macosx.app: factor
mkdir -p $(BUNDLE)/Contents/MacOS
+ mkdir -p $(BUNDLE)/Contents/Frameworks
mv $(EXECUTABLE) $(BUNDLE)/Contents/MacOS/factor
ln -s Factor.app/Contents/MacOS/factor ./factor
- cp $(ENGINE) $(BUNDLE)/Contents/Frameworks
+ cp $(ENGINE) $(BUNDLE)/Contents/Frameworks/$(ENGINE)
install_name_tool \
-change libfactor.dylib \
$(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS)
factor-ffi-test: vm/ffi_test.o
- $(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(DLL_EXTENSION) $(TEST_OBJS)
+ $(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS)
clean:
rm -f vm/*.o
- rm -f factor*.dll libfactor.{a,so,dylib}
+ rm -f factor*.dll libfactor.{a,so,dylib} libfactor-ffi-test.{a,so,dylib}
vm/resources.o:
$(WINDRES) vm/factor.rs vm/resources.o
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.
! 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
<F-destructor> DEFINES <${F}-destructor>
&F DEFINES &${F}
|F DEFINES |${F}
+N [ F stack-effect out>> length ]
WHERE
: <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
ARTICLE: "alien.fortran-abis" "Fortran ABIs"
"Fortran does not have a standard ABI like C does. Factor supports the following Fortran ABIs:"
{ $list
- { { $subsection gfortran-abi } " is used by gfortran, the Fortran compiler included with GCC 4." }
- { { $subsection f2c-abi } " is used by the F2C Fortran-to-C translator and G77, the Fortran compiler included with GCC 3.x and earlier. It is also used by gfortran when compiling with the -ff2c flag." }
- { { $subsection intel-unix-abi } " is used by the Intel Fortran Compiler on Linux and Mac OS X." }
- { { $subsection intel-windows-abi } " is used by the Intel Fortran Compiler on Windows." }
+ { { $link gfortran-abi } " is used by gfortran, the Fortran compiler included with GCC 4." }
+ { { $link f2c-abi } " is used by the F2C Fortran-to-C translator and G77, the Fortran compiler included with GCC 3.x and earlier. It is also used by gfortran when compiling with the -ff2c flag." }
+ { { $link intel-unix-abi } " is used by the Intel Fortran Compiler on Linux and Mac OS X." }
+ { { $link intel-windows-abi } " is used by the Intel Fortran Compiler on Windows." }
}
"A library's ABI is specified when that library is opened by the " { $link add-fortran-library } " word." ;
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax io.streams.string assocs
-heaps.private ;
-IN: assoc-heaps
-
-HELP: <assoc-heap>
-{ $values { "assoc" assoc } { "heap" heap } { "assoc-heap" assoc-heap } }
-{ $description "Constructs a new " { $link assoc-heap } " from two existing data structures." } ;
-
-HELP: <unique-max-heap>
-{ $values { "unique-heap" assoc-heap } }
-{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a max-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ;
-
-HELP: <unique-min-heap>
-{ $values { "unique-heap" assoc-heap } }
-{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a min-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ;
-
-{ <unique-max-heap> <unique-min-heap> } related-words
-
-HELP: assoc-heap
-{ $description "A data structure containing an assoc and a heap to get certain properties with better time constraints at the expense of more space and complexity. For instance, a hashtable and a heap can be combined into one assoc-heap to get a sorted data structure with O(1) lookup. Operations on assoc-heap may update both the assoc and the heap or leave them out of sync if it's advantageous." } ;
-
-ARTICLE: "assoc-heaps" "Associative heaps"
-"The " { $vocab-link "assoc-heaps" } " vocabulary combines exists to synthesize data structures with better time properties than either of the two component data structures alone." $nl
-"Associative heap constructor:"
-{ $subsection <assoc-heap> }
-"Unique heaps:"
-{ $subsection <unique-min-heap> }
-{ $subsection <unique-max-heap> } ;
-
-ABOUT: "assoc-heaps"
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test assoc-heaps ;
-IN: assoc-heaps.tests
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs hashtables heaps kernel ;
-IN: assoc-heaps
-
-TUPLE: assoc-heap assoc heap ;
-
-C: <assoc-heap> assoc-heap
-
-: <unique-min-heap> ( -- unique-heap )
- H{ } clone <min-heap> <assoc-heap> ;
-
-: <unique-max-heap> ( -- unique-heap )
- H{ } clone <max-heap> <assoc-heap> ;
-
-M: assoc-heap heap-push* ( value key assoc-heap -- entry )
- pick over assoc>> key? [
- 3drop f
- ] [
- [ assoc>> swapd set-at ] [ heap>> heap-push* ] 3bi
- ] if ;
-
-M: assoc-heap heap-pop ( assoc-heap -- value key )
- heap>> heap-pop ;
-
-M: assoc-heap heap-peek ( assoc-heap -- value key )
- heap>> heap-peek ;
-
-M: assoc-heap heap-empty? ( assoc-heap -- value key )
- heap>> heap-empty? ;
+++ /dev/null
-Doug Coleman
\ No newline at end of file
+++ /dev/null
-Priority queue with fast insertion, removal of first element, and lookup of arbitrary elements by key
HELP: sorted-index
{ $values { "obj" object } { "seq" "a sorted sequence" } { "i" "an index, or " { $link f } } }
-{ $description "Outputs the index and value of the element closest to " { $snippet "elt" } " in the sequence. See " { $link search } " for details." }
+{ $description "Outputs the index of the element closest to " { $snippet "elt" } " in the sequence. See " { $link search } " for details." }
{ $notes "If the sequence has at least one element, this word always outputs a valid index, because it finds the closest match, not necessarily an exact one. In this respect its behavior differs from " { $link index } "." } ;
{ index index-from last-index last-index-from sorted-index } related-words
{ [ os unix? ] [ "x11" ] }
} cond
] unless* "ui.backend." prepend require
-
- "ui-text-backend" get [
- {
- { [ os macosx? ] [ "core-text" ] }
- { [ os windows? ] [ "pango" ] }
- { [ os unix? ] [ "pango" ] }
- } cond
- ] unless* "ui.text." prepend require
] when
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math math.functions namespaces sequences
-strings system vocabs.loader threads accessors combinators
-locals classes.tuple math.order summary combinators.short-circuit ;
+USING: accessors arrays classes.tuple combinators combinators.short-circuit
+ kernel locals math math.functions math.order namespaces sequences strings
+ summary system threads vocabs.loader ;
IN: calendar
HOOK: gmt-offset os ( -- hours minutes seconds )
GENERIC: leap-year? ( obj -- ? )
M: integer leap-year? ( year -- ? )
- dup 100 mod zero? 400 4 ? mod zero? ;
+ dup 100 divisor? 400 4 ? divisor? ;
M: timestamp leap-year? ( timestamp -- ? )
year>> leap-year? ;
#! good for any date since October 15, 1582
[
dup 2 <= [ [ 1- ] [ 12 + ] bi* ] when
- [ dup [ 4 /i + ] keep [ 100 /i - ] keep 400 /i + ] dip
+ [ dup [ 4 /i + ] [ 100 /i - ] [ 400 /i + ] tri ] dip
[ 1+ 3 * 5 /i + ] keep 2 * +
] dip 1+ + 7 mod ;
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax io kernel namespaces core-foundation
core-foundation.strings cocoa.messages cocoa cocoa.classes
-cocoa.runtime sequences threads init summary kernel.private
+cocoa.runtime sequences init summary kernel.private
assocs ;
IN: cocoa.application
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 ] ;
V{ } clone literal-table set
V{ } clone calls set
compiling-word set
- compiled-stack-traces? compiling-word get f ? add-literal ;
+ compiled-stack-traces? [ compiling-word get add-literal ] when ;
: generate ( mr -- asm )
[
<<
: libfactor-ffi-tests-path ( -- string )
- "resource:" normalize-path
+ "resource:" (normalize-path)
{
{ [ os winnt? ] [ "libfactor-ffi-test.dll" ] }
{ [ os macosx? ] [ "libfactor-ffi-test.dylib" ] }
- { [ os unix? ] [ "libfactor-ffi-test.a" ] }
+ { [ os unix? ] [ "libfactor-ffi-test.so" ] }
} cond append-path ;
"f-cdecl" libfactor-ffi-tests-path "cdecl" add-library
\ clone [
in-d>> first value-info literal>> {
{ V{ } [ [ drop { } 0 vector boa ] ] }
- { H{ } [ [ drop hashtable new ] ] }
+ { H{ } [ [ drop 0 <hashtable> ] ] }
[ drop f ]
} case
] "custom-inlining" set-word-prop
]\r
] dip later ;\r
\r
+ERROR: wait-timeout ;\r
+\r
: wait ( queue timeout status -- )\r
over [\r
[ queue-timeout [ drop ] ] dip suspend\r
- [ "Timeout" throw ] [ cancel-alarm ] if\r
+ [ wait-timeout ] [ cancel-alarm ] if\r
] [\r
[ drop '[ _ push-front ] ] dip suspend drop\r
] if ;\r
IN: concurrency.mailboxes.tests\r
-USING: concurrency.mailboxes concurrency.count-downs vectors\r
-sequences threads tools.test math kernel strings namespaces\r
+USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions\r
+vectors sequences threads tools.test math kernel strings namespaces\r
continuations calendar destructors ;\r
\r
{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as\r
[ ] [ "d" get 5 seconds await-timeout ] unit-test\r
\r
[ ] [ "m" get dispose ] unit-test\r
+\r
+[ { "foo" "bar" } ] [\r
+ <mailbox>\r
+ "foo" over mailbox-put\r
+ "bar" over mailbox-put\r
+ mailbox-get-all\r
+] unit-test\r
+\r
+[\r
+ <mailbox> 1 seconds mailbox-get-timeout\r
+] [ wait-timeout? ] must-fail-with\r
+
\ No newline at end of file
\r
: mailbox-get-all-timeout ( mailbox timeout -- array )\r
block-if-empty\r
- [ dup mailbox-empty? ]\r
+ [ dup mailbox-empty? not ]\r
[ dup data>> pop-back ]\r
produce nip ;\r
\r
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax alien.strings io.encodings.string kernel
sequences byte-arrays io.encodings.utf8 math core-foundation
-core-foundation.arrays destructors unicode.data ;
+core-foundation.arrays destructors ;
IN: core-foundation.strings
TYPEDEF: void* CFStringRef
: prepare-CFString ( string -- byte-array )
[
dup HEX: 10ffff >
- [ drop CHAR: replacement-character ] when
+ [ drop HEX: fffd ] when
] map utf8 encode ;
: <CFString> ( string -- alien )
M: ppc small-enough? ( n -- ? ) -32768 32767 between? ;
-M: ppc return-struct-in-registers? ( c-type -- ? ) drop f ;
-
-M: ppc %box-small-struct
- drop "No small structs" throw ;
-
-M: ppc %unbox-small-struct
- drop "No small structs" throw ;
+M: ppc return-struct-in-registers? ( c-type -- ? )
+ c-type return-in-registers?>> ;
+
+M: ppc %box-small-struct ( c-type -- )
+ #! Box a <= 16-byte struct returned in r3:r4:r5:r6
+ heap-size 7 LI
+ "box_medium_struct" f %alien-invoke ;
+
+: %unbox-struct-1 ( -- )
+ ! Alien must be in r3.
+ "alien_offset" f %alien-invoke
+ 3 3 0 LWZ ;
+
+: %unbox-struct-2 ( -- )
+ ! Alien must be in r3.
+ "alien_offset" f %alien-invoke
+ 4 3 4 LWZ
+ 3 3 0 LWZ ;
+
+: %unbox-struct-4 ( -- )
+ ! Alien must be in r3.
+ "alien_offset" f %alien-invoke
+ 6 3 12 LWZ
+ 5 3 8 LWZ
+ 4 3 4 LWZ
+ 3 3 0 LWZ ;
+
+M: ppc %unbox-small-struct ( size -- )
+ #! Alien must be in EAX.
+ heap-size cell align cell /i {
+ { 1 [ %unbox-struct-1 ] }
+ { 2 [ %unbox-struct-2 ] }
+ { 4 [ %unbox-struct-4 ] }
+ } case ;
USE: vocabs.loader
{ [ os macosx? ] [ "cpu.ppc.macosx" require ] }
{ [ os linux? ] [ "cpu.ppc.linux" require ] }
} cond
+
+"complex-double" c-type t >>return-in-registers? drop
USING: tools.test namespaces documents documents.elements multiline ;
IN: document.elements.tests
-<document> "doc" set
-"123\nabc" "doc" get set-doc-string
+SYMBOL: doc
+<document> doc set
+"123\nabcé" doc get set-doc-string
! char-elt
-[ { 0 0 } ] [ { 0 0 } "doc" get char-elt prev-elt ] unit-test
-[ { 0 0 } ] [ { 0 1 } "doc" get char-elt prev-elt ] unit-test
-[ { 0 3 } ] [ { 1 0 } "doc" get char-elt prev-elt ] unit-test
+[ { 0 0 } ] [ { 0 0 } doc get char-elt prev-elt ] unit-test
+[ { 0 0 } ] [ { 0 1 } doc get char-elt prev-elt ] unit-test
+[ { 0 3 } ] [ { 1 0 } doc get char-elt prev-elt ] unit-test
+[ { 1 3 } ] [ { 1 5 } doc get char-elt prev-elt ] unit-test
-[ { 1 3 } ] [ { 1 3 } "doc" get char-elt next-elt ] unit-test
-[ { 0 2 } ] [ { 0 1 } "doc" get char-elt next-elt ] unit-test
-[ { 1 0 } ] [ { 0 3 } "doc" get char-elt next-elt ] unit-test
+[ { 1 5 } ] [ { 1 5 } doc get char-elt next-elt ] unit-test
+[ { 0 2 } ] [ { 0 1 } doc get char-elt next-elt ] unit-test
+[ { 1 0 } ] [ { 0 3 } doc get char-elt next-elt ] unit-test
+[ { 1 5 } ] [ { 1 3 } doc get char-elt next-elt ] unit-test
! word-elt
-<document> "doc" set
-"Hello world\nanother line" "doc" get set-doc-string
+<document> doc set
+"Hello world\nanother line" doc get set-doc-string
-[ { 0 0 } ] [ { 0 0 } "doc" get word-elt prev-elt ] unit-test
-[ { 0 0 } ] [ { 0 2 } "doc" get word-elt prev-elt ] unit-test
-[ { 0 0 } ] [ { 0 5 } "doc" get word-elt prev-elt ] unit-test
-[ { 0 5 } ] [ { 0 6 } "doc" get word-elt prev-elt ] unit-test
-[ { 0 6 } ] [ { 0 8 } "doc" get word-elt prev-elt ] unit-test
-[ { 0 11 } ] [ { 1 0 } "doc" get word-elt prev-elt ] unit-test
+[ { 0 0 } ] [ { 0 0 } doc get word-elt prev-elt ] unit-test
+[ { 0 0 } ] [ { 0 2 } doc get word-elt prev-elt ] unit-test
+[ { 0 0 } ] [ { 0 5 } doc get word-elt prev-elt ] unit-test
+[ { 0 5 } ] [ { 0 6 } doc get word-elt prev-elt ] unit-test
+[ { 0 6 } ] [ { 0 8 } doc get word-elt prev-elt ] unit-test
+[ { 0 11 } ] [ { 1 0 } doc get word-elt prev-elt ] unit-test
+
+[ { 0 5 } ] [ { 0 0 } doc get word-elt next-elt ] unit-test
+[ { 0 6 } ] [ { 0 5 } doc get word-elt next-elt ] unit-test
+[ { 0 11 } ] [ { 0 6 } doc get word-elt next-elt ] unit-test
+[ { 1 0 } ] [ { 0 11 } doc get word-elt next-elt ] unit-test
-[ { 0 5 } ] [ { 0 0 } "doc" get word-elt next-elt ] unit-test
-[ { 0 6 } ] [ { 0 5 } "doc" get word-elt next-elt ] unit-test
-[ { 0 11 } ] [ { 0 6 } "doc" get word-elt next-elt ] unit-test
-[ { 1 0 } ] [ { 0 11 } "doc" get word-elt next-elt ] unit-test
! one-word-elt
-[ { 0 0 } ] [ { 0 0 } "doc" get one-word-elt prev-elt ] unit-test
-[ { 0 0 } ] [ { 0 2 } "doc" get one-word-elt prev-elt ] unit-test
-[ { 0 0 } ] [ { 0 5 } "doc" get one-word-elt prev-elt ] unit-test
-[ { 0 5 } ] [ { 0 2 } "doc" get one-word-elt next-elt ] unit-test
-[ { 0 5 } ] [ { 0 5 } "doc" get one-word-elt next-elt ] unit-test
+[ { 0 0 } ] [ { 0 0 } doc get one-word-elt prev-elt ] unit-test
+[ { 0 0 } ] [ { 0 2 } doc get one-word-elt prev-elt ] unit-test
+[ { 0 0 } ] [ { 0 5 } doc get one-word-elt prev-elt ] unit-test
+[ { 0 5 } ] [ { 0 2 } doc get one-word-elt next-elt ] unit-test
+[ { 0 5 } ] [ { 0 5 } doc get one-word-elt next-elt ] unit-test
! line-elt
-<document> "doc" set
-"Hello\nworld, how are\nyou?" "doc" get set-doc-string
+<document> doc set
+"Hello\nworld, how are\nyou?" doc get set-doc-string
-[ { 0 0 } ] [ { 0 3 } "doc" get line-elt prev-elt ] unit-test
-[ { 0 3 } ] [ { 1 3 } "doc" get line-elt prev-elt ] unit-test
-[ { 2 4 } ] [ { 2 1 } "doc" get line-elt next-elt ] unit-test
+[ { 0 0 } ] [ { 0 3 } doc get line-elt prev-elt ] unit-test
+[ { 0 3 } ] [ { 1 3 } doc get line-elt prev-elt ] unit-test
+[ { 2 4 } ] [ { 2 1 } doc get line-elt next-elt ] unit-test
! one-line-elt
-[ { 1 0 } ] [ { 1 3 } "doc" get one-line-elt prev-elt ] unit-test
-[ { 1 14 } ] [ { 1 3 } "doc" get one-line-elt next-elt ] unit-test
+[ { 1 0 } ] [ { 1 3 } doc get one-line-elt prev-elt ] unit-test
+[ { 1 14 } ] [ { 1 3 } doc get one-line-elt next-elt ] unit-test
! page-elt
-<document> "doc" set
+<document> doc set
<" First line
Second line
Third line
Fourth line
Fifth line
-Sixth line"> "doc" get set-doc-string
+Sixth line"> doc get set-doc-string
-[ { 0 0 } ] [ { 3 3 }
"doc" get 4 <page-elt> prev-elt ] unit-test
-[ { 1 2 } ] [ { 5 2 }
"doc" get 4 <page-elt> prev-elt ] unit-test
+[ { 0 0 } ] [ { 3 3 }
doc get 4 <page-elt> prev-elt ] unit-test
+[ { 1 2 } ] [ { 5 2 }
doc get 4 <page-elt> prev-elt ] unit-test
-[ { 4 3 } ] [ { 0 3 }
"doc" get 4 <page-elt> next-elt ] unit-test
-[ { 5 10 } ] [ { 4 2 }
"doc" get 4 <page-elt> next-elt ] unit-test
+[ { 4 3 } ] [ { 0 3 }
doc get 4 <page-elt> next-elt ] unit-test
+[ { 5 10 } ] [ { 4 2 }
doc get 4 <page-elt> next-elt ] unit-test
! doc-elt
-[ { 0 0 } ] [ { 3 4 } "doc" get doc-elt prev-elt ] unit-test
-[ { 5 10 } ] [ { 3 4 } "doc" get doc-elt next-elt ] unit-test
\ No newline at end of file
+[ { 0 0 } ] [ { 3 4 } doc get doc-elt prev-elt ] unit-test
+[ { 5 10 } ] [ { 3 4 } doc get doc-elt next-elt ] unit-test
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators documents fry kernel math sequences
-unicode.categories accessors ;
+accessors unicode.categories unicode.breaks combinators.short-circuit ;
IN: documents.elements
GENERIC: prev-elt ( loc document elt -- newloc )
<PRIVATE
-: (prev-char) ( loc document quot -- loc )
+: prev ( loc document quot: ( loc document -- loc ) -- loc )
{
{ [ pick { 0 0 } = ] [ 2drop ] }
{ [ pick second zero? ] [ drop [ first 1- ] dip line-end ] }
[ call ]
} cond ; inline
-: (next-char) ( loc document quot -- loc )
+: next ( loc document quot: ( loc document -- loc ) -- loc )
{
{ [ 2over doc-end = ] [ 2drop ] }
{ [ 2over line-end? ] [ 2drop first 1+ 0 2array ] }
[ call ]
} cond ; inline
+: modify-col ( loc document quot: ( col str -- col' ) -- loc )
+ pick [
+ [ [ first2 swap ] dip doc-line ] dip call
+ ] dip =col ; inline
+
PRIVATE>
M: char-elt prev-elt
- drop [ drop -1 +col ] (prev-char) ;
+ drop [ [ last-grapheme-from ] modify-col ] prev ;
M: char-elt next-elt
- drop [ drop 1 +col ] (next-char) ;
+ drop [ [ first-grapheme-from ] modify-col ] next ;
SINGLETON: one-char-elt
<PRIVATE
-: (word-elt) ( loc document quot -- loc )
- pick [
- [ [ first2 swap ] dip doc-line ] dip call
- ] dip =col ; inline
-
-: ((word-elt)) ( n seq -- n seq ? )
+: blank-at? ( n seq -- n seq ? )
2dup ?nth blank? ;
: break-detector ( ? -- quot )
'[ blank? _ xor ] ; inline
-: (prev-word) ( col str ? -- col )
+: prev-word ( col str ? -- col )
break-detector find-last-from drop ?1+ ;
-: (next-word) ( col str ? -- col )
+: next-word ( col str ? -- col )
[ break-detector find-from drop ] [ drop length ] 2bi or ;
PRIVATE>
M: one-word-elt prev-elt
drop
- [ [ 1- ] dip f (prev-word) ] (word-elt) ;
+ [ [ 1- ] dip f prev-word ] modify-col ;
M: one-word-elt next-elt
drop
- [ f (next-word) ] (word-elt) ;
+ [ f next-word ] modify-col ;
SINGLETON: word-elt
M: word-elt prev-elt
drop
- [ [ [ 1- ] dip ((word-elt)) (prev-word) ] (word-elt) ]
- (prev-char) ;
+ [ [ [ 1- ] dip blank-at? prev-word ] modify-col ]
+ prev ;
M: word-elt next-elt
drop
- [ [ ((word-elt)) (next-word) ] (word-elt) ]
- (next-char) ;
+ [ [ blank-at? next-word ] modify-col ]
+ next ;
SINGLETON: one-line-elt
M: doc-elt prev-elt 3drop { 0 0 } ;
-M: doc-elt next-elt drop nip doc-end ;
\ No newline at end of file
+M: doc-elt next-elt drop nip doc-end ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: farkup kernel peg peg.ebnf tools.test namespaces xml
-urls.encoding assocs xml.traversal xml.data ;
+urls.encoding assocs xml.traversal xml.data sequences random
+io continuations math ;
IN: farkup.tests
relative-link-prefix off
[ "<p><em>italics<strong>both</strong></em>after<strong></strong></p>" ] [ "_italics*both_after*" convert-farkup ] unit-test
[ "<table><tr><td>foo|bar</td></tr></table>" ] [ "|foo\\|bar|" convert-farkup ] unit-test
[ "<p></p>" ] [ "\\" convert-farkup ] unit-test
+
+[ "<p>[abc]</p>" ] [ "[abc]" convert-farkup ] unit-test
+
+: random-markup ( -- string )
+ 10 [
+ 2 random 1 = [
+ {
+ "[["
+ "*"
+ "_"
+ "|"
+ "-"
+ "[{"
+ "\n"
+ } random
+ ] [
+ "abc"
+ ] if
+ ] replicate concat ;
+
+[ t ] [
+ 100 [
+ drop random-markup
+ [ convert-farkup drop t ] [ drop print f ] recover
+ ] all?
+] unit-test
"|" split1
[ "" like dup simple-link-title ] unless*
[ "image:" ?head ] dip swap [ image boa ] [ parse-paragraph link boa ] if
- ] dip [ (parse-paragraph) cons ] when* ;
+ ] dip [ (parse-paragraph) cons ] [ 1list ] if* ;
: ?first ( seq -- elt ) 0 swap ?nth ;
] if
] if ;
-: take-until ( state delimiter -- string/f state' )
+: take-until ( state delimiter -- string state'/f )
V{ } clone (take-until) ;
: count= ( string -- n )
: parse-code ( state -- state' item )
dup 1 look CHAR: [ =
- [ unclip-slice make-paragraph ] [
- "{" take-until [ rest ] dip
- "}]" take-until
- [ code boa ] dip swap
+ [ take-line make-paragraph ] [
+ dup "{" take-until [
+ [ nip rest ] dip
+ "}]" take-until
+ [ code boa ] dip swap
+ ] [ drop take-line make-paragraph ] if*
] if ;
: parse-item ( state -- state' item )
: help>html ( topic -- xml )
[ article-title ]
[ drop help-stylesheet ]
- [ [ help ] with-html-writer ]
+ [ [ print-topic ] with-html-writer ]
tri simple-page ;
: generate-help-file ( topic -- )
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 } "." ;
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/" } ": " { $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 ;" }
{ $values { "content" "a markup element" } }
\ >be { { bignum fixnum } { fixnum fixnum } } "specializer" set-word-prop
-\ hashtable \ at* method { { fixnum hashtable } { word hashtable } } "specializer" set-word-prop
+\ hashtable \ at* method { { fixnum object } { word object } } "specializer" set-word-prop
\ hashtable \ set-at method { { object fixnum object } { object word object } } "specializer" set-word-prop
! 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 ] }
: <image> ( -- image ) image new ; inline
+: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
+
GENERIC: load-image* ( path tuple -- image )
\ No newline at end of file
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 * '[
_ [ _ _ find-file [ file-not-found ] unless* ] attempt-all
] [
drop f
- ] recover ;
+ ] recover ; inline
: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
- '[ _ _ find-all-files ] map concat ;
+ '[ _ _ find-all-files ] map concat ; inline
os windows? [ "io.directories.search.windows" require ] when
! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: io io.encodings kernel math io.encodings.private io.encodings.iana ;
+USING: io io.encodings kernel math io.encodings.private ;
IN: io.encodings.ascii
<PRIVATE
128 encode-if< ;
M: ascii decode-char
- 128 decode-if< ;
-
-ascii "ANSI_X3.4-1968" register-encoding
+ 128 decode-if< ;
\ No newline at end of file
! Copyright (C) 2008 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: kernel strings values io.files assocs
-splitting sequences io namespaces sets io.encodings.utf8 ;
+splitting sequences io namespaces sets
+io.encodings.ascii io.encodings.utf8 ;
IN: io.encodings.iana
<PRIVATE
[ n>e-table get-global set-at ] with each
] [ "Bad encoding registration" throw ] if*
] [ swap e>n-table get-global set-at ] 2bi ;
+
+ascii "ANSI_X3.4-1968" register-encoding
--- /dev/null
+USING: alien.fortran help.markup help.syntax math.blas.config multiline ;
+IN: math.blas.config
+
+ARTICLE: "math.blas.config" "Configuring the BLAS interface"
+"The " { $link "math.blas-summary" } " chooses the underlying BLAS interface to use based on the values of the following global variables:"
+{ $subsection blas-library }
+{ $subsection blas-fortran-abi }
+"The interface attempts to set default values based on the ones encountered on the Factor project's build machines. If these settings don't work with your system's BLAS, or you wish to use a commercial BLAS, you may change the global values of those variables in your " { $link "factor-rc" } ". For example, to use AMD's ACML library on Windows with " { $snippet "math.blas" } ", your " { $snippet "factor-rc" } " would look like this:"
+{ $code <"
+USING: math.blas.config namespaces ;
+"X:\\path\\to\\acml.dll" blas-library set-global
+intel-windows-abi blas-fortran-abi set-global
+"> }
+"To take effect, the " { $snippet "blas-library" } " and " { $snippet "blas-fortran-abi" } " variables must be set before any other " { $snippet "math.blas" } " vocabularies are loaded."
+;
+
+HELP: blas-library
+{ $description "The name of the shared library containing the BLAS interface to load. The value of this variable must be a valid shared library name that can be passed to " { $link add-fortran-library } ". To take effect, this variable must be set before any other " { $snippet "math.blas" } " vocabularies are loaded. See " { $link "math.blas.config" } " for details and examples." } ;
+
+HELP: blas-fortran-abi
+{ $description "The Fortran ABI used by the BLAS interface specified in the " { $link blas-library } " variable. The value of " { $snippet "blas-fortran-abi" } " must be one of the " { $link "alien.fortran-abis" } " that can be passed to " { $link add-fortran-library } ". To take effect, this variable must be set before any other " { $snippet "math.blas" } " vocabularies are loaded. See " { $link "math.blas.config" } " for details and examples." } ;
+
+ABOUT: "math.blas.config"
--- /dev/null
+USING: alien.fortran combinators kernel namespaces system ;
+IN: math.blas.config
+
+SYMBOLS: blas-library blas-fortran-abi ;
+
+blas-library [
+ {
+ { [ os macosx? ] [ "libblas.dylib" ] }
+ { [ os windows? ] [ "blas.dll" ] }
+ [ "libblas.so" ]
+ } cond
+] initialize
+
+blas-fortran-abi [
+ {
+ { [ os macosx? ] [ intel-unix-abi ] }
+ { [ os windows? cpu x86.32? and ] [ f2c-abi ] }
+ { [ os windows? cpu x86.64? and ] [ gfortran-abi ] }
+ { [ os freebsd? ] [ gfortran-abi ] }
+ { [ os linux? cpu x86.32? and ] [ gfortran-abi ] }
+ [ f2c-abi ]
+ } cond
+] initialize
-USING: alien alien.fortran kernel system combinators
-alien.libraries ;
+USING: alien.fortran kernel math.blas.config namespaces ;
IN: math.blas.ffi
<<
-"blas" {
- { [ os macosx? ] [ "libblas.dylib" intel-unix-abi add-fortran-library ] }
- { [ os windows? cpu x86.32? and ] [ "blas.dll" f2c-abi add-fortran-library ] }
- { [ os windows? cpu x86.64? and ] [ "blas.dll" gfortran-abi add-fortran-library ] }
- { [ os freebsd? ] [ "libblas.so" gfortran-abi add-fortran-library ] }
- [ "libblas.so" f2c-abi add-fortran-library ]
-} cond
+"blas" blas-library blas-fortran-abi [ get ] bi@
+add-fortran-library
>>
LIBRARY: blas
IN: math.blas.matrices
ARTICLE: "math.blas-summary" "Basic Linear Algebra Subroutines (BLAS) interface"
-"Factor provides an interface to high-performance vector and matrix math routines available in the system's BLAS library. A set of specialized types are provided for handling packed, unboxed vector data:"
+"Factor provides an interface to high-performance vector and matrix math routines available in implementations of the BLAS math library. A set of specialized types are provided for handling packed, unboxed vector data:"
{ $subsection "math.blas-types" }
"Scalar-vector and vector-vector operations are available in the " { $vocab-link "math.blas.vectors" } " vocabulary:"
{ $subsection "math.blas.vectors" }
"Vector-matrix and matrix-matrix operations are available in the " { $vocab-link "math.blas.matrices" } " vocabulary:"
{ $subsection "math.blas.matrices" }
-"The low-level BLAS Fortran interface can be accessed directly through the " { $vocab-link "math.blas.ffi" } " vocabulary." ;
+"The low-level BLAS Fortran interface can be accessed directly through the " { $vocab-link "math.blas.ffi" } " vocabulary. The BLAS interface can be configured to use different underlying BLAS implementations:"
+{ $subsection "math.blas.config" } ;
ARTICLE: "math.blas-types" "BLAS interface types"
"BLAS vectors come in single- and double-precision, real and complex flavors:"
"Tests:"
{ $subsection power-of-2? }
{ $subsection even? }
-{ $subsection odd? } ;
+{ $subsection odd? }
+{ $subsection divisor? } ;
ARTICLE: "arithmetic-functions" "Arithmetic functions"
"Computing additive and multiplicative inverses:"
{ $description "Computes the positive greatest common divisor " { $snippet "d" } " of " { $snippet "x" } " and " { $snippet "y" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*y = d mod x" } }
{ $notes "If " { $snippet "d" } " is 1, then " { $snippet "a" } " is the inverse of " { $snippet "y" } " modulo " { $snippet "x" } "." } ;
+HELP: divisor?
+{ $values { "m" integer } { "n" integer } { "?" "a boolean" } }
+{ $description "Tests if " { $snippet "n" } " is a divisor of " { $snippet "m" } ". This is the same thing as asking if " { $snippet "m" } " is divisible by " { $snippet "n" } "." }
+{ $notes "Returns t for both negative and positive divisors, as well as for trivial and non-trivial divisors." } ;
+
HELP: mod-inv
{ $values { "x" integer } { "n" integer } { "y" integer } }
{ $description "Outputs an integer " { $snippet "y" } " such that " { $snippet "xy = 1 (mod n)" } "." }
[ 1.0 ] [ 0 cosh ] unit-test
[ 0.0 ] [ 1 acosh ] unit-test
-
+
[ 1.0 ] [ 0 cos ] unit-test
[ 0.0 ] [ 1 acos ] unit-test
-
+
[ 0.0 ] [ 0 sinh ] unit-test
[ 0.0 ] [ 0 asinh ] unit-test
-
+
[ 0.0 ] [ 0 sin ] unit-test
[ 0.0 ] [ 0 asin ] unit-test
: verify-gcd ( a b -- ? )
2dup gcd
- [ rot * swap rem ] dip = ;
+ [ rot * swap rem ] dip = ;
[ t ] [ 123 124 verify-gcd ] unit-test
[ t ] [ 50 120 verify-gcd ] unit-test
+[ t ] [ 0 42 divisor? ] unit-test
+[ t ] [ 42 7 divisor? ] unit-test
+[ t ] [ 42 -7 divisor? ] unit-test
+[ t ] [ 42 42 divisor? ] unit-test
+[ f ] [ 42 16 divisor? ] unit-test
+
[ 3 ] [ 5 7 mod-inv ] unit-test
[ 78572682077 ] [ 234829342 342389423843 mod-inv ] unit-test
1067811677921310779
2135623355842621559
[ >bignum ] tri@ ^mod
-] unit-test
\ No newline at end of file
+] unit-test
: lcm ( a b -- c )
[ * ] 2keep gcd nip /i ; foldable
+: divisor? ( m n -- ? )
+ mod 0 = ;
+
: mod-inv ( x n -- y )
[ nip ] [ gcd 1 = ] 2bi
[ dup 0 < [ + ] [ nip ] if ]
GENERIC: sinh ( x -- y ) foldable
-M: complex sinh
+M: complex sinh
>float-rect
[ [ fsinh ] [ fcos ] bi* * ]
[ [ fcosh ] [ fsin ] bi* * ] 2bi rect> ;
! Copyright (C) 2007-2009 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators kernel make math math.primes sequences ;
+USING: arrays combinators kernel make math math.functions math.primes sequences ;
IN: math.primes.factors
<PRIVATE
swap ;
: write-factor ( n d -- n' d' )
- 2dup mod zero? [
+ 2dup divisor? [
[ [ count-factor ] keep swap 2array , ] keep
! If the remainder is a prime number, increase d so that
! the caller stops looking for factors.
+++ /dev/null
-USING: help.syntax help.markup kernel math classes classes.tuple\r
-calendar models ;\r
-IN: models.history\r
-\r
-HELP: history\r
-{ $class-description "History models record a timeline of previous values on calls to " { $link add-history } ", and can travel back and forth on the timeline with " { $link go-back } " and " { $link go-forward } ". History models are constructed by " { $link <history> } "." } ;\r
-\r
-HELP: <history>\r
-{ $values { "value" object } { "history" "a new " { $link history } } }\r
-{ $description "Creates a new history model with an initial value." } ;\r
-\r
-{ <history> add-history go-back go-forward } related-words\r
-\r
-HELP: go-back\r
-{ $values { "history" history } }\r
-{ $description "Restores the previous value and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." } ;\r
-\r
-HELP: go-forward\r
-{ $values { "history" history } }\r
-{ $description "Restores the value set prior to the last call to " { $link go-back } " and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." } ;\r
-\r
-HELP: add-history\r
-{ $values { "history" history } }\r
-{ $description "Adds the current value to the history." } ;\r
-\r
-ARTICLE: "models-history" "History models"\r
-"History models record previous values."\r
-{ $subsection history }\r
-{ $subsection <history> }\r
-"Recording history:"\r
-{ $subsection add-history }\r
-"Navigating the history:"\r
-{ $subsection go-back }\r
-{ $subsection go-forward } ;\r
-\r
-ABOUT: "models-history"\r
+++ /dev/null
-USING: arrays generic kernel math models namespaces sequences assocs\r
-tools.test models.history accessors ;\r
-IN: models.history.tests\r
-\r
-f <history> "history" set\r
-\r
-"history" get add-history\r
-\r
-[ t ] [ "history" get back>> empty? ] unit-test\r
-[ t ] [ "history" get forward>> empty? ] unit-test\r
-\r
-"history" get add-history\r
-3 "history" get set-model\r
-\r
-[ t ] [ "history" get back>> empty? ] unit-test\r
-[ t ] [ "history" get forward>> empty? ] unit-test\r
-\r
-"history" get add-history\r
-4 "history" get set-model\r
-\r
-[ f ] [ "history" get back>> empty? ] unit-test\r
-[ t ] [ "history" get forward>> empty? ] unit-test\r
-\r
-"history" get go-back\r
-\r
-[ 3 ] [ "history" get value>> ] unit-test\r
-\r
-[ t ] [ "history" get back>> empty? ] unit-test\r
-[ f ] [ "history" get forward>> empty? ] unit-test\r
-\r
-"history" get go-forward\r
-\r
-[ 4 ] [ "history" get value>> ] unit-test\r
-\r
-[ f ] [ "history" get back>> empty? ] unit-test\r
-[ t ] [ "history" get forward>> empty? ] unit-test\r
-\r
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors kernel models sequences ;\r
-IN: models.history\r
-\r
-TUPLE: history < model back forward ;\r
-\r
-: reset-history ( history -- history )\r
- V{ } clone >>back\r
- V{ } clone >>forward ; inline\r
-\r
-: <history> ( value -- history )\r
- history new-model\r
- reset-history ;\r
-\r
-: (add-history) ( history to -- )\r
- swap value>> dup [ swap push ] [ 2drop ] if ;\r
-\r
-: go-back/forward ( history to from -- )\r
- [ 2drop ]\r
- [ [ dupd (add-history) ] dip pop swap set-model ] if-empty ;\r
-\r
-: go-back ( history -- )\r
- dup [ forward>> ] [ back>> ] bi go-back/forward ;\r
-\r
-: go-forward ( history -- )\r
- dup [ back>> ] [ forward>> ] bi go-back/forward ;\r
-\r
-: add-history ( history -- )\r
- dup forward>> delete-all\r
- dup back>> (add-history) ;\r
+++ /dev/null
-History models remember prior values
HELP: model
{ $class-description "A mutable cell holding a single value. When the value is changed, a sequence of connected objects are notified. Models have the following slots:"
{ $list
- { { $snippet "value" } " - the value of the model. Use " { $link set-model } " to change the value." }
- { { $snippet "connections" } " - a sequence of objects implementing the " { $link model-changed } " generic word, to be notified when the model's value changes." }
- { { $snippet "dependencies" } " - a sequence of models which should have this model added to their sequence of connections when activated." }
- { { $snippet "ref" } " - a reference count tracking the number of models which depend on this one." }
+ { { $slot "value" } " - the value of the model. Use " { $link set-model } " to change the value." }
+ { { $slot "connections" } " - a sequence of objects implementing the " { $link model-changed } " generic word, to be notified when the model's value changes." }
+ { { $slot "dependencies" } " - a sequence of models which should have this model added to their sequence of connections when activated." }
+ { { $slot "ref" } " - a reference count tracking the number of models which depend on this one." }
+ { { $slot "locked?" } " - a slot set by " { $link with-locked-model } " to ensure that the model doesn't get changed recursively" }
}
-"Other classes may delegate to " { $link model } "."
+"Other classes may inherit from " { $link model } "."
} ;
HELP: <model>
{ $subsection "models-impl" }
{ $subsection "models.arrow" }
{ $subsection "models.product" }
-{ $subsection "models-history" }
{ $subsection "models-range" }
{ $subsection "models-delay" } ;
{ $description "Wraps a quotation in " { $link glEnable } "/" { $link glDisable } " calls." } ;
HELP: do-matrix
-{ $values { "mode" { $link GL_MODELVIEW } " or " { $link GL_PROJECTION } } { "quot" quotation } }
-{ $description "Saves and restores the matrix specified by " { $snippet "mode" } " before and after calling the quotation." } ;
+{ $values { "quot" quotation } }
+{ $description "Saves and restores the current matrix before and after calling the quotation." } ;
HELP: gl-line
{ $values { "a" "a pair of integers" } { "b" "a pair of integers" } }
MACRO: all-enabled-client-state ( seq quot -- )
[ words>values ] dip '[ _ _ (all-enabled-client-state) ] ;
-: do-matrix ( mode quot -- )
- swap [ glMatrixMode glPushMatrix call ] keep
- glMatrixMode glPopMatrix ; inline
+: do-matrix ( quot -- )
+ glPushMatrix call glPopMatrix ; inline
: gl-material ( face pname params -- )
float-array{ } like glMaterialfv ;
: delete-dlist ( id -- ) 1 glDeleteLists ;
: with-translation ( loc quot -- )
- GL_MODELVIEW [ [ gl-translate ] dip call ] do-matrix ; inline
+ [ [ gl-translate ] dip call ] do-matrix ; inline
: fix-coordinates ( point1 point2 -- x1 y2 x2 y2 )
[ first2 [ >fixnum ] bi@ ] bi@ ;
fix-coordinates glViewport ;
: init-matrices ( -- )
+ #! Leaves with matrix mode GL_MODELVIEW
GL_PROJECTION glMatrixMode
glLoadIdentity
GL_MODELVIEW glMatrixMode
sequences ;
IN: opengl.textures.tests
-[ ] [
- T{ image
- { dim { 3 5 } }
- { component-order RGB }
- { bitmap
- B{
- 1 2 3 4 5 6 7 8 9
- 10 11 12 13 14 15 16 17 18
- 19 20 21 22 23 24 25 26 27
- 28 29 30 31 32 33 34 35 36
- 37 38 39 40 41 42 43 44 45
- }
- }
- } "image" set
-] unit-test
-
-[
- T{ image
- { dim { 4 8 } }
- { component-order RGB }
- { bitmap
- B{
- 1 2 3 4 5 6 7 8 9 7 8 9
- 10 11 12 13 14 15 16 17 18 16 17 18
- 19 20 21 22 23 24 25 26 27 25 26 27
- 28 29 30 31 32 33 34 35 36 34 35 36
- 37 38 39 40 41 42 43 44 45 43 44 45
- 37 38 39 40 41 42 43 44 45 43 44 45
- 37 38 39 40 41 42 43 44 45 43 44 45
- 37 38 39 40 41 42 43 44 45 43 44 45
- }
- }
- }
-] [
- "image" get power-of-2-image
-] unit-test
-
-[
- T{ image
- { dim { 0 0 } }
- { component-order R32G32B32 }
- { bitmap B{ } } }
-] [
- T{ image
- { dim { 0 0 } }
- { component-order R32G32B32 }
- { bitmap B{ } }
- } power-of-2-image
-] unit-test
-
[
{
{ { 0 0 } { 10 0 } }
! See http://factorcode.org/license.txt for BSD license.
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 ;
+specialized-arrays.float sequences math math.vectors
+math.matrices generalizations fry arrays ;
IN: opengl.textures
: gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ;
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 -- )
+SLOT: display-list
+
+: draw-texture ( texture -- ) display-list>> [ glCallList ] when* ;
GENERIC: draw-scaled-texture ( dim texture -- )
<PRIVATE
-TUPLE: single-texture loc dim texture-coords texture display-list disposed ;
-
-: repeat-last ( seq n -- seq' )
- over peek pad-tail concat ;
+TUPLE: single-texture image dim loc texture-coords texture display-list disposed ;
-: power-of-2-bitmap ( rows dim size -- bitmap dim )
- '[
- first2
- [ [ _ ] dip '[ _ group _ repeat-last ] map ]
- [ repeat-last ]
- bi*
- ] keep ;
+: (tex-image) ( image -- )
+ [ GL_TEXTURE_2D 0 GL_RGBA ] dip
+ [ dim>> first2 [ next-power-of-2 ] bi@ 0 ]
+ [ component-order>> component-order>format f ] bi
+ glTexImage2D ;
-: image-rows ( image -- rows )
- [ bitmap>> ]
- [ dim>> first ]
- [ component-order>> bytes-per-pixel ]
- tri * group ; inline
-
-: power-of-2-image ( image -- image )
- dup dim>> [ 0 = ] all? [
- clone dup
- [ image-rows ]
- [ dim>> [ next-power-of-2 ] map ]
- [ component-order>> bytes-per-pixel ] tri
- power-of-2-bitmap
- [ >>bitmap ] [ >>dim ] bi*
- ] unless ;
+: (tex-sub-image) ( image -- )
+ [ GL_TEXTURE_2D 0 0 0 ] dip
+ [ dim>> first2 ] [ component-order>> component-order>format ] [ bitmap>> ] tri
+ glTexSubImage2D ;
-:: make-texture ( image -- id )
+: make-texture ( image -- id )
+ #! We use glTexSubImage2D to work around the power of 2 texture size
+ #! limitation
gen-texture [
GL_TEXTURE_BIT [
GL_TEXTURE_2D swap glBindTexture
- GL_TEXTURE_2D
- 0
- GL_RGBA
- image dim>> first2
- 0
- image component-order>> component-order>format
- image bitmap>>
- glTexImage2D
+ [ (tex-image) ] [ (tex-sub-image) ] bi
] do-attribs
] keep ;
: init-texture ( -- )
- GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
- GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
+ GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST glTexParameteri
+ GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST glTexParameteri
GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT glTexParameteri
GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT glTexParameteri ;
: 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
- float-array{ } join ;
+: texture-coords ( texture -- coords )
+ [ [ dim>> ] [ image>> dim>> [ next-power-of-2 ] map ] bi v/ ]
+ [
+ image>> upside-down?>>
+ { { 0 1 } { 1 1 } { 1 0 } { 0 0 } }
+ { { 0 0 } { 1 0 } { 1 1 } { 0 1 } } ?
+ ] bi
+ [ v* ] with map 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 new swap >>loc swap [ >>image ] [ dim>> >>dim ] bi
+ dup image>> dim>> product 0 = [
+ dup texture-coords >>texture-coords
+ dup image>> make-texture >>texture
dup make-texture-display-list >>display-list
] unless ;
[ texture>> [ delete-texture ] when* ]
[ display-list>> [ delete-dlist ] when* ] bi ;
-M: single-texture draw-texture display-list>> [ glCallList ] when* ;
-
M: single-texture draw-scaled-texture
dup texture>> [ draw-textured-rect ] [ 2drop ] if ;
TUPLE: multi-texture grid display-list loc disposed ;
: image-locs ( image-grid -- loc-grid )
- [ first [ dim>> first ] map ] [ 0 <column> [ dim>> second ] map ] bi
+ [ first [ dim>> first ] map ] [ [ first dim>> second ] map ] bi
[ 0 [ + ] accumulate nip ] bi@
cross-zip flip ;
: 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 ;
f multi-texture boa
] with-destructors ;
-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>
! 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 ;
!
USING: kernel tools.test peg peg.ebnf words math math.parser
sequences accessors peg.parsers parser namespaces arrays
- strings eval ;
+ strings eval unicode.data multiline ;
IN: peg.ebnf.tests
{ T{ ebnf-non-terminal f "abc" } } [
{ "\\" } [
"\\" [EBNF foo="\\" EBNF]
] unit-test
+
+[ "USE: peg.ebnf [EBNF EBNF]" eval ] must-fail
+
+[ <" USE: peg.ebnf [EBNF
+ lol = a
+ lol = b
+ EBNF] "> eval
+] [
+ error>> [ redefined-rule? ] [ name>> "lol" = ] bi and
+] must-fail-with
continuations peg peg.parsers unicode.categories multiline\r
splitting accessors effects sequences.deep peg.search\r
combinators.short-circuit lexer io.streams.string stack-checker\r
-io combinators parser ;\r
+io combinators parser summary ;\r
IN: peg.ebnf\r
\r
: rule ( name word -- parser )\r
#! Given an EBNF word produced from EBNF: return the EBNF rule\r
"ebnf-parser" word-prop at ;\r
\r
+ERROR: no-rule rule parser ;\r
+\r
+: lookup-rule ( rule parser -- rule' )\r
+ 2dup rule [ 2nip ] [ no-rule ] if* ; \r
+\r
TUPLE: tokenizer any one many ;\r
\r
: default-tokenizer ( -- tokenizer )\r
: reset-tokenizer ( -- )\r
default-tokenizer \ tokenizer set-global ;\r
\r
+ERROR: no-tokenizer name ;\r
+\r
+M: no-tokenizer summary\r
+ drop "Tokenizer not found" ;\r
+\r
SYNTAX: TOKENIZER: \r
- scan search [ "Tokenizer not found" throw ] unless*\r
+ scan dup search [ nip ] [ no-tokenizer ] if*\r
execute( -- tokenizer ) \ tokenizer set-global ;\r
\r
TUPLE: ebnf-non-terminal symbol ;\r
"]]" token ensure-not ,\r
"]?" token ensure-not ,\r
[ drop t ] satisfy ,\r
- ] seq* [ first ] action repeat0 [ >string ] action ;\r
+ ] seq* repeat0 [ concat >string ] action ;\r
\r
: 'ensure-not' ( -- parser )\r
#! Parses the '!' syntax to ensure that \r
(transform) \r
dup parser-tokenizer \ tokenizer set-global\r
] if ;\r
+\r
+ERROR: redefined-rule name ;\r
+\r
+M: redefined-rule summary\r
+ name>> "Rule '" "' defined more than once" surround ;\r
\r
M: ebnf-rule (transform) ( ast -- parser )\r
dup elements>> \r
(transform) [\r
- swap symbol>> dup get parser? [ \r
- "Rule '" over append "' defined more than once" append throw \r
- ] [ \r
- set \r
- ] if\r
+ swap symbol>> dup get parser? [ redefined-rule ] [ set ] if\r
] keep ;\r
\r
M: ebnf-sequence (transform) ( ast -- parser )\r
{ [ dup (( -- b )) effect<= ] [ drop [ drop ] prepose ] }\r
[ bad-effect ]\r
} cond ;\r
+\r
+: ebnf-transform ( ast -- parser quot )\r
+ [ parser>> (transform) ]\r
+ [ code>> insert-escapes ]\r
+ [ parser>> ] tri build-locals \r
+ [ string-lines parse-lines ] call( string -- quot ) ;\r
\r
M: ebnf-action (transform) ( ast -- parser )\r
- [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals \r
- [ string-lines parse-lines ] call( string -- quot ) check-action-effect action ;\r
+ ebnf-transform check-action-effect action ;\r
\r
M: ebnf-semantic (transform) ( ast -- parser )\r
- [ parser>> (transform) ] [ code>> insert-escapes ] [ parser>> ] tri build-locals \r
- [ string-lines parse-lines ] call( string -- quot ) semantic ;\r
+ ebnf-transform semantic ;\r
\r
M: ebnf-var (transform) ( ast -- parser )\r
parser>> (transform) ;\r
M: ebnf-terminal (transform) ( ast -- parser )\r
symbol>> tokenizer one>> call( symbol -- parser ) ;\r
\r
+ERROR: ebnf-foreign-not-found name ;\r
+\r
+M: ebnf-foreign-not-found summary\r
+ name>> "Foreign word '" "' not found" surround ;\r
+\r
M: ebnf-foreign (transform) ( ast -- parser )\r
- dup word>> search\r
- [ "Foreign word '" swap word>> append "' not found" append throw ] unless*\r
+ dup word>> search [ word>> ebnf-foreign-not-found ] unless*\r
swap rule>> [ main ] unless* over rule [\r
nip\r
] [\r
execute( -- parser )\r
] if* ;\r
\r
-: parser-not-found ( name -- * )\r
- [\r
- "Parser '" % % "' not found." %\r
- ] "" make throw ;\r
+ERROR: parser-not-found name ;\r
\r
M: ebnf-non-terminal (transform) ( ast -- parser )\r
symbol>> [\r
'ebnf' parse transform ;\r
\r
: check-parse-result ( result -- result )\r
- dup [\r
- dup remaining>> [ blank? ] trim empty? [\r
+ [\r
+ dup remaining>> [ blank? ] trim [\r
[ \r
"Unable to fully parse EBNF. Left to parse was: " %\r
remaining>> % \r
] "" make throw\r
- ] unless\r
+ ] unless-empty\r
] [\r
"Could not parse EBNF" throw\r
- ] if ;\r
+ ] if* ;\r
\r
: parse-ebnf ( string -- hashtable )\r
'ebnf' (parse) check-parse-result ast>> transform ;\r
parse-ebnf dup dup parser [ main swap at compile ] with-variable\r
[ compiled-parse ] curry [ with-scope ast>> ] curry ;\r
\r
-SYNTAX: <EBNF "EBNF>" reset-tokenizer parse-multiline-string parse-ebnf main swap at \r
+SYNTAX: <EBNF\r
+ "EBNF>"\r
+ reset-tokenizer parse-multiline-string parse-ebnf main swap at \r
parsed reset-tokenizer ;\r
\r
-SYNTAX: [EBNF "EBNF]" reset-tokenizer parse-multiline-string ebnf>quot nip \r
+SYNTAX: [EBNF\r
+ "EBNF]"\r
+ reset-tokenizer parse-multiline-string ebnf>quot nip \r
parsed \ call parsed reset-tokenizer ;\r
\r
SYNTAX: EBNF: \r
reset-tokenizer CREATE-WORD dup ";EBNF" parse-multiline-string \r
- ebnf>quot swapd (( input -- ast )) define-declared "ebnf-parser" set-word-prop \r
+ ebnf>quot swapd\r
+ (( input -- ast )) define-declared "ebnf-parser" set-word-prop \r
reset-tokenizer ;\r
-\r
dup pos>> pos set ans>>
; inline
-:: (setup-lr) ( r l s -- )
- s head>> l head>> eq? [
- l head>> s (>>head)
- l head>> [ s rule-id>> suffix ] change-involved-set drop
- r l s next>> (setup-lr)
- ] unless ;
+:: (setup-lr) ( l s -- )
+ s [
+ s left-recursion? [ s throw ] unless
+ s head>> l head>> eq? [
+ l head>> s (>>head)
+ l head>> [ s rule-id>> suffix ] change-involved-set drop
+ l s next>> (setup-lr)
+ ] unless
+ ] when ;
:: setup-lr ( r l -- )
l head>> [
r rule-id V{ } clone V{ } clone peg-head boa l (>>head)
] unless
- r l lrstack get (setup-lr) ;
+ l lrstack get (setup-lr) ;
:: lr-answer ( r p m -- ast )
[let* |
lrstack get next>> lrstack set
pos get m (>>pos)
lr head>> [
- ans lr (>>seed)
- r p m lr-answer
+ m ans>> left-recursion? [
+ ans lr (>>seed)
+ r p m lr-answer
+ ] [ ans ] if
] [
ans m (>>ans)
ans
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test quoting ;
+IN: quoting.tests
+
+[ f ] [ "" quoted? ] unit-test
+[ t ] [ "''" quoted? ] unit-test
+[ t ] [ "\"\"" quoted? ] unit-test
+[ t ] [ "\"Circus Maximus\"" quoted? ] unit-test
+[ t ] [ "'Circus Maximus'" quoted? ] unit-test
+[ f ] [ "Circus Maximus" quoted? ] unit-test
{ } assoc-like [ first integer? ] partition
[ [ literals>cases ] keep ] dip non-literals>dispatch ;
-:: step ( last-match index str quot final? direction -- last-index/f )
+: advance ( index backwards? -- index+/-1 )
+ -1 1 ? + >fixnum ; inline
+
+: check ( index string backwards? -- in-bounds? )
+ [ drop -1 eq? not ] [ length < ] if ; inline
+
+:: step ( last-match index str quot final? backwards? -- last-index/f )
final? index last-match ?
- index str bounds-check? [
- index direction + str
+ index str backwards? check [
+ index backwards? advance str
index str nth-unsafe
quot call
] when ; inline
-: direction ( -- n )
- backwards? get -1 1 ? ;
-
: transitions>quot ( transitions final-state? -- quot )
dup shortest? get and [ 2drop [ drop nip ] ] [
- [ split-literals swap case>quot ] dip direction
- '[ { array-capacity string } declare _ _ _ step ]
+ [ split-literals swap case>quot ] dip backwards? get
+ '[ { fixnum string } declare _ _ _ step ]
] if ;
: word>quot ( word dfa -- quot )
: dfa>main-word ( dfa -- word )
states>words [ states>code ] keep start-state>> ;
+: word-template ( quot -- quot' )
+ '[ drop [ f ] 2dip over array-capacity? _ [ 2drop ] if ] ;
+
PRIVATE>
: dfa>word ( dfa -- quot )
- dfa>main-word execution-quot '[ drop [ f ] 2dip @ ]
+ dfa>main-word execution-quot word-template
(( start-index string regexp -- i/f )) define-temp ;
: dfa>shortest-word ( dfa -- word )
<PRIVATE
MACRO: binary-roman-op ( quot -- quot' )
- dup infer [ in>> swap ] [ out>> ] bi
+ [ infer in>> ] [ ] [ infer out>> ] tri
'[ [ roman> ] _ napply @ [ >roman ] _ napply ] ;
PRIVATE>
--- /dev/null
+IN: see.tests
+USING: see tools.test io.streams.string math ;
+
+CONSTANT: test-const 10
+[ "IN: see.tests\nCONSTANT: test-const 10 inline\n" ]
+[ [ \ test-const see ] with-string-writer ] unit-test
+
+ALIAS: test-alias +
+
+[ "USING: math ;\nIN: see.tests\nALIAS: test-alias + inline\n" ]
+[ [ \ test-alias see ] with-string-writer ] unit-test
io.streams.string io.styles kernel make namespaces prettyprint
prettyprint.backend prettyprint.config prettyprint.custom
prettyprint.sections sequences sets sorting strings summary
-words words.symbol ;
+words words.symbol words.constant words.alias ;
IN: see
GENERIC: synopsis* ( defspec -- )
: comment. ( text -- )
H{ { font-style italic } } styled-text ;
+GENERIC: print-stack-effect? ( word -- ? )
+
+M: parsing-word print-stack-effect? drop f ;
+M: symbol print-stack-effect? drop f ;
+M: constant print-stack-effect? drop f ;
+M: alias print-stack-effect? drop f ;
+M: word print-stack-effect? drop t ;
+
: stack-effect. ( word -- )
- [ [ parsing-word? ] [ symbol? ] bi or not ] [ stack-effect ] bi and
+ [ print-stack-effect? ] [ stack-effect ] bi and
[ effect>string comment. ] when* ;
<PRIVATE
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! 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
}
{ $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 } ;
-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
! 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<=> ;
-
-: 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 >>
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
}
{ $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"
! 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 ;
[ { } ]
[ { } { { a>> <=> } { b>> >=< } { c>> <=> } } sort-by-slots ] unit-test
+[ { } ]
+[ { } { } sort-by-slots ] unit-test
+
[
{
T{ sort-test { a 6 } { tuple2 T{ tuple2 { d 1 } } } }
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
<PRIVATE
+: short-circuit-comparator ( obj1 obj2 word -- comparator/? )
+ execute dup +eq+ eq? [ drop f ] when ; inline
+
: slot-comparator ( seq -- quot )
[
but-last-slice
[ '[ [ _ execute ] bi@ ] ] map concat
] [
peek
- '[ @ _ execute dup +eq+ eq? [ drop f ] when ]
+ '[ @ _ short-circuit-comparator ]
] bi ;
PRIVATE>
#! sort-spec: { accessors comparator }
[ slot-comparator ] map '[ _ 2|| +eq+ or ] ;
-: sort-by-slots ( seq sort-specs -- seq' )
- '[ _ compare-slots ] sort ;
+MACRO: sort-by-slots ( sort-specs -- quot )
+ '[ [ _ compare-slots ] sort ] ;
+
+MACRO: compare-seq ( seq -- quot )
+ [ '[ _ short-circuit-comparator ] ] map '[ _ 2|| +eq+ or ] ;
+
+MACRO: sort-by ( sort-seq -- quot )
+ '[ [ _ compare-seq ] sort ] ;
+
+MACRO: sort-keys-by ( sort-seq -- quot )
+ '[ [ first ] bi@ _ compare-seq ] sort ;
+
+MACRO: sort-values-by ( sort-seq -- quot )
+ '[ [ second ] bi@ _ compare-seq ] sort ;
MACRO: split-by-slots ( accessor-seqs -- quot )
[ [ '[ [ _ execute ] bi@ ] ] map concat [ = ] compose ] map
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! 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
--- /dev/null
+! 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 >>
\ fflush { alien } { } define-primitive
+\ fseek { alien integer integer } { } define-primitive
+
\ fclose { alien } { } define-primitive
\ <wrapper> { object } { wrapper } define-primitive
{ $values { "url" url } { "feed" feed } }
{ $description "Downloads a feed from a URL using the " { $link "http.client" } "." } ;
-HELP: string>feed
-{ $values { "string" string } { "feed" feed } }
-{ $description "Parses a feed in string form." } ;
+HELP: parse-feed
+{ $values { "seq" "a string or a byte array" } { "feed" feed } }
+{ $description "Parses a feed." } ;
HELP: xml>feed
{ $values { "xml" xml } { "feed" feed } }
{ $subsection <entry> }
"Reading feeds:"
{ $subsection download-feed }
-{ $subsection string>feed }
+{ $subsection parse-feed }
{ $subsection xml>feed }
"Writing feeds:"
{ $subsection feed>xml }
-USING: syndication io kernel io.files tools.test io.encodings.utf8
+USING: syndication io kernel io.files tools.test io.encodings.binary
calendar urls xml.writer ;
IN: syndication.tests
: load-news-file ( filename -- feed )
#! Load an news syndication file and process it, returning
#! it as an feed tuple.
- utf8 file-contents string>feed ;
+ binary file-contents parse-feed ;
[ T{
feed
! Copyright (C) 2006 Chris Double, Daniel Ehrenberg.
-! Portions copyright (C) 2008 Slava Pestov.
+! Portions copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: xml.traversal kernel assocs math.order
- strings sequences xml.data xml.writer
- io.streams.string combinators xml xml.entities.html io.files io
- http.client namespaces make xml.syntax hashtables
- calendar.format accessors continuations urls present ;
+USING: xml.traversal kernel assocs math.order strings sequences
+xml.data xml.writer io.streams.string combinators xml
+xml.entities.html io.files io http.client namespaces make
+xml.syntax hashtables calendar.format accessors continuations
+urls present byte-arrays ;
IN: syndication
: any-tag-named ( tag names -- tag-inside )
{ "feed" [ atom1.0 ] }
} case ;
-: string>feed ( string -- feed )
- [ string>xml xml>feed ] with-html-entities ;
+GENERIC: parse-feed ( seq -- feed )
+
+M: string parse-feed [ string>xml xml>feed ] with-html-entities ;
+
+M: byte-array parse-feed [ bytes>xml xml>feed ] with-html-entities ;
: download-feed ( url -- feed )
#! Retrieve an news syndication file, return as a feed tuple.
- http-get nip string>feed ;
+ http-get nip parse-feed ;
! Atom generation
: 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
"specializer"
"step-into"
"step-into?"
+ ! UI needs this
+ ! "superclass"
"transform-n"
"transform-quot"
"tuple-dispatch-generic"
lexer-factory
print-use-hook
root-cache
- vocab-roots
vocabs:dictionary
vocabs:load-vocab-hook
word
: 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
: 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*
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test tools.scaffold unicode.case kernel
+multiline tools.scaffold.private io.streams.string ;
+IN: tools.scaffold.tests
+
+: undocumented-word ( obj1 obj2 -- obj3 obj4 )
+ [ >lower ] [ >upper ] bi* ;
+
+[
+<" HELP: undocumented-word
+{ $values
+ { "obj1" object } { "obj2" object }
+ { "obj3" object } { "obj4" object }
+}
+{ $description "" } ;
+">
+]
+[
+ [ \ undocumented-word (help.) ] with-string-writer
+] unit-test
vocabulary>> using get [ conjoin ] [ drop ] if* ;
: ($values.) ( array -- )
- [
+ [ bl ] [
"{ " write
dup array? [ first ] when
dup lookup-type [
null add-using
] if
" }" write
- ] each ;
+ ] interleave ;
: 4bl ( -- )
" " write ; inline
: with-gl-context ( handle quot -- )
swap [ select-gl-context call ] keep
- glFlush flush-gl-context gl-error ; inline
+ flush-gl-context gl-error ; inline
HOOK: (with-ui) ui-backend ( quot -- )
\ No newline at end of file
! 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
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
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 ]
! 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 ;
: 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 ;
CONSTANT: vertical { 0 1 }
TUPLE: gadget < rect
+id
pref-dim
parent
children
M: gadget equal? 2drop f ;
-M: gadget hashcode* drop gadget hashcode* ;
+M: gadget hashcode* nip [ [ \ gadget counter ] unless* ] change-id id>> ;
M: gadget model-changed 2drop ;
: 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
: pane-caret&mark ( pane -- caret mark )
[ caret>> ] [ mark>> ] bi ; inline
-: selected-children ( pane -- seq )
+: selected-subtree ( pane -- seq )
[ pane-caret&mark sort-pair ] keep gadget-subtree ;
M: pane gadget-selection? pane-caret&mark and ;
M: pane gadget-selection ( pane -- string/f )
- selected-children gadget-text ;
+ selected-subtree gadget-text ;
: init-prototype ( pane -- pane )
<shelf> +baseline+ >>align >>prototype ; inline
[ >>last-line ] [ 1 track-add ] bi
dup prepare-last-line ; inline
-GENERIC: draw-selection ( loc obj -- )
-
-: if-fits ( rect quot -- )
- [ clip get over contains-rect? ] dip [ drop ] if ; inline
-
-M: gadget draw-selection ( loc gadget -- )
- swap offset-rect [
- rect-bounds gl-fill-rect
- ] if-fits ;
-
-M: node draw-selection ( loc node -- )
- 2dup value>> swap offset-rect [
- drop 2dup
- [ value>> loc>> v+ ] keep
- children>> [ draw-selection ] with each
- ] if-fits 2drop ;
-
-M: pane draw-gadget*
+M: pane selected-children
dup gadget-selection? [
- [ selection-color>> gl-color ]
- [
- [ loc>> vneg ] keep selected-children
- [ draw-selection ] with each
- ] bi
- ] [ drop ] if ;
+ [ selected-subtree leaves ]
+ [ selection-color>> ]
+ bi
+ ] [ drop f f ] if ;
: scroll-pane ( pane -- )
dup scrolls?>> [ scroll>bottom ] [ drop ] if ;
{ $values { "gadget" gadget } { "scroller/f" { $maybe scroller } } }
{ $description "Finds the first parent of " { $snippet "gadget" } " which is a " { $link scroller } ". Outputs " { $link f } " if the gadget is not contained in a " { $link scroller } "." } ;
-HELP: scroller-value
+HELP: scroll-position
{ $values { "scroller" scroller } { "loc" "a pair of integers" } }
{ $description "Outputs the offset of the top-left corner of the scroller's " { $link viewport } "'s child." } ;
-{ scroller-value scroll scroll>bottom scroll>top scroll>rect } related-words
+{ scroll-position set-scroll-position scroll>bottom scroll>top scroll>rect } related-words
HELP: <scroller>
{ $values { "gadget" gadget } { "scroller" "a new " { $link scroller } } }
{ <viewport> <scroller> } related-words
-HELP: scroll
+HELP: set-scroll-position
{ $values { "scroller" scroller } { "value" "a pair of integers" } }
{ $description "Sets the offset of the top-left corner of the scroller's " { $link viewport } "'s child." } ;
{ $subsection scroller }
{ $subsection <scroller> }
"Getting and setting the scroll position:"
-{ $subsection scroller-value }
-{ $subsection scroll }
+{ $subsection scroll-position }
+{ $subsection set-scroll-position }
"Writing scrolling-aware gadgets:"
{ $subsection scroll>bottom }
{ $subsection scroll>top }
[ { 100 100 } ] [ "s" get viewport>> gadget-child pref-dim ] unit-test
- [ ] [ { 0 0 } "s" get scroll ] unit-test
+ [ ] [ { 0 0 } "s" get set-scroll-position ] unit-test
[ { 0 0 } ] [ "s" get model>> range-min-value ] unit-test
[ { 100 100 } ] [ "s" get model>> range-max-value ] unit-test
- [ ] [ { 10 20 } "s" get scroll ] unit-test
+ [ ] [ { 10 20 } "s" get set-scroll-position ] unit-test
[ { 10 20 } ] [ "s" get model>> range-value ] unit-test
drop
"g2" get scroll>gadget
"s" get layout
- "s" get scroller-value
+ "s" get scroll-position
] map [ { 0 0 } = ] all?
] unit-test
: scroll-down-line ( scroller -- ) y>> 1 swap slide-by-line ;
+: set-scroll-position ( value scroller -- )
+ [
+ viewport>> [ dim>> { 0 0 } ] [ gadget-child pref-dim ] bi
+ 4array flip
+ ] keep
+ 2dup control-value = [ 2drop ] [ set-control-value ] if ;
+
<PRIVATE
: do-mouse-scroll ( scroller -- )
M: viewport pref-dim* gadget-child pref-viewport-dim ;
-: scroll ( value scroller -- )
- [
- viewport>> [ dim>> { 0 0 } ] [ gadget-child pref-dim ] bi
- 4array flip
- ] keep
- 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 ]
+ [ scroll-position 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 ]
+ [ scroll-position v+ ]
+ [ set-scroll-position ]
} cleave ;
: relative-scroll-rect ( rect gadget scroller -- newrect )
2&& ;
: (update-scroller) ( scroller -- )
- [ scroller-value ] keep scroll ;
+ [ scroll-position ] keep set-scroll-position ;
: (scroll>gadget) ( gadget scroller -- )
2dup swap child? [
] [ f >>follows (update-scroller) drop ] if ;
: (scroll>bottom) ( scroller -- )
- [ viewport>> gadget-child pref-dim { 0 1 } v* ] keep scroll ;
+ [ viewport>> gadget-child pref-dim { 0 1 } v* ] keep
+ set-scroll-position ;
GENERIC: update-scroller ( scroller follows -- )
--- /dev/null
+IN: ui.gadgets.search-tables.tests
+USING: ui.gadgets.search-tables sequences tools.test ;
+[ [ second ] <search-table> ] must-infer
: <search-field> ( model -- gadget )
horizontal search-field new-track
+ 0 >>fill
{ 5 5 } >>gap
+baseline+ >>align
swap <model-field> 10 >>min-cols >>field
: 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>
[ 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
: 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
M: viewport focusable-child*
gadget-child ;
-: scroller-value ( scroller -- loc )
+: scroll-position ( scroller -- loc )
model>> range-value [ >integer ] map ;
M: viewport model-changed
[ relayout-1 ]
[
[ gadget-child ]
- [ scroller-value vneg ]
+ [ scroll-position vneg ]
[ constraint>> ]
tri v* >>loc drop
] bi ;
USING: accessors arrays assocs continuations kernel math models
namespaces opengl sequences io combinators combinators.short-circuit
fry math.vectors math.rectangles cache ui.gadgets ui.gestures
-ui.render ui.text ui.text.private ui.backend ui.gadgets.tracks
-ui.commands ;
+ui.render ui.backend ui.gadgets.tracks ui.commands ;
IN: ui.gadgets.worlds
TUPLE: world < track
swap >>status
swap >>title
swap 1 track-add
- dup init-text-rendering
dup request-focus ;
: <world> ( gadget title status -- world )
2dup layers>> memq?
[ layers>> delq ] [ call-next-method ] if ;
+SYMBOL: flush-layout-cache-hook
+
+flush-layout-cache-hook [ [ ] ] initialize
+
: (draw-world) ( world -- )
dup handle>> [
{
[ init-gl ]
[ draw-gadget ]
- [ finish-text-rendering ]
+ [ text-handle>> [ purge-cache ] when* ]
[ images>> [ purge-cache ] when* ]
} cleave
- ] with-gl-context ;
+ ] with-gl-context
+ flush-layout-cache-hook get call( -- ) ;
: draw-world? ( world -- ? )
#! We don't draw deactivated worlds, or those with 0 size.
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: math.rectangles math.vectors namespaces kernel accessors
-combinators sequences opengl opengl.gl opengl.glu colors
+assocs combinators sequences opengl opengl.gl opengl.glu colors
colors.constants ui.gadgets ui.pens ;
IN: ui.render
GENERIC: draw-children ( gadget -- )
+! For gadget selection
+SYMBOL: selected-gadgets
+
+SYMBOL: selection-background
+
+GENERIC: selected-children ( gadget -- assoc/f selection-background )
+
+M: gadget selected-children drop f f ;
+
+! For text rendering
+SYMBOL: background
+
+SYMBOL: foreground
+
+GENERIC: gadget-background ( gadget -- color )
+
+M: gadget gadget-background dup interior>> pen-background ;
+
+GENERIC: gadget-foreground ( gadget -- color )
+
+M: gadget gadget-foreground dup interior>> pen-foreground ;
+
+<PRIVATE
+
+: draw-selection-background ( gadget -- )
+ selection-background get background set
+ selection-background get gl-color
+ [ { 0 0 } ] dip dim>> gl-fill-rect ;
+
+: draw-standard-background ( object -- )
+ dup interior>> dup [ draw-interior ] [ 2drop ] if ;
+
+: draw-background ( gadget -- )
+ origin get [
+ [
+ dup selected-gadgets get key?
+ [ draw-selection-background ]
+ [ draw-standard-background ] if
+ ] [ draw-gadget* ] bi
+ ] with-translation ;
+
+: draw-border ( object -- )
+ dup boundary>> dup [
+ origin get [ draw-boundary ] with-translation
+ ] [ 2drop ] if ;
+
+PRIVATE>
+
: (draw-gadget) ( gadget -- )
dup loc>> origin get v+ origin [
- [
- origin get [
- [ dup interior>> dup [ draw-interior ] [ 2drop ] if ]
- [ draw-gadget* ]
- bi
- ] with-translation
- ]
- [ draw-children ]
- [
- dup boundary>> dup [
- origin get [ draw-boundary ] with-translation
- ] [ 2drop ] if
- ] tri
+ [ draw-background ] [ draw-children ] [ draw-border ] tri
] with-variable ;
: >absolute ( rect -- rect )
[ [ (draw-gadget) ] with-clipping ]
} cond ;
-! For text rendering
-SYMBOL: background
-
-SYMBOL: foreground
-
-GENERIC: gadget-background ( gadget -- color )
-
-M: gadget gadget-background dup interior>> pen-background ;
-
-GENERIC: gadget-foreground ( gadget -- color )
-
-M: gadget gadget-foreground dup interior>> pen-foreground ;
-
M: gadget draw-children
- [ visible-children ]
- [ gadget-background ]
- [ gadget-foreground ] tri [
- [ foreground set ] when*
- [ background set ] when*
- [ draw-gadget ] each
- ] with-scope ;
+ dup children>> [
+ {
+ [ visible-children ]
+ [ selected-children ]
+ [ gadget-background ]
+ [ gadget-foreground ]
+ } cleave [
+
+ {
+ [ [ selected-gadgets set ] when* ]
+ [ [ selection-background set ] when* ]
+ [ [ background set ] when* ]
+ [ [ foreground set ] when* ]
+ } spread
+ [ draw-gadget ] each
+ ] with-scope
+ ] [ drop ] if ;
CONSTANT: selection-color T{ rgba f 0.8 0.8 1.0 1.0 }
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>> ]
if-empty ;
-M: core-text-renderer finish-text-rendering
- text-handle>> purge-cache
+M: core-text-renderer flush-layout-cache
cached-lines get purge-cache ;
: rendered-line ( font string -- texture )
- world get text-handle>>
- [ cached-line [ image>> ] [ loc>> ] bi <texture> ]
- 2cache ;
+ world get world-text-handle [
+ cached-line [ image>> ] [ loc>> ] bi <texture>
+ ] 2cache ;
M: core-text-renderer draw-string ( font string -- )
rendered-line draw-texture ;
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 ;
-M: pango-renderer finish-text-rendering
- text-handle>> purge-cache
+M: pango-renderer flush-layout-cache
cached-layouts get purge-cache ;
: rendered-layout ( font string -- texture )
- world get text-handle>>
- [ cached-layout [ image>> ] [ text-position vneg ] bi <texture> ]
- 2cache ;
+ world get world-text-handle [
+ cached-layout [ image>> ] [ text-position vneg ] bi <texture>
+ ] 2cache ;
M: pango-renderer draw-string ( font string -- )
rendered-layout draw-texture ;
--- /dev/null
+UI text rendering implementation using cross-platform Pango library\r
! 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
! 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 ;
+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>> [ <cache-assoc> >>text-handle ] unless
+ text-handle>> ;
-HOOK: finish-text-rendering font-renderer ( world -- )
+HOOK: flush-layout-cache font-renderer ( -- )
-M: object finish-text-rendering drop ;
+[ flush-layout-cache ] flush-layout-cache-hook set-global
HOOK: string-dim font-renderer ( font string -- dim )
M: selection draw-text draw-string ;
M: array draw-text
- GL_MODELVIEW [
+ [
[
[ draw-string ]
[ [ 0.0 ] 2dip string-height 0.0 glTranslated ] 2bi
] with each
- ] do-matrix ;
\ No newline at end of file
+ ] do-matrix ;
+
+USING: vocabs.loader namespaces system combinators ;
+
+"ui-backend" get [
+ {
+ { [ os macosx? ] [ "core-text" ] }
+ { [ os windows? ] [ "uniscribe" ] }
+ { [ os unix? ] [ "pango" ] }
+ } cond
+] unless* "ui.text." prepend require
\ No newline at end of file
--- /dev/null
+Slava Pestov\r
--- /dev/null
+UI text rendering implementation using the MS Windows Uniscribe library\r
--- /dev/null
+unportable\r
--- /dev/null
+! 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 } <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
IN: ui.tools.browser
ARTICLE: "ui-browser" "UI browser"
-"The browser is used to display Factor code, documentation, and vocabularies. The browser is opened when a word or articlelink presentation is clicked. It can also be opened using words:"
+"The browser is used to display Factor code, documentation, and vocabularies. The browser is opened when a word or article link presentation is clicked. It can also be opened using words:"
{ $subsection com-browse }
{ $subsection browser-window }
{ $command-map browser-gadget "toolbar" }
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: debugger help help.topics help.crossref help.home kernel
-models compiler.units assocs words vocabs accessors fry
-combinators.short-circuit namespaces sequences models
-models.history help.apropos combinators ui.commands ui.gadgets
-ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
-ui.gestures ui.gadgets.buttons ui.gadgets.packs
-ui.gadgets.editors ui.gadgets.labels ui.gadgets.status-bar
-ui.gadgets.glass ui.gadgets.borders ui.tools.common
-ui.tools.browser.popups ui ;
+USING: debugger help help.topics help.crossref help.home kernel models
+compiler.units assocs words vocabs accessors fry arrays
+combinators.short-circuit namespaces sequences models help.apropos
+combinators ui ui.commands ui.gadgets ui.gadgets.panes
+ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.gadgets.buttons
+ui.gadgets.packs ui.gadgets.editors ui.gadgets.labels
+ui.gadgets.status-bar ui.gadgets.glass ui.gadgets.borders ui.gadgets.viewports
+ui.tools.common ui.tools.browser.popups ui.tools.browser.history ;
IN: ui.tools.browser
-TUPLE: browser-gadget < tool pane scroller search-field popup ;
+TUPLE: browser-gadget < tool history pane scroller search-field popup ;
{ 650 400 } browser-gadget set-tool-dim
+M: browser-gadget history-value
+ [ control-value ] [ scroller>> scroll-position ]
+ bi 2array ;
+
+M: browser-gadget set-history-value
+ [ first2 ] dip
+ [ set-control-value ] [ scroller>> set-scroll-position ]
+ bi-curry bi* ;
+
: show-help ( link browser-gadget -- )
- [ >link ] [ model>> ] bi*
- [ [ add-recent ] [ add-history ] bi* ] [ set-model ] 2bi ;
+ [ >link ] dip
+ [ [ add-recent ] [ history>> add-history ] bi* ]
+ [ model>> set-model ]
+ 2bi ;
: <help-pane> ( browser-gadget -- gadget )
model>> [ '[ _ print-topic ] try ] <pane-control> ;
: <browser-gadget> ( link -- gadget )
vertical browser-gadget new-track
1 >>fill
- swap >link <history> >>model
+ swap >link <model> >>model
+ dup <history> >>history
dup <search-field> >>search-field
dup <browser-toolbar> { 3 3 } <border> { 1 0 } >>fill f track-add
dup <help-pane> >>pane
\ show-browser H{ { +nullary+ t } } define-command
-: com-back ( browser -- ) model>> go-back ;
+: com-back ( browser -- ) history>> go-back ;
-: com-forward ( browser -- ) model>> go-forward ;
+: com-forward ( browser -- ) history>> go-forward ;
: com-home ( browser -- ) "help.home" swap show-help ;
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+USING: namespaces ui.tools.browser.history sequences tools.test ;
+IN: ui.tools.browser.history.tests
+
+f <history> "history" set
+
+"history" get add-history
+
+[ t ] [ "history" get back>> empty? ] unit-test
+[ t ] [ "history" get forward>> empty? ] unit-test
+
+"history" get add-history
+"history" get 3 >>value drop
+
+[ t ] [ "history" get back>> empty? ] unit-test
+[ t ] [ "history" get forward>> empty? ] unit-test
+
+"history" get add-history
+"history" get 4 >>value drop
+
+[ f ] [ "history" get back>> empty? ] unit-test
+[ t ] [ "history" get forward>> empty? ] unit-test
+
+"history" get go-back
+
+[ 3 ] [ "history" get value>> ] unit-test
+
+[ t ] [ "history" get back>> empty? ] unit-test
+[ f ] [ "history" get forward>> empty? ] unit-test
+
+"history" get go-forward
+
+[ 4 ] [ "history" get value>> ] unit-test
+
+[ f ] [ "history" get back>> empty? ] unit-test
+[ t ] [ "history" get forward>> empty? ] unit-test
+
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors sequences locals ;
+IN: ui.tools.browser.history
+
+TUPLE: history owner back forward ;
+
+: <history> ( owner -- history )
+ V{ } clone V{ } clone history boa ;
+
+GENERIC: history-value ( object -- value )
+
+GENERIC: set-history-value ( value object -- )
+
+: (add-history) ( history to -- )
+ swap owner>> history-value dup [ swap push ] [ 2drop ] if ;
+
+:: go-back/forward ( history to from -- )
+ from empty? [
+ history to (add-history)
+ from pop history owner>> set-history-value
+ ] unless ;
+
+: go-back ( history -- )
+ dup [ forward>> ] [ back>> ] bi go-back/forward ;
+
+: go-forward ( history -- )
+ dup [ back>> ] [ forward>> ] bi go-back/forward ;
+
+: add-history ( history -- )
+ dup forward>> delete-all
+ dup back>> (add-history) ;
\ No newline at end of file
t >>selection-required?
t >>single-click?
30 >>min-cols
+ 10 >>min-rows
10 >>max-rows
dup '[ _ accept-completion ] >>action ;
: listener-run-files ( seq -- )
[
- [ \ listener-run-files ] dip
- '[ _ [ run-file ] each ] call-listener
+ '[ _ [ run-file ] each ]
+ \ listener-run-files
+ call-listener
] unless-empty ;
: com-end ( listener -- )
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors namespaces make sequences kernel math arrays io
-ui.gadgets generic combinators ;
+ui.gadgets generic combinators fry sets ;
IN: ui.traverse
TUPLE: node value children ;
: gadget-at-path ( parent path -- gadget )
[ swap nth-gadget ] each ;
+
+GENERIC# leaves* 1 ( tree assoc -- )
+
+M: node leaves* [ children>> ] dip leaves* ;
+
+M: array leaves* '[ _ leaves* ] each ;
+
+M: gadget leaves* conjoin ;
+
+: leaves ( tree -- assoc ) H{ } clone [ leaves* ] keep ;
\ No newline at end of file
deques sequences threads sequences words continuations init
combinators hashtables concurrency.flags sets accessors calendar fry
destructors ui.gadgets ui.gadgets.private ui.gadgets.worlds
-ui.gadgets.tracks ui.gestures ui.backend ui.render ui.text
-ui.text.private ;
+ui.gadgets.tracks ui.gestures ui.backend ui.render ;
IN: ui
<PRIVATE
: (ungraft-world) ( world -- )
{
[ handle>> select-gl-context ]
- [ text-handle>> dispose ]
+ [ text-handle>> [ dispose ] when* ]
[ images>> [ dispose ] when* ]
[ hand-clicked close-global ]
[ hand-gadget close-global ]
: restore-world ( world -- )
{
[ reset-world ]
- [ init-text-rendering ]
- [ f >>images drop ]
+ [ f >>text-handle f >>images drop ]
[ restore-gadget ]
} cleave ;
[ 3 ] [ "\u001112\u001161\u0011abA\u000300a"
dup last-grapheme head last-grapheme ] unit-test
+[ 3 ] [ 2 "hello" first-grapheme-from ] unit-test
+[ 1 ] [ 2 "hello" last-grapheme-from ] unit-test
+
: grapheme-break-test ( -- filename )
"vocab:unicode/breaks/GraphemeBreakTest.txt" ;
[ grapheme-class [ nip ] [ grapheme-break? ] 2bi ] find drop
nip swap length or 1+ ;
+: first-grapheme-from ( start str -- i )
+ over tail-slice first-grapheme + ;
+
+: last-grapheme ( str -- i )
+ unclip-last-slice grapheme-class swap
+ [ grapheme-class dup rot grapheme-break? ] find-last drop ?1+ nip ;
+
+: last-grapheme-from ( end str -- i )
+ swap head-slice last-grapheme ;
+
<PRIVATE
: >pieces ( str quot: ( str -- i ) -- graphemes )
: string-reverse ( str -- rts )
>graphemes reverse concat ;
-: last-grapheme ( str -- i )
- unclip-last-slice grapheme-class swap
- [ grapheme-class dup rot grapheme-break? ] find-last drop ?1+ nip ;
-
<PRIVATE
graphemes init-table table
[ "Lo" ] [ HEX: 3450 category ] unit-test
[ "Lo" ] [ HEX: 4DB5 category ] unit-test
[ "Cs" ] [ HEX: DD00 category ] unit-test
+[ t ] [ CHAR: \t blank? ] unit-test
+[ t ] [ CHAR: \s blank? ] unit-test
+[ t ] [ CHAR: \r blank? ] unit-test
+[ t ] [ CHAR: \n blank? ] unit-test
+[ f ] [ CHAR: a blank? ] unit-test
USING: unicode.categories.syntax sequences unicode.data ;
IN: unicode.categories
-CATEGORY: blank Zs Zl Zp | "\r\n" member? ;
+CATEGORY: blank Zs Zl Zp | "\r\n\t" member? ;
CATEGORY: letter Ll | "Other_Lowercase" property? ;
CATEGORY: LETTER Lu | "Other_Uppercase" property? ;
CATEGORY: Letter Lu Ll Lt Lm Lo Nl ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel present prettyprint.custom prettyprint.backend urls ;
+USING: kernel present prettyprint.custom prettyprint.sections
+prettyprint.backend urls ;
IN: urls.prettyprint
-M: url pprint* dup present "URL\" " "\"" pprint-string ;
+M: url pprint*
+ \ URL" record-vocab
+ dup present "URL\" " "\"" pprint-string ;
} ;
HELP: ensure-port
-{ $values { "url" url } }
-{ $description "If the URL does not specify a port number, fill in the default for the URL's protocol. If the protocol is unknown, the port number is not changed." }
-{ $side-effects "url" }
+{ $values { "url" url } { "url'" url } }
+{ $description "If the URL does not specify a port number, create a new URL which is equal except the port number is set to the default for the URL's protocol. If the protocol is unknown, outputs an exact copy of the input URL." }
{ $examples
{ $example
"USING: accessors prettyprint urls ;"
IN: urls.tests
-USING: urls urls.private tools.test
+USING: urls urls.private tools.test prettyprint
arrays kernel assocs present accessors ;
CONSTANT: urls
[ "http://localhost/?foo=bar" >url ] unit-test
[ "/" ] [ "http://www.jedit.org" >url path>> ] unit-test
+
+[ "USING: urls ;\nURL\" foo\"" ] [ URL" foo" unparse-use ] unit-test
\ No newline at end of file
] [ protocol>> ] bi
secure-protocol? [ >secure-addr ] when ;
-: ensure-port ( url -- url )
- dup protocol>> '[ _ protocol-port or ] change-port ;
+: ensure-port ( url -- url' )
+ clone dup protocol>> '[ _ protocol-port or ] change-port ;
! Literal syntax
SYNTAX: URL" lexer get skip-blank parse-string >url parsed ;
--- /dev/null
+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
-! 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
! 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
! FUNCTION: CreateRoundRectRgn
! FUNCTION: CreateScalableFontResourceA
! FUNCTION: CreateScalableFontResourceW
-! FUNCTION: CreateSolidBrush
+FUNCTION: HBRUSH CreateSolidBrush ( COLORREF colorref ) ;
! FUNCTION: DdEntry0
! FUNCTION: DdEntry1
! FUNCTION: DdEntry10
! 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
! 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
! FUNCTION: GetTextFaceAliasW
! FUNCTION: GetTextFaceW
! FUNCTION: GetTextMetricsA
-! FUNCTION: GetTextMetricsW
+FUNCTION: BOOL GetTextMetricsW ( HDC hdc, LPTEXTMETRIC lptm ) ;
+ALIAS: GetTextMetrics GetTextMetricsW
! FUNCTION: GetTransform
! FUNCTION: GetViewportExtEx
! FUNCTION: GetViewportOrgEx
! 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
! 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
! 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
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+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
--- /dev/null
+! 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
--- /dev/null
+Utility words for memory DCs and bitmaps\r
--- /dev/null
+unportable\r
! 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
{ "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" }
{ "LONG" "x" }
{ "LONG" "y" } ;
+C-STRUCT: SIZE
+ { "LONG" "cx" }
+ { "LONG" "cy" } ;
+
C-STRUCT: MSG
{ "HWND" "hWnd" }
{ "UINT" "message" }
{ "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
{ "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
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+High-level wrapper around Uniscribe binding\r
--- /dev/null
+unportable\r
--- /dev/null
+! 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) ;
+
+:: make-script-string-image ( dc script-string -- image )
+ script-string 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
! 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
SCRIPT_STRING_ANALYSIS* pssa
) ;
+DESTRUCTOR: ScriptStringFree
+
FUNCTION: SIZE* ScriptString_pSize ( SCRIPT_STRING_ANALYSIS ssa ) ;
FUNCTION: int* ScriptString_pcOutChars ( SCRIPT_STRING_ANALYSIS ssa ) ;
! 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
<" int x = "hi";
/* a comment */ "> <string-reader> htmlize-stream
write-xml
+] unit-test
+
+[ "<span class=\"MARKUP\">: foo</span> <span class=\"MARKUP\">;</span>" ] [
+ { ": foo ;" } "factor" htmlize-lines xml>string
+] unit-test
+
+[ ":foo" ] [
+ { ":foo" } "factor" htmlize-lines xml>string
] unit-test
\ No newline at end of file
] keep string>> length and ;
M: regexp text-matches?
- [ >string ] dip re-contains? ;
+ [ >string ] dip first-match dup [ to>> ] when ;
: rule-start-matches? ( rule -- match-count/f )
dup start>> tuck swap can-match-here? [
+++ /dev/null
-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
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
cd_factor
make_factor
get_boot_image
- maybe_download_dlls
bootstrap
}
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 ;;
USING: accessors alien alien.accessors alien.syntax byte-arrays arrays
kernel kernel.private namespaces tools.test sequences libc math
-system prettyprint layouts alien.libraries ;
+system prettyprint layouts alien.libraries sets ;
IN: alien.tests
[ t ] [ -1 <alien> alien-address 0 > ] unit-test
[ ] [ initialize-test get BAD-ALIEN >>alien drop ] unit-test
[ 7575 ] [ initialize-test [ 7575 ] initialize-alien ] unit-test
+
+[ V{ BAD-ALIEN } ] [ { BAD-ALIEN BAD-ALIEN BAD-ALIEN } prune ] unit-test
\ No newline at end of file
2drop f
] if ;
+M: simple-alien hashcode* nip dup expired>> [ drop 1234 ] [ alien-address ] if ;
+
ERROR: alien-callback-error ;
: alien-callback ( return parameters abi quot -- alien )
{ "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 )) }
scan {
{ "(" [ ")" parse-effect ] }
{ f [ ")" unexpected-eof ] }
+ [ bad-effect ]
} case 2array
] when
] if
"(" expect ")" parse-effect ;
: parse-call( ( accum word -- accum )
- [ ")" parse-effect ] dip 2array over push-all ;
\ No newline at end of file
+ [ ")" parse-effect ] dip 2array over push-all ;
: grow-hash ( hash -- )
[ [ >alist ] [ assoc-size 1+ ] bi ] keep
[ reset-hash ] keep
- swap (rehash) ; inline
+ swap (rehash) ;
: ?grow-hash ( hash -- )
dup hash-large? [
PRIVATE>
: <hashtable> ( n -- hash )
- hashtable new [ reset-hash ] keep ;
+ hashtable new [ reset-hash ] keep ; inline
M: hashtable at* ( key hash -- value ? )
key@ [ 3 fixnum+fast slot t ] [ 2drop f f ] if ;
-! 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 ;
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 ;
[ 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 ;
: bind ( ns quot -- ) swap >n call ndrop ; inline
: counter ( variable -- n ) global [ 0 or 1+ dup ] change-at ;
: make-assoc ( quot exemplar -- hash ) 20 swap new-assoc [ swap bind ] keep ; inline
-: with-scope ( quot -- ) H{ } clone swap bind ; inline
+: with-scope ( quot -- ) 5 <hashtable> swap bind ; inline
: with-variable ( value key quot -- ) [ associate ] dip bind ; inline
: initialize ( variable quot -- ) [ global ] dip [ unless* ] curry change-at ; inline
\ No newline at end of file
HELP: map-index
{ $values
- { "seq" sequence } { "quot" quotation } }
+ { "seq" sequence } { "quot" quotation } { "newseq" sequence } }
{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the input sequence." }
{ $examples { $example "USING: sequences prettyprint math ;"
"{ 10 20 30 } [ + ] map-index ."
[ [ 0 = ] 2dip if ] 2curry
each-index ; inline
-: map-index ( seq quot -- )
+: map-index ( seq quot -- newseq )
prepare-index 2map ; inline
: reduce-index ( seq identity quot -- )
"writing" associate ;
: define-writer-generic ( name -- )
- writer-word (( object value -- )) define-simple-generic ;
+ writer-word (( value object -- )) define-simple-generic ;
: define-writer ( class slot-spec -- )
[ nip name>> define-writer-generic ] [
{ $examples { $example "USE: prettyprint" "BIN: 100 ." "4" } } ;
HELP: GENERIC:
-{ $syntax "GENERIC: word" "GENERIC: word ( stack -- effect )" }
+{ $syntax "GENERIC: word ( stack -- effect )" }
{ $values { "word" "a new word to define" } }
{ $description "Defines a new generic word in the current vocabulary. Initially, it contains no methods, and thus will throw a " { $link no-method } " error when called." } ;
HELP: GENERIC#
-{ $syntax "GENERIC# word n" "GENERIC# word n ( stack -- effect )" }
+{ $syntax "GENERIC# word n ( stack -- effect )" }
{ $values { "word" "a new word to define" } { "n" "the stack position to dispatch on" } }
{ $description "Defines a new generic word which dispatches on the " { $snippet "n" } "th most element from the top of the stack in the current vocabulary. Initially, it contains no methods, and thus will throw a " { $link no-method } " error when called." }
{ $notes
{ $description "Defines a new generic word which uses the " { $link math-combination } " method combination." } ;
HELP: HOOK:
-{ $syntax "HOOK: word variable" "HOOK: word variable ( stack -- effect ) " }
+{ $syntax "HOOK: word variable ( stack -- effect ) " }
{ $values { "word" "a new word to define" } { "variable" word } }
{ $description "Defines a new hook word in the current vocabulary. Hook words are generic words which dispatch on the value of a variable, so methods are defined with " { $link POSTPONE: M: } ". Hook words differ from other generic words in that the dispatch value is removed from the stack before the chosen method is called." }
{ $examples
] define-core-syntax
"CONSTANT:" [
- CREATE scan-object define-constant
+ CREATE-WORD scan-object define-constant
] define-core-syntax
":" [
--- /dev/null
+USING: math eval tools.test effects ;
+IN: words.alias.tests
+
+ALIAS: foo +
+[ ] [ "IN: words.alias.tests CONSTANT: foo 5" eval ] unit-test
+[ (( -- value )) ] [ \ foo stack-effect ] unit-test
\ No newline at end of file
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: quotations effects accessors sequences words kernel ;
+USING: quotations effects accessors sequences words kernel definitions ;
IN: words.alias
PREDICATE: alias < word "alias" word-prop ;
M: alias reset-word
[ call-next-method ] [ f "alias" set-word-prop ] bi ;
-M: alias stack-effect
- def>> first stack-effect ;
+M: alias definer drop \ ALIAS: f ;
+
+M: alias definition def>> first 1quotation ;
\ No newline at end of file
--- /dev/null
+IN: words.constant.tests
+USING: tools.test math ;
+
+CONSTANT: a +
+
+[ + ] [ a ] unit-test
+
+CONSTANT: b \ +
+
+[ \ + ] [ b ] unit-test
+
+CONSTANT: c { 1 2 3 }
+
+[ { 1 2 3 } ] [ c ] unit-test
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sequences words ;
+USING: accessors kernel sequences words definitions quotations ;
IN: words.constant
PREDICATE: constant < word ( obj -- ? )
: define-constant ( word value -- )
[ ] curry (( -- value )) define-inline ;
+
+M: constant definer drop \ CONSTANT: f ;
+
+M: constant definition def>> first literalize 1quotation ;
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax io.streams.string assocs
+heaps.private ;
+IN: assoc-heaps
+
+HELP: <assoc-heap>
+{ $values { "assoc" assoc } { "heap" heap } { "assoc-heap" assoc-heap } }
+{ $description "Constructs a new " { $link assoc-heap } " from two existing data structures." } ;
+
+HELP: <unique-max-heap>
+{ $values { "unique-heap" assoc-heap } }
+{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a max-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ;
+
+HELP: <unique-min-heap>
+{ $values { "unique-heap" assoc-heap } }
+{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a min-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ;
+
+{ <unique-max-heap> <unique-min-heap> } related-words
+
+HELP: assoc-heap
+{ $description "A data structure containing an assoc and a heap to get certain properties with better time constraints at the expense of more space and complexity. For instance, a hashtable and a heap can be combined into one assoc-heap to get a sorted data structure with O(1) lookup. Operations on assoc-heap may update both the assoc and the heap or leave them out of sync if it's advantageous." } ;
+
+ARTICLE: "assoc-heaps" "Associative heaps"
+"The " { $vocab-link "assoc-heaps" } " vocabulary combines exists to synthesize data structures with better time properties than either of the two component data structures alone." $nl
+"Associative heap constructor:"
+{ $subsection <assoc-heap> }
+"Unique heaps:"
+{ $subsection <unique-min-heap> }
+{ $subsection <unique-max-heap> } ;
+
+ABOUT: "assoc-heaps"
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test assoc-heaps ;
+IN: assoc-heaps.tests
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs hashtables heaps kernel ;
+IN: assoc-heaps
+
+TUPLE: assoc-heap assoc heap ;
+
+C: <assoc-heap> assoc-heap
+
+: <unique-min-heap> ( -- unique-heap )
+ H{ } clone <min-heap> <assoc-heap> ;
+
+: <unique-max-heap> ( -- unique-heap )
+ H{ } clone <max-heap> <assoc-heap> ;
+
+M: assoc-heap heap-push* ( value key assoc-heap -- entry )
+ pick over assoc>> key? [
+ 3drop f
+ ] [
+ [ assoc>> swapd set-at ] [ heap>> heap-push* ] 3bi
+ ] if ;
+
+M: assoc-heap heap-pop ( assoc-heap -- value key )
+ heap>> heap-pop ;
+
+M: assoc-heap heap-peek ( assoc-heap -- value key )
+ heap>> heap-peek ;
+
+M: assoc-heap heap-empty? ( assoc-heap -- value key )
+ heap>> heap-empty? ;
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+Priority queue with fast insertion, removal of first element, and lookup of arbitrary elements by key
[ dup [ over [ swap call ] dip ] dip 1 days time+ ] dip each-day
] [
3drop
- ] if ;
+ ] if ; inline recursive
: process-to-date ( account date -- account )
over interest-last-paid>> 1 days time+
- [ dupd process-day ] spin each-day ;
+ [ dupd process-day ] spin each-day ; inline
: inserting-transactions ( account transactions -- account )
[ [ date>> process-to-date ] keep >>transaction ] each ;
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test c.preprocessor kernel accessors multiline ;
+IN: c.preprocessor.tests
+
+[ "vocab:c/tests/test1/test1.c" start-preprocess-file ]
+[ include-nested-too-deeply? ] must-fail-with
+
+[ "yo\n\n\n\nyo4\n" ]
+[ "vocab:c/tests/test2/test2.c" start-preprocess-file nip ] unit-test
+
+/*
+[ "vocab:c/tests/test3/test3.c" start-preprocess-file ]
+[ "\"BOO\"" = ] must-fail-with
+*/
+
+[ V{ "\"omg\"" "\"lol\"" } ]
+[ "vocab:c/tests/test4/test4.c" start-preprocess-file drop warnings>> ] unit-test
+
+
+/*
+f(2 * (y+1)) + f(2 * (f(2 * (z[0])))) % f(2 * (0)) + t(1);
+f(2 * (2+(3,4)-0,1)) | f(2 * (~ 5)) & f(2 * (0,1))^m(0,1);
+int i[] = { 1, 23, 4, 5, };
+char c[2][6] = { "hello", "" };
+*/
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: html.parser.state io io.encodings.utf8 io.files
+io.streams.string kernel combinators accessors io.pathnames
+fry sequences arrays locals namespaces io.directories
+assocs math splitting make unicode.categories
+combinators.short-circuit ;
+IN: c.preprocessor
+
+: initial-library-paths ( -- seq )
+ V{ "/usr/include" } clone ;
+
+: initial-symbol-table ( -- hashtable )
+ H{
+ { "__APPLE__" "" }
+ { "__amd64__" "" }
+ { "__x86_64__" "" }
+ } clone ;
+
+TUPLE: preprocessor-state library-paths symbol-table
+include-nesting include-nesting-max processing-disabled?
+ifdef-nesting warnings errors
+pragmas
+include-nexts
+ifs elifs elses ;
+
+: <preprocessor-state> ( -- preprocessor-state )
+ preprocessor-state new
+ initial-library-paths >>library-paths
+ initial-symbol-table >>symbol-table
+ 0 >>include-nesting
+ 200 >>include-nesting-max
+ 0 >>ifdef-nesting
+ V{ } clone >>warnings
+ V{ } clone >>errors
+ V{ } clone >>pragmas
+ V{ } clone >>include-nexts
+ V{ } clone >>ifs
+ V{ } clone >>elifs
+ V{ } clone >>elses ;
+
+DEFER: preprocess-file
+
+ERROR: unknown-c-preprocessor state-parser name ;
+
+ERROR: bad-include-line line ;
+
+ERROR: header-file-missing path ;
+
+:: read-standard-include ( preprocessor-state path -- )
+ preprocessor-state dup library-paths>>
+ [ path append-path exists? ] find nip
+ [
+ dup [
+ path append-path
+ preprocess-file
+ ] with-directory
+ ] [
+ ! path header-file-missing
+ drop
+ ] if* ;
+
+:: read-local-include ( preprocessor-state path -- )
+ current-directory get path append-path dup :> full-path
+ dup exists? [
+ [ preprocessor-state ] dip preprocess-file
+ ] [
+ ! full-path header-file-missing
+ drop
+ ] if ;
+
+: handle-include ( preprocessor-state state-parser -- )
+ skip-whitespace advance dup previous {
+ { CHAR: < [ CHAR: > take-until-object read-standard-include ] }
+ { CHAR: " [ CHAR: " take-until-object read-local-include ] }
+ [ bad-include-line ]
+ } case ;
+
+: (readlns) ( -- )
+ readln "\\" ?tail [ , ] dip [ (readlns) ] when ;
+
+: readlns ( -- string ) [ (readlns) ] { } make concat ;
+
+: take-define-identifier ( state-parser -- string )
+ skip-whitespace
+ [ current { [ blank? ] [ CHAR: ( = ] } 1|| ] take-until ;
+
+: handle-define ( preprocessor-state state-parser -- )
+ [ take-define-identifier ]
+ [ skip-whitespace take-rest ] bi
+ "\\" ?tail [ readlns append ] when
+ spin symbol-table>> set-at ;
+
+: handle-undef ( preprocessor-state state-parser -- )
+ take-token swap symbol-table>> delete-at ;
+
+: handle-ifdef ( preprocessor-state state-parser -- )
+ [ [ 1 + ] change-ifdef-nesting ] dip
+ take-token over symbol-table>> key?
+ [ drop ] [ t >>processing-disabled? drop ] if ;
+
+: handle-ifndef ( preprocessor-state state-parser -- )
+ [ [ 1 + ] change-ifdef-nesting ] dip
+ take-token over symbol-table>> key?
+ [ t >>processing-disabled? drop ]
+ [ drop ] if ;
+
+: handle-endif ( preprocessor-state state-parser -- )
+ drop [ 1 - ] change-ifdef-nesting drop ;
+
+: handle-if ( preprocessor-state state-parser -- )
+ [ [ 1 + ] change-ifdef-nesting ] dip
+ skip-whitespace take-rest swap ifs>> push ;
+
+: handle-elif ( preprocessor-state state-parser -- )
+ skip-whitespace take-rest swap elifs>> push ;
+
+: handle-else ( preprocessor-state state-parser -- )
+ skip-whitespace take-rest swap elses>> push ;
+
+: handle-pragma ( preprocessor-state state-parser -- )
+ skip-whitespace take-rest swap pragmas>> push ;
+
+: handle-include-next ( preprocessor-state state-parser -- )
+ skip-whitespace take-rest swap include-nexts>> push ;
+
+: handle-error ( preprocessor-state state-parser -- )
+ skip-whitespace take-rest swap errors>> push ;
+ ! nip take-rest throw ;
+
+: handle-warning ( preprocessor-state state-parser -- )
+ skip-whitespace
+ take-rest swap warnings>> push ;
+
+: parse-directive ( preprocessor-state state-parser string -- )
+ {
+ { "warning" [ handle-warning ] }
+ { "error" [ handle-error ] }
+ { "include" [ handle-include ] }
+ { "define" [ handle-define ] }
+ { "undef" [ handle-undef ] }
+ { "ifdef" [ handle-ifdef ] }
+ { "ifndef" [ handle-ifndef ] }
+ { "endif" [ handle-endif ] }
+ { "if" [ handle-if ] }
+ { "elif" [ handle-elif ] }
+ { "else" [ handle-else ] }
+ { "pragma" [ handle-pragma ] }
+ { "include_next" [ handle-include-next ] }
+ [ unknown-c-preprocessor ]
+ } case ;
+
+: parse-directive-line ( preprocessor-state state-parser -- )
+ advance dup take-token
+ pick processing-disabled?>> [
+ "endif" = [
+ drop f >>processing-disabled?
+ [ 1 - ] change-ifdef-nesting
+ drop
+ ] [ 2drop ] if
+ ] [
+ parse-directive
+ ] if ;
+
+: preprocess-line ( preprocessor-state state-parser -- )
+ skip-whitespace dup current CHAR: # =
+ [ parse-directive-line ]
+ [ swap processing-disabled?>> [ drop ] [ write-full nl ] if ] if ;
+
+: preprocess-lines ( preprocessor-state -- )
+ readln
+ [ <state-parser> [ preprocess-line ] [ drop preprocess-lines ] 2bi ]
+ [ drop ] if* ;
+
+ERROR: include-nested-too-deeply ;
+
+: check-nesting ( preprocessor-state -- preprocessor-state )
+ [ 1 + ] change-include-nesting
+ dup [ include-nesting>> ] [ include-nesting-max>> ] bi > [
+ include-nested-too-deeply
+ ] when ;
+
+: preprocess-file ( preprocessor-state path -- )
+ [ check-nesting ] dip
+ [ utf8 [ preprocess-lines ] with-file-reader ]
+ [ drop [ 1 - ] change-include-nesting drop ] 2bi ;
+
+: start-preprocess-file ( path -- preprocessor-state string )
+ dup parent-directory [
+ [
+ [ <preprocessor-state> dup ] dip preprocess-file
+ ] with-string-writer
+ ] with-directory ;
--- /dev/null
+Tests if the preprocessor bails on an infinite loop caused by mutually recursive #include lines.
--- /dev/null
+#include "lo.h"
--- /dev/null
+#include "hi.h"
--- /dev/null
+#include "hi.h"
--- /dev/null
+/*
+# lol
+*/
--- /dev/null
+#define FOO_H "foo.h"
+#include FOO_H
--- /dev/null
+#if 4 > (5 - 4++)
+#error "Umm"
+#endif
--- /dev/null
+#if 10
+#error "Umm"
--- /dev/null
+#if 4 > (1 + 2)
+good
+#endif
+
+#if 4 > 1 + 2
+good
+#endif
+
+#if (4 > 1) - 1
+bad
+#endif
+
+#if (4 > 1) - 2
+good
+#endif
--- /dev/null
+Tests whether #define and #ifdef/#endif work in the positive case.
--- /dev/null
+#define YO
+#ifdef YO
+yo
+#endif
+
+#define YO2
+#ifndef YO2
+yo2
+#endif
+
+#ifdef YO3
+yo3
+#endif
+
+#ifndef YO4
+yo4
+#endif
--- /dev/null
+Tests whether #define and #ifdef/#endif work in the positive case.
--- /dev/null
+#error "BOO"
--- /dev/null
+#warning "omg"
+#warning "lol"
--- /dev/null
+#define TABSIZE 100
+
+int table[TABSIZE];
--- /dev/null
+#define max(a, b) ((a) > (b) ? (a) : (b))
--- /dev/null
+#define x 3
+#define f(a) f(x * (a))
+#undef x
+#define x 2
+#define g f
+#define z z[0]
+#define h g(~
+#define m(a) a(w)
+#define w 0,1
+#define t(a) a
+#define p() int
+#define q(x) x
+#define r(x,y) x ## y
+#define str(x) # x
+f(y+1) + f(f(z)) % t(t(g)(0) + t)(1);
+g(x+(3,4)-w) | h 5) & m
+(f)^m(m);
+p() i[q()] = { q(1), r(2,3), r(4,), r(,5), r(,) };
+char c[2][6] = { str(hello), str() };
--- /dev/null
+#define str(s) #s
+#define xstr(s) str(s)
+#define debug(s, t) printf("x" # s "= %d, x" # t "= %s", \
+x ## s, x ## t)
+#define INCFILE(n) vers ## n
+#define glue(a, b) a## b
+#define xglue(a, b) glue(a, b)
+#define HIGHLOW "hello"
+#define LOW LOW ", world"
+debug(1, 2);
+fputs(str(strncmp("abc\0d", "abc", '\4') //this goes away
+== 0) str(: @\n), s);
+#include xstr(INCFILE(2).h)
+glue(HIGH, LOW);
+xglue(HIGH, LOW)
--- /dev/null
+#define t(x,y,z) x ## y ## z
+int j[] = { t(1,2,3), t(,4,5), t(6,,7), t(8,9,),
+t(10,,), t(,11,), t(,,12), t(,,) };
+
--- /dev/null
+USING: tools.deploy.config ;
+V{
+ { deploy-ui? t }
+ { deploy-io 1 }
+ { deploy-reflection 1 }
+ { deploy-compiler? t }
+ { deploy-math? t }
+ { deploy-word-props? f }
+ { deploy-c-types? f }
+ { "stop-after-last-window?" t }
+ { deploy-name "Chicago Talk" }
+}
--- /dev/null
+Slides for a talk at the Pycon VM Summit, Chicago, IL, March 2009
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 }
}
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors combinators.smart sorting.human
-models colors.constants present
+models colors.constants present sorting.slots
ui ui.gadgets.tables ui.gadgets.scrollers ;
IN: color-table
drop named-color ;
: <color-table> ( -- table )
- named-colors human-sort <model>
+ named-colors { human<=> } sort-by <model>
color-renderer
<table>
5 >>gap
: color-table-demo ( -- )
[ <color-table> <scroller> "Colors" open-window ] with-ui ;
-MAIN: color-table-demo
\ No newline at end of file
+MAIN: color-table-demo
-
-USING: kernel fry sequences
- vocabs.loader help.vocabs
- ui ui.gadgets ui.gadgets.buttons ui.gadgets.packs ui.gadgets.scrollers
- ui.tools.listener
- accessors ;
-
+USING: kernel fry sequences vocabs.loader help.vocabs ui
+ui.gadgets ui.gadgets.buttons ui.gadgets.packs ui.gadgets.borders
+ui.gadgets.scrollers ui.tools.listener accessors ;
IN: demos
: demo-vocabs ( -- seq ) "demos" tagged [ second ] map concat [ name>> ] map ;
: <run-vocab-button> ( vocab-name -- button )
- dup '[ drop [ _ run ] call-listener ] <border-button> ;
+ dup '[ drop [ _ run ] \ run call-listener ] <border-button> ;
: <demo-runner> ( -- gadget )
- <pile> 1 >>fill demo-vocabs [ <run-vocab-button> add-gadget ] each ;
-
-: demos ( -- ) [ <demo-runner> <scroller> "Demos" open-window ] with-ui ;
+ <pile> 1 >>fill { 2 2 } >>gap demo-vocabs [ <run-vocab-button> add-gadget ] each ;
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+: demos ( -- ) [ <demo-runner> { 2 2 } <border> <scroller> "Demos" open-window ] with-ui ;
MAIN: demos
\ No newline at end of file
USING: words kernel sequences locals locals.parser
locals.definitions accessors parser namespaces continuations
-summary definitions generalizations arrays ;
+summary definitions generalizations arrays prettyprint debugger io ;
IN: descriptive
ERROR: descriptive-error args underlying word ;
-M: descriptive-error summary
- word>> "The " swap name>> " word encountered an error."
- 3append ;
+M: descriptive-error error.
+ "The word " write dup word>> pprint " encountered an error." print
+ "Arguments:" print
+ dup args>> stack.
+ "Error:" print
+ underlying>> error. ;
<PRIVATE
USING: assocs html.parser kernel math sequences strings ascii
arrays generalizations shuffle unicode.case namespaces make
splitting http accessors io combinators http.client urls
-urls.encoding fry prettyprint ;
+urls.encoding fry prettyprint sets ;
IN: html.parser.analyzer
TUPLE: link attributes clickable ;
[ [
[ name>> "a" = ]
[ attributes>> "href" swap key? ] bi and ] filter
- ] map sift [ [ attributes>> "href" swap at ] map ] map concat ;
+ ] map sift
+ [ [ 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
+ [ >url ] map ;
+
+: find-all-links ( vector -- vector' )
+ [ find-hrefs ] [ find-frame-links ] bi append prune ;
: find-forms ( vector -- vector' )
"form" over find-opening-tags-by-name
}
] [ "<a href = \"http://factorcode.org/\" foo = bar baz='quux'a=pirsqd >" parse-html ] unit-test
+[
+V{
+ T{ tag f "a"
+ H{
+ { "a" "pirsqd" }
+ { "foo" "bar" }
+ { "href" "http://factorcode.org/" }
+ { "baz" "quux" }
+ { "nofollow" "nofollow" }
+ } f f }
+}
+] [ "<a href = \"http://factorcode.org/\" nofollow foo = bar baz='quux'a=pirsqd >" parse-html ] unit-test
+
[
V{
T{ tag f "html" H{ } f f }
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays html.parser.utils hashtables io kernel
-namespaces make prettyprint quotations sequences splitting
-html.parser.state strings unicode.categories unicode.case ;
+USING: accessors arrays hashtables html.parser.state
+html.parser.utils kernel namespaces sequences
+unicode.case unicode.categories combinators.short-circuit
+quoting fry ;
IN: html.parser
TUPLE: tag name attributes text closing? ;
SINGLETON: text
SINGLETON: dtd
SINGLETON: comment
+
+<PRIVATE
+
SYMBOL: tagstack
: push-tag ( tag -- )
: closing-tag? ( string -- ? )
[ f ]
- [ [ first ] [ peek ] bi [ CHAR: / = ] bi@ or ] if-empty ;
+ [ { [ first CHAR: / = ] [ peek CHAR: / = ] } 1|| ] if-empty ;
: <tag> ( name attributes closing? -- tag )
tag new
: make-tag ( string attribs -- tag )
[ [ closing-tag? ] keep "/" trim1 ] dip rot <tag> ;
-: make-text-tag ( string -- tag )
+: new-tag ( text name -- tag )
tag new
- text >>name
- swap >>text ;
+ swap >>name
+ swap >>text ; inline
-: make-comment-tag ( string -- tag )
- tag new
- comment >>name
- swap >>text ;
+: (read-quote) ( state-parser ch -- string )
+ '[ [ current _ = ] take-until ] [ advance drop ] bi ;
-: make-dtd-tag ( string -- tag )
- tag new
- dtd >>name
- swap >>text ;
+: read-single-quote ( state-parser -- string )
+ CHAR: ' (read-quote) ;
-: read-whitespace ( -- string )
- [ get-char blank? not ] take-until ;
+: read-double-quote ( state-parser -- string )
+ CHAR: " (read-quote) ;
-: read-whitespace* ( -- ) read-whitespace drop ;
+: read-quote ( state-parser -- string )
+ dup get+increment CHAR: ' =
+ [ read-single-quote ] [ read-double-quote ] if ;
-: read-token ( -- string )
- read-whitespace*
- [ get-char blank? ] take-until ;
+: read-key ( state-parser -- string )
+ skip-whitespace
+ [ current { [ CHAR: = = ] [ blank? ] } 1|| ] take-until ;
-: read-single-quote ( -- string )
- [ get-char CHAR: ' = ] take-until ;
+: read-token ( state-parser -- string )
+ [ current blank? ] take-until ;
-: read-double-quote ( -- string )
- [ get-char CHAR: " = ] take-until ;
+: read-value ( state-parser -- string )
+ skip-whitespace
+ dup current quote? [ read-quote ] [ read-token ] if
+ [ blank? ] trim ;
-: read-quote ( -- string )
- get-char next CHAR: ' =
- [ read-single-quote ] [ read-double-quote ] if next ;
+: read-comment ( state-parser -- )
+ "-->" take-until-sequence comment new-tag push-tag ;
-: read-key ( -- string )
- read-whitespace*
- [ get-char [ CHAR: = = ] [ blank? ] bi or ] take-until ;
+: read-dtd ( state-parser -- )
+ ">" take-until-sequence dtd new-tag push-tag ;
-: read-= ( -- )
- read-whitespace*
- [ get-char CHAR: = = ] take-until drop next ;
+: read-bang ( state-parser -- )
+ advance dup { [ current CHAR: - = ] [ peek-next CHAR: - = ] } 1&&
+ [ advance advance read-comment ] [ read-dtd ] if ;
-: read-value ( -- string )
- read-whitespace*
- get-char quote? [ read-quote ] [ read-token ] if
- [ blank? ] trim ;
+: read-tag ( state-parser -- string )
+ [ [ current "><" member? ] take-until ]
+ [ dup current CHAR: < = [ advance ] unless drop ] bi ;
-: read-comment ( -- )
- "-->" take-string make-comment-tag push-tag ;
+: read-until-< ( state-parser -- string )
+ [ current CHAR: < = ] take-until ;
-: read-dtd ( -- )
- ">" take-string make-dtd-tag push-tag ;
+: parse-text ( state-parser -- )
+ read-until-< [ text new-tag push-tag ] unless-empty ;
-: read-bang ( -- )
- next get-char CHAR: - = get-next CHAR: - = and [
- next next
- read-comment
- ] [
- read-dtd
- ] if ;
+: parse-key/value ( state-parser -- key value )
+ [ read-key >lower ]
+ [ skip-whitespace "=" take-sequence ]
+ [ swap [ read-value ] [ drop dup ] if ] tri ;
-: read-tag ( -- string )
- [ get-char CHAR: > = get-char CHAR: < = or ] take-until
- get-char CHAR: < = [ next ] unless ;
-
-: read-< ( -- string )
- next get-char CHAR: ! = [
- read-bang f
+: (parse-attributes) ( state-parser -- )
+ skip-whitespace
+ dup state-parse-end? [
+ drop
] [
- read-tag
+ [ parse-key/value swap set ] [ (parse-attributes) ] bi
] if ;
-: read-until-< ( -- string )
- [ get-char CHAR: < = ] take-until ;
+: parse-attributes ( state-parser -- hashtable )
+ [ (parse-attributes) ] H{ } make-assoc ;
-: parse-text ( -- )
- read-until-< [
- make-text-tag push-tag
- ] unless-empty ;
+: (parse-tag) ( string -- string' hashtable )
+ [
+ [ read-token >lower ] [ parse-attributes ] bi
+ ] state-parse ;
-: (parse-attributes) ( -- )
- read-whitespace*
- string-parse-end? [
- read-key >lower read-= read-value
- 2array , (parse-attributes)
- ] unless ;
+: read-< ( state-parser -- string/f )
+ advance dup current [
+ CHAR: ! = [ read-bang f ] [ read-tag ] if
+ ] [
+ drop f
+ ] if* ;
-: parse-attributes ( -- hashtable )
- [ (parse-attributes) ] { } make >hashtable ;
+: parse-tag ( state-parser -- )
+ read-< [ (parse-tag) make-tag push-tag ] unless-empty ;
-: (parse-tag) ( string -- string' hashtable )
- [
- read-token >lower
- parse-attributes
- ] string-parse ;
-
-: parse-tag ( -- )
- read-< [
- (parse-tag) make-tag push-tag
- ] unless-empty ;
-
-: (parse-html) ( -- )
- get-next [
- parse-text
- parse-tag
- (parse-html)
- ] when ;
+: (parse-html) ( state-parser -- )
+ dup peek-next [
+ [ parse-text ] [ parse-tag ] [ (parse-html) ] tri
+ ] [ drop ] if ;
: tag-parse ( quot -- vector )
- V{ } clone tagstack [ string-parse ] with-variable ; inline
+ V{ } clone tagstack [ state-parse ] with-variable ; inline
+
+PRIVATE>
: parse-html ( string -- vector )
[ (parse-html) tagstack get ] tag-parse ;
-USING: tools.test html.parser.state ascii kernel ;
+USING: tools.test html.parser.state ascii kernel accessors ;
IN: html.parser.state.tests
-: take-rest ( -- string )
- [ f ] take-until ;
+[ "hello" ]
+[ "hello" [ take-rest ] state-parse ] unit-test
-: take-char ( -- string )
- [ get-char = ] curry take-until ;
+[ "hi" " how are you?" ]
+[
+ "hi how are you?"
+ [ [ [ current blank? ] take-until ] [ take-rest ] bi ] state-parse
+] unit-test
+
+[ "foo" ";bar" ]
+[
+ "foo;bar" [
+ [ CHAR: ; take-until-object ] [ take-rest ] bi
+ ] state-parse
+] unit-test
-[ "hello" ] [ "hello" [ take-rest ] string-parse ] unit-test
-[ "hi" " how are you?" ] [ "hi how are you?" [ [ get-char blank? ] take-until take-rest ] string-parse ] unit-test
-[ "foo" ";bar" ] [ "foo;bar" [ CHAR: ; take-char take-rest ] string-parse ] unit-test
[ "foo " " bar" ]
-[ "foo and bar" [ "and" take-string take-rest ] string-parse ] unit-test
+[
+ "foo and bar" [
+ [ "and" take-until-sequence ] [ take-rest ] bi
+ ] state-parse
+] unit-test
+
+[ 6 ]
+[
+ " foo " [ skip-whitespace n>> ] state-parse
+] unit-test
+
+[ { 1 2 } ]
+[ { 1 2 3 } <state-parser> [ current 3 = ] take-until ] unit-test
+
+[ { 1 2 } ]
+[ { 1 2 3 4 } <state-parser> { 3 4 } take-until-sequence ] unit-test
+
+[ "ab" ]
+[ "abcd" <state-parser> "ab" take-sequence ] unit-test
+
+[ f ]
+[ "abcd" <state-parser> "lol" take-sequence ] unit-test
+
+[ "ab" ]
+[
+ "abcd" <state-parser>
+ [ "lol" take-sequence drop ] [ "ab" take-sequence ] bi
+] unit-test
+
+[ "" ]
+[ "abcd" <state-parser> "" take-sequence ] unit-test
+
+[ "cd" ]
+[ "abcd" <state-parser> [ "ab" take-sequence drop ] [ "cd" take-sequence ] bi ] unit-test
+
+[ f ]
+[
+ "\"abc\" asdf" <state-parser>
+ [ CHAR: \ CHAR: " take-quoted-string drop ] [ "asdf" take-sequence ] bi
+] unit-test
+
+[ "abc\\\"def" ]
+[
+ "\"abc\\\"def\" asdf" <state-parser>
+ CHAR: \ CHAR: " take-quoted-string
+] unit-test
+
+[ "asdf" ]
+[
+ "\"abc\" asdf" <state-parser>
+ [ CHAR: \ CHAR: " take-quoted-string drop ]
+ [ skip-whitespace "asdf" take-sequence ] bi
+] unit-test
+
+[ f ]
+[
+ "\"abc asdf" <state-parser>
+ CHAR: \ CHAR: " take-quoted-string
+] unit-test
+
+[ "\"abc" ]
+[
+ "\"abc asdf" <state-parser>
+ [ CHAR: \ CHAR: " take-quoted-string drop ]
+ [ "\"abc" take-sequence ] bi
+] unit-test
+
+[ "c" ]
+[ "c" <state-parser> take-token ] unit-test
+
+[ f ]
+[ "" <state-parser> take-token ] unit-test
+
+[ "abcd e \\\"f g" ]
+[ "\"abcd e \\\"f g\"" <state-parser> CHAR: \ CHAR: " take-token* ] unit-test
+
+[ "" ]
+[ "" <state-parser> take-rest ] unit-test
+
+[ "" ]
+[ "abc" <state-parser> dup "abc" take-sequence drop take-rest ] unit-test
+
+[ f ]
+[ "abc" <state-parser> "abcdefg" take-sequence ] unit-test
! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces math kernel sequences accessors fry circular ;
+USING: namespaces math kernel sequences accessors fry circular
+unicode.case unicode.categories locals combinators.short-circuit
+make combinators io splitting ;
+
IN: html.parser.state
-TUPLE: state string i ;
+TUPLE: state-parser sequence n ;
+
+: <state-parser> ( sequence -- state-parser )
+ state-parser new
+ swap >>sequence
+ 0 >>n ;
+
+: offset ( state-parser offset -- char/f )
+ swap
+ [ n>> + ] [ sequence>> ?nth ] bi ; inline
+
+: current ( state-parser -- char/f ) 0 offset ; inline
+
+: previous ( state-parser -- char/f ) -1 offset ; inline
+
+: peek-next ( state-parser -- char/f ) 1 offset ; inline
+
+: advance ( state-parser -- state-parser )
+ [ 1 + ] change-n ; inline
+
+: advance* ( state-parser -- )
+ advance drop ; inline
+
+: get+increment ( state-parser -- char/f )
+ [ current ] [ advance drop ] bi ; inline
+
+:: skip-until ( state-parser quot: ( obj -- ? ) -- )
+ state-parser current [
+ state-parser quot call [ state-parser advance quot skip-until ] unless
+ ] when ; inline recursive
+
+: state-parse-end? ( state-parser -- ? ) current not ;
+
+: take-until ( state-parser quot: ( obj -- ? ) -- sequence/f )
+ over state-parse-end? [
+ 2drop f
+ ] [
+ [ drop n>> ]
+ [ skip-until ]
+ [ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq
+ ] if ; inline
+
+: 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
+ <safe-slice> sequence sequence= [
+ sequence
+ state-parser [ sequence length + ] change-n drop
+ ] [
+ f
+ ] if ;
-: get-i ( -- i ) state get i>> ; inline
+:: take-until-sequence ( state-parser sequence -- sequence' )
+ sequence length <growing-circular> :> growing
+ state-parser
+ [
+ current growing push-growing-circular
+ sequence growing sequence=
+ ] take-until :> found
+ found dup length
+ growing length 1- - head
+ state-parser advance drop ;
+
+: skip-whitespace ( state-parser -- state-parser )
+ [ [ current blank? not ] take-until drop ] keep ;
-: get-char ( -- char )
- state get [ i>> ] [ string>> ] bi ?nth ; inline
+: take-rest-slice ( state-parser -- sequence/f )
+ [ sequence>> ] [ n>> ] bi
+ 2dup [ length ] dip < [ 2drop f ] [ tail-slice ] if ; inline
-: get-next ( -- char )
- state get [ i>> 1+ ] [ string>> ] bi ?nth ; inline
+: take-rest ( state-parser -- sequence )
+ [ take-rest-slice ] [ sequence>> like ] bi ;
-: next ( -- )
- state get [ 1+ ] change-i drop ; inline
+: take-until-object ( state-parser obj -- sequence )
+ '[ current _ = ] take-until ;
-: string-parse ( string quot -- )
- [ 0 state boa state ] dip with-variable ; inline
+: state-parse ( sequence quot -- )
+ [ <state-parser> ] dip call ; inline
-: short* ( n seq -- n' seq )
- over [ nip dup length swap ] unless ; inline
+:: take-quoted-string ( state-parser escape-char quote-char -- string )
+ state-parser n>> :> start-n
+ state-parser advance
+ [
+ {
+ [ { [ previous escape-char = ] [ current quote-char = ] } 1&& ]
+ [ current quote-char = not ]
+ } 1||
+ ] take-while :> string
+ state-parser current quote-char = [
+ state-parser advance* string
+ ] [
+ start-n state-parser (>>n) f
+ ] if ;
-: skip-until ( quot: ( -- ? ) -- )
- get-char [
- [ call ] keep swap
- [ drop ] [ next skip-until ] if
- ] [ drop ] if ; inline recursive
+: (take-token) ( state-parser -- string )
+ skip-whitespace [ current { [ blank? ] [ f = ] } 1|| ] take-until ;
-: take-until ( quot: ( -- ? ) -- )
- get-i [ skip-until ] dip get-i
- state get string>> subseq ; inline
+:: take-token* ( state-parser escape-char quote-char -- string/f )
+ state-parser skip-whitespace
+ dup current {
+ { quote-char [ escape-char quote-char take-quoted-string ] }
+ { f [ drop f ] }
+ [ drop (take-token) ]
+ } case ;
-: string-matches? ( string circular -- ? )
- get-char over push-growing-circular sequence= ; inline
+: take-token ( state-parser -- string/f )
+ CHAR: \ CHAR: " take-token* ;
-: take-string ( match -- string )
- dup length <growing-circular>
- [ 2dup string-matches? ] take-until nip
- dup length rot length 1- - head next ; inline
+: write-full ( state-parser -- ) sequence>> write ;
+: write-rest ( state-parser -- ) take-rest write ;
USING: assocs combinators continuations hashtables
hashtables.private io kernel math
namespaces prettyprint quotations sequences splitting
-strings tools.test ;
-USING: html.parser.utils ;
+strings tools.test html.parser.utils quoting ;
IN: html.parser.utils.tests
[ "'Rome'" ] [ "Rome" single-quote ] unit-test
[ "\"Roma\"" ] [ "Roma" double-quote ] unit-test
[ "'Firenze'" ] [ "Firenze" quote ] unit-test
[ "\"Caesar's\"" ] [ "Caesar's" quote ] unit-test
-[ f ] [ "" quoted? ] unit-test
-[ t ] [ "''" quoted? ] unit-test
-[ t ] [ "\"\"" quoted? ] unit-test
-[ t ] [ "\"Circus Maximus\"" quoted? ] unit-test
-[ t ] [ "'Circus Maximus'" quoted? ] unit-test
-[ f ] [ "Circus Maximus" quoted? ] unit-test
[ "'Italy'" ] [ "Italy" ?quote ] unit-test
[ "'Italy'" ] [ "'Italy'" ?quote ] unit-test
[ "\"Italy\"" ] [ "\"Italy\"" ?quote ] unit-test
USING: assocs circular combinators continuations hashtables
hashtables.private io kernel math namespaces prettyprint
quotations sequences splitting html.parser.state strings
-combinators.short-circuit ;
+combinators.short-circuit quoting ;
IN: html.parser.utils
-: string-parse-end? ( -- ? ) get-next not ;
-
: trim1 ( seq ch -- newseq )
[ [ ?head-slice drop ] [ ?tail-slice drop ] bi ] 2keep drop like ;
-: quote? ( ch -- ? ) "'\"" member? ;
-
: single-quote ( str -- newstr ) "'" dup surround ;
: double-quote ( str -- newstr ) "\"" dup surround ;
CHAR: ' over member?
[ double-quote ] [ single-quote ] if ;
-: quoted? ( str -- ? )
- {
- [ length 1 > ]
- [ first quote? ]
- [ [ first ] [ peek ] bi = ]
- } 1&& ;
-
: ?quote ( str -- newstr ) dup quoted? [ quote ] unless ;
-
-: unquote ( str -- newstr )
- dup quoted? [ but-last-slice rest-slice >string ] when ;
! Copyright (C) 2008 Tim Wawrzynczak
! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax sequences kernel accessors ;
+USING: help.markup help.syntax sequences kernel accessors
+id3.private strings ;
IN: id3
-HELP: file-id3-tags
+HELP: mp3>id3
{ $values
{ "path" "a path string" }
{ "id3v2-info/f" "a tuple storing ID3v2 metadata or f" } }
- { $description "Return a tuple containing the ID3 information parsed out of the MP3 file, or " { $link f } " if no metadata is present. Currently, the parser supports the following tags: "
- $nl { $link title>> }
- $nl { $link artist>> }
- $nl { $link album>> }
- $nl { $link year>> }
- $nl { $link genre>> }
- $nl { $link comment>> } } ;
+ { $description "Return a tuple containing the ID3 information parsed out of the MP3 file, or " { $link f } " if no metadata is present. Words to access the ID3v1 information are here:"
+ { $list
+ { $link title }
+ { $link artist }
+ { $link album }
+ { $link year }
+ { $link genre }
+ { $link comment }
+ }
+ "For other fields, use the " { $link find-id3-frame } " word."
+ } ;
+
+HELP: album
+{ $values
+ { "id3" id3v2-info }
+ { "album/f" "string or f" }
+}
+{ $description "Returns the album, or " { $link f } " if this field is missing, from a parsed id3 tag." } ;
+
+HELP: artist
+{ $values
+ { "id3" id3v2-info }
+ { "artist/f" "string or f" }
+}
+{ $description "Returns the artist, or " { $link f } " if this field is missing, from a parsed id3 tag." } ;
+
+HELP: comment
+{ $values
+ { "id3" id3v2-info }
+ { "comment/f" "string or f" }
+}
+{ $description "Returns the comment, or " { $link f } " if this field is missing, from a parsed id3 tag." } ;
+
+HELP: genre
+{ $values
+ { "id3" id3v2-info }
+ { "genre/f" "string or f" }
+}
+{ $description "Returns the genre, or " { $link f } " if this field is missing, from a parsed id3 tag." } ;
+
+HELP: title
+{ $values
+ { "id3" id3v2-info }
+ { "title/f" "string or f" }
+}
+{ $description "Returns the title, or " { $link f } " if this field is missing, from a parsed id3 tag." } ;
+
+HELP: year
+{ $values
+ { "id3" id3v2-info }
+ { "year/f" "string or f" }
+}
+{ $description "Returns the year, or " { $link f } " if this field is missing, from a parsed id3 tag." } ;
+
+HELP: find-id3-frame
+{ $values
+ { "id3" id3v2-info } { "name" string }
+ { "obj/f" "object or f" }
+}
+{ $description "Returns the " { $slot "data" } " slot of the ID3 frame with the given name, or " { $link f } "." } ;
+
+HELP: mp3-paths>id3s
+{ $values
+ { "seq" sequence }
+ { "seq'" sequence }
+}
+{ $description "From a sequence of pathnames, parses each ID3 header and returns a sequence of key/value pairs of pathnames and ID3 objects." } ;
+
+HELP: find-mp3s
+{ $values
+ { "path" "a pathname string" }
+ { "seq" sequence }
+}
+{ $description "Returns a sequence of MP3 pathnames from a directory and all of its subdirectories." } ;
+
+HELP: parse-mp3-directory
+{ $values
+ { "path" "a pathname string" }
+ { "seq" sequence }
+}
+{ $description "Returns a sequence of key/value pairs where the key is the path of an MP3 and the value is the parsed ID3 header or " { $link f } " recursively for each MP3 file in the directory and all subdirectories." } ;
ARTICLE: "id3" "ID3 tags"
"The " { $vocab-link "id3" } " vocabulary contains words for parsing " { $emphasis "ID3" } " tags, which are textual fields storing an MP3's title, artist, and other metadata." $nl
-"Parsing ID3 tags from an MP3 file:"
-{ $subsection file-id3-tags } ;
+"Parsing ID3 tags for a directory of MP3s, recursively:"
+{ $subsection parse-mp3-directory }
+"Finding MP3 files recursively:"
+{ $subsection find-mp3s }
+"Parsing a sequence of MP3 pathnames:"
+{ $subsection mp3-paths>id3s }
+"Parsing an MP3 file's ID3 tags:"
+{ $subsection mp3>id3 }
+"ID3v1 frame tag accessors:"
+{ $subsection album }
+{ $subsection artist }
+{ $subsection comment }
+{ $subsection genre }
+{ $subsection title }
+{ $subsection year }
+"Access any frame tag:"
+{ $subsection find-id3-frame } ;
ABOUT: "id3"
: id3-params ( id3 -- title artist album year comment genre )
{
- [ id3-title ]
- [ id3-artist ]
- [ id3-album ]
- [ id3-year ]
- [ id3-comment ]
- [ id3-genre ]
+ [ title ]
+ [ artist ]
+ [ album ]
+ [ year ]
+ [ comment ]
+ [ genre ]
} cleave ;
[
"2009"
"COMMENT"
"Bluegrass"
-] [ "vocab:id3/tests/blah.mp3" file-id3-tags id3-params ] unit-test
+] [ "vocab:id3/tests/blah.mp3" mp3>id3 id3-params ] unit-test
[
"Anthem of the Trinity"
f
f
"Classical"
-] [ "vocab:id3/tests/blah2.mp3" file-id3-tags id3-params ] unit-test
+] [ "vocab:id3/tests/blah2.mp3" mp3>id3 id3-params ] unit-test
[
"Stormy Weather"
f
"eng, AG# 08E1C12E"
"Big Band"
-] [ "vocab:id3/tests/blah3.mp3" file-id3-tags id3-params ] unit-test
+] [ "vocab:id3/tests/blah3.mp3" mp3>id3 id3-params ] unit-test
TUPLE: id3v1-info title artist album year comment genre ;
-: <id3v1-info> ( -- object ) id3v1-info new ;
+: <id3v1-info> ( -- object ) id3v1-info new ; inline
: <id3v2-info> ( header frames -- object )
- [ [ frame-id>> ] keep ] H{ } map>assoc
- id3v2-info boa ;
+ [ [ frame-id>> ] keep ] H{ } map>assoc id3v2-info boa ;
-: <header> ( -- object ) header new ;
+: <header> ( -- object ) header new ; inline
-: <frame> ( -- object ) frame new ;
+: <frame> ( -- object ) frame new ; inline
: id3v2? ( mmap -- ? ) "ID3" head? ; inline
: id3v1-frame ( string key -- frame )
<frame>
swap >>frame-id
- swap >>data ;
+ swap >>data ; inline
: id3v1>id3v2 ( id3v1 -- id3v2 )
[
[ comment>> "COMM" id3v1-frame ]
[ genre>> "TCON" id3v1-frame ]
} cleave
- ] output>array f swap <id3v2-info> ;
+ ] output>array f swap <id3v2-info> ; inline
: >28bitword ( seq -- int )
0 [ [ 7 shift ] dip bitor ] reduce ; inline
[ [ 4 8 ] dip subseq >28bitword >>size ]
[ [ 8 10 ] dip subseq >byte-array >>flags ]
[ read-frame-data decode-text >>data ]
- } cleave ;
+ } cleave ; inline
: read-frame ( mmap -- frame/f )
dup 4 head-slice valid-frame-id?
- [ (read-frame) ] [ drop f ] if ;
+ [ (read-frame) ] [ drop f ] if ; inline
: remove-frame ( mmap frame -- mmap )
size>> 10 + tail-slice ; inline
: read-frames ( mmap -- frames )
[ dup read-frame dup ]
[ [ remove-frame ] keep ]
- produce 2nip ;
+ produce 2nip ; inline
-! header stuff
-
: read-v2-header ( seq -- id3header )
[ <header> ] dip
{
[ read-v2-header ]
[ read-frames ] bi* <id3v2-info> ; inline
-! v1 information
-
: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
: (read-v1-tag-data) ( seq -- mp3-file )
drop
] if ; inline
-PRIVATE>
+: (mp3>id3) ( path -- id3v2-info/f )
+ [
+ {
+ { [ dup id3v2? ] [ read-v2-tag-data ] }
+ { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
+ [ drop f ]
+ } cond
+ ] with-mapped-uchar-file ;
-: frame-named ( id3 name quot -- obj )
+: (find-id3-frame) ( id3 name quot: ( obj -- obj' ) -- obj' )
[ swap frames>> at* ] dip
[ data>> ] prepose [ drop f ] if ; inline
-: id3-title ( id3 -- title/f ) "TIT2" [ ] frame-named ; inline
+PRIVATE>
-: id3-artist ( id3 -- artist/f ) "TPE1" [ ] frame-named ; inline
+: mp3>id3 ( path -- id3v2-info/f )
+ dup file-info size>> 0 <= [ drop f ] [ (mp3>id3) ] if ; inline
-: id3-album ( id3 -- album/f ) "TALB" [ ] frame-named ; inline
+: find-id3-frame ( id3 name -- obj/f )
+ [ ] (find-id3-frame) ; inline
-: id3-year ( id3 -- year/f ) "TYER" [ ] frame-named ; inline
+: title ( id3 -- title/f ) "TIT2" find-id3-frame ; inline
-: id3-comment ( id3 -- comment/f ) "COMM" [ ] frame-named ; inline
+: artist ( id3 -- artist/f ) "TPE1" find-id3-frame ; inline
-: id3-genre ( id3 -- genre/f )
- "TCON" [ parse-genre ] frame-named ; inline
+: album ( id3 -- album/f ) "TALB" find-id3-frame ; inline
-: id3-frame ( id3 key -- value/f ) [ ] frame-named ; inline
+: year ( id3 -- year/f ) "TYER" find-id3-frame ; inline
-: (file-id3-tags) ( path -- id3v2-info/f )
- [
- {
- { [ dup id3v2? ] [ read-v2-tag-data ] }
- { [ dup id3v1? ] [ read-v1-tag-data id3v1>id3v2 ] }
- [ drop f ]
- } cond
- ] with-mapped-uchar-file ;
+: comment ( id3 -- comment/f ) "COMM" find-id3-frame ; inline
+
+: genre ( id3 -- genre/f )
+ "TCON" [ parse-genre ] (find-id3-frame) ; inline
+
+: find-mp3s ( path -- seq )
+ [ >lower ".mp3" tail? ] find-all-files ; inline
-: file-id3-tags ( path -- id3v2-info/f )
- dup file-info size>> 0 <= [ drop f ] [ (file-id3-tags) ] if ;
+: mp3-paths>id3s ( seq -- seq' )
+ [ dup mp3>id3 ] { } map>assoc ; inline
-: parse-id3s ( path -- seq )
- [ >lower ".mp3" tail? ] find-all-files
- [ dup file-id3-tags ] { } map>assoc ;
+: parse-mp3-directory ( path -- seq )
+ find-mp3s mp3-paths>id3s ;
" hostname servername :irc.factor" irc-print ;
: /CONNECT ( server port -- stream )
- irc> connect>> call drop ;
+ irc> connect>> call drop ; inline
: /JOIN ( channel password -- )
"JOIN " irc-write
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
! 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
: 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
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 ;
try-process
] with-directory ;
-: test-cmd ( -- cmd ) { "./factor" "-run=mason.test" } ;
+: test-cmd ( -- cmd ) factor-vm "-run=mason.test" 2array ;
: test ( -- )
"factor" [
compiler.errors generic help.html help.lint io.directories
io.encodings.utf8 io.files kernel mason.common math namespaces
prettyprint sequences sets sorting tools.test tools.time
-tools.vocabs words ;
+tools.vocabs words system io ;
IN: mason.test
: do-load ( -- )
: benchmark-ms ( quot -- ms )
benchmark 1000 /i ; inline
+: check-boot-image ( -- )
+ "" to-refresh drop 2dup [ empty? not ] either?
+ [
+ "Boot image is out of date. Changed vocabs:" print
+ append prune [ print ] each
+ flush
+ 1 exit
+ ] [ 2drop ] if ;
+
: do-all ( -- )
".." [
bootstrap-time get boot-time-file to-file
+ check-boot-image
[ do-load do-compile-errors ] benchmark-ms load-time-file to-file
[ generate-help ] benchmark-ms html-help-time-file to-file
[ do-tests ] benchmark-ms test-time-file to-file
{ deploy-word-props? f }
{ deploy-c-types? f }
{ "stop-after-last-window?" t }
- { deploy-name "Catalyst Talk" }
+ { deploy-name "Minnesota Talk" }
}
-Slides for a talk at Ruby.mn, Minneapolis MN, January 2008
+Slides for a talk at Ruby.mn, Minneapolis, MN, January 2008
--- /dev/null
+USING: help.syntax help.markup kernel math classes classes.tuple\r
+calendar models ;\r
+IN: models.history\r
+\r
+HELP: history\r
+{ $class-description "History models record a timeline of previous values on calls to " { $link add-history } ", and can travel back and forth on the timeline with " { $link go-back } " and " { $link go-forward } ". History models are constructed by " { $link <history> } "." } ;\r
+\r
+HELP: <history>\r
+{ $values { "value" object } { "history" "a new " { $link history } } }\r
+{ $description "Creates a new history model with an initial value." } ;\r
+\r
+{ <history> add-history go-back go-forward } related-words\r
+\r
+HELP: go-back\r
+{ $values { "history" history } }\r
+{ $description "Restores the previous value and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." } ;\r
+\r
+HELP: go-forward\r
+{ $values { "history" history } }\r
+{ $description "Restores the value set prior to the last call to " { $link go-back } " and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." } ;\r
+\r
+HELP: add-history\r
+{ $values { "history" history } }\r
+{ $description "Adds the current value to the history." } ;\r
+\r
+ARTICLE: "models-history" "History models"\r
+"History models record previous values."\r
+{ $subsection history }\r
+{ $subsection <history> }\r
+"Recording history:"\r
+{ $subsection add-history }\r
+"Navigating the history:"\r
+{ $subsection go-back }\r
+{ $subsection go-forward } ;\r
+\r
+ABOUT: "models-history"\r
--- /dev/null
+USING: arrays generic kernel math models namespaces sequences assocs\r
+tools.test models.history accessors ;\r
+IN: models.history.tests\r
+\r
+f <history> "history" set\r
+\r
+"history" get add-history\r
+\r
+[ t ] [ "history" get back>> empty? ] unit-test\r
+[ t ] [ "history" get forward>> empty? ] unit-test\r
+\r
+"history" get add-history\r
+3 "history" get set-model\r
+\r
+[ t ] [ "history" get back>> empty? ] unit-test\r
+[ t ] [ "history" get forward>> empty? ] unit-test\r
+\r
+"history" get add-history\r
+4 "history" get set-model\r
+\r
+[ f ] [ "history" get back>> empty? ] unit-test\r
+[ t ] [ "history" get forward>> empty? ] unit-test\r
+\r
+"history" get go-back\r
+\r
+[ 3 ] [ "history" get value>> ] unit-test\r
+\r
+[ t ] [ "history" get back>> empty? ] unit-test\r
+[ f ] [ "history" get forward>> empty? ] unit-test\r
+\r
+"history" get go-forward\r
+\r
+[ 4 ] [ "history" get value>> ] unit-test\r
+\r
+[ f ] [ "history" get back>> empty? ] unit-test\r
+[ t ] [ "history" get forward>> empty? ] unit-test\r
+\r
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.\r
+! See http://factorcode.org/license.txt for BSD license.\r
+USING: accessors kernel models sequences ;\r
+IN: models.history\r
+\r
+TUPLE: history < model back forward ;\r
+\r
+: reset-history ( history -- history )\r
+ V{ } clone >>back\r
+ V{ } clone >>forward ; inline\r
+\r
+: <history> ( value -- history )\r
+ history new-model\r
+ reset-history ;\r
+\r
+: (add-history) ( history to -- )\r
+ swap value>> dup [ swap push ] [ 2drop ] if ;\r
+\r
+: go-back/forward ( history to from -- )\r
+ [ 2drop ]\r
+ [ [ dupd (add-history) ] dip pop swap set-model ] if-empty ;\r
+\r
+: go-back ( history -- )\r
+ dup [ forward>> ] [ back>> ] bi go-back/forward ;\r
+\r
+: go-forward ( history -- )\r
+ dup [ back>> ] [ forward>> ] bi go-back/forward ;\r
+\r
+: add-history ( history -- )\r
+ dup forward>> delete-all\r
+ dup back>> (add-history) ;\r
--- /dev/null
+History models remember prior values
#! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0
-EBNF: pl0
+EBNF: pl0
-block = { "CONST" ident "=" number { "," ident "=" number }* ";" }?
- { "VAR" ident { "," ident }* ";" }?
- { "PROCEDURE" ident ";" { block ";" }? }* statement
-statement = { ident ":=" expression
- | "CALL" ident
- | "BEGIN" statement { ";" statement }* "END"
- | "IF" condition "THEN" statement
- | "WHILE" condition "DO" statement }?
+block = { "CONST" ident "=" number { "," ident "=" number }* ";" }?
+ { "VAR" ident { "," ident }* ";" }?
+ { "PROCEDURE" ident ";" { block ";" }? }* statement
+statement = { ident ":=" expression
+ | "CALL" ident
+ | "BEGIN" statement { ";" statement }* "END"
+ | "IF" condition "THEN" statement
+ | "WHILE" condition "DO" statement }?
condition = { "ODD" expression }
| { expression ("=" | "#" | "<=" | "<" | ">=" | ">") expression }
-expression = {"+" | "-"}? term { {"+" | "-"} term }*
-term = factor { {"*" | "/"} factor }*
+expression = {"+" | "-"}? term { {"+" | "-"} term }*
+term = factor { {"*" | "/"} factor }*
factor = ident | number | "(" expression ")"
ident = (([a-zA-Z])+) => [[ >string ]]
digit = ([0-9]) => [[ digit> ]]
--- /dev/null
+! Copyright (c) 2009 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+IN: poker.arrays
+
+! This is a lookup table for all flush hands. A zero means that specific
+! combination is not possible with this type of hand.
+CONSTANT: flushes-table
+{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 9 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 1599 0 0 0 0 0 0 0 1598 0 0 0 1597 0 1596 8 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 1595 0 0 0 0 0 0 0 1594 0 0 0 1593 0 1592 1591 0 0 0 0 0 0 0 0 1590
+0 0 0 1589 0 1588 1587 0 0 0 0 1586 0 1585 1584 0 0 1583 1582 0 7 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 1581 0 0 0 0 0 0 0 1580 0 0 0 1579 0 1578 1577 0 0 0 0 0
+0 0 0 1576 0 0 0 1575 0 1574 1573 0 0 0 0 1572 0 1571 1570 0 0 1569 1568 0 1567
+0 0 0 0 0 0 0 0 0 0 1566 0 0 0 1565 0 1564 1563 0 0 0 0 1562 0 1561 1560 0 0
+1559 1558 0 1557 0 0 0 0 0 0 1556 0 1555 1554 0 0 1553 1552 0 1551 0 0 0 0 1550
+1549 0 1548 0 0 0 6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1547 0 0 0 0 0
+0 0 1546 0 0 0 1545 0 1544 1543 0 0 0 0 0 0 0 0 1542 0 0 0 1541 0 1540 1539 0 0
+0 0 1538 0 1537 1536 0 0 1535 1534 0 1533 0 0 0 0 0 0 0 0 0 0 1532 0 0 0 1531 0
+1530 1529 0 0 0 0 1528 0 1527 1526 0 0 1525 1524 0 1523 0 0 0 0 0 0 1522 0 1521
+1520 0 0 1519 1518 0 1517 0 0 0 0 1516 1515 0 1514 0 0 0 1513 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 1512 0 0 0 1511 0 1510 1509 0 0 0 0 1508 0 1507 1506 0 0 1505 1504 0
+1503 0 0 0 0 0 0 1502 0 1501 1500 0 0 1499 1498 0 1497 0 0 0 0 1496 1495 0 1494
+0 0 0 1493 0 0 0 0 0 0 0 0 0 0 1492 0 1491 1490 0 0 1489 1488 0 1487 0 0 0 0
+1486 1485 0 1484 0 0 0 1483 0 0 0 0 0 0 0 0 1482 1481 0 1480 0 0 0 1479 0 0 0 0
+0 0 0 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1478 0 0 0
+0 0 0 0 1477 0 0 0 1476 0 1475 1474 0 0 0 0 0 0 0 0 1473 0 0 0 1472 0 1471 1470
+0 0 0 0 1469 0 1468 1467 0 0 1466 1465 0 1464 0 0 0 0 0 0 0 0 0 0 1463 0 0 0
+1462 0 1461 1460 0 0 0 0 1459 0 1458 1457 0 0 1456 1455 0 1454 0 0 0 0 0 0 1453
+0 1452 1451 0 0 1450 1449 0 1448 0 0 0 0 1447 1446 0 1445 0 0 0 1444 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 1443 0 0 0 1442 0 1441 1440 0 0 0 0 1439 0 1438 1437 0 0 1436
+1435 0 1434 0 0 0 0 0 0 1433 0 1432 1431 0 0 1430 1429 0 1428 0 0 0 0 1427 1426
+0 1425 0 0 0 1424 0 0 0 0 0 0 0 0 0 0 1423 0 1422 1421 0 0 1420 1419 0 1418 0 0
+0 0 1417 1416 0 1415 0 0 0 1414 0 0 0 0 0 0 0 0 1413 1412 0 1411 0 0 0 1410 0 0
+0 0 0 0 0 1409 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1408 0 0 0 1407 0
+1406 1405 0 0 0 0 1404 0 1403 1402 0 0 1401 1400 0 1399 0 0 0 0 0 0 1398 0 1397
+1396 0 0 1395 1394 0 1393 0 0 0 0 1392 1391 0 1390 0 0 0 1389 0 0 0 0 0 0 0 0 0
+0 1388 0 1387 1386 0 0 1385 1384 0 1383 0 0 0 0 1382 1381 0 1380 0 0 0 1379 0 0
+0 0 0 0 0 0 1378 1377 0 1376 0 0 0 1375 0 0 0 0 0 0 0 1374 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 1373 0 1372 1371 0 0 1370 1369 0 1368 0 0 0 0 1367 1366 0 1365
+0 0 0 1364 0 0 0 0 0 0 0 0 1363 1362 0 1361 0 0 0 1360 0 0 0 0 0 0 0 1359 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 1358 1357 0 1356 0 0 0 1355 0 0 0 0 0 0 0 1354 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1353 0 0 0 0 0 0 0 1352 0 0 0 1351 0 1350
+1349 0 0 0 0 0 0 0 0 1348 0 0 0 1347 0 1346 1345 0 0 0 0 1344 0 1343 1342 0 0
+1341 1340 0 1339 0 0 0 0 0 0 0 0 0 0 1338 0 0 0 1337 0 1336 1335 0 0 0 0 1334 0
+1333 1332 0 0 1331 1330 0 1329 0 0 0 0 0 0 1328 0 1327 1326 0 0 1325 1324 0
+1323 0 0 0 0 1322 1321 0 1320 0 0 0 1319 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1318 0 0 0
+1317 0 1316 1315 0 0 0 0 1314 0 1313 1312 0 0 1311 1310 0 1309 0 0 0 0 0 0 1308
+0 1307 1306 0 0 1305 1304 0 1303 0 0 0 0 1302 1301 0 1300 0 0 0 1299 0 0 0 0 0
+0 0 0 0 0 1298 0 1297 1296 0 0 1295 1294 0 1293 0 0 0 0 1292 1291 0 1290 0 0 0
+1289 0 0 0 0 0 0 0 0 1288 1287 0 1286 0 0 0 1285 0 0 0 0 0 0 0 1284 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1283 0 0 0 1282 0 1281 1280 0 0 0 0 1279 0 1278
+1277 0 0 1276 1275 0 1274 0 0 0 0 0 0 1273 0 1272 1271 0 0 1270 1269 0 1268 0 0
+0 0 1267 1266 0 1265 0 0 0 1264 0 0 0 0 0 0 0 0 0 0 1263 0 1262 1261 0 0 1260
+1259 0 1258 0 0 0 0 1257 1256 0 1255 0 0 0 1254 0 0 0 0 0 0 0 0 1253 1252 0
+1251 0 0 0 1250 0 0 0 0 0 0 0 1249 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1248 0
+1247 1246 0 0 1245 1244 0 1243 0 0 0 0 1242 1241 0 1240 0 0 0 1239 0 0 0 0 0 0
+0 0 1238 1237 0 1236 0 0 0 1235 0 0 0 0 0 0 0 1234 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 1233 1232 0 1231 0 0 0 1230 0 0 0 0 0 0 0 1229 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 1228 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 1227 0 0 0 1226 0 1225 1224 0 0 0 0 1223 0 1222 1221 0 0 1220 1219 0 1218 0
+0 0 0 0 0 1217 0 1216 1215 0 0 1214 1213 0 1212 0 0 0 0 1211 1210 0 1209 0 0 0
+1208 0 0 0 0 0 0 0 0 0 0 1207 0 1206 1205 0 0 1204 1203 0 1202 0 0 0 0 1201
+1200 0 1199 0 0 0 1198 0 0 0 0 0 0 0 0 1197 1196 0 1195 0 0 0 1194 0 0 0 0 0 0
+0 1193 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1192 0 1191 1190 0 0 1189 1188 0
+1187 0 0 0 0 1186 1185 0 1184 0 0 0 1183 0 0 0 0 0 0 0 0 1182 1181 0 1180 0 0 0
+1179 0 0 0 0 0 0 0 1178 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1177 1176 0 1175 0 0 0
+1174 0 0 0 0 0 0 0 1173 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1172 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1171 0 1170 1169 0 0 1168 1167
+0 1166 0 0 0 0 1165 1164 0 1163 0 0 0 1162 0 0 0 0 0 0 0 0 1161 1160 0 1159 0 0
+0 1158 0 0 0 0 0 0 0 1157 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1156 1155 0 1154 0 0
+0 1153 0 0 0 0 0 0 0 1152 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1151 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1150 1149 0 1148 0 0 0 1147 0 0 0
+0 0 0 0 1146 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1145 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 1144 0 0 0 0 0 0 0 1143 0 0 0 1142 0 1141 1140 0 0
+0 0 0 0 0 0 1139 0 0 0 1138 0 1137 1136 0 0 0 0 1135 0 1134 1133 0 0 1132 1131
+0 1130 0 0 0 0 0 0 0 0 0 0 1129 0 0 0 1128 0 1127 1126 0 0 0 0 1125 0 1124 1123
+0 0 1122 1121 0 1120 0 0 0 0 0 0 1119 0 1118 1117 0 0 1116 1115 0 1114 0 0 0 0
+1113 1112 0 1111 0 0 0 1110 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1109 0 0 0 1108 0 1107
+1106 0 0 0 0 1105 0 1104 1103 0 0 1102 1101 0 1100 0 0 0 0 0 0 1099 0 1098 1097
+0 0 1096 1095 0 1094 0 0 0 0 1093 1092 0 1091 0 0 0 1090 0 0 0 0 0 0 0 0 0 0
+1089 0 1088 1087 0 0 1086 1085 0 1084 0 0 0 0 1083 1082 0 1081 0 0 0 1080 0 0 0
+0 0 0 0 0 1079 1078 0 1077 0 0 0 1076 0 0 0 0 0 0 0 1075 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 1074 0 0 0 1073 0 1072 1071 0 0 0 0 1070 0 1069 1068 0 0
+1067 1066 0 1065 0 0 0 0 0 0 1064 0 1063 1062 0 0 1061 1060 0 1059 0 0 0 0 1058
+1057 0 1056 0 0 0 1055 0 0 0 0 0 0 0 0 0 0 1054 0 1053 1052 0 0 1051 1050 0
+1049 0 0 0 0 1048 1047 0 1046 0 0 0 1045 0 0 0 0 0 0 0 0 1044 1043 0 1042 0 0 0
+1041 0 0 0 0 0 0 0 1040 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1039 0 1038 1037 0
+0 1036 1035 0 1034 0 0 0 0 1033 1032 0 1031 0 0 0 1030 0 0 0 0 0 0 0 0 1029
+1028 0 1027 0 0 0 1026 0 0 0 0 0 0 0 1025 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1024
+1023 0 1022 0 0 0 1021 0 0 0 0 0 0 0 1020 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1019 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1018
+0 0 0 1017 0 1016 1015 0 0 0 0 1014 0 1013 1012 0 0 1011 1010 0 1009 0 0 0 0 0
+0 1008 0 1007 1006 0 0 1005 1004 0 1003 0 0 0 0 1002 1001 0 1000 0 0 0 999 0 0
+0 0 0 0 0 0 0 0 998 0 997 996 0 0 995 994 0 993 0 0 0 0 992 991 0 990 0 0 0 989
+0 0 0 0 0 0 0 0 988 987 0 986 0 0 0 985 0 0 0 0 0 0 0 984 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 983 0 982 981 0 0 980 979 0 978 0 0 0 0 977 976 0 975 0 0 0 974 0
+0 0 0 0 0 0 0 973 972 0 971 0 0 0 970 0 0 0 0 0 0 0 969 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 968 967 0 966 0 0 0 965 0 0 0 0 0 0 0 964 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+963 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 962 0
+961 960 0 0 959 958 0 957 0 0 0 0 956 955 0 954 0 0 0 953 0 0 0 0 0 0 0 0 952
+951 0 950 0 0 0 949 0 0 0 0 0 0 0 948 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 947 946 0
+945 0 0 0 944 0 0 0 0 0 0 0 943 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 942 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 941 940 0 939 0 0 0 938 0 0 0
+0 0 0 0 937 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 936 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 935 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 934 0 0 0 933 0 932 931 0 0 0 0 930 0 929 928 0 0 927 926 0 925 0 0
+0 0 0 0 924 0 923 922 0 0 921 920 0 919 0 0 0 0 918 917 0 916 0 0 0 915 0 0 0 0
+0 0 0 0 0 0 914 0 913 912 0 0 911 910 0 909 0 0 0 0 908 907 0 906 0 0 0 905 0 0
+0 0 0 0 0 0 904 903 0 902 0 0 0 901 0 0 0 0 0 0 0 900 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 899 0 898 897 0 0 896 895 0 894 0 0 0 0 893 892 0 891 0 0 0 890 0 0 0
+0 0 0 0 0 889 888 0 887 0 0 0 886 0 0 0 0 0 0 0 885 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 884 883 0 882 0 0 0 881 0 0 0 0 0 0 0 880 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 879
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 878 0 877
+876 0 0 875 874 0 873 0 0 0 0 872 871 0 870 0 0 0 869 0 0 0 0 0 0 0 0 868 867 0
+866 0 0 0 865 0 0 0 0 0 0 0 864 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 863 862 0 861 0
+0 0 860 0 0 0 0 0 0 0 859 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 858 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 857 856 0 855 0 0 0 854 0 0 0 0 0 0
+0 853 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 852 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 851 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+850 0 849 848 0 0 847 846 0 845 0 0 0 0 844 843 0 842 0 0 0 841 0 0 0 0 0 0 0 0
+840 839 0 838 0 0 0 837 0 0 0 0 0 0 0 836 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 835
+834 0 833 0 0 0 832 0 0 0 0 0 0 0 831 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 830 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 829 828 0 827 0 0 0 826
+0 0 0 0 0 0 0 825 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 824 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 823 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 822 821 0 820 0 0 0 819 0 0 0 0 0 0 0 818 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+817 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 816 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 10 0 0 0 0 0 0 0 815 0 0 0 814 0 813 812 0 0 0 0 0 0 0 0 811 0 0 0 810 0 809
+808 0 0 0 0 807 0 806 805 0 0 804 803 0 802 0 0 0 0 0 0 0 0 0 0 801 0 0 0 800 0
+799 798 0 0 0 0 797 0 796 795 0 0 794 793 0 792 0 0 0 0 0 0 791 0 790 789 0 0
+788 787 0 786 0 0 0 0 785 784 0 783 0 0 0 782 0 0 0 0 0 0 0 0 0 0 0 0 0 0 781 0
+0 0 780 0 779 778 0 0 0 0 777 0 776 775 0 0 774 773 0 772 0 0 0 0 0 0 771 0 770
+769 0 0 768 767 0 766 0 0 0 0 765 764 0 763 0 0 0 762 0 0 0 0 0 0 0 0 0 0 761 0
+760 759 0 0 758 757 0 756 0 0 0 0 755 754 0 753 0 0 0 752 0 0 0 0 0 0 0 0 751
+750 0 749 0 0 0 748 0 0 0 0 0 0 0 747 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 746 0 0 0 745 0 744 743 0 0 0 0 742 0 741 740 0 0 739 738 0 737 0 0 0 0 0 0
+736 0 735 734 0 0 733 732 0 731 0 0 0 0 730 729 0 728 0 0 0 727 0 0 0 0 0 0 0 0
+0 0 726 0 725 724 0 0 723 722 0 721 0 0 0 0 720 719 0 718 0 0 0 717 0 0 0 0 0 0
+0 0 716 715 0 714 0 0 0 713 0 0 0 0 0 0 0 712 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 711 0 710 709 0 0 708 707 0 706 0 0 0 0 705 704 0 703 0 0 0 702 0 0 0 0 0 0 0
+0 701 700 0 699 0 0 0 698 0 0 0 0 0 0 0 697 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 696
+695 0 694 0 0 0 693 0 0 0 0 0 0 0 692 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 691 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 690 0 0 0
+689 0 688 687 0 0 0 0 686 0 685 684 0 0 683 682 0 681 0 0 0 0 0 0 680 0 679 678
+0 0 677 676 0 675 0 0 0 0 674 673 0 672 0 0 0 671 0 0 0 0 0 0 0 0 0 0 670 0 669
+668 0 0 667 666 0 665 0 0 0 0 664 663 0 662 0 0 0 661 0 0 0 0 0 0 0 0 660 659 0
+658 0 0 0 657 0 0 0 0 0 0 0 656 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 655 0 654
+653 0 0 652 651 0 650 0 0 0 0 649 648 0 647 0 0 0 646 0 0 0 0 0 0 0 0 645 644 0
+643 0 0 0 642 0 0 0 0 0 0 0 641 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 640 639 0 638 0
+0 0 637 0 0 0 0 0 0 0 636 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 635 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 634 0 633 632 0 0 631 630 0 629
+0 0 0 0 628 627 0 626 0 0 0 625 0 0 0 0 0 0 0 0 624 623 0 622 0 0 0 621 0 0 0 0
+0 0 0 620 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 619 618 0 617 0 0 0 616 0 0 0 0 0 0 0
+615 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 614 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 613 612 0 611 0 0 0 610 0 0 0 0 0 0 0 609 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 608 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+607 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 606 0 0 0 605 0
+604 603 0 0 0 0 602 0 601 600 0 0 599 598 0 597 0 0 0 0 0 0 596 0 595 594 0 0
+593 592 0 591 0 0 0 0 590 589 0 588 0 0 0 587 0 0 0 0 0 0 0 0 0 0 586 0 585 584
+0 0 583 582 0 581 0 0 0 0 580 579 0 578 0 0 0 577 0 0 0 0 0 0 0 0 576 575 0 574
+0 0 0 573 0 0 0 0 0 0 0 572 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 571 0 570 569 0
+0 568 567 0 566 0 0 0 0 565 564 0 563 0 0 0 562 0 0 0 0 0 0 0 0 561 560 0 559 0
+0 0 558 0 0 0 0 0 0 0 557 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 556 555 0 554 0 0 0
+553 0 0 0 0 0 0 0 552 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 551 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 550 0 549 548 0 0 547 546 0 545 0 0
+0 0 544 543 0 542 0 0 0 541 0 0 0 0 0 0 0 0 540 539 0 538 0 0 0 537 0 0 0 0 0 0
+0 536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 535 534 0 533 0 0 0 532 0 0 0 0 0 0 0 531
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 530 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 529 528 0 527 0 0 0 526 0 0 0 0 0 0 0 525 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 524 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 523
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 522 0 521 520 0 0 519 518 0
+517 0 0 0 0 516 515 0 514 0 0 0 513 0 0 0 0 0 0 0 0 512 511 0 510 0 0 0 509 0 0
+0 0 0 0 0 508 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 507 506 0 505 0 0 0 504 0 0 0 0 0
+0 0 503 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 502 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 501 500 0 499 0 0 0 498 0 0 0 0 0 0 0 497 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 496 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 495 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 494 493 0 492 0 0 0 491
+0 0 0 0 0 0 0 490 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 489 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 488 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 487 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 486 0 0 0 485 0 484 483 0 0 0 0 482 0 481
+480 0 0 479 478 0 477 0 0 0 0 0 0 476 0 475 474 0 0 473 472 0 471 0 0 0 0 470
+469 0 468 0 0 0 467 0 0 0 0 0 0 0 0 0 0 466 0 465 464 0 0 463 462 0 461 0 0 0 0
+460 459 0 458 0 0 0 457 0 0 0 0 0 0 0 0 456 455 0 454 0 0 0 453 0 0 0 0 0 0 0
+452 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 451 0 450 449 0 0 448 447 0 446 0 0 0 0
+445 444 0 443 0 0 0 442 0 0 0 0 0 0 0 0 441 440 0 439 0 0 0 438 0 0 0 0 0 0 0
+437 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 436 435 0 434 0 0 0 433 0 0 0 0 0 0 0 432 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 431 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 430 0 429 428 0 0 427 426 0 425 0 0 0 0 424 423 0 422 0 0 0
+421 0 0 0 0 0 0 0 0 420 419 0 418 0 0 0 417 0 0 0 0 0 0 0 416 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 415 414 0 413 0 0 0 412 0 0 0 0 0 0 0 411 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 410 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 409
+408 0 407 0 0 0 406 0 0 0 0 0 0 0 405 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 404 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 403 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 402 0 401 400 0 0 399 398 0 397 0 0 0 0 396 395 0
+394 0 0 0 393 0 0 0 0 0 0 0 0 392 391 0 390 0 0 0 389 0 0 0 0 0 0 0 388 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 387 386 0 385 0 0 0 384 0 0 0 0 0 0 0 383 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 382 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 381 380 0 379 0 0 0 378 0 0 0 0 0 0 0 377 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 376
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 375 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 374 373 0 372 0 0 0 371 0 0 0 0 0 0 0 370 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 369 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 368 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 367 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 366 0 365 364 0 0 363 362 0 361 0 0 0 0 360 359 0 358 0 0 0 357 0 0 0 0 0
+0 0 0 356 355 0 354 0 0 0 353 0 0 0 0 0 0 0 352 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+351 350 0 349 0 0 0 348 0 0 0 0 0 0 0 347 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 346 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 345 344 0 343 0 0 0
+342 0 0 0 0 0 0 0 341 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 340 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 339 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 338 337 0 336 0 0 0 335 0 0 0 0 0 0 0 334 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 333 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 332 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 331 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 330 329 0 328 0 0 0
+327 0 0 0 0 0 0 0 326 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 325 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 324 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 323 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 1 }
+
+! This is a lookup table for all non-flush hands consisting of five unique
+! ranks (i.e. either Straights or High Card hands). A zero means that specific
+! combination is not possible with this type of hand.
+CONSTANT: unique5-table
+{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1608 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 7462 0 0 0 0 0 0 0 7461 0 0 0 7460 0 7459 1607 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 7458 0 0 0 0 0 0 0 7457 0 0 0 7456 0 7455 7454 0 0 0 0 0 0
+0 0 7453 0 0 0 7452 0 7451 7450 0 0 0 0 7449 0 7448 7447 0 0 7446 7445 0 1606 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7444 0 0 0 0 0 0 0 7443 0 0 0 7442 0 7441
+7440 0 0 0 0 0 0 0 0 7439 0 0 0 7438 0 7437 7436 0 0 0 0 7435 0 7434 7433 0 0
+7432 7431 0 7430 0 0 0 0 0 0 0 0 0 0 7429 0 0 0 7428 0 7427 7426 0 0 0 0 7425 0
+7424 7423 0 0 7422 7421 0 7420 0 0 0 0 0 0 7419 0 7418 7417 0 0 7416 7415 0
+7414 0 0 0 0 7413 7412 0 7411 0 0 0 1605 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 7410 0 0 0 0 0 0 0 7409 0 0 0 7408 0 7407 7406 0 0 0 0 0 0 0 0 7405 0 0 0
+7404 0 7403 7402 0 0 0 0 7401 0 7400 7399 0 0 7398 7397 0 7396 0 0 0 0 0 0 0 0
+0 0 7395 0 0 0 7394 0 7393 7392 0 0 0 0 7391 0 7390 7389 0 0 7388 7387 0 7386 0
+0 0 0 0 0 7385 0 7384 7383 0 0 7382 7381 0 7380 0 0 0 0 7379 7378 0 7377 0 0 0
+7376 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7375 0 0 0 7374 0 7373 7372 0 0 0 0 7371 0
+7370 7369 0 0 7368 7367 0 7366 0 0 0 0 0 0 7365 0 7364 7363 0 0 7362 7361 0
+7360 0 0 0 0 7359 7358 0 7357 0 0 0 7356 0 0 0 0 0 0 0 0 0 0 7355 0 7354 7353 0
+0 7352 7351 0 7350 0 0 0 0 7349 7348 0 7347 0 0 0 7346 0 0 0 0 0 0 0 0 7345
+7344 0 7343 0 0 0 7342 0 0 0 0 0 0 0 1604 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 7341 0 0 0 0 0 0 0 7340 0 0 0 7339 0 7338 7337 0 0 0 0 0
+0 0 0 7336 0 0 0 7335 0 7334 7333 0 0 0 0 7332 0 7331 7330 0 0 7329 7328 0 7327
+0 0 0 0 0 0 0 0 0 0 7326 0 0 0 7325 0 7324 7323 0 0 0 0 7322 0 7321 7320 0 0
+7319 7318 0 7317 0 0 0 0 0 0 7316 0 7315 7314 0 0 7313 7312 0 7311 0 0 0 0 7310
+7309 0 7308 0 0 0 7307 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7306 0 0 0 7305 0 7304 7303
+0 0 0 0 7302 0 7301 7300 0 0 7299 7298 0 7297 0 0 0 0 0 0 7296 0 7295 7294 0 0
+7293 7292 0 7291 0 0 0 0 7290 7289 0 7288 0 0 0 7287 0 0 0 0 0 0 0 0 0 0 7286 0
+7285 7284 0 0 7283 7282 0 7281 0 0 0 0 7280 7279 0 7278 0 0 0 7277 0 0 0 0 0 0
+0 0 7276 7275 0 7274 0 0 0 7273 0 0 0 0 0 0 0 7272 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 7271 0 0 0 7270 0 7269 7268 0 0 0 0 7267 0 7266 7265 0 0 7264
+7263 0 7262 0 0 0 0 0 0 7261 0 7260 7259 0 0 7258 7257 0 7256 0 0 0 0 7255 7254
+0 7253 0 0 0 7252 0 0 0 0 0 0 0 0 0 0 7251 0 7250 7249 0 0 7248 7247 0 7246 0 0
+0 0 7245 7244 0 7243 0 0 0 7242 0 0 0 0 0 0 0 0 7241 7240 0 7239 0 0 0 7238 0 0
+0 0 0 0 0 7237 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7236 0 7235 7234 0 0 7233
+7232 0 7231 0 0 0 0 7230 7229 0 7228 0 0 0 7227 0 0 0 0 0 0 0 0 7226 7225 0
+7224 0 0 0 7223 0 0 0 0 0 0 0 7222 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7221 7220 0
+7219 0 0 0 7218 0 0 0 0 0 0 0 7217 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1603 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 7216 0 0 0 0 0 0 0 7215 0 0 0 7214 0 7213 7212 0 0 0 0 0 0 0 0 7211 0 0 0
+7210 0 7209 7208 0 0 0 0 7207 0 7206 7205 0 0 7204 7203 0 7202 0 0 0 0 0 0 0 0
+0 0 7201 0 0 0 7200 0 7199 7198 0 0 0 0 7197 0 7196 7195 0 0 7194 7193 0 7192 0
+0 0 0 0 0 7191 0 7190 7189 0 0 7188 7187 0 7186 0 0 0 0 7185 7184 0 7183 0 0 0
+7182 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7181 0 0 0 7180 0 7179 7178 0 0 0 0 7177 0
+7176 7175 0 0 7174 7173 0 7172 0 0 0 0 0 0 7171 0 7170 7169 0 0 7168 7167 0
+7166 0 0 0 0 7165 7164 0 7163 0 0 0 7162 0 0 0 0 0 0 0 0 0 0 7161 0 7160 7159 0
+0 7158 7157 0 7156 0 0 0 0 7155 7154 0 7153 0 0 0 7152 0 0 0 0 0 0 0 0 7151
+7150 0 7149 0 0 0 7148 0 0 0 0 0 0 0 7147 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 7146 0 0 0 7145 0 7144 7143 0 0 0 0 7142 0 7141 7140 0 0 7139 7138 0 7137
+0 0 0 0 0 0 7136 0 7135 7134 0 0 7133 7132 0 7131 0 0 0 0 7130 7129 0 7128 0 0
+0 7127 0 0 0 0 0 0 0 0 0 0 7126 0 7125 7124 0 0 7123 7122 0 7121 0 0 0 0 7120
+7119 0 7118 0 0 0 7117 0 0 0 0 0 0 0 0 7116 7115 0 7114 0 0 0 7113 0 0 0 0 0 0
+0 7112 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7111 0 7110 7109 0 0 7108 7107 0
+7106 0 0 0 0 7105 7104 0 7103 0 0 0 7102 0 0 0 0 0 0 0 0 7101 7100 0 7099 0 0 0
+7098 0 0 0 0 0 0 0 7097 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7096 7095 0 7094 0 0 0
+7093 0 0 0 0 0 0 0 7092 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7091 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7090 0 0 0 7089 0 7088
+7087 0 0 0 0 7086 0 7085 7084 0 0 7083 7082 0 7081 0 0 0 0 0 0 7080 0 7079 7078
+0 0 7077 7076 0 7075 0 0 0 0 7074 7073 0 7072 0 0 0 7071 0 0 0 0 0 0 0 0 0 0
+7070 0 7069 7068 0 0 7067 7066 0 7065 0 0 0 0 7064 7063 0 7062 0 0 0 7061 0 0 0
+0 0 0 0 0 7060 7059 0 7058 0 0 0 7057 0 0 0 0 0 0 0 7056 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 7055 0 7054 7053 0 0 7052 7051 0 7050 0 0 0 0 7049 7048 0 7047 0
+0 0 7046 0 0 0 0 0 0 0 0 7045 7044 0 7043 0 0 0 7042 0 0 0 0 0 0 0 7041 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 7040 7039 0 7038 0 0 0 7037 0 0 0 0 0 0 0 7036 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 7035 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 7034 0 7033 7032 0 0 7031 7030 0 7029 0 0 0 0 7028 7027 0 7026
+0 0 0 7025 0 0 0 0 0 0 0 0 7024 7023 0 7022 0 0 0 7021 0 0 0 0 0 0 0 7020 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 7019 7018 0 7017 0 0 0 7016 0 0 0 0 0 0 0 7015 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 7014 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 7013 7012 0 7011 0 0 0 7010 0 0 0 0 0 0 0 7009 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 7008 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+1602 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 7007 0 0 0 0 0 0 0 7006 0 0 0 7005 0 7004 7003 0 0 0 0 0 0 0 0 7002 0 0 0
+7001 0 7000 6999 0 0 0 0 6998 0 6997 6996 0 0 6995 6994 0 6993 0 0 0 0 0 0 0 0
+0 0 6992 0 0 0 6991 0 6990 6989 0 0 0 0 6988 0 6987 6986 0 0 6985 6984 0 6983 0
+0 0 0 0 0 6982 0 6981 6980 0 0 6979 6978 0 6977 0 0 0 0 6976 6975 0 6974 0 0 0
+6973 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6972 0 0 0 6971 0 6970 6969 0 0 0 0 6968 0
+6967 6966 0 0 6965 6964 0 6963 0 0 0 0 0 0 6962 0 6961 6960 0 0 6959 6958 0
+6957 0 0 0 0 6956 6955 0 6954 0 0 0 6953 0 0 0 0 0 0 0 0 0 0 6952 0 6951 6950 0
+0 6949 6948 0 6947 0 0 0 0 6946 6945 0 6944 0 0 0 6943 0 0 0 0 0 0 0 0 6942
+6941 0 6940 0 0 0 6939 0 0 0 0 0 0 0 6938 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 6937 0 0 0 6936 0 6935 6934 0 0 0 0 6933 0 6932 6931 0 0 6930 6929 0 6928
+0 0 0 0 0 0 6927 0 6926 6925 0 0 6924 6923 0 6922 0 0 0 0 6921 6920 0 6919 0 0
+0 6918 0 0 0 0 0 0 0 0 0 0 6917 0 6916 6915 0 0 6914 6913 0 6912 0 0 0 0 6911
+6910 0 6909 0 0 0 6908 0 0 0 0 0 0 0 0 6907 6906 0 6905 0 0 0 6904 0 0 0 0 0 0
+0 6903 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6902 0 6901 6900 0 0 6899 6898 0
+6897 0 0 0 0 6896 6895 0 6894 0 0 0 6893 0 0 0 0 0 0 0 0 6892 6891 0 6890 0 0 0
+6889 0 0 0 0 0 0 0 6888 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6887 6886 0 6885 0 0 0
+6884 0 0 0 0 0 0 0 6883 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6882 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6881 0 0 0 6880 0 6879
+6878 0 0 0 0 6877 0 6876 6875 0 0 6874 6873 0 6872 0 0 0 0 0 0 6871 0 6870 6869
+0 0 6868 6867 0 6866 0 0 0 0 6865 6864 0 6863 0 0 0 6862 0 0 0 0 0 0 0 0 0 0
+6861 0 6860 6859 0 0 6858 6857 0 6856 0 0 0 0 6855 6854 0 6853 0 0 0 6852 0 0 0
+0 0 0 0 0 6851 6850 0 6849 0 0 0 6848 0 0 0 0 0 0 0 6847 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 6846 0 6845 6844 0 0 6843 6842 0 6841 0 0 0 0 6840 6839 0 6838 0
+0 0 6837 0 0 0 0 0 0 0 0 6836 6835 0 6834 0 0 0 6833 0 0 0 0 0 0 0 6832 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 6831 6830 0 6829 0 0 0 6828 0 0 0 0 0 0 0 6827 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 6826 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 6825 0 6824 6823 0 0 6822 6821 0 6820 0 0 0 0 6819 6818 0 6817
+0 0 0 6816 0 0 0 0 0 0 0 0 6815 6814 0 6813 0 0 0 6812 0 0 0 0 0 0 0 6811 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 6810 6809 0 6808 0 0 0 6807 0 0 0 0 0 0 0 6806 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 6805 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 6804 6803 0 6802 0 0 0 6801 0 0 0 0 0 0 0 6800 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 6799 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+6798 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6797 0 0 0
+6796 0 6795 6794 0 0 0 0 6793 0 6792 6791 0 0 6790 6789 0 6788 0 0 0 0 0 0 6787
+0 6786 6785 0 0 6784 6783 0 6782 0 0 0 0 6781 6780 0 6779 0 0 0 6778 0 0 0 0 0
+0 0 0 0 0 6777 0 6776 6775 0 0 6774 6773 0 6772 0 0 0 0 6771 6770 0 6769 0 0 0
+6768 0 0 0 0 0 0 0 0 6767 6766 0 6765 0 0 0 6764 0 0 0 0 0 0 0 6763 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 6762 0 6761 6760 0 0 6759 6758 0 6757 0 0 0 0 6756 6755
+0 6754 0 0 0 6753 0 0 0 0 0 0 0 0 6752 6751 0 6750 0 0 0 6749 0 0 0 0 0 0 0
+6748 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6747 6746 0 6745 0 0 0 6744 0 0 0 0 0 0 0
+6743 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6742 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 6741 0 6740 6739 0 0 6738 6737 0 6736 0 0 0 0 6735
+6734 0 6733 0 0 0 6732 0 0 0 0 0 0 0 0 6731 6730 0 6729 0 0 0 6728 0 0 0 0 0 0
+0 6727 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6726 6725 0 6724 0 0 0 6723 0 0 0 0 0 0
+0 6722 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6721 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 6720 6719 0 6718 0 0 0 6717 0 0 0 0 0 0 0 6716 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 6715 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 6714 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6713 0
+6712 6711 0 0 6710 6709 0 6708 0 0 0 0 6707 6706 0 6705 0 0 0 6704 0 0 0 0 0 0
+0 0 6703 6702 0 6701 0 0 0 6700 0 0 0 0 0 0 0 6699 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 6698 6697 0 6696 0 0 0 6695 0 0 0 0 0 0 0 6694 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 6693 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6692
+6691 0 6690 0 0 0 6689 0 0 0 0 0 0 0 6688 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6687 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6686 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6685 6684 0 6683 0 0 0 6682 0 0 0 0 0 0 0
+6681 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6680 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 6679 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1601
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1609 0 0 0 0 0 0 0 6678 0 0 0 6677
+0 6676 6675 0 0 0 0 0 0 0 0 6674 0 0 0 6673 0 6672 6671 0 0 0 0 6670 0 6669
+6668 0 0 6667 6666 0 6665 0 0 0 0 0 0 0 0 0 0 6664 0 0 0 6663 0 6662 6661 0 0 0
+0 6660 0 6659 6658 0 0 6657 6656 0 6655 0 0 0 0 0 0 6654 0 6653 6652 0 0 6651
+6650 0 6649 0 0 0 0 6648 6647 0 6646 0 0 0 6645 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+6644 0 0 0 6643 0 6642 6641 0 0 0 0 6640 0 6639 6638 0 0 6637 6636 0 6635 0 0 0
+0 0 0 6634 0 6633 6632 0 0 6631 6630 0 6629 0 0 0 0 6628 6627 0 6626 0 0 0 6625
+0 0 0 0 0 0 0 0 0 0 6624 0 6623 6622 0 0 6621 6620 0 6619 0 0 0 0 6618 6617 0
+6616 0 0 0 6615 0 0 0 0 0 0 0 0 6614 6613 0 6612 0 0 0 6611 0 0 0 0 0 0 0 6610
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6609 0 0 0 6608 0 6607 6606 0 0 0 0
+6605 0 6604 6603 0 0 6602 6601 0 6600 0 0 0 0 0 0 6599 0 6598 6597 0 0 6596
+6595 0 6594 0 0 0 0 6593 6592 0 6591 0 0 0 6590 0 0 0 0 0 0 0 0 0 0 6589 0 6588
+6587 0 0 6586 6585 0 6584 0 0 0 0 6583 6582 0 6581 0 0 0 6580 0 0 0 0 0 0 0 0
+6579 6578 0 6577 0 0 0 6576 0 0 0 0 0 0 0 6575 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 6574 0 6573 6572 0 0 6571 6570 0 6569 0 0 0 0 6568 6567 0 6566 0 0 0 6565 0
+0 0 0 0 0 0 0 6564 6563 0 6562 0 0 0 6561 0 0 0 0 0 0 0 6560 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 6559 6558 0 6557 0 0 0 6556 0 0 0 0 0 0 0 6555 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 6554 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 6553 0 0 0 6552 0 6551 6550 0 0 0 0 6549 0 6548 6547 0 0 6546
+6545 0 6544 0 0 0 0 0 0 6543 0 6542 6541 0 0 6540 6539 0 6538 0 0 0 0 6537 6536
+0 6535 0 0 0 6534 0 0 0 0 0 0 0 0 0 0 6533 0 6532 6531 0 0 6530 6529 0 6528 0 0
+0 0 6527 6526 0 6525 0 0 0 6524 0 0 0 0 0 0 0 0 6523 6522 0 6521 0 0 0 6520 0 0
+0 0 0 0 0 6519 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6518 0 6517 6516 0 0 6515
+6514 0 6513 0 0 0 0 6512 6511 0 6510 0 0 0 6509 0 0 0 0 0 0 0 0 6508 6507 0
+6506 0 0 0 6505 0 0 0 0 0 0 0 6504 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6503 6502 0
+6501 0 0 0 6500 0 0 0 0 0 0 0 6499 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6498 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6497 0 6496 6495 0 0
+6494 6493 0 6492 0 0 0 0 6491 6490 0 6489 0 0 0 6488 0 0 0 0 0 0 0 0 6487 6486
+0 6485 0 0 0 6484 0 0 0 0 0 0 0 6483 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6482 6481
+0 6480 0 0 0 6479 0 0 0 0 0 0 0 6478 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6477 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6476 6475 0 6474 0 0 0
+6473 0 0 0 0 0 0 0 6472 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6471 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6470 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 6469 0 0 0 6468 0 6467 6466 0 0 0 0 6465 0 6464
+6463 0 0 6462 6461 0 6460 0 0 0 0 0 0 6459 0 6458 6457 0 0 6456 6455 0 6454 0 0
+0 0 6453 6452 0 6451 0 0 0 6450 0 0 0 0 0 0 0 0 0 0 6449 0 6448 6447 0 0 6446
+6445 0 6444 0 0 0 0 6443 6442 0 6441 0 0 0 6440 0 0 0 0 0 0 0 0 6439 6438 0
+6437 0 0 0 6436 0 0 0 0 0 0 0 6435 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6434 0
+6433 6432 0 0 6431 6430 0 6429 0 0 0 0 6428 6427 0 6426 0 0 0 6425 0 0 0 0 0 0
+0 0 6424 6423 0 6422 0 0 0 6421 0 0 0 0 0 0 0 6420 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 6419 6418 0 6417 0 0 0 6416 0 0 0 0 0 0 0 6415 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 6414 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6413
+0 6412 6411 0 0 6410 6409 0 6408 0 0 0 0 6407 6406 0 6405 0 0 0 6404 0 0 0 0 0
+0 0 0 6403 6402 0 6401 0 0 0 6400 0 0 0 0 0 0 0 6399 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 6398 6397 0 6396 0 0 0 6395 0 0 0 0 0 0 0 6394 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 6393 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6392
+6391 0 6390 0 0 0 6389 0 0 0 0 0 0 0 6388 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6387 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6386 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6385 0 6384 6383 0 0 6382 6381 0 6380 0 0
+0 0 6379 6378 0 6377 0 0 0 6376 0 0 0 0 0 0 0 0 6375 6374 0 6373 0 0 0 6372 0 0
+0 0 0 0 0 6371 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6370 6369 0 6368 0 0 0 6367 0 0
+0 0 0 0 0 6366 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6365 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6364 6363 0 6362 0 0 0 6361 0 0 0 0 0 0 0
+6360 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6359 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 6358 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+6357 6356 0 6355 0 0 0 6354 0 0 0 0 0 0 0 6353 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+6352 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6351 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6350 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6349 0
+0 0 6348 0 6347 6346 0 0 0 0 6345 0 6344 6343 0 0 6342 6341 0 6340 0 0 0 0 0 0
+6339 0 6338 6337 0 0 6336 6335 0 6334 0 0 0 0 6333 6332 0 6331 0 0 0 6330 0 0 0
+0 0 0 0 0 0 0 6329 0 6328 6327 0 0 6326 6325 0 6324 0 0 0 0 6323 6322 0 6321 0
+0 0 6320 0 0 0 0 0 0 0 0 6319 6318 0 6317 0 0 0 6316 0 0 0 0 0 0 0 6315 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 6314 0 6313 6312 0 0 6311 6310 0 6309 0 0 0 0 6308
+6307 0 6306 0 0 0 6305 0 0 0 0 0 0 0 0 6304 6303 0 6302 0 0 0 6301 0 0 0 0 0 0
+0 6300 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6299 6298 0 6297 0 0 0 6296 0 0 0 0 0 0
+0 6295 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6294 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6293 0 6292 6291 0 0 6290 6289 0 6288 0 0 0 0
+6287 6286 0 6285 0 0 0 6284 0 0 0 0 0 0 0 0 6283 6282 0 6281 0 0 0 6280 0 0 0 0
+0 0 0 6279 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6278 6277 0 6276 0 0 0 6275 0 0 0 0
+0 0 0 6274 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6273 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6272 6271 0 6270 0 0 0 6269 0 0 0 0 0 0 0 6268 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 6267 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 6266 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6265
+0 6264 6263 0 0 6262 6261 0 6260 0 0 0 0 6259 6258 0 6257 0 0 0 6256 0 0 0 0 0
+0 0 0 6255 6254 0 6253 0 0 0 6252 0 0 0 0 0 0 0 6251 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 6250 6249 0 6248 0 0 0 6247 0 0 0 0 0 0 0 6246 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 6245 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6244
+6243 0 6242 0 0 0 6241 0 0 0 0 0 0 0 6240 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6239 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6238 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6237 6236 0 6235 0 0 0 6234 0 0 0 0 0 0 0
+6233 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6232 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 6231 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6230
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 6229 0 6228 6227 0 0 6226 6225 0 6224 0 0 0 0 6223 6222 0
+6221 0 0 0 6220 0 0 0 0 0 0 0 0 6219 6218 0 6217 0 0 0 6216 0 0 0 0 0 0 0 6215
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6214 6213 0 6212 0 0 0 6211 0 0 0 0 0 0 0 6210
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6209 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 6208 6207 0 6206 0 0 0 6205 0 0 0 0 0 0 0 6204 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 6203 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 6202 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6201 6200 0 6199 0
+0 0 6198 0 0 0 0 0 0 0 6197 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6196 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6195 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 6194 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6193 6192 0 6191 0 0 0 6190 0 0 0 0 0 0
+0 6189 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6188 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 6187 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+6186 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 1600 }
+
+! This is a lookup table for the product of prime values associated with the
+! cards in a hand.
+CONSTANT: products-table
+{ 48 72 80 108 112 120 162 168 176 180 200 208 252 264 270 272 280 300 304 312
+368 378 392 396 405 408 420 440 450 456 464 468 496 500 520 552 567 588 592 594
+612 616 630 656 660 675 680 684 696 700 702 728 744 750 760 780 828 882 888 891
+918 920 924 945 952 968 980 984 990 1020 1026 1044 1050 1053 1064 1092 1100
+1116 1125 1140 1144 1160 1170 1240 1242 1250 1288 1300 1323 1332 1352 1372 1377
+1380 1386 1428 1452 1470 1476 1480 1485 1496 1530 1539 1540 1566 1575 1596 1624
+1638 1640 1650 1672 1674 1700 1710 1716 1736 1740 1750 1755 1768 1820 1860 1863
+1875 1900 1932 1950 1976 1998 2024 2028 2058 2070 2072 2079 2142 2156 2178 2205
+2214 2220 2244 2295 2296 2300 2312 2349 2380 2392 2394 2420 2436 2450 2457 2460
+2475 2508 2511 2548 2550 2552 2565 2574 2584 2604 2610 2625 2652 2660 2728 2750
+2790 2850 2860 2888 2898 2900 2925 2964 2997 3016 3036 3042 3087 3100 3105 3108
+3128 3213 3220 3224 3234 3250 3256 3267 3321 3330 3332 3366 3380 3388 3430 3444
+3450 3465 3468 3496 3588 3591 3608 3630 3654 3675 3690 3700 3724 3740 3762 3822
+3825 3828 3848 3850 3861 3876 3906 3915 3944 3978 4004 4060 4092 4095 4100 4125
+4180 4185 4216 4232 4250 4264 4275 4332 4340 4347 4350 4375 4408 4420 4446 4508
+4524 4550 4554 4563 4650 4662 4692 4712 4732 4750 4802 4836 4851 4875 4884 4940
+4995 4998 5032 5049 5060 5070 5082 5145 5166 5175 5180 5202 5236 5244 5324 5336
+5355 5382 5390 5412 5445 5481 5535 5550 5576 5586 5624 5643 5684 5704 5733 5740
+5742 5750 5772 5775 5780 5814 5852 5859 5916 5950 5967 5980 5985 6050 6076 6125
+6138 6150 6188 6232 6292 6324 6348 6370 6375 6380 6396 6435 6460 6498 6525 6612
+6650 6669 6728 6762 6786 6808 6820 6825 6831 6875 6916 6975 6993 7038 7068 7084
+7098 7125 7150 7192 7203 7220 7245 7250 7252 7254 7326 7436 7497 7540 7544 7546
+7548 7605 7623 7688 7749 7750 7803 7820 7866 7986 8004 8036 8050 8060 8073 8085
+8092 8118 8125 8140 8228 8325 8330 8364 8372 8379 8415 8436 8450 8470 8526 8556
+8575 8584 8613 8625 8658 8670 8721 8740 8788 8874 8918 8925 8932 9009 9020 9044
+9075 9114 9135 9176 9196 9207 9225 9250 9310 9348 9350 9405 9438 9486 9512 9522
+9548 9555 9594 9620 9625 9724 9747 9765 9860 9918 9945 9975 10092 10108 10143
+10150 10168 10179 10212 10250 10450 10540 10556 10557 10580 10602 10625 10647
+10660 10725 10788 10830 10850 10868 10875 10878 10881 10948 10952 10989 11020
+11050 11115 11132 11154 11270 11284 11316 11319 11322 11375 11385 11396 11492
+11532 11625 11655 11662 11780 11781 11799 11830 11858 11875 11979 12005 12006
+12054 12075 12136 12138 12177 12236 12342 12350 12495 12546 12580 12628 12650
+12654 12675 12705 12716 12789 12834 12844 12876 12915 12950 12987 13005 13034
+13156 13167 13182 13310 13311 13340 13377 13448 13455 13468 13475 13671 13764
+13794 13804 13875 13923 13940 13965 14014 14022 14025 14036 14060 14157 14210
+14212 14229 14260 14268 14283 14350 14355 14375 14391 14450 14535 14756 14812
+14875 14877 14924 14950 15004 15028 15125 15138 15162 15190 15225 15252 15318
+15345 15375 15428 15548 15561 15580 15675 15730 15778 15870 15884 15903 15925
+15939 15950 16150 16182 16245 16275 16317 16428 16492 16562 16575 16588 16625
+16698 16731 16796 16820 16905 16965 16974 16983 17020 17050 17204 17238 17298
+17493 17595 17612 17732 17745 17787 17875 17908 17980 18009 18050 18081 18125
+18130 18135 18204 18207 18315 18326 18513 18525 18590 18634 18676 18772 18819
+18837 18850 18860 18865 18975 18981 19074 19220 19228 19251 19266 19314 19375
+19425 19516 19550 19551 19604 19652 19665 19684 19773 19844 19894 19964 19965
+20090 20097 20125 20150 20172 20230 20295 20332 20349 20350 20482 20570 20646
+20691 20825 20956 21021 21033 21054 21125 21164 21175 21266 21315 21402 21460
+21483 21525 21645 21658 21675 21692 21812 21850 21879 21964 21970 22022 22185
+22218 22295 22425 22506 22542 22550 22707 22724 22743 22785 22878 22940 22977
+22990 23125 23188 23275 23276 23322 23375 23452 23548 23595 23667 23715 23751
+23780 23805 23826 23828 23925 23985 24050 24206 24225 24244 24273 24453 24548
+24633 24642 24650 24794 24795 24843 25012 25025 25047 25172 25230 25270 25375
+25382 25389 25420 25461 25575 25625 25636 25641 25857 25916 25947 26026 26125
+26350 26404 26411 26450 26505 26588 26650 26862 26908 27075 27125 27195 27306
+27380 27404 27436 27489 27508 27531 27550 27625 27676 27716 27830 27885 27951
+28126 28158 28175 28275 28305 28322 28413 28611 28652 28730 28798 28830 28899
+28971 29155 29282 29302 29325 29348 29406 29450 29478 29575 29601 29645 29716
+29766 29841 30015 30044 30135 30225 30258 30303 30340 30345 30525 30628 30668
+30723 30758 30855 30875 30932 30969 31059 31213 31262 31365 31372 31434 31450
+31581 31625 31635 31654 31790 31899 31977 32085 32103 32110 32116 32186 32375
+32487 32585 32708 32725 32775 32946 32955 33033 33201 33212 33275 33292 33327
+33350 33418 33524 33579 33620 33759 33813 33825 34276 34317 34485 34606 34684
+34713 34850 34914 34983 35035 35055 35090 35150 35322 35378 35525 35588 35650
+35739 35836 35875 35972 36075 36125 36244 36309 36556 36575 36822 36946 36963
+36975 37004 37030 37076 37107 37191 37323 37375 37444 37468 37510 37518 37570
+37791 37845 37905 37975 38073 38295 38318 38332 38675 38709 38870 38950 38962
+39039 39325 39445 39494 39525 39556 39627 39675 39710 39875 39882 39886 39897
+39975 40052 40204 40222 40293 40362 40375 40455 40508 40817 40898 40959 41070
+41154 41262 41325 41405 41492 41503 41574 41745 41876 42021 42050 42189 42237
+42284 42435 42476 42483 42550 42625 42772 42826 43095 43197 43225 43245 43263
+43732 43911 43923 43953 44109 44175 44198 44217 44252 44275 44289 44506 44649
+44764 44770 44919 44950 44954 45125 45254 45325 45356 45387 45619 45747 45815
+46137 46475 46585 46748 46893 46930 47068 47125 47138 47150 47151 47175 47212
+47396 47481 47619 47685 47804 48050 48165 48279 48285 48314 48334 48484 48668
+48807 48875 49010 49036 49049 49077 49126 49130 49419 49610 49735 49818 49972
+50025 50127 50225 50286 50375 50430 50468 50575 50578 50692 50875 51129 51205
+51425 51615 51646 51842 51909 52173 52234 52275 52316 52325 52371 52390 52514
+52598 52635 52725 52767 52972 52983 53067 53165 53428 53475 53482 53505 53613
+53650 53754 53958 53998 54145 54188 54418 54549 54625 54910 54925 55055 55223
+55233 55419 55506 55545 55594 55796 55825 55924 56265 56277 56355 56375 56525
+56637 57122 57188 57195 57350 57475 57477 57498 57681 57722 57868 57967 58190
+58305 58311 58425 58443 58870 59204 59241 59409 59450 59565 59644 59675 59774
+59823 59829 60125 60236 60306 60333 60515 60543 60775 61132 61226 61347 61364
+61370 61605 61625 61642 61659 61731 61828 61893 61985 62271 62361 62530 62678
+62814 63075 63175 63206 63426 63455 63550 63825 63916 64124 64141 64158 64239
+64467 64676 65065 65219 65348 65366 65596 65598 65702 65875 65975 66033 66092
+66125 66297 66470 66625 66748 66759 66861 67146 67155 67270 67425 67431 67599
+67881 67925 68265 68306 68324 68425 68450 68590 68614 68770 68782 68875 68894
+68913 69003 69290 69454 69575 69597 69629 69874 69938 70315 70395 70525 70587
+70602 70642 70707 70725 70805 71094 71188 71225 71668 71687 71825 71995 72075
+72261 72358 72471 72501 72964 73002 73036 73205 73255 73346 73515 73593 73625
+73689 73695 73964 74415 74431 74698 74727 74907 74958 75429 75645 75803 75850
+75867 76342 76475 76874 76895 77077 77121 77198 77372 77469 77763 77996 78039
+78155 78166 78292 78351 78585 78625 78771 78884 78897 78925 79135 79475 80073
+80142 80223 80275 80465 80475 80631 80852 80937 80997 81466 81548 81549 81627
+82225 82251 82365 82418 82522 82654 82708 83030 83259 83375 83391 83398 83421
+83486 83545 83810 84050 84175 84249 84303 84721 85514 85683 85782 85918 86025
+86247 86275 86428 86515 86583 86756 86779 87125 87172 87285 87362 87412 87542
+87725 87875 88102 88305 88412 88445 88806 88825 88837 89001 89125 89175 89590
+89661 89930 90117 90354 90364 90459 91091 91143 91234 91839 92046 92055 92225
+92365 92414 92463 92510 92575 93058 93092 93275 93357 93775 93795 93925 94017
+94178 94221 94622 94809 95139 95325 95571 95795 95830 95874 96026 96237 96278
+96425 96596 97006 97175 97375 97405 97526 97556 97682 98022 98049 98394 98397
+98441 98494 98553 98716 98735 99127 99275 99567 99705 99715 100510 100555
+100719 100793 100905 101062 102051 102245 102459 102487 102557 102675 102885
+102921 103075 103155 103156 103173 103246 103341 103675 103935 104044 104181
+104284 104690 104811 104907 104975 105125 105154 105183 105524 105710 105754
+105903 105963 106227 106375 106641 106782 106930 107065 107525 107559 107653
+107822 108086 108537 109089 109142 109174 109330 109388 109417 109503 109554
+110019 110075 110331 110495 110789 110825 110946 111265 111476 111910 111925
+112047 112375 112385 112406 112437 112651 113135 113553 113775 114057 114308
+114513 115258 115292 115311 115797 116058 116242 116402 116522 116725 116932
+116963 117249 117325 117334 117438 117670 117711 117845 117875 118490 119119
+119164 119187 119306 120125 120175 120213 120785 120802 120835 121121 121670
+121923 121975 122018 122199 122525 122815 122825 123025 123627 123783 123823
+123981 124025 124468 124545 124558 124775 124930 125097 125229 125426 125541
+125715 125829 125902 125948 126075 126445 127075 127426 127534 127738 127756
+128018 128271 128673 128877 128986 129115 129311 129514 129605 130134 130203
+130585 130975 131043 131118 131285 131313 131495 132153 132158 132275 132618
+133052 133133 133209 133342 133570 133705 134113 134125 134162 134199 134385
+134895 134995 135014 135531 135575 136045 136214 136325 136367 136851 137275
+137547 137566 137924 138069 138229 138621 138765 138985 139113 139564 139587
+139601 139638 140714 140777 141267 141933 142025 142228 142538 142766 142805
+142970 143143 143375 143745 143811 144039 144279 144305 144417 144925 145475
+145509 145521 146234 146289 146334 146523 146566 146575 147033 147175 147436
+147591 147706 147741 147994 148010 148625 148666 148707 148925 149435 149702
+149891 150183 150590 150765 150898 151294 151525 151593 152218 152438 153062
+153065 153410 153425 153729 154105 154652 154693 154869 155771 156066 156325
+156426 156674 156695 157035 157325 157339 157604 157731 158015 158389 158565
+158631 158804 158875 159562 159790 160173 160225 160395 161161 161253 161414
+161733 161975 162129 162578 163370 163415 163713 163761 163990 163995 164169
+164255 164331 164738 164983 165025 165886 166175 166419 166634 167042 167214
+167865 168175 168609 168674 169099 169169 169756 170126 170338 170765 171125
+171275 171462 171475 171535 171925 171941 171955 172235 172546 172822 172887
+172975 173225 173635 174087 174097 174363 174603 174685 174783 174845 174902
+175491 175972 176001 176157 176505 176605 177023 177489 177735 177970 178126
+178334 178746 178802 178959 179075 180154 180761 180895 181203 181447 181917
+182505 182590 182666 182819 183027 183365 183425 183483 183799 184093 184382
+184910 185725 186093 186238 186694 186702 186745 186837 186998 187187 187395
+187775 188108 188139 188518 188853 188922 188993 189625 190333 190463 190855
+191139 191301 191425 191607 191634 191675 192027 192185 192995 193325 193430
+193479 194271 194463 194579 194996 195201 195415 195730 196075 196137 196677
+197098 197846 198237 198927 199082 199927 200013 200158 200355 200725 201243
+202027 202521 202612 203203 203319 203522 203665 204321 204425 205751 205942
+206045 206305 206349 206635 206886 207214 207575 208075 208444 208495 208658
+208715 209209 209457 209525 210125 210749 210826 211071 212602 213342 213785
+213807 214149 214225 214291 214455 214774 214795 215747 215878 216775 216890
+217217 217341 217558 217906 218405 218530 218855 219351 219373 219501 219849
+220255 221030 221122 221221 221559 221991 222015 222111 222425 222999 223706
+223975 224516 224553 224825 224939 225446 225885 225998 226347 226525 226941
+228085 228206 228327 228475 228657 228718 228781 229586 229593 229957 230115
+230318 231035 231275 231725 231978 232101 232562 232645 232730 232934 233206
+233818 234025 234099 234175 234639 235011 235246 235445 235543 235586 236406
+236555 237429 237614 238206 239071 239343 239575 239685 240065 240149 240526
+240695 240737 240994 241129 242121 242515 243089 243815 243867 243890 244205
+244559 244783 245055 245985 246123 246202 246235 247107 247225 247247 248788
+248829 248897 249067 249158 249951 250325 250563 250821 251275 252586 252655
+253011 253175 253253 254634 255189 255507 255626 256711 257193 258115 258819
+258874 259233 259259 259325 259407 259666 260110 260642 260678 260710 261326
+261443 261725 262353 262885 263097 263302 264275 264385 265475 265727 265837
+266955 267189 267197 267325 267501 267674 268119 268203 269059 269555 270193
+270215 270231 270802 272194 272855 272935 273325 273581 273885 273999 274022
+274846 275684 276573 276575 277365 277574 278018 278179 278369 278690 279357
+279775 280041 280053 280497 281015 282302 282777 283383 283475 284053 284258
+284954 285131 285770 287287 287451 287638 287738 288145 288463 288827 289289
+290145 290605 290966 291005 291305 291893 292175 292201 292494 293335 293595
+293854 294151 294175 295075 295647 296225 296769 296989 297910 298265 298623
+298775 299299 299367 300237 300713 302005 303025 303646 303862 303918 304175
+304606 305045 305283 305762 305767 305942 306397 306475 307582 308074 308357
+308913 309442 310329 310821 311170 311395 312325 312666 312987 313565 314019
+314041 314171 314534 314755 314870 315425 315514 316239 316342 316825 317471
+318478 318565 318734 318835 318903 319319 319345 319390 320013 320045 322161
+322465 323449 323785 323817 324818 325335 325622 325703 325822 326337 326859
+326975 327795 328757 329623 330395 331075 331177 331298 331545 331683 331731
+333355 333925 335405 335559 335699 336091 336743 336774 336973 337502 337535
+338169 338675 338997 339031 339521 340442 340535 341341 341446 341734 341887
+342309 343077 343915 344379 344729 344810 345477 347282 347633 347967 348725
+348843 349095 349401 349525 349809 350727 350987 351538 351785 352869 353379
+353717 354609 355570 355946 356345 356421 356915 357309 357425 359414 359513
+360778 360789 361361 361491 361675 362674 363562 364021 364154 364994 365585
+365835 366415 367114 368039 369265 369303 369985 370025 370139 371665 371722
+372775 373182 373737 374255 375193 375683 376475 377245 377377 378235 378301
+378879 378917 380494 380545 381095 381938 381951 381997 382075 382109 382655
+383439 383525 384307 384659 384826 385526 386425 386630 387686 388311 388531
+389499 390165 390166 390963 391017 391065 391534 391685 391989 393421 394010
+394953 395937 397010 397822 397969 398866 398905 399475 400078 400673 400775
+401511 401698 401882 402866 403403 403535 404225 406203 406334 406445 406802
+406847 407407 407827 408291 408425 409975 410669 410839 411033 411845 412114
+412269 413075 413526 413678 414715 415454 416361 416585 417027 417074 417175
+417571 417605 418035 419881 421685 422807 423243 423453 424390 424589 424762
+424879 425258 425315 425546 425845 426374 426387 427025 427063 427431 428655
+429598 429913 430606 431365 431457 431607 432055 435638 435953 436449 437255
+438741 438991 440657 440781 440818 443989 444925 445315 445835 445991 446369
+446865 447005 447083 447146 447811 447925 448063 450262 450385 451451 453299
+453871 454138 454181 454597 455469 455793 455877 456025 456475 456665 456909
+458643 458689 458913 458983 459173 460955 461373 462111 462275 462346 462553
+462722 464163 465595 466697 466735 466755 467495 468999 469567 470327 471295
+471801 472305 472549 473271 474513 474734 476749 477158 477717 478101 479085
+480491 480766 481481 481574 482734 483575 484561 485537 486098 486266 487227
+487475 487490 488433 488733 489325 490637 491878 492499 492745 493025 494615
+496223 496947 497705 497798 498883 499681 500395 501787 502918 503234 505161
+505325 506253 506530 507566 508079 508277 508805 508898 509675 510663 511819
+512006 512169 512601 512746 512981 514786 514855 516925 516971 517215 517979
+518035 519622 520331 520421 520923 521110 521594 521645 523957 527065 527307
+528143 529529 531505 532763 533355 533533 533919 535717 536393 536558 536935
+537251 539121 539695 540175 541167 541282 541717 542087 542225 542659 543286
+543895 544011 544765 544825 545054 545343 546231 546325 547491 548359 550671
+551614 552575 552805 555458 555611 555814 555841 557566 557583 558467 559265
+559682 559773 561290 562438 563615 563914 564775 564949 564995 567853 568178
+569023 570515 570741 571795 572242 572663 572907 573562 573965 574678 575795
+576583 577239 578289 578347 579945 580601 581405 581529 581647 581825 582335
+582958 583015 583219 584545 584647 585249 585599 587301 588115 588965 590359
+591015 593021 593929 594035 594146 594473 595441 595515 596183 596733 598299
+600117 600281 600457 600691 601315 602485 602547 602823 603725 603911 604299
+604877 605098 607202 609501 609725 610203 612157 613118 614422 615043 615505
+616975 618171 618233 620194 620289 620517 620806 620977 621970 622895 623162
+623181 623441 624169 625611 625807 628694 630539 631465 633919 634114 634933
+636585 637143 637887 638319 639065 639331 639561 640211 640871 644397 644725
+645337 645909 647185 648907 649078 649165 650275 651605 651695 651775 651833
+653315 653429 653457 654493 655402 656183 656903 657662 658255 659525 659813
+661227 662966 663803 664411 665482 669185 670719 671099 675393 676286 677005
+677846 680485 680846 681207 682486 683501 683675 684574 685055 685069 687115
+687242 687401 689210 689843 692461 692714 693519 693842 693935 694083 695045
+696725 696787 700553 700843 701437 702559 702658 704099 705686 705755 708883
+709142 709423 709631 710645 712101 712327 712385 714425 715737 719095 719345
+720575 720797 721149 722361 724101 724594 725249 726869 727415 729147 729399
+729554 730303 730639 730825 731235 733381 734635 734638 735034 737426 737817
+737891 742577 743002 743774 744107 744775 746697 748867 749177 751502 751709
+754354 754377 754851 755573 756613 757393 758582 759115 759655 759795 761349
+761453 761515 762671 763347 764405 764855 768009 768955 769119 770185 772179
+773605 773927 774566 774706 775489 777925 779433 781665 782254 782391 782971
+783959 785213 785519 785806 786335 787175 788785 789061 790855 790993 791282
+792281 793117 796195 796835 798475 798721 800513 803551 804287 804837 806113
+809042 809627 811923 812045 812383 813967 814055 814555 814929 815269 816221
+817581 817663 818363 818662 823361 824182 824551 827421 828134 828245 828269
+828971 829226 829939 830297 830414 831575 831649 832117 833187 833721 836349
+836969 837199 838409 839523 839914 841841 841935 843479 843657 843755 845871
+850586 851105 852267 853615 854335 858363 858458 859027 860343 861707 862017
+862025 866723 866822 868205 870758 872053 872275 873422 874437 876826 877591
+877933 878845 884051 884374 885391 886414 887777 888925 889778 889865 891219
+893809 894179 894691 896506 898535 898909 900358 901945 906059 906685 907647
+908831 908905 910385 910803 912247 912373 912485 914641 916487 917662 917785
+918731 919677 921475 921557 921633 924482 926497 926782 927707 927979 929305
+930291 931209 932955 933658 934743 935693 936859 943041 947546 947807 949003
+950521 951142 951171 951235 952679 954845 955451 959077 960089 961961 962065
+963815 964894 966329 966575 969215 971509 971618 973063 973617 975415 978835
+979693 980837 983103 983411 985025 986493 988057 988418 989417 990437 990698
+990847 992525 994449 994555 994903 997165 997339 997694 998223 998963 1000195
+1004245 1004663 1004705 1005238 1006733 1007083 1007165 1012894 1013173 1014101
+1014429 1015835 1016738 1016769 1017005 1018381 1021269 1023729 1024309 1024426
+1026817 1026861 1028489 1030285 1030863 1032226 1033815 1034195 1036849 1037153
+1038635 1039071 1040763 1042685 1049191 1053987 1056757 1057978 1058529 1058743
+1059022 1060975 1061905 1062761 1063145 1063517 1063713 1063865 1065935 1066121
+1067857 1070167 1070558 1070797 1072478 1073995 1076515 1076537 1078259 1083047
+1083121 1084039 1085773 1085926 1086891 1088153 1089095 1094331 1094951 1095274
+1096381 1099825 1100869 1101957 1102045 1102551 1103414 1104299 1105819 1106139
+1106959 1107197 1114366 1114503 1114673 1115569 1115661 1117865 1119371 1121549
+1121894 1123343 1125655 1127253 1131531 1132058 1132681 1133407 1135234 1135345
+1136863 1137873 1139677 1140377 1146442 1147619 1155865 1156805 1157819 1159171
+1159543 1161849 1162059 1162213 1169311 1171001 1172354 1173381 1175675 1178709
+1181257 1182446 1183301 1186835 1186923 1187329 1191547 1192895 1195061 1196069
+1196506 1196569 1198483 1199266 1201915 1203935 1206835 1208938 1209271 1210547
+1211573 1213511 1213526 1213563 1213682 1215245 1215487 1215665 1216171 1218725
+1225367 1227993 1229695 1230383 1234838 1236273 1239953 1242201 1242989 1243839
+1244495 1245621 1245811 1255133 1255501 1257295 1257949 1257962 1258085 1259871
+1262723 1263661 1266325 1266749 1267474 1268915 1269359 1272245 1272467 1274539
+1275879 1277479 1279091 1280015 1281137 1281865 1281974 1282633 1284899 1285999
+1286965 1287687 1292669 1293853 1294033 1295723 1299055 1300233 1301027 1302775
+1303985 1306137 1306877 1310133 1310278 1314542 1315239 1316978 1322893 1325467
+1326561 1329621 1331729 1334667 1336783 1338623 1339634 1340003 1341395 1344718
+1344759 1346891 1349341 1349834 1350537 1351166 1353205 1354111 1354886 1356277
+1356901 1358215 1362635 1365581 1368334 1370369 1370386 1372019 1376493 1379035
+1381913 1386723 1388645 1389223 1389535 1390173 1392377 1393915 1396031 1399205
+1400273 1400487 1403207 1403225 1405943 1406095 1406587 1409785 1410031 1412327
+1414127 1414562 1416389 1420445 1421319 1422169 1423807 1426713 1428163 1430605
+1431382 1432417 1433531 1433729 1433905 1436695 1437293 1442399 1442926 1446071
+1447341 1447873 1448161 1448402 1454089 1457395 1457427 1459354 1459759 1465399
+1466641 1468987 1469194 1472207 1482627 1483339 1485365 1486047 1486667 1488403
+1489411 1492309 1496541 1497067 1497238 1503593 1507121 1507857 1508638 1511653
+1512118 1512745 1514071 1515839 1516262 1518005 1519341 1519817 1524733 1525107
+1526657 1529099 1531309 1532795 1533433 1536055 1536639 1542863 1544491 1548339
+1550485 1552015 1552661 1554925 1557905 1563419 1565011 1566461 1567247 1571735
+1575917 1582009 1582559 1583023 1585285 1586126 1586899 1586967 1588533 1589483
+1600313 1602403 1604986 1605837 1608717 1612682 1616197 1616402 1617122 1618211
+1619527 1622695 1628889 1629887 1635622 1638505 1639187 1641809 1642911 1644155
+1655121 1657415 1657466 1661569 1663705 1670053 1671241 1671549 1675333 1681691
+1682681 1682841 1685509 1687829 1689569 1690715 1691701 1692197 1694173 1694407
+1694615 1698087 1698619 1701343 1701931 1702115 1702851 1706215 1709659 1711435
+1711463 1718105 1719663 1721573 1722202 1723025 1727878 1729937 1731785 1734605
+1735327 1739881 1742293 1750507 1751629 1753037 1756645 1758531 1760213 1761319
+1764215 1769261 1771774 1772855 1773593 1773669 1776481 1778498 1781143 1786499
+1790921 1791946 1792021 1794611 1794759 1798899 1801751 1804231 1804786 1806091
+1807117 1811485 1812446 1813407 1818677 1820289 1820523 1822139 1823885 1825579
+1826246 1834963 1836595 1837585 1843565 1847042 1847677 1849243 1852201 1852257
+1852462 1856261 1857505 1859435 1869647 1870297 1872431 1877953 1878755 1879537
+1885885 1886943 1891279 1894487 1896455 1901211 1901501 1907689 1908386 1910051
+1916291 1920983 1922961 1924814 1929254 1930649 1933459 1936415 1936765 1939751
+1944103 1945349 1951481 1952194 1955635 1956449 1957703 1958887 1964515 1965417
+1968533 1971813 1973699 1975103 1975467 1976777 1978205 1979939 1980218 1982251
+1984279 1987453 1988623 1994707 1999283 1999591 1999898 2002481 2002847 2007467
+2009451 2011373 2017077 2019127 2019719 2022605 2024751 2026749 2032329 2040353
+2044471 2046655 2048449 2050841 2052501 2055579 2056223 2060455 2062306 2066801
+2070107 2070335 2071771 2073065 2076035 2079511 2092717 2099785 2100659 2111317
+2114698 2116543 2117843 2120393 2121843 2125207 2126465 2132273 2132902 2137822
+2141737 2145913 2146145 2146981 2147073 2150477 2153437 2155657 2164389 2167055
+2167957 2170679 2172603 2172821 2176895 2181067 2183555 2188021 2189031 2192065
+2193763 2200429 2203791 2204534 2207161 2209339 2210351 2210935 2212873 2215457
+2215763 2216035 2219399 2221271 2224445 2234837 2237411 2238067 2241265 2242454
+2245857 2250895 2257333 2262957 2266627 2268177 2271773 2274393 2275229 2284997
+2285258 2289443 2293907 2294155 2301817 2302658 2304323 2311205 2313649 2316955
+2320381 2329187 2330038 2334145 2336191 2338919 2340503 2343314 2345057 2357381
+2359379 2362789 2363153 2363486 2367001 2368333 2368865 2372461 2377855 2379189
+2382961 2386241 2388701 2396009 2397106 2399567 2405347 2407479 2412235 2416193
+2419023 2422109 2424499 2424603 2425683 2428447 2429045 2442862 2444923 2445773
+2453433 2459303 2461462 2466827 2469901 2471045 2473211 2476441 2476745 2481997
+2482597 2486199 2494235 2497759 2501369 2501917 2505919 2513095 2519959 2532235
+2536079 2541845 2542903 2544971 2551594 2553439 2561065 2571233 2572619 2580565
+2580991 2581934 2582827 2583303 2585843 2589151 2591817 2592629 2598977 2600507
+2603209 2611037 2612233 2614447 2618629 2618998 2624369 2630257 2631218 2636953
+2640239 2641171 2644213 2644945 2647555 2648657 2655037 2657661 2667747 2673539
+2674463 2676395 2678741 2681195 2681869 2687919 2688907 2700451 2705329 2707063
+2707179 2709239 2710981 2711471 2714815 2718669 2732561 2733511 2737889 2738185
+2739369 2750321 2758535 2760953 2764177 2766049 2767787 2769487 2770563 2771431
+2778693 2785915 2791613 2792387 2798939 2804735 2816033 2820103 2827442 2830145
+2831323 2831647 2838085 2857921 2861062 2862579 2865317 2866105 2868767 2884637
+2886689 2887221 2893757 2893881 2898469 2902291 2904739 2906449 2915674 2922029
+2926703 2928291 2930885 2937874 2939699 2951069 2951897 2956115 2970327 2977051
+2986159 2988073 2991265 2997383 2997797 2998165 2999847 3004603 3005249 3007693
+3022345 3022438 3025541 3027973 3033815 3033877 3034205 3047653 3055019 3056977
+3066613 3068891 3078251 3082729 3085771 3087095 3090277 3093409 3093459 3095309
+3101527 3102449 3114223 3120469 3124979 3130231 3137771 3140486 3144905 3147331
+3151253 3154591 3159637 3160729 3168685 3170366 3172047 3192101 3197207 3199353
+3204935 3206269 3206733 3211817 3230882 3234199 3235687 3243737 3246473 3255482
+3267803 3268967 3271021 3275695 3276971 3286355 3292445 3295331 3299179 3306801
+3307837 3308987 3316411 3328039 3328997 3332849 3339611 3346109 3349085 3361795
+3363681 3372149 3374585 3377129 3377543 3377915 3379321 3381487 3387215 3390361
+3400663 3411067 3414433 3415997 3420835 3424361 3425965 3427391 3427887 3445403
+3453839 3453987 3457817 3459463 3467443 3479998 3487583 3487627 3491929 3494413
+3495057 3502969 3514971 3516263 3518333 3531359 3536405 3537193 3542851 3545129
+3545229 3558583 3569929 3578455 3585491 3595659 3604711 3607315 3607426 3610477
+3612791 3614693 3617141 3621005 3624179 3628411 3637933 3646313 3648385 3651583
+3655847 3660151 3662497 3664293 3665441 3672985 3683017 3692193 3693157 3702923
+3706577 3719573 3728153 3735407 3743095 3744653 3746953 3748322 3753673 3765157
+3771595 3779309 3779831 3780295 3789227 3790655 3800741 3809927 3816131 3817879
+3827227 3827391 3833459 3856214 3860173 3861949 3864619 3872901 3881273 3900281
+3915083 3926629 3928497 3929941 3933137 3946813 3946827 3962203 3965315 3973319
+3985267 3993743 3997418 4012465 4012547 4024823 4031261 4031705 4035239 4039951
+4040509 4041005 4042687 4042805 4050553 4055843 4081181 4086511 4089055 4090757
+4093379 4103239 4121741 4131833 4133261 4138561 4143665 4148947 4153546 4170751
+4172201 4180963 4187771 4197431 4219007 4221811 4231283 4241163 4247341 4247887
+4260113 4260883 4273102 4274803 4277489 4291593 4302397 4305505 4309279 4314311
+4319695 4321933 4325633 4352051 4358341 4373511 4375681 4392287 4395859 4402867
+4405999 4406811 4416787 4425499 4429435 4433549 4436159 4446245 4449731 4458389
+4459939 4467073 4479865 4486909 4502641 4509973 4511965 4531115 4533001 4533657
+4554737 4560743 4565615 4567277 4574953 4585973 4586959 4600897 4602578 4609423
+4617605 4617931 4619527 4621643 4631155 4632959 4672841 4678223 4688719 4706513
+4709861 4710729 4721393 4721519 4724419 4729081 4739311 4742101 4755549 4757297
+4767521 4770965 4775147 4777721 4780723 4789169 4793269 4796351 4803821 4812035
+4821877 4822543 4823135 4829513 4834531 4846323 4864057 4871087 4875277 4880485
+4883223 4884763 4890467 4893779 4903301 4930783 4936409 4940377 4950545 4950967
+4951969 4955143 4999745 5009837 5034679 5035589 5047141 5050241 5069407 5084651
+5097301 5100154 5107739 5135119 5142179 5143333 5155765 5161217 5178013 5211503
+5219997 5222587 5231281 5240333 5258773 5271649 5276851 5280233 5286745 5292413
+5296877 5306917 5316979 5321303 5323153 5332255 5343161 5343899 5344555 5357183
+5382871 5389969 5397691 5411139 5436299 5448839 5459441 5487317 5511335 5517163
+5528809 5538101 5551441 5570917 5579977 5590127 5592059 5606135 5617451 5621447
+5622483 5634343 5635211 5644387 5651522 5656597 5657407 5659927 5677243 5690267
+5699369 5713145 5724677 5748431 5756645 5761691 5768419 5783557 5784321 5787191
+5801131 5818879 5824621 5825095 5827289 5837009 5841557 5852327 5858285 5888069
+5891843 5896579 5897657 5898629 5908715 5920039 5964803 5972593 5975653 5992765
+5996127 5998331 6009133 6024007 6024083 6027707 6047573 6068777 6107155 6129013
+6153655 6159049 6166241 6170417 6182423 6201209 6224743 6226319 6229171 6230319
+6243787 6244423 6247789 6268121 6271811 6298177 6305431 6315517 6316751 6322079
+6343561 6378985 6387767 6391861 6409653 6412009 6424717 6439537 6447947 6454835
+6464647 6468037 6483617 6485011 6503453 6528799 6534047 6547495 6578045 6580783
+6583811 6585001 6591499 6595963 6608797 6649159 6658769 6674393 6675251 6679351
+6704017 6709469 6725897 6736849 6752389 6791609 6832679 6876857 6883643 6903867
+6918791 6930763 6958627 6971107 6979061 6982823 6999643 7005547 7039139 7048421
+7050857 7058519 7065853 7068605 7119281 7132231 7139269 7152655 7166363 7172191
+7206529 7218071 7229981 7243379 7289185 7292311 7296893 7344685 7358377 7359707
+7367987 7379021 7395949 7401443 7424087 7431413 7434817 7451873 7453021 7464397
+7465157 7482377 7517179 7525837 7534519 7537123 7556095 7563113 7620301 7624109
+7650231 7653043 7685899 7715869 7777289 7780091 7795229 7800127 7829729 7848589
+7851215 7858097 7867273 7872601 7877647 7887919 7888933 7903283 7925915 7936093
+7947563 7966211 7979183 7998403 8026447 8054141 8059303 8077205 8080567 8084707
+8115389 8138705 8155133 8155351 8176753 8201599 8234809 8238581 8258753 8272201
+8297509 8316649 8329847 8332831 8339441 8389871 8401553 8420933 8448337 8452891
+8477283 8480399 8516807 8544523 8550017 8553401 8560357 8609599 8615117 8642273
+8675071 8699995 8707621 8717789 8723693 8740667 8773921 8782579 8804429 8806759
+8827423 8869751 8890211 8894171 8907509 8909119 8930579 8992813 8995921 9001687
+9018565 9035849 9036769 9099743 9116063 9166493 9194653 9209263 9230371 9303983
+9309829 9370805 9379019 9389971 9411631 9414613 9472111 9478093 9485801 9503329
+9523541 9536099 9549761 9613007 9622493 9640535 9649489 9659011 9732047 9744757
+9781739 9806147 9828767 9855703 9872267 9896047 9926323 9965009 9968453 9993545
+10013717 10044353 10050791 10060709 10083499 10158731 10170301 10188541
+10193761 10204859 10232447 10275973 10282559 10309819 10314971 10316297
+10354117 10383865 10405103 10432409 10482433 10496123 10506613 10511293
+10553113 10578533 10586477 10610897 10631543 10652251 10657993 10682755
+10692677 10737067 10754551 10773529 10784723 10891199 10896779 10938133
+10991701 10999439 11096281 11137363 11173607 11194313 11231207 11233237
+11308087 11342683 11366807 11386889 11393027 11394187 11430103 11473481
+11473589 11484911 11506445 11516531 11528497 11529979 11560237 11630839
+11647649 11648281 11692487 11730961 11731109 11758021 11780899 11870599
+11950639 12005773 12007943 12023777 12041003 12124937 12166747 12178753
+12179993 12264871 12311417 12333497 12404509 12447641 12488149 12511291
+12540151 12568919 12595651 12625991 12664619 12689261 12713977 12726523
+12750385 12774821 12815209 12823423 12836077 12853003 12871417 12888227
+12901781 12999173 12999337 13018667 13055191 13119127 13184083 13306099
+13404989 13435741 13438339 13482071 13496749 13538041 13590803 13598129
+13642381 13707797 13739417 13745537 13759819 13791559 13863863 13895843
+13902787 13955549 13957343 13990963 14033767 14088461 14128805 14200637
+14223761 14329471 14332061 14365121 14404489 14466563 14471699 14537411
+14575951 14638717 14686963 14742701 14854177 14955857 14967277 15060079
+15068197 15117233 15145247 15231541 15247367 15320479 15340681 15355819
+15362659 15405791 15464257 15523091 15538409 15550931 15581189 15699857
+15735841 15745927 15759439 15878603 15881473 15999503 16036207 16109023
+16158307 16221281 16267463 16360919 16398659 16414841 16460893 16585361
+16593649 16623409 16656623 16782571 16831853 16895731 16976747 16999133
+17023487 17102917 17145467 17218237 17272673 17349337 17389357 17437013
+17529601 17546899 17596127 17598389 17769851 17850539 17905151 17974933
+18129667 18171487 18240449 18285733 18327913 18378373 18457339 18545843
+18588623 18596903 18738539 18809653 18812071 18951881 18999031 19060859
+19096181 19139989 19424693 19498411 19572593 19591907 19645847 19780327
+19805323 19840843 19870597 19918169 20089631 20262569 20309309 20375401
+20413159 20452727 20607379 20615771 20755039 20764327 20843129 20922427
+20943073 21000733 21001829 21160633 21209177 21240983 21303313 21688549
+21709951 21875251 21925711 21946439 21985799 22135361 22186421 22261483
+22365353 22450231 22453117 22619987 22772507 22844503 22998827 23207189
+23272297 23383889 23437829 23448269 23502061 23716519 24033257 24240143
+24319027 24364093 24528373 24584953 24783229 24877283 24880481 24971929
+24996571 25054231 25065391 25314179 25352141 25690723 25788221 25983217
+26169397 26280467 26480567 26694131 26782109 26795437 26860699 26948111
+26998049 27180089 27462497 27566719 27671597 27698903 27775163 27909803
+27974183 28050847 28092913 28306813 28713161 28998521 29343331 29579983
+29692241 29834617 29903437 29916757 30118477 30259007 30663121 30693379
+30927079 30998419 31083371 31860737 31965743 32515583 32777819 32902213
+33059981 33136241 33151001 33388541 33530251 33785551 33978053 34170277
+34270547 34758037 35305141 35421499 35609059 35691199 36115589 36321367
+36459209 36634033 36734893 36998113 37155143 37438043 37864361 37975471
+38152661 39121913 39458687 39549707 40019977 40594469 40783879 40997909
+41485399 42277273 42599173 43105703 43351309 43724491 43825351 44346461
+45192947 45537047 45970307 46847789 47204489 47765779 48037937 48451463
+48677533 49140673 50078671 50459971 52307677 52929647 53689459 53939969
+54350669 55915103 57962561 58098991 58651771 59771317 60226417 61959979
+64379963 64992503 66233081 66737381 71339959 73952233 76840601 79052387
+81947069 85147693 87598591 94352849 104553157 }
+
+! This is a lookup table for the final hand values of all hands not covered in
+! the flushes and unique5 tables above.
+CONSTANT: values-table
+{ 166 322 165 310 164 2467 154 2466 163 3325 321 162 3324 2464 2401 161 2465
+3314 160 2461 159 2400 320 3323 153 2457 6185 2463 3303 2452 158 3322 157 298
+2460 2446 152 3292 156 2398 3321 2462 5965 155 6184 309 2456 3320 2439 3313
+2395 2459 2431 2335 2451 6181 3319 3281 2422 151 2391 2445 6183 2399 2455 319
+3291 2412 5964 6175 2386 3318 5745 150 2450 6180 3312 3317 297 6165 2458 2438
+5961 2430 2380 142 2444 3311 308 3316 318 286 149 6150 5963 6174 3259 5525 3315
+2421 2397 2454 5955 148 6182 2373 3302 6164 2437 5960 2411 5744 2449 2365 3310
+5945 6178 2429 6129 2334 2394 2453 6179 6101 147 141 3309 6149 5741 2448 2356
+2443 3215 2269 5930 2420 2396 5954 3290 3248 3280 2346 6065 6172 2390 2410 3308
+317 146 6173 2442 5944 3258 6128 3270 2393 6020 3301 6162 145 3289 5735 2436
+2385 5958 2447 6100 5909 2333 6169 6163 2428 2332 5881 5725 6177 316 5929 3307
+3300 6159 144 2435 6147 3204 285 3306 2379 6064 2441 2389 6148 2427 5524 2329
+2419 307 143 5845 3288 5952 3214 3257 2268 6019 5710 5962 3160 2440 6144 2384
+2409 5305 5908 3269 5800 3305 3287 6171 5942 5521 3299 6126 2418 5743 2392 6155
+5880 2372 2434 5949 6176 6127 6098 5959 3304 2331 6161 2364 2426 315 2325 2408
+3298 3094 6099 2378 5689 140 2433 6168 5939 3286 6123 5740 5927 306 5661 5844
+6140 2425 3213 2320 130 6095 3279 2328 6062 6158 2355 5515 2417 2388 6146 5085
+5304 2267 5799 3297 6063 3149 6170 6135 274 2432 5953 5924 5523 6017 3247 2371
+2345 5625 2407 5505 2416 2383 3285 2424 3278 6018 5906 2314 6059 5742 3159 5935
+6160 2363 6119 5734 2387 6143 5943 3237 3284 296 5878 5580 6167 2406 3256 6091
+3017 5520 2324 6125 6014 5957 6154 3083 3296 6114 5724 2382 314 5490 5903 2415
+6097 5739 2377 139 6157 3295 2354 5920 6086 6145 5084 2319 5738 2423 129 3093
+5928 2307 3283 5875 5842 3212 3277 6122 2405 2266 6055 3203 3246 313 2344 2299
+305 6139 5915 2203 6108 3282 5709 6094 2376 5522 3158 5797 138 6061 3255 3294
+5514 6010 6142 3276 5951 6050 3193 5303 5469 6080 284 2414 2370 2313 5839 4865
+2381 6134 262 5899 2263 5733 6124 5956 6016 6153 3236 5441 5907 2413 3254 2362
+3293 2290 5504 6005 5732 5941 5301 5871 2404 3006 6096 5519 5794 6058 2330 6166
+304 5879 6118 5894 5948 5723 2929 3092 3275 5688 2403 2369 6044 2280 5722 6090
+6121 2375 3016 5866 137 3202 6013 5737 6073 4645 5660 6156 2306 5405 2361 6138
+312 2353 6113 5729 5938 3253 5081 5489 6093 5999 2265 5835 2327 5926 6060 3211
+2830 2298 5843 2259 6085 5950 2374 5083 3226 136 273 128 5888 5360 5708 2402
+4864 2343 6133 5295 5719 5513 5790 6054 6015 5707 5830 3192 5302 3157 3274 5860
+3210 6037 5798 5624 2352 3148 2254 6141 5940 2137 2202 2368 6107 2262 311 5923
+6057 3268 3273 6029 5285 6117 2289 5947 6009 5503 5518 5785 5731 3252 6049 3245
+5468 6152 2360 6079 5992 303 5579 5905 135 2342 3138 5934 6089 3015 2323 2367
+6012 5704 3251 3156 295 2918 4644 5440 5687 5984 5824 5877 2279 6112 3209 5937
+6004 5721 5300 2248 4425 3091 2359 3267 5925 5686 5715 5853 3082 5659 3272 2720
+6084 3182 5728 6120 2318 5270 3201 6151 2928 5488 5902 5779 2351 6043 5658 6137
+5075 2819 2258 5919 6053 6092 5082 3225 2326 3250 6072 2366 3072 3271 134 5404
+5874 5975 3147 5841 5512 3244 5718 5080 2200 6106 3090 2341 5922 5683 5998 2264
+5706 2350 4861 2829 6132 2358 5065 5817 133 5623 6008 5700 2253 3208 250 5914
+6048 261 3249 2241 6078 2201 5359 5904 2312 5655 2599 4863 5796 6136 5933 5622
+5502 5294 5809 3243 3266 3207 5517 2340 5249 294 6056 3235 2233 5467 5772 6036
+5876 5578 5838 5509 3137 6116 6003 5695 5946 3155 2136 5298 5898 4424 2261 5703
+5221 4855 5577 302 6131 3081 5439 5764 6028 2349 5284 132 6088 3265 3014 5050
+2322 6011 2927 5299 2247 5870 5901 5991 3005 4641 6042 5685 5793 5619 5499 5714
+6111 2357 5936 3089 5918 2709 5679 5487 5893 3181 3206 5736 3242 6071 4205 4643
+2305 2224 5873 5983 2339 5657 131 6115 5840 3200 6083 301 5078 2317 5651 5997
+127 2995 5865 3154 5574 5185 2828 3071 2297 5403 5755 2719 6087 238 5511 3013
+5913 5674 2321 6052 3205 5269 5079 2199 2214 4635 3264 5682 5834 3127 5795 3146
+6110 5074 5292 3985 3199 2348 2257 118 5484 5699 6105 5029 5646 2071 3191 5921
+3224 6130 5140 2240 5887 6035 5358 5654 2588 5837 5974 4862 5621 6082 6007 5501
+2134 5293 2316 6047 2347 5897 126 5466 5789 6077 5001 5615 3241 2311 5829 5495
+4860 2232 5932 5859 2338 5064 6027 5282 2288 5508 2252 6051 5730 5694 4845 2135
+5297 5869 3088 272 5990 3004 5668 5438 3153 5792 2598 3240 3145 5576 6002 2337
+5283 2197 6104 5892 5570 4421 3198 5516 5784 5248 5610 4204 3061 3263 5982 5640
+3080 3152 2278 3012 5618 293 6006 5498 6046 5720 4625 5463 300 5678 2926 4423
+6076 5864 5486 5900 2310 6041 6109 5220 4965 4854 5931 2917 4642 3262 2223 5823
+5480 2718 5727 5917 5049 5565 5267 5077 3234 2246 5435 5650 6070 5833 2994 4640
+2304 4830 5402 5872 5573 6081 3011 5072 3239 3984 2315 5852 6001 125 3171 2336
+3765 2005 4415 5673 3180 5996 283 4920 5268 3087 5886 2907 2213 3079 2827 5778
+5973 3126 5604 2296 3151 5475 5073 5291 5717 2818 5912 2925 5788 117 5483 3197
+5645 5357 249 6040 5705 5828 4858 3238 3086 5184 5858 5633 5062 292 2193 3261
+6103 299 124 5916 5510 2133 3190 2198 6069 5465 4634 2597 2303 5399 5559 3196
+5614 6034 3150 5494 5836 4859 6045 2808 5063 5281 5816 5459 2131 6075 226 5896
+2309 5028 5995 2260 5783 5246 2070 3144 5139 2239 4610 2826 5667 5437 3260 4809
+2295 3545 6026 3136 2188 6102 2287 5911 5500 3233 5808 5431 2984 2196 5868 5354
+5569 5989 5702 3003 5000 5218 4852 5247 5609 5791 6000 2916 3060 2231 3085 5639
+5289 5771 5822 5597 4781 4405 5454 5507 6074 5047 5891 2308 4844 260 5296 123
+3078 5462 4201 4422 4638 6033 5684 5981 5219 3195 4853 2277 5713 5851 106 2924
+5763 5589 3232 5479 3764 5895 5426 6039 282 4420 5048 5863 5564 5266 4203 3084
+5434 5777 5552 4639 6025 5656 5279 3143 5401 2286 2717 4390 5071 5497 2817 5726
+6068 2182 3170 3010 4624 2708 2302 5395 5867 237 5988 3002 5485 5832 3194 4964
+5182 4589 2906 3070 5069 3981 2222 5544 5603 2923 5994 2256 4745 5474 5890 6038
+5076 271 2825 5448 3009 4195 4632 2294 5681 5885 5980 291 5356 4829 2276 5972
+4857 5910 4561 5183 3983 5632 5061 5815 2192 5716 5754 5350 6067 5698 2698 2004
+5026 4414 2068 2301 5390 5862 5787 4919 5137 3231 5827 122 5420 3116 2212 4633
+5653 5857 3544 5059 5398 5558 3125 4700 2716 5620 5993 2251 3189 5290 2807 5807
+5264 5458 2130 6032 1939 2824 116 5482 4998 5027 5831 2293 5245 2069 2596 5138
+121 2127 3077 5770 3975 3142 2587 2255 5535 2187 5345 5693 4842 2132 3223 5782
+2175 2922 5430 2983 6024 5884 5464 5275 3008 5353 4999 2285 5217 5971 4851 5575
+5493 3135 5762 4525 5288 3188 5280 5596 3141 5987 3001 5453 4418 6031 5786 5046
+5701 5826 4843 2896 2167 4849 6066 4609 2915 2300 4637 5384 5856 2122 5436 4808
+2577 5617 5821 5889 2250 5044 105 4185 4622 5588 2707 5677 5979 2195 5425 3007
+2245 2275 6023 4419 3050 2595 4962 3230 2284 5413 4202 2823 3059 4480 5712 120
+5850 2292 5551 4780 5278 4404 5861 3761 5986 3000 3179 5781 5243 2181 4369 4623
+5649 5461 5339 5394 4200 2993 4827 2715 5572 5776 3229 4963 3134 5181 2797 3076
+5260 5068 2816 5543 5753 5478 3763 4170 2002 3140 4412 5672 5978 4917 3187 2274
+5265 5215 214 3105 3965 5447 4341 2914 119 2158 4631 6030 5433 281 3069 5820
+4828 5400 4389 5070 3075 3222 3982 2116 5883 3169 5349 115 2244 2697 2003 5025
+5644 4413 5970 2067 4629 5389 5680 4918 2714 5136 2921 4588 5419 3115 5711 290
+5377 5849 6022 3980 5255 2586 5058 5814 2283 3139 3755 4744 5473 5697 5825 259
+5023 2065 5263 5855 2148 5055 4194 5985 2238 225 3950 4997 5613 5775 5355 2249
+5652 3541 4856 2822 4560 3228 2126 2291 5060 5369 2815 3221 2191 5806 5534 5882
+2594 5344 4995 5969 4841 2174 4149 4607 5179 5332 5666 5977 2230 5274 3068 4806
+4305 3543 5769 5397 2273 4699 5506 202 5780 5239 289 5692 3074 5457 4839 2129
+2194 1938 5854 5568 3039 4417 3186 5244 248 5608 2895 2166 280 4848 3227 2920
+4608 5324 5638 3974 5383 2121 4778 5813 4807 5761 4402 2713 2576 2186 5696 2109
+5211 2061 2593 2973 5043 2913 4621 5134 5429 2237 4198 2982 4260 5819 5352 3185
+3049 3535 5216 4961 4850 5412 5040 5616 3929 6021 5496 3073 5234 4524 5287 2243
+2282 2687 5805 4779 4403 5452 4619 2706 5676 5045 2101 5563 3220 5242 3133 5848
+4959 2919 2999 2229 5338 4199 4636 5768 5968 4826 2221 3745 4387 3178 2796 5259
+5691 2821 5206 4835 104 4184 3168 2281 3762 2912 2001 5774 5424 4411 5648 2992
+4916 5818 4824 5214 1873 3104 4586 5571 2814 2905 5976 2998 5035 2157 3978 4479
+2272 5315 5760 5602 5277 4742 2242 5752 3760 4388 1999 4409 5671 2115 5175 4914
+4192 2180 4368 3067 5847 5393 2592 2211 4628 3124 3730 3184 4121 4558 5180 4587
+5631 3177 2820 5376 5067 2190 3979 5254 2712 2271 4615 4169 2705 5675 4743 5481
+5773 5228 5022 5643 2064 2092 3964 5446 2147 5054 4340 4193 5812 4630 2813 2566
+2220 5557 4697 3132 2585 5019 94 3901 4559 2806 5368 5130 2236 2128 2711 5170
+1936 5348 288 5647 3525 236 5024 2991 3219 2066 5388 5200 4820 4994 5612 3183
+5135 2911 5492 4606 5178 5418 5331 3114 3972 5804 5967 4805 2997 3542 5057 2185
+5751 4698 3754 4991 1995 1807 2962 5238 5670 2082 2228 5262 4838 279 5767 1937
+3949 4604 2210 3038 4996 5665 5811 3218 3123 4803 3540 5690 5846 5014 2056 4085
+2125 5323 4522 5286 3973 5595 5966 4777 5125 4401 3709 2235 2270 114 3176 5343
+2108 5210 5642 2060 3510 5567 2972 4840 2173 5607 4148 5133 4197 5759 3058 2591
+2996 5273 4304 5637 5803 2584 4775 4399 5039 2812 4986 103 5233 4182 4523 5587
+2686 2227 4618 190 5460 5766 2885 4416 2100 5611 5491 5164 2894 2165 4958 4847
+4040 4477 3066 5550 2590 5382 3028 2120 5276 2704 3131 287 5477 3758 4386 4955
+3865 5042 5205 4834 5562 2179 4183 4366 4620 2219 4600 5664 4259 5432 5758 5193
+4799 3048 3534 4960 4823 3217 213 4585 5411 3928 4384 5066 5034 3977 4478 5810
+5542 5314 4167 3130 2710 4741 2990 270 5008 3759 2050 1998 5566 4408 5241 5119
+5174 5606 4913 3962 2234 4338 4191 3057 4367 4583 5337 2904 5636 3489 5750 2786
+4825 3744 4771 1990 4395 5601 2703 5669 2910 4557 4739 2795 5472 4910 3820 5258
+5802 4950 3681 2209 4614 2696 4168 2000 3175 4189 4410 247 4980 2218 5227 4915
+3216 5213 2091 1872 3103 2226 3113 3963 4339 5765 4555 2156 2565 5630 5056 2589
+4696 113 5476 3752 5018 5641 93 2811 2989 4815 2114 5129 5561 5261 3645 5169
+1935 3947 3174 2583 4627 5199 3538 4819 5396 5556 5749 5157 3729 82 4694 4120
+4380 2124 3065 3971 5375 5757 4905 2805 5253 5533 5456 258 3753 4990 2208 3129
+1994 1933 201 2961 3122 5021 2172 2063 2081 4146 4579 2146 5053 2903 5272 3948
+4603 4302 3969 178 4802 5600 3539 5149 4735 112 5471 3900 5013 3064 2055 2909
+4521 5367 4595 5124 2702 5663 5428 2874 2043 2981 3524 5351 2582 4944 5112 4993
+278 2164 4846 4147 4605 4551 5177 5330 2217 5629 2119 3461 4804 4303 4519 2189
+2575 5594 4774 3128 4398 5451 1806 5237 4985 5605 5041 5801 4181 3056 4837 5635
+4257 4973 1741 224 2035 3037 2884 2951 3047 3532 3173 5555 5104 4690 2225 5163
+3926 2908 4476 4084 5322 2804 3425 3027 4776 5748 5455 102 4179 4400 3708 5586
+1984 3757 1929 5662 5423 4794 2107 4899 5209 4954 5240 2059 3509 2810 2971 4365
+5132 2207 4196 4599 2775 4258 4474 3121 3742 5192 4798 5549 3533 2184 277 5038
+5560 5257 2676 3927 4383 5756 5232 3063 2685 4166 5427 235 111 3600 2980 4363
+4617 5007 5634 2049 5392 3172 4766 2099 5212 1870 4375 3102 5118 3961 4957 4337
+2155 4039 4582 4515 3167 2581 5593 2785 3743 4770 5541 1989 4394 5450 4164 4385
+4738 4909 2113 2809 3864 4574 5204 4949 4833 2701 2902 3959 5445 4335 4188 4626
+4979 5599 4937 2026 5470 3727 4118 4822 1871 4584 5095 2216 5033 4554 3976 3062
+5252 5313 4175 5585 3380 3751 4740 5422 5347 2695 1997 5020 4407 2062 4814 5387
+4546 5173 4912 2940 2700 2145 5628 5052 4190 3946 2988 5417 269 4470 4788 5548
+3488 4929 3537 3166 5156 3728 3898 81 4693 4119 3749 4556 4379 2215 3819 4904
+5747 3680 1977 2178 4359 4613 2901 3522 5391 5554 1932 3944 4892 2016 4992 5226
+5598 4145 4730 2090 2555 3055 5176 2206 4578 2803 2987 3120 2123 4301 2564 4760
+3968 5540 1675 1924 4695 4160 5148 5017 4734 1804 5532 5236 92 3899 5342 5128
+4836 5746 4594 3644 110 3955 5444 1969 5168 4143 1934 4331 2873 5627 3036 2042
+3523 4884 2183 4299 5198 4943 5111 4818 4082 2205 4550 3970 2580 3119 2979 4518
+3706 5346 2694 4989 1993 2106 5208 1805 2960 2058 3507 5386 5553 2970 4685 2080
+5131 2893 109 4510 5416 3112 4256 4972 189 5592 2802 4602 2034 2950 5381 3531
+5449 2118 4801 5103 4689 2574 1918 5037 2665 3925 5012 5231 2054 4083 4520 2579
+276 3165 5123 4178 3707 4616 1983 1928 3940 2098 4254 4793 4898 3508 268 3529
+4956 4568 4037 2900 5410 101 2863 3923 2774 5584 3460 4473 3741 2986 5421 4724
+2978 4773 5531 4397 5341 2675 4984 3862 5203 4832 4180 2171 4139 4465 2699 5547
+4362 1740 1960 5271 5336 2883 4295 5591 4765 4821 3739 1869 4374 4875 3054 4540
+5162 5626 5032 4038 2794 4475 4753 2204 2177 4514 3424 4354 3026 3118 3756 4163
+1996 4406 4953 5172 3863 4911 4573 2892 2163 1867 4364 3101 3958 4598 5539 4334
+3486 108 5380 2985 100 4155 5191 4936 4797 5583 4679 2025 3726 2573 4117 3053
+5094 3817 2801 4382 2764 5443 3678 2112 4326 4174 4612 4165 70 2578 3599 1950
+5006 4250 5546 5225 2048 3046 2544 2089 5117 4545 3960 3724 5409 2939 4115 4336
+3919 4581 275 4469 4787 5374 3487 3117 2784 4928 2176 2693 4769 4348 1988 5016
+4393 91 3897 5385 3748 4737 4908 5127 3818 3164 5415 4948 3642 246 5167 3679
+223 1976 4358 3521 107 5051 5335 4187 4978 3943 4891 5538 5197 2015 4817 3735
+2852 4729 212 2554 2793 3895 4504 5256 4553 5590 4759 5366 4717 177 1923 3935
+5442 3379 3750 4320 4159 4988 1992 1803 2959 3519 2079 4813 3163 1863 257 3643
+3954 1968 4142 3945 4601 4330 2154 5329 4883 5530 4800 4298 3536 5340 4533 5155
+2692 80 4692 2899 5011 4378 2053 4081 3052 1801 2170 99 4134 4903 5582 5122
+3705 4709 5414 3111 4290 1931 3506 3035 4684 3720 4144 4111 4577 4459 4509 3458
+5373 5545 4079 4300 5321 3967 4672 5251 1674 4772 4396 3703 1917 2753 5147 2664
+4733 2800 4983 2891 2105 2162 2057 3504 267 1911 4593 5379 1738 2144 2117 2872
+3939 2882 2041 2572 4253 4942 5110 5529 5161 3528 4567 4036 3891 3051 5036 4549
+2862 3922 3422 3025 5365 5537 3459 2169 4517 4664 4128 4245 4723 2684 3045 3515
+4284 4952 200 3861 5408 2097 3914 2977 1903 4138 4464 4597 3162 5328 4034 4255
+4971 1739 1959 5190 2033 4796 4294 2949 3530 3738 5102 4874 4688 4539 3924 4381
+1797 4497 5235 2898 4752 3423 3859 4353 2890 2161 4831 5334 3597 4177 2691 1982
+5005 1927 2047 2654 5378 256 4792 4897 2571 5116 2792 2976 3110 1866 4580 4075
+5320 3485 2773 5031 2783 4472 3740 4154 4768 1987 4678 5312 4392 3699 4736 4239
+4907 3816 4489 2674 98 5207 1858 234 245 3500 5581 4947 2969 2763 3677 4325
+5407 2153 3161 69 3908 4186 3598 4977 1949 4361 4249 3483 4764 2543 1868 4373
+3723 4452 2111 4114 4552 3918 2897 5230 3814 4513 3377 2683 5528 3675 4347 4655
+4611 5333 4162 4812 3715 97 4106 2168 2799 2841 4572 3641 5372 2088 2791 4030
+3957 5250 1894 4333 2563 4935 3734 5154 2024 3725 2851 79 4691 4116 4377 5015
+4444 5093 90 3894 5536 4902 4503 3855 5202 1852 2143 3100 4173 4716 3934 3378
+3639 4319 2152 1930 3518 3886 2889 2160 4816 4313 1862 4544 4576 2938 5364 2975
+2110 3966 4468 4786 1672 5311 2570 4927 5146 2533 4732 4532 3896 3747 4987 1991
+1800 2958 2798 4133 4592 2643 5171 5327 4100 2078 2690 4708 1975 2871 4357 2040
+1884 4289 5371 3520 3942 3044 4890 3479 4941 5109 2014 1792 5406 3109 3719 4728
+2742 4110 2553 4548 4458 3457 5010 3810 2052 4078 4516 4758 4671 3671 1673 1922
+2142 3034 4158 3702 2752 1802 5224 3503 96 4070 1910 5319 3880 2689 3953 2974
+1967 4970 1737 4141 4329 2032 5363 2948 3694 2562 3455 4882 4297 5101 4687 2790
+2104 3108 89 3495 3890 2968 4080 3421 4982 4435 5126 5527 4176 4663 3704 4127
+3635 1981 5166 4244 5326 1926 1735 3514 4791 4896 4283 3505 266 5196 1845 3099
+4683 3913 1902 1786 2151 5229 4277 4508 2772 4033 4471 2682 3419 3024 1916 2663
+2096 233 2673 1796 4496 255 4951 95 4025 3858 5526 3596 4360 4064 5318 3938
+2653 4596 4763 4252 211 4372 3688 2159 4795 4093 3527 4566 4035 3850 5370 2103
+5201 2051 4269 4074 2522 2861 4512 3921 2967 2569 5121 3698 4722 4161 3594 4238
+5004 4488 2046 1857 3860 3499 4571 2141 5030 4137 3956 4232 4463 3907 4332 5310
+188 3043 3451 1958 4934 4293 2023 2681 3482 2888 265 3737 4767 4873 3873 1986
+5092 4391 4538 4451 5362 3107 2095 4906 4751 3813 4172 2568 4352 3376 4946 3674
+4019 3474 4654 1731 2881 4976 3714 4105 4543 2840 2937 5160 3805 5325 1865 4224
+4029 4467 4785 3666 1893 3844 3484 3042 3415 3023 4926 4153 4677 2789 3374 3746
+1779 5223 4443 3815 2087 3854 2762 4811 3676 1851 1974 4324 4356 68 2561 3638
+3033 2688 3941 1948 4889 4248 2013 5309 5189 58 3098 2542 3885 4727 2552 4312
+2150 3722 4057 5317 78 3106 4113 3917 4376 4757 3630 5165 1671 1921 4901 2632
+4157 4346 2532 3590 199 2102 5195 2045 3468 222 2642 5115 3640 4099 3952 1966
+4140 4328 1883 4575 3799 4881 4296 3478 3660 2782 1837 3733 3097 1985 1669 2850
+1791 2957 2887 2741 2149 4731 2077 3893 5222 4502 3809 2680 2086 3670 4715 3933
+4591 2567 4318 2870 2560 2094 2039 3517 4682 4940 2140 5009 1861 4012 88 4069
+3879 4507 4547 5120 4215 3693 3454 3624 3041 2731 3370 1915 2662 4531 3494 5361
+3837 1799 5194 4810 4434 4132 3634 4707 3446 3937 4288 4251 4969 1734 2031 2947
+3526 1844 4565 5153 2886 3718 2139 4981 77 4686 4109 1785 2956 2860 3920 4457
+4276 3456 5308 4077 2076 4670 3418 4721 1726 176 1771 2880 3701 2751 1980 1925
+2788 5159 4790 4895 3502 4024 4136 4462 1909 3032 3410 1736 244 4063 1957 2511
+4292 2771 3040 1665 3736 4872 3687 4092 4537 5145 1828 5316 3096 3889 3792 3849
+4750 4268 2521 264 3420 4351 3653 4590 4662 4126 4243 46 254 5188 2038 3593
+3440 2966 3513 4282 2085 5108 4762 1864 3912 4371 1901 4231 3031 2559 4032 3450
+4152 4676 3585 4511 5003 87 3872 1720 4049 2787 2879 1795 4495 5114 2761 2679
+4323 3617 3857 5158 4570 67 3595 4018 1947 3473 4247 2093 1730 2781 2652 2030
+3404 232 2965 2946 2541 4933 5100 2022 1818 3095 3721 4112 3804 3916 4223 2138
+4945 4073 3665 3843 3414 4345 4171 3697 4975 1979 3373 1778 221 4237 3829 5187
+4789 4487 2075 1856 3498 2678 4542 3906 2936 253 3365 4466 3732 4784 57 2849
+3481 4925 3579 4004 5002 3892 4450 2044 4056 4501 2672 5307 3629 3812 5113 4714
+2631 3932 3375 4317 3673 1973 3589 4653 4355 3516 3467 1762 5152 2780 4888 3713
+4761 76 2012 4104 1860 4370 2839 4726 263 4900 4028 3433 3798 1892 3030 3659
+4756 1836 4530 1668 1920 4156 3784 4974 1798 4442 4131 2621 5306 3853 4569 1850
+4706 4287 1713 3637 3951 1965 2878 1660 4327 2084 5144 4880 2021 3359 3717 2964
+3884 4108 4311 4011 4456 5091 2558 4076 3397 3022 4669 4214 1670 2869 3623 86
+3700 2730 3369 2750 2531 1752 4939 5107 3836 3501 3609 5151 1908 2641 4541 4681
+4098 187 2935 3445 1882 4506 3029 5186 4783 3477 2083 1790 3888 2740 1914 2661
+3995 2557 3808 4661 4125 3669 4242 3572 4968 1725 1972 85 1770 2955 243 3512
+4281 3936 2074 5099 2011 1654 2963 3911 2610 5143 1900 4725 2551 4068 3878 4564
+4031 3409 2510 2859 2779 3692 4755 3453 1978 1664 1919 2868 4720 2037 1827 4894
+1794 4494 3493 3791 4938 5106 3856 4433 3652 2677 3633 2770 1964 4135 4461 2651
+45 2954 3439 1733 1956 2073 4291 1843 2671 4871 2500 1784 4536 4072 4275 4749
+3352 3584 3696 3417 4350 4236 4967 1719 2029 4048 4486 1855 2945 3497 3775 5098
+4680 3616 4023 1705 3905 210 4505 4062 3403 3480 5150 4151 3686 75 4675 4091
+1817 4449 1913 252 3848 3389 3021 4893 4267 3811 2520 2556 2760 3672 4322 4652
+66 4932 2769 3592 84 1946 3828 3712 4246 4103 2838 5090 2540 4563 4027 1696
+4230 2670 1891 2877 2858 3915 3449 1647 3364 5142 4719 3578 3871 4344 4003 4441
+2489 3020 3852 1849 2934 3564 3636 2867 4460 4017 2036 3472 1729 4924 1955 1761
+2953 5105 3883 3731 4310 2072 2848 4535 3803 4222 3432 2778 3664 175 4748 3842
+4500 1971 3413 4349 2530 4713 3931 4887 3372 83 1777 4316 3783 4931 2020 2620
+2550 2640 4097 3555 5089 1859 1881 4966 1712 2028 1659 220 3476 4150 56 5097
+4674 1789 3358 2739 4529 4055 3807 3396 198 3628 3344 2759 3668 1963 4130 2630
+4321 231 65 4705 3588 4879 1945 4286 4782 1751 2952 3466 4923 3608 251 4067
+3877 3716 4107 2768 3797 4455 3691 34 3452 2876 3658 74 4668 1835 4343 1667
+3492 2669 2749 4886 2010 3994 4432 3335 3019 3632 2549 3571 1907 1732 4754 1842
+1653 1912 2660 2847 2609 1783 4010 4274 3887 4499 1639 4213 3416 5141 4712 3622
+3930 73 4660 2729 4124 3368 4315 4241 4878 3511 3835 4280 4562 4022 209 242
+3910 4061 3444 1899 1686 4930 2875 2019 3685 4090 4528 5088 3847 2499 4266 2519
+1793 4493 1630 4129 3018 3351 2777 1724 4704 1954 1769 3591 4285 2650 4870 3774
+4534 219 2659 4229 2866 1704 2027 4454 3408 2944 3448 2509 4071 4922 5096 4667
+1663 3870 3695 2748 1826 3790 4235 3388 4485 1854 3651 3496 1970 4016 1906 3471
+2478 1728 44 2857 3904 4885 3438 2009 4718 2548 3802 4221 2767 1695 241 4448
+3663 3841 2943 3412 1646 64 2776 3583 4659 4123 1944 3371 4240 1776 2668 1718
+72 4651 4047 2539 4279 2488 3711 4869 4102 3615 3563 3909 1962 2837 1898 4026
+4747 4877 3402 55 1890 4342 1816 4054 197 4492 4440 3627 2629 3851 1848 1620
+3587 2667 3465 2649 3827 2846 4673 3882 3554 4498 4309 3796 2865 2018 2758 3657
+3363 1834 4314 1666 63 2658 5087 3577 71 2529 4002 4234 4484 1853 2538 3343
+2639 4096 3903 1880 1760 4527 3475 2933 4009 1788 4447 2856 2738 3431 4212 4921
+33 3806 2017 3621 22 2942 2728 3367 3667 5086 4650 3782 3834 3710 2619 4101 230
+2836 3334 4453 3443 4066 3876 1711 2864 1953 2008 1889 1658 3690 4711 4868 2747
+2547 3357 2932 4439 3491 4746 3395 1638 1905 2766 4431 1847 1723 1768 3631 1750
+186 3607 3881 1961 1841 4308 3407 2508 1782 4876 1685 4273 2007 4122 2941 1662
+4703 2546 2528 1825 4278 3789 3993 2757 3650 1629 1897 2638 4095 4021 3570 43
+1943 3437 1879 4060 4666 2537 1652 2608 3684 1787 4491 229 4089 2737 3846 2765
+4265 2518 3582 1904 2657 240 1717 4046 2666 3614 4065 3875 2477 4228 3401 3689
+3447 4658 2845 1815 4233 4483 208 3869 3490 2931 2498 4430 4710 3902 3350 1896
+2656 4015 3826 3470 1727 3773 1840 4446 1703 1781 1952 3801 4272 4220 3362 3662
+3840 4867 3411 2006 4526 3576 4001 2648 2545 2855 1775 3387 2835 4020 4702 1619
+1888 4059 1759 3683 54 4088 4438 2930 3430 1694 3845 1951 4053 1846 4264 2517
+4665 1645 3626 4866 2628 2746 3781 3586 2756 2618 2487 3464 4307 62 3562 1710
+1942 4227 1657 3795 2536 239 3356 3656 1833 4649 3868 174 3394 2637 4094 4657
+2834 21 1878 4014 3469 1749 1887 185 196 3606 2736 61 3553 3800 1941 4008 4219
+3661 3839 207 2535 4211 3620 2727 3366 1774 4490 3992 2854 3833 3874 3342 4306
+3569 2647 3442 1651 53 2607 2527 4052 4429 32 3625 228 2844 2627 1722 1877 2655
+1767 4482 1839 3463 4701 1780 3333 4271 2735 3794 3406 2507 3655 1832 1661 4445
+2497 1824 2853 3788 1637 3349 3649 4058 2745 4648 42 3682 3436 4087 3772 218
+2755 1702 4007 4263 2516 60 1684 1940 4210 3619 3581 2726 2534 4437 3386 1716
+4045 3832 4656 1838 1628 4226 3613 195 3441 4270 3400 3867 1895 1693 1814 1644
+4013 2526 1721 1766 2843 2486 3825 2636 2754 4086 3561 4218 59 2646 3838 2476
+3405 4262 227 2506 3361 173 1773 217 3575 1823 4000 3787 3648 4225 41 4481 52
+3435 1758 4051 3866 3552 2645 2626 3429 3580 2842 3462 1715 4044 3780 4428 3341
+2617 3612 4647 3793 1618 4217 1709 3654 2744 1831 3399 1656 206 3355 1813 1772
+1886 31 3393 4436 3824 1748 51 4006 3332 3605 4646 4050 4209 3618 2725 3360
+2625 2833 3574 3999 3831 1885 2515 1636 3991 2525 20 3568 2743 1757 2635 1830
+1650 1876 2606 1683 3428 184 1765 2734 3779 1627 2616 2524 4005 2505 1708 1655
+4208 2634 1822 2724 3354 3786 1875 3647 3830 2496 3392 40 3348 3434 194 1747
+4427 3604 3771 2475 1701 2644 50 1714 4043 1764 2832 3990 3611 3385 216 3567
+3398 2504 4426 1812 1649 2605 1821 3785 1692 3646 1829 1643 3823 39 4261 2514
+2485 1617 3560 2523 3573 3998 2831 183 4042 2495 1874 3610 2723 3347 1756 2733
+2513 3770 1811 3427 1700 3551 3778 4216 2615 3822 3384 19 1707 3340 1763 172
+3353 2633 3997 3391 1691 215 1642 30 1820 1746 2732 3603 1755 2484 2624 3559
+3331 38 3426 3989 3777 2614 49 3566 1635 1706 4041 1648 2604 2623 2512 3550
+3390 1682 1810 1745 4207 3602 205 3339 1626 3821 2494 3988 3346 29 3565 3996
+3769 4206 171 1699 2603 193 3330 2474 1754 3383 2503 1634 48 3776 2613 1690 37
+182 2493 1641 1681 3345 2483 2502 3558 3768 1625 1698 1819 1616 1744 3601 3382
+47 3987 3549 2622 1689 2722 2473 1640 2602 3338 2482 3557 1809 18 28 1753 2492
+3329 2501 3548 2721 1615 204 3767 1697 1633 36 3337 3381 1680 1743 27 2612 1688
+1624 170 3328 17 1808 2481 3556 35 1632 2601 2472 1679 3986 3547 1623 192 203
+3336 3766 181 26 1614 2471 2491 3327 1742 1687 1631 2480 2611 1678 16 1613 180
+1622 191 3546 2490 2470 15 2600 25 3326 169 24 1612 2479 1677 1621 1676 14 168
+2469 2468 1611 23 1610 13 179 12 167 11 }
--- /dev/null
+Aaron Schaefer
\ No newline at end of file
--- /dev/null
+USING: accessors poker poker.private tools.test ;
+IN: poker.tests
+
+[ 134236965 ] [ "KD" >ckf ] unit-test
+[ 529159 ] [ "5s" >ckf ] unit-test
+[ 33589533 ] [ "jc" >ckf ] unit-test
+
+
+[ 7462 ] [ "7C 5D 4H 3S 2C" <hand> value>> ] unit-test
+[ 1601 ] [ "KD QS JC TH 9S" <hand> value>> ] unit-test
+[ 9 ] [ "6C 5C 4C 3C 2C" <hand> value>> ] unit-test
+[ 1 ] [ "AC KC QC JC TC" <hand> value>> ] unit-test
+
+[ "High Card" ] [ "7C 5D 4H 3S 2C" <hand> >value ] unit-test
+[ "Straight" ] [ "KD QS JC TH 9S" <hand> >value ] unit-test
+[ "Straight Flush" ] [ "6C 5C 4C 3C 2C" <hand> >value ] unit-test
--- /dev/null
+! Copyright (c) 2009 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors ascii binary-search combinators kernel locals math
+ math.bitwise math.order poker.arrays sequences splitting ;
+IN: poker
+
+! The algorithm used is based on Cactus Kev's Poker Hand Evaluator:
+! http://www.suffecool.net/poker/evaluator.html
+
+<PRIVATE
+
+! Bitfield Format for Card Values:
+
+! +-------------------------------------+
+! | xxxbbbbb bbbbbbbb ssssrrrr xxpppppp |
+! +-------------------------------------+
+! xxxAKQJT 98765432 CDHSrrrr xxpppppp
+! +-------------------------------------+
+! | 00001000 00000000 01001011 00100101 | King of Diamonds
+! | 00000000 00001000 00010011 00000111 | Five of Spades
+! | 00000010 00000000 10001001 00011101 | Jack of Clubs
+
+! p = prime number value of rank (deuce = 2, trey = 3, four = 5, ..., ace = 41)
+! r = rank of card (deuce = 0, trey = 1, four = 2, ..., ace = 12)
+! s = bit turned on depending on suit of card
+! b = bit turned on depending on rank of card
+! x = bit turned off, not used
+
+CONSTANT: CLUB 8
+CONSTANT: DIAMOND 4
+CONSTANT: HEART 2
+CONSTANT: SPADE 1
+
+CONSTANT: DEUCE 0
+CONSTANT: TREY 1
+CONSTANT: FOUR 2
+CONSTANT: FIVE 3
+CONSTANT: SIX 4
+CONSTANT: SEVEN 5
+CONSTANT: EIGHT 6
+CONSTANT: NINE 7
+CONSTANT: TEN 8
+CONSTANT: JACK 9
+CONSTANT: QUEEN 10
+CONSTANT: KING 11
+CONSTANT: ACE 12
+
+CONSTANT: STRAIGHT_FLUSH 1
+CONSTANT: FOUR_OF_A_KIND 2
+CONSTANT: FULL_HOUSE 3
+CONSTANT: FLUSH 4
+CONSTANT: STRAIGHT 5
+CONSTANT: THREE_OF_A_KIND 6
+CONSTANT: TWO_PAIR 7
+CONSTANT: ONE_PAIR 8
+CONSTANT: HIGH_CARD 9
+
+CONSTANT: RANK_STR { "2" "3" "4" "5" "6" "7" "8" "9" "T" "J" "Q" "K" "A" }
+
+CONSTANT: VALUE_STR { "" "Straight Flush" "Four of a Kind" "Full House" "Flush"
+ "Straight" "Three of a Kind" "Two Pair" "One Pair" "High Card" }
+
+: card-rank-prime ( rank -- n )
+ RANK_STR index { 2 3 5 7 11 13 17 19 23 29 31 37 41 } nth ;
+
+: card-rank ( rank -- n )
+ {
+ { "2" [ DEUCE ] }
+ { "3" [ TREY ] }
+ { "4" [ FOUR ] }
+ { "5" [ FIVE ] }
+ { "6" [ SIX ] }
+ { "7" [ SEVEN ] }
+ { "8" [ EIGHT ] }
+ { "9" [ NINE ] }
+ { "T" [ TEN ] }
+ { "J" [ JACK ] }
+ { "Q" [ QUEEN ] }
+ { "K" [ KING ] }
+ { "A" [ ACE ] }
+ } case ;
+
+: card-suit ( suit -- n )
+ {
+ { "C" [ CLUB ] }
+ { "D" [ DIAMOND ] }
+ { "H" [ HEART ] }
+ { "S" [ SPADE ] }
+ } case ;
+
+: card-rank-bit ( rank -- n )
+ RANK_STR index 1 swap shift ;
+
+: card-bitfield ( rank rank suit rank -- n )
+ {
+ { card-rank-bit 16 }
+ { card-suit 12 }
+ { card-rank 8 }
+ { card-rank-prime 0 }
+ } bitfield ;
+
+:: (>ckf) ( rank suit -- n )
+ rank rank suit rank card-bitfield ;
+
+: >ckf ( str -- n )
+ #! Cactus Kev Format
+ >upper 1 cut (>ckf) ;
+
+: flush? ( cards -- ? )
+ HEX: F000 [ bitand ] reduce 0 = not ;
+
+: rank-bits ( cards -- q )
+ 0 [ bitor ] reduce -16 shift ;
+
+: lookup ( cards table -- value )
+ [ rank-bits ] dip nth ;
+
+: unique5? ( cards -- ? )
+ unique5-table lookup 0 > ;
+
+: map-product ( seq quot -- n )
+ [ 1 ] 2dip [ dip * ] curry [ swap ] prepose each ; inline
+
+: prime-bits ( cards -- q )
+ [ HEX: FF bitand ] map-product ;
+
+: hand-value ( cards -- value )
+ {
+ { [ dup flush? ] [ flushes-table lookup ] }
+ { [ dup unique5? ] [ unique5-table lookup ] }
+ [
+ prime-bits products-table sorted-index
+ values-table nth
+ ]
+ } cond ;
+
+: >card-rank ( card -- str )
+ -8 shift HEX: F bitand RANK_STR nth ;
+
+: >card-suit ( card -- str )
+ {
+ { [ dup 15 bit? ] [ drop "C" ] }
+ { [ dup 14 bit? ] [ drop "D" ] }
+ { [ dup 13 bit? ] [ drop "H" ] }
+ [ drop "S" ]
+ } cond ;
+
+PRIVATE>
+
+TUPLE: hand
+ { cards sequence }
+ { value integer } ;
+
+M: hand <=> [ value>> ] compare ;
+M: hand equal?
+ over hand? [ [ value>> ] bi@ = ] [ 2drop f ] if ;
+
+: <hand> ( str -- hand )
+ " " split [ >ckf ] map
+ dup hand-value hand boa ;
+
+: hand-rank ( hand -- rank )
+ value>> {
+ { [ dup 6185 > ] [ drop HIGH_CARD ] } ! 1277 high card
+ { [ dup 3325 > ] [ drop ONE_PAIR ] } ! 2860 one pair
+ { [ dup 2467 > ] [ drop TWO_PAIR ] } ! 858 two pair
+ { [ dup 1609 > ] [ drop THREE_OF_A_KIND ] } ! 858 three-kind
+ { [ dup 1599 > ] [ drop STRAIGHT ] } ! 10 straights
+ { [ dup 322 > ] [ drop FLUSH ] } ! 1277 flushes
+ { [ dup 166 > ] [ drop FULL_HOUSE ] } ! 156 full house
+ { [ dup 10 > ] [ drop FOUR_OF_A_KIND ] } ! 156 four-kind
+ [ drop STRAIGHT_FLUSH ] ! 10 straight-flushes
+ } cond ;
+
+: >value ( hand -- str )
+ hand-rank VALUE_STR nth ;
+
+: >cards ( hand -- str )
+ cards>> [
+ [ >card-rank ] [ >card-suit ] bi append
+ ] map " " join ;
--- /dev/null
+5-card poker hand evaluator
[ 233168 ] [ euler001 ] unit-test
[ 233168 ] [ euler001a ] unit-test
[ 233168 ] [ euler001b ] unit-test
+[ 233168 ] [ euler001c ] unit-test
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007, 2008 Aaron Schaefer, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.ranges sequences project-euler.common ;
+USING: kernel math math.functions math.ranges sequences project-euler.common ;
IN: project-euler.001
! http://projecteuler.net/index.php?section=problems&id=1
! [ euler001b ] 100 ave-time
! 0 ms run / 0 ms GC ave time - 100 trials
+
+: euler001c ( -- answer )
+ 1000 [ { 3 5 } [ divisor? ] with any? ] filter sum ;
+
+! [ euler001c ] 100 ave-time
+! 0 ms ave run time - 0.06 SD (100 trials)
+
SOLUTION: euler001
! Copyright (c) 2007 Aaron Schaefer, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: hashtables kernel math math.ranges project-euler.common sequences
- sorting sets ;
+USING: hashtables kernel math math.functions math.ranges project-euler.common
+ sequences sorting sets ;
IN: project-euler.004
! http://projecteuler.net/index.php?section=problems&id=4
<PRIVATE
: source-004 ( -- seq )
- 100 999 [a,b] [ 10 mod 0 = not ] filter ;
+ 100 999 [a,b] [ 10 divisor? not ] filter ;
: max-palindrome ( seq -- palindrome )
natural-sort [ palindrome? ] find-last nip ;
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit kernel make math math.ranges
-sequences project-euler.common ;
+USING: combinators.short-circuit kernel make math math.functions math.ranges
+ sequences project-euler.common ;
IN: project-euler.014
! http://projecteuler.net/index.php?section=problems&id=14
<PRIVATE
: worth-calculating? ( n -- ? )
- 1- 3 { [ mod 0 = ] [ / even? ] } 2&& ;
+ 1- 3 { [ divisor? ] [ / even? ] } 2&& ;
PRIVATE>
10 99 [a,b] dup cartesian-product [ first2 < ] filter ;
: safe? ( ax xb -- ? )
- [ 10 /mod ] bi@ -roll = rot zero? not and nip ;
+ [ 10 /mod ] bi@ [ = ] dip zero? not and nip ;
: ax/xb ( ax xb -- z/f )
2dup safe? [ [ 10 /mod ] bi@ 2nip / ] [ 2drop f ] if ;
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit kernel math math.combinatorics math.parser
- math.ranges project-euler.common sequences sets sorting ;
+USING: combinators.short-circuit kernel math math.functions math.combinatorics
+ math.parser math.ranges project-euler.common sequences sets sorting ;
IN: project-euler.043
! http://projecteuler.net/index.php?section=problems&id=43
<PRIVATE
: subseq-divisible? ( n index seq -- ? )
- [ 1- dup 3 + ] dip subseq 10 digits>integer swap mod zero? ;
+ [ 1- dup 3 + ] dip subseq 10 digits>integer swap divisor? ;
: interesting? ( seq -- ? )
{
--- /dev/null
+USING: project-euler.049 tools.test ;
+IN: project-euler.049.tests
+
+[ 296962999629 ] [ euler049 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays byte-arrays fry hints kernel math math.combinatorics
+ math.functions math.parser math.primes project-euler.common sequences sets ;
+IN: project-euler.049
+
+! http://projecteuler.net/index.php?section=problems&id=49
+
+! DESCRIPTION
+! -----------
+
+! The arithmetic sequence, 1487, 4817, 8147, in which each of the terms
+! increases by 3330, is unusual in two ways: (i) each of the three terms are
+! prime, and, (ii) each of the 4-digit numbers are permutations of one another.
+
+! There are no arithmetic sequences made up of three 1-, 2-, or 3-digit primes,
+! exhibiting this property, but there is one other 4-digit increasing sequence.
+
+! What 12-digit number do you form by concatenating the three terms in this
+! sequence?
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: count-digits ( n -- byte-array )
+ 10 <byte-array> [
+ '[ 10 /mod _ [ 1+ ] change-nth dup 0 > ] loop drop
+ ] keep ;
+
+HINTS: count-digits fixnum ;
+
+: permutations? ( n m -- ? )
+ [ count-digits ] bi@ = ;
+
+: collect-permutations ( seq -- seq )
+ [ V{ } clone ] [ dup ] bi* [
+ dupd '[ _ permutations? ] filter
+ [ diff ] keep pick push
+ ] each drop ;
+
+: potential-sequences ( -- seq )
+ 1000 9999 primes-between
+ collect-permutations [ length 3 >= ] filter ;
+
+: arithmetic-terms ( m n -- seq )
+ 2dup [ swap - ] keep + 3array ;
+
+: (find-unusual-terms) ( n seq -- seq/f )
+ [ [ arithmetic-terms ] with map ] keep
+ '[ _ [ peek ] dip member? ] find nip ;
+
+: find-unusual-terms ( seq -- seq/? )
+ unclip-slice over (find-unusual-terms) [
+ nip
+ ] [
+ dup length 3 >= [ find-unusual-terms ] [ drop f ] if
+ ] if* ;
+
+: 4digit-concat ( seq -- str )
+ 0 [ [ 10000 * ] dip + ] reduce ;
+
+PRIVATE>
+
+: euler049 ( -- answer )
+ potential-sequences [ find-unusual-terms ] map sift
+ [ { 1487 4817 8147 } = not ] find nip 4digit-concat ;
+
+! [ euler049 ] 100 ave-time
+! 206 ms ave run time - 10.25 SD (100 trials)
+
+SOLUTION: euler049
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit kernel math
- project-euler.common sequences sorting
- grouping ;
+USING: combinators.short-circuit kernel math math.functions
+ project-euler.common sequences sorting grouping ;
IN: project-euler.052
! http://projecteuler.net/index.php?section=problems&id=52
[ number>digits natural-sort ] map all-equal? ;
: candidate? ( n -- ? )
- { [ odd? ] [ 3 mod 0 = ] } 1&& ;
+ { [ odd? ] [ 3 divisor? ] } 1&& ;
: next-all-same ( x n -- n )
dup candidate? [
--- /dev/null
+USING: project-euler.054 tools.test ;
+IN: project-euler.054.tests
+
+[ 376 ] [ euler054 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays io.encodings.ascii io.files kernel math.order poker
+ project-euler.common sequences ;
+IN: project-euler.054
+
+! http://projecteuler.net/index.php?section=problems&id=54
+
+! DESCRIPTION
+! -----------
+
+! In the card game poker, a hand consists of five cards and are ranked, from
+! lowest to highest, in the following way:
+
+! * High Card: Highest value card.
+! * One Pair: Two cards of the same value.
+! * Two Pairs: Two different pairs.
+! * Three of a Kind: Three cards of the same value.
+! * Straight: All cards are consecutive values.
+! * Flush: All cards of the same suit.
+! * Full House: Three of a kind and a pair.
+! * Four of a Kind: Four cards of the same value.
+! * Straight Flush: All cards are consecutive values of same suit.
+! * Royal Flush: Ten, Jack, Queen, King, Ace, in same suit.
+
+! The cards are valued in the order:
+! 2, 3, 4, 5, 6, 7, 8, 9, 10, Jack, Queen, King, Ace.
+
+! If two players have the same ranked hands then the rank made up of the
+! highest value wins; for example, a pair of eights beats a pair of fives (see
+! example 1 below). But if two ranks tie, for example, both players have a pair
+! of queens, then highest cards in each hand are compared (see example 4
+! below); if the highest cards tie then the next highest cards are compared,
+! and so on.
+
+! Consider the following five hands dealt to two players:
+
+! Hand Player 1 Player 2 Winner
+! ---------------------------------------------------------
+! 1 5H 5C 6S 7S KD 2C 3S 8S 8D TD
+! Pair of Fives Pair of Eights Player 2
+
+! 2 5D 8C 9S JS AC 2C 5C 7D 8S QH
+! Highest card Ace Highest card Queen Player 1
+
+! 3 2D 9C AS AH AC 3D 6D 7D TD QD
+! Three Aces Flush with Diamonds Player 2
+
+! 4 4D 6S 9H QH QC 3D 6D 7H QD QS
+! Pair of Queens Pair of Queens
+! Highest card Nine Highest card Seven Player 1
+
+! 5 2H 2D 4C 4D 4S 3C 3D 3S 9S 9D
+! Full House Full House
+! With Three Fours With Three Threes Player 1
+
+! The file, poker.txt, contains one-thousand random hands dealt to two players.
+! Each line of the file contains ten cards (separated by a single space): the
+! first five are Player 1's cards and the last five are Player 2's cards. You
+! can assume that all hands are valid (no invalid characters or repeated
+! cards), each player's hand is in no specific order, and in each hand there is
+! a clear winner.
+
+! How many hands does Player 1 win?
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: source-054 ( -- seq )
+ "resource:extra/project-euler/054/poker.txt" ascii file-lines
+ [ [ 14 head-slice ] [ 14 tail-slice* ] bi 2array ] map ;
+
+: player1-win? ( hand1 hand2 -- ? )
+ before? ; inline
+
+PRIVATE>
+
+: euler054 ( -- answer )
+ source-054 [ [ <hand> ] map first2 player1-win? ] count ;
+
+! [ euler054 ] 100 ave-time
+! 36 ms ave run time - 2.71 SD (100 trials)
+
+SOLUTION: euler054
--- /dev/null
+8C TS KC 9H 4S 7D 2S 5D 3S AC\r
+5C AD 5D AC 9C 7C 5H 8D TD KS\r
+3H 7H 6S KC JS QH TD JC 2D 8S\r
+TH 8H 5C QS TC 9H 4D JC KS JS\r
+7C 5H KC QH JD AS KH 4C AD 4S\r
+5H KS 9C 7D 9H 8D 3S 5D 5C AH\r
+6H 4H 5C 3H 2H 3S QH 5S 6S AS\r
+TD 8C 4H 7C TC KC 4C 3H 7S KS\r
+7C 9C 6D KD 3H 4C QS QC AC KH\r
+JC 6S 5H 2H 2D KD 9D 7C AS JS\r
+AD QH TH 9D 8H TS 6D 3S AS AC\r
+2H 4S 5C 5S TC KC JD 6C TS 3C\r
+QD AS 6H JS 2C 3D 9H KC 4H 8S\r
+KD 8S 9S 7C 2S 3S 6D 6S 4H KC\r
+3C 8C 2D 7D 4D 9S 4S QH 4H JD\r
+8C KC 7S TC 2D TS 8H QD AC 5C\r
+3D KH QD 6C 6S AD AS 8H 2H QS\r
+6S 8D 4C 8S 6C QH TC 6D 7D 9D\r
+2S 8D 8C 4C TS 9S 9D 9C AC 3D\r
+3C QS 2S 4H JH 3D 2D TD 8S 9H\r
+5H QS 8S 6D 3C 8C JD AS 7H 7D\r
+6H TD 9D AS JH 6C QC 9S KD JC\r
+AH 8S QS 4D TH AC TS 3C 3D 5C\r
+5S 4D JS 3D 8H 6C TS 3S AD 8C\r
+6D 7C 5D 5H 3S 5C JC 2H 5S 3D\r
+5H 6H 2S KS 3D 5D JD 7H JS 8H\r
+KH 4H AS JS QS QC TC 6D 7C KS\r
+3D QS TS 2H JS 4D AS 9S JC KD\r
+QD 5H 4D 5D KH 7H 3D JS KD 4H\r
+2C 9H 6H 5C 9D 6C JC 2D TH 9S\r
+7D 6D AS QD JH 4D JS 7C QS 5C\r
+3H KH QD AD 8C 8H 3S TH 9D 5S\r
+AH 9S 4D 9D 8S 4H JS 3C TC 8D\r
+2C KS 5H QD 3S TS 9H AH AD 8S\r
+5C 7H 5D KD 9H 4D 3D 2D KS AD\r
+KS KC 9S 6D 2C QH 9D 9H TS TC\r
+9C 6H 5D QH 4D AD 6D QC JS KH\r
+9S 3H 9D JD 5C 4D 9H AS TC QH\r
+2C 6D JC 9C 3C AD 9S KH 9D 7D\r
+KC 9C 7C JC JS KD 3H AS 3C 7D\r
+QD KH QS 2C 3S 8S 8H 9H 9C JC\r
+QH 8D 3C KC 4C 4H 6D AD 9H 9D\r
+3S KS QS 7H KH 7D 5H 5D JD AD\r
+2H 2C 6H TH TC 7D 8D 4H 8C AS\r
+4S 2H AC QC 3S 6D TH 4D 4C KH\r
+4D TC KS AS 7C 3C 6D 2D 9H 6C\r
+8C TD 5D QS 2C 7H 4C 9C 3H 9H\r
+5H JH TS 7S TD 6H AD QD 8H 8S\r
+5S AD 9C 8C 7C 8D 5H 9D 8S 2S\r
+4H KH KS 9S 2S KC 5S AD 4S 7D\r
+QS 9C QD 6H JS 5D AC 8D 2S AS\r
+KH AC JC 3S 9D 9S 3C 9C 5S JS\r
+AD 3C 3D KS 3S 5C 9C 8C TS 4S\r
+JH 8D 5D 6H KD QS QD 3D 6C KC\r
+8S JD 6C 3S 8C TC QC 3C QH JS\r
+KC JC 8H 2S 9H 9C JH 8S 8C 9S\r
+8S 2H QH 4D QC 9D KC AS TH 3C\r
+8S 6H TH 7C 2H 6S 3C 3H AS 7S\r
+QH 5S JS 4H 5H TS 8H AH AC JC\r
+9D 8H 2S 4S TC JC 3C 7H 3H 5C\r
+3D AD 3C 3S 4C QC AS 5D TH 8C\r
+6S 9D 4C JS KH AH TS JD 8H AD\r
+4C 6S 9D 7S AC 4D 3D 3S TC JD\r
+AD 7H 6H 4H JH KC TD TS 7D 6S\r
+8H JH TC 3S 8D 8C 9S 2C 5C 4D\r
+2C 9D KC QH TH QS JC 9C 4H TS\r
+QS 3C QD 8H KH 4H 8D TD 8S AC\r
+7C 3C TH 5S 8H 8C 9C JD TC KD\r
+QC TC JD TS 8C 3H 6H KD 7C TD\r
+JH QS KS 9C 6D 6S AS 9H KH 6H\r
+2H 4D AH 2D JH 6H TD 5D 4H JD\r
+KD 8C 9S JH QD JS 2C QS 5C 7C\r
+4S TC 7H 8D 2S 6H 7S 9C 7C KC\r
+8C 5D 7H 4S TD QC 8S JS 4H KS\r
+AD 8S JH 6D TD KD 7C 6C 2D 7D\r
+JC 6H 6S JS 4H QH 9H AH 4C 3C\r
+6H 5H AS 7C 7S 3D KH KC 5D 5C\r
+JC 3D TD AS 4D 6D 6S QH JD KS\r
+8C 7S 8S QH 2S JD 5C 7H AH QD\r
+8S 3C 6H 6C 2C 8D TD 7D 4C 4D\r
+5D QH KH 7C 2S 7H JS 6D QC QD\r
+AD 6C 6S 7D TH 6H 2H 8H KH 4H\r
+KS JS KD 5D 2D KH 7D 9C 8C 3D\r
+9C 6D QD 3C KS 3S 7S AH JD 2D\r
+AH QH AS JC 8S 8H 4C KC TH 7D\r
+JC 5H TD 7C 5D KD 4C AD 8H JS\r
+KC 2H AC AH 7D JH KH 5D 7S 6D\r
+9S 5S 9C 6H 8S TD JD 9H 6C AC\r
+7D 8S 6D TS KD 7H AC 5S 7C 5D\r
+AH QC JC 4C TC 8C 2H TS 2C 7D\r
+KD KC 6S 3D 7D 2S 8S 3H 5S 5C\r
+8S 5D 8H 4C 6H KC 3H 7C 5S KD\r
+JH 8C 3D 3C 6C KC TD 7H 7C 4C\r
+JC KC 6H TS QS TD KS 8H 8C 9S\r
+6C 5S 9C QH 7D AH KS KC 9S 2C\r
+4D 4S 8H TD 9C 3S 7D 9D AS TH\r
+6S 7D 3C 6H 5D KD 2C 5C 9D 9C\r
+2H KC 3D AD 3H QD QS 8D JC 4S\r
+8C 3H 9C 7C AD 5D JC 9D JS AS\r
+5D 9H 5C 7H 6S 6C QC JC QD 9S\r
+JC QS JH 2C 6S 9C QC 3D 4S TC\r
+4H 5S 8D 3D 4D 2S KC 2H JS 2C\r
+TD 3S TH KD 4D 7H JH JS KS AC\r
+7S 8C 9S 2D 8S 7D 5C AD 9D AS\r
+8C 7H 2S 6C TH 3H 4C 3S 8H AC\r
+KD 5H JC 8H JD 2D 4H TD JH 5C\r
+3D AS QH KS 7H JD 8S 5S 6D 5H\r
+9S 6S TC QS JC 5C 5D 9C TH 8C\r
+5H 3S JH 9H 2S 2C 6S 7S AS KS\r
+8C QD JC QS TC QC 4H AC KH 6C\r
+TC 5H 7D JH 4H 2H 8D JC KS 4D\r
+5S 9C KH KD 9H 5C TS 3D 7D 2D\r
+5H AS TC 4D 8C 2C TS 9D 3H 8D\r
+6H 8D 2D 9H JD 6C 4S 5H 5S 6D\r
+AD 9C JC 7D 6H 9S 6D JS 9H 3C\r
+AD JH TC QS 4C 5D 9S 7C 9C AH\r
+KD 6H 2H TH 8S QD KS 9D 9H AS\r
+4H 8H 8D 5H 6C AH 5S AS AD 8S\r
+QS 5D 4S 2H TD KS 5H AC 3H JC\r
+9C 7D QD KD AC 6D 5H QH 6H 5S\r
+KC AH QH 2H 7D QS 3H KS 7S JD\r
+6C 8S 3H 6D KS QD 5D 5C 8H TC\r
+9H 4D 4S 6S 9D KH QC 4H 6C JD\r
+TD 2D QH 4S 6H JH KD 3C QD 8C\r
+4S 6H 7C QD 9D AS AH 6S AD 3C\r
+2C KC TH 6H 8D AH 5C 6D 8S 5D\r
+TD TS 7C AD JC QD 9H 3C KC 7H\r
+5D 4D 5S 8H 4H 7D 3H JD KD 2D\r
+JH TD 6H QS 4S KD 5C 8S 7D 8H\r
+AC 3D AS 8C TD 7H KH 5D 6C JD\r
+9D KS 7C 6D QH TC JD KD AS KC\r
+JH 8S 5S 7S 7D AS 2D 3D AD 2H\r
+2H 5D AS 3C QD KC 6H 9H 9S 2C\r
+9D 5D TH 4C JH 3H 8D TC 8H 9H\r
+6H KD 2C TD 2H 6C 9D 2D JS 8C\r
+KD 7S 3C 7C AS QH TS AD 8C 2S\r
+QS 8H 6C JS 4C 9S QC AD TD TS\r
+2H 7C TS TC 8C 3C 9H 2D 6D JC\r
+TC 2H 8D JH KS 6D 3H TD TH 8H\r
+9D TD 9H QC 5D 6C 8H 8C KC TS\r
+2H 8C 3D AH 4D TH TC 7D 8H KC\r
+TS 5C 2D 8C 6S KH AH 5H 6H KC\r
+5S 5D AH TC 4C JD 8D 6H 8C 6C\r
+KC QD 3D 8H 2D JC 9H 4H AD 2S\r
+TD 6S 7D JS KD 4H QS 2S 3S 8C\r
+4C 9H JH TS 3S 4H QC 5S 9S 9C\r
+2C KD 9H JS 9S 3H JC TS 5D AC\r
+AS 2H 5D AD 5H JC 7S TD JS 4C\r
+2D 4S 8H 3D 7D 2C AD KD 9C TS\r
+7H QD JH 5H JS AC 3D TH 4C 8H\r
+6D KH KC QD 5C AD 7C 2D 4H AC\r
+3D 9D TC 8S QD 2C JC 4H JD AH\r
+6C TD 5S TC 8S AH 2C 5D AS AC\r
+TH 7S 3D AS 6C 4C 7H 7D 4H AH\r
+5C 2H KS 6H 7S 4H 5H 3D 3C 7H\r
+3C 9S AC 7S QH 2H 3D 6S 3S 3H\r
+2D 3H AS 2C 6H TC JS 6S 9C 6C\r
+QH KD QD 6D AC 6H KH 2C TS 8C\r
+8H 7D 3S 9H 5D 3H 4S QC 9S 5H\r
+2D 9D 7H 6H 3C 8S 5H 4D 3S 4S\r
+KD 9S 4S TC 7S QC 3S 8S 2H 7H\r
+TC 3D 8C 3H 6C 2H 6H KS KD 4D\r
+KC 3D 9S 3H JS 4S 8H 2D 6C 8S\r
+6H QS 6C TC QD 9H 7D 7C 5H 4D\r
+TD 9D 8D 6S 6C TC 5D TS JS 8H\r
+4H KC JD 9H TC 2C 6S 5H 8H AS\r
+JS 9C 5C 6S 9D JD 8H KC 4C 6D\r
+4D 8D 8S 6C 7C 6H 7H 8H 5C KC\r
+TC 3D JC 6D KS 9S 6H 7S 9C 2C\r
+6C 3S KD 5H TS 7D 9H 9S 6H KH\r
+3D QD 4C 6H TS AC 3S 5C 2H KD\r
+4C AS JS 9S 7C TS 7H 9H JC KS\r
+4H 8C JD 3H 6H AD 9S 4S 5S KS\r
+4C 2C 7D 3D AS 9C 2S QS KC 6C\r
+8S 5H 3D 2S AC 9D 6S 3S 4D TD\r
+QD TH 7S TS 3D AC 7H 6C 5D QC\r
+TC QD AD 9C QS 5C 8D KD 3D 3C\r
+9D 8H AS 3S 7C 8S JD 2D 8D KC\r
+4C TH AC QH JS 8D 7D 7S 9C KH\r
+9D 8D 4C JH 2C 2S QD KD TS 4H\r
+4D 6D 5D 2D JH 3S 8S 3H TC KH\r
+AD 4D 2C QS 8C KD JH JD AH 5C\r
+5C 6C 5H 2H JH 4H KS 7C TC 3H\r
+3C 4C QC 5D JH 9C QD KH 8D TC\r
+3H 9C JS 7H QH AS 7C 9H 5H JC\r
+2D 5S QD 4S 3C KC 6S 6C 5C 4C\r
+5D KH 2D TS 8S 9C AS 9S 7C 4C\r
+7C AH 8C 8D 5S KD QH QS JH 2C\r
+8C 9D AH 2H AC QC 5S 8H 7H 2C\r
+QD 9H 5S QS QC 9C 5H JC TH 4H\r
+6C 6S 3H 5H 3S 6H KS 8D AC 7S\r
+AC QH 7H 8C 4S KC 6C 3D 3S TC\r
+9D 3D JS TH AC 5H 3H 8S 3S TC\r
+QD KH JS KS 9S QC 8D AH 3C AC\r
+5H 6C KH 3S 9S JH 2D QD AS 8C\r
+6C 4D 7S 7H 5S JC 6S 9H 4H JH\r
+AH 5S 6H 9S AD 3S TH 2H 9D 8C\r
+4C 8D 9H 7C QC AD 4S 9C KC 5S\r
+9D 6H 4D TC 4C JH 2S 5D 3S AS\r
+2H 6C 7C KH 5C AD QS TH JD 8S\r
+3S 4S 7S AH AS KC JS 2S AD TH\r
+JS KC 2S 7D 8C 5C 9C TS 5H 9D\r
+7S 9S 4D TD JH JS KH 6H 5D 2C\r
+JD JS JC TH 2D 3D QD 8C AC 5H\r
+7S KH 5S 9D 5D TD 4S 6H 3C 2D\r
+4S 5D AC 8D 4D 7C AD AS AH 9C\r
+6S TH TS KS 2C QC AH AS 3C 4S\r
+2H 8C 3S JC 5C 7C 3H 3C KH JH\r
+7S 3H JC 5S 6H 4C 2S 4D KC 7H\r
+4D 7C 4H 9S 8S 6S AD TC 6C JC\r
+KH QS 3S TC 4C 8H 8S AC 3C TS\r
+QD QS TH 3C TS 7H 7D AH TD JC\r
+TD JD QC 4D 9S 7S TS AD 7D AC\r
+AH 7H 4S 6D 7C 2H 9D KS JC TD\r
+7C AH JD 4H 6D QS TS 2H 2C 5C\r
+TC KC 8C 9S 4C JS 3C JC 6S AH\r
+AS 7D QC 3D 5S JC JD 9D TD KH\r
+TH 3C 2S 6H AH AC 5H 5C 7S 8H\r
+QC 2D AC QD 2S 3S JD QS 6S 8H\r
+KC 4H 3C 9D JS 6H 3S 8S AS 8C\r
+7H KC 7D JD 2H JC QH 5S 3H QS\r
+9H TD 3S 8H 7S AC 5C 6C AH 7C\r
+8D 9H AH JD TD QS 7D 3S 9C 8S\r
+AH QH 3C JD KC 4S 5S 5D TD KS\r
+9H 7H 6S JH TH 4C 7C AD 5C 2D\r
+7C KD 5S TC 9D 6S 6C 5D 2S TH\r
+KC 9H 8D 5H 7H 4H QC 3D 7C AS\r
+6S 8S QC TD 4S 5C TH QS QD 2S\r
+8S 5H TH QC 9H 6S KC 7D 7C 5C\r
+7H KD AH 4D KH 5C 4S 2D KC QH\r
+6S 2C TD JC AS 4D 6C 8C 4H 5S\r
+JC TC JD 5S 6S 8D AS 9D AD 3S\r
+6D 6H 5D 5S TC 3D 7D QS 9D QD\r
+4S 6C 8S 3S 7S AD KS 2D 7D 7C\r
+KC QH JC AC QD 5D 8D QS 7H 7D\r
+JS AH 8S 5H 3D TD 3H 4S 6C JH\r
+4S QS 7D AS 9H JS KS 6D TC 5C\r
+2D 5C 6H TC 4D QH 3D 9H 8S 6C\r
+6D 7H TC TH 5S JD 5C 9C KS KD\r
+8D TD QH 6S 4S 6C 8S KC 5C TC\r
+5S 3D KS AC 4S 7D QD 4C TH 2S\r
+TS 8H 9S 6S 7S QH 3C AH 7H 8C\r
+4C 8C TS JS QC 3D 7D 5D 7S JH\r
+8S 7S 9D QC AC 7C 6D 2H JH KC\r
+JS KD 3C 6S 4S 7C AH QC KS 5H\r
+KS 6S 4H JD QS TC 8H KC 6H AS\r
+KH 7C TC 6S TD JC 5C 7D AH 3S\r
+3H 4C 4H TC TH 6S 7H 6D 9C QH\r
+7D 5H 4S 8C JS 4D 3D 8S QH KC\r
+3H 6S AD 7H 3S QC 8S 4S 7S JS\r
+3S JD KH TH 6H QS 9C 6C 2D QD\r
+4S QH 4D 5H KC 7D 6D 8D TH 5S\r
+TD AD 6S 7H KD KH 9H 5S KC JC\r
+3H QC AS TS 4S QD KS 9C 7S KC\r
+TS 6S QC 6C TH TC 9D 5C 5D KD\r
+JS 3S 4H KD 4C QD 6D 9S JC 9D\r
+8S JS 6D 4H JH 6H 6S 6C KS KH\r
+AC 7D 5D TC 9S KH 6S QD 6H AS\r
+AS 7H 6D QH 8D TH 2S KH 5C 5H\r
+4C 7C 3D QC TC 4S KH 8C 2D JS\r
+6H 5D 7S 5H 9C 9H JH 8S TH 7H\r
+AS JS 2S QD KH 8H 4S AC 8D 8S\r
+3H 4C TD KD 8C JC 5C QS 2D JD\r
+TS 7D 5D 6C 2C QS 2H 3C AH KS\r
+4S 7C 9C 7D JH 6C 5C 8H 9D QD\r
+2S TD 7S 6D 9C 9S QS KH QH 5C\r
+JC 6S 9C QH JH 8D 7S JS KH 2H\r
+8D 5H TH KC 4D 4S 3S 6S 3D QS\r
+2D JD 4C TD 7C 6D TH 7S JC AH\r
+QS 7S 4C TH 9D TS AD 4D 3H 6H\r
+2D 3H 7D JD 3D AS 2S 9C QC 8S\r
+4H 9H 9C 2C 7S JH KD 5C 5D 6H\r
+TC 9H 8H JC 3C 9S 8D KS AD KC\r
+TS 5H JD QS QH QC 8D 5D KH AH\r
+5D AS 8S 6S 4C AH QC QD TH 7H\r
+3H 4H 7D 6S 4S 9H AS 8H JS 9D\r
+JD 8C 2C 9D 7D 5H 5S 9S JC KD\r
+KD 9C 4S QD AH 7C AD 9D AC TD\r
+6S 4H 4S 9C 8D KS TC 9D JH 7C\r
+5S JC 5H 4S QH AC 2C JS 2S 9S\r
+8C 5H AS QD AD 5C 7D 8S QC TD\r
+JC 4C 8D 5C KH QS 4D 6H 2H 2C\r
+TH 4S 2D KC 3H QD AC 7H AD 9D\r
+KH QD AS 8H TH KC 8D 7S QH 8C\r
+JC 6C 7D 8C KH AD QS 2H 6S 2D\r
+JC KH 2D 7D JS QC 5H 4C 5D AD\r
+TS 3S AD 4S TD 2D TH 6S 9H JH\r
+9H 2D QS 2C 4S 3D KH AS AC 9D\r
+KH 6S 8H 4S KD 7D 9D TS QD QC\r
+JH 5H AH KS AS AD JC QC 5S KH\r
+5D 7D 6D KS KD 3D 7C 4D JD 3S\r
+AC JS 8D 5H 9C 3H 4H 4D TS 2C\r
+6H KS KH 9D 7C 2S 6S 8S 2H 3D\r
+6H AC JS 7S 3S TD 8H 3H 4H TH\r
+9H TC QC KC 5C KS 6H 4H AC 8S\r
+TC 7D QH 4S JC TS 6D 6C AC KH\r
+QH 7D 7C JH QS QD TH 3H 5D KS\r
+3D 5S 8D JS 4C 2C KS 7H 9C 4H\r
+5H 8S 4H TD 2C 3S QD QC 3H KC\r
+QC JS KD 9C AD 5S 9D 7D 7H TS\r
+8C JC KH 7C 7S 6C TS 2C QD TH\r
+5S 9D TH 3C 7S QH 8S 9C 2H 5H\r
+5D 9H 6H 2S JS KH 3H 7C 2H 5S\r
+JD 5D 5S 2C TC 2S 6S 6C 3C 8S\r
+4D KH 8H 4H 2D KS 3H 5C 2S 9H\r
+3S 2D TD 7H 8S 6H JD KC 9C 8D\r
+6S QD JH 7C 9H 5H 8S 8H TH TD\r
+QS 7S TD 7D TS JC KD 7C 3C 2C\r
+3C JD 8S 4H 2D 2S TD AS 4D AC\r
+AH KS 6C 4C 4S 7D 8C 9H 6H AS\r
+5S 3C 9S 2C QS KD 4D 4S AC 5D\r
+2D TS 2C JS KH QH 5D 8C AS KC\r
+KD 3H 6C TH 8S 7S KH 6H 9S AC\r
+6H 7S 6C QS AH 2S 2H 4H 5D 5H\r
+5H JC QD 2C 2S JD AS QC 6S 7D\r
+6C TC AS KD 8H 9D 2C 7D JH 9S\r
+2H 4C 6C AH 8S TD 3H TH 7C TS\r
+KD 4S TS 6C QH 8D 9D 9C AH 7D\r
+6D JS 5C QD QC 9C 5D 8C 2H KD\r
+3C QH JH AD 6S AH KC 8S 6D 6H\r
+3D 7C 4C 7S 5S 3S 6S 5H JC 3C\r
+QH 7C 5H 3C 3S 8C TS 4C KD 9C\r
+QD 3S 7S 5H 7H QH JC 7C 8C KD\r
+3C KD KH 2S 4C TS AC 6S 2C 7C\r
+2C KH 3C 4C 6H 4D 5H 5S 7S QD\r
+4D 7C 8S QD TS 9D KS 6H KD 3C\r
+QS 4D TS 7S 4C 3H QD 8D 9S TC\r
+TS QH AC 6S 3C 9H 9D QS 8S 6H\r
+3S 7S 5D 4S JS 2D 6C QH 6S TH\r
+4C 4H AS JS 5D 3D TS 9C AC 8S\r
+6S 9C 7C 3S 5C QS AD AS 6H 3C\r
+9S 8C 7H 3H 6S 7C AS 9H JD KH\r
+3D 3H 7S 4D 6C 7C AC 2H 9C TH\r
+4H 5S 3H AC TC TH 9C 9H 9S 8D\r
+8D 9H 5H 4D 6C 2H QD 6S 5D 3S\r
+4C 5C JD QS 4D 3H TH AC QH 8C\r
+QC 5S 3C 7H AD 4C KS 4H JD 6D\r
+QS AH 3H KS 9H 2S JS JH 5H 2H\r
+2H 5S TH 6S TS 3S KS 3C 5H JS\r
+2D 9S 7H 3D KC JH 6D 7D JS TD\r
+AC JS 8H 2C 8C JH JC 2D TH 7S\r
+5D 9S 8H 2H 3D TC AH JC KD 9C\r
+9D QD JC 2H 6D KH TS 9S QH TH\r
+2C 8D 4S JD 5H 3H TH TC 9C KC\r
+AS 3D 9H 7D 4D TH KH 2H 7S 3H\r
+4H 7S KS 2S JS TS 8S 2H QD 8D\r
+5S 6H JH KS 8H 2S QC AC 6S 3S\r
+JC AS AD QS 8H 6C KH 4C 4D QD\r
+2S 3D TS TD 9S KS 6S QS 5C 8D\r
+3C 6D 4S QC KC JH QD TH KH AD\r
+9H AH 4D KS 2S 8D JH JC 7C QS\r
+2D 6C TH 3C 8H QD QH 2S 3S KS\r
+6H 5D 9S 4C TS TD JS QD 9D JD\r
+5H 8H KH 8S KS 7C TD AD 4S KD\r
+2C 7C JC 5S AS 6C 7D 8S 5H 9C\r
+6S QD 9S TS KH QS 5S QH 3C KC\r
+7D 3H 3C KD 5C AS JH 7H 6H JD\r
+9D 5C 9H KC 8H KS 4S AD 4D 2S\r
+3S JD QD 8D 2S 7C 5S 6S 5H TS\r
+6D 9S KC TD 3S 6H QD JD 5C 8D\r
+5H 9D TS KD 8D 6H TD QC 4C 7D\r
+6D 4S JD 9D AH 9S AS TD 9H QD\r
+2D 5S 2H 9C 6H 9S TD QC 7D TC\r
+3S 2H KS TS 2C 9C 8S JS 9D 7D\r
+3C KC 6D 5D 6C 6H 8S AS 7S QS\r
+JH 9S 2H 8D 4C 8H 9H AD TH KH\r
+QC AS 2S JS 5C 6H KD 3H 7H 2C\r
+QD 8H 2S 8D 3S 6D AH 2C TC 5C\r
+JD JS TS 8S 3H 5D TD KC JC 6H\r
+6S QS TC 3H 5D AH JC 7C 7D 4H\r
+7C 5D 8H 9C 2H 9H JH KH 5S 2C\r
+9C 7H 6S TH 3S QC QD 4C AC JD\r
+2H 5D 9S 7D KC 3S QS 2D AS KH\r
+2S 4S 2H 7D 5C TD TH QH 9S 4D\r
+6D 3S TS 6H 4H KS 9D 8H 5S 2D\r
+9H KS 4H 3S 5C 5D KH 6H 6S JS\r
+KC AS 8C 4C JC KH QC TH QD AH\r
+6S KH 9S 2C 5H TC 3C 7H JC 4D\r
+JD 4S 6S 5S 8D 7H 7S 4D 4C 2H\r
+7H 9H 5D KH 9C 7C TS TC 7S 5H\r
+4C 8D QC TS 4S 9H 3D AD JS 7C\r
+8C QS 5C 5D 3H JS AH KC 4S 9D\r
+TS JD 8S QS TH JH KH 2D QD JS\r
+JD QC 5D 6S 9H 3S 2C 8H 9S TS\r
+2S 4C AD 7H JC 5C 2D 6D 4H 3D\r
+7S JS 2C 4H 8C AD QD 9C 3S TD\r
+JD TS 4C 6H 9H 7D QD 6D 3C AS\r
+AS 7C 4C 6S 5D 5S 5C JS QC 4S\r
+KD 6S 9S 7C 3C 5S 7D JH QD JS\r
+4S 7S JH 2C 8S 5D 7H 3D QH AD\r
+TD 6H 2H 8D 4H 2D 7C AD KH 5D\r
+TS 3S 5H 2C QD AH 2S 5C KH TD\r
+KC 4D 8C 5D AS 6C 2H 2S 9H 7C\r
+KD JS QC TS QS KH JH 2C 5D AD\r
+3S 5H KC 6C 9H 3H 2H AD 7D 7S\r
+7S JS JH KD 8S 7D 2S 9H 7C 2H\r
+9H 2D 8D QC 6S AD AS 8H 5H 6C\r
+2S 7H 6C 6D 7D 8C 5D 9D JC 3C\r
+7C 9C 7H JD 2H KD 3S KH AD 4S\r
+QH AS 9H 4D JD KS KD TS KH 5H\r
+4C 8H 5S 3S 3D 7D TD AD 7S KC\r
+JS 8S 5S JC 8H TH 9C 4D 5D KC\r
+7C 5S 9C QD 2C QH JS 5H 8D KH\r
+TD 2S KS 3D AD KC 7S TC 3C 5D\r
+4C 2S AD QS 6C 9S QD TH QH 5C\r
+8C AD QS 2D 2S KC JD KS 6C JC\r
+8D 4D JS 2H 5D QD 7S 7D QH TS\r
+6S 7H 3S 8C 8S 9D QS 8H 6C 9S\r
+4S TC 2S 5C QD 4D QS 6D TH 6S\r
+3S 5C 9D 6H 8D 4C 7D TC 7C TD\r
+AH 6S AS 7H 5S KD 3H 5H AC 4C\r
+8D 8S AH KS QS 2C AD 6H 7D 5D\r
+6H 9H 9S 2H QS 8S 9C 5D 2D KD\r
+TS QC 5S JH 7D 7S TH 9S 9H AC\r
+7H 3H 6S KC 4D 6D 5C 4S QD TS\r
+TD 2S 7C QD 3H JH 9D 4H 7S 7H\r
+KS 3D 4H 5H TC 2S AS 2D 6D 7D\r
+8H 3C 7H TD 3H AD KC TH 9C KH\r
+TC 4C 2C 9S 9D 9C 5C 2H JD 3C\r
+3H AC TS 5D AD 8D 6H QC 6S 8C\r
+2S TS 3S JD 7H 8S QH 4C 5S 8D\r
+AC 4S 6C 3C KH 3D 7C 2D 8S 2H\r
+4H 6C 8S TH 2H 4S 8H 9S 3H 7S\r
+7C 4C 9C 2C 5C AS 5D KD 4D QH\r
+9H 4H TS AS 7D 8D 5D 9S 8C 2H\r
+QC KD AC AD 2H 7S AS 3S 2D 9S\r
+2H QC 8H TC 6D QD QS 5D KH 3C\r
+TH JD QS 4C 2S 5S AD 7H 3S AS\r
+7H JS 3D 6C 3S 6D AS 9S AC QS\r
+9C TS AS 8C TC 8S 6H 9D 8D 6C\r
+4D JD 9C KC 7C 6D KS 3S 8C AS\r
+3H 6S TC 8D TS 3S KC 9S 7C AS\r
+8C QC 4H 4S 8S 6C 3S TC AH AC\r
+4D 7D 5C AS 2H 6S TS QC AD TC\r
+QD QC 8S 4S TH 3D AH TS JH 4H\r
+5C 2D 9S 2C 3H 3C 9D QD QH 7D\r
+KC 9H 6C KD 7S 3C 4D AS TC 2D\r
+3D JS 4D 9D KS 7D TH QC 3H 3C\r
+8D 5S 2H 9D 3H 8C 4C 4H 3C TH\r
+JC TH 4S 6S JD 2D 4D 6C 3D 4C\r
+TS 3S 2D 4H AC 2C 6S 2H JH 6H\r
+TD 8S AD TC AH AC JH 9S 6S 7S\r
+6C KC 4S JD 8D 9H 5S 7H QH AH\r
+KD 8D TS JH 5C 5H 3H AD AS JS\r
+2D 4H 3D 6C 8C 7S AD 5D 5C 8S\r
+TD 5D 7S 9C 4S 5H 6C 8C 4C 8S\r
+JS QH 9C AS 5C QS JC 3D QC 7C\r
+JC 9C KH JH QS QC 2C TS 3D AD\r
+5D JH AC 5C 9S TS 4C JD 8C KS\r
+KC AS 2D KH 9H 2C 5S 4D 3D 6H\r
+TH AH 2D 8S JC 3D 8C QH 7S 3S\r
+8H QD 4H JC AS KH KS 3C 9S 6D\r
+9S QH 7D 9C 4S AC 7H KH 4D KD\r
+AH AD TH 6D 9C 9S KD KS QH 4H\r
+QD 6H 9C 7C QS 6D 6S 9D 5S JH\r
+AH 8D 5H QD 2H JC KS 4H KH 5S\r
+5C 2S JS 8D 9C 8C 3D AS KC AH\r
+JD 9S 2H QS 8H 5S 8C TH 5C 4C\r
+QC QS 8C 2S 2C 3S 9C 4C KS KH\r
+2D 5D 8S AH AD TD 2C JS KS 8C\r
+TC 5S 5H 8H QC 9H 6H JD 4H 9S\r
+3C JH 4H 9H AH 4S 2H 4C 8D AC\r
+8S TH 4D 7D 6D QD QS 7S TC 7C\r
+KH 6D 2D JD 5H JS QD JH 4H 4S\r
+9C 7S JH 4S 3S TS QC 8C TC 4H\r
+QH 9D 4D JH QS 3S 2C 7C 6C 2D\r
+4H 9S JD 5C 5H AH 9D TS 2D 4C\r
+KS JH TS 5D 2D AH JS 7H AS 8D\r
+JS AH 8C AD KS 5S 8H 2C 6C TH\r
+2H 5D AD AC KS 3D 8H TS 6H QC\r
+6D 4H TS 9C 5H JS JH 6S JD 4C\r
+JH QH 4H 2C 6D 3C 5D 4C QS KC\r
+6H 4H 6C 7H 6S 2S 8S KH QC 8C\r
+3H 3D 5D KS 4H TD AD 3S 4D TS\r
+5S 7C 8S 7D 2C KS 7S 6C 8C JS\r
+5D 2H 3S 7C 5C QD 5H 6D 9C 9H\r
+JS 2S KD 9S 8D TD TS AC 8C 9D\r
+5H QD 2S AC 8C 9H KS 7C 4S 3C\r
+KH AS 3H 8S 9C JS QS 4S AD 4D\r
+AS 2S TD AD 4D 9H JC 4C 5H QS\r
+5D 7C 4H TC 2D 6C JS 4S KC 3S\r
+4C 2C 5D AC 9H 3D JD 8S QS QH\r
+2C 8S 6H 3C QH 6D TC KD AC AH\r
+QC 6C 3S QS 4S AC 8D 5C AD KH\r
+5S 4C AC KH AS QC 2C 5C 8D 9C\r
+8H JD 3C KH 8D 5C 9C QD QH 9D\r
+7H TS 2C 8C 4S TD JC 9C 5H QH\r
+JS 4S 2C 7C TH 6C AS KS 7S JD\r
+JH 7C 9H 7H TC 5H 3D 6D 5D 4D\r
+2C QD JH 2H 9D 5S 3D TD AD KS\r
+JD QH 3S 4D TH 7D 6S QS KS 4H\r
+TC KS 5S 8D 8H AD 2S 2D 4C JH\r
+5S JH TC 3S 2D QS 9D 4C KD 9S\r
+AC KH 3H AS 9D KC 9H QD 6C 6S\r
+9H 7S 3D 5C 7D KC TD 8H 4H 6S\r
+3C 7H 8H TC QD 4D 7S 6S QH 6C\r
+6D AD 4C QD 6C 5D 7D 9D KS TS\r
+JH 2H JD 9S 7S TS KH 8D 5D 8H\r
+2D 9S 4C 7D 9D 5H QD 6D AC 6S\r
+7S 6D JC QD JH 4C 6S QS 2H 7D\r
+8C TD JH KD 2H 5C QS 2C JS 7S\r
+TC 5H 4H JH QD 3S 5S 5D 8S KH\r
+KS KH 7C 2C 5D JH 6S 9C 6D JC\r
+5H AH JD 9C JS KC 2H 6H 4D 5S\r
+AS 3C TH QC 6H 9C 8S 8C TD 7C\r
+KC 2C QD 9C KH 4D 7S 3C TS 9H\r
+9C QC 2S TS 8C TD 9S QD 3S 3C\r
+4D 9D TH JH AH 6S 2S JD QH JS\r
+QD 9H 6C KD 7D 7H 5D 6S 8H AH\r
+8H 3C 4S 2H 5H QS QH 7S 4H AC\r
+QS 3C 7S 9S 4H 3S AH KS 9D 7C\r
+AD 5S 6S 2H 2D 5H TC 4S 3C 8C\r
+QH TS 6S 4D JS KS JH AS 8S 6D\r
+2C 8S 2S TD 5H AS TC TS 6C KC\r
+KC TS 8H 2H 3H 7C 4C 5S TH TD\r
+KD AD KH 7H 7S 5D 5H 5S 2D 9C\r
+AD 9S 3D 7S 8C QC 7C 9C KD KS\r
+3C QC 9S 8C 4D 5C AS QD 6C 2C\r
+2H KC 8S JD 7S AC 8D 5C 2S 4D\r
+9D QH 3D 2S TC 3S KS 3C 9H TD\r
+KD 6S AC 2C 7H 5H 3S 6C 6H 8C\r
+QH TC 8S 6S KH TH 4H 5D TS 4D\r
+8C JS 4H 6H 2C 2H 7D AC QD 3D\r
+QS KC 6S 2D 5S 4H TD 3H JH 4C\r
+7S 5H 7H 8H KH 6H QS TH KD 7D\r
+5H AD KD 7C KH 5S TD 6D 3C 6C\r
+8C 9C 5H JD 7C KC KH 7H 2H 3S\r
+7S 4H AD 4D 8S QS TH 3D 7H 5S\r
+8D TC KS KD 9S 6D AD JD 5C 2S\r
+7H 8H 6C QD 2H 6H 9D TC 9S 7C\r
+8D 6D 4C 7C 6C 3C TH KH JS JH\r
+5S 3S 8S JS 9H AS AD 8H 7S KD\r
+JH 7C 2C KC 5H AS AD 9C 9S JS\r
+AD AC 2C 6S QD 7C 3H TH KS KD\r
+9D JD 4H 8H 4C KH 7S TS 8C KC\r
+3S 5S 2H 7S 6H 7D KS 5C 6D AD\r
+5S 8C 9H QS 7H 7S 2H 6C 7D TD\r
+QS 5S TD AC 9D KC 3D TC 2D 4D\r
+TD 2H 7D JD QD 4C 7H 5D KC 3D\r
+4C 3H 8S KD QH 5S QC 9H TC 5H\r
+9C QD TH 5H TS 5C 9H AH QH 2C\r
+4D 6S 3C AC 6C 3D 2C 2H TD TH\r
+AC 9C 5D QC 4D AD 8D 6D 8C KC\r
+AD 3C 4H AC 8D 8H 7S 9S TD JC\r
+4H 9H QH JS 2D TH TD TC KD KS\r
+5S 6S 9S 8D TH AS KH 5H 5C 8S\r
+JD 2S 9S 6S 5S 8S 5D 7S 7H 9D\r
+5D 8C 4C 9D AD TS 2C 7D KD TC\r
+8S QS 4D KC 5C 8D 4S KH JD KD\r
+AS 5C AD QH 7D 2H 9S 7H 7C TC\r
+2S 8S JD KH 7S 6C 6D AD 5D QC\r
+9H 6H 3S 8C 8H AH TC 4H JS TD\r
+2C TS 4D 7H 2D QC 9C 5D TH 7C\r
+6C 8H QC 5D TS JH 5C 5H 9H 4S\r
+2D QC 7H AS JS 8S 2H 4C 4H 8D\r
+JS 6S AC KD 3D 3C 4S 7H TH KC\r
+QH KH 6S QS 5S 4H 3C QD 3S 3H\r
+7H AS KH 8C 4H 9C 5S 3D 6S TS\r
+9C 7C 3H 5S QD 2C 3D AD AC 5H\r
+JH TD 2D 4C TS 3H KH AD 3S 7S\r
+AS 4C 5H 4D 6S KD JC 3C 6H 2D\r
+3H 6S 8C 2D TH 4S AH QH AD 5H\r
+7C 2S 9H 7H KC 5C 6D 5S 3H JC\r
+3C TC 9C 4H QD TD JH 6D 9H 5S\r
+7C 6S 5C 5D 6C 4S 7H 9H 6H AH\r
+AD 2H 7D KC 2C 4C 2S 9S 7H 3S\r
+TH 4C 8S 6S 3S AD KS AS JH TD\r
+5C TD 4S 4D AD 6S 5D TC 9C 7D\r
+8H 3S 4D 4S 5S 6H 5C AC 3H 3D\r
+9H 3C AC 4S QS 8S 9D QH 5H 4D\r
+JC 6C 5H TS AC 9C JD 8C 7C QD\r
+8S 8H 9C JD 2D QC QH 6H 3C 8D\r
+KS JS 2H 6H 5H QH QS 3H 7C 6D\r
+TC 3H 4S 7H QC 2H 3S 8C JS KH\r
+AH 8H 5S 4C 9H JD 3H 7S JC AC\r
+3C 2D 4C 5S 6C 4S QS 3S JD 3D\r
+5H 2D TC AH KS 6D 7H AD 8C 6H\r
+6C 7S 3C JD 7C 8H KS KH AH 6D\r
+AH 7D 3H 8H 8S 7H QS 5H 9D 2D\r
+JD AC 4H 7S 8S 9S KS AS 9D QH\r
+7S 2C 8S 5S JH QS JC AH KD 4C\r
+AH 2S 9H 4H 8D TS TD 6H QH JD\r
+4H JC 3H QS 6D 7S 9C 8S 9D 8D\r
+5H TD 4S 9S 4C 8C 8D 7H 3H 3D\r
+QS KH 3S 2C 2S 3C 7S TD 4S QD\r
+7C TD 4D 5S KH AC AS 7H 4C 6C\r
+2S 5H 6D JD 9H QS 8S 2C 2H TD\r
+2S TS 6H 9H 7S 4H JC 4C 5D 5S\r
+2C 5H 7D 4H 3S QH JC JS 6D 8H\r
+4C QH 7C QD 3S AD TH 8S 5S TS\r
+9H TC 2S TD JC 7D 3S 3D TH QH\r
+7D 4C 8S 5C JH 8H 6S 3S KC 3H\r
+JC 3H KH TC QH TH 6H 2C AC 5H\r
+QS 2H 9D 2C AS 6S 6C 2S 8C 8S\r
+9H 7D QC TH 4H KD QS AC 7S 3C\r
+4D JH 6S 5S 8H KS 9S QC 3S AS\r
+JD 2D 6S 7S TC 9H KC 3H 7D KD\r
+2H KH 7C 4D 4S 3H JS QD 7D KC\r
+4C JC AS 9D 3C JS 6C 8H QD 4D\r
+AH JS 3S 6C 4C 3D JH 6D 9C 9H\r
+9H 2D 8C 7H 5S KS 6H 9C 2S TC\r
+6C 8C AD 7H 6H 3D KH AS 5D TH\r
+KS 8C 3S TS 8S 4D 5S 9S 6C 4H\r
+9H 4S 4H 5C 7D KC 2D 2H 9D JH\r
+5C JS TC 9D 9H 5H 7S KH JC 6S\r
+7C 9H 8H 4D JC KH JD 2H TD TC\r
+8H 6C 2H 2C KH 6H 9D QS QH 5H\r
+AC 7D 2S 3D QD JC 2D 8D JD JH\r
+2H JC 2D 7H 2C 3C 8D KD TD 4H\r
+3S 4H 6D 8D TS 3H TD 3D 6H TH\r
+JH JC 3S AC QH 9H 7H 8S QC 2C\r
+7H TD QS 4S 8S 9C 2S 5D 4D 2H\r
+3D TS 3H 2S QC 8H 6H KC JC KS\r
+5D JD 7D TC 8C 6C 9S 3D 8D AC\r
+8H 6H JH 6C 5D 8D 8S 4H AD 2C\r
+9D 4H 2D 2C 3S TS AS TC 3C 5D\r
+4D TH 5H KS QS 6C 4S 2H 3D AD\r
+5C KC 6H 2C 5S 3C 4D 2D 9H 9S\r
+JD 4C 3H TH QH 9H 5S AH 8S AC\r
+7D 9S 6S 2H TD 9C 4H 8H QS 4C\r
+3C 6H 5D 4H 8C 9C KC 6S QD QS\r
+3S 9H KD TC 2D JS 8C 6S 4H 4S\r
+2S 4C 8S QS 6H KH 3H TH 8C 5D\r
+2C KH 5S 3S 7S 7H 6C 9D QD 8D\r
+8H KS AC 2D KH TS 6C JS KC 7H\r
+9C KS 5C TD QC AH 6C 5H 9S 7C\r
+5D 4D 3H 4H 6S 7C 7S AH QD TD\r
+2H 7D QC 6S TC TS AH 7S 9D 3H\r
+TH 5H QD 9S KS 7S 7C 6H 8C TD\r
+TH 2D 4D QC 5C 7D JD AH 9C 4H\r
+4H 3H AH 8D 6H QC QH 9H 2H 2C\r
+2D AD 4C TS 6H 7S TH 4H QS TD\r
+3C KD 2H 3H QS JD TC QC 5D 8H\r
+KS JC QD TH 9S KD 8D 8C 2D 9C\r
+3C QD KD 6D 4D 8D AH AD QC 8S\r
+8H 3S 9D 2S 3H KS 6H 4C 7C KC\r
+TH 9S 5C 3D 7D 6H AC 7S 4D 2C\r
+5C 3D JD 4D 2D 6D 5H 9H 4C KH\r
+AS 7H TD 6C 2H 3D QD KS 4C 4S\r
+JC 3C AC 7C JD JS 8H 9S QC 5D\r
+JD 6S 5S 2H AS 8C 7D 5H JH 3D\r
+8D TC 5S 9S 8S 3H JC 5H 7S AS\r
+5C TD 3D 7D 4H 8D 7H 4D 5D JS\r
+QS 9C KS TD 2S 8S 5C 2H 4H AS\r
+TH 7S 4H 7D 3H JD KD 5D 2S KC\r
+JD 7H 4S 8H 4C JS 6H QH 5S 4H\r
+2C QS 8C 5S 3H QC 2S 6C QD AD\r
+8C 3D JD TC 4H 2H AD 5S AC 2S\r
+5D 2C JS 2D AD 9D 3D 4C 4S JH\r
+8D 5H 5D 6H 7S 4D KS 9D TD JD\r
+3D 6D 9C 2S AS 7D 5S 5C 8H JD\r
+7C 8S 3S 6S 5H JD TC AD 7H 7S\r
+2S 9D TS 4D AC 8D 6C QD JD 3H\r
+9S KH 2C 3C AC 3D 5H 6H 8D 5D\r
+KS 3D 2D 6S AS 4C 2S 7C 7H KH\r
+AC 2H 3S JC 5C QH 4D 2D 5H 7S\r
+TS AS JD 8C 6H JC 8S 5S 2C 5D\r
+7S QH 7H 6C QC 8H 2D 7C JD 2S\r
+2C QD 2S 2H JC 9C 5D 2D JD JH\r
+7C 5C 9C 8S 7D 6D 8D 6C 9S JH\r
+2C AD 6S 5H 3S KS 7S 9D KH 4C\r
+7H 6C 2C 5C TH 9D 8D 3S QC AH\r
+5S KC 6H TC 5H 8S TH 6D 3C AH\r
+9C KD 4H AD TD 9S 4S 7D 6H 5D\r
+7H 5C 5H 6D AS 4C KD KH 4H 9D\r
+3C 2S 5C 6C JD QS 2H 9D 7D 3H\r
+AC 2S 6S 7S JS QD 5C QS 6H AD\r
+5H TH QC 7H TC 3S 7C 6D KC 3D\r
+4H 3D QC 9S 8H 2C 3S JC KS 5C\r
+4S 6S 2C 6H 8S 3S 3D 9H 3H JS\r
+4S 8C 4D 2D 8H 9H 7D 9D AH TS\r
+9S 2C 9H 4C 8D AS 7D 3D 6D 5S\r
+6S 4C 7H 8C 3H 5H JC AH 9D 9C\r
+2S 7C 5S JD 8C 3S 3D 4D 7D 6S\r
+3C KC 4S 5D 7D 3D JD 7H 3H 4H\r
+9C 9H 4H 4D TH 6D QD 8S 9S 7S\r
+2H AC 8S 4S AD 8C 2C AH 7D TC\r
+TS 9H 3C AD KS TC 3D 8C 8H JD\r
+QC 8D 2C 3C 7D 7C JD 9H 9C 6C\r
+AH 6S JS JH 5D AS QC 2C JD TD\r
+9H KD 2H 5D 2D 3S 7D TC AH TS\r
+TD 8H AS 5D AH QC AC 6S TC 5H\r
+KS 4S 7H 4D 8D 9C TC 2H 6H 3H\r
+3H KD 4S QD QH 3D 8H 8C TD 7S\r
+8S JD TC AH JS QS 2D KH KS 4D\r
+3C AD JC KD JS KH 4S TH 9H 2C\r
+QC 5S JS 9S KS AS 7C QD 2S JD\r
+KC 5S QS 3S 2D AC 5D 9H 8H KS\r
+6H 9C TC AD 2C 6D 5S JD 6C 7C\r
+QS KH TD QD 2C 3H 8S 2S QC AH\r
+9D 9H JH TC QH 3C 2S JS 5C 7H\r
+6C 3S 3D 2S 4S QD 2D TH 5D 2C\r
+2D 6H 6D 2S JC QH AS 7H 4H KH\r
+5H 6S KS AD TC TS 7C AC 4S 4H\r
+AD 3C 4H QS 8C 9D KS 2H 2D 4D\r
+4S 9D 6C 6D 9C AC 8D 3H 7H KD\r
+JC AH 6C TS JD 6D AD 3S 5D QD\r
+JC JH JD 3S 7S 8S JS QC 3H 4S\r
+JD TH 5C 2C AD JS 7H 9S 2H 7S\r
+8D 3S JH 4D QC AS JD 2C KC 6H\r
+2C AC 5H KD 5S 7H QD JH AH 2D\r
+JC QH 8D 8S TC 5H 5C AH 8C 6C\r
+3H JS 8S QD JH 3C 4H 6D 5C 3S\r
+6D 4S 4C AH 5H 5S 3H JD 7C 8D\r
+8H AH 2H 3H JS 3C 7D QC 4H KD\r
+6S 2H KD 5H 8H 2D 3C 8S 7S QD\r
+2S 7S KC QC AH TC QS 6D 4C 8D\r
+5S 9H 2C 3S QD 7S 6C 2H 7C 9D\r
+3C 6C 5C 5S JD JC KS 3S 5D TS\r
+7C KS 6S 5S 2S 2D TC 2H 5H QS\r
+AS 7H 6S TS 5H 9S 9D 3C KD 2H\r
+4S JS QS 3S 4H 7C 2S AC 6S 9D\r
+8C JH 2H 5H 7C 5D QH QS KH QC\r
+3S TD 3H 7C KC 8D 5H 8S KH 8C\r
+4H KH JD TS 3C 7H AS QC JS 5S\r
+AH 9D 2C 8D 4D 2D 6H 6C KC 6S\r
+2S 6H 9D 3S 7H 4D KH 8H KD 3D\r
+9C TC AC JH KH 4D JD 5H TD 3S\r
+7S 4H 9D AS 4C 7D QS 9S 2S KH\r
+3S 8D 8S KS 8C JC 5C KH 2H 5D\r
+8S QH 2C 4D KC JS QC 9D AC 6H\r
+8S 8C 7C JS JD 6S 4C 9C AC 4S\r
+QH 5D 2C 7D JC 8S 2D JS JH 4C\r
+JS 4C 7S TS JH KC KH 5H QD 4S\r
+QD 8C 8D 2D 6S TD 9D AC QH 5S\r
+QH QC JS 3D 3C 5C 4H KH 8S 7H\r
+7C 2C 5S JC 8S 3H QC 5D 2H KC\r
+5S 8D KD 6H 4H QD QH 6D AH 3D\r
+7S KS 6C 2S 4D AC QS 5H TS JD\r
+7C 2D TC 5D QS AC JS QC 6C KC\r
+2C KS 4D 3H TS 8S AD 4H 7S 9S\r
+QD 9H QH 5H 4H 4D KH 3S JC AD\r
+4D AC KC 8D 6D 4C 2D KH 2C JD\r
+2C 9H 2D AH 3H 6D 9C 7D TC KS\r
+8C 3H KD 7C 5C 2S 4S 5H AS AH\r
+TH JD 4H KD 3H TC 5C 3S AC KH\r
+6D 7H AH 7S QC 6H 2D TD JD AS\r
+JH 5D 7H TC 9S 7D JC AS 5S KH\r
+2H 8C AD TH 6H QD KD 9H 6S 6C\r
+QH KC 9D 4D 3S JS JH 4H 2C 9H\r
+TC 7H KH 4H JC 7D 9S 3H QS 7S\r
+AD 7D JH 6C 7H 4H 3S 3H 4D QH\r
+JD 2H 5C AS 6C QC 4D 3C TC JH\r
+AC JD 3H 6H 4C JC AD 7D 7H 9H\r
+4H TC TS 2C 8C 6S KS 2H JD 9S\r
+4C 3H QS QC 9S 9H 6D KC 9D 9C\r
+5C AD 8C 2C QH TH QD JC 8D 8H\r
+QC 2C 2S QD 9C 4D 3S 8D JH QS\r
+9D 3S 2C 7S 7C JC TD 3C TC 9H\r
+3C TS 8H 5C 4C 2C 6S 8D 7C 4H\r
+KS 7H 2H TC 4H 2C 3S AS AH QS\r
+8C 2D 2H 2C 4S 4C 6S 7D 5S 3S\r
+TH QC 5D TD 3C QS KD KC KS AS\r
+4D AH KD 9H KS 5C 4C 6H JC 7S\r
+KC 4H 5C QS TC 2H JC 9S AH QH\r
+4S 9H 3H 5H 3C QD 2H QC JH 8H\r
+5D AS 7H 2C 3D JH 6H 4C 6S 7D\r
+9C JD 9H AH JS 8S QH 3H KS 8H\r
+3S AC QC TS 4D AD 3D AH 8S 9H\r
+7H 3H QS 9C 9S 5H JH JS AH AC\r
+8D 3C JD 2H AC 9C 7H 5S 4D 8H\r
+7C JH 9H 6C JS 9S 7H 8C 9D 4H\r
+2D AS 9S 6H 4D JS JH 9H AD QD\r
+6H 7S JH KH AH 7H TD 5S 6S 2C\r
+8H JH 6S 5H 5S 9D TC 4C QC 9S\r
+7D 2C KD 3H 5H AS QD 7H JS 4D\r
+TS QH 6C 8H TH 5H 3C 3H 9C 9D\r
+AD KH JS 5D 3H AS AC 9S 5C KC\r
+2C KH 8C JC QS 6D AH 2D KC TC\r
+9D 3H 2S 7C 4D 6D KH KS 8D 7D\r
+9H 2S TC JH AC QC 3H 5S 3S 8H\r
+3S AS KD 8H 4C 3H 7C JH QH TS\r
+7S 6D 7H 9D JH 4C 3D 3S 6C AS\r
+4S 2H 2C 4C 8S 5H KC 8C QC QD\r
+3H 3S 6C QS QC 2D 6S 5D 2C 9D\r
+2H 8D JH 2S 3H 2D 6C 5C 7S AD\r
+9H JS 5D QH 8S TS 2H 7S 6S AD\r
+6D QC 9S 7H 5H 5C 7D KC JD 4H\r
+QC 5S 9H 9C 4D 6S KS 2S 4C 7C\r
+9H 7C 4H 8D 3S 6H 5C 8H JS 7S\r
+2D 6H JS TD 4H 4D JC TH 5H KC\r
+AC 7C 8D TH 3H 9S 2D 4C KC 4D\r
+KD QS 9C 7S 3D KS AD TS 4C 4H\r
+QH 9C 8H 2S 7D KS 7H 5D KD 4C\r
+9C 2S 2H JC 6S 6C TC QC JH 5C\r
+7S AC 8H KC 8S 6H QS JC 3D 6S\r
+JS 2D JH 8C 4S 6H 8H 6D 5D AD\r
+6H 7D 2S 4H 9H 7C AS AC 8H 5S\r
+3C JS 4S 6D 5H 2S QH 6S 9C 2C\r
+3D 5S 6S 9S 4C QS 8D QD 8S TC\r
+9C 3D AH 9H 5S 2C 7D AD JC 3S\r
+7H TC AS 3C 6S 6D 7S KH KC 9H\r
+3S TC 8H 6S 5H JH 8C 7D AC 2S\r
+QD 9D 9C 3S JC 8C KS 8H 5D 4D\r
+JS AH JD 6D 9D 8C 9H 9S 8H 3H\r
+2D 6S 4C 4D 8S AD 4S TC AH 9H\r
+TS AC QC TH KC 6D 4H 7S 8C 2H\r
+3C QD JS 9D 5S JC AH 2H TS 9H\r
+3H 4D QH 5D 9C 5H 7D 4S JC 3S\r
+8S TH 3H 7C 2H JD JS TS AC 8D\r
+9C 2H TD KC JD 2S 8C 5S AD 2C\r
+3D KD 7C 5H 4D QH QD TC 6H 7D\r
+7H 2C KC 5S KD 6H AH QC 7S QH\r
+6H 5C AC 5H 2C 9C 2D 7C TD 2S\r
+4D 9D AH 3D 7C JD 4H 8C 4C KS\r
+TH 3C JS QH 8H 4C AS 3D QS QC\r
+4D 7S 5H JH 6D 7D 6H JS KH 3C\r
+QD 8S 7D 2H 2C 7C JC 2S 5H 8C\r
+QH 8S 9D TC 2H AD 7C 8D QD 6S\r
+3S 7C AD 9H 2H 9S JD TS 4C 2D\r
+3S AS 4H QC 2C 8H 8S 7S TD TC\r
+JH TH TD 3S 4D 4H 5S 5D QS 2C\r
+8C QD QH TC 6D 4S 9S 9D 4H QC\r
+8C JS 9D 6H JD 3H AD 6S TD QC\r
+KC 8S 3D 7C TD 7D 8D 9H 4S 3S\r
+6C 4S 3D 9D KD TC KC KS AC 5S\r
+7C 6S QH 3D JS KD 6H 6D 2D 8C\r
+JD 2S 5S 4H 8S AC 2D 6S TS 5C\r
+5H 8C 5S 3C 4S 3D 7C 8D AS 3H\r
+AS TS 7C 3H AD 7D JC QS 6C 6H\r
+3S 9S 4C AC QH 5H 5D 9H TS 4H\r
+6C 5C 7H 7S TD AD JD 5S 2H 2S\r
+7D 6C KC 3S JD 8D 8S TS QS KH\r
+8S QS 8D 6C TH AC AH 2C 8H 9S\r
+7H TD KH QH 8S 3D 4D AH JD AS\r
+TS 3D 2H JC 2S JH KH 6C QC JS\r
+KC TH 2D 6H 7S 2S TC 8C 9D QS\r
+3C 9D 6S KH 8H 6D 5D TH 2C 2H\r
+6H TC 7D AD 4D 8S TS 9H TD 7S\r
+JS 6D JD JC 2H AC 6C 3D KH 8D\r
+KH JD 9S 5D 4H 4C 3H 7S QS 5C\r
+4H JD 5D 3S 3C 4D KH QH QS 7S\r
+JD TS 8S QD AH 4C 6H 3S 5S 2C\r
+QS 3D JD AS 8D TH 7C 6S QC KS\r
+7S 2H 8C QC 7H AC 6D 2D TH KH\r
+5S 6C 7H KH 7D AH 8C 5C 7S 3D\r
+3C KD AD 7D 6C 4D KS 2D 8C 4S\r
+7C 8D 5S 2D 2S AH AD 2C 9D TD\r
+3C AD 4S KS JH 7C 5C 8C 9C TH\r
+AS TD 4D 7C JD 8C QH 3C 5H 9S\r
+3H 9C 8S 9S 6S QD KS AH 5H JH\r
+QC 9C 5S 4H 2H TD 7D AS 8C 9D\r
+8C 2C 9D KD TC 7S 3D KH QC 3C\r
+4D AS 4C QS 5S 9D 6S JD QH KS\r
+6D AH 6C 4C 5H TS 9H 7D 3D 5S\r
+QS JD 7C 8D 9C AC 3S 6S 6C KH\r
+8H JH 5D 9S 6D AS 6S 3S QC 7H\r
+QD AD 5C JH 2H AH 4H AS KC 2C\r
+JH 9C 2C 6H 2D JS 5D 9H KC 6D\r
+7D 9D KD TH 3H AS 6S QC 6H AD\r
+JD 4H 7D KC 3H JS 3C TH 3D QS\r
+4C 3H 8C QD 5H 6H AS 8H AD JD\r
+TH 8S KD 5D QC 7D JS 5S 5H TS\r
+7D KC 9D QS 3H 3C 6D TS 7S AH\r
+7C 4H 7H AH QC AC 4D 5D 6D TH\r
+3C 4H 2S KD 8H 5H JH TC 6C JD\r
+4S 8C 3D 4H JS TD 7S JH QS KD\r
+7C QC KD 4D 7H 6S AD TD TC KH\r
+5H 9H KC 3H 4D 3D AD 6S QD 6H\r
+TH 7C 6H TS QH 5S 2C KC TD 6S\r
+7C 4D 5S JD JH 7D AC KD KH 4H\r
+7D 6C 8D 8H 5C JH 8S QD TH JD\r
+8D 7D 6C 7C 9D KD AS 5C QH JH\r
+9S 2C 8C 3C 4C KS JH 2D 8D 4H\r
+7S 6C JH KH 8H 3H 9D 2D AH 6D\r
+4D TC 9C 8D 7H TD KS TH KD 3C\r
+JD 9H 8D QD AS KD 9D 2C 2S 9C\r
+8D 3H 5C 7H KS 5H QH 2D 8C 9H\r
+2D TH 6D QD 6C KC 3H 3S AD 4C\r
+4H 3H JS 9D 3C TC 5H QH QC JC\r
+3D 5C 6H 3S 3C JC 5S 7S 2S QH\r
+AC 5C 8C 4D 5D 4H 2S QD 3C 3H\r
+2C TD AH 9C KD JS 6S QD 4C QC\r
+QS 8C 3S 4H TC JS 3H 7C JC AD\r
+5H 4D 9C KS JC TD 9S TS 8S 9H\r
+QD TS 7D AS AC 2C TD 6H 8H AH\r
+6S AD 8C 4S 9H 8D 9D KH 8S 3C\r
+QS 4D 2D 7S KH JS JC AD 4C 3C\r
+QS 9S 7H KC TD TH 5H JS AC JH\r
+6D AC 2S QS 7C AS KS 6S KH 5S\r
+6D 8H KH 3C QS 2H 5C 9C 9D 6C\r
+JS 2C 4C 6H 7D JC AC QD TD 3H\r
+4H QC 8H JD 4C KD KS 5C KC 7S\r
+6D 2D 3H 2S QD 5S 7H AS TH 6S\r
+AS 6D 8D 2C 8S TD 8H QD JC AH\r
+9C 9H 2D TD QH 2H 5C TC 3D 8H\r
+KC 8S 3D KH 2S TS TC 6S 4D JH\r
+9H 9D QS AC KC 6H 5D 4D 8D AH\r
+9S 5C QS 4H 7C 7D 2H 8S AD JS\r
+3D AC 9S AS 2C 2D 2H 3H JC KH\r
+7H QH KH JD TC KS 5S 8H 4C 8D\r
+2H 7H 3S 2S 5H QS 3C AS 9H KD\r
+AD 3D JD 6H 5S 9C 6D AC 9S 3S\r
+3D 5D 9C 2D AC 4S 2S AD 6C 6S\r
+QC 4C 2D 3H 6S KC QH QD 2H JH\r
+QC 3C 8S 4D 9S 2H 5C 8H QS QD\r
+6D KD 6S 7H 3S KH 2H 5C JC 6C\r
+3S 9S TC 6S 8H 2D AD 7S 8S TS\r
+3C 6H 9C 3H 5C JC 8H QH TD QD\r
+3C JS QD 5D TD 2C KH 9H TH AS\r
+9S TC JD 3D 5C 5H AD QH 9H KC\r
+TC 7H 4H 8H 3H TD 6S AC 7C 2S\r
+QS 9D 5D 3C JC KS 4D 6C JH 2S\r
+9S 6S 3C 7H TS 4C KD 6D 3D 9C\r
+2D 9H AH AC 7H 2S JH 3S 7C QC\r
+QD 9H 3C 2H AC AS 8S KD 8C KH\r
+2D 7S TD TH 6D JD 8D 4D 2H 5S\r
+8S QH KD JD QS JH 4D KC 5H 3S\r
+3C KH QC 6D 8H 3S AH 7D TD 2D\r
+5S 9H QH 4S 6S 6C 6D TS TH 7S\r
+6C 4C 6D QS JS 9C TS 3H 8D 8S\r
+JS 5C 7S AS 2C AH 2H AD 5S TC\r
+KD 6C 9C 9D TS 2S JC 4H 2C QD\r
+QS 9H TC 3H KC KS 4H 3C AD TH\r
+KH 9C 2H KD 9D TC 7S KC JH 2D\r
+7C 3S KC AS 8C 5D 9C 9S QH 3H\r
+2D 8C TD 4C 2H QC 5D TC 2C 7D\r
+KS 4D 6C QH TD KH 5D 7C AD 8D\r
+2S 9S 8S 4C 8C 3D 6H QD 7C 7H\r
+6C 8S QH 5H TS 5C 3C 4S 2S 2H\r
+8S 6S 2H JC 3S 3H 9D 8C 2S 7H\r
+QC 2C 8H 9C AC JD 4C 4H 6S 3S\r
+3H 3S 7D 4C 9S 5H 8H JC 3D TC\r
+QH 2S 2D 9S KD QD 9H AD 6D 9C\r
+8D 2D KS 9S JC 4C JD KC 4S TH\r
+KH TS 6D 4D 5C KD 5H AS 9H AD\r
+QD JS 7C 6D 5D 5C TH 5H QH QS\r
+9D QH KH 5H JH 4C 4D TC TH 6C\r
+KH AS TS 9D KD 9C 7S 4D 8H 5S\r
+KH AS 2S 7D 9D 4C TS TH AH 7C\r
+KS 4D AC 8S 9S 8D TH QH 9D 5C\r
+5D 5C 8C QS TC 4C 3D 3S 2C 8D\r
+9D KS 2D 3C KC 4S 8C KH 6C JC\r
+8H AH 6H 7D 7S QD 3C 4C 6C KC\r
+3H 2C QH 8H AS 7D 4C 8C 4H KC\r
+QD 5S 4H 2C TD AH JH QH 4C 8S\r
+3H QS 5S JS 8H 2S 9H 9C 3S 2C\r
+6H TS 7S JC QD AC TD KC 5S 3H\r
+QH AS QS 7D JC KC 2C 4C 5C 5S\r
+QH 3D AS JS 4H 8D 7H JC 2S 9C\r
+5D 4D 2S 4S 9D 9C 2D QS 8H 7H\r
+6D 7H 3H JS TS AC 2D JH 7C 8S\r
+JH 5H KC 3C TC 5S 9H 4C 8H 9D\r
+8S KC 5H 9H AD KS 9D KH 8D AH\r
+JC 2H 9H KS 6S 3H QC 5H AH 9C\r
+5C KH 5S AD 6C JC 9H QC 9C TD\r
+5S 5D JC QH 2D KS 8H QS 2H TS\r
+JH 5H 5S AH 7H 3C 8S AS TD KH\r
+6H 3D JD 2C 4C KC 7S AH 6C JH\r
+4C KS 9D AD 7S KC 7D 8H 3S 9C\r
+7H 5C 5H 3C 8H QC 3D KH 6D JC\r
+2D 4H 5D 7D QC AD AH 9H QH 8H\r
+KD 8C JS 9D 3S 3C 2H 5D 6D 2S\r
+8S 6S TS 3C 6H 8D 5S 3H TD 6C\r
+KS 3D JH 9C 7C 9S QS 5S 4H 6H\r
+7S 6S TH 4S KC KD 3S JC JH KS\r
+7C 3C 2S 6D QH 2C 7S 5H 8H AH\r
+KC 8D QD 6D KH 5C 7H 9D 3D 9C\r
+6H 2D 8S JS 9S 2S 6D KC 7C TC\r
+KD 9C JH 7H KC 8S 2S 7S 3D 6H\r
+4H 9H 2D 4C 8H 7H 5S 8S 2H 8D\r
+AD 7C 3C 7S 5S 4D 9H 3D JC KH\r
+5D AS 7D 6D 9C JC 4C QH QS KH\r
+KD JD 7D 3D QS QC 8S 6D JS QD\r
+6S 8C 5S QH TH 9H AS AC 2C JD\r
+QC KS QH 7S 3C 4C 5C KC 5D AH\r
+6C 4H 9D AH 2C 3H KD 3D TS 5C\r
+TD 8S QS AS JS 3H KD AC 4H KS\r
+7D 5D TS 9H 4H 4C 9C 2H 8C QC\r
+2C 7D 9H 4D KS 4C QH AD KD JS\r
+QD AD AH KH 9D JS 9H JC KD JD\r
+8S 3C 4S TS 7S 4D 5C 2S 6H 7C\r
+JS 7S 5C KD 6D QH 8S TD 2H 6S\r
+QH 6C TC 6H TD 4C 9D 2H QC 8H\r
+3D TS 4D 2H 6H 6S 2C 7H 8S 6C\r
+9H 9D JD JH 3S AH 2C 6S 3H 8S\r
+2C QS 8C 5S 3H 2S 7D 3C AD 4S\r
+5C QC QH AS TS 4S 6S 4C 5H JS\r
+JH 5C TD 4C 6H JS KD KH QS 4H\r
+TC KH JC 4D 9H 9D 8D KC 3C 8H\r
+2H TC 8S AD 9S 4H TS 7H 2C 5C\r
+4H 2S 6C 5S KS AH 9C 7C 8H KD\r
+TS QH TD QS 3C JH AH 2C 8D 7D\r
+5D KC 3H 5S AC 4S 7H QS 4C 2H\r
+3D 7D QC KH JH 6D 6C TD TH KD\r
+5S 8D TH 6C 9D 7D KH 8C 9S 6D\r
+JD QS 7S QC 2S QH JC 4S KS 8D\r
+7S 5S 9S JD KD 9C JC AD 2D 7C\r
+4S 5H AH JH 9C 5D TD 7C 2D 6S\r
+KC 6C 7H 6S 9C QD 5S 4H KS TD\r
+6S 8D KS 2D TH TD 9H JD TS 3S\r
+KH JS 4H 5D 9D TC TD QC JD TS\r
+QS QD AC AD 4C 6S 2D AS 3H KC\r
+4C 7C 3C TD QS 9C KC AS 8D AD\r
+KC 7H QC 6D 8H 6S 5S AH 7S 8C\r
+3S AD 9H JC 6D JD AS KH 6S JH\r
+AD 3D TS KS 7H JH 2D JS QD AC\r
+9C JD 7C 6D TC 6H 6C JC 3D 3S\r
+QC KC 3S JC KD 2C 8D AH QS TS\r
+AS KD 3D JD 8H 7C 8C 5C QD 6C\r
: (sum-divisors) ( n -- sum )
dup sqrt >integer [1,b] [
- [ 2dup mod 0 = [ 2dup / + , ] [ drop ] if ] each
+ [ 2dup divisor? [ 2dup / + , ] [ drop ] if ] each
dup perfect-square? [ sqrt >fixnum neg , ] [ drop ] if
] { } make sum ;
>lower [ CHAR: a - 1+ ] sigma ;
: cartesian-product ( seq1 seq2 -- seq1xseq2 )
- swap [ swap [ 2array ] with map ] with map concat ;
+ [ [ 2array ] with map ] curry map concat ;
: log10 ( m -- n )
log 10 log / ;
: number>digits ( n -- seq )
[ dup 0 = not ] [ 10 /mod ] produce reverse nip ;
+: number-length ( n -- m )
+ log10 floor 1+ >integer ;
+
: nth-triangle ( n -- n )
dup 1+ * 2 / ;
factor-2s dup [ 1+ ]
[ perfect-square? -1 0 ? ]
[ dup sqrt >fixnum [1,b] ] tri* [
- dupd mod 0 = [ [ 2 + ] dip ] when
+ dupd divisor? [ [ 2 + ] dip ] when
] each drop * ;
! These transforms are for generating primitive Pythagorean triples
[ drop in get vocab (>>main) ]
[ [ . ] swap prefix (( -- )) define-declared ]
2bi ;
-
-! Copyright (c) 2007, 2008 Aaron Schaefer, Samuel Tardieu.
+! Copyright (c) 2007, 2008, 2009 Aaron Schaefer, Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: definitions io io.files io.pathnames kernel math math.parser
prettyprint project-euler.ave-time sequences vocabs vocabs.loader
project-euler.037 project-euler.038 project-euler.039 project-euler.040
project-euler.041 project-euler.042 project-euler.043 project-euler.044
project-euler.045 project-euler.046 project-euler.047 project-euler.048
- project-euler.052 project-euler.053 project-euler.055 project-euler.056
- project-euler.057 project-euler.059 project-euler.067 project-euler.071
- project-euler.073 project-euler.075 project-euler.076 project-euler.079
- project-euler.092 project-euler.097 project-euler.099 project-euler.100
- project-euler.116 project-euler.117 project-euler.134 project-euler.148
- project-euler.150 project-euler.151 project-euler.164 project-euler.169
- project-euler.173 project-euler.175 project-euler.186 project-euler.190
- project-euler.203 project-euler.215 ;
+ project-euler.049 project-euler.052 project-euler.053 project-euler.054
+ project-euler.055 project-euler.056 project-euler.057 project-euler.059
+ project-euler.067 project-euler.071 project-euler.073 project-euler.075
+ project-euler.076 project-euler.079 project-euler.092 project-euler.097
+ project-euler.099 project-euler.100 project-euler.116 project-euler.117
+ project-euler.134 project-euler.148 project-euler.150 project-euler.151
+ project-euler.164 project-euler.169 project-euler.173 project-euler.175
+ project-euler.186 project-euler.190 project-euler.203 project-euler.215 ;
IN: project-euler
<PRIVATE
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: strings arrays memoize kernel sequences accessors combinators ;
+IN: smalltalk.ast
+
+SINGLETONS: nil self super ;
+
+TUPLE: ast-comment { string string } ;
+TUPLE: ast-block { arguments array } { temporaries array } { body array } ;
+TUPLE: ast-message-send receiver { selector string } { arguments array } ;
+TUPLE: ast-message { selector string } { arguments array } ;
+TUPLE: ast-cascade receiver { messages array } ;
+TUPLE: ast-name { name string } ;
+TUPLE: ast-return value ;
+TUPLE: ast-assignment { name ast-name } value ;
+TUPLE: ast-local-variables { names array } ;
+TUPLE: ast-method { name string } { body ast-block } ;
+TUPLE: ast-class { name string } { superclass string } { ivars array } { methods array } ;
+TUPLE: ast-foreign { class string } { name string } ;
+TUPLE: ast-sequence { temporaries array } { body array } ;
+
+! We treat a sequence of statements like a block in a few places to
+! simplify handling of top-level forms
+M: ast-sequence arguments>> drop { } ;
+
+: unclip-temporaries ( statements -- temporaries statements' )
+ {
+ { [ dup empty? ] [ { } ] }
+ { [ dup first ast-local-variables? not ] [ { } ] }
+ [ unclip names>> ]
+ } cond swap ;
+
+: <ast-block> ( arguments body -- block )
+ unclip-temporaries ast-block boa ;
+
+: <ast-sequence> ( body -- block )
+ unclip-temporaries ast-sequence boa ;
+
+! The parser parses normal message sends as cascades with one message, but
+! we represent them differently in the AST to simplify generated code in
+! the common case
+: <ast-cascade> ( receiver messages -- ast )
+ dup length 1 =
+ [ first [ selector>> ] [ arguments>> ] bi ast-message-send boa ]
+ [ ast-cascade boa ]
+ if ;
+
+! Methods return self by default
+: <ast-method> ( class arguments body -- method )
+ self suffix <ast-block> ast-method boa ;
+
+TUPLE: symbol { name string } ;
+MEMO: intern ( name -- symbol ) symbol boa ;
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel namespaces assocs accessors words sequences classes.tuple ;
+IN: smalltalk.classes
+
+SYMBOL: classes
+
+classes [ H{ } clone ] initialize
+
+: create-class ( class -- class )
+ "smalltalk.classes" create ;
+
+ERROR: no-class name ;
+
+: lookup-class ( class -- class )
+ classes get ?at [ ] [ no-class ] if ;
+
+: define-class ( class superclass ivars -- class-word )
+ [ create-class ] [ lookup-class ] [ ] tri*
+ [ define-tuple-class ] [ 2drop dup dup name>> classes get set-at ] 3bi ;
+
+: define-foreign ( class name -- )
+ classes get set-at ;
+
+tuple "Object" define-foreign
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays kernel sequences sets smalltalk.ast ;
+IN: smalltalk.compiler.assignment
+
+GENERIC: assigned-locals ( ast -- seq )
+
+M: ast-return assigned-locals value>> assigned-locals ;
+
+M: ast-block assigned-locals
+ [ body>> assigned-locals ] [ arguments>> ] bi diff ;
+
+M: ast-message-send assigned-locals
+ [ receiver>> assigned-locals ]
+ [ arguments>> assigned-locals ]
+ bi append ;
+
+M: ast-cascade assigned-locals
+ [ receiver>> assigned-locals ]
+ [ messages>> assigned-locals ]
+ bi append ;
+
+M: ast-message assigned-locals
+ arguments>> assigned-locals ;
+
+M: ast-assignment assigned-locals
+ [ name>> dup ast-name? [ name>> 1array ] [ drop { } ] if ]
+ [ value>> assigned-locals ] bi append ;
+
+M: ast-sequence assigned-locals
+ body>> assigned-locals ;
+
+M: array assigned-locals
+ [ assigned-locals ] map concat ;
+
+M: object assigned-locals drop f ;
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+USING: smalltalk.compiler tools.test prettyprint smalltalk.ast
+smalltalk.compiler.lexenv stack-checker locals.rewrite.closures
+kernel accessors compiler.units sequences arrays ;
+IN: smalltalk.compiler.tests
+
+: test-compilation ( ast -- quot )
+ [
+ 1array ast-sequence new swap >>body
+ compile-smalltalk [ call ] append
+ ] with-compilation-unit ;
+
+: test-inference ( ast -- in# out# )
+ test-compilation infer [ in>> ] [ out>> ] bi ;
+
+[ 2 1 ] [
+ T{ ast-block f
+ { "a" "b" }
+ {
+ T{ ast-message-send f
+ T{ ast-name f "a" }
+ "+"
+ { T{ ast-name f "b" } }
+ }
+ }
+ } test-inference
+] unit-test
+
+[ 3 1 ] [
+ T{ ast-block f
+ { "a" "b" "c" }
+ {
+ T{ ast-assignment f
+ T{ ast-name f "a" }
+ T{ ast-message-send f
+ T{ ast-name f "c" }
+ "+"
+ { T{ ast-name f "b" } }
+ }
+ }
+ T{ ast-message-send f
+ T{ ast-name f "b" }
+ "blah:"
+ { 123.456 }
+ }
+ T{ ast-return f T{ ast-name f "c" } }
+ }
+ } test-inference
+] unit-test
+
+[ 0 1 ] [
+ T{ ast-block f
+ { }
+ { }
+ {
+ T{ ast-message-send
+ { receiver 1 }
+ { selector "to:do:" }
+ { arguments
+ {
+ 10
+ T{ ast-block
+ { arguments { "i" } }
+ { body
+ {
+ T{ ast-message-send
+ { receiver
+ T{ ast-name { name "i" } }
+ }
+ { selector "print" }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ } test-inference
+] unit-test
+
+[ "a" ] [
+ T{ ast-block f
+ { }
+ { }
+ { { T{ ast-block { body { "a" } } } } }
+ } test-compilation call first call
+] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs combinators.short-circuit
+continuations fry kernel namespaces quotations sequences sets
+generalizations slots locals.types splitting math
+locals.rewrite.closures generic words combinators locals smalltalk.ast
+smalltalk.compiler.lexenv smalltalk.compiler.assignment
+smalltalk.compiler.return smalltalk.selectors smalltalk.classes ;
+IN: smalltalk.compiler
+
+GENERIC: compile-ast ( lexenv ast -- quot )
+
+M: object compile-ast nip 1quotation ;
+
+M: self compile-ast drop self>> 1quotation ;
+
+ERROR: unbound-local name ;
+
+M: ast-name compile-ast name>> swap lookup-reader ;
+
+: compile-arguments ( lexenv ast -- quot )
+ arguments>> [ compile-ast ] with map [ ] join ;
+
+: compile-new ( lexenv ast -- quot )
+ [ receiver>> compile-ast ]
+ [ compile-arguments ] 2bi
+ [ new ] 3append ;
+
+: compile-ifTrue:ifFalse: ( lexenv ast -- quot )
+ [ receiver>> compile-ast ]
+ [ compile-arguments ] 2bi
+ [ if ] 3append ;
+
+M: ast-message-send compile-ast
+ dup selector>> {
+ { "ifTrue:ifFalse:" [ compile-ifTrue:ifFalse: ] }
+ { "new" [ compile-new ] }
+ [
+ drop
+ [ compile-arguments ]
+ [ receiver>> compile-ast ]
+ [ nip selector>> selector>generic ]
+ 2tri [ append ] dip suffix
+ ]
+ } case ;
+
+M: ast-cascade compile-ast
+ [ receiver>> compile-ast ]
+ [
+ messages>> [
+ [ compile-arguments \ dip ]
+ [ selector>> selector>generic ] bi
+ [ ] 3sequence
+ ] with map
+ unclip-last [ [ [ drop ] append ] map ] dip suffix
+ cleave>quot
+ ] 2bi append ;
+
+M: ast-return compile-ast
+ [ value>> compile-ast ] [ drop return>> 1quotation ] 2bi
+ [ continue-with ] 3append ;
+
+: (compile-sequence) ( lexenv asts -- quot )
+ [ drop [ nil ] ] [
+ [ compile-ast ] with map [ drop ] join
+ ] if-empty ;
+
+: block-lexenv ( block -- lexenv )
+ [ [ arguments>> ] [ temporaries>> ] bi append ]
+ [ body>> [ assigned-locals ] map concat unique ] bi
+ '[
+ dup dup _ key?
+ [ <local-reader> ]
+ [ <local> ]
+ if
+ ] H{ } map>assoc
+ dup
+ [ nip local-reader? ] assoc-filter
+ [ <local-writer> ] assoc-map
+ <lexenv> swap >>local-writers swap >>local-readers ;
+
+: lookup-block-vars ( vars lexenv -- seq )
+ local-readers>> '[ _ at ] map ;
+
+: make-temporaries ( block lexenv -- quot )
+ [ temporaries>> ] dip lookup-block-vars
+ [ <def> [ f ] swap suffix ] map [ ] join ;
+
+:: compile-sequence ( lexenv block -- vars quot )
+ lexenv block block-lexenv lexenv-union :> lexenv
+ block arguments>> lexenv lookup-block-vars
+ lexenv block body>> (compile-sequence) block lexenv make-temporaries prepend ;
+
+M: ast-sequence compile-ast
+ compile-sequence nip ;
+
+GENERIC: contains-blocks? ( obj -- ? )
+
+M: ast-block contains-blocks? drop t ;
+
+M: object contains-blocks? drop f ;
+
+M: array contains-blocks? [ contains-blocks? ] any? ;
+
+M: array compile-ast
+ dup contains-blocks? [
+ [ [ compile-ast ] with map [ ] join ] [ length ] bi
+ '[ @ _ narray ]
+ ] [ call-next-method ] if ;
+
+GENERIC: compile-assignment ( lexenv name -- quot )
+
+M: ast-name compile-assignment name>> swap lookup-writer ;
+
+M: ast-assignment compile-ast
+ [ value>> compile-ast [ dup ] ] [ name>> compile-assignment ] 2bi 3append ;
+
+M: ast-block compile-ast
+ compile-sequence <lambda> '[ _ ] ;
+
+:: (compile-method-body) ( lexenv block -- lambda )
+ lexenv block compile-sequence
+ [ lexenv self>> suffix ] dip <lambda> ;
+
+: compile-method-body ( lexenv block -- quot )
+ [ [ (compile-method-body) ] [ arguments>> length 1+ ] bi ] 2keep
+ make-return ;
+
+: compile-method ( lexenv ast-method -- )
+ [ [ class>> ] [ name>> selector>generic ] bi* create-method ]
+ [ body>> compile-method-body ]
+ 2bi define ;
+
+: <class-lexenv> ( class -- lexenv )
+ <lexenv> swap >>class "self" <local> >>self "^" <local> >>return ;
+
+M: ast-class compile-ast
+ nip
+ [
+ [ name>> ] [ superclass>> ] [ ivars>> ] tri
+ define-class <class-lexenv>
+ ]
+ [ methods>> ] bi
+ [ compile-method ] with each
+ [ nil ] ;
+
+ERROR: no-word name ;
+
+M: ast-foreign compile-ast
+ nip
+ [ class>> dup ":" split1 lookup [ ] [ no-word ] ?if ]
+ [ name>> ] bi define-foreign
+ [ nil ] ;
+
+: compile-smalltalk ( statement -- quot )
+ [ empty-lexenv ] dip [ compile-sequence nip 0 ]
+ 2keep make-return ;
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+USING: smalltalk.compiler.lexenv tools.test kernel namespaces accessors ;
+IN: smalltalk.compiler.lexenv.tests
+
+TUPLE: some-class x y z ;
+
+SYMBOL: fake-self
+
+SYMBOL: fake-local
+
+<lexenv>
+ some-class >>class
+ fake-self >>self
+ H{ { "mumble" fake-local } } >>local-readers
+ H{ { "jumble" fake-local } } >>local-writers
+lexenv set
+
+[ [ fake-local ] ] [ "mumble" lexenv get lookup-reader ] unit-test
+[ [ fake-self x>> ] ] [ "x" lexenv get lookup-reader ] unit-test
+[ [ \ tuple ] ] [ "Object" lexenv get lookup-reader ] unit-test
+
+[ [ fake-local ] ] [ "jumble" lexenv get lookup-writer ] unit-test
+[ [ fake-self (>>y) ] ] [ "y" lexenv get lookup-writer ] unit-test
+
+[ "blahblah" lexenv get lookup-writer ] must-fail
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs kernel accessors quotations slots words
+sequences namespaces combinators combinators.short-circuit
+summary smalltalk.classes ;
+IN: smalltalk.compiler.lexenv
+
+! local-readers: assoc string => word
+! local-writers: assoc string => word
+! self: word or f for top-level forms
+! class: class word or f for top-level forms
+! method: generic word or f for top-level forms
+TUPLE: lexenv local-readers local-writers self return class method ;
+
+: <lexenv> ( -- lexenv ) lexenv new ; inline
+
+CONSTANT: empty-lexenv T{ lexenv }
+
+: lexenv-union ( lexenv1 lexenv2 -- lexenv )
+ [ <lexenv> ] 2dip {
+ [ [ local-readers>> ] bi@ assoc-union >>local-readers ]
+ [ [ local-writers>> ] bi@ assoc-union >>local-writers ]
+ [ [ self>> ] either? >>self ]
+ [ [ return>> ] either? >>return ]
+ [ [ class>> ] either? >>class ]
+ [ [ method>> ] either? >>method ]
+ } 2cleave ;
+
+: local-reader ( name lexenv -- local )
+ local-readers>> at dup [ 1quotation ] when ;
+
+: ivar-reader ( name lexenv -- quot/f )
+ dup class>> [
+ [ class>> "slots" word-prop slot-named ] [ self>> ] bi
+ swap dup [ name>> reader-word [ ] 2sequence ] [ 2drop f ] if
+ ] [ 2drop f ] if ;
+
+: class-name ( name -- quot/f )
+ classes get at dup [ [ ] curry ] when ;
+
+ERROR: bad-identifier name ;
+
+M: bad-identifier summary drop "Unknown identifier" ;
+
+: lookup-reader ( name lexenv -- reader-quot )
+ {
+ [ local-reader ]
+ [ ivar-reader ]
+ [ drop class-name ]
+ [ drop bad-identifier ]
+ } 2|| ;
+
+: local-writer ( name lexenv -- local )
+ local-writers>> at dup [ 1quotation ] when ;
+
+: ivar-writer ( name lexenv -- quot/f )
+ dup class>> [
+ [ class>> "slots" word-prop slot-named ] [ self>> ] bi
+ swap dup [ name>> writer-word [ ] 2sequence ] [ 2drop f ] if
+ ] [ 2drop f ] if ;
+
+: lookup-writer ( name lexenv -- writer-quot )
+ {
+ [ local-writer ]
+ [ ivar-writer ]
+ [ drop bad-identifier ]
+ } 2|| ;
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+USING: smalltalk.parser smalltalk.compiler.return tools.test ;
+
+[ t ] [ "(i <= 1) ifTrue: [^1] ifFalse: [^((Fib new i:(i-1)) compute + (Fib new i:(i-2)) compute)]" parse-smalltalk need-return-continuation? ] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays combinators.short-circuit continuations
+fry generalizations kernel locals locals.types locals.rewrite.closures
+namespaces make sequences smalltalk.ast ;
+IN: smalltalk.compiler.return
+
+SYMBOL: return-continuation
+
+GENERIC: need-return-continuation? ( ast -- ? )
+
+M: ast-return need-return-continuation? drop t ;
+
+M: ast-block need-return-continuation? body>> need-return-continuation? ;
+
+M: ast-message-send need-return-continuation?
+ {
+ [ receiver>> need-return-continuation? ]
+ [ arguments>> need-return-continuation? ]
+ } 1|| ;
+
+M: ast-cascade need-return-continuation?
+ {
+ [ receiver>> need-return-continuation? ]
+ [ messages>> need-return-continuation? ]
+ } 1|| ;
+
+M: ast-message need-return-continuation?
+ arguments>> need-return-continuation? ;
+
+M: ast-assignment need-return-continuation?
+ value>> need-return-continuation? ;
+
+M: ast-sequence need-return-continuation?
+ body>> need-return-continuation? ;
+
+M: array need-return-continuation? [ need-return-continuation? ] any? ;
+
+M: object need-return-continuation? drop f ;
+
+:: make-return ( quot n lexenv block -- quot )
+ block need-return-continuation? [
+ quot clone [ lexenv return>> <def> '[ _ ] prepend ] change-body
+ n '[ _ _ ncurry callcc1 ]
+ ] [ quot ] if rewrite-closures first ;
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+IN: smalltalk.eval.tests
+USING: smalltalk.eval tools.test io.streams.string kernel ;
+
+[ 3 ] [ "1+2" eval-smalltalk ] unit-test
+[ "HAI" ] [ "(1<10) ifTrue:['HAI'] ifFalse:['BAI']" eval-smalltalk ] unit-test
+[ 7 ] [ "1+2+3;+4" eval-smalltalk ] unit-test
+[ 6 "5\n6\n" ] [ [ "[:x|x print] value: 5; value: 6" eval-smalltalk ] with-string-writer ] unit-test
+[ 5 ] [ "|x| x:=5. x" eval-smalltalk ] unit-test
+[ 11 ] [ "[:i| |x| x:=5. i+x] value: 6" eval-smalltalk ] unit-test
+[ t ] [ "class Blah [method foo [5]]. Blah new foo" eval-smalltalk tuple? ] unit-test
+[ 196418 ] [ "vocab:smalltalk/eval/fib.st" eval-smalltalk-file ] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.files io.encodings.utf8
+compiler.units smalltalk.parser smalltalk.compiler
+smalltalk.library ;
+IN: smalltalk.eval
+
+: eval-smalltalk ( string -- result )
+ [ parse-smalltalk compile-smalltalk ] with-compilation-unit
+ call( -- result ) ;
+
+: eval-smalltalk-file ( path -- result )
+ utf8 file-contents eval-smalltalk ;
--- /dev/null
+class Fib [
+ |i|
+ method i: newI [i:=newI].
+ method compute [
+ (i <= 1)
+ ifTrue: [^1]
+ ifFalse: [^((Fib new i:(i-1)) compute + (Fib new i:(i-2)) compute)]
+ ].
+].
+
+[(Fib new i: 26) compute] time
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel present io math sequences assocs math.ranges
+math.order fry tools.time locals smalltalk.selectors
+smalltalk.ast smalltalk.classes ;
+IN: smalltalk.library
+
+SELECTOR: print
+SELECTOR: asString
+
+M: object selector-print dup present print ;
+M: object selector-asString present ;
+
+SELECTOR: print:
+SELECTOR: nextPutAll:
+SELECTOR: tab
+SELECTOR: nl
+
+M: object selector-print: [ present ] dip stream-print nil ;
+M: object selector-nextPutAll: selector-print: ;
+M: object selector-tab " " swap selector-print: ;
+M: object selector-nl stream-nl nil ;
+
+SELECTOR: +
+SELECTOR: -
+SELECTOR: *
+SELECTOR: /
+SELECTOR: <
+SELECTOR: >
+SELECTOR: <=
+SELECTOR: >=
+SELECTOR: =
+
+M: object selector-+ swap + ;
+M: object selector-- swap - ;
+M: object selector-* swap * ;
+M: object selector-/ swap / ;
+M: object selector-< swap < ;
+M: object selector-> swap > ;
+M: object selector-<= swap <= ;
+M: object selector->= swap >= ;
+M: object selector-= swap = ;
+
+SELECTOR: min:
+SELECTOR: max:
+
+M: object selector-min: min ;
+M: object selector-max: max ;
+
+SELECTOR: ifTrue:
+SELECTOR: ifFalse:
+SELECTOR: ifTrue:ifFalse:
+
+M: object selector-ifTrue: [ call( -- result ) ] [ drop nil ] if ;
+M: object selector-ifFalse: [ drop nil ] [ call( -- result ) ] if ;
+M: object selector-ifTrue:ifFalse: [ drop call( -- result ) ] [ nip call( -- result ) ] if ;
+
+SELECTOR: isNil
+
+M: object selector-isNil nil eq? ;
+
+SELECTOR: at:
+SELECTOR: at:put:
+
+M: sequence selector-at: nth ;
+M: sequence selector-at:put: ( key value receiver -- receiver ) [ swapd set-nth ] keep ;
+
+M: assoc selector-at: at ;
+M: assoc selector-at:put: ( key value receiver -- receiver ) [ swapd set-at ] keep ;
+
+SELECTOR: do:
+
+M:: object selector-do: ( quot receiver -- nil )
+ receiver [ quot call( elt -- result ) drop ] each nil ;
+
+SELECTOR: to:
+SELECTOR: to:do:
+
+M: object selector-to: swap [a,b] ;
+M:: object selector-to:do: ( to quot from -- nil )
+ from to [a,b] [ quot call( i -- result ) drop ] each nil ;
+
+SELECTOR: value
+SELECTOR: value:
+SELECTOR: value:value:
+SELECTOR: value:value:value:
+SELECTOR: value:value:value:value:
+
+M: object selector-value call( -- result ) ;
+M: object selector-value: call( input -- result ) ;
+M: object selector-value:value: call( input input -- result ) ;
+M: object selector-value:value:value: call( input input input -- result ) ;
+M: object selector-value:value:value:value: call( input input input input -- result ) ;
+
+SELECTOR: new
+
+M: object selector-new new ;
+
+SELECTOR: time
+
+M: object selector-time '[ _ call( -- result ) ] time ;
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel prettyprint io io.styles colors.constants compiler.units
+fry debugger sequences locals.rewrite.closures smalltalk.ast
+smalltalk.eval smalltalk.printer smalltalk.listener ;
+IN: smalltalk.listener
+
+: eval-interactively ( string -- )
+ '[
+ _ eval-smalltalk
+ dup nil? [ drop ] [ "Result: " write smalltalk>string print ] if
+ ] try ;
+
+: smalltalk-listener ( -- )
+ "Smalltalk>" { { background COLOR: light-blue } } format bl flush readln
+ [ eval-interactively smalltalk-listener ] when* ;
+
+MAIN: smalltalk-listener
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+IN: smalltalk.parser.tests
+USING: smalltalk.parser smalltalk.ast
+peg.ebnf tools.test accessors
+io.files io.encodings.ascii kernel ;
+
+EBNF: test-Character
+test = <foreign parse-smalltalk Character>
+;EBNF
+
+[ CHAR: a ] [ "a" test-Character ] unit-test
+
+EBNF: test-Comment
+test = <foreign parse-smalltalk Comment>
+;EBNF
+
+[ T{ ast-comment f "Hello, this is a comment." } ]
+[ "\"Hello, this is a comment.\"" test-Comment ]
+unit-test
+
+[ T{ ast-comment f "Hello, \"this\" is a comment." } ]
+[ "\"Hello, \"\"this\"\" is a comment.\"" test-Comment ]
+unit-test
+
+EBNF: test-Identifier
+test = <foreign parse-smalltalk Identifier>
+;EBNF
+
+[ "OrderedCollection" ] [ "OrderedCollection" test-Identifier ] unit-test
+
+EBNF: test-Literal
+test = <foreign parse-smalltalk Literal>
+;EBNF
+
+[ nil ] [ "nil" test-Literal ] unit-test
+[ 123 ] [ "123" test-Literal ] unit-test
+[ HEX: deadbeef ] [ "16rdeadbeef" test-Literal ] unit-test
+[ -123 ] [ "-123" test-Literal ] unit-test
+[ 1.2 ] [ "1.2" test-Literal ] unit-test
+[ -1.24 ] [ "-1.24" test-Literal ] unit-test
+[ 12.4e7 ] [ "12.4e7" test-Literal ] unit-test
+[ 12.4e-7 ] [ "12.4e-7" test-Literal ] unit-test
+[ -12.4e7 ] [ "-12.4e7" test-Literal ] unit-test
+[ CHAR: x ] [ "$x" test-Literal ] unit-test
+[ "Hello, world" ] [ "'Hello, world'" test-Literal ] unit-test
+[ "Hello, 'funny' world" ] [ "'Hello, ''funny'' world'" test-Literal ] unit-test
+[ T{ symbol f "foo" } ] [ "#foo" test-Literal ] unit-test
+[ T{ symbol f "+" } ] [ "#+" test-Literal ] unit-test
+[ T{ symbol f "at:put:" } ] [ "#at:put:" test-Literal ] unit-test
+[ T{ symbol f "Hello world" } ] [ "#'Hello world'" test-Literal ] unit-test
+[ B{ 1 2 3 4 } ] [ "#[1 2 3 4]" test-Literal ] unit-test
+[ { nil t f } ] [ "#(nil true false)" test-Literal ] unit-test
+[ { nil { t f } } ] [ "#(nil (true false))" test-Literal ] unit-test
+[ T{ ast-block f { } { } { } } ] [ "[]" test-Literal ] unit-test
+[ T{ ast-block f { "x" } { } { T{ ast-return f T{ ast-name f "x" } } } } ] [ "[ :x|^x]" test-Literal ] unit-test
+[ T{ ast-block f { } { } { T{ ast-return f self } } } ] [ "[^self]" test-Literal ] unit-test
+
+[
+ T{ ast-block
+ { arguments { "i" } }
+ { body
+ {
+ T{ ast-message-send
+ { receiver T{ ast-name { name "i" } } }
+ { selector "print" }
+ }
+ }
+ }
+ }
+]
+[ "[ :i | i print ]" test-Literal ] unit-test
+
+[
+ T{ ast-block
+ { body { 5 self } }
+ }
+]
+[ "[5. self]" test-Literal ] unit-test
+
+EBNF: test-FormalBlockArgumentDeclarationList
+test = <foreign parse-smalltalk FormalBlockArgumentDeclarationList>
+;EBNF
+
+[ V{ "x" "y" "elt" } ] [ ":x :y :elt" test-FormalBlockArgumentDeclarationList ] unit-test
+
+EBNF: test-Operand
+test = <foreign parse-smalltalk Operand>
+;EBNF
+
+[ { 123 15.6 { t f } } ] [ "#(123 15.6 (true false))" test-Operand ] unit-test
+[ T{ ast-name f "x" } ] [ "x" test-Operand ] unit-test
+
+EBNF: test-Expression
+test = <foreign parse-smalltalk Expression>
+;EBNF
+
+[ self ] [ "self" test-Expression ] unit-test
+[ { 123 15.6 { t f } } ] [ "#(123 15.6 (true false))" test-Expression ] unit-test
+[ T{ ast-name f "x" } ] [ "x" test-Expression ] unit-test
+[ T{ ast-message-send f 5 "print" { } } ] [ "5 print" test-Expression ] unit-test
+[ T{ ast-message-send f T{ ast-message-send f 5 "squared" { } } "print" { } } ] [ "5 squared print" test-Expression ] unit-test
+[ T{ ast-message-send f 2 "+" { 2 } } ] [ "2+2" test-Expression ] unit-test
+
+[
+ T{ ast-message-send f
+ T{ ast-message-send f 3 "factorial" { } }
+ "+"
+ { T{ ast-message-send f 4 "factorial" { } } }
+ }
+]
+[ "3 factorial + 4 factorial" test-Expression ] unit-test
+
+[
+ T{ ast-message-send f
+ T{ ast-message-send f 3 "factorial" { } }
+ "+"
+ { T{ ast-message-send f 4 "factorial" { } } }
+ }
+]
+[ " 3 factorial + 4 factorial" test-Expression ] unit-test
+
+[
+ T{ ast-message-send f
+ T{ ast-message-send f 3 "factorial" { } }
+ "+"
+ { T{ ast-message-send f 4 "factorial" { } } }
+ }
+]
+[ " 3 factorial + 4 factorial " test-Expression ] unit-test
+
+[
+ T{ ast-message-send f
+ T{ ast-message-send f
+ T{ ast-message-send f 3 "factorial" { } }
+ "+"
+ { 4 }
+ }
+ "factorial"
+ { }
+ }
+]
+[ "(3 factorial + 4) factorial" test-Expression ] unit-test
+
+[
+ T{ ast-message-send
+ { receiver
+ T{ ast-message-send
+ { receiver
+ T{ ast-message-send
+ { receiver 1 }
+ { selector "<" }
+ { arguments { 10 } }
+ }
+ }
+ { selector "ifTrue:ifFalse:" }
+ { arguments
+ {
+ T{ ast-block { body { "HI" } } }
+ T{ ast-block { body { "BYE" } } }
+ }
+ }
+ }
+ }
+ { selector "print" }
+ }
+]
+[ "((1 < 10) ifTrue: [ 'HI' ] ifFalse: [ 'BYE' ]) print" test-Expression ] unit-test
+
+[
+ T{ ast-cascade
+ { receiver 12 }
+ { messages
+ {
+ T{ ast-message f "sqrt" }
+ T{ ast-message f "+" { 2 } }
+ }
+ }
+ }
+]
+[ "12 sqrt; + 2" test-Expression ] unit-test
+
+[
+ T{ ast-cascade
+ { receiver T{ ast-message-send f 12 "sqrt" } }
+ { messages
+ {
+ T{ ast-message f "+" { 1 } }
+ T{ ast-message f "+" { 2 } }
+ }
+ }
+ }
+]
+[ "12 sqrt + 1; + 2" test-Expression ] unit-test
+
+[
+ T{ ast-cascade
+ { receiver T{ ast-message-send f 12 "squared" } }
+ { messages
+ {
+ T{ ast-message f "to:" { 100 } }
+ T{ ast-message f "sqrt" }
+ }
+ }
+ }
+]
+[ "12 squared to: 100; sqrt" test-Expression ] unit-test
+
+[
+ T{ ast-message-send f
+ T{ ast-message-send f 1 "+" { 2 } }
+ "*"
+ { 3 }
+ }
+]
+[ "1+2*3" test-Expression ] unit-test
+
+[
+ T{ ast-message-send
+ { receiver
+ T{ ast-message-send
+ { receiver { T{ ast-block { body { "a" } } } } }
+ { selector "at:" }
+ { arguments { 0 } }
+ }
+ }
+ { selector "value" }
+ }
+]
+[ "(#(['a']) at: 0) value" test-Expression ] unit-test
+
+EBNF: test-FinalStatement
+test = <foreign parse-smalltalk FinalStatement>
+;EBNF
+
+[ T{ ast-name f "value" } ] [ "value" test-FinalStatement ] unit-test
+[ T{ ast-return f T{ ast-name f "value" } } ] [ "^value" test-FinalStatement ] unit-test
+[ T{ ast-assignment f T{ ast-name f "value" } 5 } ] [ "value:=5" test-FinalStatement ] unit-test
+
+EBNF: test-LocalVariableDeclarationList
+test = <foreign parse-smalltalk LocalVariableDeclarationList>
+;EBNF
+
+[ T{ ast-local-variables f { "i" "j" } } ] [ " | i j |" test-LocalVariableDeclarationList ] unit-test
+
+
+[ T{ ast-message-send f T{ ast-name f "x" } "foo:bar:" { 1 2 } } ]
+[ "x foo:1 bar:2" test-Expression ] unit-test
+
+[
+ T{ ast-message-send
+ f
+ T{ ast-message-send f
+ T{ ast-message-send f 3 "factorial" { } }
+ "+"
+ { T{ ast-message-send f 4 "factorial" { } } }
+ }
+ "between:and:"
+ { 10 100 }
+ }
+]
+[ "3 factorial + 4 factorial between: 10 and: 100" test-Expression ] unit-test
+
+[ T{ ast-sequence f { } { 1 2 } } ] [ "1. 2" parse-smalltalk ] unit-test
+
+[ T{ ast-sequence f { } { 1 2 } } ] [ "1. 2." parse-smalltalk ] unit-test
+
+[
+ T{ ast-sequence f { }
+ {
+ T{ ast-class
+ { name "Test" }
+ { superclass "Object" }
+ { ivars { "a" } }
+ }
+ }
+ }
+]
+[ "class Test [|a|]" parse-smalltalk ] unit-test
+
+[
+ T{ ast-sequence f { }
+ {
+ T{ ast-class
+ { name "Test1" }
+ { superclass "Object" }
+ { ivars { "a" } }
+ }
+
+ T{ ast-class
+ { name "Test2" }
+ { superclass "Test1" }
+ { ivars { "b" } }
+ }
+ }
+ }
+]
+[ "class Test1 [|a|]. class Test2 extends Test1 [|b|]" parse-smalltalk ] unit-test
+
+[ ] [ "class Foo []. Tests blah " parse-smalltalk drop ] unit-test
+
+[ ] [ "vocab:smalltalk/parser/test.st" ascii file-contents parse-smalltalk drop ] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: peg peg.ebnf smalltalk.ast sequences sequences.deep strings
+math.parser kernel arrays byte-arrays math assocs accessors ;
+IN: smalltalk.parser
+
+! :mode=text:noTabs=true:
+
+! Based on http://chronos-st.blogspot.com/2007/12/smalltalk-in-one-page.html
+
+ERROR: bad-number str ;
+
+: check-number ( str -- n )
+ >string dup string>number [ ] [ bad-number ] ?if ;
+
+EBNF: parse-smalltalk
+
+Character = .
+WhitespaceCharacter = (" " | "\t" | "\n" | "\r" )
+DecimalDigit = [0-9]
+Letter = [A-Za-z]
+
+CommentCharacter = [^"] | '""' => [[ CHAR: " ]]
+Comment = '"' (CommentCharacter)*:s '"' => [[ s >string ast-comment boa ]]
+
+OptionalWhiteSpace = (WhitespaceCharacter | Comment)*
+Whitespace = (WhitespaceCharacter | Comment)+
+
+LetterOrDigit = DecimalDigit | Letter
+Identifier = (Letter | "_"):h (LetterOrDigit | "_")*:t => [[ { h t } flatten >string ]]
+Reference = Identifier => [[ ast-name boa ]]
+
+ConstantReference = "nil" => [[ nil ]]
+ | "false" => [[ f ]]
+ | "true" => [[ t ]]
+PseudoVariableReference = "self" => [[ self ]]
+ | "super" => [[ super ]]
+ReservedIdentifier = PseudoVariableReference | ConstantReference
+
+BindableIdentifier = Identifier
+
+UnaryMessageSelector = Identifier
+
+Keyword = Identifier:i ":" => [[ i ":" append ]]
+
+KeywordMessageSelector = Keyword+ => [[ concat ]]
+BinarySelectorChar = "~" | "!" | "@" | "%" | "&" | "*" | "-" | "+"
+ | "=" | "|" | "\" | "<" | ">" | "," | "?" | "/"
+BinaryMessageSelector = BinarySelectorChar+ => [[ concat ]]
+
+OptionalMinus = ("-" => [[ CHAR: - ]])?
+IntegerLiteral = (OptionalMinus:m UnsignedIntegerLiteral:i) => [[ i m [ neg ] when ]]
+UnsignedIntegerLiteral = Radix:r "r" BaseNIntegerLiteral:b => [[ b >string r base> ]]
+ | DecimalIntegerLiteral => [[ check-number ]]
+DecimalIntegerLiteral = DecimalDigit+
+Radix = DecimalIntegerLiteral => [[ check-number ]]
+BaseNIntegerLiteral = LetterOrDigit+
+FloatingPointLiteral = (OptionalMinus
+ DecimalIntegerLiteral
+ ("." => [[ CHAR: . ]] DecimalIntegerLiteral Exponent? | Exponent))
+ => [[ flatten check-number ]]
+Exponent = "e" => [[ CHAR: e ]] (OptionalMinus DecimalIntegerLiteral)?
+
+CharacterLiteral = "$" Character:c => [[ c ]]
+
+StringLiteral = "'" (StringLiteralCharacter | "''" => [[ CHAR: ' ]])*:s "'"
+ => [[ s >string ]]
+StringLiteralCharacter = [^']
+
+SymbolInArrayLiteral = KeywordMessageSelector
+ | UnaryMessageSelector
+ | BinaryMessageSelector
+SymbolLiteral = "#" (SymbolInArrayLiteral | StringLiteral):s => [[ s intern ]]
+
+ArrayLiteral = (ObjectArrayLiteral | ByteArrayLiteral)
+ObjectArrayLiteral = "#" NestedObjectArrayLiteral:elts => [[ elts ]]
+NestedObjectArrayLiteral = "(" OptionalWhiteSpace
+ (LiteralArrayElement:h
+ (Whitespace LiteralArrayElement:e => [[ e ]])*:t
+ => [[ t h prefix ]]
+ )?:elts OptionalWhiteSpace ")" => [[ elts >array ]]
+
+LiteralArrayElement = Literal
+ | NestedObjectArrayLiteral
+ | SymbolInArrayLiteral
+ | ConstantReference
+
+ByteArrayLiteral = "#[" OptionalWhiteSpace
+ (UnsignedIntegerLiteral:h
+ (Whitespace UnsignedIntegerLiteral:i => [[ i ]])*:t
+ => [[ t h prefix ]]
+ )?:elts OptionalWhiteSpace "]" => [[ elts >byte-array ]]
+
+FormalBlockArgumentDeclaration = ":" BindableIdentifier:i => [[ i ]]
+FormalBlockArgumentDeclarationList =
+ FormalBlockArgumentDeclaration:h
+ (Whitespace FormalBlockArgumentDeclaration:v => [[ v ]])*:t
+ => [[ t h prefix ]]
+
+BlockLiteral = "["
+ (OptionalWhiteSpace
+ FormalBlockArgumentDeclarationList:args
+ OptionalWhiteSpace
+ "|"
+ => [[ args ]]
+ )?:args
+ ExecutableCode:body
+ "]" => [[ args >array body <ast-block> ]]
+
+Literal = (ConstantReference
+ | FloatingPointLiteral
+ | IntegerLiteral
+ | CharacterLiteral
+ | StringLiteral
+ | ArrayLiteral
+ | SymbolLiteral
+ | BlockLiteral)
+
+NestedExpression = "(" Statement:s OptionalWhiteSpace ")" => [[ s ]]
+Operand = Literal
+ | PseudoVariableReference
+ | Reference
+ | NestedExpression
+
+UnaryMessage = OptionalWhiteSpace
+ UnaryMessageSelector:s !(":")
+ => [[ s { } ast-message boa ]]
+
+BinaryMessage = OptionalWhiteSpace
+ BinaryMessageSelector:selector
+ OptionalWhiteSpace
+ (UnaryMessageSend | Operand):rhs
+ => [[ selector { rhs } ast-message boa ]]
+
+KeywordMessageSegment = Keyword:k OptionalWhiteSpace (BinaryMessageSend | UnaryMessageSend | Operand):arg => [[ { k arg } ]]
+KeywordMessage = OptionalWhiteSpace
+ KeywordMessageSegment:h
+ (OptionalWhiteSpace KeywordMessageSegment:s => [[ s ]])*:t
+ => [[ t h prefix unzip [ concat ] dip ast-message boa ]]
+
+Message = BinaryMessage | UnaryMessage | KeywordMessage
+
+UnaryMessageSend = (UnaryMessageSend | Operand):lhs
+ UnaryMessage:h
+ (OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
+ => [[ lhs t h prefix >array <ast-cascade> ]]
+
+BinaryMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):lhs
+ BinaryMessage:h
+ (OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
+ => [[ lhs t h prefix >array <ast-cascade> ]]
+
+KeywordMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):lhs
+ KeywordMessage:h
+ (OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
+ => [[ lhs t h prefix >array <ast-cascade> ]]
+
+Expression = OptionalWhiteSpace
+ (KeywordMessageSend | BinaryMessageSend | UnaryMessageSend | Operand):e
+ => [[ e ]]
+
+AssignmentOperation = OptionalWhiteSpace BindableIdentifier:i
+ OptionalWhiteSpace ":=" OptionalWhiteSpace => [[ i ast-name boa ]]
+AssignmentStatement = AssignmentOperation:a Statement:s => [[ a s ast-assignment boa ]]
+Statement = ClassDeclaration | ForeignClassDeclaration | AssignmentStatement | Expression
+
+MethodReturnOperator = OptionalWhiteSpace "^"
+FinalStatement = (MethodReturnOperator Statement:s => [[ s ast-return boa ]])
+ | Statement
+
+LocalVariableDeclarationList = OptionalWhiteSpace "|" OptionalWhiteSpace
+ (BindableIdentifier:h
+ (Whitespace BindableIdentifier:b => [[ b ]])*:t
+ => [[ t h prefix ]]
+ )?:b OptionalWhiteSpace "|" => [[ b >array ast-local-variables boa ]]
+
+EndStatement = "."
+
+ExecutableCode = (LocalVariableDeclarationList)?:locals
+ (Statement:s OptionalWhiteSpace EndStatement => [[ s ]])*:h
+ (FinalStatement:t (EndStatement)? => [[ t ]])?:t
+ OptionalWhiteSpace
+ => [[ h t [ suffix ] when* locals [ prefix ] when* >array ]]
+
+TopLevelForm = ExecutableCode => [[ <ast-sequence> ]]
+
+UnaryMethodHeader = UnaryMessageSelector:selector
+ => [[ { selector { } } ]]
+BinaryMethodHeader = BinaryMessageSelector:selector OptionalWhiteSpace BindableIdentifier:identifier
+ => [[ { selector { identifier } } ]]
+KeywordMethodHeaderSegment = Keyword:keyword
+ OptionalWhiteSpace
+ BindableIdentifier:identifier => [[ { keyword identifier } ]]
+KeywordMethodHeader = KeywordMethodHeaderSegment:h (Whitespace KeywordMethodHeaderSegment:s => [[ s ]])*:t
+ => [[ t h prefix unzip [ concat ] dip 2array ]]
+MethodHeader = KeywordMethodHeader
+ | BinaryMethodHeader
+ | UnaryMethodHeader
+MethodDeclaration = OptionalWhiteSpace "method" OptionalWhiteSpace MethodHeader:header
+ OptionalWhiteSpace "["
+ ExecutableCode:code
+ "]"
+ => [[ header first2 code <ast-method> ]]
+
+ClassDeclaration = OptionalWhiteSpace "class" OptionalWhiteSpace Identifier:name
+ OptionalWhiteSpace
+ ("extends" OptionalWhiteSpace Identifier:superclass OptionalWhiteSpace => [[ superclass ]])?:superclass
+ OptionalWhiteSpace "["
+ (OptionalWhiteSpace LocalVariableDeclarationList:l => [[ l names>> ]])?:ivars
+ (MethodDeclaration:h
+ (OptionalWhiteSpace
+ EndStatement
+ OptionalWhiteSpace
+ MethodDeclaration:m => [[ m ]])*:t (EndStatement)?
+ => [[ t h prefix ]]
+ )?:methods
+ OptionalWhiteSpace "]"
+ => [[ name superclass "Object" or ivars >array methods >array ast-class boa ]]
+
+ForeignClassDeclaration = OptionalWhiteSpace "foreign"
+ OptionalWhiteSpace Identifier:name
+ OptionalWhiteSpace Literal:class
+ => [[ class name ast-foreign boa ]]
+End = !(.)
+
+Program = TopLevelForm End
+
+;EBNF
\ No newline at end of file
--- /dev/null
+class TreeNode extends Object [
+ |left right item|
+
+ method binarytrees: n to: output [
+ | minDepth maxDepth stretchDepth check longLivedTree iterations |
+ minDepth := 4.
+ maxDepth := minDepth + 2 max: n.
+ stretchDepth := maxDepth + 1.
+
+ check := (TreeNode bottomUpTree: 0 depth: stretchDepth) itemCheck.
+ output
+ nextPutAll: 'stretch tree of depth '; print: stretchDepth; tab;
+ nextPutAll: ' check: '; print: check; nl.
+
+ longLivedTree := TreeNode bottomUpTree: 0 depth: maxDepth.
+ minDepth to: maxDepth by: 2 do: [:depth|
+ iterations := 1 bitShift: maxDepth - depth + minDepth.
+
+ check := 0.
+ 1 to: iterations do: [:i|
+ check := check + (TreeNode bottomUpTree: i depth: depth) itemCheck.
+ check := check + (TreeNode bottomUpTree: -1*i depth: depth) itemCheck
+ ].
+ output
+ print: (2*iterations); tab;
+ nextPutAll: ' trees of depth '; print: depth; tab;
+ nextPutAll: ' check: '; print: check; nl
+ ].
+
+ output
+ nextPutAll: 'long lived tree of depth '; print: maxDepth; tab;
+ nextPutAll: ' check: '; print: longLivedTree itemCheck; nl
+ ].
+
+ method binarytrees: arg [
+ self binarytrees: arg to: self stdout.
+ ^''
+ ].
+
+ method left: leftChild right: rightChild item: anItem [
+ left := leftChild.
+ right := rightChild.
+ item := anItem
+ ].
+
+ method itemCheck [
+ ^left isNil
+ ifTrue: [item] ifFalse: [item + (left itemCheck - right itemCheck)]
+ ].
+
+ method bottomUpTree: anItem depth: anInteger [
+ ^(anInteger > 0)
+ ifTrue: [
+ self
+ left: (self bottomUpTree: 2*anItem - 1 depth: anInteger - 1)
+ right: (self bottomUpTree: 2*anItem depth: anInteger - 1)
+ item: anItem
+ ] ifFalse: [self left: nil right: nil item: anItem]
+ ].
+
+ method left: leftChild right: rightChild item: anItem [
+ ^(super new) left: leftChild right: rightChild item: anItem
+ ]
+].
+
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+IN: smalltalk.printer.tests
+USING: smalltalk.printer tools.test ;
+
+[ "#((1 2) 'hi')" ] [ { { 1 2 } "hi" } smalltalk>string ] unit-test
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays byte-arrays kernel make math
+math.parser prettyprint sequences smalltalk.ast strings ;
+IN: smalltalk.printer
+
+GENERIC: smalltalk>string ( object -- string )
+
+M: real smalltalk>string number>string ;
+
+M: string smalltalk>string
+ [
+ "'" %
+ [ dup CHAR: ' = [ dup , , ] [ , ] if ] each
+ "'" %
+ ] "" make ;
+
+GENERIC: array-element>string ( object -- string )
+
+M: object array-element>string smalltalk>string ;
+
+M: array array-element>string
+ [ array-element>string ] map " " join "(" ")" surround ;
+
+M: array smalltalk>string
+ array-element>string "#" prepend ;
+
+M: byte-array smalltalk>string
+ [ number>string ] { } map-as " " join "#[" "]" surround ;
+
+M: symbol smalltalk>string
+ name>> smalltalk>string "#" prepend ;
+
+M: object smalltalk>string unparse-short ;
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators effects generic generic.standard
+kernel sequences words lexer ;
+IN: smalltalk.selectors
+
+SYMBOLS: unary binary keyword ;
+
+: selector-type ( selector -- type )
+ {
+ { [ dup [ "~!@%&*-+=|\\<>,?/" member? ] all? ] [ binary ] }
+ { [ CHAR: : over member? ] [ keyword ] }
+ [ unary ]
+ } cond nip ;
+
+: selector>effect ( selector -- effect )
+ dup selector-type {
+ { unary [ drop 0 ] }
+ { binary [ drop 1 ] }
+ { keyword [ [ CHAR: : = ] count ] }
+ } case "receiver" suffix { "result" } <effect> ;
+
+: selector>generic ( selector -- generic )
+ [ "selector-" prepend "smalltalk.selectors" create dup ]
+ [ selector>effect ]
+ bi define-simple-generic ;
+
+SYNTAX: SELECTOR: scan selector>generic drop ;
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! 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 -- )
+ fetched-in>> 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 ;
{ "spider" spider } }
{ $description "Runs a spider until completion. See the " { $subsection "spider-tutorial" } " for a complete description of the tuple slots that affect how thet spider works." } ;
-HELP: slurp-heap-while
-{ $values
- { "heap" "a heap" } { "quot1" quotation } { "quot2" quotation } }
-{ $description "Removes values from a heap that match the predicate quotation " { $snippet "quot1" } " and processes them with " { $snippet "quot2" } " until the predicate quotation no longer matches." } ;
-
ARTICLE: "spider-tutorial" "Spider tutorial"
"To create a new spider, call the " { $link <spider> } " word with a link to the site you wish to spider."
{ $code <" "http://concatenative.org" <spider> "> }
USING: accessors fry html.parser html.parser.analyzer
http.client kernel tools.time sets assocs sequences
concurrency.combinators io threads namespaces math multiline
-heaps math.parser inspector urls assoc-heaps logging
-combinators.short-circuit continuations calendar prettyprint ;
+math.parser inspector urls logging combinators.short-circuit
+continuations calendar prettyprint dlists deques locals
+spider.unique-deque ;
IN: spider
TUPLE: spider base count max-count sleep max-depth initial-links
-filters spidered todo nonmatching quiet ;
+filters spidered todo nonmatching quiet currently-spidering
+#threads follow-robots? 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 ;
: <spider> ( base -- spider )
>url
spider new
over >>base
- swap 0 <unique-min-heap> [ heap-push ] keep >>todo
- <unique-min-heap> >>nonmatching
+ over >>currently-spidering
+ swap 0 <unique-deque> [ push-url ] keep >>todo
+ <unique-deque> >>nonmatching
0 >>max-depth
0 >>count
1/0. >>max-count
- H{ } clone >>spidered ;
+ H{ } clone >>spidered
+ 1 >>#threads ;
<PRIVATE
: apply-filters ( links spider -- links' )
- filters>> [ '[ _ 1&& ] filter ] when* ;
+ filters>> [ '[ [ _ 1&& ] filter ] call( seq -- seq' ) ] when* ;
-: push-links ( links level assoc-heap -- )
- '[ _ _ heap-push ] each ;
+: push-links ( links level unique-deque -- )
+ '[ _ _ push-url ] each ;
: add-todo ( links level spider -- )
todo>> push-links ;
: add-nonmatching ( links level spider -- )
nonmatching>> push-links ;
-: filter-base ( spider spider-result -- base-links nonmatching-links )
+: filter-base-links ( spider spider-result -- base-links nonmatching-links )
[ base>> host>> ] [ links>> prune ] bi*
[ host>> = ] with partition ;
: add-spidered ( spider spider-result -- )
[ [ 1+ ] change-count ] dip
2dup [ spidered>> ] [ dup url>> ] bi* rot set-at
- [ filter-base ] 2keep
+ [ filter-base-links ] 2keep
depth>> 1+ swap
[ add-nonmatching ]
[ tuck [ apply-filters ] 2dip add-todo ] 2bi ;
-: normalize-hrefs ( links -- links' )
- [ >url ] map
- spider get base>> swap [ derive-url ] with map ;
+: normalize-hrefs ( base links -- links' )
+ [ derive-url ] with map ;
: print-spidering ( url depth -- )
"depth: " write number>string write
", spidering: " write . yield ;
-: (spider-page) ( url depth -- spider-result )
- f pick spider get spidered>> set-at
- over '[ _ http-get ] benchmark swap
- [ parse-html dup find-hrefs normalize-hrefs ] benchmark
+:: new-spidered-result ( spider url depth -- spider-result )
+ f url spider spidered>> set-at
+ [ url http-get ] benchmark :> fetched-at :> html :> headers
+ [
+ html parse-html
+ spider currently-spidering>>
+ over find-all-links normalize-hrefs
+ ] benchmark :> processing-time :> links :> parsed-html
+ url depth headers fetched-at parsed-html links processing-time
now spider-result boa ;
-: spider-page ( url depth -- )
- spider get quiet>> [ 2dup print-spidering ] unless
- (spider-page)
- spider get [ quiet>> [ dup describe ] unless ]
- [ swap add-spidered ] bi ;
+:: spider-page ( spider url depth -- )
+ spider quiet>> [ url depth print-spidering ] unless
+ spider url depth new-spidered-result :> spidered-result
+ spider quiet>> [ spidered-result describe ] unless
+ spider spidered-result add-spidered ;
\ spider-page ERROR add-error-logging
-: spider-sleep ( -- )
- spider get sleep>> [ sleep ] when* ;
+: spider-sleep ( spider -- ) sleep>> [ sleep ] when* ;
-: queue-initial-links ( spider -- spider )
- [ initial-links>> normalize-hrefs 0 ] keep
- [ add-todo ] keep ;
+: queue-initial-links ( spider -- )
+ [
+ [ currently-spidering>> ] [ initial-links>> ] bi normalize-hrefs 0
+ ] keep add-todo ;
-: slurp-heap-while ( heap quot1 quot2: ( value key -- ) -- )
- pick heap-empty? [ 3drop ] [
- [ [ heap-pop dup ] 2dip slip [ t ] compose [ 2drop f ] if ]
- [ roll [ slurp-heap-while ] [ 3drop ] if ] 3bi
- ] if ; inline recursive
+: spider-page? ( spider -- ? )
+ {
+ [ todo>> deque>> deque-empty? not ]
+ [ [ todo>> peek-url depth>> ] [ max-depth>> ] bi < ]
+ [ [ count>> ] [ max-count>> ] bi < ]
+ } 1&& ;
+
+: setup-next-url ( spider -- spider url depth )
+ dup todo>> peek-url url>> >>currently-spidering
+ dup todo>> pop-url [ url>> ] [ depth>> ] bi ;
+
+: spider-next-page ( spider -- )
+ setup-next-url spider-page ;
PRIVATE>
+: run-spider-loop ( spider -- )
+ dup spider-page? [
+ [ spider-next-page ] [ spider-sleep ] [ run-spider-loop ] tri
+ ] [
+ drop
+ ] if ;
+
: run-spider ( spider -- spider )
"spider" [
- dup spider [
- queue-initial-links
- [ todo>> ] [ max-depth>> ] bi
- '[
- _ <= spider get
- [ count>> ] [ max-count>> ] bi < and
- ] [ spider-page spider-sleep ] slurp-heap-while
- spider get
- ] with-variable
+ dup queue-initial-links [ run-spider-loop ] keep
] with-logging ;
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs deques dlists kernel spider ;
+IN: spider.unique-deque
+
+TUPLE: todo-url url depth ;
+
+: <todo-url> ( url depth -- todo-url )
+ todo-url new
+ swap >>depth
+ swap >>url ;
+
+TUPLE: unique-deque assoc deque ;
+
+: <unique-deque> ( -- unique-deque )
+ H{ } clone <dlist> unique-deque boa ;
+
+: url-exists? ( url unique-deque -- ? )
+ [ url>> ] [ assoc>> ] bi* key? ;
+
+: push-url ( url depth unique-deque -- )
+ [ <todo-url> ] dip 2dup url-exists? [
+ 2drop
+ ] [
+ [ [ [ t ] dip url>> ] [ assoc>> ] bi* set-at ]
+ [ deque>> push-back ] 2bi
+ ] if ;
+
+: pop-url ( unique-deque -- todo-url ) deque>> pop-front ;
+
+: peek-url ( unique-deque -- todo-url ) deque>> peek-front ;
: draw-tetris ( width height tetris -- )
#! width and height are in pixels
- GL_MODELVIEW [
+ [
{
[ board>> scale-board ]
[ board>> draw-board ]
! 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>
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." } ;
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
! (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 ;
: 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 ;
</t:a>
</h2>
- <t:farkup t:name="parsed" t:parsed="true" />
+ <t:farkup t:name="content" />
</t:bind>
</div>
</td>
<tr>
<td colspan="2" class="footer">
<t:bind t:name="footer">
- <t:farkup t:name="parsed" t:parsed="true" />
+ <t:farkup t:name="content" />
</t:bind>
</td>
</tr>
(number constant "integers and floats")
(ratio constant "ratios")
(declaration keyword "declaration words")
+ (ebnf-form constant "EBNF: ... ;EBNF form")
(parsing-word keyword "parsing words")
(setter-word function-name "setter words (>>foo)")
(getter-word function-name "getter words (foo>>)")
(defun fuel-font-lock--syntactic-face (state)
(if (nth 3 state) 'factor-font-lock-string
(let ((c (char-after (nth 8 state))))
- (cond ((or (char-equal c ?\ ) (char-equal c ?\n))
+ (cond ((or (char-equal c ?\ )
+ (char-equal c ?\n)
+ (char-equal c ?E))
(save-excursion
(goto-char (nth 8 state))
(beginning-of-line)
'factor-font-lock-symbol)
((looking-at-p "C-ENUM:\\( \\|\n\\)")
'factor-font-lock-constant)
+ ((looking-at-p "E")
+ 'factor-font-lock-ebnf-form)
(t 'default))))
((or (char-equal c ?U) (char-equal c ?C))
'factor-font-lock-parsing-word)
(let ((name (match-string-no-properties 2))
(body (match-string-no-properties 4))
(end (match-end 0)))
- (list (split-string body nil t) name pos end)))))
+ (list (split-string (or body "") nil t) name pos end)))))
(defun fuel-refactor--find (code to)
(let ((candidate) (result))
(defun fuel-refactor--insert-word (word stack-effect code)
(let ((start (goto-char (fuel-refactor--insertion-point))))
(open-line 1)
- (insert ": " word " " stack-effect "\n" code " ;\n")
+ (insert ": " word " " stack-effect "\n" (or code " ") " ;\n")
(indent-region start (point))
(move-overlay fuel-stack--overlay start (point))))
(delete-overlay fuel-stack--overlay)))
(defun fuel-refactor--extract (begin end)
- (unless (< begin end) (error "No proper region to extract"))
- (let* ((code (buffer-substring begin end))
- (existing (fuel-refactor--reuse-existing code))
- (code-str (or existing (fuel--region-to-string begin end)))
+ (let* ((rp (< begin end))
+ (code (and rp (buffer-substring begin end)))
+ (existing (and code (fuel-refactor--reuse-existing code)))
+ (code-str (and code (or existing (fuel--region-to-string begin end))))
(word (or (car existing) (read-string "New word name: ")))
(stack-effect (or existing
- (fuel-stack--infer-effect code-str)
+ (and code-str (fuel-stack--infer-effect code-str))
(read-string "Stack effect: "))))
- (goto-char begin)
- (delete-region begin end)
- (insert word)
- (indent-region begin (point))
+ (when rp
+ (goto-char begin)
+ (delete-region begin end)
+ (insert word)
+ (indent-region begin (point)))
(save-excursion
(let ((start (or (cadr existing) (point))))
(unless existing
(fuel-refactor--insert-word word stack-effect code))
- (fuel-refactor--extract-other start
- (or (car (cddr existing)) (point))
- code)))))
+ (if rp
+ (fuel-refactor--extract-other start
+ (or (car (cddr existing)) (point))
+ code)
+ (unwind-protect
+ (sit-for fuel-stack-highlight-period)
+ (delete-overlay fuel-stack--overlay)))))))
(defun fuel-refactor-extract-region (begin end)
"Extracts current region as a separate word."
(interactive "r")
- (let ((begin (save-excursion
- (goto-char begin)
- (when (zerop (skip-syntax-backward "w"))
- (skip-syntax-forward "-"))
- (point)))
- (end (save-excursion
- (goto-char end)
- (skip-syntax-forward "w")
- (point))))
- (fuel-refactor--extract begin end)))
+ (if (= begin end)
+ (fuel-refactor--extract begin end)
+ (let ((begin (save-excursion
+ (goto-char begin)
+ (when (zerop (skip-syntax-backward "w"))
+ (skip-syntax-forward "-"))
+ (point)))
+ (end (save-excursion
+ (goto-char end)
+ (skip-syntax-forward "w")
+ (point))))
+ (fuel-refactor--extract begin end))))
(defun fuel-refactor-extract-sexp ()
"Extracts current innermost sexp (up to point) as a separate
"B" "BIN:"
"C:" "C-ENUM:" "C-STRUCT:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method"
"DEFER:"
- "ERROR:" "EXCLUDE:"
+ "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:"
"f" "FORGET:" "FROM:" "FUNCTION:"
"GENERIC#" "GENERIC:"
"HELP:" "HEX:" "HOOK:"
("\\_<<\\(\"\\)\\_>" (1 "<b"))
("\\_<\\(\"\\)>\\_>" (1 ">b"))
;; Multiline constructs
+ ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "<b"))
+ ("\\_<;EBN\\(F\\)\\_>" (1 ">b"))
("\\_<\\(U\\)SING: \\(;\\)" (1 "<b") (2 ">b"))
("\\_<USING:\\( \\)" (1 "<b"))
("\\_<\\(C\\)-ENUM: \\(;\\)" (1 "<b") (2 ">b"))
PLAF_DLL_OBJS += vm/os-macosx.o vm/mach_signal.o
DLL_EXTENSION = .dylib
+SHARED_DLL_EXTENSION = .dylib
SHARED_FLAG = -dynamiclib
EXE_SUFFIX =
DLL_PREFIX = lib
DLL_EXTENSION = .a
-# DLL_EXTENSION = .so
+SHARED_DLL_EXTENSION = .so
SHARED_FLAG = -shared
PLAF_DLL_OBJS = vm/os-unix.o
EXE_EXTENSION=.exe
CONSOLE_EXTENSION=.com
DLL_EXTENSION=.dll
+SHARED_DLL_EXTENSION=.dll
LINKER = $(CC) -shared -mno-cygwin -o
LINK_WITH_ENGINE = -l$(DLL_PREFIX)factor$(DLL_SUFFIX)
dpush(tag_object(array));
}
-/* On OS X, structs <= 8 bytes are returned in registers. */
+/* On some x86 OSes, structs <= 8 bytes are returned in registers. */
void box_small_struct(CELL x, CELL y, CELL size)
{
CELL data[2];
box_value_struct(data,size);
}
+/* On OS X/PPC, complex numbers are returned in registers. */
+void box_medium_struct(CELL x1, CELL x2, CELL x3, CELL x4, CELL size)
+{
+ CELL data[4];
+ data[0] = x1;
+ data[1] = x2;
+ data[2] = x3;
+ data[3] = x4;
+ box_value_struct(data,size);
+}
+
/* open a native library and push a handle */
void primitive_dlopen(void)
{
DLLEXPORT void to_value_struct(CELL src, void *dest, CELL size);
DLLEXPORT void box_value_struct(void *src, CELL size);
DLLEXPORT void box_small_struct(CELL x, CELL y, CELL size);
+void box_medium_struct(CELL x1, CELL x2, CELL x3, CELL x4, CELL size);
DEFINE_UNTAG(F_DLL,DLL_TYPE,dll)
CELL frame_executing(F_STACK_FRAME *frame)
{
F_CODE_BLOCK *compiled = frame_code(frame);
- if(compiled->literals == F)
+ if(compiled->literals == F || !stack_traces_p())
return F;
else
{
{
F_BYTE_ARRAY *relocation = untag_object(compiled->relocation);
- CELL index = 1;
+ CELL index = stack_traces_p() ? 1 : 0;
F_REL *rel = (F_REL *)(relocation + 1);
F_REL *rel_end = (F_REL *)((char *)rel + byte_array_capacity(relocation));
copy_handle(&compiled->literals);
copy_handle(&compiled->relocation);
-
- flush_icache_for(compiled);
}
void mark_stack_frame_step(F_STACK_FRAME *frame)
}
}
-bool stack_traces_p(void)
-{
- return to_boolean(userenv[STACK_TRACES_ENV]);
-}
-
CELL compiled_code_format(void)
{
return untag_fixnum_fast(userenv[JIT_CODE_FORMAT]);
UNREGISTER_ROOT(relocation);
UNREGISTER_ROOT(literals);
+ /* slight space optimization */
+ if(type_of(literals) == ARRAY_TYPE && array_capacity(untag_object(literals)) == 0)
+ literals = F;
+
/* compiled header */
compiled->block.type = type;
compiled->block.last_scan = NURSERY;
CELL compiled_code_format(void);
-bool stack_traces_p(void);
+INLINE bool stack_traces_p(void)
+{
+ return userenv[STACK_TRACES_ENV] != F;
+}
F_CODE_BLOCK *add_code_block(
CELL type,
/* Dump all code blocks for debugging */
void dump_code_heap(void)
{
- CELL size = 0;
+ CELL reloc_size = 0, literal_size = 0;
F_BLOCK *scan = first_block(&code_heap);
status = "free";
break;
case B_ALLOCATED:
- size += object_size(((F_CODE_BLOCK *)scan)->relocation);
+ reloc_size += object_size(((F_CODE_BLOCK *)scan)->relocation);
+ literal_size += object_size(((F_CODE_BLOCK *)scan)->literals);
status = "allocated";
break;
case B_MARKED:
- size += object_size(((F_CODE_BLOCK *)scan)->relocation);
+ reloc_size += object_size(((F_CODE_BLOCK *)scan)->relocation);
+ literal_size += object_size(((F_CODE_BLOCK *)scan)->literals);
status = "marked";
break;
default:
scan = next_block(&code_heap,scan);
}
- print_cell(size); print_string(" bytes of relocation data\n");
+ print_cell(reloc_size); print_string(" bytes of relocation data\n");
+ print_cell(literal_size); print_string(" bytes of literal data\n");
}
void factorbug(void)
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;
gc_off = false;
if(!stage2)
+ {
+ userenv[STACK_TRACES_ENV] = tag_boolean(p->stack_traces);
do_stage1_init();
+ }
}
/* May allocate memory */
}
}
+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();
void primitive_fputc(void);
void primitive_fwrite(void);
void primitive_fflush(void);
+void primitive_fseek(void);
void primitive_fclose(void);
/* Platform specific primitives */
#define STRNCMP strncmp
#define STRDUP strdup
+#define FSEEK fseeko
+
#define FIXNUM_FORMAT "%ld"
#define CELL_FORMAT "%lu"
#define CELL_HEX_FORMAT "%lx"
#define STRNCMP wcsncmp
#define STRDUP _wcsdup
#define MIN(a,b) ((a)>(b)?(b):(a))
+#define FSEEK fseek
#ifdef WIN64
#define CELL_FORMAT "%Iu"
#if defined(FACTOR_X86)
#include "os-solaris-x86.32.h"
#elif defined(FACTOR_AMD64)
- #incluide "os-solaris-x86.64.h"
+ #include "os-solaris-x86.64.h"
#else
#error "Unsupported Solaris flavor"
#endif
primitive_fputc,
primitive_fwrite,
primitive_fflush,
+ primitive_fseek,
primitive_fclose,
primitive_wrapper,
primitive_clone,
GROWABLE_ARRAY(literals);
REGISTER_ROOT(literals);
- GROWABLE_ARRAY_ADD(literals,stack_traces_p() ? quot : F);
+ if(stack_traces_p())
+ GROWABLE_ARRAY_ADD(literals,quot);
bool stack_frame = jit_stack_frame_p(untag_object(array));
projects / factor.git / commitdiff