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

View File

@ -2,6 +2,12 @@ USING: combinators.lib kernel math random sequences tools.test continuations
arrays vectors ;
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
[ t ] [ [ 10 random ] [ even? ] generate even? ] unit-test

View File

@ -12,11 +12,16 @@ IN: combinators.lib
! Currying cleave combinators
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: bi+ ( obj quot quot -- quot' quot' )
: bi, ( obj quot quot -- quot' quot' )
[ [ 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
: 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
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

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

View File

@ -53,7 +53,7 @@ M: axis-gadget pref-dim* drop SIZE ;
: move-axis ( gadget x y z -- )
(xyz>loc) rot
[ indicator>> (>>loc) ]
[ z-indicator>> (>>loc) ] bi+ bi* ;
[ z-indicator>> (>>loc) ] bi, bi* ;
: move-pov ( gadget pov -- )
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 ;
: 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 )
<axis-gadget> [ >>raxis ] [ add-gadget-with-border ] bi+ bi* ;
<axis-gadget> [ >>raxis ] [ add-gadget-with-border ] bi, bi* ;
:: (add-button-gadgets) ( gadget shelf -- )
gadget controller>> read-controller buttons>> length [