day11_lib.tal

( get-at w h -- )
@dump-matrix
  [ ,&h STR2 ]
  [ ,&w STR2 ]
  [ ,&get-at STR2 ]
  LIT2r 0000 ( : y )
  &row-loop
    #0000 ( x : y )
    &col-loop
      DUP2 STH2rk LIT2 [ &get-at $2 ] JSR2
      #30 ADD EMIT
      INC2 ( x+1 : y )
      DUP2 [ ,&w LDR2 ] LTH2 ,&col-loop JCN
    POP2 ( : y )
    LF
    INC2r ( : y+1 )
    STH2rk [ ,&h LDR2 ] LTH2 ,&row-loop JCN
  ( : y )
  POP2r
  RTN
  [ &w $2 &h $2 ]

( get-ptr-at w h -- )
@dump-ptr-matrix
  STH2 STH2 [ ,&get-ptr-at2 STR2 ]
  ;&get-at STH2r STH2r ;dump-matrix JMP2

  &get-at
    LIT2 [ &get-ptr-at2 $2 ] JSR2 LDA
    RTN

( get-byte matrix* border -- w h )
@parse-matrix
  [ ;&border STA ]
  [ ;&matrix STA2 ]
  [ ;&get-byte-addr STA2 ]
  #0000 [ ;&w STA2 ]
  #0002 [ ;&h STA2 ]

  ( scan first row to get width )
  ;&parse-row JSR2
  [ ;&row-w LDA2 ] [ ;&w STA2 ]

  ( write border row into matrix )
  ;&append-border-row JSR2

  ( copy first row into matrix )
  ;&append-row JSR2

  ( parse other rows )
  &next-row
    ;&parse-row JSR2
    [ ;&row-w LDA2 ] #0002 EQU2 ,&done JCN
    ;&append-row JSR2
    ,&next-row JMP

  &done

  ;&append-border-row JSR2

  [ ;&w LDA2 ] [ ;&h LDA2 ] RTN

  [ &row $100 &matrix $2 &w $2 &h $2 &row-w $2 &border $1 ]

  &get-byte
    LIT2 [ &get-byte-addr $2 ] JMP2

  &parse-row
    ;&row STH2 ( : row* )
    [ ,&border LDR ] STH2rk STA INC2r
    &next-char
      ;&get-byte JSR2
      DUP #00 EQU ,&row-done JCN
      DUP #0a EQU ,&row-done JCN
      #30 SUB
      STH2rk STA INC2r
      ,&next-char JMP
    &row-done
    POP
    [ ,&border LDR ] STH2rk STA INC2r

    STH2r ;&row SUB2 [ ;&row-w STA2 ]
    RTN

  &append-border-row
    ;&row [ ;&w LDA2 ] ADD2 STH2 ( : rowend* )
    [ ;&matrix LDA2 ] ;&row STH2 ( matrix* : row* rowend* )
    &fill-top-next-char
      #00 [ ,&border LDR ] OVR2 STA POP
      INC2 INC2r
      ( loop if rowend > row )
      GTH2rk STHr ,&fill-top-next-char JCN
    POP2r POP2r
    ( matrix* ) [ ;&matrix STA2 ]
    RTN

  &append-row
    ;&row [ ;&w LDA2 ] ADD2 STH2 ( : rowend* )
    [ ;&matrix LDA2 ] ;&row STH2 ( matrix* : row* rowend* )
    &copy-next-char
      STH2rk LDA #00 SWP OVR2 STA POP
      INC2 INC2r
      ( loop if rowend > row )
      GTH2rk STHr ,&copy-next-char JCN
    POP2r POP2r
    ( matrix* ) [ ;&matrix STA2 ]
    [ ;&h *INC2 ]
    RTN

( get-ptr-at w h -- )
@increment-matrix
  ;&increment-cell ;visit-matrix-skipborder JMP2

  ( cell* -- cell* )
  &increment-cell
    STH2k LDA INC STH2rk STA STH2r
    RTN

( get-ptr-at w h visitor[ x y cell* -- x y cell* ] -- )
@visit-matrix
  STH2 STH2 STH2
  STH2r STH2r
  #0000 #0000
  STH2r
  ;visit-submatrix JMP2

( get-ptr-at w h visitor[ x y cell* -- x y cell* ] -- )
@visit-matrix-skipborder
  STH2 STH2 STH2
  STH2r DEC2 STH2r DEC2
  #0001 #0001
  STH2r
  ;visit-submatrix JMP2

