turmite.fs

\ lf94 / [email protected]
\ I git turmites in me house
\ 2-state 2-color turmite

\ check a condition is true otherwise abort
: assert ( bool -- ) <> abort" not equal" ;

0 constant state.0
1 constant state.1

0 constant color.0
1 constant color.1

0 constant dir.east
1 constant dir.south
2 constant dir.west
3 constant dir.north
4 constant dir.total

64 constant width
16 constant height

: bits ( n -- n ) 8 / ;
: by ;
: lines * ;

: bitmap-new, ( -- )
  here
  width bits by height lines \ calc the total bytes needed
  dup allot                  \ allot them
  ( here n ) 0 do ( here ) 0 over I + ! loop \ fill with zeros
  ( here ) drop
;

create bitmap bitmap-new,
create bug.x 32 ,
create bug.y 8 ,
create bug.dir dir.east ,

: state.0,color.0 color.0 = swap state.0 = and ;
: state.0,color.1 color.1 = swap state.0 = and ;
: state.1,color.0 color.0 = swap state.1 = and ;
: state.1,color.1 color.1 = swap state.1 = and ;

: bug.turn-right! ( -- )
  bug.dir @ 1 + \ next dir is always +90deg
  dir.total mod \ loop around to zero
  bug.dir !
;
: bug.turn-none ( -- ) ;
: bug.crawl! ( -- )
  bug.dir @ case
    dir.east  of bug.x @ 1 + width  min bug.x ! endof
    dir.south of bug.y @ 1 + height min bug.y ! endof
    dir.west  of bug.x @ 1 - 0      max bug.x ! endof
    dir.north of bug.y @ 1 - 0      max bug.y ! endof
  endcase
;
: bug.xy! ( x y -- ) bug.y ! bug.x ! ;
: bug.xy@ ( -- x y ) bug.x @ bug.y @ ;

: xy-to-bit-index ( x y -- u )
  width * +
;

\ 18 0 xy-to-bit-index ) 18 assert
\ 18 3 xy-to-bit-index ) 24 8 * 18 + assert

: bitmap.bit! ( bit x y -- )
  rot rot swap ( y x bit ) over 8 mod
  ( y x bit x2 ) lshift
  ( y x bit2 ) -rot swap
  ( bit2 x y ) over swap ( bit2 x x y ) xy-to-bit-index 8 /
  ( bit2 x n ) bitmap + dup c@
  ( bit2 x addr c ) rot
  ( bit2 addr c x ) 8 mod 1 swap lshift invert and
  ( bit2 addr c ) rot ( addr bit2 c ) or
  ( addr c ) swap c!
;
: bitmap.bit@ ( x y -- bit )
  over swap ( x x y ) xy-to-bit-index 8 / bitmap + c@
  swap ( c x ) 8 mod rshift 1 and
;

\ 0 0 bug.xy!
\ color.1 bug.xy@ bitmap.bit!
\ bug.xy@ bitmap.bit@ 1 assert
\ 1 0 bug.xy!
\ color.1 bug.xy@ bitmap.bit!
\ bug.xy@ bitmap.bit@ 1 assert
\ 2 0 bug.xy!
\ color.1 bug.xy@ bitmap.bit!
\ bug.xy@ bitmap.bit@ 1 assert
\ 3 0 bug.xy!
\ color.1 bug.xy@ bitmap.bit!
\ bug.xy@ bitmap.bit@ 1 assert
\ 4 0 bug.xy!
\ color.1 bug.xy@ bitmap.bit!
\ bug.xy@ bitmap.bit@ 1 assert
\ 8 0 bug.xy!
\ color.1 bug.xy@ bitmap.bit!
\ bug.xy@ bitmap.bit@ 1 assert
\ 9 0 bug.xy!
\ color.1 bug.xy@ bitmap.bit!
\ bug.xy@ bitmap.bit@ 1 assert
 
\ width 0 bug.xy!
\ color.1 bug.xy@ bitmap.bit!
\ bug.xy@ bitmap.bit@ 1 assert

\ width 2 / height 2 / bug.xy!
\ color.1 bug.xy@ bitmap.bit!
\ bug.xy@ bitmap.bit@ 1 assert

\ width height 2 / bug.xy!
\ color.0 bug.xy@ bitmap.bit!
\ bug.xy@ bitmap.bit@ 0 assert

\ Lazy grid plotting, much more performant than full redraw.
: term.emit-color ( color -- )
  bug.x @ bug.y @ at-xy
  dup color.0 = if       bl emit then
  dup color.1 = if [char] O emit then
;

\ Full grid output, intended for debugging.
: term.emit-grid ( -- )
  width bits by height lines 0 do
    I bitmap + c@
    8 0 do
      dup I rshift 1 and 1 = if [char] O else bl then emit
    loop drop
    I 1 +  width bits  mod 0 = if cr then
  loop
;

: transition ( state color -- state )
  over over state.0,color.0 if
    drop drop color.1 bug.xy@ bitmap.bit! bug.turn-right! bug.crawl! state.0 exit
  then
  over over state.0,color.1 if
    drop drop color.1 bug.xy@ bitmap.bit! bug.turn-right! bug.crawl! state.1 exit
  then
  over over state.1,color.0 if
    drop drop color.0 bug.xy@ bitmap.bit! bug.turn-none   bug.crawl! state.0 exit
  then
  over over state.1,color.1 if
    drop drop color.0 bug.xy@ bitmap.bit! bug.turn-none   bug.crawl! state.1 exit
  then
  ( state color ) drop drop
;

: main
  10000 0 do
    transition
    ( state ) bug.xy@ bitmap.bit@
    dup term.emit-color
    20 ms
  loop
  ( state color ) drop drop
;

\ term.emit-grid
state.0 color.0 main