use ">>foo" instead of "over foo<<".

db4
John Benediktsson 2014-12-11 20:55:04 -08:00
parent 26583dbbaa
commit b76503a718
4 changed files with 14 additions and 14 deletions

View File

@ -53,7 +53,7 @@ M: growable set-length ( n seq -- )
2dup length >= [ 2dup length >= [
2dup capacity >= [ over new-size over expand ] when 2dup capacity >= [ over new-size over expand ] when
[ integer>fixnum ] dip [ integer>fixnum ] dip
over 1 fixnum+fast over length<< over 1 fixnum+fast >>length
] [ ] [
[ integer>fixnum ] dip [ integer>fixnum ] dip
] if ; inline ] if ; inline

View File

@ -518,9 +518,9 @@ ERROR: undefined-8080-opcode n ;
] [ ] [
[ [ 16667 - ] dip cycles<< ] keep [ [ 16667 - ] dip cycles<< ] keep
dup last-interrupt>> 0x10 = [ dup last-interrupt>> 0x10 = [
0x08 over last-interrupt<< 0x08 swap interrupt 0x08 >>last-interrupt 0x08 swap interrupt
] [ ] [
0x10 over last-interrupt<< 0x10 swap interrupt 0x10 >>last-interrupt 0x10 swap interrupt
] if ] if
] if ; ] if ;

View File

@ -86,7 +86,7 @@ CONSTANT: SOUND-UFO-HIT 8
f swap looping?<< ; f swap looping?<< ;
: cpu-init ( cpu -- cpu ) : cpu-init ( cpu -- cpu )
make-opengl-bitmap over bitmap<< make-opengl-bitmap >>bitmap
[ init-sounds ] keep [ init-sounds ] keep
[ reset ] keep ; [ reset ] keep ;
@ -159,11 +159,11 @@ M: space-invaders read-port ( port cpu -- byte )
#! Bit 4 = Extended play sound #! Bit 4 = Extended play sound
over 0 bit? over looping?>> not and [ over 0 bit? over looping?>> not and [
dup SOUND-UFO play-invaders-sound dup SOUND-UFO play-invaders-sound
t over looping?<< t >>looping?
] when ] when
over 0 bit? not over looping?>> and [ over 0 bit? not over looping?>> and [
dup SOUND-UFO stop-invaders-sound dup SOUND-UFO stop-invaders-sound
f over looping?<< f >>looping?
] when ] when
2dup 0 port3-newly-set? [ dup SOUND-UFO play-invaders-sound ] when 2dup 0 port3-newly-set? [ dup SOUND-UFO play-invaders-sound ] when
2dup 1 port3-newly-set? [ dup SOUND-SHOT play-invaders-sound ] when 2dup 1 port3-newly-set? [ dup SOUND-SHOT play-invaders-sound ] when
@ -229,9 +229,9 @@ M: space-invaders reset ( cpu -- )
] [ ] [
[ [ 16667 - ] dip cycles<< ] keep [ [ 16667 - ] dip cycles<< ] keep
dup last-interrupt>> 0x10 = [ dup last-interrupt>> 0x10 = [
0x08 over last-interrupt<< 0x08 swap interrupt 0x08 >>last-interrupt 0x08 swap interrupt
] [ ] [
0x10 over last-interrupt<< 0x10 swap interrupt 0x10 >>last-interrupt 0x10 swap interrupt
] if ] if
] if ; ] if ;
@ -278,7 +278,7 @@ M: space-invaders reset ( cpu -- )
TUPLE: invaders-gadget < gadget cpu quit? windowed? ; TUPLE: invaders-gadget < gadget cpu quit? windowed? ;
invaders-gadget H{ invaders-gadget H{
{ T{ key-down f f "ESC" } [ t over quit?<< dup windowed?>> [ close-window ] [ drop ] if ] } { T{ key-down f f "ESC" } [ t >>quit? dup windowed?>> [ close-window ] [ drop ] if ] }
{ T{ key-down f f "BACKSPACE" } [ cpu>> coin-down ] } { T{ key-down f f "BACKSPACE" } [ cpu>> coin-down ] }
{ T{ key-up f f "BACKSPACE" } [ cpu>> coin-up ] } { T{ key-up f f "BACKSPACE" } [ cpu>> coin-up ] }
{ T{ key-down f f "1" } [ cpu>> player1-down ] } { T{ key-down f f "1" } [ cpu>> player1-down ] }
@ -377,7 +377,7 @@ M: space-invaders update-video ( value addr cpu -- )
M: invaders-gadget graft* ( gadget -- ) M: invaders-gadget graft* ( gadget -- )
dup cpu>> init-sounds dup cpu>> init-sounds
f over quit?<< f >>quit?
[ gmt timestamp>micros swap invaders-process ] curry [ gmt timestamp>micros swap invaders-process ] curry
"Space invaders" threads:spawn drop ; "Space invaders" threads:spawn drop ;

View File

@ -74,7 +74,7 @@ DEFER: avl-set
: (avl-set) ( value key node -- node taller? ) : (avl-set) ( value key node -- node taller? )
2dup key>> = [ 2dup key>> = [
-rot pick key<< over value<< f -rot pick key<< >>value f
] [ avl-insert ] if ; ] [ avl-insert ] if ;
: avl-set ( value key node -- node taller? ) : avl-set ( value key node -- node taller? )
@ -85,7 +85,7 @@ M: avl set-at ( value key node -- )
: delete-select-rotate ( node -- node shorter? ) : delete-select-rotate ( node -- node shorter? )
dup node+link balance>> zero? [ dup node+link balance>> zero? [
current-side get neg over balance<< current-side get neg >>balance
current-side get over node+link balance<< rotate f current-side get over node+link balance<< rotate f
] [ ] [
select-rotate t select-rotate t
@ -100,7 +100,7 @@ M: avl set-at ( value key node -- )
: balance-delete ( node -- node shorter? ) : balance-delete ( node -- node shorter? )
current-side get over balance>> { current-side get over balance>> {
{ [ dup zero? ] [ drop neg over balance<< f ] } { [ dup zero? ] [ drop neg >>balance f ] }
{ [ 2dup = ] [ 2drop 0 >>balance t ] } { [ 2dup = ] [ 2drop 0 >>balance t ] }
[ drop neg increase-balance rebalance-delete ] [ drop neg increase-balance rebalance-delete ]
} cond ; } cond ;