use ">>foo" instead of "over foo<<".
parent
26583dbbaa
commit
b76503a718
|
@ -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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
Loading…
Reference in New Issue