]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/windows/fonts/fonts.factor
new structs in font rendering
[factor.git] / basis / windows / fonts / fonts.factor
index 269e8f8f489297c0aa12d487c0cc21164f9acfc9..b8acf5d8d1ab9f31d390b6b1de787e137c70f5b6 100755 (executable)
@@ -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 ;