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

db4
Slava Pestov 2008-07-12 01:22:31 -05:00
commit 0d6ed2b85a
16 changed files with 60 additions and 62 deletions

View File

@ -1,6 +1,6 @@
USING: kernel math math.parser random arrays hashtables assocs sequences USING: kernel math math.parser random arrays hashtables assocs sequences
vars ; grouping vars ;
IN: automata IN: automata
@ -32,29 +32,16 @@ dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ;
! step-wrapped-line ! step-wrapped-line
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: 3nth ( n seq -- slice ) >r dup 3 + r> <slice> ; : pattern>state ( {_a_b_c_} -- state ) >array rule> at ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: map3-i ( seq -- i ) length 2 - ;
: map3-quot ( seq quot -- quot ) >r [ 3nth ] curry r> compose ; inline
: map3 ( seq quot -- seq ) >r dup map3-i swap r> map3-quot map ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: pattern>state ( {_a_b_c_} -- state ) rule> at ;
: cap-line ( line -- 0-line-0 ) { 0 } prepend { 0 } append ; : cap-line ( line -- 0-line-0 ) { 0 } prepend { 0 } append ;
: wrap-line ( a-line-z -- za-line-za ) : wrap-line ( a-line-z -- za-line-za )
dup peek 1array swap dup first 1array append append ; dup peek 1array swap dup first 1array append append ;
: step-line ( line -- new-line ) [ >array pattern>state ] map3 ; : step-line ( line -- new-line ) 3 <clumps> [ pattern>state ] map ;
: step-capped-line ( line -- new-line ) cap-line step-line ;
: step-capped-line ( line -- new-line ) cap-line step-line ;
: step-wrapped-line ( line -- new-line ) wrap-line step-line ; : step-wrapped-line ( line -- new-line ) wrap-line step-line ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -15,7 +15,7 @@ USING: kernel namespaces math quotations arrays hashtables sequences threads
ui.gadgets.grids ui.gadgets.grids
ui.gadgets.theme ui.gadgets.theme
namespaces.lib assocs.lib vars namespaces.lib assocs.lib vars
rewrite-closures automata ; rewrite-closures automata math.geometry.rect ;
IN: automata.ui IN: automata.ui

View File

@ -3,7 +3,7 @@
USING: kernel math math.functions math.parser models USING: kernel math math.functions math.parser models
models.filter models.range models.compose sequences ui models.filter models.range models.compose sequences ui
ui.gadgets ui.gadgets.frames ui.gadgets.labels ui.gadgets.packs ui.gadgets ui.gadgets.frames ui.gadgets.labels ui.gadgets.packs
ui.gadgets.sliders ui.render ; ui.gadgets.sliders ui.render math.geometry.rect ;
IN: color-picker IN: color-picker
! Simple example demonstrating the use of models. ! Simple example demonstrating the use of models.

View File

@ -1,6 +1,9 @@
! Copyright (C) 2007, 2008 Alex Chapman ! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alarms arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render math.vectors ; USING: accessors alarms arrays calendar jamshred.game jamshred.gl
jamshred.player jamshred.log kernel math math.constants namespaces
sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds
ui.gestures ui.render math.vectors math.geometry.rect ;
IN: jamshred IN: jamshred
TUPLE: jamshred-gadget jamshred last-hand-loc alarm ; TUPLE: jamshred-gadget jamshred last-hand-loc alarm ;

View File

@ -0,0 +1,37 @@
USING: tools.test math.geometry.rect ;
IN: math.geometry.rect.tests
[ T{ rect f { 10 10 } { 20 20 } } ]
[
T{ rect f { 10 10 } { 50 50 } }
T{ rect f { -10 -10 } { 40 40 } }
rect-intersect
] unit-test
[ T{ rect f { 200 200 } { 0 0 } } ]
[
T{ rect f { 100 100 } { 50 50 } }
T{ rect f { 200 200 } { 40 40 } }
rect-intersect
] unit-test
[ f ] [
T{ rect f { 100 100 } { 50 50 } }
T{ rect f { 200 200 } { 40 40 } }
intersects?
] unit-test
[ t ] [
T{ rect f { 100 100 } { 50 50 } }
T{ rect f { 120 120 } { 40 40 } }
intersects?
] unit-test
[ f ] [
T{ rect f { 1000 100 } { 50 50 } }
T{ rect f { 120 120 } { 40 40 } }
intersects?
] unit-test

View File

@ -1,7 +1,7 @@
! From http://www.ffconsultancy.com/ocaml/maze/index.html ! From http://www.ffconsultancy.com/ocaml/maze/index.html
USING: sequences namespaces math math.vectors opengl opengl.gl USING: sequences namespaces math math.vectors opengl opengl.gl
arrays kernel random ui ui.gadgets ui.gadgets.canvas ui.render arrays kernel random ui ui.gadgets ui.gadgets.canvas ui.render
math.order ; math.order math.geometry.rect ;
IN: maze IN: maze
: line-width 8 ; : line-width 8 ;

View File

@ -10,7 +10,7 @@ USING: kernel namespaces threads combinators sequences arrays
combinators.cleave combinators.cleave
rewrite-closures fry accessors newfx rewrite-closures fry accessors newfx
processing.color processing.color
processing.gadget ; processing.gadget math.geometry.rect ;
IN: processing IN: processing

View File

