Uniscribe text rendering work in progress

diff --git a/basis/windows/uniscribe/authors.txt b/basis/windows/uniscribe/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
+++ b/basis/windows/uniscribe/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file

diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor
new file mode 100644 (file)
index 0000000..5d24601
--- /dev/null
+++ b/basis/windows/uniscribe/uniscribe.factor
@@ -0,0 +1,65 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math sequences io.encodings.string io.encodings.utf16n
+accessors arrays destructors alien.c-types windows windows.usp10
+windows.offscreen ;
+IN: windows.uniscribe
+
+TUPLE: script-string pssa size image ;
+
+: make-script-string ( dc string -- script-string )
+    [ utf16n encode ] ! pString
+    [ length ] bi ! cString
+    dup 1.5 * 16 + ! cGlyphs -- MSDN says this is "recommended size"
+    -1 ! iCharset -- Unicode
+    SSA_GLYPHS ! dwFlags
+    ... ! iReqWidth
+    f ! psControl
+    f ! psState
+    f ! piDx
+    f ! pTabdef
+    ... ! pbInClass
+    f <void*> ! pssa
+    [ ScriptStringAnalyse ] keep
+    [ win32-error=0/f ] [ |ScriptStringFree ] bi* ;
+
+: draw-script-string ( script-string -- bitmap )
+    ! ssa
+    0 ! iX
+    0 ! iY
+    ETO_OPAQUE ! uOptions ... ????
+    f ! prc
+    0 ! iMinSel
+    0 ! iMaxSel
+    f ! fDisabled
+    ScriptStringOut ;
+
+: <script-string> ( string -- script-string )
+    [
+        ... dim ... [
+            make-script-string |ScriptStringFree
+            [ ]
+            [ draw-script-string ]
+            [
+                ScriptString_pSize
+                dup win32-error=0/f
+                [ SIZE-cx ] [ SIZE-cy ] bi 2array
+            ] tri
+        ] make-bitmap-image
+        script-string boa
+    ] with-destructors ;
+
+M: script-string dispose* pssa>> ScriptStringFree win32-error=0/f ;
+
+: line-offset>x ( offset script-string -- x )
+    pssa>> ! ssa
+    swap ! icp
+    ... ! fTrailing
+    0 <int> [ ScriptStringCPtoX win32-error=0/f ] keep *int ;
+
+: line-x>offset ( x script-string -- offset trailing )
+    pssa>> ! ssa
+    swap ! iX
+    0 <int> ! pCh
+    0 <int> ! piTrailing
+    [ ScriptStringXtoCP win32-error=0/f ] 2keep [ *int ] bi@ ;
\ No newline at end of file

diff --git a/basis/windows/usp10/usp10.factor b/basis/windows/usp10/usp10.factor
index 64e5a60019e10f2fddb85f07aa7086eff1a4ef3b..50fa98996c7fe3fee90c7ba8f858002a87379a0d 100755 (executable)
--- a/basis/windows/usp10/usp10.factor
+++ b/basis/windows/usp10/usp10.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.syntax alien.destructors ;
 IN: windows.usp10
 
 LIBRARY: usp10
@@ -262,6 +262,8 @@ FUNCTION: HRESULT ScriptStringFree (
     SCRIPT_STRING_ANALYSIS* pssa
 ) ;
 
+DESTRUCTOR: ScriptStringFree
+
 FUNCTION: SIZE* ScriptString_pSize ( SCRIPT_STRING_ANALYSIS ssa ) ;
 
 FUNCTION: int* ScriptString_pcOutChars ( SCRIPT_STRING_ANALYSIS ssa ) ;