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

db4
Doug Coleman 2009-03-07 19:33:25 -06:00
commit 97a44b44ac
19 changed files with 67 additions and 200 deletions

View File

@ -6,17 +6,17 @@ io.streams.byte-array ;
IN: bitstreams.tests IN: bitstreams.tests
[ 1 t ] [ 1 t ]
[ B{ 254 } <string-reader> <bitstream-reader> read-bit ] unit-test [ B{ 254 } binary <byte-reader> <bitstream-reader> read-bit ] unit-test
[ 254 8 t ] [ 254 8 t ]
[ B{ 254 } <string-reader> <bitstream-reader> 8 swap read-bits ] unit-test [ B{ 254 } binary <byte-reader> <bitstream-reader> 8 swap read-bits ] unit-test
[ 4095 12 t ] [ 4095 12 t ]
[ B{ 255 255 } <string-reader> <bitstream-reader> 12 swap read-bits ] unit-test [ B{ 255 255 } binary <byte-reader> <bitstream-reader> 12 swap read-bits ] unit-test
[ B{ 254 } ] [ B{ 254 } ]
[ [
<string-writer> <bitstream-writer> 254 8 rot binary <byte-writer> <bitstream-writer> 254 8 rot
[ write-bits ] keep stream>> >byte-array [ write-bits ] keep stream>> >byte-array
] unit-test ] unit-test

View File

