new structs in font rendering

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

diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index 59192bb3b6de2e1fcfe8b485e2841b2d294cf4a0..c62de58bcd64925ca79e0a18cac27e3b6ff42705 100755 (executable)
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -380,26 +380,26 @@ TYPEDEF: DWORD* LPCOLORREF
 : color>RGB ( color -- COLORREF )
     >rgba-components drop [ 255 * >integer ] tri@ RGB ;
 
 : 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
 
 TYPEDEF: TEXTMETRICW* LPTEXTMETRIC

diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor
index 457f4bc9f017e59e3301d976f16c2376fc2457b2..7dd630ca5b1ad5f3d27c50f8991657c56b16f033 100755 (executable)
--- a/basis/windows/uniscribe/uniscribe.factor
+++ b/basis/windows/uniscribe/uniscribe.factor
@@ -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
 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 ;
 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 )
     [ SIZE-cx ] [ SIZE-cy ] bi 2array ;
 
 : dc-metrics ( dc -- metrics )

-    "TEXTMETRICW" <c-object>
+    TEXTMETRICW <struct>

     [ GetTextMetrics drop ] keep
     TEXTMETRIC>metrics ;
 
     [ GetTextMetrics drop ] keep
     TEXTMETRIC>metrics ;