decimal

needs clink clink.fth

needs make-c-entry fentry.fth

"" cam.out clink

2 0 ' eval make-c-entry _forth_eval !

: struct 0 ;

: field  		\ name  ( offset size -- offset' )
   create  over  ,  +
   does> @ +	 	( base --- addr )
;

struct ( mpr_data )
  /l field md_linebytes
  /l field md_image
  /l field md_offset_x
  /l field md_offset_y
  /w field md_primary
  /w field md_flags
constant /mpr_data

struct ( Pixrect )
  /l field pr_ops
  /l field pr_width
  /l field pr_height
  /l field pr_depth
  /l field pr_data
constant /Pixrect

: pr_linebytes	pr_data @ md_linebytes ;
: pr_image	pr_data @ md_image ;

struct ( Can )
  /l field can_pix
  /l field can_filename
  /l field can_wire
  /l field can_hook
  /l field can_token
  /l field can_tag
  /c field can_grabbed
  /c field can_shared
constant /Can

: can_width	can_pix @ pr_width ;
: can_height	can_pix @ pr_height ;
: can_depth	can_pix @ pr_depth ;
: can_linebytes	can_pix @ pr_linebytes ;
: can_image	can_pix @ pr_image ;

struct ( Cam )
  /l field cam_past
  /l field cam_future
  /l field cam_wire
  /l field cam_token
  /l field cam_tag
  /l field cam_hook
  /l field cam_neighborhood
  /l field cam_rule
  /l field cam_rulesize
  /l field cam_src
  /l field cam_dst
  /l field cam_width
  /l field cam_height
  /c field cam_phase
  /c field cam_wrap
constant /Cam

\ Neighborhood definitions

: neighborhood
  create ' >body @ ,
  does>
    @ _cam @
    ?dup if
      cam_neighborhood !
    else
      drop
    then
;

: cam-box ( x y w h -- )
  _cam @ cam_height !
  _cam @ cam_width !
  2dup
  _cam @ cam_past @ can_linebytes @ * +
  _cam @ cam_past @ can_image @ +
  _cam @ cam_src !
  _cam @ cam_future @ can_linebytes @ * +
  _cam @ cam_future @ can_image @ +
  _cam @ cam_dst !
;

neighborhood n/moore	_n_moore_a
neighborhood n/moore-a	_n_moore_a
neighborhood n/moore-ab	_n_moore_ab
neighborhood n/vonn	_n_vonn_neumann
neighborhood n/marg	_n_margolis
neighborhood n/marg-ph	_n_margolis_ph
neighborhood n/marg-hv	_n_margolis_hv
neighborhood n/life	_n_life
neighborhood n/brain	_n_brain
neighborhood n/heat	_n_heat
neighborhood n/dheat	_n_dheat
neighborhood n/lheat	_n_lheat
neighborhood n/ldheat	_n_ldheat

\ minor &/centers
\ minor &/phases
\ minor &/hv

: cam-steps ( steps -- )
  _cam @ _cam_steps 2drop
;

: cstring,  ( string -- )
   count tuck  here  swap cmove   ( len )
   dup allot 0 c,
;

create file-name-buf 256 allot
: c-file-name ( string --- buf )
  count tuck file-name-buf swap cmove
  file-name-buf + 0 swap c!
  file-name-buf
;

: read-raster ( filename --- )
  c-file-name _cam_read_raster drop
  _cam_update
;

: write-raster ( filename --- )
  c-file-name _cam_write_raster drop
;

: use-compiled-rule
  rule-table _cam @ cam_rule !
  /rule-table _cam @ cam_rulesize !
;

variable cam-w variable cam-h
128 cam-w !  128 cam-h !

: init
  cam-h @ cam-w @ _cam_init 2drop
;

: (rule:)
  compile-rule-function
  use-compiled-rule
;

: rule:
  '
  state @ if
    compile (lit) , compile (rule:)
  else
    (rule:)
  then
; immediate

variable zaps 1 zaps !

: zap
  _cam_grab
  zaps @ cam-steps
  _cam_update
  _cam_ungrab
;

: r
  _Canvas @ _Can_Reset pop
;

: z
  begin zap key? until
  key drop
  _cam_ungrab
  _cam_flush
;