@ -38,6 +38,8 @@ C: <node> node
! : >>vel ( node vel -- node ) over set-node-vel ; ! : >>vel ( node vel -- node ) over set-node-vel ;
: node-vel ( node -- vel ) vel>> ;
: set-node-vel ( vel node -- ) swap >>vel drop ; : set-node-vel ( vel node -- ) swap >>vel drop ;
: pos-x ( node -- x ) pos>> first ; : pos-x ( node -- x ) pos>> first ;

View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alarms arrays calendar kernel ui.gadgets ui.gadgets.labels USING: alarms arrays calendar kernel ui.gadgets ui.gadgets.labels
ui.gadgets.worlds ui.gadgets.status-bar ui.gestures ui.render ui ui.gadgets.worlds ui.gadgets.status-bar ui.gestures ui.render ui
tetris.game tetris.gl sequences system math math.parser namespaces ; tetris.game tetris.gl sequences system math math.parser namespaces
math.geometry.rect ;
IN: tetris IN: tetris
TUPLE: tetris-gadget tetris alarm ; TUPLE: tetris-gadget tetris alarm ;

View File

@ -1,6 +1,6 @@
IN: ui.gadgets.borders.tests IN: ui.gadgets.borders.tests
USING: tools.test accessors namespaces kernel USING: tools.test accessors namespaces kernel
ui.gadgets ui.gadgets.borders ; ui.gadgets ui.gadgets.borders math.geometry.rect ;
[ { 110 210 } ] [ <gadget> { 100 200 } >>dim 5 <border> pref-dim ] unit-test [ { 110 210 } ] [ <gadget> { 100 200 } >>dim 5 <border> pref-dim ] unit-test

View File

@ -1,7 +1,7 @@
USING: kernel alien.c-types combinators sequences splitting grouping USING: kernel alien.c-types combinators sequences splitting grouping
opengl.gl ui.gadgets ui.render opengl.gl ui.gadgets ui.render
math math.vectors accessors ; math math.vectors accessors math.geometry.rect ;
IN: ui.gadgets.frame-buffer IN: ui.gadgets.frame-buffer

View File

@ -2,39 +2,7 @@ IN: ui.gadgets.tests
USING: accessors ui.gadgets ui.gadgets.packs ui.gadgets.worlds USING: accessors ui.gadgets ui.gadgets.packs ui.gadgets.worlds
tools.test namespaces models kernel dlists dequeues math sets tools.test namespaces models kernel dlists dequeues math sets
math.parser ui sequences hashtables assocs io arrays prettyprint math.parser ui sequences hashtables assocs io arrays prettyprint
io.streams.string ; io.streams.string math.geometry.rect ;
[ T{ rect f { 10 10 } { 20 20 } } ]
[
T{ rect f { 10 10 } { 50 50 } }
T{ rect f { -10 -10 } { 40 40 } }
rect-intersect
] unit-test
[ T{ rect f { 200 200 } { 0 0 } } ]
[
T{ rect f { 100 100 } { 50 50 } }
T{ rect f { 200 200 } { 40 40 } }
rect-intersect
] unit-test
[ f ] [
T{ rect f { 100 100 } { 50 50 } }
T{ rect f { 200 200 } { 40 40 } }
intersects?
] unit-test
[ t ] [
T{ rect f { 100 100 } { 50 50 } }
T{ rect f { 120 120 } { 40 40 } }
intersects?
] unit-test
[ f ] [
T{ rect f { 1000 100 } { 50 50 } }
T{ rect f { 120 120 } { 40 40 } }
intersects?
] unit-test
[ { 300 300 } ] [ { 300 300 } ]
[ [

View File

@ -1,5 +1,5 @@
USING: ui.gadgets ui.gadgets.grids tools.test kernel arrays USING: ui.gadgets ui.gadgets.grids tools.test kernel arrays
namespaces ; namespaces math.geometry.rect ;
IN: ui.gadgets.grids.tests IN: ui.gadgets.grids.tests
[ { 0 0 } ] [ { } <grid> pref-dim ] unit-test [ { 0 0 } ] [ { } <grid> pref-dim ] unit-test

View File

@ -1,6 +1,6 @@
IN: ui.gadgets.packs.tests IN: ui.gadgets.packs.tests
USING: ui.gadgets.packs ui.gadgets.labels ui.gadgets ui.render USING: ui.gadgets.packs ui.gadgets.labels ui.gadgets ui.render
kernel namespaces tools.test math.parser sequences ; kernel namespaces tools.test math.parser sequences math.geometry.rect ;
[ t ] [ [ t ] [
{ 0 0 } { 100 100 } <rect> clip set { 0 0 } { 100 100 } <rect> clip set

View File

@ -3,7 +3,7 @@ USING: ui.gadgets ui.gadgets.scrollers namespaces tools.test
kernel models models.compose models.range ui.gadgets.viewports kernel models models.compose models.range ui.gadgets.viewports
ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames
ui.gadgets.sliders math math.vectors arrays sequences ui.gadgets.sliders math math.vectors arrays sequences
tools.test.ui ; tools.test.ui math.geometry.rect ;
[ ] [ [ ] [
<gadget> "g" set <gadget> "g" set

View File

@ -1,4 +1,4 @@
USING: kernel ui.gadgets ui.gadgets.tracks tools.test ; USING: kernel ui.gadgets ui.gadgets.tracks tools.test math.geometry.rect ;
IN: ui.gadgets.tracks.tests IN: ui.gadgets.tracks.tests
[ { 100 100 } ] [ [ { 100 100 } ] [