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