( tic tac toe )

( devices: {{{ )
|00 @System
  [ &vector    $2
    &wst       $1
    &rst       $5
    &r         $2
    &g         $2
    &b         $2
    &debug     $1
    &state     $1
  ]
|20 @Screen
  [ &vector    $2
    &width     $2
    &height    $2
    &auto      $2
    &x         $2
    &y         $2
    &addr      $2
    &pixel     $1
    &sprite    $1
  ]
|80 @Controller
  [ &vector    $2
    &button    $1
    &key       $1
  ]
( }}} )

|0000
@game
  [ &cursor-pos     $1 ( high nibble - x, low nibble - y )
    &current-player $1 ( 01 - x, 02 - o )
    &moves          $1 ( 00 - 09 )
    &cells          $9 ( 00 - empty, 01 - x, 02 - o )
  ]

|0100 ( -> )
  ( add .theme support ? )
  #1c2f .System/r DEO2
  #1b3a .System/g DEO2
  #1c3a .System/b DEO2

  #0050 .Screen/width  DEO2
  #0050 .Screen/height DEO2

  ;on-controller .Controller/vector DEO2

  ;init-game JSR2

  ( border )
  #0010 #000f #30 #02 #01 ;draw-line-at JSR2
  #000f #0010 #30 #02 #02 ;draw-line-at JSR2
  #0010 #0040 #30 #02 #01 ;draw-line-at JSR2
  #0040 #0010 #30 #02 #02 ;draw-line-at JSR2
  
  ( cells )
  #0010 #001f #30 #02 #01 ;draw-line-at JSR2
  #0010 #002f #30 #02 #01 ;draw-line-at JSR2
  #0010 #003f #30 #02 #01 ;draw-line-at JSR2
  #001f #0010 #30 #02 #02 ;draw-line-at JSR2
  #002f #0010 #30 #02 #02 ;draw-line-at JSR2
  #003f #0010 #30 #02 #02 ;draw-line-at JSR2
BRK

@init-game ( -- )
  #11 .game/cursor-pos     STZ
  #01 .game/current-player STZ
  #00 .game/moves          STZ

  ( clear the board )
  #09 &while
    DUP #01 SUB .game/cells ADD #00 SWP STZ
    #01 SUB DUP ,&while JCN
  POP

  .game/cursor-pos LDZ #01 ;draw-cursor-at JSR2
JMP2r

