day15_lib.tal

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

@risk-matrix
  [ &_risks $2720 &_risks_end &_w $2 &_h $2 ]

  ( get-byte -- )
  &parse
    [ ;&parse/get-byte STA2 ]
    #00 ;&_risks_end ;&_risks SUB2 ;&_risks ;memset JSR2

    #0000 [ ;&_h STA2 ]
    LIT2r :&_risks ( : p* )
    #0000 [ ;&parse/w STA2 ]
    &parse/loop
      LIT2 [ &parse/get-byte $2 ] JSR2
      DUP #00 EQU ;&parse/done JCN2
      DUP #0a EQU ;&parse/next-row JCN2
      LIT '0 SUB              ( parse )
      STH2rk STA INC2r        ( store )
      [ ;&parse/w *INC2 ]     ( count )
      ;&parse/loop JMP2
      &parse/next-row
      POP
      [ ;&_h *INC2 ]
      [ ;&parse/w LDA2 ] #0000 EQU2 ,&parse/not-started JCN
        [ ;&parse/w LDA2 ] [ ;&_w STA2 ]
      &parse/not-started
      #0000 [ ;&parse/w STA2 ]
      ;&parse/loop JMP2
    &parse/done
    POP POP2r
    RTN
    [ &parse/w $2 ]

  ( x y -- ptr )
  &ptr-at
    ( x y )
    [ ;&_h LDA2 ] MOD2
    ( x y%h )
    [ ;&_w LDA2 ] MUL2 ( x y*w )

    SWP2
    ( y*w x )
    [ ;&_w LDA2 ] MOD2

    ADD2
    ;&_risks ADD2
    RTN

    &ptr-at/outside
    POP2 POP2
    #ff [ ;&dummy-cell STA ]
    ;&dummy-cell
    RTN
    [ &dummy-cell $1 ]

  ( -- )
  &dump
    [ ;&_w LDA2 ] [ ;cost-matrix/scale LDA2 ] MUL2  DBGSHORTDECn SP POP2
    [ ;&_h LDA2 ] [ ;cost-matrix/scale LDA2 ] MUL2  DBGSHORTDEC POP2
    #0000 [ ;&_h LDA2 ] [ ;cost-matrix/scale LDA2 ] MUL2  DO
      #0000 [ ;&_w LDA2 ] [ ;cost-matrix/scale LDA2 ] MUL2 DO
        DUP4 SWP2 ;&get-at JSR2
        LIT '0 ADD EMIT
        SP
      LOOP
      LF
    LOOP
    RTN

  ( x y -- val )
  &get-at
    DUP4 ;&ptr-at JSR2 LDA
    STH ( x y : val )
    [ ;&_h LDA2 ] DIV2 ( x y-tile : val )
    SWP2 [ ;&_w LDA2 ] DIV2 ( y-tile x-tile : val )
    ADD2 ( tile : val )
    NIP STHr ( tile8 val )
    DEC ADD #09 MOD INC
    RTN

%VISITED_SIZE { $7c00 }

@cost-matrix
  &init
    [ ;risk-matrix/_w LDA2 ] [ ;cost-matrix/scale LDA2 ] MUL2 [ ;&_w STA2 ]
    [ ;risk-matrix/_h LDA2 ] [ ;cost-matrix/scale LDA2 ] MUL2 [ ;&_h STA2 ]
    [ ;&_w LDA2 ] DEC2 8// INC2 [ ;&_visited_w STA2 ]
    #00 ;&_costlist_end ;&_costlist SUB2 ;&_costlist ;memset JSR2
    #00 ;&_visited_end ;&_visited SUB2 ;&_visited ;memset JSR2
    #ffff [ ;&_costlist STA2 ]
    RTN

  ( val x y -- )
  &set-at
    ( P< "set 20 >P OVR2 DBGSHORTDECn POP2 SP DBGSHORTDECn SP STH4 DBGSHORTDEC STH4r )
    DUP2 [ ;&_h LDA2 ] GEQ2 ;&set-at/outside JCN2
    OVR2 [ ;&_w LDA2 ] GEQ2 ;&set-at/outside JCN2

    DUP4 ;&mark-visited JSR2

    ( find end of costlist )
    LIT2r :&_costlist ( : cost* )
    &set-at/loop
      STH2rk LDA2 #ffff EQU2 ,&set-at/at-end JCN
      ( val x y : cost* )

      ( is this slot usable? )
      STH2rk ( val x y cost* : cost* )
      #0004 ADD2 LDA2 ( val x y costval : cost* )
      STH2 ( val x y : costval cost* )

      ROT2 ( x y val : costval cost* )
      STH2k ( x y val : val costval cost* )
      ROT2 ROT2 ( val x y : val costval cost* )

      STH2r STH2r ( val x y val costval : cost* )

      #000a ADD2 ( val costval+10 )
      LTH2  ,&set-at/not-free JCN

        ( val x y : cost* )
        STH2r ( val x y cost* )
        ;&set-at/store JSR2 ( cost * )
        POP2
        RTN

      &set-at/not-free

      LIT2r 0006 ADD2r
      ,&set-at/loop JMP
    &set-at/at-end
    ( bounds check )
    ;&_costlist_end STH2rk GTH2 ,&set-at/bounds-ok JCN
      P< "costlist 20 "bounds 20 "exceeded >P
      !
    &set-at/bounds-ok
    ( val x y : cost* )
    STH2r ( val x y cost* )
    ;&set-at/store JSR2
    ( cost* )
    ;&set-at/terminate JSR2
    RTN

    ( val x y cost* -- cost* )
    &set-at/store
      ( val x y cost* )
      STH2 ( val x y cost* )
      SWP2 ( val y x : cost* )
      STH2rk STA2 INC2r INC2r ( x )
      STH2rk STA2 INC2r INC2r ( y )
      STH2rk STA2 INC2r INC2r ( val )
      ( : cost* )
      STH2r ( cost* )
      RTN

    ( cost* )
    &set-at/terminate
      #ffff SWP2 STA2
      RTN

    &set-at/outside
      POP2 POP2 POP2
      RTN

  ( x y -- byte* bitpos )
  &get-visited-ptr
    [ ;&_visited_w LDA2 ] MUL2 ( x y*w )
    OVR2 STH2 ( x y*w : x )
    SWP2 8// ADD2 ;&_visited ADD2 ( byte* : x )
    STH2r NIP ( byte* xlow )
    #07 AND ( byte* bitpos )
    RTN

  ( x y -- )
  &mark-visited
    ( P< "visit 20 >P OVR2 DBGSHORTDECn SP POP2 DBGSHORTDECn SP )
    ;&get-visited-ptr JSR2 STH
    ( byte* : bitpos )
    LDAk ( byte* byte : bitpos )
    #80 STHr ( byte* byte 80 bitpos )
    SFT ( byte* byte bit )
    ORA ( byte* byte|bit )
    ( DBGBYTEn )
    ROT ROT ( newbyte byte* )
    ( DBGSHORT )
    STA
    RTN

  ( -- )
  &dump-visited
    [ ;&_w LDA2 ] DBGSHORTDECn SP POP2
    [ ;&_h LDA2 ] DBGSHORTDEC POP2
    #0000 [ ;&_h LDA2 ] DO
      #0000 [ ;&_w LDA2 ] DO
        DUP4 SWP2 ;&get-visited JSR2
        LIT '0 ADD EMIT
        SP
      LOOP
      LF
    LOOP
    RTN

  ( -- )
  &dump-visited-bytes
    [ ;&_visited_w LDA2 ] DBGSHORTDECn SP POP2
    [ ;&_h LDA2 ] DBGSHORTDEC POP2
    #0000 [ ;&_h LDA2 ] DO
      #0000 [ ;&_visited_w LDA2 ] DO
        ( y x )
        DUP4 8** SWP2
        ( y x 8*x y )
        ;&get-visited-ptr JSR2
        ( y x byte* bitpos )
        POP LDA ( byte )
        ;print-byte JSR2
        SP
      LOOP
      LF
    LOOP
    RTN

  ( x y -- flag )
  &get-visited
    ( LIT 'G EMIT OVR2 DBGSHORTDECn SP POP2 DBGSHORTDECn SP )
    ;&get-visited-ptr JSR2 STH
    ( byte* : bitpos )
    LDA #80 STHr SFT ( byte mask )
    AND ( masked )
    #00 NEQ
    RTN

  ( x y -- val )
  &get-at
    DUP2 [ ;&_h LDA2 ] GEQ2 ,&get-at/outside JCN
    OVR2 [ ;&_w LDA2 ] GEQ2 ,&get-at/outside JCN

    STH2 STH2 ( : x y )
    ( scan costlist )
    ;&_costlist ( cost* : x y )
    &get-at/loop
      LDA2k #ffff EQU2 ,&get-at/at-end JCN
      ( cost* : x y )
      LDA2k STH2rk NEQ2 ,&get-at/next JCN
      ( cost* : x y )
      DUP2 #0002 ADD2 LDA2 OVR2r STH2r NEQ2 ,&get-at/next JCN

        ( found match )
        ( cost* : x y )

        #0004 ADD2 LDA2

        POP2r POP2r
        ( cost )
        RTN

      &get-at/next
      #0006 ADD2
      ,&get-at/loop JMP
    &get-at/at-end
    ( cost* : x y )
    POP2 POP2r POP2r
    #0000
    RTN

    &get-at/outside
      POP2 POP2
      #ffff
      RTN

  ( cost x y -- cost|visitbit )
  &add-visited-bit
    ;&get-visited JSR2
    #00 SWP #f0 SFT2
    ORA2
    RTN

  ( -- count )
  &count
    ( scan costlist )
    ;&_costlist ( cost* )
    &count/loop
      LDA2k #ffff EQU2 ,&count/at-end JCN
      #0006 ADD2
      ,&count/loop JMP
    &count/at-end
    ( cost-end* )
    ;&_costlist SUB2 #0006 DIV2
    RTN

  ( val x y -- )
  &combine-at
    STH2k OVR2 STH2 ( val x y : x y )
    ;&get-visited JSR2 ( val visited? : x y )
    ,&combine-at/visited JCN
      ( val : x y )
      STH2rk OVR2r STH2r ( val x y : x y )
      ;risk-matrix/get-at JSR2 #00 SWP
      ( val riskval : x y )
      ADD2 ( val+riskval : x y )
      STH2r STH2r ( val+riskval x y )
      ;&set-at JSR2
    RTN
    &combine-at/visited
      ( val : x y )
      POP2
      POP2r POP2r
    RTN

  ( x y -- )
  &flood-from
    DUP4 ;&get-at JSR2 STH2 ( : val )
    OVR2 INC2 OVR2 STH2rk ROT2 ROT2 ;&combine-at JSR2
    OVR2 DEC2 OVR2 STH2rk ROT2 ROT2 ;&combine-at JSR2
    OVR2 OVR2 INC2 STH2rk ROT2 ROT2 ;&combine-at JSR2
              DEC2 STH2rk ROT2 ROT2 ;&combine-at JSR2
    POP2r
    RTN

  ( val -- )
  &flood-matching
    STH2 ( : val )
    ( scan costlist )
    ;&_costlist ( cost* : x y )
    &flood-matching/loop
      LDA2k #ffff EQU2 ,&flood-matching/at-end JCN
      ( cost* : val )
      DUP2 #0004 ADD2 LDA2 STH2rk NEQ2 ,&flood-matching/next JCN

      ( found match )
      ( cost* : val )
      LDA2k ( cost* x : val )
      OVR2 #0002 ADD2 LDA2 ( cost* x y : val )

      ;&flood-from JSR2
      ( cost* : val )

      &flood-matching/next
      #0006 ADD2
      ,&flood-matching/loop JMP
    &flood-matching/at-end
    ( cost* : val )
    POP2 POP2r
    RTN

  ( -- )
  &flood-all
    #0000 #0000 #0000 ;&set-at JSR2
    #0000 #2000 DO
      ( DBGSHORTDECn SP ;&count JSR2 DBGSHORTDEC POP2 )
      DUP2 ;&flood-matching JSR2
      ;&is-end-visited JSR2
      NOT ,&flood-all/not-done JCN
        UNLOOP
        RTN
      &flood-all/not-done
      ( ;&dump-visited JSR2 )
      ( ;&dump JSR2 )
    LOOP
    RTN

  ( -- flag )
  &is-end-visited
    [ ;&_w LDA2 ] DEC2 [ ;&_h LDA2 ] DEC2 ;&get-visited JSR2
    RTN

  ( -- )
  &list-dump
    LIT2r :&_costlist ( : cost* )
    &list-dump/loop
      STH2rk LDA2 #ffff EQU2 ,&list-dump/at-end JCN
      ( : cost* )
      STH2rk LDA2k DBGSHORTDECn SP POP2
      #0002 ADD2 LDA2k DBGSHORTDECn SP POP2
      #0002 ADD2 LDA2k ;print-short-no0x JSR2
      POP2
      LF
      LIT2r 0006 ADD2r
      ,&list-dump/loop JMP
    &list-dump/at-end
    ( : cost* )
    POP2r
    RTN

  ( -- )
  &dump
    [ ;&_w LDA2 ] DBGSHORTDECn SP POP2
    [ ;&_h LDA2 ] DBGSHORTDEC POP2
    #0000 [ ;&_h LDA2 ] DO
      #0000 [ ;&_w LDA2 ] DO
        ( y x )
        DUP4 ( y x y x )
        SWP2
        ( y x x y )
        DUP4 ;&get-visited JSR2
        NOT ,&dump/not-visited JCN
          ;&get-at JSR2
          ( x y cost )
          ;print-short-no0x JSR2
          ,&dump/next JMP
        &dump/not-visited
          ( y x x y )
          POP2 POP2
          P< 20 20 20 20 >P
        &dump/next
        SP
      LOOP
      LF
    LOOP
    RTN

  ( -- end-val )
  &get-end
    [ ;&_w LDA2 ] DEC2 [ ;&_h LDA2 ] DEC2 ;&get-at JSR2
    RTN

  ( -- risk )
  &get-end-cost
    ;&get-end JSR2
    RTN

  [ 
    &_w $2 &_h $2 &_visited_w $2
    &_visited VISITED_SIZE &_visited_end 
    &scale 0001
    &_costlist
|ff00 &_costlist_end
  ]