@ -1,10 +1,9 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: tools.test core-text core-foundation USING: tools.test core-text core-text.fonts core-foundation
core-foundation.dictionaries destructors core-foundation.dictionaries destructors arrays kernel generalizations
arrays kernel generalizations math accessors math accessors core-foundation.utilities combinators hashtables colors
core-foundation.utilities colors.constants ;
combinators hashtables colors ;
IN: core-text.tests IN: core-text.tests
: test-font ( name -- font ) : test-font ( name -- font )
@ -21,8 +20,8 @@ IN: core-text.tests
: test-typographic-bounds ( string font -- ? ) : test-typographic-bounds ( string font -- ? )
[ [
test-font &CFRelease white <CTLine> &CFRelease test-font &CFRelease tuck COLOR: white <CTLine> &CFRelease
line-typographic-bounds { compute-line-metrics {
[ width>> float? ] [ width>> float? ]
[ ascent>> float? ] [ ascent>> float? ]
[ descent>> float? ] [ descent>> float? ]

View File

@ -3,7 +3,7 @@
USING: io.encodings.iana io.encodings.euc ; USING: io.encodings.iana io.encodings.euc ;
IN: io.encodings.big5 IN: io.encodings.big5
EUC: big5 "vocab:io/encodings/big5/CP950.txt" EUC: big5 "vocab:io/encodings/big5/CP950.TXT"
big5 "Big5" register-encoding big5 "Big5" register-encoding

View File

@ -1,6 +1,6 @@
! Copyright (C) 2009 Yun, Jonghyouk. ! Copyright (C) 2009 Yun, Jonghyouk.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: simple-flat-file tools.test memoize ; USING: simple-flat-file tools.test memoize assocs ;
IN: simple-flat-file.tests IN: simple-flat-file.tests

View File

@ -7,7 +7,7 @@ IN: simple-flat-file
[ "#" split1 drop ] map harvest ; [ "#" split1 drop ] map harvest ;
: split-column ( line -- columns ) : split-column ( line -- columns )
"\t" split 2 head ; " \t" split harvest 2 head ;
: parse-hex ( s -- n ) : parse-hex ( s -- n )
2 short tail hex> ; 2 short tail hex> ;

View File

@ -0,0 +1,15 @@
#
# Name: cp949 to Unicode table (for testing, partial)
#
0x00 0x0000 #NULL
0x01 0x0001 #START OF HEADING
0x02 0x0002 #START OF TEXT
0x03 0x0003 #END OF TEXT
0x04 0x0004 #END OF TRANSMISSION
0x8253 0xAD2A #HANGUL SYLLABLE KIYEOK WAE PIEUPSIOS
0x8254 0xAD2B #HANGUL SYLLABLE KIYEOK WAE SIOS
0x8255 0xAD2E #HANGUL SYLLABLE KIYEOK WAE CIEUC
0x8256 0xAD2F #HANGUL SYLLABLE KIYEOK WAE CHIEUCH
0x8257 0xAD30 #HANGUL SYLLABLE KIYEOK WAE KHIEUKH
0x8258 0xAD31 #HANGUL SYLLABLE KIYEOK WAE THIEUTH
0x8259 0xAD32 #HANGUL SYLLABLE KIYEOK WAE PHIEUPH

View File

@ -288,7 +288,7 @@ DEFER: bar
[ [ [ dup call ] dup call ] infer ] [ [ [ dup call ] dup call ] infer ]
[ inference-error? ] must-fail-with [ inference-error? ] must-fail-with
: m dup call ; inline : m ( q -- ) dup call ; inline
[ [ [ m ] m ] infer ] [ inference-error? ] must-fail-with [ [ [ m ] m ] infer ] [ inference-error? ] must-fail-with
@ -296,13 +296,13 @@ DEFER: bar
[ [ [ m' ] m' ] infer ] [ inference-error? ] must-fail-with [ [ [ m' ] m' ] infer ] [ inference-error? ] must-fail-with
: m'' [ dup curry ] ; inline : m'' ( -- q ) [ dup curry ] ; inline
: m''' m'' call call ; inline : m''' ( -- ) m'' call call ; inline
[ [ [ m''' ] m''' ] infer ] [ inference-error? ] must-fail-with [ [ [ m''' ] m''' ] infer ] [ inference-error? ] must-fail-with
: m-if t over if ; inline : m-if ( a b c -- ) t over if ; inline
[ [ [ m-if ] m-if ] infer ] [ inference-error? ] must-fail-with [ [ [ m-if ] m-if ] infer ] [ inference-error? ] must-fail-with
@ -488,7 +488,7 @@ ERROR: custom-error ;
[ custom-error ] infer [ custom-error ] infer
] unit-test ] unit-test
: funny-throw throw ; inline : funny-throw ( a -- * ) throw ; inline
[ T{ effect f 0 0 t } ] [ [ T{ effect f 0 0 t } ] [
[ 3 funny-throw ] infer [ 3 funny-throw ] infer
@ -502,12 +502,8 @@ ERROR: custom-error ;
[ dup [ 3 throw ] dip ] infer [ dup [ 3 throw ] dip ] infer
] unit-test ] unit-test
! This was a false trigger of the undecidable quotation
! recursion bug
{ 2 1 } [ find-last-sep ] must-infer-as
! Regression ! Regression
: missing->r-check 1 load-locals ; : missing->r-check ( a -- ) 1 load-locals ;
[ [ missing->r-check ] infer ] must-fail [ [ missing->r-check ] infer ] must-fail
@ -516,7 +512,7 @@ ERROR: custom-error ;
[ [ [ f dup ] [ ] while ] infer ] must-fail [ [ [ f dup ] [ ] while ] infer ] must-fail
: erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline : erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline recursive
[ [ erg's-inference-bug ] infer ] must-fail [ [ erg's-inference-bug ] infer ] must-fail
@ -544,10 +540,10 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ;
[ [ inference-invalidation-d ] infer ] must-fail [ [ inference-invalidation-d ] infer ] must-fail
: bad-recursion-3 ( -- ) dup [ [ bad-recursion-3 ] dip ] when ; inline : bad-recursion-3 ( -- ) dup [ [ bad-recursion-3 ] dip ] when ; inline recursive
[ [ bad-recursion-3 ] infer ] must-fail [ [ bad-recursion-3 ] infer ] must-fail
: bad-recursion-4 ( -- ) 4 [ dup call roll ] times ; inline : bad-recursion-4 ( -- ) 4 [ dup call roll ] times ; inline recursive
[ [ [ ] [ 1 2 3 ] over dup bad-recursion-4 ] infer ] must-fail [ [ [ ] [ 1 2 3 ] over dup bad-recursion-4 ] infer ] must-fail
: bad-recursion-5 ( obj quot: ( -- ) -- ) dup call swap bad-recursion-5 ; inline recursive : bad-recursion-5 ( obj quot: ( -- ) -- ) dup call swap bad-recursion-5 ; inline recursive

View File

@ -45,4 +45,4 @@ M: string blah-generic ;
{ string blah-generic } watch { string blah-generic } watch
[ ] [ "hi" blah-generic ] unit-test [ "hi" ] [ "hi" blah-generic ] unit-test

View File

@ -25,7 +25,7 @@ IN: ui.tools.listener.tests
! This should not throw an exception ! This should not throw an exception
[ ] [ "interactor" get evaluate-input ] unit-test [ ] [ "interactor" get evaluate-input ] unit-test
[ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test [ ] [ [ "interactor" get interactor-busy? ] [ yield ] while ] unit-test
[ ] [ "[ 1 2 3 ]" "interactor" get set-editor-string ] unit-test [ ] [ "[ 1 2 3 ]" "interactor" get set-editor-string ] unit-test
@ -48,7 +48,7 @@ IN: ui.tools.listener.tests
[ ] [ "hi" "interactor" get set-editor-string ] unit-test [ ] [ "hi" "interactor" get set-editor-string ] unit-test
[ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test [ ] [ [ "interactor" get interactor-busy? ] [ yield ] while ] unit-test
[ ] [ "interactor" get evaluate-input ] unit-test [ ] [ "interactor" get evaluate-input ] unit-test

View File

@ -3,6 +3,7 @@
USING: kernel USING: kernel
namespaces namespaces
accessors accessors
assocs
make make
math math
math.functions math.functions
@ -16,6 +17,7 @@ colors
colors.constants colors.constants
prettyprint prettyprint
vars vars
call
quotations quotations
io io
io.directories io.directories
@ -27,8 +29,6 @@ ui.gadgets.panes
ui.gadgets ui.gadgets
ui.traverse ui.traverse
ui.gadgets.borders ui.gadgets.borders
ui.gadgets.handler
ui.gadgets.slate
ui.gadgets.frames ui.gadgets.frames
ui.gadgets.tracks ui.gadgets.tracks
ui.gadgets.labels ui.gadgets.labels
@ -53,6 +53,7 @@ adsoda
adsoda.tools adsoda.tools
; ;
QUALIFIED-WITH: ui.pens.solid s QUALIFIED-WITH: ui.pens.solid s
QUALIFIED-WITH: ui.gadgets.wrappers w
IN: 4DNav IN: 4DNav
@ -392,6 +393,13 @@ USE: ui.gadgets.labeled.private
add-gadget add-gadget
menu-quick-views add-gadget ; menu-quick-views add-gadget ;
TUPLE: handler < w:wrapper table ;
: <handler> ( child -- handler ) handler w:new-wrapper ;
M: handler handle-gesture ( gesture gadget -- ? )
tuck table>> at dup [ call( gadget -- ) f ] [ 2drop t ] if ;
: add-keyboard-delegate ( obj -- obj ) : add-keyboard-delegate ( obj -- obj )
<handler> <handler>
{ {

View File

@ -24,7 +24,6 @@ ui.gadgets.panes
ui.gadgets.scrollers ui.gadgets.scrollers
prettyprint prettyprint
combinators combinators
rewrite-closures
accessors accessors
values values
tools.walker tools.walker
@ -67,7 +66,7 @@ file-chooser H{
[ directory? ] bi or ] filter [ directory? ] bi or ] filter
; ;
: update-filelist-model ( file-chooser -- file-chooser ) : update-filelist-model ( file-chooser -- )
[ list-of-files ] [ model>> ] bi set-model ; [ list-of-files ] [ model>> ] bi set-model ;
: init-filelist-model ( file-chooser -- file-chooser ) : init-filelist-model ( file-chooser -- file-chooser )
@ -86,7 +85,7 @@ file-chooser H{
: fc-go-home ( file-chooser -- ) : fc-go-home ( file-chooser -- )
[ home ] (fc-go) ; [ home ] (fc-go) ;
: fc-change-directory ( file-chooser file -- file-chooser ) : fc-change-directory ( file-chooser file -- )
dupd [ path>> value>> normalize-path ] [ name>> ] bi* dupd [ path>> value>> normalize-path ] [ name>> ] bi*
append-path over path>> set-model append-path over path>> set-model
update-filelist-model update-filelist-model

View File

@ -10,9 +10,9 @@ IN: 4DNav.turtle
VAR: self VAR: self
: with-self ( quot obj -- ) [ >self call ] with-scope ; : with-self ( quot obj -- ) [ >self call ] with-scope ; inline
: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ; : save-self ( quot -- ) self> [ self> clone >self call ] dip >self ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -1,23 +1,23 @@
USING: accessors arrays colors kernel tetris.board tetris.piece tools.test ; USING: accessors arrays colors colors.constants kernel tetris.board tetris.piece tools.test ;
[ { { f f } { f f } { f f } } ] [ 2 3 make-rows ] unit-test [ { { f f } { f f } { f f } } ] [ 2 3 make-rows ] unit-test
[ { { f f } { f f } { f f } } ] [ 2 3 <board> rows>> ] unit-test [ { { f f } { f f } { f f } } ] [ 2 3 <board> rows>> ] unit-test
[ 1 { f f } ] [ 2 3 <board> { 1 1 } board@block ] unit-test [ 1 { f f } ] [ 2 3 <board> { 1 1 } board@block ] unit-test
[ f ] [ 2 3 <board> { 1 1 } block ] unit-test [ f ] [ 2 3 <board> { 1 1 } block ] unit-test
[ 2 3 <board> { 2 3 } block ] must-fail [ 2 3 <board> { 2 3 } block ] must-fail
red 1array [ 2 3 <board> dup { 1 1 } red set-block { 1 1 } block ] unit-test COLOR: red 1array [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 1 } block ] unit-test
[ t ] [ 2 3 <board> { 1 1 } block-free? ] unit-test [ t ] [ 2 3 <board> { 1 1 } block-free? ] unit-test
[ f ] [ 2 3 <board> dup { 1 1 } red set-block { 1 1 } block-free? ] unit-test [ f ] [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 1 } block-free? ] unit-test
[ t ] [ 2 3 <board> dup { 1 1 } red set-block { 1 2 } block-free? ] unit-test [ t ] [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 2 } block-free? ] unit-test
[ t ] [ 2 3 <board> dup { 1 1 } red set-block { 0 1 } block-free? ] unit-test [ t ] [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 0 1 } block-free? ] unit-test
[ t ] [ 2 3 <board> { 0 0 } block-in-bounds? ] unit-test [ t ] [ 2 3 <board> { 0 0 } block-in-bounds? ] unit-test
[ f ] [ 2 3 <board> { -1 0 } block-in-bounds? ] unit-test [ f ] [ 2 3 <board> { -1 0 } block-in-bounds? ] unit-test
[ t ] [ 2 3 <board> { 1 2 } block-in-bounds? ] unit-test [ t ] [ 2 3 <board> { 1 2 } block-in-bounds? ] unit-test
[ f ] [ 2 3 <board> { 2 2 } block-in-bounds? ] unit-test [ f ] [ 2 3 <board> { 2 2 } block-in-bounds? ] unit-test
[ t ] [ 2 3 <board> { 1 1 } location-valid? ] unit-test [ t ] [ 2 3 <board> { 1 1 } location-valid? ] unit-test
[ f ] [ 2 3 <board> dup { 1 1 } red set-block { 1 1 } location-valid? ] unit-test [ f ] [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 1 } location-valid? ] unit-test
[ t ] [ 10 10 <board> 10 <random-piece> piece-valid? ] unit-test [ t ] [ 10 10 <board> 10 <random-piece> piece-valid? ] unit-test
[ f ] [ 2 3 <board> 10 <random-piece> { 1 2 } >>location piece-valid? ] unit-test [ f ] [ 2 3 <board> 10 <random-piece> { 1 2 } >>location piece-valid? ] unit-test
[ { { f } { f } } ] [ 1 1 <board> add-row rows>> ] unit-test [ { { f } { f } } ] [ 1 1 <board> add-row rows>> ] unit-test
[ { { f } } ] [ 1 2 <board> dup { 0 1 } red set-block remove-full-rows rows>> ] unit-test [ { { f } } ] [ 1 2 <board> dup { 0 1 } COLOR: red set-block remove-full-rows rows>> ] unit-test
[ { { f } { f } } ] [ 1 2 <board> dup { 0 1 } red set-block dup check-rows drop rows>> ] unit-test [ { { f } { f } } ] [ 1 2 <board> dup { 0 1 } COLOR: red set-block dup check-rows drop rows>> ] unit-test

View File

@ -1 +0,0 @@
Eduardo Cavazos

View File

@ -1,11 +0,0 @@
USING: kernel assocs ui.gestures ui.gadgets.wrappers accessors ;
IN: ui.gadgets.handler
TUPLE: handler < wrapper table ;
: <handler> ( child -- handler ) handler new-wrapper ;
M: handler handle-gesture ( gesture gadget -- ? )
tuck table>> at dup [ call f ] [ 2drop t ] if ;

View File

@ -1,10 +1,10 @@
! Copyright (C) 2006, 2009 Slava Pestov. ! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors math.vectors classes.tuple math.rectangles colors USING: accessors math.vectors classes.tuple math.rectangles colors
kernel sequences models opengl math math.order namespaces kernel sequences models opengl math math.order namespaces call
ui.commands ui.gestures ui.render ui.gadgets ui.commands ui.gestures ui.render ui.gadgets ui.gadgets.labels
ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.scrollers ui.gadgets.presentations ui.gadgets.viewports
ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs ; ui.gadgets.packs ;
IN: ui.gadgets.lists IN: ui.gadgets.lists
TUPLE: list < pack index presenter color hook ; TUPLE: list < pack index presenter color hook ;
@ -32,7 +32,7 @@ TUPLE: list < pack index presenter color hook ;
hook>> [ [ list? ] find-parent ] prepend ; hook>> [ [ list? ] find-parent ] prepend ;
: <list-presentation> ( hook elt presenter -- gadget ) : <list-presentation> ( hook elt presenter -- gadget )
keep [ >label text-theme ] dip [ call( elt -- obj ) ] [ drop ] 2bi [ >label text-theme ] dip
<presentation> <presentation>
swap >>hook ; inline swap >>hook ; inline

View File

@ -1 +0,0 @@
Eduardo Cavazos

View File

@ -1,13 +0,0 @@
! Copyright (C) 2009 Eduardo Cavazos
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax multiline ;
IN: ui.gadgets.slate
ARTICLE: "ui.gadgets.slate" "Slate gadget"
{ $description "A gadget with an 'action' slot which should be set to a callable."}
{ $heading "Example" }
{ $code <" USING: processing.shapes ui.gadgets.slate ui.gadgets.panes ;
[ { { 10 10 } { 50 30 } { 10 50 } } polygon fill-mode ] <slate>
gadget."> } ;
ABOUT: "ui.gadgets.slate"

View File

@ -1,124 +0,0 @@
! Copyright (C) 2009 Eduardo Cavazos
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces opengl ui.render ui.gadgets accessors ;
IN: ui.gadgets.slate
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: slate < gadget action pdim graft ungraft ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: init-slate ( slate -- slate )
[ ] >>action
{ 200 200 } >>pdim
[ ] >>graft
[ ] >>ungraft ;
: <slate> ( action -- slate )
slate new
init-slate
swap >>action ;
M: slate pref-dim* ( slate -- dim ) pdim>> ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
USING: combinators arrays sequences math
opengl.gl ui.gadgets.worlds ;
: width ( rect -- w ) dim>> first ;
: height ( rect -- h ) dim>> second ;
: screen-y* ( gadget -- loc )
{
[ find-world height ]
[ screen-loc second ]
[ height ]
}
cleave
+ - ;
: screen-loc* ( gadget -- loc )
{
[ screen-loc first ]
[ screen-y* ]
}
cleave
2array ;
: setup-viewport ( gadget -- gadget )
dup
{
[ screen-loc* ]
[ dim>> ]
}
cleave
gl-viewport ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: default-coordinate-system ( gadget -- gadget )
dup
{
[ drop 0 ]
[ width 1 - ]
[ height 1 - ]
[ drop 0 ]
}
cleave
-1 1
glOrtho ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
M: slate graft* ( slate -- ) graft>> call ;
M: slate ungraft* ( slate -- ) ungraft>> call ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
GENERIC: establish-coordinate-system ( gadget -- gadget )
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
M: slate establish-coordinate-system ( slate -- slate )
default-coordinate-system ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
GENERIC: draw-slate ( slate -- slate )
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
M: slate draw-slate ( slate -- slate ) dup action>> call ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
M: slate draw-gadget* ( slate -- )
GL_PROJECTION glMatrixMode glPushMatrix glLoadIdentity
establish-coordinate-system
GL_MODELVIEW glMatrixMode glPushMatrix glLoadIdentity
setup-viewport
draw-slate
GL_PROJECTION glMatrixMode glPopMatrix glLoadIdentity
GL_MODELVIEW glMatrixMode glPopMatrix glLoadIdentity
dup
find-world
! The world coordinate system is a little wacky:
dup { [ drop 0 ] [ width ] [ height ] [ drop 0 ] } cleave -1 1 glOrtho
setup-viewport
drop
drop ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!