[plt-scheme] A GUI/font puzzle
In the good tradition of posting puzzles I have something funny to
present. Does not have much to do with denotational semantics but took
from me a little more the ten hours nevertheless. ;-)
Try the following program on Windows (but also read the notes below the
code):
#lang scheme/gui
(define my-canvas%
(class canvas%
(super-new [min-width 100]
[min-height 100])
(inherit get-dc)
(define/override (on-paint)
(let* ([txt "Starting"]
[backbuf (make-object bitmap% 100 100)]
[back-dc (new bitmap-dc% [bitmap backbuf])]
[value-font (make-object font% 18 "Verdana" 'default
'normal 'bold #f 'smoothed)])
(send back-dc set-background (make-object color% 255 255 255))
; may be left out
(send back-dc clear) ; may be left out
(send back-dc set-smoothing 'smoothed) ; critical
(send back-dc draw-rectangle 0 0 2 2) ; critical
(send back-dc set-smoothing 'unsmoothed) ; may be left out
(send back-dc set-font value-font) ; critical
(send back-dc get-text-extent txt) ; critical
(send back-dc draw-text txt 0 0)
(send (get-dc) draw-bitmap backbuf 0 0)))))
(define frame (new frame% [label "Font test"]))
(define canvas (new my-canvas% [parent frame]))
(send frame show #t)
Some notes:
- the problem is with font kerning on Windows only (does not seem to
depend on the font)
- it manifests itself at least in 4.1.2 and 4.1.4 (but probably in other
versions too) on several different WinXP machines (1 VirtualBox and 2
physical)
- if you remove any of the lines labeled "critical" the problem
disappears
- once you run it in a DrScheme session it will make the font look bad
(or good) for all future runs (even if you change the code)
[this means the error (or the lack of it) persists between custodian
shutdowns]
- the most impotant operation seems to be the call to get-text-extent
before the call to draw-text (adding another draw-text before
get-text-extent fixes the bug)
- this is probably the best testcase I have ever done (I found this bug
in a 2KLoS multithreaded program ;)
--
regards,
Jakub Piotr Cłapa