new structs in font rendering

db4
Doug Coleman 2009-08-29 14:29:46 -05:00
parent 56be96429a
commit 6aeb3614ff
3 changed files with 61 additions and 60 deletions

View File

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

View File

@ -380,26 +380,26 @@ TYPEDEF: DWORD* LPCOLORREF
: color>RGB ( color -- COLORREF ) : color>RGB ( color -- COLORREF )
>rgba-components drop [ 255 * >integer ] tri@ RGB ; >rgba-components drop [ 255 * >integer ] tri@ RGB ;
C-STRUCT: TEXTMETRICW STRUCT: TEXTMETRICW
{ "LONG" "tmHeight" } { tmHeight LONG }
{ "LONG" "tmAscent" } { tmAscent LONG }
{ "LONG" "tmDescent" } { tmDescent LONG }
{ "LONG" "tmInternalLeading" } { tmInternalLeading LONG }
{ "LONG" "tmExternalLeading" } { tmExternalLeading LONG }
{ "LONG" "tmAveCharWidth" } { tmAveCharWidth LONG }
{ "LONG" "tmMaxCharWidth" } { tmMaxCharWidth LONG }
{ "LONG" "tmWeight" } { tmWeight LONG }
{ "LONG" "tmOverhang" } { tmOverhang LONG }
{ "LONG" "tmDigitizedAspectX" } { tmDigitizedAspectX LONG }
{ "LONG" "tmDigitizedAspectY" } { tmDigitizedAspectY LONG }
{ "WCHAR" "tmFirstChar" } { tmFirstChar WCHAR }
{ "WCHAR" "tmLastChar" } { tmLastChar WCHAR }
{ "WCHAR" "tmDefaultChar" } { tmDefaultChar WCHAR }
{ "WCHAR" "tmBreakChar" } { tmBreakChar WCHAR }
{ "BYTE" "tmItalic" } { tmItalic BYTE }
{ "BYTE" "tmUnderlined" } { tmUnderlined BYTE }
{ "BYTE" "tmStruckOut" } { tmStruckOut BYTE }
{ "BYTE" "tmPitchAndFamily" } { tmPitchAndFamily BYTE }
{ "BYTE" "tmCharSet" } ; { tmCharSet BYTE } ;
TYPEDEF: TEXTMETRICW* LPTEXTMETRIC TYPEDEF: TEXTMETRICW* LPTEXTMETRIC

View File

@ -4,7 +4,8 @@ USING: kernel assocs math sequences fry io.encodings.string
io.encodings.utf16n accessors arrays combinators destructors io.encodings.utf16n accessors arrays combinators destructors
cache namespaces init fonts alien.c-types windows.usp10 cache namespaces init fonts alien.c-types windows.usp10
windows.offscreen windows.gdi32 windows.ole32 windows.types 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 IN: windows.uniscribe
TUPLE: script-string < disposable font string metrics ssa size image ; 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 ; [ SIZE-cx ] [ SIZE-cy ] bi 2array ;
: dc-metrics ( dc -- metrics ) : dc-metrics ( dc -- metrics )
"TEXTMETRICW" <c-object> TEXTMETRICW <struct>
[ GetTextMetrics drop ] keep [ GetTextMetrics drop ] keep
TEXTMETRIC>metrics ; TEXTMETRIC>metrics ;