steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

bi, is really a better name than bi+. Add analogous bi*, and tri*, words along with unit tests

db4
Joe Groff 2008-07-27 11:15:27 -07:00
parent d2d5dba6a8
commit d6db9897fa
4 changed files with 17 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/combinators/lib/lib-tests.factor
View File

@ -2,6 +2,12 @@ USING: combinators.lib kernel math random sequences tools.test continuations
arrays vectors ; arrays vectors ;
IN: combinators.lib.tests IN: combinators.lib.tests
[ 6 -1 ] [ 5 0 1 [ + ] [ - ] bi, bi* ] unit-test
[ 6 -1 1 ] [ 5 0 1 1 [ + ] [ - ] [ * ] tri, tri* ] unit-test
[ 5 4 ] [ 5 0 1 [ + ] [ - ] bi*, bi ] unit-test
[ 5 4 5 ] [ 5 0 1 1 [ + ] [ - ] [ * ] tri*, tri ] unit-test
[ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test [ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test
[ t ] [ [ 10 random ] [ even? ] generate even? ] unit-test [ t ] [ [ 10 random ] [ even? ] generate even? ] unit-test

9
extra/combinators/lib/lib.factor
View File

@ -12,11 +12,16 @@ IN: combinators.lib
! Currying cleave combinators ! Currying cleave combinators
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: bi+ ( obj quot quot -- quot' quot' ) : bi, ( obj quot quot -- quot' quot' )
[ [ curry ] curry ] bi@ bi ; inline [ [ curry ] curry ] bi@ bi ; inline
: tri+ ( obj quot quot quot -- quot' quot' quot' ) : tri, ( obj quot quot quot -- quot' quot' quot' )
[ [ curry ] curry ] tri@ tri ; inline [ [ curry ] curry ] tri@ tri ; inline
: bi*, ( obj obj quot quot -- quot' quot' )
[ [ curry ] curry ] bi@ bi* ; inline
: tri*, ( obj obj obj quot quot quot -- quot' quot' quot' )
[ [ curry ] curry ] tri@ tri* ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Generalized versions of core combinators ! Generalized versions of core combinators
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

2
extra/game-input/game-input.factor
View File

@ -46,7 +46,7 @@ HOOK: instance-id game-input-backend ( controller -- id )
: find-controller-instance ( product-id instance-id -- controller/f ) : find-controller-instance ( product-id instance-id -- controller/f )
get-controllers [ get-controllers [
[ product-id = ] [ product-id = ]
[ instance-id = ] bi+ bi* and [ instance-id = ] bi, bi* and
] 2with find nip ; ] 2with find nip ;
HOOK: read-controller game-input-backend ( controller -- controller-state ) HOOK: read-controller game-input-backend ( controller -- controller-state )

6
extra/joystick-demo/joystick-demo.factor
View File

@ -53,7 +53,7 @@ M: axis-gadget pref-dim* drop SIZE ;
: move-axis ( gadget x y z -- ) : move-axis ( gadget x y z -- )
(xyz>loc) rot (xyz>loc) rot
[ indicator>> (>>loc) ] [ indicator>> (>>loc) ]
[ z-indicator>> (>>loc) ] bi+ bi* ; [ z-indicator>> (>>loc) ] bi, bi* ;
: move-pov ( gadget pov -- ) : move-pov ( gadget pov -- )
swap pov>> [ interior>> -rot = [ gray ] [ white ] if >>color drop ] swap pov>> [ interior>> -rot = [ gray ] [ white ] if >>color drop ]
@ -82,10 +82,10 @@ TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
[ >>controller ] [ product-string <label> add-gadget ] bi ; [ >>controller ] [ product-string <label> add-gadget ] bi ;
: add-axis-gadget ( gadget shelf -- gadget shelf ) : add-axis-gadget ( gadget shelf -- gadget shelf )
<axis-gadget> [ >>axis ] [ add-gadget-with-border ] bi+ bi* ; <axis-gadget> [ >>axis ] [ add-gadget-with-border ] bi, bi* ;
: add-raxis-gadget ( gadget shelf -- gadget shelf ) : add-raxis-gadget ( gadget shelf -- gadget shelf )
<axis-gadget> [ >>raxis ] [ add-gadget-with-border ] bi+ bi* ; <axis-gadget> [ >>raxis ] [ add-gadget-with-border ] bi, bi* ;
:: (add-button-gadgets) ( gadget shelf -- ) :: (add-button-gadgets) ( gadget shelf -- )
gadget controller>> read-controller buttons>> length [ gadget controller>> read-controller buttons>> length [