From cf87e20a30af3479fd0ce2e09b77701775f3699f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 28 Mar 2009 22:27:37 -0500
Subject: [PATCH] Uniscribe text rendering work in progress

---
 basis/windows/uniscribe/authors.txt      |  1 +
 basis/windows/uniscribe/uniscribe.factor | 65 ++++++++++++++++++++++++
 basis/windows/usp10/usp10.factor         |  4 +-
 3 files changed, 69 insertions(+), 1 deletion(-)
 create mode 100644 basis/windows/uniscribe/authors.txt
 create mode 100644 basis/windows/uniscribe/uniscribe.factor

diff --git a/basis/windows/uniscribe/authors.txt b/basis/windows/uniscribe/authors.txt
new file mode 100644
index 0000000000..d4f5d6b3ae
--- /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
index 0000000000..5d24601555
--- /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 64e5a60019..50fa98996c 100755
--- 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 ) ;
-- 
2.34.1