Days 5-6

advent-2021-05a.fs

+1000 constant dim
+: allocate-board ( -- a ) dim dim * allocate if ." Error!" quit then ;
+allocate-board  variable (board)  (board) !
+(board) @  dim dim *  0  fill
+
+: board ( -- a ) (board) @ ;
+: xy ( x y -- o ) dim * + ;
+: c1+! ( a -- ) dup  c@ 1+  swap c! ;
+: >vent ( x y -- ) xy board +  c1+! ;
+: dangers ( -- n ) 0  dim dim *  0 do  i board + c@  1- 0 max 1 min  +  loop ;
+
+variable inp
+: get-line ( -- n ) pad 81 bl fill  pad 80 accept  pad inp ! ;
+: i>n ( -- n ) 0 0   inp @ 80   >number   drop  inp !  drop ;
+: i>_ ( delim -- )
+  begin  dup  inp @  c@ = 0=  while  1 inp +!  repeat  drop  1 inp +! ; 
+
+variable x1   variable y1   variable x2   variable y2
+: split ( -- x1 y1 x2 y2 ) i>n  44 i>_  i>n  62 i>_ bl i>_  i>n  44 i>_  i>n ;
+: store                    y2 ! x2 ! y1 ! x1 ! ;
+
+: bound ( n n -- big+1 small ) 2dup > if swap then 1+ swap ;
+
+: vert  ( -- ) x1 @ x2 @ = if y1 @ y2 @ bound do x1 @ i >vent loop rdrop then ;
+: horiz ( -- ) y1 @ y2 @ = if x1 @ x2 @ bound do i y1 @ >vent loop rdrop then ;
+
+: process ( -- ) vert horiz ;
+
+: go ( -- ) begin  get-line  while  split store process   repeat
+  ." Answer:" dangers . ;
+
+go
\ No newline at end of file

advent-2021-05b.fs

+1000 constant dim
+: allocate-board ( -- a ) dim dim * allocate if ." Error!" quit then ;
+allocate-board  variable (board)  (board) !
+(board) @  dim dim *  0  fill
+
+: board ( -- a ) (board) @ ;
+: xy ( x y -- o ) dim * + ;
+: c1+! ( a -- ) dup  c@ 1+  swap c! ;
+: >vent ( x y -- ) xy board +  c1+! ;
+: dangers ( -- n ) 0  dim dim *  0 do  i board + c@  1- 0 max 1 min  +  loop ;
+
+variable inp
+: get-line ( -- n ) pad 81 bl fill  pad 80 accept  pad inp ! ;
+: i>n ( -- n ) 0 0   inp @ 80   >number   drop  inp !  drop ;
+: i>_ ( delim -- )
+  begin  dup  inp @  c@ = 0=  while  1 inp +!  repeat  drop  1 inp +! ; 
+
+variable x1   variable y1   variable x2   variable y2
+: split ( -- x1 y1 x2 y2 ) i>n  44 i>_  i>n  62 i>_ bl i>_  i>n  44 i>_  i>n ;
+: store                    y2 ! x2 ! y1 ! x1 ! ;
+
+: bound ( n n -- big+1 small ) 2dup > if swap then 1+ swap ;
+
+: vert  ( -- ) x1 @ x2 @ = if y1 @ y2 @ bound do x1 @ i >vent loop rdrop then ;
+: horiz ( -- ) y1 @ y2 @ = if x1 @ x2 @ bound do i y1 @ >vent loop rdrop then ;
+
+: normalize-x ( -- ) x1 @ x2 @ > if
+  x1 @ x2 x2 @ x1 ! ! y1 @ y2 y2 @ y1 ! ! then ;
+
+: (diag) ( ydelta -- )
+  y1 @  x2 @ x1 @ bound  do  i over >vent  over +  loop 2drop ;
+
+: diag ( -- ) normalize-x  y1 @ y2 @ <  1 and 2* 1-  (diag) ;
+: process ( -- ) vert horiz diag ;
+: go ( -- ) begin  get-line  while  split store process   repeat
+  ." Answer:" dangers . ;
+
+go
\ No newline at end of file

advent-2021-06ab.fs

+\ To avoid using tons of memory, we should keep a count of lanternfish
+\ of each age.
+
+\ Use two buffers so we can ping-pong.
+
+\ buffer "old" describes fishes in step 0 
+\ new[0 .. 7] = old[1 .. 8]
+\ new[6] += old[0]
+\ new[8] = old[0]
+\ buffer "new" now describes fishes in step 1
+
+: clear ( a -- ) 9 cells  0 fill ;
+create b1 9 cells allot    b1 clear
+create b2 9 cells allot    b2 clear
+variable (old)   b1 (old) !   : old ( -- a ) (old) @ ;
+variable (new)   b2 (new) !   : new ( -- a ) (new) @ ;
+
+: page-flip ( -- ) (new) @ (old)   (old) @ (new)  ! ! ;
+: slide ( -- ) old cell +   new   8 cells   cmove> ;
+: refract ( -- ) old @  new 6 cells +  +! ;
+: spawn ( -- )   old @  new 8 cells +  ! ;
+
+: add-fish ( n -- ) cells   old +   1 swap +! ;
+: step ( -- ) slide refract spawn page-flip ;
+: count-fish ( -- n ) 0  9 0 do  old  i cells +  @ +  loop ;
+: days ( n -- ) 1 +  1  do step count-fish i ." Day" . ." : " . cr loop ;
+
+: handle-char ( c -- )
+  dup 10 = if drop rdrop exit then
+  48 - dup 10 u> if drop else add-fish then ;
+  
+: get-input ( -- ) begin key handle-char again ;
+
+get-input 256 days
\ No newline at end of file