]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor into clean-linux-x86-32
authorMaxim Savchenko <pdunan@gmail.com>
Sat, 4 Apr 2009 09:57:48 +0000 (05:57 -0400)
committerMaxim Savchenko <pdunan@gmail.com>
Sat, 4 Apr 2009 09:57:48 +0000 (05:57 -0400)
75 files changed:
README.txt
basis/alien/destructors/destructors.factor [changed mode: 0644->0755]
basis/combinators/smart/smart.factor
basis/help/tips/tips-docs.factor
basis/images/images.factor [changed mode: 0644->0755]
basis/images/normalization/normalization.factor [changed mode: 0644->0755]
basis/opengl/textures/textures.factor [changed mode: 0644->0755]
basis/pack/pack.factor
basis/sorting/functor/authors.txt [new file with mode: 0644]
basis/sorting/functor/functor.factor [new file with mode: 0644]
basis/sorting/human/human-docs.factor
basis/sorting/human/human-tests.factor
basis/sorting/human/human.factor
basis/sorting/slots/slots-docs.factor
basis/sorting/slots/slots-tests.factor
basis/sorting/slots/slots.factor
basis/sorting/title/authors.txt [new file with mode: 0644]
basis/sorting/title/title-tests.factor [new file with mode: 0644]
basis/sorting/title/title.factor [new file with mode: 0644]
basis/stack-checker/known-words/known-words.factor
basis/tools/deploy/macosx/macosx.factor
basis/tools/deploy/shaker/shaker.factor
basis/tools/deploy/windows/windows.factor
basis/ui/backend/windows/windows.factor
basis/ui/gadgets/editors/editors.factor
basis/ui/gadgets/line-support/line-support.factor
basis/ui/gadgets/scrollers/scrollers.factor
basis/ui/gadgets/tables/tables.factor
basis/ui/images/images.factor [changed mode: 0644->0755]
basis/ui/text/core-text/core-text.factor [changed mode: 0644->0755]
basis/ui/text/pango/pango.factor
basis/ui/text/pango/summary.txt [new file with mode: 0755]
basis/ui/text/text-tests.factor [changed mode: 0644->0755]
basis/ui/text/text.factor [changed mode: 0644->0755]
basis/ui/text/uniscribe/authors.txt [new file with mode: 0755]
basis/ui/text/uniscribe/summary.txt [new file with mode: 0755]
basis/ui/text/uniscribe/tags.txt [new file with mode: 0755]
basis/ui/text/uniscribe/uniscribe.factor [new file with mode: 0755]
basis/ui/tools/listener/completion/completion.factor
basis/windows/fonts/fonts.factor [new file with mode: 0755]
basis/windows/gdi32/gdi32.factor
basis/windows/offscreen/authors.txt [new file with mode: 0644]
basis/windows/offscreen/offscreen-tests.factor [new file with mode: 0755]
basis/windows/offscreen/offscreen.factor [new file with mode: 0755]
basis/windows/offscreen/summary.txt [new file with mode: 0755]
basis/windows/offscreen/tags.txt [new file with mode: 0755]
basis/windows/types/types.factor
basis/windows/uniscribe/authors.txt [new file with mode: 0644]
basis/windows/uniscribe/summary.txt [new file with mode: 0755]
basis/windows/uniscribe/tags.txt [new file with mode: 0755]
basis/windows/uniscribe/uniscribe.factor [new file with mode: 0755]
basis/windows/usp10/usp10.factor
basis/windows/windows.factor [changed mode: 0644->0755]
build-support/dlls.txt
build-support/factor.sh
core/bootstrap/primitives.factor
core/io/streams/c/c.factor
extra/color-picker/deploy.factor
extra/html/parser/analyzer/analyzer.factor
extra/html/parser/state/state-tests.factor
extra/html/parser/state/state.factor
extra/mason/child/child-tests.factor
extra/mason/child/child.factor [changed mode: 0644->0755]
extra/spider/report/authors.txt [new file with mode: 0644]
extra/spider/report/report.factor [new file with mode: 0644]
extra/spider/spider.factor
extra/ui/offscreen/offscreen-docs.factor
extra/ui/offscreen/offscreen.factor
extra/ui/offscreen/tags.txt
vm/factor.c
vm/io.c
vm/io.h
vm/os-unix.h
vm/os-windows.h
vm/primitives.c

index bd9da0ab2bc85318bf37526af68a75b4ca312ecb..c5d53de84275c86a69f8b4eb7394800fbd98ea8c 100755 (executable)
@@ -113,12 +113,6 @@ the command prompt using the console application:
 
   factor.com -i=boot.<cpu>.image
 
-Before bootstrapping, you will need to download the DLLs for the Pango
-text rendering library. The required DLLs are listed in
-build-support/dlls.txt and are available from the following location:
-
-  <http://factorcode.org/dlls>
-
 Once bootstrapped, double-clicking factor.exe or factor.com starts
 the Factor UI.
 
old mode 100644 (file)
new mode 100755 (executable)
index 1b6022d..374d642
@@ -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
+effects generalizations sequences ;
 IN: alien.destructors
 
 SLOT: alien
@@ -11,6 +12,7 @@ F-destructor DEFINES-CLASS ${F}-destructor
 <F-destructor> DEFINES <${F}-destructor>
 &F DEFINES &${F}
 |F DEFINES |${F}
+N [ F stack-effect out>> length ]
 
 WHERE
 
@@ -18,7 +20,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 N ndrop ;
 
 : &F ( alien -- alien ) dup <F-destructor> &dispose drop ; inline
 
index e7bdd75ced39028508cd709d1c41d53ae75772c3..aa7960539cca6f6d66c022b8262911481c0f06d1 100644 (file)
@@ -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 ] ;
index 48ed65b3189f840ba85e0ce874497d4e3a1f6255..030c546f0c4c7f005ab8c319f8e793a4eefada62 100644 (file)
@@ -1,6 +1,6 @@
 IN: help.tips
 USING: help.markup help.syntax debugger prettyprint see help help.vocabs
-help.apropos tools.time stack-checker editors ;
+help.apropos tools.time stack-checker editors memory ;
 
 TIP: "To look at the most recent error, run " { $link :error } ". To look at the most recent error's callstack, run " { $link :c } "." ;
 
@@ -20,7 +20,9 @@ TIP: "Power tools: " { $links see edit help about apropos time infer. } ;
 
 TIP: "Tips of the day implement the " { $link "definition-protocol" } " and new tips of the day can be defined using the " { $link POSTPONE: TIP: } " parsing word." ;
 
-TIP: "Try some simple demo applications, then look at the source code in " { $snippet "extra/" } ": " { $code "\"demos\" run" } ;
+TIP: "Try some simple demo applications, then look at the source code in " { $snippet "extra/" } ": " { $snippet "\"demos\" run" } ;
+
+TIP: "To save time on reloading big libraries such as the " { $vocab-link "furnace" } " web framework, save the image after loading them using the " { $link save } " word." ;
 
 HELP: TIP:
 { $syntax "TIP: content ;" }
old mode 100644 (file)
new mode 100755 (executable)
index 08fbdd4..b32953f
@@ -1,11 +1,13 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators kernel ;
+USING: combinators kernel accessors ;
 IN: images
 
 SINGLETONS: L BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
 R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;
 
+UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ;
+
 : bytes-per-pixel ( component-order -- n )
     {
         { L [ 1 ] }
@@ -29,4 +31,6 @@ TUPLE: image dim component-order upside-down? bitmap ;
 
 : <image> ( -- image ) image new ; inline
 
+: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
+
 GENERIC: load-image* ( path tuple -- image )
\ No newline at end of file
old mode 100644 (file)
new mode 100755 (executable)
index bcdf841..dcdf39a
@@ -61,6 +61,18 @@ M: ARGB normalize-component-order*
 M: ABGR normalize-component-order*
     drop ARGB>RGBA BGRA>RGBA ;
 
+: fix-XBGR ( bitmap -- bitmap' )
+    dup 4 <sliced-groups> [ [ 255 0 ] dip set-nth ] each ;
+
+M: XBGR normalize-component-order*
+    drop fix-XBGR ABGR normalize-component-order* ;
+
+: fix-BGRX ( bitmap -- bitmap' )
+    dup 4 <sliced-groups> [ [ 255 3 ] dip set-nth ] each ;
+
+M: BGRX normalize-component-order*
+    drop fix-BGRX BGRA normalize-component-order* ;
+
 : normalize-scan-line-order ( image -- image )
     dup upside-down?>> [
         dup dim>> first 4 * '[
old mode 100644 (file)
new mode 100755 (executable)
index 810aaa2..3efe924
@@ -3,7 +3,7 @@
 USING: accessors assocs cache colors.constants destructors fry kernel
 opengl opengl.gl combinators images images.tesselation grouping
 specialized-arrays.float locals sequences math math.vectors
-math.matrices generalizations fry columns ;
+math.matrices generalizations fry columns arrays ;
 IN: opengl.textures
 
 : gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ;
@@ -17,6 +17,7 @@ M: BGR component-order>format drop GL_BGR GL_UNSIGNED_BYTE ;
 M: RGBA component-order>format drop GL_RGBA GL_UNSIGNED_BYTE ;
 M: ARGB component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV ;
 M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;
+M: BGRX component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;
 
 GENERIC: draw-texture ( texture -- )
 
@@ -24,7 +25,7 @@ GENERIC: draw-scaled-texture ( dim texture -- )
 
 <PRIVATE
 
-TUPLE: single-texture loc dim texture-coords texture display-list disposed ;
+TUPLE: single-texture image loc dim texture-coords texture display-list disposed ;
 
 : repeat-last ( seq n -- seq' )
     over peek pad-tail concat ;
@@ -44,7 +45,7 @@ TUPLE: single-texture loc dim texture-coords texture display-list disposed ;
     tri * group ; inline
 
 : power-of-2-image ( image -- image )
-    dup dim>> [ 0 = ] all? [
+    dup dim>> [ [ 0 = ] [ power-of-2? ] bi or ] all? [
         clone dup
         [ image-rows ]
         [ dim>> [ next-power-of-2 ] map ]
@@ -92,26 +93,30 @@ TUPLE: single-texture loc dim texture-coords texture display-list disposed ;
 
 : draw-textured-rect ( dim texture -- )
     [
-        (draw-textured-rect)
-        GL_TEXTURE_2D 0 glBindTexture
+        [ image>> has-alpha? [ GL_BLEND glDisable ] unless ]
+        [ (draw-textured-rect) GL_TEXTURE_2D 0 glBindTexture ]
+        [ image>> has-alpha? [ GL_BLEND glEnable ] unless ]
+        tri
     ] with-texturing ;
 
-: texture-coords ( dim -- coords )
-    [ dup next-power-of-2 /f ] map
-    { { 0 0 } { 1 0 } { 1 1 } { 0 1 } } [ v* ] with map
+: texture-coords ( texture -- coords )
+    [
+        [ dim>> ] [ image>> dim>> ] bi v/
+        { { 0 0 } { 1 0 } { 1 1 } { 0 1 } }
+        [ v* ] with map
+    ] keep
+    image>> upside-down?>> [ [ first2 1 swap - 2array ] map ] when
     float-array{ } join ;
 
 : make-texture-display-list ( texture -- dlist )
     GL_COMPILE [ [ dim>> ] keep draw-textured-rect ] make-dlist ;
 
-: <single-texture> ( image loc -- texture )
-   single-texture new swap >>loc
-    swap
-    [ dim>> >>dim ] keep
-    [ dim>> product 0 = ] keep '[
-        _
-        [ dim>> texture-coords >>texture-coords ]
-        [ power-of-2-image make-texture >>texture ] bi
+: <single-texture> ( image loc dim -- texture )
+    [ power-of-2-image ] 2dip
+    single-texture new swap >>dim swap >>loc swap >>image
+    dup image>> dim>> product 0 = [
+        dup texture-coords >>texture-coords
+        dup image>> make-texture >>texture
         dup make-texture-display-list >>display-list
     ] unless ;
 
@@ -133,19 +138,20 @@ TUPLE: multi-texture grid display-list loc disposed ;
 
 : <texture-grid> ( image-grid loc -- grid )
     [ dup image-locs ] dip
-    '[ [ _ v+ <single-texture> |dispose ] 2map ] 2map ;
+    '[ [ _ v+ over dim>> <single-texture> |dispose ] 2map ] 2map ;
 
 : draw-textured-grid ( grid -- )
     [ [ [ dim>> ] keep (draw-textured-rect) ] each ] each ;
 
+: grid-has-alpha? ( grid -- ? )
+    first first image>> has-alpha? ;
+
 : make-textured-grid-display-list ( grid -- dlist )
     GL_COMPILE [
         [
-            [
-                [
-                    [ dim>> ] keep (draw-textured-rect)
-                ] each
-            ] each
+            [ grid-has-alpha? [ GL_BLEND glDisable ] unless ]
+            [ [ [ [ dim>> ] keep (draw-textured-rect) ] each ] each ]
+            [ grid-has-alpha? [ GL_BLEND glEnable ] unless ] tri
             GL_TEXTURE_2D 0 glBindTexture
         ] with-texturing
     ] make-dlist ;
@@ -163,11 +169,14 @@ M: multi-texture draw-texture display-list>> [ glCallList ] when* ;
 
 M: multi-texture dispose* grid>> [ [ dispose ] each ] each ;
 
-CONSTANT: max-texture-size { 256 256 }
+CONSTANT: max-texture-size { 512 512 }
 
 PRIVATE>
 
-: <texture> ( image loc -- texture )
-    over dim>> max-texture-size [ <= ] 2all?
+: small-texture? ( dim -- ? )
+    max-texture-size [ <= ] 2all? ;
+
+: <texture> ( image loc dim -- texture )
+    pick dim>> small-texture?
     [ <single-texture> ]
-    [ [ max-texture-size tesselate ] dip <multi-texture> ] if ;
\ No newline at end of file
+    [ drop [ max-texture-size tesselate ] dip <multi-texture> ] if ;
\ No newline at end of file
index 27cba6d6e729b22a7e45bd01a31e25b5c2642edc..3b9739fb0f143dc6169b06dcfb972737d1de99b3 100755 (executable)
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays assocs byte-arrays io
 io.binary io.streams.string kernel math math.parser namespaces
-make parser prettyprint quotations sequences strings vectors
+make parser quotations sequences strings vectors
 words macros math.functions math.bitwise fry generalizations
 combinators.smart io.streams.byte-array io.encodings.binary
 math.vectors combinators multiline endian ;
diff --git a/basis/sorting/functor/authors.txt b/basis/sorting/functor/authors.txt
new file mode 100644 (file)
index 0000000..b4bd0e7
--- /dev/null
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file
diff --git a/basis/sorting/functor/functor.factor b/basis/sorting/functor/functor.factor
new file mode 100644 (file)
index 0000000..7f46af4
--- /dev/null
@@ -0,0 +1,16 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: functors kernel math.order sequences sorting ;
+IN: sorting.functor
+
+FUNCTOR: define-sorting ( NAME QUOT -- )
+
+NAME<=> DEFINES ${NAME}<=>
+NAME>=< DEFINES ${NAME}>=<
+
+WHERE
+
+: NAME<=> ( obj1 obj2 -- <=> ) QUOT bi@ <=> ;
+: NAME>=< ( obj1 obj2 -- >=< ) NAME<=> invert-comparison ;
+
+;FUNCTOR
index 5952b3e3f9fb21d0c1edd205416d99c8aea83904..4bb62b13132eeadd1129d280cfca672c6986754c 100644 (file)
@@ -25,46 +25,11 @@ HELP: human>=<
 }
 { $description "Compares two objects using the " { $link human<=> } " word and inverts the result." } ;
 
-HELP: human-compare
-{ $values
-     { "obj1" object } { "obj2" object } { "quot" quotation }
-     { "<=>" "an ordering specifier" }
-}
-{ $description "Compares the results of applying the quotation to both objects via <=>." } ;
-
-HELP: human-sort
-{ $values
-     { "seq" sequence }
-     { "seq'" sequence }
-}
-{ $description "Sorts a sequence of objects by comparing the magnitude of any integers in the input string using the <=> word." } ;
-
-HELP: human-sort-keys
-{ $values
-     { "seq" "an alist" }
-     { "sortedseq" "a new sorted sequence" }
-}
-{ $description "Sorts the elements comparing first elements of pairs using the " { $link human<=> } " word." } ;
-
-HELP: human-sort-values
-{ $values
-     { "seq" "an alist" }
-     { "sortedseq" "a new sorted sequence" }
-}
-{ $description "Sorts the elements comparing second elements of pairs using the " { $link human<=> } " word." } ;
-
-{ <=> >=< human-compare human-sort human-sort-keys human-sort-values } related-words
-
 ARTICLE: "sorting.human" "Human-friendly sorting"
 "The " { $vocab-link "sorting.human" } " vocabulary sorts by numbers as a human would -- by comparing their magnitudes -- rather than in a lexicographic way. For example, sorting a1, a10, a03, a2 with human sort returns a1, a2, a03, a10, while sorting with natural sort returns a03, a1, a10, a2." $nl
 "Comparing two objects:"
 { $subsection human<=> }
 { $subsection human>=< }
-{ $subsection human-compare }
-"Sort a sequence:"
-{ $subsection human-sort }
-{ $subsection human-sort-keys }
-{ $subsection human-sort-values }
 "Splitting a string into substrings and integers:"
 { $subsection find-numbers } ;
 
index 0e20b54c2f7460f0527454de279bc40f77896aec..519e0064b6d4b602d0fe3c333fcf7a6f76da8b45 100644 (file)
@@ -1,6 +1,6 @@
-USING: sorting.human tools.test ;
+USING: sorting.human tools.test sorting.slots ;
 IN: sorting.human.tests
 
 \ human-sort must-infer
 
-[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } human-sort ] unit-test
+[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } { human<=> } sort-by ] unit-test
index c07ed8758ba0e1d9cf947d502a34ff3bc8ad3fc0..b3dae45a9b87d26fd94d46ed04e9439be96a1ebd 100644 (file)
@@ -1,22 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: peg.ebnf math.parser kernel assocs sorting fry
-math.order sequences ascii splitting.monotonic ;
+USING: math.parser peg.ebnf sorting.functor ;
 IN: sorting.human
 
 : find-numbers ( string -- seq )
     [EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ;
 
-: human<=> ( obj1 obj2 -- <=> ) [ find-numbers ] bi@ <=> ;
-
-: human>=< ( obj1 obj2 -- >=< ) human<=> invert-comparison ; inline
-
-: human-compare ( obj1 obj2 quot -- <=> ) bi@ human<=> ; inline
-
-: human-sort ( seq -- seq' ) [ human<=> ] sort ;
-
-: human-sort-keys ( seq -- sortedseq )
-    [ [ first ] human-compare ] sort ;
-
-: human-sort-values ( seq -- sortedseq )
-    [ [ second ] human-compare ] sort ;
+<< "human" [ find-numbers ] define-sorting >>
index a3bdbf9ac1cbc880ac883eed136c091507484558..cc89d497e78202b7349e121e214dd3ee4e255042 100644 (file)
@@ -14,7 +14,7 @@ HELP: compare-slots
 HELP: sort-by-slots
 { $values
      { "seq" sequence } { "sort-specs" "a sequence of accessors ending with a comparator" }
-     { "seq'" sequence }
+     { "sortedseq" sequence }
 }
 { $description "Sorts a sequence of tuples by the sort-specs in " { $snippet "sort-spec" } ". A sort-spec is a sequence of slot accessors ending in a comparator." }
 { $examples
@@ -39,11 +39,20 @@ HELP: split-by-slots
 }
 { $description "Splits a sequence of tuples into a sequence of slices of tuples that have the same values in all slots in the accessor sequence. This word is only useful for splitting a sorted sequence, but is more efficient than partitioning in such a case." } ;
 
+HELP: sort-by
+{ $values
+    { "seq" sequence } { "sort-seq" "a sequence of comparators" }
+    { "sortedseq" sequence }
+}
+{ $description "Sorts a sequence by comparing elements by comparators, using subsequent comparators when there is a tie." } ;
+
 ARTICLE: "sorting.slots" "Sorting by slots"
 "The " { $vocab-link "sorting.slots" } " vocabulary can sort tuples by slot in ascending or descending order, using subsequent slots as tie-breakers." $nl
 "Comparing two objects by a sequence of slots:"
 { $subsection compare-slots }
-"Sorting a sequence by a sequence of slots:"
-{ $subsection sort-by-slots } ;
+"Sorting a sequence of tuples by a slot/comparator pairs:"
+{ $subsection sort-by-slots }
+"Sorting a sequence by a sequence of comparators:"
+{ $subsection sort-by } ;
 
 ABOUT: "sorting.slots"
index 46824c6fdb17d6738a364ac0070a7a60d810c5cd..83900461c3dfbe0255c209edc71399b981ae3e30 100644 (file)
@@ -1,7 +1,8 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors math.order sorting.slots tools.test
-sorting.human arrays sequences kernel assocs multiline ;
+sorting.human arrays sequences kernel assocs multiline
+sorting.functor ;
 IN: sorting.literals.tests
 
 TUPLE: sort-test a b c tuple2 ;
@@ -76,6 +77,9 @@ TUPLE: tuple2 d ;
 [ { } ]
 [ { } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots ] unit-test
 
+[ { } ]
+[ { } { } sort-by-slots ] unit-test
+
 [
     {
         T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 1 } } } }
@@ -143,3 +147,15 @@ TUPLE: tuple2 d ;
         T{ sort-test { a 5 } { tuple2 T{ tuple2 { d 4 } } } }
     } { { tuple2>> d>> } { a>> } } split-by-slots [ >array ] map
 ] unit-test
+
+
+[ { "a" "b" "c" } ] [ { "b" "c" "a" } { <=> <=> } sort-by ] unit-test
+[ { "b" "c" "a" } ] [ { "b" "c" "a" } { } sort-by ] unit-test
+
+<< "length-test" [ length ] define-sorting >>
+
+[ { { 1 } { 1 2 3 } { 1 3 2 } { 3 2 1 } } ]
+[
+    { { 3 2 1 } { 1 2 3 } { 1 3 2 } { 1 } }
+    { length-test<=> <=> } sort-by
+] unit-test
index 56b6a115f07350f505dfb588fc8176512a6ac68c..26458bb22cfeb847ce40528bd88ecf35cb1e3fee 100644 (file)
@@ -7,13 +7,16 @@ IN: sorting.slots
 
 <PRIVATE
 
+: short-circuit-comparator ( obj1 obj2 word --  comparator/? )
+    execute dup +eq+ eq? [ drop f ] when ;
+
 : slot-comparator ( seq -- quot )
     [
         but-last-slice
         [ '[ [ _ execute ] bi@ ] ] map concat
     ] [
         peek
-        '[ @ _ execute dup +eq+ eq? [ drop f ] when ]
+        '[ @ _ short-circuit-comparator ]
     ] bi ;
 
 PRIVATE>
@@ -22,9 +25,21 @@ MACRO: compare-slots ( sort-specs -- <=> )
     #! sort-spec: { accessors comparator }
     [ slot-comparator ] map '[ _ 2|| +eq+ or ] ;
 
-: sort-by-slots ( seq sort-specs -- seq' )
+: sort-by-slots ( seq sort-specs -- sortedseq )
     '[ _ compare-slots ] sort ;
 
+MACRO: compare-seq ( seq -- quot )
+    [ '[ _ short-circuit-comparator ] ] map '[ _ 2|| +eq+ or ] ;
+
+: sort-by ( seq sort-seq -- sortedseq )
+    '[ _ compare-seq ] sort ;
+
+: sort-keys-by ( seq sort-seq -- sortedseq )
+    '[ [ first ] bi@ _ compare-seq ] sort ;
+
+: sort-values-by ( seq sort-seq -- sortedseq )
+    '[ [ second ] bi@ _ compare-seq ] sort ;
+
 MACRO: split-by-slots ( accessor-seqs -- quot )
     [ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map
     '[ [ _ 2&& ] slice monotonic-slice ] ;
diff --git a/basis/sorting/title/authors.txt b/basis/sorting/title/authors.txt
new file mode 100644 (file)
index 0000000..b4bd0e7
--- /dev/null
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file
diff --git a/basis/sorting/title/title-tests.factor b/basis/sorting/title/title-tests.factor
new file mode 100644 (file)
index 0000000..65a58e4
--- /dev/null
@@ -0,0 +1,40 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test sorting.title sorting.slots ;
+IN: sorting.title.tests
+
+: sort-me ( -- seq )
+    {
+        "The Beatles"
+        "A river runs through it"
+        "Another"
+        "la vida loca"
+        "Basketball"
+        "racquetball"
+        "Los Fujis"
+        "los Fujis"
+        "La cucaracha"
+        "a day to remember"
+        "of mice and men"
+        "on belay"
+        "for the horde"
+    } ;
+[
+    {
+        "Another"
+        "Basketball"
+        "The Beatles"
+        "La cucaracha"
+        "a day to remember"
+        "for the horde"
+        "Los Fujis"
+        "los Fujis"
+        "of mice and men"
+        "on belay"
+        "racquetball"
+        "A river runs through it"
+        "la vida loca"
+    }
+] [
+    sort-me { title<=> } sort-by
+] unit-test
diff --git a/basis/sorting/title/title.factor b/basis/sorting/title/title.factor
new file mode 100644 (file)
index 0000000..dbdbf8a
--- /dev/null
@@ -0,0 +1,7 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: sorting.functor regexp kernel accessors sequences
+unicode.case ;
+IN: sorting.title
+
+<< "title" [ >lower dup R/ ^(the|a|an|el|la|los|las|il) / first-match [ to>> tail-slice ] when* ] define-sorting >>
index a38bb42c7efa5cad2089d20f899e703c492e7f55..c55e69a8a275fcda4af42d749345d63880cfad3d 100644 (file)
@@ -605,6 +605,8 @@ M: object infer-call*
 
 \ fflush { alien } { } define-primitive
 
+\ fseek { alien integer integer } { } define-primitive
+
 \ fclose { alien } { } define-primitive
 
 \ <wrapper> { object } { wrapper } define-primitive
index 11e2b8957b8ce96e2ae40b806a31c34e24a404ab..f753e38fb2bf8c3a1e3355d37670d684d085278c 100755 (executable)
@@ -42,11 +42,12 @@ IN: tools.deploy.macosx
 
 : create-app-dir ( vocab bundle-name -- vm )
     [
-        nip
-        [ copy-dll ]
-        [ copy-nib ]
-        [ "Contents/Resources" append-path make-directories ]
-        tri
+        nip {
+            [ copy-dll ]
+            [ copy-nib ]
+            [ "Contents/Resources" append-path make-directories ]
+            [ "Contents/Resources" copy-theme ]
+        } cleave
     ]
     [ create-app-plist ]
     [ "Contents/MacOS/" append-path copy-vm ] 2tri
index 8ee03930912ce96d0cea98c459ce477e4870dd09..79335fd0320ebf37ace7db5fab04693a7ec2e0e3 100755 (executable)
@@ -157,7 +157,8 @@ IN: tools.deploy.shaker
                 "specializer"
                 "step-into"
                 "step-into?"
-                "superclass"
+                ! UI needs this
+                ! "superclass"
                 "transform-n"
                 "transform-quot"
                 "tuple-dispatch-generic"
@@ -276,7 +277,6 @@ IN: tools.deploy.shaker
                 lexer-factory
                 print-use-hook
                 root-cache
-                vocab-roots
                 vocabs:dictionary
                 vocabs:load-vocab-hook
                 word
index bfa096ad2fb674ace677073a420d75b4f53a3ae0..f21f4ac363a83c3efc9a25f4a332e872ee8b2ab7 100755 (executable)
@@ -9,11 +9,6 @@ IN: tools.deploy.windows
 : copy-dll ( bundle-name -- )
     "resource:factor.dll" swap copy-file-into ;
 
-: copy-pango ( bundle-name -- )
-    "resource:build-support/dlls.txt" ascii file-lines
-    [ "resource:" prepend-path ] map
-    swap copy-files-into ;
-
 :: copy-vm ( executable bundle-name extension -- vm )
     vm "." split1-last drop extension append
     bundle-name executable ".exe" append append-path
@@ -22,9 +17,7 @@ IN: tools.deploy.windows
 : create-exe-dir ( vocab bundle-name -- vm )
     dup copy-dll
     deploy-ui? get [
-        [ copy-pango ]
-        [ "" copy-theme ]
-        [ ".exe" copy-vm ] tri
+        [ "" copy-theme ] [ ".exe" copy-vm ] bi
     ] [ ".com" copy-vm ] if ;
 
 M: winnt deploy*
index 80dd313e8543e9d913ef4ae71452eaccbe80184c..e405efb540d16f21ee39849e804d2c7c2a6690d8 100755 (executable)
@@ -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
@@ -433,12 +433,7 @@ M: windows-ui-backend do-events
     style 0 ex-style AdjustWindowRectEx win32-error=0/f ;
 
 : make-RECT ( world -- RECT )
-    [ window-loc>> dup ] [ dim>> ] bi v+
-    "RECT" <c-object>
-    over first over set-RECT-right
-    swap second over set-RECT-bottom
-    over first over set-RECT-left
-    swap second over set-RECT-top ;
+    [ window-loc>> ] [ dim>> ] bi <RECT> ;
 
 : default-position-RECT ( RECT -- )
     dup get-RECT-dimensions [ 2drop ] 2dip
@@ -501,35 +496,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 +520,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 ;
index f5b7f63d22bcb16ce17ad547755040dbc25894a9..3eb40a51353abbbcfa59509f6265a460aab25c61 100755 (executable)
@@ -141,7 +141,7 @@ M: editor ungraft*
 : scroll>caret ( editor -- )
     dup graft-state>> second [
         [
-            [ caret-loc ] [ caret-dim { 1 0 } v+ ] bi <rect>
+            [ caret-loc ] [ caret-dim { 2 1 } v+ ] bi <rect>
         ] keep scroll>rect
     ] [ drop ] if ;
 
index 80feb31ad2215f83d177491c59a77c2c0b80d839..b9fe10c530b83e71ce1265a1f8edb8a255d57732 100644 (file)
@@ -30,6 +30,9 @@ M: line-gadget line-height font>> font-metrics height>> ceiling ;
 : validate-line ( m gadget -- n )
     control-value [ drop f ] [ length 1- min 0 max ] if-empty ;
 
+: valid-line? ( n gadget -- ? )
+    control-value length 1- 0 swap between? ;
+
 : visible-line ( gadget quot -- n )
     '[
         [ clip get @ origin get [ second ] bi@ - ] dip
index 64e035c81bb505858741b5d73b4c5414f75a5008..a526cc618b7adb7506c820105daa94d46525392f 100644 (file)
@@ -54,10 +54,10 @@ M: viewport pref-dim* gadget-child pref-viewport-dim ;
     2dup control-value = [ 2drop ] [ set-control-value ] if ;
 
 : (scroll>rect) ( rect scroller -- )
-    [ [ loc>> ] [ dim>> { 1 1 } v+ ] bi <rect> ] dip
     {
         [ scroller-value vneg offset-rect ]
         [ viewport>> dim>> rect-min ]
+        [ viewport>> loc>> offset-rect ]
         [ viewport>> [ v- { 0 0 } vmin ] [ v- { 0 0 } vmax ] with-rect-extents v+ ]
         [ scroller-value v+ ]
         [ scroll ]
index f2ed5b10e0a5d520e64f8980a544ab4565d006eb..77249149aee11e97986ee9b95d05e5791c765d40 100644 (file)
@@ -268,12 +268,13 @@ M: table model-changed
 : mouse-row ( table -- n )
     [ hand-rel second ] keep y>line ;
 
+: if-mouse-row ( table true: ( table mouse-index -- ) false: ( table -- ) -- )
+    [ [ mouse-row ] keep 2dup valid-line? ]
+    [ ] [ '[ nip @ ] ] tri* if ; inline
+
 : table-button-down ( table -- )
     dup takes-focus?>> [ dup request-focus ] when
-    dup control-value empty? [ drop ] [
-        dup [ mouse-row ] keep validate-line
-        [ >>mouse-index ] [ (select-row) ] bi
-    ] if ;
+    [ swap [ >>mouse-index ] [ (select-row) ] bi ] [ drop ] if-mouse-row ;
 
 PRIVATE>
 
@@ -283,11 +284,14 @@ PRIVATE>
     [ 2drop ]
     if ;
 
+: row-action? ( table -- ? )
+    [ [ mouse-row ] keep valid-line? ]
+    [ single-click?>> hand-click# get 2 = or ] bi and ;
+
 <PRIVATE
 
 : table-button-up ( table -- )
-    dup single-click?>> hand-click# get 2 = or
-    [ row-action ] [ update-selected-value ] if ;
+    dup row-action? [ row-action ] [ update-selected-value ] if ;
 
 : select-row ( table n -- )
     over validate-line
@@ -320,13 +324,6 @@ PRIVATE>
 : next-page ( table -- )
     1 prev/next-page ;
 
-: valid-row? ( row table -- ? )
-    control-value length 1- 0 swap between? ;
-
-: if-mouse-row ( table true false -- )
-    [ [ mouse-row ] keep 2dup valid-row? ]
-    [ ] [ '[ nip @ ] ] tri* if ; inline
-
 : show-mouse-help ( table -- )
     [
         swap
old mode 100644 (file)
new mode 100755 (executable)
index 2b1caa8..8e36f2a
@@ -20,7 +20,7 @@ PRIVATE>
 
 : rendered-image ( path -- texture )
     world get image-texture-cache
-    [ cached-image { 0 0 } <texture> ] cache ;
+    [ cached-image [ { 0 0 } ] keep dim>> <texture> ] cache ;
 
 : draw-image ( image-name -- )
     rendered-image draw-texture ;
old mode 100644 (file)
new mode 100755 (executable)
index 3704189..404624d
@@ -10,9 +10,6 @@ IN: ui.text.core-text
 
 SINGLETON: core-text-renderer
 
-M: core-text-renderer init-text-rendering
-    <cache-assoc> >>text-handle drop ;
-
 M: core-text-renderer string-dim
     [ " " string-dim { 0 1 } v* ]
     [ cached-line dim>> ]
@@ -22,9 +19,11 @@ M: core-text-renderer flush-layout-cache
     cached-lines get purge-cache ;
 
 : rendered-line ( font string -- texture )
-    world get world-text-handle
-    [ cached-line [ image>> ] [ loc>> ] bi <texture> ]
-    2cache ;
+    world get world-text-handle [
+        cached-line
+        [ image>> ] [ loc>> ] [ image>> dim>> ] tri
+        <texture>
+    ] 2cache ;
 
 M: core-text-renderer draw-string ( font string -- )
     rendered-line draw-texture ;
index 017a4b2cf24d44a09d5c15883e01cd0ab403378e..46328d11d57f65c071f870ce947771ec94556c94 100755 (executable)
@@ -7,9 +7,6 @@ IN: ui.text.pango
 
 SINGLETON: pango-renderer
 
-M: pango-renderer init-text-rendering
-    <cache-assoc> >>text-handle drop ;
-
 M: pango-renderer string-dim
     [ " " string-dim { 0 1 } v* ]
     [ cached-layout logical-rect>> dim>> [ >integer ] map ] if-empty ;
@@ -18,9 +15,11 @@ M: pango-renderer flush-layout-cache
     cached-layouts get purge-cache ;
 
 : rendered-layout ( font string -- texture )
-    world get world-text-handle
-    [ cached-layout [ image>> ] [ text-position vneg ] bi <texture> ]
-    2cache ;
+    world get world-text-handle [
+        cached-layout
+        [ image>> ] [ text-position vneg ] [ image>> dim>> ] tri
+        <texture>
+    ] 2cache ;
 
 M: pango-renderer draw-string ( font string -- )
     rendered-layout draw-texture ;
diff --git a/basis/ui/text/pango/summary.txt b/basis/ui/text/pango/summary.txt
new file mode 100755 (executable)
index 0000000..0e2e18c
--- /dev/null
@@ -0,0 +1 @@
+UI text rendering implementation using cross-platform Pango library\r
old mode 100644 (file)
new mode 100755 (executable)
index 939e262..7ee901d
@@ -1,6 +1,22 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test ui.text fonts ;
+USING: tools.test ui.text fonts math accessors kernel sequences ;
 IN: ui.text.tests
 
-[ 0.0 ] [ 0 sans-serif-font "aaa" offset>x ] unit-test
+[ t ] [ 0 sans-serif-font "aaa" offset>x zero? ] unit-test
+[ t ] [ 1 sans-serif-font "aaa" offset>x 0.0 > ] unit-test
+[ t ] [ 3 sans-serif-font "aaa" offset>x 0.0 > ] unit-test
+[ t ] [ 1 monospace-font "a" offset>x 0.0 > ] unit-test
+[ 0 ] [ 0 sans-serif-font "aaa" x>offset ] unit-test
+[ 3 ] [ 100 sans-serif-font "aaa" x>offset ] unit-test
+[ 0 ] [ 0 sans-serif-font "" x>offset ] unit-test
+
+[ t ] [
+    sans-serif-font "aaa" line-metrics
+    [ [ ascent>> ] [ descent>> ] bi + ] [ height>> ] bi =
+] unit-test
+
+[ f ] [ sans-serif-font "\0a" text-dim first zero? ] unit-test
+[ t ] [ sans-serif-font "" text-dim first zero? ] unit-test
+
+[ f ] [ sans-serif-font font-metrics height>> zero? ] unit-test
old mode 100644 (file)
new mode 100755 (executable)
index ebf4b9c..d787fe8
@@ -1,17 +1,16 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel arrays sequences math math.order opengl opengl.gl
-strings fonts colors accessors namespaces ui.gadgets.worlds ;
+USING: kernel arrays sequences math math.order cache opengl
+opengl.gl strings fonts colors accessors namespaces
+ui.gadgets.worlds ;
 IN: ui.text
 
 <PRIVATE
 
 SYMBOL: font-renderer
 
-HOOK: init-text-rendering font-renderer ( world -- )
-
 : world-text-handle ( world -- handle )
-    dup text-handle>> [ dup init-text-rendering ] unless
+    dup text-handle>> [ <cache-assoc> >>text-handle ] unless
     text-handle>> ;
 
 HOOK: flush-layout-cache font-renderer ( -- )
@@ -79,7 +78,7 @@ USING: vocabs.loader namespaces system combinators ;
 "ui-backend" get [
     {
         { [ os macosx? ] [ "core-text" ] }
-        { [ os windows? ] [ "pango" ] }
+        { [ os windows? ] [ "uniscribe" ] }
         { [ os unix? ] [ "pango" ] }
     } cond
 ] unless* "ui.text." prepend require
\ No newline at end of file
diff --git a/basis/ui/text/uniscribe/authors.txt b/basis/ui/text/uniscribe/authors.txt
new file mode 100755 (executable)
index 0000000..56f4654
--- /dev/null
@@ -0,0 +1 @@
+Slava Pestov\r
diff --git a/basis/ui/text/uniscribe/summary.txt b/basis/ui/text/uniscribe/summary.txt
new file mode 100755 (executable)
index 0000000..6fe24d9
--- /dev/null
@@ -0,0 +1 @@
+UI text rendering implementation using the MS Windows Uniscribe library\r
diff --git a/basis/ui/text/uniscribe/tags.txt b/basis/ui/text/uniscribe/tags.txt
new file mode 100755 (executable)
index 0000000..6abe115
--- /dev/null
@@ -0,0 +1 @@
+unportable\r
diff --git a/basis/ui/text/uniscribe/uniscribe.factor b/basis/ui/text/uniscribe/uniscribe.factor
new file mode 100755 (executable)
index 0000000..dcec4ab
--- /dev/null
@@ -0,0 +1,42 @@
+! Copyright (C) 2009 Slava Pestov.\r
+! See http://factorcode.org/license.txt for BSD license.\r
+USING: accessors assocs cache kernel math math.vectors sequences fonts\r
+namespaces opengl.textures ui.text ui.text.private ui.gadgets.worlds \r
+windows.uniscribe ;\r
+IN: ui.text.uniscribe\r
+\r
+SINGLETON: uniscribe-renderer\r
+\r
+M: uniscribe-renderer string-dim\r
+    [ " " string-dim { 0 1 } v* ]\r
+    [ cached-script-string size>> ] if-empty ;\r
+\r
+M: uniscribe-renderer flush-layout-cache\r
+    cached-script-strings get purge-cache ;\r
+\r
+: rendered-script-string ( font string -- texture )\r
+    world get world-text-handle\r
+    [ cached-script-string [ image>> { 0 0 } ] [ size>> ] bi <texture> ]\r
+    2cache ;\r
+\r
+M: uniscribe-renderer draw-string ( font string -- )\r
+    dup dup selection? [ string>> ] when empty?\r
+    [ 2drop ] [ rendered-script-string draw-texture ] if ;\r
+\r
+M: uniscribe-renderer x>offset ( x font string -- n )\r
+    [ 2drop 0 ] [\r
+        cached-script-string x>line-offset 0 = [ 1+ ] unless\r
+    ] if-empty ;\r
+\r
+M: uniscribe-renderer offset>x ( n font string -- x )\r
+    [ 2drop 0 ] [ cached-script-string line-offset>x ] if-empty ;\r
+\r
+M: uniscribe-renderer font-metrics ( font -- metrics )\r
+    " " cached-script-string metrics>> clone f >>width ;\r
+\r
+M: uniscribe-renderer line-metrics ( font string -- metrics )\r
+    [ " " line-metrics clone 0 >>width ]\r
+    [ cached-script-string metrics>> 50 >>width 10 >>cap-height 10 >>x-height ]\r
+    if-empty ;\r
+\r
+uniscribe-renderer font-renderer set-global\r
index 022a2daabfc61d4a893aba29c90080ca7348b193..ba66121bc223cad84682107ce3e0c10a62527b36 100644 (file)
@@ -141,6 +141,7 @@ GENERIC# accept-completion-hook 1 ( item popup -- )
         t >>selection-required?
         t >>single-click?
         30 >>min-cols
+        10 >>min-rows
         10 >>max-rows
         dup '[ _ accept-completion ] >>action ;
 
diff --git a/basis/windows/fonts/fonts.factor b/basis/windows/fonts/fonts.factor
new file mode 100755 (executable)
index 0000000..a034856
--- /dev/null
@@ -0,0 +1,37 @@
+USING: assocs memoize locals kernel accessors init fonts math\r
+combinators windows 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-default ;\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
index 077adf1961bc75eb4731cf5d78c0777b4737925f..794aa0e32e17277fd1cfc92ab5263bc43838d84c 100755 (executable)
-! 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
+math.bitwise ;
 IN: windows.gdi32
 
-! Stock Logical Objects
-CONSTANT: WHITE_BRUSH         0
-CONSTANT: LTGRAY_BRUSH        1
-CONSTANT: GRAY_BRUSH          2
-CONSTANT: DKGRAY_BRUSH        3
-CONSTANT: BLACK_BRUSH         4
-CONSTANT: NULL_BRUSH          5
-ALIAS: HOLLOW_BRUSH        NULL_BRUSH
-CONSTANT: WHITE_PEN           6
-CONSTANT: BLACK_PEN           7
-CONSTANT: NULL_PEN            8
-CONSTANT: OEM_FIXED_FONT      10
-CONSTANT: ANSI_FIXED_FONT     11
-CONSTANT: ANSI_VAR_FONT       12
-CONSTANT: SYSTEM_FONT         13
+CONSTANT: BI_RGB 0
+CONSTANT: BI_RLE8 1
+CONSTANT: BI_RLE4 2
+CONSTANT: BI_BITFIELDS 3
+CONSTANT: BI_JPEG 4
+CONSTANT: BI_PNG 5
+CONSTANT: LF_FACESIZE 32
+CONSTANT: LF_FULLFACESIZE 64
+CONSTANT: CA_NEGATIVE 1
+CONSTANT: CA_LOG_FILTER 2
+CONSTANT: ILLUMINANT_DEVICE_DEFAULT 0
+CONSTANT: ILLUMINANT_A 1
+CONSTANT: ILLUMINANT_B 2
+CONSTANT: ILLUMINANT_C 3
+CONSTANT: ILLUMINANT_D50 4
+CONSTANT: ILLUMINANT_D55 5
+CONSTANT: ILLUMINANT_D65 6
+CONSTANT: ILLUMINANT_D75 7
+CONSTANT: ILLUMINANT_F2 8
+ALIAS: ILLUMINANT_MAX_INDEX ILLUMINANT_F2
+ALIAS: ILLUMINANT_TUNGSTEN ILLUMINANT_A
+ALIAS: ILLUMINANT_DAYLIGHT ILLUMINANT_C
+ALIAS: ILLUMINANT_FLUORESCENT ILLUMINANT_F2
+ALIAS: ILLUMINANT_NTSC ILLUMINANT_C
+CONSTANT: RGB_GAMMA_MIN 2500
+CONSTANT: RGB_GAMMA_MAX 65000
+CONSTANT: REFERENCE_WHITE_MIN 6000
+CONSTANT: REFERENCE_WHITE_MAX 10000
+CONSTANT: REFERENCE_BLACK_MIN 0
+CONSTANT: REFERENCE_BLACK_MAX 4000
+CONSTANT: COLOR_ADJ_MIN -100
+CONSTANT: COLOR_ADJ_MAX 100
+CONSTANT: CCHDEVICENAME 32
+CONSTANT: CCHFORMNAME 32
+CONSTANT: DI_COMPAT 4
+CONSTANT: DI_DEFAULTSIZE 8
+CONSTANT: DI_IMAGE 2
+CONSTANT: DI_MASK 1
+CONSTANT: DI_NORMAL 3
+CONSTANT: DI_APPBANDING 1
+CONSTANT: EMR_HEADER 1
+CONSTANT: EMR_POLYBEZIER 2
+CONSTANT: EMR_POLYGON 3
+CONSTANT: EMR_POLYLINE 4
+CONSTANT: EMR_POLYBEZIERTO 5
+CONSTANT: EMR_POLYLINETO 6
+CONSTANT: EMR_POLYPOLYLINE 7
+CONSTANT: EMR_POLYPOLYGON 8
+CONSTANT: EMR_SETWINDOWEXTEX 9
+CONSTANT: EMR_SETWINDOWORGEX 10
+CONSTANT: EMR_SETVIEWPORTEXTEX 11
+CONSTANT: EMR_SETVIEWPORTORGEX 12
+CONSTANT: EMR_SETBRUSHORGEX 13
+CONSTANT: EMR_EOF 14
+CONSTANT: EMR_SETPIXELV 15
+CONSTANT: EMR_SETMAPPERFLAGS 16
+CONSTANT: EMR_SETMAPMODE 17
+CONSTANT: EMR_SETBKMODE 18
+CONSTANT: EMR_SETPOLYFILLMODE 19
+CONSTANT: EMR_SETROP2 20
+CONSTANT: EMR_SETSTRETCHBLTMODE 21
+CONSTANT: EMR_SETTEXTALIGN 22
+CONSTANT: EMR_SETCOLORADJUSTMENT 23
+CONSTANT: EMR_SETTEXTCOLOR 24
+CONSTANT: EMR_SETBKCOLOR 25
+CONSTANT: EMR_OFFSETCLIPRGN 26
+CONSTANT: EMR_MOVETOEX 27
+CONSTANT: EMR_SETMETARGN 28
+CONSTANT: EMR_EXCLUDECLIPRECT 29
+CONSTANT: EMR_INTERSECTCLIPRECT 30
+CONSTANT: EMR_SCALEVIEWPORTEXTEX 31
+CONSTANT: EMR_SCALEWINDOWEXTEX 32
+CONSTANT: EMR_SAVEDC 33
+CONSTANT: EMR_RESTOREDC 34
+CONSTANT: EMR_SETWORLDTRANSFORM 35
+CONSTANT: EMR_MODIFYWORLDTRANSFORM 36
+CONSTANT: EMR_SELECTOBJECT 37
+CONSTANT: EMR_CREATEPEN 38
+CONSTANT: EMR_CREATEBRUSHINDIRECT 39
+CONSTANT: EMR_DELETEOBJECT 40
+CONSTANT: EMR_ANGLEARC 41
+CONSTANT: EMR_ELLIPSE 42
+CONSTANT: EMR_RECTANGLE 43
+CONSTANT: EMR_ROUNDRECT 44
+CONSTANT: EMR_ARC 45
+CONSTANT: EMR_CHORD 46
+CONSTANT: EMR_PIE 47
+CONSTANT: EMR_SELECTPALETTE 48
+CONSTANT: EMR_CREATEPALETTE 49
+CONSTANT: EMR_SETPALETTEENTRIES 50
+CONSTANT: EMR_RESIZEPALETTE 51
+CONSTANT: EMR_REALIZEPALETTE 52
+CONSTANT: EMR_EXTFLOODFILL 53
+CONSTANT: EMR_LINETO 54
+CONSTANT: EMR_ARCTO 55
+CONSTANT: EMR_POLYDRAW 56
+CONSTANT: EMR_SETARCDIRECTION 57
+CONSTANT: EMR_SETMITERLIMIT 58
+CONSTANT: EMR_BEGINPATH 59
+CONSTANT: EMR_ENDPATH 60
+CONSTANT: EMR_CLOSEFIGURE 61
+CONSTANT: EMR_FILLPATH 62
+CONSTANT: EMR_STROKEANDFILLPATH 63
+CONSTANT: EMR_STROKEPATH 64
+CONSTANT: EMR_FLATTENPATH 65
+CONSTANT: EMR_WIDENPATH 66
+CONSTANT: EMR_SELECTCLIPPATH 67
+CONSTANT: EMR_ABORTPATH 68
+CONSTANT: EMR_GDICOMMENT 70
+CONSTANT: EMR_FILLRGN 71
+CONSTANT: EMR_FRAMERGN 72
+CONSTANT: EMR_INVERTRGN 73
+CONSTANT: EMR_PAINTRGN 74
+CONSTANT: EMR_EXTSELECTCLIPRGN 75
+CONSTANT: EMR_BITBLT 76
+CONSTANT: EMR_STRETCHBLT 77
+CONSTANT: EMR_MASKBLT 78
+CONSTANT: EMR_PLGBLT 79
+CONSTANT: EMR_SETDIBITSTODEVICE 80
+CONSTANT: EMR_STRETCHDIBITS 81
+CONSTANT: EMR_EXTCREATEFONTINDIRECTW 82
+CONSTANT: EMR_EXTTEXTOUTA 83
+CONSTANT: EMR_EXTTEXTOUTW 84
+CONSTANT: EMR_POLYBEZIER16 85
+CONSTANT: EMR_POLYGON16 86
+CONSTANT: EMR_POLYLINE16 87
+CONSTANT: EMR_POLYBEZIERTO16 88
+CONSTANT: EMR_POLYLINETO16 89
+CONSTANT: EMR_POLYPOLYLINE16 90
+CONSTANT: EMR_POLYPOLYGON16 91
+CONSTANT: EMR_POLYDRAW16 92
+CONSTANT: EMR_CREATEMONOBRUSH 93
+CONSTANT: EMR_CREATEDIBPATTERNBRUSHPT 94
+CONSTANT: EMR_EXTCREATEPEN 95
+CONSTANT: EMR_POLYTEXTOUTA 96
+CONSTANT: EMR_POLYTEXTOUTW 97
+CONSTANT: EMR_SETICMMODE 98
+CONSTANT: EMR_CREATECOLORSPACE 99
+CONSTANT: EMR_SETCOLORSPACE 100
+CONSTANT: EMR_DELETECOLORSPACE 101
+CONSTANT: EMR_GLSRECORD 102
+CONSTANT: EMR_GLSBOUNDEDRECORD 103
+CONSTANT: EMR_PIXELFORMAT 104
+CONSTANT: ENHMETA_SIGNATURE 1179469088
+CONSTANT: EPS_SIGNATURE HEX: 46535045
+CONSTANT: FR_PRIVATE HEX: 10
+CONSTANT: FR_NOT_ENUM HEX: 20
+CONSTANT: META_SETBKCOLOR HEX: 201
+CONSTANT: META_SETBKMODE HEX: 102
+CONSTANT: META_SETMAPMODE HEX: 103
+CONSTANT: META_SETROP2 HEX: 104
+CONSTANT: META_SETRELABS HEX: 105
+CONSTANT: META_SETPOLYFILLMODE HEX: 106
+CONSTANT: META_SETSTRETCHBLTMODE HEX: 107
+CONSTANT: META_SETTEXTCHAREXTRA HEX: 108
+CONSTANT: META_SETTEXTCOLOR HEX: 209
+CONSTANT: META_SETTEXTJUSTIFICATION HEX: 20A
+CONSTANT: META_SETWINDOWORG HEX: 20B
+CONSTANT: META_SETWINDOWEXT HEX: 20C
+CONSTANT: META_SETVIEWPORTORG HEX: 20D
+CONSTANT: META_SETVIEWPORTEXT HEX: 20E
+CONSTANT: META_OFFSETWINDOWORG HEX: 20F
+CONSTANT: META_SCALEWINDOWEXT HEX: 410
+CONSTANT: META_OFFSETVIEWPORTORG HEX: 211
+CONSTANT: META_SCALEVIEWPORTEXT HEX: 412
+CONSTANT: META_LINETO HEX: 213
+CONSTANT: META_MOVETO HEX: 214
+CONSTANT: META_EXCLUDECLIPRECT HEX: 415
+CONSTANT: META_INTERSECTCLIPRECT HEX: 416
+CONSTANT: META_ARC HEX: 817
+CONSTANT: META_ELLIPSE HEX: 418
+CONSTANT: META_FLOODFILL HEX: 419
+CONSTANT: META_PIE HEX: 81A
+CONSTANT: META_RECTANGLE HEX: 41B
+CONSTANT: META_ROUNDRECT HEX: 61C
+CONSTANT: META_PATBLT HEX: 61D
+CONSTANT: META_SAVEDC HEX: 1E
+CONSTANT: META_SETPIXEL HEX: 41F
+CONSTANT: META_OFFSETCLIPRGN HEX: 220
+CONSTANT: META_TEXTOUT HEX: 521
+CONSTANT: META_BITBLT HEX: 922
+CONSTANT: META_STRETCHBLT HEX: b23
+CONSTANT: META_POLYGON HEX: 324
+CONSTANT: META_POLYLINE HEX: 325
+CONSTANT: META_ESCAPE HEX: 626
+CONSTANT: META_RESTOREDC HEX: 127
+CONSTANT: META_FILLREGION HEX: 228
+CONSTANT: META_FRAMEREGION HEX: 429
+CONSTANT: META_INVERTREGION HEX: 12A
+CONSTANT: META_PAINTREGION HEX: 12B
+CONSTANT: META_SELECTCLIPREGION HEX: 12C
+CONSTANT: META_SELECTOBJECT HEX: 12D
+CONSTANT: META_SETTEXTALIGN HEX: 12E
+CONSTANT: META_CHORD HEX: 830
+CONSTANT: META_SETMAPPERFLAGS HEX: 231
+CONSTANT: META_EXTTEXTOUT HEX: a32
+CONSTANT: META_SETDIBTODEV HEX: d33
+CONSTANT: META_SELECTPALETTE HEX: 234
+CONSTANT: META_REALIZEPALETTE HEX: 35
+CONSTANT: META_ANIMATEPALETTE HEX: 436
+CONSTANT: META_SETPALENTRIES HEX: 37
+CONSTANT: META_POLYPOLYGON HEX: 538
+CONSTANT: META_RESIZEPALETTE HEX: 139
+CONSTANT: META_DIBBITBLT HEX: 940
+CONSTANT: META_DIBSTRETCHBLT HEX: b41
+CONSTANT: META_DIBCREATEPATTERNBRUSH HEX: 142
+CONSTANT: META_STRETCHDIB HEX: f43
+CONSTANT: META_EXTFLOODFILL HEX: 548
+CONSTANT: META_DELETEOBJECT HEX: 1f0
+CONSTANT: META_CREATEPALETTE HEX: f7
+CONSTANT: META_CREATEPATTERNBRUSH HEX: 1F9
+CONSTANT: META_CREATEPENINDIRECT HEX: 2FA
+CONSTANT: META_CREATEFONTINDIRECT HEX: 2FB
+CONSTANT: META_CREATEBRUSHINDIRECT HEX: 2FC
+CONSTANT: META_CREATEREGION HEX: 6FF
+CONSTANT: ELF_VENDOR_SIZE 4
+CONSTANT: ELF_VERSION 0
+CONSTANT: ELF_CULTURE_LATIN 0
+CONSTANT: PFD_TYPE_RGBA 0
+CONSTANT: PFD_TYPE_COLORINDEX 1
+CONSTANT: PFD_MAIN_PLANE 0
+CONSTANT: PFD_OVERLAY_PLANE 1
+CONSTANT: PFD_UNDERLAY_PLANE -1
+CONSTANT: PFD_DOUBLEBUFFER 1
+CONSTANT: PFD_STEREO 2
+CONSTANT: PFD_DRAW_TO_WINDOW 4
+CONSTANT: PFD_DRAW_TO_BITMAP 8
+CONSTANT: PFD_SUPPORT_GDI 16
+CONSTANT: PFD_SUPPORT_OPENGL 32
+CONSTANT: PFD_GENERIC_FORMAT 64
+CONSTANT: PFD_NEED_PALETTE 128
+CONSTANT: PFD_NEED_SYSTEM_PALETTE HEX: 00000100
+CONSTANT: PFD_SWAP_EXCHANGE HEX: 00000200
+CONSTANT: PFD_SWAP_COPY HEX: 00000400
+CONSTANT: PFD_SWAP_LAYER_BUFFERS HEX: 00000800
+CONSTANT: PFD_GENERIC_ACCELERATED HEX: 00001000
+CONSTANT: PFD_DEPTH_DONTCARE HEX: 20000000
+CONSTANT: PFD_DOUBLEBUFFER_DONTCARE HEX: 40000000
+CONSTANT: PFD_STEREO_DONTCARE HEX: 80000000
+CONSTANT: SP_ERROR -1
+CONSTANT: SP_OUTOFDISK -4
+CONSTANT: SP_OUTOFMEMORY -5
+CONSTANT: SP_USERABORT -3
+CONSTANT: SP_APPABORT -2
+CONSTANT: BLACKNESS HEX: 00000042
+CONSTANT: NOTSRCERASE HEX: 001100A6
+CONSTANT: NOTSRCCOPY HEX: 00330008
+CONSTANT: SRCERASE HEX: 00440328
+CONSTANT: DSTINVERT HEX: 00550009
+CONSTANT: PATINVERT HEX: 005A0049
+CONSTANT: SRCINVERT HEX: 00660046
+CONSTANT: SRCAND HEX: 008800C6
+CONSTANT: MERGEPAINT HEX: 00BB0226
+CONSTANT: MERGECOPY HEX: 00C000CA
+CONSTANT: SRCCOPY HEX: 00CC0020
+CONSTANT: SRCPAINT HEX: 00EE0086
+CONSTANT: PATCOPY HEX: 00F00021
+CONSTANT: PATPAINT HEX: 00FB0A09
+CONSTANT: WHITENESS HEX: 00FF0062
+CONSTANT: CAPTUREBLT HEX: 40000000
+CONSTANT: NOMIRRORBITMAP HEX: 80000000
+CONSTANT: R2_BLACK 1
+CONSTANT: R2_COPYPEN 13
+CONSTANT: R2_MASKNOTPEN 3
+CONSTANT: R2_MASKPEN 9
+CONSTANT: R2_MASKPENNOT 5
+CONSTANT: R2_MERGENOTPEN 12
+CONSTANT: R2_MERGEPEN 15
+CONSTANT: R2_MERGEPENNOT 14
+CONSTANT: R2_NOP 11
+CONSTANT: R2_NOT 6
+CONSTANT: R2_NOTCOPYPEN 4
+CONSTANT: R2_NOTMASKPEN 8
+CONSTANT: R2_NOTMERGEPEN 2
+CONSTANT: R2_NOTXORPEN 10
+CONSTANT: R2_WHITE 16
+CONSTANT: R2_XORPEN 7
+CONSTANT: CM_OUT_OF_GAMUT 255
+CONSTANT: CM_IN_GAMUT 0
+CONSTANT: RGN_AND 1
+CONSTANT: RGN_COPY 5
+CONSTANT: RGN_DIFF 4
+CONSTANT: RGN_OR 2
+CONSTANT: RGN_XOR 3
+CONSTANT: NULLREGION 1
+CONSTANT: SIMPLEREGION 2
+CONSTANT: COMPLEXREGION 3
+CONSTANT: ERROR 0
+CONSTANT: CBM_INIT 4
+CONSTANT: DIB_PAL_COLORS 1
+CONSTANT: DIB_RGB_COLORS 0
+CONSTANT: FW_DONTCARE 0
+CONSTANT: FW_THIN 100
+CONSTANT: FW_EXTRALIGHT 200
+ALIAS: FW_ULTRALIGHT FW_EXTRALIGHT
+CONSTANT: FW_LIGHT 300
+CONSTANT: FW_NORMAL 400
+CONSTANT: FW_REGULAR 400
+CONSTANT: FW_MEDIUM 500
+CONSTANT: FW_SEMIBOLD 600
+ALIAS: FW_DEMIBOLD FW_SEMIBOLD
+CONSTANT: FW_BOLD 700
+CONSTANT: FW_EXTRABOLD 800
+ALIAS: FW_ULTRABOLD FW_EXTRABOLD
+CONSTANT: FW_HEAVY 900
+ALIAS: FW_BLACK FW_HEAVY
+CONSTANT: ANSI_CHARSET 0
+CONSTANT: DEFAULT_CHARSET 1
+CONSTANT: SYMBOL_CHARSET 2
+CONSTANT: SHIFTJIS_CHARSET 128
+CONSTANT: HANGEUL_CHARSET 129
+CONSTANT: HANGUL_CHARSET 129
+CONSTANT: GB2312_CHARSET 134
+CONSTANT: CHINESEBIG5_CHARSET 136
+CONSTANT: GREEK_CHARSET 161
+CONSTANT: TURKISH_CHARSET 162
+CONSTANT: HEBREW_CHARSET 177
+CONSTANT: ARABIC_CHARSET 178
+CONSTANT: BALTIC_CHARSET 186
+CONSTANT: RUSSIAN_CHARSET 204
+CONSTANT: THAI_CHARSET 222
+CONSTANT: EASTEUROPE_CHARSET 238
+CONSTANT: OEM_CHARSET 255
+CONSTANT: JOHAB_CHARSET 130
+CONSTANT: VIETNAMESE_CHARSET 163
+CONSTANT: MAC_CHARSET 77
+CONSTANT: OUT_DEFAULT_PRECIS 0
+CONSTANT: OUT_STRING_PRECIS 1
+CONSTANT: OUT_CHARACTER_PRECIS 2
+CONSTANT: OUT_STROKE_PRECIS 3
+CONSTANT: OUT_TT_PRECIS 4
+CONSTANT: OUT_DEVICE_PRECIS 5
+CONSTANT: OUT_RASTER_PRECIS 6
+CONSTANT: OUT_TT_ONLY_PRECIS 7
+CONSTANT: OUT_OUTLINE_PRECIS 8
+CONSTANT: CLIP_DEFAULT_PRECIS 0
+CONSTANT: CLIP_CHARACTER_PRECIS 1
+CONSTANT: CLIP_STROKE_PRECIS 2
+CONSTANT: CLIP_MASK 15
+CONSTANT: CLIP_LH_ANGLES 16
+CONSTANT: CLIP_TT_ALWAYS 32
+CONSTANT: CLIP_EMBEDDED 128
+CONSTANT: DEFAULT_QUALITY 0
+CONSTANT: DRAFT_QUALITY 1
+CONSTANT: PROOF_QUALITY 2
+CONSTANT: NONANTIALIASED_QUALITY 3
+CONSTANT: ANTIALIASED_QUALITY 4
+CONSTANT: DEFAULT_PITCH 0
+CONSTANT: FIXED_PITCH 1
+CONSTANT: VARIABLE_PITCH 2
+CONSTANT: MONO_FONT 8
+CONSTANT: FF_DECORATIVE 80
+CONSTANT: FF_DONTCARE 0
+CONSTANT: FF_MODERN 48
+CONSTANT: FF_ROMAN 16
+CONSTANT: FF_SCRIPT 64
+CONSTANT: FF_SWISS 32
+CONSTANT: PANOSE_COUNT 10
+CONSTANT: PAN_FAMILYTYPE_INDEX 0
+CONSTANT: PAN_SERIFSTYLE_INDEX 1
+CONSTANT: PAN_WEIGHT_INDEX 2
+CONSTANT: PAN_PROPORTION_INDEX 3
+CONSTANT: PAN_CONTRAST_INDEX 4
+CONSTANT: PAN_STROKEVARIATION_INDEX 5
+CONSTANT: PAN_ARMSTYLE_INDEX 6
+CONSTANT: PAN_LETTERFORM_INDEX 7
+CONSTANT: PAN_MIDLINE_INDEX 8
+CONSTANT: PAN_XHEIGHT_INDEX 9
+CONSTANT: PAN_CULTURE_LATIN 0
+CONSTANT: PAN_ANY 0
+CONSTANT: PAN_NO_FIT 1
+CONSTANT: PAN_FAMILY_TEXT_DISPLAY 2
+CONSTANT: PAN_FAMILY_SCRIPT 3
+CONSTANT: PAN_FAMILY_DECORATIVE 4
+CONSTANT: PAN_FAMILY_PICTORIAL 5
+CONSTANT: PAN_SERIF_COVE 2
+CONSTANT: PAN_SERIF_OBTUSE_COVE 3
+CONSTANT: PAN_SERIF_SQUARE_COVE 4
+CONSTANT: PAN_SERIF_OBTUSE_SQUARE_COVE 5
+CONSTANT: PAN_SERIF_SQUARE 6
+CONSTANT: PAN_SERIF_THIN 7
+CONSTANT: PAN_SERIF_BONE 8
+CONSTANT: PAN_SERIF_EXAGGERATED 9
+CONSTANT: PAN_SERIF_TRIANGLE 10
+CONSTANT: PAN_SERIF_NORMAL_SANS 11
+CONSTANT: PAN_SERIF_OBTUSE_SANS 12
+CONSTANT: PAN_SERIF_PERP_SANS 13
+CONSTANT: PAN_SERIF_FLARED 14
+CONSTANT: PAN_SERIF_ROUNDED 15
+CONSTANT: PAN_WEIGHT_VERY_LIGHT 2
+CONSTANT: PAN_WEIGHT_LIGHT 3
+CONSTANT: PAN_WEIGHT_THIN 4
+CONSTANT: PAN_WEIGHT_BOOK 5
+CONSTANT: PAN_WEIGHT_MEDIUM 6
+CONSTANT: PAN_WEIGHT_DEMI 7
+CONSTANT: PAN_WEIGHT_BOLD 8
+CONSTANT: PAN_WEIGHT_HEAVY 9
+CONSTANT: PAN_WEIGHT_BLACK 10
+CONSTANT: PAN_WEIGHT_NORD 11
+CONSTANT: PAN_PROP_OLD_STYLE 2
+CONSTANT: PAN_PROP_MODERN 3
+CONSTANT: PAN_PROP_EVEN_WIDTH 4
+CONSTANT: PAN_PROP_EXPANDED 5
+CONSTANT: PAN_PROP_CONDENSED 6
+CONSTANT: PAN_PROP_VERY_EXPANDED 7
+CONSTANT: PAN_PROP_VERY_CONDENSED 8
+CONSTANT: PAN_PROP_MONOSPACED 9
+CONSTANT: PAN_CONTRAST_NONE 2
+CONSTANT: PAN_CONTRAST_VERY_LOW 3
+CONSTANT: PAN_CONTRAST_LOW 4
+CONSTANT: PAN_CONTRAST_MEDIUM_LOW 5
+CONSTANT: PAN_CONTRAST_MEDIUM 6
+CONSTANT: PAN_CONTRAST_MEDIUM_HIGH 7
+CONSTANT: PAN_CONTRAST_HIGH 8
+CONSTANT: PAN_CONTRAST_VERY_HIGH 9
+CONSTANT: PAN_STROKE_GRADUAL_DIAG 2
+CONSTANT: PAN_STROKE_GRADUAL_TRAN 3
+CONSTANT: PAN_STROKE_GRADUAL_VERT 4
+CONSTANT: PAN_STROKE_GRADUAL_HORZ 5
+CONSTANT: PAN_STROKE_RAPID_VERT 6
+CONSTANT: PAN_STROKE_RAPID_HORZ 7
+CONSTANT: PAN_STROKE_INSTANT_VERT 8
+CONSTANT: PAN_STRAIGHT_ARMS_HORZ 2
+CONSTANT: PAN_STRAIGHT_ARMS_WEDGE 3
+CONSTANT: PAN_STRAIGHT_ARMS_VERT 4
+CONSTANT: PAN_STRAIGHT_ARMS_SINGLE_SERIF 5
+CONSTANT: PAN_STRAIGHT_ARMS_DOUBLE_SERIF 6
+CONSTANT: PAN_BENT_ARMS_HORZ 7
+CONSTANT: PAN_BENT_ARMS_WEDGE 8
+CONSTANT: PAN_BENT_ARMS_VERT 9
+CONSTANT: PAN_BENT_ARMS_SINGLE_SERIF 10
+CONSTANT: PAN_BENT_ARMS_DOUBLE_SERIF 11
+CONSTANT: PAN_LETT_NORMAL_CONTACT 2
+CONSTANT: PAN_LETT_NORMAL_WEIGHTED 3
+CONSTANT: PAN_LETT_NORMAL_BOXED 4
+CONSTANT: PAN_LETT_NORMAL_FLATTENED 5
+CONSTANT: PAN_LETT_NORMAL_ROUNDED 6
+CONSTANT: PAN_LETT_NORMAL_OFF_CENTER 7
+CONSTANT: PAN_LETT_NORMAL_SQUARE 8
+CONSTANT: PAN_LETT_OBLIQUE_CONTACT 9
+CONSTANT: PAN_LETT_OBLIQUE_WEIGHTED 10
+CONSTANT: PAN_LETT_OBLIQUE_BOXED 11
+CONSTANT: PAN_LETT_OBLIQUE_FLATTENED 12
+CONSTANT: PAN_LETT_OBLIQUE_ROUNDED 13
+CONSTANT: PAN_LETT_OBLIQUE_OFF_CENTER 14
+CONSTANT: PAN_LETT_OBLIQUE_SQUARE 15
+CONSTANT: PAN_MIDLINE_STANDARD_TRIMMED 2
+CONSTANT: PAN_MIDLINE_STANDARD_POINTED 3
+CONSTANT: PAN_MIDLINE_STANDARD_SERIFED 4
+CONSTANT: PAN_MIDLINE_HIGH_TRIMMED 5
+CONSTANT: PAN_MIDLINE_HIGH_POINTED 6
+CONSTANT: PAN_MIDLINE_HIGH_SERIFED 7
+CONSTANT: PAN_MIDLINE_CONSTANT_TRIMMED 8
+CONSTANT: PAN_MIDLINE_CONSTANT_POINTED 9
+CONSTANT: PAN_MIDLINE_CONSTANT_SERIFED 10
+CONSTANT: PAN_MIDLINE_LOW_TRIMMED 11
+CONSTANT: PAN_MIDLINE_LOW_POINTED 12
+CONSTANT: PAN_MIDLINE_LOW_SERIFED 13
+CONSTANT: PAN_XHEIGHT_CONSTANT_SMALL 2
+CONSTANT: PAN_XHEIGHT_CONSTANT_STD 3
+CONSTANT: PAN_XHEIGHT_CONSTANT_LARGE 4
+CONSTANT: PAN_XHEIGHT_DUCKING_SMALL 5
+CONSTANT: PAN_XHEIGHT_DUCKING_STD 6
+CONSTANT: PAN_XHEIGHT_DUCKING_LARGE 7
+CONSTANT: FS_LATIN1 1
+CONSTANT: FS_LATIN2 2
+CONSTANT: FS_CYRILLIC 4
+CONSTANT: FS_GREEK 8
+CONSTANT: FS_TURKISH 16
+CONSTANT: FS_HEBREW 32
+CONSTANT: FS_ARABIC 64
+CONSTANT: FS_BALTIC 128
+CONSTANT: FS_THAI HEX: 10000
+CONSTANT: FS_JISJAPAN HEX: 20000
+CONSTANT: FS_CHINESESIMP HEX: 40000
+CONSTANT: FS_WANSUNG HEX: 80000
+CONSTANT: FS_CHINESETRAD HEX: 100000
+CONSTANT: FS_JOHAB HEX: 200000
+CONSTANT: FS_SYMBOL HEX: 80000000
+CONSTANT: HS_BDIAGONAL 3
+CONSTANT: HS_CROSS 4
+CONSTANT: HS_DIAGCROSS 5
+CONSTANT: HS_FDIAGONAL 2
+CONSTANT: HS_HORIZONTAL 0
+CONSTANT: HS_VERTICAL 1
+CONSTANT: PS_GEOMETRIC 65536
+CONSTANT: PS_COSMETIC 0
+CONSTANT: PS_ALTERNATE 8
+CONSTANT: PS_SOLID 0
+CONSTANT: PS_DASH 1
+CONSTANT: PS_DOT 2
+CONSTANT: PS_DASHDOT 3
+CONSTANT: PS_DASHDOTDOT 4
+CONSTANT: PS_NULL 5
+CONSTANT: PS_USERSTYLE 7
+CONSTANT: PS_INSIDEFRAME 6
+CONSTANT: PS_ENDCAP_ROUND 0
+CONSTANT: PS_ENDCAP_SQUARE 256
+CONSTANT: PS_ENDCAP_FLAT 512
+CONSTANT: PS_JOIN_BEVEL 4096
+CONSTANT: PS_JOIN_MITER 8192
+CONSTANT: PS_JOIN_ROUND 0
+CONSTANT: PS_STYLE_MASK 15
+CONSTANT: PS_ENDCAP_MASK 3840
+CONSTANT: PS_TYPE_MASK 983040
+CONSTANT: ALTERNATE 1
+CONSTANT: WINDING 2
+CONSTANT: DC_BINNAMES 12
+CONSTANT: DC_BINS 6
+CONSTANT: DC_COPIES 18
+CONSTANT: DC_DRIVER 11
+CONSTANT: DC_DATATYPE_PRODUCED 21
+CONSTANT: DC_DUPLEX 7
+CONSTANT: DC_EMF_COMPLIANT 20
+CONSTANT: DC_ENUMRESOLUTIONS 13
+CONSTANT: DC_EXTRA 9
+CONSTANT: DC_FIELDS 1
+CONSTANT: DC_FILEDEPENDENCIES 14
+CONSTANT: DC_MAXEXTENT 5
+CONSTANT: DC_MINEXTENT 4
+CONSTANT: DC_ORIENTATION 17
+CONSTANT: DC_PAPERNAMES 16
+CONSTANT: DC_PAPERS 2
+CONSTANT: DC_PAPERSIZE 3
+CONSTANT: DC_SIZE 8
+CONSTANT: DC_TRUETYPE 15
+CONSTANT: DCTT_BITMAP 1
+CONSTANT: DCTT_DOWNLOAD 2
+CONSTANT: DCTT_SUBDEV 4
+CONSTANT: DCTT_DOWNLOAD_OUTLINE 8
+CONSTANT: DC_VERSION 10
+CONSTANT: DC_BINADJUST 19
+CONSTANT: DC_MANUFACTURER 23
+CONSTANT: DC_MODEL 24
+CONSTANT: DC_PERSONALITY 25
+CONSTANT: DC_PRINTRATE 26
+CONSTANT: DC_PRINTRATEUNIT 27
+CONSTANT: DC_PRINTERMEM 28
+CONSTANT: DC_MEDIAREADY 29
+CONSTANT: DC_STAPLE 30
+CONSTANT: DC_PRINTRATEPPM 31
+CONSTANT: DC_COLORDEVICE 32
+CONSTANT: DC_NUP 33
+CONSTANT: DC_MEDIATYPENAMES 34
+CONSTANT: DC_MEDIATYPES 35
+CONSTANT: DCBA_FACEUPNONE 0
+CONSTANT: DCBA_FACEUPCENTER 1
+CONSTANT: DCBA_FACEUPLEFT 2
+CONSTANT: DCBA_FACEUPRIGHT 3
+CONSTANT: DCBA_FACEDOWNNONE 256
+CONSTANT: DCBA_FACEDOWNCENTER 257
+CONSTANT: DCBA_FACEDOWNLEFT 258
+CONSTANT: DCBA_FACEDOWNRIGHT 259
+CONSTANT: FLOODFILLBORDER 0
+CONSTANT: FLOODFILLSURFACE 1
+CONSTANT: ETO_CLIPPED HEX: 0004
+CONSTANT: ETO_GLYPH_INDEX HEX: 0010
+CONSTANT: ETO_OPAQUE HEX: 0002
+CONSTANT: ETO_NUMERICSLATIN HEX: 0800
+CONSTANT: ETO_NUMERICSLOCAL HEX: 0400
+CONSTANT: ETO_RTLREADING HEX: 0080
+CONSTANT: ETO_IGNORELANGUAGE HEX: 1000
+CONSTANT: ETO_PDY HEX: 2000
+CONSTANT: GDICOMMENT_WINDOWS_METAFILE -2147483647
+CONSTANT: GDICOMMENT_BEGINGROUP 2
+CONSTANT: GDICOMMENT_ENDGROUP 3
+CONSTANT: GDICOMMENT_MULTIFORMATS 1073741828
+CONSTANT: GDICOMMENT_IDENTIFIER 1128875079
+CONSTANT: AD_COUNTERCLOCKWISE 1
+CONSTANT: AD_CLOCKWISE 2
+CONSTANT: RDH_RECTANGLES 1
+CONSTANT: GCPCLASS_LATIN 1
+CONSTANT: GCPCLASS_HEBREW 2
+CONSTANT: GCPCLASS_ARABIC 2
+CONSTANT: GCPCLASS_NEUTRAL 3
+CONSTANT: GCPCLASS_LOCALNUMBER 4
+CONSTANT: GCPCLASS_LATINNUMBER 5
+CONSTANT: GCPCLASS_LATINNUMERICTERMINATOR 6
+CONSTANT: GCPCLASS_LATINNUMERICSEPARATOR 7
+CONSTANT: GCPCLASS_NUMERICSEPARATOR 8
+CONSTANT: GCPCLASS_PREBOUNDLTR 128
+CONSTANT: GCPCLASS_PREBOUNDRTL 64
+CONSTANT: GCPCLASS_POSTBOUNDLTR 32
+CONSTANT: GCPCLASS_POSTBOUNDRTL 16
+CONSTANT: GCPGLYPH_LINKBEFORE HEX: 8000
+CONSTANT: GCPGLYPH_LINKAFTER HEX: 4000
+CONSTANT: DCB_DISABLE 8
+CONSTANT: DCB_ENABLE 4
+CONSTANT: DCB_RESET 1
+CONSTANT: DCB_SET 3
+CONSTANT: DCB_ACCUMULATE 2
+CONSTANT: DCB_DIRTY 2
+CONSTANT: OBJ_BRUSH 2
+CONSTANT: OBJ_PEN 1
+CONSTANT: OBJ_PAL 5
+CONSTANT: OBJ_FONT 6
+CONSTANT: OBJ_BITMAP 7
+CONSTANT: OBJ_EXTPEN 11
+CONSTANT: OBJ_REGION 8
+CONSTANT: OBJ_DC 3
+CONSTANT: OBJ_MEMDC 10
+CONSTANT: OBJ_METAFILE 9
+CONSTANT: OBJ_METADC 4
+CONSTANT: OBJ_ENHMETAFILE 13
+CONSTANT: OBJ_ENHMETADC 12
+CONSTANT: DRIVERVERSION 0
+CONSTANT: TECHNOLOGY 2
+CONSTANT: DT_PLOTTER 0
+CONSTANT: DT_RASDISPLAY 1
+CONSTANT: DT_RASPRINTER 2
+CONSTANT: DT_RASCAMERA 3
+CONSTANT: DT_CHARSTREAM 4
+CONSTANT: DT_METAFILE 5
+CONSTANT: DT_DISPFILE 6
+CONSTANT: HORZSIZE 4
+CONSTANT: VERTSIZE 6
+CONSTANT: HORZRES 8
+CONSTANT: VERTRES 10
+CONSTANT: LOGPIXELSX 88
+CONSTANT: LOGPIXELSY 90
+CONSTANT: BITSPIXEL 12
+CONSTANT: PLANES 14
+CONSTANT: NUMBRUSHES 16
+CONSTANT: NUMPENS 18
+CONSTANT: NUMFONTS 22
+CONSTANT: NUMCOLORS 24
+CONSTANT: NUMMARKERS 20
+CONSTANT: ASPECTX 40
+CONSTANT: ASPECTY 42
+CONSTANT: ASPECTXY 44
+CONSTANT: PDEVICESIZE 26
+CONSTANT: CLIPCAPS 36
+CONSTANT: SIZEPALETTE 104
+CONSTANT: NUMRESERVED 106
+CONSTANT: COLORRES 108
+CONSTANT: PHYSICALWIDTH 110
+CONSTANT: PHYSICALHEIGHT 111
+CONSTANT: PHYSICALOFFSETX 112
+CONSTANT: PHYSICALOFFSETY 113
+CONSTANT: SCALINGFACTORX 114
+CONSTANT: SCALINGFACTORY 115
+CONSTANT: VREFRESH 116
+CONSTANT: DESKTOPHORZRES 118
+CONSTANT: DESKTOPVERTRES 117
+CONSTANT: BLTALIGNMENT 119
+CONSTANT: SHADEBLENDCAPS 120
+CONSTANT: SB_NONE HEX: 00
+CONSTANT: SB_CONST_ALPHA HEX: 01
+CONSTANT: SB_PIXEL_ALPHA HEX: 02
+CONSTANT: SB_PREMULT_ALPHA HEX: 04
+CONSTANT: SB_GRAD_RECT HEX: 10
+CONSTANT: SB_GRAD_TRI HEX: 20
+CONSTANT: COLORMGMTCAPS 121
+CONSTANT: CM_NONE HEX: 00
+CONSTANT: CM_DEVICE_ICM HEX: 01
+CONSTANT: CM_GAMMA_RAMP HEX: 02
+CONSTANT: CM_CMYK_COLOR HEX: 04
+CONSTANT: RASTERCAPS 38
+CONSTANT: RC_BITBLT 1
+CONSTANT: RC_BITMAP64 8
+CONSTANT: RC_DI_BITMAP 128
+CONSTANT: RC_DIBTODEV 512
+CONSTANT: RC_FLOODFILL 4096
+CONSTANT: RC_STRETCHBLT 2048
+CONSTANT: RC_STRETCHDIB 8192
+CONSTANT: CURVECAPS 28
+CONSTANT: CC_NONE 0
+CONSTANT: CC_CIRCLES 1
+CONSTANT: CC_PIE 2
+CONSTANT: CC_CHORD 4
+CONSTANT: CC_ELLIPSES 8
+CONSTANT: CC_WIDE 16
+CONSTANT: CC_STYLED 32
+CONSTANT: CC_WIDESTYLED 64
+CONSTANT: CC_INTERIORS 128
+CONSTANT: CC_ROUNDRECT 256
+CONSTANT: LINECAPS 30
+CONSTANT: LC_NONE 0
+CONSTANT: LC_POLYLINE 2
+CONSTANT: LC_MARKER 4
+CONSTANT: LC_POLYMARKER 8
+CONSTANT: LC_WIDE 16
+CONSTANT: LC_STYLED 32
+CONSTANT: LC_WIDESTYLED 64
+CONSTANT: LC_INTERIORS 128
+CONSTANT: POLYGONALCAPS 32
+CONSTANT: RC_BANDING 2
+CONSTANT: RC_BIGFONT 1024
+CONSTANT: RC_DEVBITS HEX: 8000
+CONSTANT: RC_GDI20_OUTPUT 16
+CONSTANT: RC_GDI20_STATE 32
+CONSTANT: RC_NONE 0
+CONSTANT: RC_OP_DX_OUTPUT HEX: 4000
+CONSTANT: RC_PALETTE 256
+CONSTANT: RC_SAVEBITMAP 64
+CONSTANT: RC_SCALING 4
+CONSTANT: PC_NONE 0
+CONSTANT: PC_POLYGON 1
+CONSTANT: PC_POLYPOLYGON 256
+CONSTANT: PC_PATHS 512
+CONSTANT: PC_RECTANGLE 2
+CONSTANT: PC_WINDPOLYGON 4
+CONSTANT: PC_SCANLINE 8
+CONSTANT: PC_TRAPEZOID 4
+CONSTANT: PC_WIDE 16
+CONSTANT: PC_STYLED 32
+CONSTANT: PC_WIDESTYLED 64
+CONSTANT: PC_INTERIORS 128
+CONSTANT: TEXTCAPS 34
+CONSTANT: TC_OP_CHARACTER 1
+CONSTANT: TC_OP_STROKE 2
+CONSTANT: TC_CP_STROKE 4
+CONSTANT: TC_CR_90 8
+CONSTANT: TC_CR_ANY 16
+CONSTANT: TC_SF_X_YINDEP 32
+CONSTANT: TC_SA_DOUBLE 64
+CONSTANT: TC_SA_INTEGER 128
+CONSTANT: TC_SA_CONTIN 256
+CONSTANT: TC_EA_DOUBLE 512
+CONSTANT: TC_IA_ABLE 1024
+CONSTANT: TC_UA_ABLE 2048
+CONSTANT: TC_SO_ABLE 4096
+CONSTANT: TC_RA_ABLE 8192
+CONSTANT: TC_VA_ABLE 16384
+CONSTANT: TC_RESERVED 32768
+CONSTANT: TC_SCROLLBLT 65536
+CONSTANT: GCP_DBCS 1
+CONSTANT: GCP_ERROR HEX: 8000
+CONSTANT: GCP_CLASSIN HEX: 80000
+CONSTANT: GCP_DIACRITIC 256
+CONSTANT: GCP_DISPLAYZWG HEX: 400000
+CONSTANT: GCP_GLYPHSHAPE 16
+CONSTANT: GCP_JUSTIFY HEX: 10000
+CONSTANT: GCP_JUSTIFYIN HEX: 200000
+CONSTANT: GCP_KASHIDA 1024
+CONSTANT: GCP_LIGATE 32
+CONSTANT: GCP_MAXEXTENT HEX: 100000
+CONSTANT: GCP_NEUTRALOVERRIDE HEX: 2000000
+CONSTANT: GCP_NUMERICOVERRIDE HEX: 1000000
+CONSTANT: GCP_NUMERICSLATIN HEX: 4000000
+CONSTANT: GCP_NUMERICSLOCAL HEX: 8000000
+CONSTANT: GCP_REORDER 2
+CONSTANT: GCP_SYMSWAPOFF HEX: 800000
+CONSTANT: GCP_USEKERNING 8
+CONSTANT: FLI_GLYPHS HEX: 40000
+CONSTANT: FLI_MASK HEX: 103b
+CONSTANT: GGO_METRICS 0
+CONSTANT: GGO_BITMAP 1
+CONSTANT: GGO_NATIVE 2
+CONSTANT: GGO_BEZIER 3
+CONSTANT: GGO_GRAY2_BITMAP 4
+CONSTANT: GGO_GRAY4_BITMAP 5
+CONSTANT: GGO_GRAY8_BITMAP 6
+CONSTANT: GGO_GLYPH_INDEX 128
+CONSTANT: GGO_UNHINTED 256
+CONSTANT: GM_COMPATIBLE 1
+CONSTANT: GM_ADVANCED 2
+CONSTANT: MM_ANISOTROPIC 8
+CONSTANT: MM_HIENGLISH 5
+CONSTANT: MM_HIMETRIC 3
+CONSTANT: MM_ISOTROPIC 7
+CONSTANT: MM_LOENGLISH 4
+CONSTANT: MM_LOMETRIC 2
+CONSTANT: MM_TEXT 1
+CONSTANT: MM_TWIPS 6
+ALIAS: MM_MAX_FIXEDSCALE MM_TWIPS
+CONSTANT: ABSOLUTE 1
+CONSTANT: RELATIVE 2
+CONSTANT: PC_EXPLICIT 2
+CONSTANT: PC_NOCOLLAPSE 4
+CONSTANT: PC_RESERVED 1
+CONSTANT: CLR_NONE HEX: ffffffff
+ALIAS: CLR_INVALID CLR_NONE
+CONSTANT: CLR_DEFAULT HEX: ff000000
+CONSTANT: PT_MOVETO 6
+CONSTANT: PT_LINETO 2
+CONSTANT: PT_BEZIERTO 4
+CONSTANT: PT_CLOSEFIGURE 1
+CONSTANT: TT_AVAILABLE 1
+CONSTANT: TT_ENABLED 2
+CONSTANT: BLACK_BRUSH 4
+CONSTANT: DKGRAY_BRUSH 3
+CONSTANT: GRAY_BRUSH 2
+CONSTANT: HOLLOW_BRUSH 5
+CONSTANT: LTGRAY_BRUSH 1
+CONSTANT: NULL_BRUSH 5
+CONSTANT: WHITE_BRUSH 0
+CONSTANT: BLACK_PEN 7
+CONSTANT: NULL_PEN 8
+CONSTANT: WHITE_PEN 6
+CONSTANT: ANSI_FIXED_FONT 11
+CONSTANT: ANSI_VAR_FONT 12
 CONSTANT: DEVICE_DEFAULT_FONT 14
-CONSTANT: DEFAULT_PALETTE     15
-CONSTANT: SYSTEM_FIXED_FONT   16
-CONSTANT: DEFAULT_GUI_FONT    17
-CONSTANT: DC_BRUSH            18
-CONSTANT: DC_PEN              19
-                  
-CONSTANT: BI_RGB        0
-CONSTANT: BI_RLE8       1
-CONSTANT: BI_RLE4       2
-CONSTANT: BI_BITFIELDS  3
+CONSTANT: DEFAULT_GUI_FONT 17
+CONSTANT: OEM_FIXED_FONT 10
+CONSTANT: SYSTEM_FONT 13
+CONSTANT: SYSTEM_FIXED_FONT 16
+CONSTANT: DEFAULT_PALETTE 15
+CONSTANT: DC_BRUSH 18
+CONSTANT: DC_PEN 19
+CONSTANT: SYSPAL_ERROR 0
+CONSTANT: SYSPAL_STATIC 1
+CONSTANT: SYSPAL_NOSTATIC 2
+CONSTANT: SYSPAL_NOSTATIC256 3 
+CONSTANT: TA_BASELINE 24
+CONSTANT: TA_BOTTOM 8
+CONSTANT: TA_TOP 0
+CONSTANT: TA_CENTER 6
+CONSTANT: TA_LEFT 0
+CONSTANT: TA_RIGHT 2
+CONSTANT: TA_RTLREADING 256
+CONSTANT: TA_NOUPDATECP 0
+CONSTANT: TA_UPDATECP 1
+: TA_MASK ( -- n ) { TA_BASELINE TA_CENTER TA_UPDATECP TA_RTLREADING } flags ; foldable
+CONSTANT: VTA_BASELINE 24
+CONSTANT: VTA_CENTER 6
+ALIAS: VTA_LEFT TA_BOTTOM
+ALIAS: VTA_RIGHT TA_TOP
+ALIAS: VTA_BOTTOM TA_RIGHT
+ALIAS: VTA_TOP TA_LEFT
+CONSTANT: MWT_IDENTITY 1
+CONSTANT: MWT_LEFTMULTIPLY 2
+CONSTANT: MWT_RIGHTMULTIPLY 3
+CONSTANT: OPAQUE 2
+CONSTANT: TRANSPARENT 1
+CONSTANT: BLACKONWHITE 1
+CONSTANT: WHITEONBLACK 2
+CONSTANT: COLORONCOLOR 3
+CONSTANT: HALFTONE 4
+CONSTANT: MAXSTRETCHBLTMODE 4
+CONSTANT: STRETCH_ANDSCANS 1
+CONSTANT: STRETCH_DELETESCANS 3
+CONSTANT: STRETCH_HALFTONE 4
+CONSTANT: STRETCH_ORSCANS 2
+CONSTANT: TCI_SRCCHARSET 1
+CONSTANT: TCI_SRCCODEPAGE 2
+CONSTANT: TCI_SRCFONTSIG 3
+CONSTANT: ICM_ON 2
+CONSTANT: ICM_OFF 1
+CONSTANT: ICM_QUERY 3
+CONSTANT: NEWFRAME 1
+CONSTANT: ABORTDOC 2
+CONSTANT: NEXTBAND 3
+CONSTANT: SETCOLORTABLE 4
+CONSTANT: GETCOLORTABLE 5
+CONSTANT: FLUSHOUTPUT 6
+CONSTANT: DRAFTMODE 7
+CONSTANT: QUERYESCSUPPORT 8
+CONSTANT: SETABORTPROC 9
+CONSTANT: STARTDOC 10
+CONSTANT: ENDDOC 11
+CONSTANT: GETPHYSPAGESIZE 12
+CONSTANT: GETPRINTINGOFFSET 13
+CONSTANT: GETSCALINGFACTOR 14
+CONSTANT: MFCOMMENT 15
+CONSTANT: GETPENWIDTH 16
+CONSTANT: SETCOPYCOUNT 17
+CONSTANT: SELECTPAPERSOURCE 18
+CONSTANT: DEVICEDATA 19
+CONSTANT: PASSTHROUGH 19
+CONSTANT: GETTECHNOLGY 20
+CONSTANT: GETTECHNOLOGY 20
+CONSTANT: SETLINECAP 21
+CONSTANT: SETLINEJOIN 22
+CONSTANT: SETMITERLIMIT 23
+CONSTANT: BANDINFO 24
+CONSTANT: DRAWPATTERNRECT 25
+CONSTANT: GETVECTORPENSIZE 26
+CONSTANT: GETVECTORBRUSHSIZE 27
+CONSTANT: ENABLEDUPLEX 28
+CONSTANT: GETSETPAPERBINS 29
+CONSTANT: GETSETPRINTORIENT 30
+CONSTANT: ENUMPAPERBINS 31
+CONSTANT: SETDIBSCALING 32
+CONSTANT: EPSPRINTING 33
+CONSTANT: ENUMPAPERMETRICS 34
+CONSTANT: GETSETPAPERMETRICS 35
+CONSTANT: POSTSCRIPT_DATA 37
+CONSTANT: POSTSCRIPT_IGNORE 38
+CONSTANT: MOUSETRAILS 39
+CONSTANT: GETDEVICEUNITS 42
+CONSTANT: GETEXTENDEDTEXTMETRICS 256
+CONSTANT: GETEXTENTTABLE 257
+CONSTANT: GETPAIRKERNTABLE 258
+CONSTANT: GETTRACKKERNTABLE 259
+CONSTANT: EXTTEXTOUT 512
+CONSTANT: GETFACENAME 513
+CONSTANT: DOWNLOADFACE 514
+CONSTANT: ENABLERELATIVEWIDTHS 768
+CONSTANT: ENABLEPAIRKERNING 769
+CONSTANT: SETKERNTRACK 770
+CONSTANT: SETALLJUSTVALUES 771
+CONSTANT: SETCHARSET 772
+CONSTANT: STRETCHBLT 2048
+CONSTANT: GETSETSCREENPARAMS 3072
+CONSTANT: QUERYDIBSUPPORT 3073
+CONSTANT: BEGIN_PATH 4096
+CONSTANT: CLIP_TO_PATH 4097
+CONSTANT: END_PATH 4098
+CONSTANT: EXT_DEVICE_CAPS 4099
+CONSTANT: RESTORE_CTM 4100
+CONSTANT: SAVE_CTM 4101
+CONSTANT: SET_ARC_DIRECTION 4102
+CONSTANT: SET_BACKGROUND_COLOR 4103
+CONSTANT: SET_POLY_MODE 4104
+CONSTANT: SET_SCREEN_ANGLE 4105
+CONSTANT: SET_SPREAD 4106
+CONSTANT: TRANSFORM_CTM 4107
+CONSTANT: SET_CLIP_BOX 4108
+CONSTANT: SET_BOUNDS 4109
+CONSTANT: SET_MIRROR_MODE 4110
+CONSTANT: OPENCHANNEL 4110
+CONSTANT: DOWNLOADHEADER 4111
+CONSTANT: CLOSECHANNEL 4112
+CONSTANT: POSTSCRIPT_PASSTHROUGH 4115
+CONSTANT: ENCAPSULATED_POSTSCRIPT 4116
+CONSTANT: QDI_SETDIBITS 1
+CONSTANT: QDI_GETDIBITS 2
+CONSTANT: QDI_DIBTOSCREEN 4
+CONSTANT: QDI_STRETCHDIB 8
+CONSTANT: SP_NOTREPORTED HEX: 4000
+CONSTANT: PR_JOBSTATUS 0
+CONSTANT: ASPECT_FILTERING 1
+CONSTANT: BS_SOLID 0
+CONSTANT: BS_NULL 1
+CONSTANT: BS_HOLLOW 1
+CONSTANT: BS_HATCHED 2
+CONSTANT: BS_PATTERN 3
+CONSTANT: BS_INDEXED 4
+CONSTANT: BS_DIBPATTERN 5
+CONSTANT: BS_DIBPATTERNPT 6
+CONSTANT: BS_PATTERN8X8 7
+CONSTANT: BS_DIBPATTERN8X8 8
+CONSTANT: LCS_CALIBRATED_RGB 0
+CONSTANT: LCS_DEVICE_RGB 1
+CONSTANT: LCS_DEVICE_CMYK 2
+CONSTANT: LCS_GM_BUSINESS 1
+CONSTANT: LCS_GM_GRAPHICS 2
+CONSTANT: LCS_GM_IMAGES 4
+CONSTANT: RASTER_FONTTYPE 1
+CONSTANT: DEVICE_FONTTYPE 2
+CONSTANT: TRUETYPE_FONTTYPE 4
+CONSTANT: DMORIENT_PORTRAIT 1
+CONSTANT: DMORIENT_LANDSCAPE 2
+CONSTANT: DMPAPER_FIRST 1
+CONSTANT: DMPAPER_LETTER 1
+CONSTANT: DMPAPER_LETTERSMALL 2
+CONSTANT: DMPAPER_TABLOID 3
+CONSTANT: DMPAPER_LEDGER 4
+CONSTANT: DMPAPER_LEGAL 5
+CONSTANT: DMPAPER_STATEMENT 6
+CONSTANT: DMPAPER_EXECUTIVE 7
+CONSTANT: DMPAPER_A3 8
+CONSTANT: DMPAPER_A4 9
+CONSTANT: DMPAPER_A4SMALL 10
+CONSTANT: DMPAPER_A5 11
+CONSTANT: DMPAPER_B4 12
+CONSTANT: DMPAPER_B5 13
+CONSTANT: DMPAPER_FOLIO 14
+CONSTANT: DMPAPER_QUARTO 15
+CONSTANT: DMPAPER_10X14 16
+CONSTANT: DMPAPER_11X17 17
+CONSTANT: DMPAPER_NOTE 18
+CONSTANT: DMPAPER_ENV_9 19
+CONSTANT: DMPAPER_ENV_10 20
+CONSTANT: DMPAPER_ENV_11 21
+CONSTANT: DMPAPER_ENV_12 22
+CONSTANT: DMPAPER_ENV_14 23
+CONSTANT: DMPAPER_CSHEET 24
+CONSTANT: DMPAPER_DSHEET 25
+CONSTANT: DMPAPER_ESHEET 26
+CONSTANT: DMPAPER_ENV_DL 27
+CONSTANT: DMPAPER_ENV_C5 28
+CONSTANT: DMPAPER_ENV_C3 29
+CONSTANT: DMPAPER_ENV_C4 30
+CONSTANT: DMPAPER_ENV_C6 31
+CONSTANT: DMPAPER_ENV_C65 32
+CONSTANT: DMPAPER_ENV_B4 33
+CONSTANT: DMPAPER_ENV_B5 34
+CONSTANT: DMPAPER_ENV_B6 35
+CONSTANT: DMPAPER_ENV_ITALY 36
+CONSTANT: DMPAPER_ENV_MONARCH 37
+CONSTANT: DMPAPER_ENV_PERSONAL 38
+CONSTANT: DMPAPER_FANFOLD_US 39
+CONSTANT: DMPAPER_FANFOLD_STD_GERMAN 40
+CONSTANT: DMPAPER_FANFOLD_LGL_GERMAN 41
+CONSTANT: DMPAPER_ISO_B4 42
+CONSTANT: DMPAPER_JAPANESE_POSTCARD 43
+CONSTANT: DMPAPER_9X11 44
+CONSTANT: DMPAPER_10X11 45
+CONSTANT: DMPAPER_15X11 46
+CONSTANT: DMPAPER_ENV_INVITE 47
+CONSTANT: DMPAPER_RESERVED_48 48
+CONSTANT: DMPAPER_RESERVED_49 49
+CONSTANT: DMPAPER_LETTER_EXTRA 50
+CONSTANT: DMPAPER_LEGAL_EXTRA 51
+CONSTANT: DMPAPER_TABLOID_EXTRA 52
+CONSTANT: DMPAPER_A4_EXTRA 53
+CONSTANT: DMPAPER_LETTER_TRANSVERSE 54
+CONSTANT: DMPAPER_A4_TRANSVERSE 55
+CONSTANT: DMPAPER_LETTER_EXTRA_TRANSVERSE 56
+CONSTANT: DMPAPER_A_PLUS 57
+CONSTANT: DMPAPER_B_PLUS 58
+CONSTANT: DMPAPER_LETTER_PLUS 59
+CONSTANT: DMPAPER_A4_PLUS 60
+CONSTANT: DMPAPER_A5_TRANSVERSE 61
+CONSTANT: DMPAPER_B5_TRANSVERSE 62
+CONSTANT: DMPAPER_A3_EXTRA 63
+CONSTANT: DMPAPER_A5_EXTRA 64
+CONSTANT: DMPAPER_B5_EXTRA 65
+CONSTANT: DMPAPER_A2 66
+CONSTANT: DMPAPER_A3_TRANSVERSE 67
+CONSTANT: DMPAPER_A3_EXTRA_TRANSVERSE 68
+CONSTANT: DMPAPER_DBL_JAPANESE_POSTCARD 69
+CONSTANT: DMPAPER_A6 70
+CONSTANT: DMPAPER_JENV_KAKU2 71
+CONSTANT: DMPAPER_JENV_KAKU3 72
+CONSTANT: DMPAPER_JENV_CHOU3 73
+CONSTANT: DMPAPER_JENV_CHOU4 74
+CONSTANT: DMPAPER_LETTER_ROTATED 75
+CONSTANT: DMPAPER_A3_ROTATED 76
+CONSTANT: DMPAPER_A4_ROTATED 77
+CONSTANT: DMPAPER_A5_ROTATED 78
+CONSTANT: DMPAPER_B4_JIS_ROTATED 79
+CONSTANT: DMPAPER_B5_JIS_ROTATED 80
+CONSTANT: DMPAPER_JAPANESE_POSTCARD_ROTATED 81
+CONSTANT: DMPAPER_DBL_JAPANESE_POSTCARD_ROTATED 82
+CONSTANT: DMPAPER_A6_ROTATED 83
+CONSTANT: DMPAPER_JENV_KAKU2_ROTATED 84
+CONSTANT: DMPAPER_JENV_KAKU3_ROTATED 85
+CONSTANT: DMPAPER_JENV_CHOU3_ROTATED 86
+CONSTANT: DMPAPER_JENV_CHOU4_ROTATED 87
+CONSTANT: DMPAPER_B6_JIS 88
+CONSTANT: DMPAPER_B6_JIS_ROTATED 89
+CONSTANT: DMPAPER_12X11 90
+CONSTANT: DMPAPER_JENV_YOU4 91
+CONSTANT: DMPAPER_JENV_YOU4_ROTATED 92
+CONSTANT: DMPAPER_P16K 93
+CONSTANT: DMPAPER_P32K 94
+CONSTANT: DMPAPER_P32KBIG 95
+CONSTANT: DMPAPER_PENV_1 96
+CONSTANT: DMPAPER_PENV_2 97
+CONSTANT: DMPAPER_PENV_3 98
+CONSTANT: DMPAPER_PENV_4 99
+CONSTANT: DMPAPER_PENV_5 100
+CONSTANT: DMPAPER_PENV_6 101
+CONSTANT: DMPAPER_PENV_7 102
+CONSTANT: DMPAPER_PENV_8 103
+CONSTANT: DMPAPER_PENV_9 104
+CONSTANT: DMPAPER_PENV_10 105
+CONSTANT: DMPAPER_P16K_ROTATED 106
+CONSTANT: DMPAPER_P32K_ROTATED 107
+CONSTANT: DMPAPER_P32KBIG_ROTATED 108
+CONSTANT: DMPAPER_PENV_1_ROTATED 109
+CONSTANT: DMPAPER_PENV_2_ROTATED 110
+CONSTANT: DMPAPER_PENV_3_ROTATED 111
+CONSTANT: DMPAPER_PENV_4_ROTATED 112
+CONSTANT: DMPAPER_PENV_5_ROTATED 113
+CONSTANT: DMPAPER_PENV_6_ROTATED 114
+CONSTANT: DMPAPER_PENV_7_ROTATED 115
+CONSTANT: DMPAPER_PENV_8_ROTATED 116
+CONSTANT: DMPAPER_PENV_9_ROTATED 117
+CONSTANT: DMPAPER_PENV_10_ROTATED 118
+CONSTANT: DMPAPER_LAST 118
+CONSTANT: DMPAPER_USER 256
+CONSTANT: DMBIN_FIRST 1
+CONSTANT: DMBIN_UPPER 1
+CONSTANT: DMBIN_ONLYONE 1
+CONSTANT: DMBIN_LOWER 2
+CONSTANT: DMBIN_MIDDLE 3
+CONSTANT: DMBIN_MANUAL 4
+CONSTANT: DMBIN_ENVELOPE 5
+CONSTANT: DMBIN_ENVMANUAL 6
+CONSTANT: DMBIN_AUTO 7
+CONSTANT: DMBIN_TRACTOR 8
+CONSTANT: DMBIN_SMALLFMT 9
+CONSTANT: DMBIN_LARGEFMT 10
+CONSTANT: DMBIN_LARGECAPACITY 11
+CONSTANT: DMBIN_CASSETTE 14
+CONSTANT: DMBIN_FORMSOURCE 15
+CONSTANT: DMBIN_LAST 15
+CONSTANT: DMBIN_USER 256
+CONSTANT: DMRES_DRAFT -1
+CONSTANT: DMRES_LOW -2
+CONSTANT: DMRES_MEDIUM -3
+CONSTANT: DMRES_HIGH -4
+CONSTANT: DMCOLOR_MONOCHROME 1
+CONSTANT: DMCOLOR_COLOR 2
+CONSTANT: DMDUP_SIMPLEX 1
+CONSTANT: DMDUP_VERTICAL 2
+CONSTANT: DMDUP_HORIZONTAL 3
+CONSTANT: DMTT_BITMAP 1
+CONSTANT: DMTT_DOWNLOAD 2
+CONSTANT: DMTT_SUBDEV 3
+CONSTANT: DMTT_DOWNLOAD_OUTLINE 4
+CONSTANT: DMCOLLATE_FALSE 0
+CONSTANT: DMCOLLATE_TRUE 1
+CONSTANT: DM_SPECVERSION 800
+CONSTANT: DM_GRAYSCALE 1
+CONSTANT: DM_INTERLACED 2
+CONSTANT: DM_UPDATE 1
+CONSTANT: DM_COPY 2
+CONSTANT: DM_PROMPT 4
+CONSTANT: DM_MODIFY 8
+ALIAS: DM_IN_BUFFER DM_MODIFY
+ALIAS: DM_IN_PROMPT DM_PROMPT
+ALIAS: DM_OUT_BUFFER DM_COPY
+ALIAS: DM_OUT_DEFAULT DM_UPDATE
+CONSTANT: DM_ORIENTATION HEX: 00000001
+CONSTANT: DM_PAPERSIZE HEX: 00000002
+CONSTANT: DM_PAPERLENGTH HEX: 00000004
+CONSTANT: DM_PAPERWIDTH HEX: 00000008
+CONSTANT: DM_SCALE HEX: 00000010
+CONSTANT: DM_POSITION HEX: 00000020
+CONSTANT: DM_COPIES HEX: 00000100
+CONSTANT: DM_DEFAULTSOURCE HEX: 00000200
+CONSTANT: DM_PRINTQUALITY HEX: 00000400
+CONSTANT: DM_COLOR HEX: 00000800
+CONSTANT: DM_DUPLEX HEX: 00001000
+CONSTANT: DM_YRESOLUTION HEX: 00002000
+CONSTANT: DM_TTOPTION HEX: 00004000
+CONSTANT: DM_COLLATE HEX: 00008000
+CONSTANT: DM_FORMNAME HEX: 00010000
+CONSTANT: DM_LOGPIXELS HEX: 00020000
+CONSTANT: DM_BITSPERPEL HEX: 00040000
+CONSTANT: DM_PELSWIDTH HEX: 00080000
+CONSTANT: DM_PELSHEIGHT HEX: 00100000
+CONSTANT: DM_DISPLAYFLAGS HEX: 00200000
+CONSTANT: DM_DISPLAYFREQUENCY HEX: 00400000
+CONSTANT: DM_ICMMETHOD HEX: 00800000
+CONSTANT: DM_ICMINTENT HEX: 01000000
+CONSTANT: DM_MEDIATYPE HEX: 02000000
+CONSTANT: DM_DITHERTYPE HEX: 04000000
+CONSTANT: DM_PANNINGWIDTH HEX: 08000000
+CONSTANT: DM_PANNINGHEIGHT HEX: 10000000
+CONSTANT: DM_DISPLAYFIXEDOUTPUT HEX: 20000000
+CONSTANT: DM_DISPLAYORIENTATION HEX: 00000080
+CONSTANT: DMDO_DEFAULT HEX: 00000000
+CONSTANT: DMDO_90 HEX: 00000001
+CONSTANT: DMDO_180 HEX: 00000002
+CONSTANT: DMDO_270 HEX: 00000003
+CONSTANT: DMDFO_DEFAULT HEX: 00000000
+CONSTANT: DMDFO_STRETCH HEX: 00000001
+CONSTANT: DMDFO_CENTER HEX: 00000002
+CONSTANT: DMICMMETHOD_NONE 1
+CONSTANT: DMICMMETHOD_SYSTEM 2
+CONSTANT: DMICMMETHOD_DRIVER 3
+CONSTANT: DMICMMETHOD_DEVICE 4
+CONSTANT: DMICMMETHOD_USER 256
+CONSTANT: DMICM_SATURATE 1
+CONSTANT: DMICM_CONTRAST 2
+CONSTANT: DMICM_COLORMETRIC 3
+CONSTANT: DMICM_USER 256
+CONSTANT: DMMEDIA_STANDARD 1
+CONSTANT: DMMEDIA_TRANSPARENCY 2
+CONSTANT: DMMEDIA_GLOSSY 3
+CONSTANT: DMMEDIA_USER 256
+CONSTANT: DMDITHER_NONE 1
+CONSTANT: DMDITHER_COARSE 2
+CONSTANT: DMDITHER_FINE 3
+CONSTANT: DMDITHER_LINEART 4
+CONSTANT: DMDITHER_ERRORDIFFUSION 5
+CONSTANT: DMDITHER_RESERVED6 6
+CONSTANT: DMDITHER_RESERVED7 7
+CONSTANT: DMDITHER_RESERVED8 8
+CONSTANT: DMDITHER_RESERVED9 9
+CONSTANT: DMDITHER_GRAYSCALE 10
+CONSTANT: DMDITHER_USER 256
+CONSTANT: GDI_ERROR HEX: FFFFFFFF
+: HGDI_ERROR ( -- alien ) GDI_ERROR <alien> ; inline
+CONSTANT: TMPF_FIXED_PITCH 1
+CONSTANT: TMPF_VECTOR 2
+CONSTANT: TMPF_TRUETYPE 4
+CONSTANT: TMPF_DEVICE 8
+CONSTANT: NTM_ITALIC 1
+CONSTANT: NTM_BOLD 32
+CONSTANT: NTM_REGULAR 64
+CONSTANT: TT_POLYGON_TYPE 24
+CONSTANT: TT_PRIM_LINE 1
+CONSTANT: TT_PRIM_QSPLINE 2
+CONSTANT: TT_PRIM_CSPLINE 3 
+CONSTANT: FONTMAPPER_MAX 10
+CONSTANT: ENHMETA_STOCK_OBJECT HEX: 80000000
+CONSTANT: WGL_FONT_LINES 0
+CONSTANT: WGL_FONT_POLYGONS 1
+CONSTANT: LPD_DOUBLEBUFFER 1
+CONSTANT: LPD_STEREO 2
+CONSTANT: LPD_SUPPORT_GDI 16
+CONSTANT: LPD_SUPPORT_OPENGL 32
+CONSTANT: LPD_SHARE_DEPTH 64
+CONSTANT: LPD_SHARE_STENCIL 128
+CONSTANT: LPD_SHARE_ACCUM 256
+CONSTANT: LPD_SWAP_EXCHANGE 512
+CONSTANT: LPD_SWAP_COPY 1024
+CONSTANT: LPD_TRANSPARENT 4096
+CONSTANT: LPD_TYPE_RGBA 0
+CONSTANT: LPD_TYPE_COLORINDEX 1
+CONSTANT: WGL_SWAP_MAIN_PLANE 1
+CONSTANT: WGL_SWAP_OVERLAY1 2
+CONSTANT: WGL_SWAP_OVERLAY2 4
+CONSTANT: WGL_SWAP_OVERLAY3 8
+CONSTANT: WGL_SWAP_OVERLAY4 16
+CONSTANT: WGL_SWAP_OVERLAY5 32
+CONSTANT: WGL_SWAP_OVERLAY6 64
+CONSTANT: WGL_SWAP_OVERLAY7 128
+CONSTANT: WGL_SWAP_OVERLAY8 256
+CONSTANT: WGL_SWAP_OVERLAY9 512
+CONSTANT: WGL_SWAP_OVERLAY10 1024
+CONSTANT: WGL_SWAP_OVERLAY11 2048
+CONSTANT: WGL_SWAP_OVERLAY12 4096
+CONSTANT: WGL_SWAP_OVERLAY13 8192
+CONSTANT: WGL_SWAP_OVERLAY14 16384
+CONSTANT: WGL_SWAP_OVERLAY15 32768
+CONSTANT: WGL_SWAP_UNDERLAY1 65536
+CONSTANT: WGL_SWAP_UNDERLAY2 HEX: 20000
+CONSTANT: WGL_SWAP_UNDERLAY3 HEX: 40000
+CONSTANT: WGL_SWAP_UNDERLAY4 HEX: 80000
+CONSTANT: WGL_SWAP_UNDERLAY5 HEX: 100000
+CONSTANT: WGL_SWAP_UNDERLAY6 HEX: 200000
+CONSTANT: WGL_SWAP_UNDERLAY7 HEX: 400000
+CONSTANT: WGL_SWAP_UNDERLAY8 HEX: 800000
+CONSTANT: WGL_SWAP_UNDERLAY9 HEX: 1000000
+CONSTANT: WGL_SWAP_UNDERLAY10 HEX: 2000000
+CONSTANT: WGL_SWAP_UNDERLAY11 HEX: 4000000
+CONSTANT: WGL_SWAP_UNDERLAY12 HEX: 8000000
+CONSTANT: WGL_SWAP_UNDERLAY13 HEX: 10000000
+CONSTANT: WGL_SWAP_UNDERLAY14 HEX: 20000000
+CONSTANT: WGL_SWAP_UNDERLAY15 HEX: 40000000
+CONSTANT: AC_SRC_OVER HEX: 00
+CONSTANT: AC_SRC_ALPHA HEX: 01
+CONSTANT: AC_SRC_NO_PREMULT_ALPHA HEX: 01
+CONSTANT: AC_SRC_NO_ALPHA HEX: 02
+CONSTANT: AC_DST_NO_PREMULT_ALPHA HEX: 10
+CONSTANT: AC_DST_NO_ALPHA HEX: 20
+CONSTANT: LAYOUT_RTL 1
+CONSTANT: LAYOUT_BITMAPORIENTATIONPRESERVED 8
+CONSTANT: CS_ENABLE HEX: 00000001
+CONSTANT: CS_DISABLE HEX: 00000002
+CONSTANT: CS_DELETE_TRANSFORM HEX: 00000003
+CONSTANT: GRADIENT_FILL_RECT_H HEX: 00
+CONSTANT: GRADIENT_FILL_RECT_V HEX: 01
+CONSTANT: GRADIENT_FILL_TRIANGLE HEX: 02
+CONSTANT: GRADIENT_FILL_OP_FLAG HEX: ff
+CONSTANT: COLORMATCHTOTARGET_EMBEDED HEX: 00000001
+CONSTANT: CREATECOLORSPACE_EMBEDED HEX: 00000001
+CONSTANT: SETICMPROFILE_EMBEDED HEX: 00000001
 
-CONSTANT: DIB_RGB_COLORS 0
-CONSTANT: DIB_PAL_COLORS 1
+CONSTANT: DISPLAY_DEVICE_ATTACHED_TO_DESKTOP HEX: 00000001
+CONSTANT: DISPLAY_DEVICE_MULTI_DRIVER HEX: 00000002
+CONSTANT: DISPLAY_DEVICE_PRIMARY_DEVICE HEX: 00000004
+CONSTANT: DISPLAY_DEVICE_MIRRORING_DRIVER HEX: 00000008
+CONSTANT: DISPLAY_DEVICE_VGA_COMPATIBLE HEX: 00000010
+CONSTANT: DISPLAY_DEVICE_REMOVABLE HEX: 00000020
+CONSTANT: DISPLAY_DEVICE_MODESPRUNED HEX: 08000000
+
+CONSTANT: NTM_NONNEGATIVE_AC HEX: 00010000
+CONSTANT: NTM_PS_OPENTYPE HEX: 00020000
+CONSTANT: NTM_TT_OPENTYPE HEX: 00040000
+CONSTANT: NTM_MULTIPLEMASTER HEX: 00080000
+CONSTANT: NTM_TYPE1 HEX: 00100000
+CONSTANT: NTM_DSIG HEX: 00200000
+
+CONSTANT: GGI_MARK_NONEXISTING_GLYPHS 1
 
 LIBRARY: gdi32
 
+! FUNCTION: AbortDoc
 ! FUNCTION: AbortPath
 ! FUNCTION: AddFontMemResourceEx
 ! FUNCTION: AddFontResourceA
@@ -100,7 +1335,8 @@ FUNCTION: HBITMAP CreateDIBSection ( HDC hdc, BITMAPINFO* pbmi, UINT iUsage, voi
 ! FUNCTION: CreateFontIndirectExA
 ! FUNCTION: CreateFontIndirectExW
 ! FUNCTION: CreateFontIndirectW
-! FUNCTION: CreateFontW
+FUNCTION: HFONT CreateFontW ( int nHeight, int nWidth, int nEscapement, int nOrientation, int fnWeight, DWORD fdwItalic, DWORD fdwUnderline, DWORD fdwStrikeOut, DWORD fdwCharSet, DWORD fdwOutputPrecision, DWORD fdwClipPrecision, DWORD fdwQuality, DWORD fdwPitchAndFamily, LPCTSTR lpszFace ) ;
+ALIAS: CreateFont CreateFontW
 ! FUNCTION: CreateHalftonePalette
 ! FUNCTION: CreateHatchBrush
 ! FUNCTION: CreateICA
@@ -118,7 +1354,7 @@ FUNCTION: HRGN CreateRectRgn ( int x, int y, int w, int h ) ;
 ! FUNCTION: CreateRoundRectRgn
 ! FUNCTION: CreateScalableFontResourceA
 ! FUNCTION: CreateScalableFontResourceW
-! FUNCTION: CreateSolidBrush
+FUNCTION: HBRUSH CreateSolidBrush ( COLORREF colorref ) ;
 ! FUNCTION: DdEntry0
 ! FUNCTION: DdEntry1
 ! FUNCTION: DdEntry10
@@ -178,9 +1414,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
@@ -260,8 +1498,10 @@ FUNCTION: BOOL DeleteObject ( HGDIOBJ hObject ) ;
 ! FUNCTION: ExtFloodFill
 ! FUNCTION: ExtSelectClipRgn
 ! FUNCTION: ExtTextOutA
-! FUNCTION: ExtTextOutW
+FUNCTION: BOOL ExtTextOutW ( HDC hdc, int X, int Y, UINT fuOptions, RECT* lprc, LPCTSTR lpString, UINT cbCount, INT* lpDx ) ;
+ALIAS: ExtTextOut ExtTextOutW
 ! FUNCTION: FillPath
+FUNCTION: int FillRect ( HDC hDC, RECT* lprc, HBRUSH hbr ) ;
 ! FUNCTION: FillRgn
 ! FUNCTION: FixBrushOrgEx
 ! FUNCTION: FlattenPath
@@ -484,7 +1724,8 @@ FUNCTION: HGDIOBJ GetStockObject ( int fnObject ) ;
 ! FUNCTION: GetTextFaceAliasW
 ! FUNCTION: GetTextFaceW
 ! FUNCTION: GetTextMetricsA
-! FUNCTION: GetTextMetricsW
+FUNCTION: BOOL GetTextMetricsW ( HDC hdc, LPTEXTMETRIC lptm ) ;
+ALIAS: GetTextMetrics GetTextMetricsW
 ! FUNCTION: GetTransform
 ! FUNCTION: GetViewportExtEx
 ! FUNCTION: GetViewportOrgEx
@@ -539,7 +1780,7 @@ FUNCTION: HGDIOBJ GetStockObject ( int fnObject ) ;
 ! FUNCTION: PtVisible
 ! FUNCTION: QueryFontAssocStatus
 ! FUNCTION: RealizePalette
-! FUNCTION: Rectangle
+FUNCTION: BOOL Rectangle ( HDC hdc, int x, int y, int w, int h ) ;
 ! FUNCTION: RectInRegion
 ! FUNCTION: RectVisible
 ! FUNCTION: RemoveFontMemResourceEx
@@ -567,15 +1808,15 @@ FUNCTION: HGDIOBJ SelectObject ( HDC hdc, HGDIOBJ hgdiobj ) ;
 ! FUNCTION: SetBitmapAttributes
 ! FUNCTION: SetBitmapBits
 ! FUNCTION: SetBitmapDimensionEx
-! FUNCTION: SetBkColor
+FUNCTION: COLORREF SetBkColor ( HDC hdc, COLORREF color ) ;
 ! FUNCTION: SetBkMode
 ! FUNCTION: SetBoundsRect
 ! FUNCTION: SetBrushAttributes
 ! FUNCTION: SetBrushOrgEx
 ! FUNCTION: SetColorAdjustment
 ! FUNCTION: SetColorSpace
-! FUNCTION: SetDCBrushColor
-! FUNCTION: SetDCPenColor
+FUNCTION: COLORREF SetDCBrushColor ( HDC hdc, COLORREF color ) ;
+FUNCTION: COLORREF SetDCPenColor ( HDC hdc, COLORREF color ) ;
 ! FUNCTION: SetDeviceGammaRamp
 ! FUNCTION: SetDIBColorTable
 ! FUNCTION: SetDIBits
@@ -606,7 +1847,8 @@ FUNCTION: BOOL SetPixelFormat ( HDC hDC, int iPixelFormat, PFD* ppfd ) ;
 ! FUNCTION: SetSystemPaletteUse
 ! FUNCTION: SetTextAlign
 ! FUNCTION: SetTextCharacterExtra
-! FUNCTION: SetTextColor
+FUNCTION: COLORREF SetTextColor ( HDC hdc, COLORREF crColor ) ;
+! FUNCTION: SetTextColor ( HDC hDC, 
 ! FUNCTION: SetTextJustification
 ! FUNCTION: SetViewportExtEx
 ! FUNCTION: SetViewportOrgEx
diff --git a/basis/windows/offscreen/authors.txt b/basis/windows/offscreen/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/windows/offscreen/offscreen-tests.factor b/basis/windows/offscreen/offscreen-tests.factor
new file mode 100755 (executable)
index 0000000..5827397
--- /dev/null
@@ -0,0 +1,5 @@
+IN: windows.offscreen.tests\r
+USING: windows.offscreen effects tools.test kernel images ;\r
+\r
+{ 1 1 } [ [ [ ] make-bitmap-image ] with-memory-dc ] must-infer-as\r
+[ t ] [ [ { 10 10 } swap [ ] make-bitmap-image ] with-memory-dc image? ] unit-test\r
diff --git a/basis/windows/offscreen/offscreen.factor b/basis/windows/offscreen/offscreen.factor
new file mode 100755 (executable)
index 0000000..6e65958
--- /dev/null
@@ -0,0 +1,53 @@
+! 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 locals ;
+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-bitmap ( dim dc -- hBitmap bits )
+    [ nip ]
+    [
+        swap (bitmap-info) DIB_RGB_COLORS f <void*>
+        [ f 0 CreateDIBSection ] keep *void*
+    ] 2bi
+    [ [ SelectObject drop ] keep ] dip ;
+
+: make-offscreen-dc-and-bitmap ( dim -- dc hBitmap bits )
+    [ f CreateCompatibleDC ] dip over make-bitmap ;
+
+: 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
+        BGRX >>component-order
+        t >>upside-down? ;
+
+: with-memory-dc ( quot: ( hDC -- ) -- )
+    [ [ f CreateCompatibleDC &DeleteDC ] dip call ] with-destructors ; inline
+
+:: make-bitmap-image ( dim dc quot -- image )
+    dim dc make-bitmap [ &DeleteObject drop ] dip
+    quot dip
+    dim bitmap>image ; inline
\ No newline at end of file
diff --git a/basis/windows/offscreen/summary.txt b/basis/windows/offscreen/summary.txt
new file mode 100755 (executable)
index 0000000..dd70405
--- /dev/null
@@ -0,0 +1 @@
+Utility words for memory DCs and bitmaps\r
diff --git a/basis/windows/offscreen/tags.txt b/basis/windows/offscreen/tags.txt
new file mode 100755 (executable)
index 0000000..6abe115
--- /dev/null
@@ -0,0 +1 @@
+unportable\r
index ee74e47feaa223e86b7c1d2ba3dbb8417c4df412..20bae06f30d82fb872b9291c1ae81659bc6c2bf3 100755 (executable)
@@ -1,6 +1,7 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax namespaces kernel words ;
+USING: alien alien.c-types alien.syntax namespaces kernel words
+sequences math math.bitwise math.vectors colors ;
 IN: windows.types
 
 TYPEDEF: char                CHAR
@@ -244,14 +245,14 @@ C-STRUCT: RECT
     { "LONG" "right" }
     { "LONG" "bottom" } ;
 
-C-STRUCT: PAINTSTRUCT
-    { "HDC" " hdc" }
-    { "BOOL" "fErase" }
-    { "RECT" "rcPaint" }
-    { "BOOL" "fRestore" }
-    { "BOOL" "fIncUpdate" }
-    { "BYTE[32]" "rgbReserved" }
-;
+C-STRUCT: PAINTSTRUCT
+    { "HDC" " hdc" }
+    { "BOOL" "fErase" }
+    { "RECT" "rcPaint" }
+    { "BOOL" "fRestore" }
+    { "BOOL" "fIncUpdate" }
+    { "BYTE[32]" "rgbReserved" }
+;
 
 C-STRUCT: BITMAPINFOHEADER
     { "DWORD"  "biSize" }
@@ -283,6 +284,10 @@ C-STRUCT: POINT
     { "LONG" "x" }
     { "LONG" "y" } ; 
 
+C-STRUCT: SIZE
+    { "LONG" "cx" }
+    { "LONG" "cy" } ; 
+
 C-STRUCT: MSG
     { "HWND" "hWnd" }
     { "UINT" "message" }
@@ -327,6 +332,14 @@ C-STRUCT: RECT
     { "LONG" "right" }
     { "LONG" "bottom" } ;
 
+: <RECT> ( loc dim -- RECT )
+    over v+
+    "RECT" <c-object>
+    over first over set-RECT-right
+    swap second over set-RECT-bottom
+    over first over set-RECT-left
+    swap second over set-RECT-top ;
+
 TYPEDEF: RECT* PRECT
 TYPEDEF: RECT* LPRECT
 TYPEDEF: PIXELFORMATDESCRIPTOR PFD
@@ -363,3 +376,36 @@ C-STRUCT: ACCEL
     { "WORD" "key" }
     { "WORD" "cmd" } ;
 TYPEDEF: ACCEL* LPACCEL
+
+TYPEDEF: DWORD COLORREF
+TYPEDEF: DWORD* LPCOLORREF
+
+: RGB ( r g b -- COLORREF )
+    { 16 8 0 } bitfield ; inline
+
+: 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" } ;
+
+TYPEDEF: TEXTMETRICW* LPTEXTMETRIC
diff --git a/basis/windows/uniscribe/authors.txt b/basis/windows/uniscribe/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/windows/uniscribe/summary.txt b/basis/windows/uniscribe/summary.txt
new file mode 100755 (executable)
index 0000000..7b71cf1
--- /dev/null
@@ -0,0 +1 @@
+High-level wrapper around Uniscribe binding\r
diff --git a/basis/windows/uniscribe/tags.txt b/basis/windows/uniscribe/tags.txt
new file mode 100755 (executable)
index 0000000..6abe115
--- /dev/null
@@ -0,0 +1 @@
+unportable\r
diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor
new file mode 100755 (executable)
index 0000000..53d2d99
--- /dev/null
@@ -0,0 +1,118 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel assocs math sequences fry io.encodings.string
+io.encodings.utf16n accessors arrays combinators destructors locals
+cache namespaces init images.normalization fonts alien.c-types
+windows windows.usp10 windows.offscreen windows.gdi32
+windows.ole32 windows.types windows.fonts opengl.textures ;
+IN: windows.uniscribe
+
+TUPLE: script-string font string metrics ssa size image disposed ;
+
+: line-offset>x ( n script-string -- x )
+    2dup string>> length = [
+        ssa>> ! ssa
+        swap 1- ! icp
+        TRUE ! fTrailing
+    ] [
+        ssa>>
+        swap ! icp
+        FALSE ! fTrailing
+    ] if
+    0 <int> [ ScriptStringCPtoX ole32-error ] keep *int ;
+
+: x>line-offset ( x script-string -- n trailing )
+    ssa>> ! ssa
+    swap ! iX
+    0 <int> ! pCh
+    0 <int> ! piTrailing
+    [ ScriptStringXtoCP ole32-error ] 2keep [ *int ] bi@ ;
+
+<PRIVATE
+
+: make-script-string ( dc string -- script-string )
+    dup selection? [ string>> ] when
+    [ utf16n encode ] ! pString
+    [ length ] bi ! cString
+    dup 1.5 * 16 + >integer ! cGlyphs -- MSDN says this is "recommended size"
+    -1 ! iCharset -- Unicode
+    SSA_GLYPHS ! dwFlags
+    0 ! iReqWidth
+    f ! psControl
+    f ! psState
+    f ! piDx
+    f ! pTabdef
+    f ! pbInClass
+    f <void*> ! pssa
+    [ ScriptStringAnalyse ] keep
+    [ ole32-error ] [ |ScriptStringFree *void* ] bi* ;
+
+: set-dc-colors ( dc font -- )
+    [ background>> color>RGB SetBkColor drop ]
+    [ foreground>> color>RGB SetTextColor drop ] 2bi ;
+
+: selection-start/end ( script-string -- iMinSel iMaxSel )
+    string>> dup selection? [ [ start>> ] [ end>> ] bi ] [ drop 0 0 ] if ;
+
+: (draw-script-string) ( script-string -- )
+    [
+        ssa>> ! ssa
+        0 ! iX
+        0 ! iY
+        0 ! uOptions
+        f ! prc
+    ]
+    [ selection-start/end ] bi
+    ! iMinSel
+    ! iMaxSel
+    FALSE ! fDisabled
+    ScriptStringOut ole32-error ;
+
+: draw-script-string ( dc script-string -- )
+    [ font>> set-dc-colors ] keep (draw-script-string) ;
+
+: script-string-bitmap-size ( script-string -- dim )
+    size>> dup small-texture? [ [ next-power-of-2 ] map ] when ;
+
+:: make-script-string-image ( dc script-string -- image )
+    script-string script-string-bitmap-size dc
+    [ dc script-string draw-script-string ] make-bitmap-image ;
+
+: set-dc-font ( dc font -- )
+    cache-font SelectObject win32-error=0/f ;
+
+: script-string-size ( script-string -- dim )
+    ssa>> ScriptString_pSize
+    dup win32-error=0/f
+    [ SIZE-cx ] [ SIZE-cy ] bi 2array ;
+
+: dc-metrics ( dc -- metrics )
+    "TEXTMETRICW" <c-object>
+    [ GetTextMetrics drop ] keep
+    TEXTMETRIC>metrics ;
+
+: <script-string> ( font string -- script-string )
+    [ script-string new ] 2dip
+        [ >>font ] [ >>string ] bi*
+    [
+        {
+            [ over font>> set-dc-font ]
+            [ dc-metrics >>metrics ]
+            [ over string>> make-script-string >>ssa ]
+            [ drop dup script-string-size >>size ]
+            [ over make-script-string-image >>image ]
+        } cleave
+    ] with-memory-dc ;
+
+PRIVATE>
+
+M: script-string dispose*
+    ssa>> <void*> ScriptStringFree ole32-error ;
+
+SYMBOL: cached-script-strings
+
+: cached-script-string ( string font -- script-string )
+    cached-script-strings get-global [ <script-string> ] 2cache ;
+
+[ <cache-assoc> cached-script-strings set-global ]
+"windows.uniscribe" add-init-hook
\ No newline at end of file
index 64e5a60019e10f2fddb85f07aa7086eff1a4ef3b..50fa98996c7fe3fee90c7ba8f858002a87379a0d 100755 (executable)
@@ -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 ) ;
old mode 100644 (file)
new mode 100755 (executable)
index 44db355..902b1be
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.syntax alien.c-types alien.strings arrays
-combinators kernel math namespaces parser prettyprint sequences
+combinators kernel math namespaces parser sequences
 windows.errors windows.types windows.kernel32 words
 io.encodings.utf16n ;
 IN: windows
index 97d0cf6e9c2dc3f3aa6e3b970d4e86b5fc075063..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 100644 (file)
@@ -1,12 +0,0 @@
-libcairo-2.dll
-libgio-2.0-0.dll
-libglib-2.0-0.dll
-libgmodule-2.0-0.dll
-libgobject-2.0-0.dll
-libgthread-2.0-0.dll
-libpango-1.0-0.dll
-libpangocairo-1.0-0.dll
-libpangowin32-1.0-0.dll
-libpng12-0.dll
-libtiff3.dll
-zlib1.dll
index 61450dacb48121cb9f2128172632eccad610cc72..ad64c541fed6a694d40a0daec90ccb1f2b464e5b 100755 (executable)
@@ -445,16 +445,6 @@ get_url() {
     check_ret $DOWNLOADER
 }
 
-maybe_download_dlls() {
-    if [[ $OS == winnt ]] ; then
-       for file in `cat build-support/dlls.txt`; do
-           get_url http://factorcode.org/dlls/$file
-            chmod 777 *.dll
-            check_ret chmod
-       done
-    fi
-}
-
 get_config_info() {
     find_build_info
     check_installed_programs
@@ -472,7 +462,6 @@ install() {
     cd_factor
     make_factor
     get_boot_image
-    maybe_download_dlls
     bootstrap
 }
 
@@ -547,7 +536,6 @@ case "$1" in
     update) update; update_bootstrap ;;
     bootstrap) get_config_info; bootstrap ;;
     report) find_build_info ;;
-    dlls) get_config_info; maybe_download_dlls;;
     net-bootstrap) get_config_info; update_boot_images; bootstrap ;;
     make-target) ECHO=false; find_build_info; echo $MAKE_TARGET ;;
     *) usage ;;
index e3803f21500b14ddf6841862fb196c195ff26221..4466bd9bfe00aab5e50e3e90cc2e0150da143dde 100644 (file)
@@ -510,6 +510,7 @@ tuple
     { "fputc" "io.streams.c" (( ch alien -- )) }
     { "fwrite" "io.streams.c" (( string alien -- )) }
     { "fflush" "io.streams.c" (( alien -- )) }
+    { "fseek" "io.streams.c" (( alien offset whence -- )) }
     { "fclose" "io.streams.c" (( alien -- )) }
     { "<wrapper>" "kernel" (( obj -- wrapper )) }
     { "(clone)" "kernel" (( obj -- newobj )) }
index eb23a627b922acf2df727bf73df78f5dddfeb9c7..bec3bdc6bfab34682137fd8dde38c79514f8234d 100755 (executable)
@@ -1,11 +1,24 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private namespaces make io io.encodings
 sequences math generic threads.private classes io.backend
-io.files continuations destructors byte-arrays accessors ;
+io.files continuations destructors byte-arrays accessors
+combinators ;
 IN: io.streams.c
 
-TUPLE: c-writer handle disposed ;
+TUPLE: c-stream handle disposed ;
+
+M: c-stream dispose* handle>> fclose ;
+
+M: c-stream stream-seek
+    handle>> swap {
+        { seek-absolute [ 0 ] }
+        { seek-relative [ 1 ] }
+        { seek-end [ 2 ] }
+        [ bad-seek-type ]
+    } case fseek ;
+
+TUPLE: c-writer < c-stream ;
 
 : <c-writer> ( handle -- stream ) f c-writer boa ;
 
@@ -17,9 +30,7 @@ M: c-writer stream-write dup check-disposed handle>> fwrite ;
 
 M: c-writer stream-flush dup check-disposed handle>> fflush ;
 
-M: c-writer dispose* handle>> fclose ;
-
-TUPLE: c-reader handle disposed ;
+TUPLE: c-reader < c-stream ;
 
 : <c-reader> ( handle -- stream ) f c-reader boa ;
 
@@ -43,9 +54,6 @@ M: c-reader stream-read-until
     [ swap read-until-loop ] B{ } make swap
     over empty? over not and [ 2drop f f ] when ;
 
-M: c-reader dispose*
-    handle>> fclose ;
-
 M: c-io-backend init-io ;
 
 : stdin-handle ( -- alien ) 11 getenv ;
index fcb4dbd69d1654023e950a74506ee3168a215ee9..eeeb63dd7db86f61de4a72153f5b3d5f470a83d6 100755 (executable)
@@ -1,12 +1,15 @@
 USING: tools.deploy.config ;
-V{
-    { deploy-ui? t }
-    { deploy-io 1 }
-    { deploy-reflection 1 }
-    { deploy-compiler? t }
-    { deploy-math? t }
+H{
+    { deploy-name "Color Picker" }
     { deploy-word-props? f }
+    { deploy-ui? t }
+    { deploy-threads? t }
+    { deploy-unicode? f }
     { deploy-c-types? f }
+    { deploy-word-defs? f }
+    { deploy-compiler? t }
+    { deploy-io 2 }
+    { deploy-reflection 1 }
     { "stop-after-last-window?" t }
-    { deploy-name "Color Picker" }
+    { deploy-math? t }
 }
index 54b8c8fc69d28a1befb29ee7889803f629ed3c30..2196f1baaa1493ab4ce485548e9b0c0dac3439b6 100755 (executable)
@@ -127,11 +127,13 @@ TUPLE: link attributes clickable ;
         [ name>> "a" = ]
         [ attributes>> "href" swap key? ] bi and ] filter
     ] map sift
-    [ [ attributes>> "href" swap at ] map ] map concat ;
+    [ [ attributes>> "href" swap at ] map ] map concat
+    [ >url ] map ;
 
 : find-frame-links ( vector -- vector' )
     [ name>> "frame" = ] find-between-all
-    [ [ attributes>> "src" swap at ] map sift ] map concat sift ;
+    [ [ attributes>> "src" swap at ] map sift ] map concat sift
+    [ >url ] map ;
 
 : find-all-links ( vector -- vector' )
     [ find-hrefs ] [ find-frame-links ] bi append prune ;
index 75db1a373ecbea5bd56bbb156d96f09e27394831..c8a8a958921e284402a231493d15bc78549e020c 100644 (file)
@@ -99,3 +99,6 @@ IN: html.parser.state.tests
 
 [ "" ]
 [ "abc" <state-parser> dup "abc" take-sequence drop take-rest ] unit-test
+
+[ f ]
+[ "abc" <state-parser> "abcdefg" take-sequence ] unit-test
index 5f845ce8101954a24336960ec6a35128235e0216..2bcd08be5fbc1254fd187943557f87cd5c678960 100644 (file)
@@ -51,9 +51,16 @@ TUPLE: state-parser sequence n ;
 : take-while ( state-parser quot: ( obj -- ? ) -- sequence/f )
     [ not ] compose take-until ; inline
 
+: <safe-slice> ( from to seq -- slice/f )
+    3dup {
+        [ 2drop 0 < ]
+        [ [ drop ] 2dip length > ]
+        [ drop > ]
+    } 3|| [ 3drop f ] [ slice boa ] if ; inline
+
 :: take-sequence ( state-parser sequence -- obj/f )
-    state-parser [ n>> dup sequence length + ] [ sequence>> ] bi <slice>
-    sequence sequence= [
+    state-parser [ n>> dup sequence length + ] [ sequence>> ] bi
+    <safe-slice> sequence sequence= [
         sequence
         state-parser [ sequence length + ] change-n drop
     ] [
index 104360e1fa9aa01527d0152331066e9fcf486633..27bb42ed074ad465cda3cc4fefb2868ad39e8b4f 100644 (file)
@@ -32,3 +32,11 @@ USING: mason.child mason.config tools.test namespaces ;
         boot-cmd
     ] with-scope
 ] unit-test
+
+[ { "./factor.com" "-i=boot.x86.32.image" "-no-user-init" } ] [
+    [
+        "winnt" target-os set
+        "x86.32" target-cpu set
+        boot-cmd
+    ] with-scope
+] unit-test
old mode 100644 (file)
new mode 100755 (executable)
index 04c4a09..feb1193
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays calendar combinators.short-circuit
-continuations debugger http.client io.directories io.files io.launcher
+continuations debugger io.directories io.files io.launcher
 io.pathnames io.encodings.ascii kernel make mason.common mason.config
 mason.platform mason.report mason.email namespaces sequences ;
 IN: mason.child
@@ -9,20 +9,8 @@ IN: mason.child
 : make-cmd ( -- args )
     gnu-make platform 2array ;
 
-: dll-url ( -- url )
-    "http://factorcode.org/dlls/"
-    target-cpu get "x86.64" = [ "64/" append ] when ;
-
-: download-dlls ( -- )
-    target-os get "winnt" = [
-        dll-url "build-support/dlls.txt" ascii file-lines
-        [ append download ] with each
-    ] when ;
-
 : make-vm ( -- )
     "factor" [
-        download-dlls
-
         <process>
             make-cmd >>command
             "../compile-log" >>stdout
@@ -37,8 +25,11 @@ IN: mason.child
     builds-factor-image "." copy-file-into
     builds-factor-image "factor" copy-file-into ;
 
+: factor-vm ( -- string )
+    target-os get "winnt" = "./factor.com" "./factor" ? ;
+
 : boot-cmd ( -- cmd )
-    "./factor"
+    factor-vm
     "-i=" boot-image-name append
     "-no-user-init"
     3array ;
@@ -54,7 +45,7 @@ IN: mason.child
         try-process
     ] with-directory ;
 
-: test-cmd ( -- cmd ) { "./factor" "-run=mason.test" } ;
+: test-cmd ( -- cmd ) factor-vm "-run=mason.test" 2array ;
 
 : test ( -- )
     "factor" [
diff --git a/extra/spider/report/authors.txt b/extra/spider/report/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/extra/spider/report/report.factor b/extra/spider/report/report.factor
new file mode 100644 (file)
index 0000000..8bb4f91
--- /dev/null
@@ -0,0 +1,113 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs combinators kernel math
+math.statistics namespaces sequences sorting xml.syntax
+spider ;
+IN: spider.report
+
+SYMBOL: network-failures
+SYMBOL: broken-pages
+SYMBOL: timings
+
+: record-broken-page ( url spider-result -- )
+    headers>> [ code>> ] [ message>> ] bi 2array 2array
+    broken-pages push ;
+
+: record-page-timings ( url spider-result -- )
+    fetch-time>> 2array timings get push ;
+
+: record-network-failure ( url -- )
+    network-failures get push ;
+
+: process-result ( url spider-result -- )
+    {
+        { f [ record-network-failure ] }
+        [
+            dup headers>> code>> 200 =
+            [ record-page-timings ] [ record-broken-page ] if
+        ]
+    } case ;
+
+CONSTANT: slowest 5
+
+SYMBOL: slowest-pages
+SYMBOL: mean-time
+SYMBOL: median-time
+SYMBOL: time-std
+
+: process-timings ( -- )
+    timings get sort-values
+    [ slowest short tail* reverse slowest-pages set ]
+    [
+        values
+        [ mean 1000000 /f mean-time set ]
+        [ median 1000000 /f median-time set ]
+        [ std 1000000 /f time-std set ] tri
+    ] bi ;
+
+: process-results ( results -- )
+    V{ } clone network-failures set
+    V{ } clone broken-pages set
+    V{ } clone timings set
+    [ process-result ] assoc-each
+    process-timings ;
+
+: info-table ( alist -- html )
+    [
+        first2 dupd 1000000 /f
+        [XML
+        <tr><td><a href=<->><-></a></td><td><-> seconds</td></tr>
+        XML]
+    ] map [XML <table border="1"><-></table> XML] ;
+
+: report-broken-pages ( -- html )
+    broken-pages get info-table ;
+
+: report-network-failures ( -- html )
+    network-failures get [
+        dup [XML <li><a href=<->><-></a></li> XML]
+    ] map [XML <ul><-></ul> XML] ;
+
+: slowest-pages-table ( -- html )
+    slowest-pages get info-table ;
+
+: timing-summary-table ( -- html )
+    mean-time get
+    median-time get
+    time-std get
+    [XML
+    <table border="1">
+    <tr><th>Mean</th><td><-> seconds</td></tr>
+    <tr><th>Median</th><td><-> seconds</td></tr>
+    <tr><th>Standard deviation</th><td><-> seconds</td></tr>
+    </table>
+    XML] ;
+
+: report-timings ( -- html )
+    slowest-pages-table
+    timing-summary-table
+    [XML
+    <h2>Slowest pages</h2>
+    <->
+
+    <h2>Summary</h2>
+    <->
+    XML] ;
+
+: generate-report ( -- html )
+    report-broken-pages
+    report-network-failures
+    report-timings
+    [XML
+    <h1>Broken pages</h1>
+    <->
+
+    <h1>Network failures</h1>
+    <->
+
+    <h1>Load times</h1>
+    <->
+    XML] ;
+
+: spider-report ( spider -- html )
+    [ spidered>> process-results generate-report ] with-scope ;
index aeb4676767fae656cab4fa36d0928fb691bfe9d5..07989860ff2d0afb03e43b2fa2694a9d5b283f8e 100644 (file)
@@ -4,15 +4,15 @@ USING: accessors fry html.parser html.parser.analyzer
 http.client kernel tools.time sets assocs sequences
 concurrency.combinators io threads namespaces math multiline
 math.parser inspector urls logging combinators.short-circuit
-continuations calendar prettyprint dlists deques locals
-present ;
+continuations calendar prettyprint dlists deques locals ;
 IN: spider
 
 TUPLE: spider base count max-count sleep max-depth initial-links
-filters spidered todo nonmatching quiet currently-spidering ;
+filters spidered todo nonmatching quiet currently-spidering
+#threads follow-robots ;
 
-TUPLE: spider-result url depth headers fetch-time parsed-html
-links processing-time timestamp ;
+TUPLE: spider-result url depth headers
+fetched-in parsed-html links processed-in fetched-at ;
 
 TUPLE: todo-url url depth ;
 
@@ -51,7 +51,8 @@ TUPLE: unique-deque assoc deque ;
         0 >>max-depth
         0 >>count
         1/0. >>max-count
-        H{ } clone >>spidered ;
+        H{ } clone >>spidered
+        1 >>#threads ;
 
 <PRIVATE
 
@@ -79,12 +80,8 @@ TUPLE: unique-deque assoc deque ;
     [ add-nonmatching ]
     [ tuck [ apply-filters ] 2dip add-todo ] 2bi ;
 
-: url-absolute? ( url -- ? )
-    present "http://" head? ;
-
-: normalize-hrefs ( links spider -- links' )
-    currently-spidering>> present swap
-    [ dup url-absolute? [ derive-url ] [ url-append-path >url ] if ] with map ;
+: normalize-hrefs ( base links -- links' )
+    [ derive-url ] with map ;
 
 : print-spidering ( url depth -- )
     "depth: " write number>string write
@@ -94,7 +91,9 @@ TUPLE: unique-deque assoc deque ;
     f url spider spidered>> set-at
     [ url http-get ] benchmark :> fetch-time :> html :> headers
     [
-        html parse-html [ ] [ find-all-links spider normalize-hrefs ] bi
+        html parse-html
+        spider currently-spidering>>
+        over find-all-links normalize-hrefs
     ] benchmark :> processing-time :> links :> parsed-html
     url depth headers fetch-time parsed-html links processing-time
     now spider-result boa ;
@@ -107,11 +106,12 @@ TUPLE: unique-deque assoc deque ;
 
 \ spider-page ERROR add-error-logging
 
-: spider-sleep ( spider -- )
-    sleep>> [ sleep ] when* ;
+: spider-sleep ( spider -- ) sleep>> [ sleep ] when* ;
 
-:: queue-initial-links ( spider -- spider )
-    spider initial-links>> spider normalize-hrefs 0 spider add-todo spider ;
+: queue-initial-links ( spider -- )
+    [
+        [ currently-spidering>> ] [ initial-links>> ] bi normalize-hrefs 0
+    ] keep add-todo ;
 
 : spider-page? ( spider -- ? )
     {
@@ -121,7 +121,7 @@ TUPLE: unique-deque assoc deque ;
     } 1&& ;
 
 : setup-next-url ( spider -- spider url depth )
-    dup todo>> peek-url url>> present >>currently-spidering
+    dup todo>> peek-url url>> >>currently-spidering
     dup todo>> pop-url [ url>> ] [ depth>> ] bi ;
 
 : spider-next-page ( spider -- )
@@ -138,5 +138,5 @@ PRIVATE>
 
 : run-spider ( spider -- spider )
     "spider" [
-        queue-initial-links [ run-spider-loop ] keep
+        dup queue-initial-links [ run-spider-loop ] keep
     ] with-logging ;
index 4123a836750a8a32d1a8daa49c05c937299296b8..b9d68ffaeb48eaa9336c92003c6678de00e259f7 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: help.markup help.syntax kernel quotations ui.gadgets
-images.bitmap strings ui.gadgets.worlds ;
+images strings ui.gadgets.worlds ;
 IN: ui.offscreen
 
 HELP: <offscreen-world>
@@ -26,9 +26,9 @@ HELP: do-offscreen
 HELP: gadget>bitmap
 { $values
      { "gadget" gadget }
-     { "bitmap" bitmap }
+     { "image" image }
 }
-{ $description "Renders " { $snippet "gadget" } " to an " { $link offscreen-world } " and creates a " { $link bitmap } " from its contents." } ;
+{ $description "Renders " { $snippet "gadget" } " to an " { $link offscreen-world } " and creates an " { $link image } " from its contents." } ;
 
 HELP: offscreen-world
 { $class-description "The class of " { $link world } " objects that render to an offscreen buffer." } ;
@@ -36,9 +36,9 @@ HELP: offscreen-world
 HELP: offscreen-world>bitmap
 { $values
      { "world" offscreen-world }
-     { "bitmap" bitmap }
+     { "image" image }
 }
-{ $description "Saves a copy of the contents of " { $snippet "world" } " to a " { $link bitmap } " object." } ;
+{ $description "Saves a copy of the contents of " { $snippet "world" } " to a " { $link image } " object." } ;
 
 HELP: open-offscreen
 { $values
index cf9370ed7fa6b050fe9e373bf33124743f165445..8d197eb844e7eba490fdfbb93a862ffc4fb4c4ec 100755 (executable)
@@ -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 ;
+USING: accessors alien.c-types continuations images kernel math
+sequences ui.gadgets ui.gadgets.private ui.gadgets.worlds
+ui.private ui ui.backend destructors locals ;
 IN: ui.offscreen
 
 TUPLE: offscreen-world < world ;
@@ -19,18 +19,24 @@ M: offscreen-world ungraft*
 
 : open-offscreen ( gadget -- world )
     "" f <offscreen-world>
-    [ open-world-window dup relayout-1 ] keep
+    [ open-world-window ] [ relayout-1 ] [ ] tri
     notify-queued ;
 
 : close-offscreen ( world -- )
     ungraft notify-queued ;
 
-: offscreen-world>bitmap ( world -- bitmap )
-    offscreen-pixels bgra>bitmap ;
+:: bgrx>bitmap ( alien w h -- image )
+    <image>
+        { w h } >>dim
+        alien w h * 4 * memory>byte-array >>bitmap
+        BGRX >>component-order ;
+
+: offscreen-world>bitmap ( world -- image )
+    offscreen-pixels bgrx>bitmap ;
 
 : do-offscreen ( gadget quot: ( offscreen-world -- ) -- )
     [ open-offscreen ] dip
     over [ slip ] [ close-offscreen ] [ ] cleanup ; inline
 
-: gadget>bitmap ( gadget -- bitmap )
+: gadget>bitmap ( gadget -- image )
     [ offscreen-world>bitmap ] do-offscreen ;
index b796ebde9124cd1beac6a69bd42032703dbafcb2..46f6dcd8de25f6a27fec35e7dee247082d16f364 100644 (file)
@@ -1,3 +1,2 @@
-unportable
 ui
 graphics
index d9042c945563a854a3b149dc9df24ea554b72c25..9b5d3de6020bce406b977b227e72c31c56cdfa27 100755 (executable)
@@ -132,9 +132,7 @@ void init_factor(F_PARAMETERS *p)
        userenv[CPU_ENV] = tag_object(from_char_string(FACTOR_CPU_STRING));
        userenv[OS_ENV] = tag_object(from_char_string(FACTOR_OS_STRING));
        userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(CELL));
-       userenv[STACK_TRACES_ENV] = tag_boolean(p->stack_traces);
-       userenv[EXECUTABLE_ENV] = (p->executable_path ?
-               tag_object(from_native_string(p->executable_path)) : F);
+       userenv[EXECUTABLE_ENV] = (p->executable_path ? tag_object(from_native_string(p->executable_path)) : F);
        userenv[ARGS_ENV] = F;
        userenv[EMBEDDED_ENV] = F;
 
@@ -142,7 +140,10 @@ void init_factor(F_PARAMETERS *p)
        gc_off = false;
 
        if(!stage2)
+       {
+               userenv[STACK_TRACES_ENV] = tag_boolean(p->stack_traces);
                do_stage1_init();
+       }
 }
 
 /* May allocate memory */
diff --git a/vm/io.c b/vm/io.c
index bad4854775279ea82c276268c855af9f07237164..d88f1bab504aa205720e2054092b58c708c1db7a 100755 (executable)
--- a/vm/io.c
+++ b/vm/io.c
@@ -163,6 +163,31 @@ void primitive_fwrite(void)
        }
 }
 
+void primitive_fseek(void)
+{
+       int whence = to_fixnum(dpop());
+       FILE *file = unbox_alien();
+       off_t offset = to_signed_8(dpop());
+
+       switch(whence)
+       {
+       case 0: whence = SEEK_SET; break;
+       case 1: whence = SEEK_CUR; break;
+       case 2: whence = SEEK_END; break;
+       default:
+               critical_error("Bad value for whence",whence);
+               break;
+       }
+
+       if(FSEEK(file,offset,whence) == -1)
+       {
+               io_error();
+
+               /* Still here? EINTR */
+               critical_error("Don't know what to do; EINTR from fseek()?",0);
+       }
+}
+
 void primitive_fflush(void)
 {
        FILE *file = unbox_alien();
diff --git a/vm/io.h b/vm/io.h
index dc7d69edee84779afe941438946f7d0240890b3a..63a9c35490843993fc7c5fe32a52fdd7fc707563 100755 (executable)
--- a/vm/io.h
+++ b/vm/io.h
@@ -9,6 +9,7 @@ void primitive_fread(void);
 void primitive_fputc(void);
 void primitive_fwrite(void);
 void primitive_fflush(void);
+void primitive_fseek(void);
 void primitive_fclose(void);
 
 /* Platform specific primitives */
index d2f34b4bc4c26d50a1c419ce436619ac3c833d8e..35abfee41c66737d1eb3bb13958ac1ce6d491327 100755 (executable)
@@ -23,6 +23,8 @@ typedef char F_SYMBOL;
 #define STRNCMP strncmp
 #define STRDUP strdup
 
+#define FSEEK fseeko
+
 #define FIXNUM_FORMAT "%ld"
 #define CELL_FORMAT "%lu"
 #define CELL_HEX_FORMAT "%lx"
index 0704459dd0800996c2c1abff3a847d47a83737a8..36d350f50dc81f008008adbebb7833c430425ff3 100755 (executable)
@@ -20,6 +20,7 @@ typedef wchar_t F_CHAR;
 #define STRNCMP wcsncmp
 #define STRDUP _wcsdup
 #define MIN(a,b) ((a)>(b)?(b):(a))
+#define FSEEK fseek
 
 #ifdef WIN64
        #define CELL_FORMAT "%Iu"
index 00103ac0471c6bc31e2a369a2b5f8dc88271a53c..80b672d9d2d34d20a406bfcd4ffaf6ad6c7ef6bf 100755 (executable)
@@ -121,6 +121,7 @@ void *primitives[] = {
        primitive_fputc,
        primitive_fwrite,
        primitive_fflush,
+       primitive_fseek,
        primitive_fclose,
        primitive_wrapper,
        primitive_clone,