( get-ptr-at w h x0 y0 visitor[ x y cell* -- x y cell* ] -- )
@visit-submatrix
  [ ;&visitor STA2 ]
  [ ,&y0 STR2 ]
  [ ,&x0 STR2 ]
  [ ,&h STR2 ]
  [ ,&w STR2 ]
  [ ,&get-ptr-at STR2 ]
  [ ,&y0 LDR2 ] STH2 ( : y )
  &row-loop
    [ ,&x0 LDR2 ] ( x : y )
    &col-loop
      DUP2 STH2rk LIT2 [ &get-ptr-at $2 ] JSR2
      ( x cell* : y )

      ( visit cell )

      STH2rk SWP2 ( x y cell* : y )

      LIT2 [ &visitor $2 ] JSR2

      POP2 POP2
       ( x cell* : y )

      INC2 ( x+1 : y )
      DUP2 [ ,&w LDR2 ] LTH2 ,&col-loop JCN
    POP2 ( : y )
    INC2r ( : y+1 )
    STH2rk [ ,&h LDR2 ] LTH2 ,&row-loop JCN
  ( : y )
  POP2r
  RTN
  [ &x0 $2 &y0 $2 &w $2 &h $2 ]

( get-ptr-at w h -- flashcount )
@flash-matrix
  [ ,&h STR2 ]
  [ ,&w STR2 ]
  [ ,&get-ptr-at STR2 ]
  #0000 [ ,&flashtotal STR2 ]

  &again
    #00 [ ;&flashcount STA ]
    [ ,&get-ptr-at LDR2 ] [ ,&w LDR2 ] [ ,&h LDR2 ] ;&flash-cell ;visit-matrix-skipborder JSR2
    ( LF [ ,&get-ptr-at LDR2 ] [ ,&w LDR2 ] [ ,&h LDR2 ] ;dump-ptr-matrix JSR2 LF )
    #00 [ ,&flashcount LDR ] [ ,&flashtotal LDR2 ] ADD2 [ ,&flashtotal STR2 ]
    [ ,&flashcount LDR ] ,&again JCN

  [ ,&get-ptr-at LDR2 ] [ ,&w LDR2 ] [ ,&h LDR2 ] ;&cool-cell ;visit-matrix JSR2
  ;&clear-border JSR2

  [ ,&flashtotal LDR2 ]

  RTN

  [ &get-ptr-at $2 &flashcount $1 &w $2 &h $2 &flashtotal $2 ]

  ( x y cell* )
  &flash-cell
    LDAk ( cell )
    #09 LEQ ;&not-flashing JCN2
    LDAk #80 GTH ;&not-flashing JCN2
      ( x y cell* )

      ( increment count )
      [ ;&flashcount *INC ]

      ( make cell negative enough that it doesn't flash again this turn )
      STH2 #f0 STH2rk STA STH2r

      STH2 ( x y : cell* )

      ;&neighbors [ ,&neighbor-ptr STR2 ]
      LITr 08 ( : cnt )
      &nloop
        [ ,&neighbor-ptr LDR2 ]
        DUP2 LDA4 STH4 4++
        [ ,&neighbor-ptr STR2 ]

        STH4r ,&inc-neighbor JSR

        DECr STHrk ,&nloop JCN
      POPr

      STH2r ( x y cell* )
      &not-flashing
    RTN
  [ &neighbor-ptr $2
    &neighbors
      0001 0000
      0001 0001
      0001 ffff
      0000 0001
      0000 ffff
      ffff 0000
      ffff 0001
      ffff ffff ]

  ( x y -- )
  &inc-cell
    [ ;&get-ptr-at LDA2 ] JSR2
    ( cell* )
    STH2k LDA INC STH2r STA
    RTN

  ( x y dx dy -- x y )
  &inc-neighbor
    STH2 STH2 ( x y : dx dy )
    OVR2 STH2r ( x y x dx : dy )
    ADD2 ( x y x+dx : dy )
    STH2 SWP2r ( x y : dy x+dx )
    DUP2 STH2r ADD2 ( x y y+dy : x+dx )
    STH2r SWP2 ( x y x+dx y+dy )
    ;&inc-cell JSR2
    RTN

  ( x y cell* )
  &cool-cell
    LDAk ( cell )
    #f0 LTH ,&not-flashed JCN
      STH2k #00 STH2r STA
      &not-flashed
    RTN

  &clear-border
    #0000 ( x )
    &y-clear-loop
      DUP2 #0000 ( x x 0 )
      ;&clear-cell JSR2

      DUP2 [ ;&h LDA2 ] DEC2 ( x x h-1 )
      ;&clear-cell JSR2

      INC2 ( x+1 )
      DUP2 [ ;&w LDA2 ] LTH2 ,&y-clear-loop JCN
    POP2

    #0000 ( y )
    &x-clear-loop
      DUP2 #0000 SWP2 ( x 0 x )
      ;&clear-cell JSR2

      DUP2 [ ;&w LDA2 ] DEC2 SWP2 ( y w-1 y )
      ;&clear-cell JSR2

      INC2 ( y+1 )
      DUP2 [ ;&h LDA2 ] LTH2 ,&x-clear-loop JCN

    POP2
    RTN

  ( x y -- )
  &clear-cell
    [ ;&get-ptr-at LDA2 ] JSR2 ( cell* )
    #0000 SWP2 STA POP
    RTN

~library/console.lib.tal
~library/string.tal
~library/math.tal