@on-controller ( -> )
  .game/cursor-pos LDZ

  .Controller/button DEI
  #01 ANDk NIP ,&play  JCN
  #10 ANDk NIP ,&up    JCN
  #20 ANDk NIP ,&down  JCN
  #40 ANDk NIP ,&left  JCN
  #80 ANDk NIP ,&right JCN
  POP
  .Controller/key DEI
  #20 EQUk NIP ,&play JCN
  POP2 BRK

  &play
    POP
    DUP ;pos-to-addr JSR2 LDZk
    #00 EQU ,&draw JCN
    POP2 BRK
    &draw
      .game/current-player LDZ
      SWP STZ 
      ;draw-move-at JSR2
      .game/moves LDZk INC SWP STZk
      ( game can't be ended before 5 moves )
      POP #05 LTH ,&no-check JCN
      ;check-win JSR2
      &no-check
  BRK
  &up
    POP
    DUP #00 ;draw-cursor-at JSR2
    ;move-cursor/up JSR2
    #01 ;draw-cursor-at JSR2
  BRK
  &down
    POP
    DUP #00 ;draw-cursor-at JSR2
    ;move-cursor/down JSR2
    #01 ;draw-cursor-at JSR2
  BRK
  &left
    POP
    DUP #00 ;draw-cursor-at JSR2
    ;move-cursor/left JSR2
    #01 ;draw-cursor-at JSR2
  BRK
  &right
    POP
    DUP #00 ;draw-cursor-at JSR2
    ;move-cursor/right JSR2
    #01 ;draw-cursor-at JSR2
BRK

@on-controller-trap ( -> )
  .Controller/button DEI ,&restart JCN
  .Controller/key    DEI ,&restart JCN
  BRK
  &restart
  #0100 JMP2
BRK

@check-win ( -- )
  ( diagonals )
  #00 ;pos-to-addr JSR2 LDZ
  #11 ;pos-to-addr JSR2 LDZ
  #22 ;pos-to-addr JSR2 LDZ AND AND
  #02 ;pos-to-addr JSR2 LDZ
  #11 ;pos-to-addr JSR2 LDZ
  #20 ;pos-to-addr JSR2 LDZ AND AND
  ORA

  ( columns )
  #03 &while-x1
    #03 &while-y1
      DUP2 #01 DUP SUB2
      SWP #40 SFT ORA
      ;pos-to-addr JSR2 LDZ STH
      #01 SUB DUP ,&while-y1 JCN
    POP
    STH2r STHr AND AND STH
    #01 SUB DUP ,&while-x1 JCN
  POP
  STH2r STHr ORA ORA
  ORA

  ( rows )
  #03 &while-y2
    #03 &while-x2
      DUP2 #01 DUP SUB2
      #40 SFT ORA
      ;pos-to-addr JSR2 LDZ STH
      #01 SUB DUP ,&while-x2 JCN
    POP
    STH2r STHr AND AND STH
    #01 SUB DUP ,&while-y2 JCN
  POP
  STH2r STHr ORA ORA
  ORA
  DUP ,&endgame JCN
  .game/moves LDZ #09 EQU ,&endgame JCN
  POP
  JMP2r
  &endgame
    ;draw-endgame JSR2
    ;on-controller-trap .Controller/vector DEO2
JMP2r

@move-cursor ( pos -- newpos )
  &up
    #03 ANDk NIP
    #00 EQUk NIP #03 MUL ADD
    #01 SUB SWP #30 AND ORA
    ,&end JMP
  &down
    #03 ANDk NIP
    #02 EQUk NIP #03 MUL SUB
    INC SWP #30 AND ORA
    ,&end JMP
  &left
    #04 SFTk NIP
    #03 AND
    #00 EQUk NIP #03 MUL ADD
    #01 SUB #40 SFT
    SWP #03 AND ORA
    ,&end JMP
  &right
    #04 SFTk NIP
    #03 AND
    #02 EQUk NIP #03 MUL SUB
    INC #40 SFT
    SWP #03 AND ORA
  &end
  .game/cursor-pos STZk POP ( lil side effect : )
JMP2r

@draw-cursor-at ( pos col -- )
  STH
  ;pos-to-xy JSR2
  OVR2 OVR2
  .Screen/y DEO2
  .Screen/x DEO2
  #0e STHrk #01 ;draw-line JSR2
  #0e STHrk #02 ;draw-line JSR2
  .Screen/y DEO2
  .Screen/x DEO2
  #0e STHrk #02 ;draw-line JSR2
  #0f STHr  #01 ;draw-line JSR2
JMP2r

@draw-move-at ( pos -- )
  ;pos-to-xy JSR2
  #0003 ADD2
  .Screen/y DEO2
  #0003 ADD2
  .Screen/x DEO2
  .game/current-player LDZ
  ;draw-figure JSR2
JMP2r

@draw-figure ( fig -- )
  #00 EQUk NIP ,&tie JCN
  #01 EQUk NIP ,&x   JCN
  #02 EQUk NIP ,&o   JCN
  POP JMP2r ( this should never happen (tm) )
  
  &tie
    POP
    .Screen/x DEI2k #0008 SUB2 ROT DEO2 ( align )
    #01 .Screen/auto DEO
    ;tie DUP2 .Screen/addr DEO2
    #01 .Screen/sprite DEO
    #0008 ADD2k NIP2 .Screen/addr DEO2
    #01 .Screen/sprite DEO
    .Screen/addr DEO2
    #11 .Screen/sprite DEO
    #00 .Screen/auto DEO
  JMP2r
  &x
    POP
    ;x .Screen/addr DEO2
    #01 .Screen/sprite DEO
    #02 .game/current-player STZ ( evil stuff )
  JMP2r
  &o
    POP
    ;o .Screen/addr DEO2
    #03 .Screen/sprite DEO
    #01 .game/current-player STZ ( very evil )
JMP2r

@draw-endgame ( winstate -- )
  #13 ;pos-to-xy JSR2
  #0003 ADD2
  .Screen/y DEO2
  #0003 ADD2
  .Screen/x DEO2
  ;draw-figure JSR2 
JMP2r

@draw-line ( wid col dir -- )
  .Screen/auto DEO
  SWP
  &while
    SWP .Screen/pixel DEOk POP
    SWP #01 SUB DUP ,&while JCN
  POP2
  #00 .Screen/auto DEO
JMP2r

@draw-line-at ( x* y* wid col dir -- )
  STH2 STH
  .Screen/y DEO2
  .Screen/x DEO2
  STHr STH2r ;draw-line JSR2
JMP2r

@pos-to-xy ( pos -- x* y* )
  #04 SFTk NIP
  #03 AND
  INC #00 SWP #40 SFT2
  ROT
  #03 AND
  INC #00 SWP #40 SFT2
JMP2r

@pos-to-addr ( pos -- addr )
  #04 SFTk NIP
  #03 AND
  #03 MUL
  SWP
  #03 AND
  ADD
  .game/cells ADD
JMP2r

( data )

@x    c3e7 7e3c 3c7e e7c3
@o    7ee7 c3c3 c3c3 e77e
@tie  0000 e010 1008 0807
      0824 1410 0146 3800

( vim: fdm=marker: )