53 lines
1.4 KiB
Factor
53 lines
1.4 KiB
Factor
USING: assocs memoize locals kernel accessors init fonts math
|
|
combinators system-info.windows windows.errors windows.types
|
|
windows.gdi32 ;
|
|
IN: windows.fonts
|
|
|
|
MEMO: windows-fonts ( -- fonts )
|
|
windows-major 6 >=
|
|
H{
|
|
{ "sans-serif" "Segoe UI" }
|
|
{ "serif" "Cambria" }
|
|
{ "monospace" "Consolas" }
|
|
}
|
|
H{
|
|
{ "sans-serif" "Tahoma" }
|
|
{ "serif" "Times New Roman" }
|
|
{ "monospace" "Courier New" }
|
|
} ? ;
|
|
|
|
: windows-font-name ( string -- string' )
|
|
windows-fonts ?at drop ;
|
|
|
|
MEMO:: (cache-font) ( name size bold? italic? -- HFONT )
|
|
size neg ! nHeight
|
|
0 0 0 ! nWidth, nEscapement, nOrientation
|
|
bold? FW_BOLD FW_NORMAL ? ! fnWeight
|
|
italic? TRUE FALSE ? ! fdwItalic
|
|
FALSE ! fdwUnderline
|
|
FALSE ! fdWStrikeOut
|
|
DEFAULT_CHARSET ! fdwCharSet
|
|
OUT_OUTLINE_PRECIS ! fdwOutputPrecision
|
|
CLIP_DEFAULT_PRECIS ! fdwClipPrecision
|
|
DEFAULT_QUALITY ! fdwQuality
|
|
DEFAULT_PITCH ! fdwPitchAndFamily
|
|
name windows-font-name
|
|
CreateFont
|
|
dup win32-error=0/f ;
|
|
|
|
: cache-font ( font -- HFONT )
|
|
{ [ name>> ] [ size>> ] [ bold?>> ] [ italic?>> ] } cleave
|
|
(cache-font) ;
|
|
|
|
[
|
|
\ (cache-font) reset-memoized
|
|
\ windows-fonts reset-memoized
|
|
] "windows.fonts" add-startup-hook
|
|
|
|
: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
|
|
[ metrics new 0 >>width ] dip {
|
|
[ tmHeight>> >>height ]
|
|
[ tmAscent>> >>ascent ]
|
|
[ tmDescent>> >>descent ]
|
|
} cleave ;
|