1 USING: assocs memoize locals kernel accessors init fonts math
\r
2 combinators windows.errors windows.types windows.gdi32 ;
\r
5 : windows-font-name ( string -- string' )
\r
7 { "sans-serif" "Tahoma" }
\r
8 { "serif" "Times New Roman" }
\r
9 { "monospace" "Courier New" }
\r
12 MEMO:: (cache-font) ( font -- HFONT )
\r
13 font size>> neg ! nHeight
\r
14 0 0 0 ! nWidth, nEscapement, nOrientation
\r
15 font bold?>> FW_BOLD FW_NORMAL ? ! fnWeight
\r
16 font italic?>> TRUE FALSE ? ! fdwItalic
\r
17 FALSE ! fdwUnderline
\r
18 FALSE ! fdWStrikeOut
\r
19 DEFAULT_CHARSET ! fdwCharSet
\r
20 OUT_OUTLINE_PRECIS ! fdwOutputPrecision
\r
21 CLIP_DEFAULT_PRECIS ! fdwClipPrecision
\r
22 DEFAULT_QUALITY ! fdwQuality
\r
23 DEFAULT_PITCH ! fdwPitchAndFamily
\r
24 font name>> windows-font-name
\r
26 dup win32-error=0/f ;
\r
28 : cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;
\r
30 [ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook
\r
32 : TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
\r
33 [ metrics new 0 >>width ] dip {
\r
34 [ TEXTMETRICW-tmHeight >>height ]
\r
35 [ TEXTMETRICW-tmAscent >>ascent ]
\r
36 [ TEXTMETRICW-tmDescent >>descent ]
\r