new structs in font rendering
Doug Coleman
parent
56be96429a
commit
6aeb3614ff
|
|
@ -1,37 +1,37 @@
|
|||
USING: assocs memoize locals kernel accessors init fonts math
|
||||
combinators windows.errors windows.types windows.gdi32 ;
|
||||
IN: windows.fonts
|
||||
|
||||
: windows-font-name ( string -- string' )
|
||||
H{
|
||||
{ "sans-serif" "Tahoma" }
|
||||
{ "serif" "Times New Roman" }
|
||||
{ "monospace" "Courier New" }
|
||||
} ?at drop ;
|
||||
|
||||
MEMO:: (cache-font) ( font -- HFONT )
|
||||
font size>> neg ! nHeight
|
||||
0 0 0 ! nWidth, nEscapement, nOrientation
|
||||
font bold?>> FW_BOLD FW_NORMAL ? ! fnWeight
|
||||
font 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
|
||||
font name>> windows-font-name
|
||||
CreateFont
|
||||
dup win32-error=0/f ;
|
||||
|
||||
: cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;
|
||||
|
||||
[ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook
|
||||
|
||||
: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
|
||||
[ metrics new 0 >>width ] dip {
|
||||
[ TEXTMETRICW-tmHeight >>height ]
|
||||
[ TEXTMETRICW-tmAscent >>ascent ]
|
||||
[ TEXTMETRICW-tmDescent >>descent ]
|
||||
} cleave ;
|
||||
USING: assocs memoize locals kernel accessors init fonts math
|
||||
combinators windows.errors windows.types windows.gdi32 ;
|
||||
IN: windows.fonts
|
||||
|
||||
: windows-font-name ( string -- string' )
|
||||
H{
|
||||
{ "sans-serif" "Tahoma" }
|
||||
{ "serif" "Times New Roman" }
|
||||
{ "monospace" "Courier New" }
|
||||
} ?at drop ;
|
||||
|
||||
MEMO:: (cache-font) ( font -- HFONT )
|
||||
font size>> neg ! nHeight
|
||||
0 0 0 ! nWidth, nEscapement, nOrientation
|
||||
font bold?>> FW_BOLD FW_NORMAL ? ! fnWeight
|
||||
font 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
|
||||
font name>> windows-font-name
|
||||
CreateFont
|
||||
dup win32-error=0/f ;
|
||||
|
||||
: cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;
|
||||
|
||||
[ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook
|
||||
|
||||
: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
|
||||
[ metrics new 0 >>width ] dip {
|
||||
[ tmHeight>> >>height ]
|
||||
[ tmAscent>> >>ascent ]
|
||||
[ tmDescent>> >>descent ]
|
||||
} cleave ;
|
||||
|
|
|
|||
|
|
@ -380,26 +380,26 @@ TYPEDEF: DWORD* LPCOLORREF
|
|||
: color>RGB ( color -- COLORREF )
|
||||
>rgba-components drop [ 255 * >integer ] tri@ RGB ;
|
||||
|
||||
C-STRUCT: TEXTMETRICW
|
||||
{ "LONG" "tmHeight" }
|
||||
{ "LONG" "tmAscent" }
|
||||
{ "LONG" "tmDescent" }
|
||||
{ "LONG" "tmInternalLeading" }
|
||||
{ "LONG" "tmExternalLeading" }
|
||||
{ "LONG" "tmAveCharWidth" }
|
||||
{ "LONG" "tmMaxCharWidth" }
|
||||
{ "LONG" "tmWeight" }
|
||||
{ "LONG" "tmOverhang" }
|
||||
{ "LONG" "tmDigitizedAspectX" }
|
||||
{ "LONG" "tmDigitizedAspectY" }
|
||||
{ "WCHAR" "tmFirstChar" }
|
||||
{ "WCHAR" "tmLastChar" }
|
||||
{ "WCHAR" "tmDefaultChar" }
|
||||
{ "WCHAR" "tmBreakChar" }
|
||||
{ "BYTE" "tmItalic" }
|
||||
{ "BYTE" "tmUnderlined" }
|
||||
{ "BYTE" "tmStruckOut" }
|
||||
{ "BYTE" "tmPitchAndFamily" }
|
||||
{ "BYTE" "tmCharSet" } ;
|
||||
STRUCT: TEXTMETRICW
|
||||
{ tmHeight LONG }
|
||||
{ tmAscent LONG }
|
||||
{ tmDescent LONG }
|
||||
{ tmInternalLeading LONG }
|
||||
{ tmExternalLeading LONG }
|
||||
{ tmAveCharWidth LONG }
|
||||
{ tmMaxCharWidth LONG }
|
||||
{ tmWeight LONG }
|
||||
{ tmOverhang LONG }
|
||||
{ tmDigitizedAspectX LONG }
|
||||
{ tmDigitizedAspectY LONG }
|
||||
{ tmFirstChar WCHAR }
|
||||
{ tmLastChar WCHAR }
|
||||
{ tmDefaultChar WCHAR }
|
||||
{ tmBreakChar WCHAR }
|
||||
{ tmItalic BYTE }
|
||||
{ tmUnderlined BYTE }
|
||||
{ tmStruckOut BYTE }
|
||||
{ tmPitchAndFamily BYTE }
|
||||
{ tmCharSet BYTE } ;
|
||||
|
||||
TYPEDEF: TEXTMETRICW* LPTEXTMETRIC
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@ USING: kernel assocs math sequences fry io.encodings.string
|
|||
io.encodings.utf16n accessors arrays combinators destructors
|
||||
cache namespaces init fonts alien.c-types windows.usp10
|
||||
windows.offscreen windows.gdi32 windows.ole32 windows.types
|
||||
windows.fonts opengl.textures locals windows.errors ;
|
||||
windows.fonts opengl.textures locals windows.errors
|
||||
classes.struct ;
|
||||
IN: windows.uniscribe
|
||||
|
||||
TUPLE: script-string < disposable font string metrics ssa size image ;
|
||||
|
|
@ -84,7 +85,7 @@ TUPLE: script-string < disposable font string metrics ssa size image ;
|
|||
[ SIZE-cx ] [ SIZE-cy ] bi 2array ;
|
||||
|
||||
: dc-metrics ( dc -- metrics )
|
||||
"TEXTMETRICW" <c-object>
|
||||
TEXTMETRICW <struct>
|
||||
[ GetTextMetrics drop ] keep
|
||||
TEXTMETRIC>metrics ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue