Merge branch 'master' of git://factorcode.org/git/factor into uniscribe

diff --git a/basis/alien/destructors/destructors.factor b/basis/alien/destructors/destructors.factor
index 1b6022d3b7b21bea1dadde136f2013a4761770e0..1c5c975fe65f37c1de0052af67684a4cdd04338f 100644 (file)
--- a/basis/alien/destructors/destructors.factor
+++ b/basis/alien/destructors/destructors.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: functors destructors accessors kernel parser words ;
+USING: functors destructors accessors kernel parser words
+combinators.smart ;
 IN: alien.destructors
 
 SLOT: alien
@@ -18,7 +19,7 @@ TUPLE: F-destructor alien disposed ;
 
 : <F-destructor> ( alien -- destructor ) f F-destructor boa ; inline
 
-M: F-destructor dispose* alien>> F ;
+M: F-destructor dispose* [ alien>> F ] drop-outputs ;
 
 : &F ( alien -- alien ) dup <F-destructor> &dispose drop ; inline
 

diff --git a/basis/combinators/smart/smart.factor b/basis/combinators/smart/smart.factor
index e7bdd75ced39028508cd709d1c41d53ae75772c3..aa7960539cca6f6d66c022b8262911481c0f06d1 100644 (file)
--- a/basis/combinators/smart/smart.factor
+++ b/basis/combinators/smart/smart.factor
@@ -4,6 +4,9 @@ USING: accessors fry generalizations kernel macros math.order
 stack-checker math ;
 IN: combinators.smart
 
+MACRO: drop-outputs ( quot -- quot' )
+    dup infer out>> '[ @ _ ndrop ] ;
+
 MACRO: output>sequence ( quot exemplar -- newquot )
     [ dup infer out>> ] dip
     '[ @ _ _ nsequence ] ;

diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 80dd313e8543e9d913ef4ae71452eaccbe80184c..12ce2bed80a6cf9b8f07407b06f5d12943238415 100755 (executable)
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -1,16 +1,16 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! Portions copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings arrays assocs ui
-ui.private ui.gadgets ui.gadgets.private ui.backend
-ui.clipboards ui.gadgets.worlds ui.gestures ui.event-loop io
-kernel math math.vectors namespaces make sequences strings
-vectors words windows.kernel32 windows.gdi32 windows.user32
-windows.opengl32 windows.messages windows.types windows.nt
-windows threads libc combinators fry combinators.short-circuit
-continuations command-line shuffle opengl ui.render ascii
-math.bitwise locals accessors math.rectangles math.order ascii
-calendar io.encodings.utf16n ;
+USING: alien alien.c-types alien.strings arrays assocs ui ui.private
+ui.gadgets ui.gadgets.private ui.backend ui.clipboards
+ui.gadgets.worlds ui.gestures ui.event-loop io kernel math
+math.vectors namespaces make sequences strings vectors words
+windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
+windows.messages windows.types windows.offscreen windows.nt windows
+threads libc combinators fry combinators.short-circuit continuations
+command-line shuffle opengl ui.render ascii math.bitwise locals
+accessors math.rectangles math.order ascii calendar
+io.encodings.utf16n ;
 IN: ui.backend.windows
 
 SINGLETON: windows-ui-backend
@@ -501,35 +501,12 @@ M: windows-ui-backend (open-window) ( world -- )
     hWnd>> show-window ;
 
 M: win-base select-gl-context ( handle -- )
-    [ hDC>> ] keep hRC>> wglMakeCurrent win32-error=0/f
+    [ hDC>> ] [ hRC>> ] bi wglMakeCurrent win32-error=0/f
     GdiFlush drop ;
 
 M: win-base flush-gl-context ( handle -- )
     hDC>> SwapBuffers win32-error=0/f ;
 
-: (bitmap-info) ( dim -- BITMAPINFO )
-    "BITMAPINFO" <c-object> [
-        BITMAPINFO-bmiHeader {
-            [ nip "BITMAPINFOHEADER" heap-size swap set-BITMAPINFOHEADER-biSize ]
-            [ [ first ] dip set-BITMAPINFOHEADER-biWidth ]
-            [ [ second ] dip set-BITMAPINFOHEADER-biHeight ]
-            [ nip 1 swap set-BITMAPINFOHEADER-biPlanes ]
-            [ nip 32 swap set-BITMAPINFOHEADER-biBitCount ]
-            [ nip BI_RGB swap set-BITMAPINFOHEADER-biCompression ]
-            [ [ first2 * 4 * ] dip set-BITMAPINFOHEADER-biSizeImage ]
-            [ nip 72 swap set-BITMAPINFOHEADER-biXPelsPerMeter ]
-            [ nip 72 swap set-BITMAPINFOHEADER-biYPelsPerMeter ]
-            [ nip 0 swap set-BITMAPINFOHEADER-biClrUsed ]
-            [ nip 0 swap set-BITMAPINFOHEADER-biClrImportant ]
-        } 2cleave
-    ] keep ;
-
-: make-offscreen-dc-and-bitmap ( dim -- hDC hBitmap bits )
-    f CreateCompatibleDC
-    dup rot (bitmap-info) DIB_RGB_COLORS f <void*>
-    [ f 0 CreateDIBSection ] keep *void*
-    [ 2dup SelectObject drop ] dip ;
-
 : setup-offscreen-gl ( dim -- hDC hRC hBitmap bits )
     make-offscreen-dc-and-bitmap [
         [ dup offscreen-pfd-dwFlags setup-pixel-format ]
@@ -548,13 +525,12 @@ M: windows-ui-backend (close-offscreen-buffer) ( handle -- )
 ! each pixel; it's left as zero
 
 : (make-opaque) ( byte-array -- byte-array' )
-    [ length 4 / ]
+    [ length 4 /i ]
     [ '[ 255 swap 4 * 3 + _ set-nth ] each ]
     [ ] tri ;
 
 : (opaque-pixels) ( world -- pixels )
-    [ handle>> bits>> ] [ dim>> first2 * 4 * ] bi
-    memory>byte-array (make-opaque) ;
+    [ handle>> bits>> ] [ dim>> ] bi bitmap>byte-array (make-opaque) ;
 
 M: windows-ui-backend offscreen-pixels ( world -- alien w h )
     [ (opaque-pixels) ] [ dim>> first2 ] bi ;

diff --git a/basis/windows/gdi32/gdi32.factor b/basis/windows/gdi32/gdi32.factor
index 077adf1961bc75eb4731cf5d78c0777b4737925f..2281255a4f571940c77334d2cbc167896a928736 100755 (executable)
--- a/basis/windows/gdi32/gdi32.factor
+++ b/basis/windows/gdi32/gdi32.factor
@@ -1,7 +1,6 @@
-! FUNCTION: AbortDoc
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax kernel windows.types ;
+USING: alien alien.syntax alien.destructors kernel windows.types ;
 IN: windows.gdi32
 
 ! Stock Logical Objects
@@ -36,6 +35,7 @@ CONSTANT: DIB_PAL_COLORS 1
 
 LIBRARY: gdi32
 
+! FUNCTION: AbortDoc
 ! FUNCTION: AbortPath
 ! FUNCTION: AddFontMemResourceEx
 ! FUNCTION: AddFontResourceA
@@ -178,9 +178,11 @@ FUNCTION: HRGN CreateRectRgn ( int x, int y, int w, int h ) ;
 ! FUNCTION: DdEntry9
 ! FUNCTION: DeleteColorSpace
 FUNCTION: BOOL DeleteDC ( HDC hdc ) ;
+DESTRUCTOR: DeleteDC
 ! FUNCTION: DeleteEnhMetaFile
 ! FUNCTION: DeleteMetaFile
 FUNCTION: BOOL DeleteObject ( HGDIOBJ hObject ) ;
+DESTRUCTOR: DeleteObject
 ! FUNCTION: DescribePixelFormat
 ! FUNCTION: DeviceCapabilitiesExA
 ! FUNCTION: DeviceCapabilitiesExW

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

diff --git a/basis/windows/offscreen/offscreen.factor b/basis/windows/offscreen/offscreen.factor
new file mode 100644 (file)
index 0000000..4eee68c
--- /dev/null
+++ b/basis/windows/offscreen/offscreen.factor
@@ -0,0 +1,47 @@
+! Copyright (C) 2009 Joe Groff, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types kernel combinators sequences
+math windows.gdi32 windows.types images destructors
+accessors fry ;
+IN: windows.offscreen
+
+: (bitmap-info) ( dim -- BITMAPINFO )
+    "BITMAPINFO" <c-object> [
+        BITMAPINFO-bmiHeader {
+            [ nip "BITMAPINFOHEADER" heap-size swap set-BITMAPINFOHEADER-biSize ]
+            [ [ first ] dip set-BITMAPINFOHEADER-biWidth ]
+            [ [ second ] dip set-BITMAPINFOHEADER-biHeight ]
+            [ nip 1 swap set-BITMAPINFOHEADER-biPlanes ]
+            [ nip 32 swap set-BITMAPINFOHEADER-biBitCount ]
+            [ nip BI_RGB swap set-BITMAPINFOHEADER-biCompression ]
+            [ [ first2 * 4 * ] dip set-BITMAPINFOHEADER-biSizeImage ]
+            [ nip 72 swap set-BITMAPINFOHEADER-biXPelsPerMeter ]
+            [ nip 72 swap set-BITMAPINFOHEADER-biYPelsPerMeter ]
+            [ nip 0 swap set-BITMAPINFOHEADER-biClrUsed ]
+            [ nip 0 swap set-BITMAPINFOHEADER-biClrImportant ]
+        } 2cleave
+    ] keep ;
+
+: make-offscreen-dc-and-bitmap ( dim -- hDC hBitmap bits )
+    f CreateCompatibleDC
+    [ nip ]
+    [
+        swap (bitmap-info) DIB_RGB_COLORS f <void*>
+        [ f 0 CreateDIBSection ] keep *void*
+    ] 2bi
+    [ 2dup SelectObject drop ] dip ;
+
+: bitmap>byte-array ( bits dim -- byte-array )
+    product 4 * memory>byte-array ;
+
+: bitmap>image ( bits dim -- image )
+    [ bitmap>byte-array ] keep
+    <image> swap >>dim swap >>bitmap XBGR >>component-order ;
+
+: make-bitmap-image ( dim quot: ( hDC -- ) -- image )
+    '[
+        [
+            make-offscreen-dc-and-bitmap
+            [ &DeleteDC @ ] [ &DeleteObject drop ] [ ] tri*
+        ] keep bitmap>byte-array
+    ] with-destructors ; inline
\ No newline at end of file

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 ) ;

diff --git a/extra/ui/offscreen/offscreen.factor b/extra/ui/offscreen/offscreen.factor
index cf9370ed7fa6b050fe9e373bf33124743f165445..f0b81ccacd99f27540de841cb637441ad057c48b 100755 (executable)
--- a/extra/ui/offscreen/offscreen.factor
+++ b/extra/ui/offscreen/offscreen.factor
@@ -1,7 +1,7 @@
 ! (c) 2008 Joe Groff, see license for details
 USING: accessors continuations images.bitmap kernel math
-sequences ui.gadgets ui.gadgets.worlds ui ui.backend
-destructors ;
+sequences ui.gadgets ui.gadgets.private ui.gadgets.worlds
+ui.private ui ui.backend destructors ;
 IN: ui.offscreen
 
 TUPLE: offscreen-world < world ;

diff --git a/extra/ui/offscreen/tags.txt b/extra/ui/offscreen/tags.txt
index b796ebde9124cd1beac6a69bd42032703dbafcb2..46f6dcd8de25f6a27fec35e7dee247082d16f364 100644 (file)
--- a/extra/ui/offscreen/tags.txt
+++ b/extra/ui/offscreen/tags.txt
@@ -1,3 +1,2 @@
-unportable
 ui
 graphics