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

extra: updates

modern-harvey2
Doug Coleman 2018-03-23 18:01:15 -05:00
parent 2c7a579ecd
commit cbf77f34cc
2 changed files with 17 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
extra/game-of-life/game-of-life.factor
View File

@ -26,14 +26,14 @@ IN: game-of-life
rows 1 - { fixnum } declare :> max-rows rows 1 - { fixnum } declare :> max-rows
cols 1 - { fixnum } declare :> max-cols cols 1 - { fixnum } declare :> max-cols
rows [ cols <byte-array> ] replicate :> neighbors rows [ cols <byte-array> ] replicate :> neighbors
grid { array } declare [| row j | grid { array } declare |[ row j |
j 0 eq? [ max-rows ] [ j 1 - ] if j 0 eq? [ max-rows ] [ j 1 - ] if
j j
j max-rows eq? [ 0 ] [ j 1 + ] if j max-rows eq? [ 0 ] [ j 1 + ] if
[ neighbors nth-unsafe { byte-array } declare ] tri@ :> [ neighbors nth-unsafe { byte-array } declare ] tri@ :>
( above same below ) ( above same below )
row { bit-array } declare [| cell i | row { bit-array } declare |[ cell i |
cell [ cell [
i 0 eq? [ max-cols ] [ i 1 - ] if i 0 eq? [ max-cols ] [ i 1 - ] if
i i
@ -49,9 +49,9 @@ IN: game-of-life
:: next-step ( grid -- ) :: next-step ( grid -- )
grid count-neighbors { array } declare :> neighbors grid count-neighbors { array } declare :> neighbors
grid { array } declare [| row j | grid { array } declare |[ row j |
j neighbors nth-unsafe { byte-array } declare :> neighbor-row j neighbors nth-unsafe { byte-array } declare :> neighbor-row
row { bit-array } declare [| cell i | row { bit-array } declare |[ cell i |
i neighbor-row nth-unsafe i neighbor-row nth-unsafe
cell [ cell [
2 3 between? i row set-nth-unsafe 2 3 between? i row set-nth-unsafe
@ -85,8 +85,8 @@ M: grid-gadget pref-dim*
rows new-rows = not rows new-rows = not
cols new-cols = not or [ cols new-cols = not or [
new-rows new-cols make-grid :> new-grid new-rows new-cols make-grid :> new-grid
rows new-rows min <iota> [| j | rows new-rows min <iota> |[ j |
cols new-cols min <iota> [| i | cols new-cols min <iota> |[ i |
i j grid nth nth i j grid nth nth
i j new-grid nth set-nth i j new-grid nth set-nth
] each ] each
@ -95,10 +95,10 @@ M: grid-gadget pref-dim*
] when ; ] when ;
:: draw-cells ( gadget -- ) :: draw-cells ( gadget -- )
COLOR: black gl-color color: black gl-color
gadget size>> :> size gadget size>> :> size
gadget grid>> { array } declare [| row j | gadget grid>> { array } declare |[ row j |
row { bit-array } declare [| cell i | row { bit-array } declare |[ cell i |
cell [ cell [
i j [ size * ] bi@ 2array i j [ size * ] bi@ 2array
{ size size } gl-fill-rect { size size } gl-fill-rect
@ -109,12 +109,12 @@ M: grid-gadget pref-dim*
:: draw-lines ( gadget -- ) :: draw-lines ( gadget -- )
gadget size>> :> size gadget size>> :> size
gadget grid>> grid-dim :> ( rows cols ) gadget grid>> grid-dim :> ( rows cols )
COLOR: gray gl-color color: gray gl-color
cols rows [ size * ] bi@ :> ( w h ) cols rows [ size * ] bi@ :> ( w h )
rows [0,b] [| j | rows [0,b] |[ j |
j size * :> y j size * :> y
{ 0 y } { w y } gl-line { 0 y } { w y } gl-line
cols [0,b] [| i | cols [0,b] |[ i |
i size * :> x i size * :> x
{ x 0 } { x h } gl-line { x 0 } { x h } gl-line
] each ] each

10
extra/pong/pong.factor
View File

@ -15,8 +15,8 @@ CONSTANT: PADDLE-DIM ${ PADDLE-SIZE 10 }
CONSTANT: FONT $[ CONSTANT: FONT $[
monospace-font monospace-font
t >>bold? t >>bold?
COLOR: red >>foreground color: red >>foreground
COLOR: gray95 >>background color: gray95 >>background
] ]
TUPLE: ball pos vel ; TUPLE: ball pos vel ;
@ -33,7 +33,7 @@ DEFER: on-tick
: <pong-gadget> ( -- gadget ) : <pong-gadget> ( -- gadget )
pong-gadget new initial-state pong-gadget new initial-state
COLOR: gray95 <solid> >>interior color: gray95 <solid> >>interior
dup '[ _ on-tick ] f 16 milliseconds <timer> >>timer ; dup '[ _ on-tick ] f 16 milliseconds <timer> >>timer ;
M: pong-gadget pref-dim* drop { 400 400 } ; M: pong-gadget pref-dim* drop { 400 400 } ;
@ -42,12 +42,12 @@ M: pong-gadget ungraft*
[ timer>> stop-timer ] [ call-next-method ] bi ; [ timer>> stop-timer ] [ call-next-method ] bi ;
M:: pong-gadget draw-gadget* ( PONG -- ) M:: pong-gadget draw-gadget* ( PONG -- )
COLOR: gray80 gl-color color: gray80 gl-color
15 390 20 <range> [ 15 390 20 <range> [
197 2array { 10 6 } gl-fill-rect 197 2array { 10 6 } gl-fill-rect
] each ] each
COLOR: black gl-color color: black gl-color
{ 0 0 } { 10 400 } gl-fill-rect { 0 0 } { 10 400 } gl-fill-rect
{ 390 0 } { 10 400 } gl-fill-rect { 390 0 } { 10 400 } gl-fill-rect