( maze.tal )
( )
( mazes generated by randomized depth-first search )
( press any key to generate a new maze )
( )
( generator uses a simple 16-bit xorshift RNG )
( based on http://b2d-f9r.blogspot.com/2010/08/16-bit-xorshift-rng-now-with-more.html )

%DEBUG { #ff #0e DEO }
%<<5 { #50 SFT2 }
%>>1 { #01 SFT2 }
%>>3 { #03 SFT2 }
%RTN  { JMP2r }
%EMIT { #18 DEO }
%SPACE { #20 EMIT }
%NEWLINE { #0a EMIT }
%MOD { DIVk MUL SUB }
%MOD2 { DIV2k MUL2 SUB2 }
%DEC { #01 SUB }
%DEC2 { #0001 SUB2 }
%NEGATE2 { #ffff MUL2 }

( TODO: once the dimensions are finalized inline constants )

%ROWS { #0027 } ( rows of cells )
%COLS { #003f } ( columns of cells )
%CELLS { ROWS COLS MUL2 }
( %MAZEROWS { ROWS #0003 SUB2 #0002 DIV2 }
%MAZECOLS { COLS #0003 SUB2 #0002 DIV2 } )
%MAZEROWS { ROWS INC2 #0002 DIV2 }
%MAZECOLS { COLS INC2 #0002 DIV2 }
%NORTH { COLS NEGATE2 }
%EAST { #0001 }
%SOUTH { COLS }
%WEST { #ffff }

%CELL { SWP2 COLS MUL2 ADD2 } ( row* col* -> row*cols+col )
%LOAD { ;maze ADD2 LDA } ( cell* -> val^ )
%STORE { ;maze ADD2 STA } ( val cell* -> )
%XSTORE { ROT ROT STORE } ( cell* val -> )
%IS-OPEN { LOAD #01 AND }
%UNSEEN { LOAD #02 AND #00 EQU } ( cell* -> bool^ )
( %PATH { ADD2 #0002 DIV2 } ( cell1* cell2* -> cell3* ) )
%PATH { ADD2 #01 SFT2 } ( cell1* cell2* -> cell3* )

%DIGIT { #00 SWP ;digits ADD2 LDA EMIT }
%EMIT-BYTE { DUP #04 SFT DIGIT #0f AND DIGIT }
%EMIT-SHORT { SWP EMIT-BYTE EMIT-BYTE }

( devices )

|00 @System     [ &vector $2 &pad      $6 &r      $2 &g     $2 &b      $2 ]
|10 @Console    [ &vector $2 &read     $1 &pad    $5 &write $1 ]
|20 @Screen     [ &vector $2 &width    $2 &height $2 &pad   $2 &x      $2 &y      $2 &addr $2 &pixel  $1 &sprite $1 ]
|30 @Audio0     [ &vector $2 &position $2 &output $1 &pad   $3 &adsr   $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|70 @Midi       [ &vector $2 &channel  $1 &note   $1 &velocity $1 ]
|80 @Controller [ &vector $2 &button   $1 &key    $1 ]
|90 @Mouse      [ &vector $2 &x        $2 &y      $2 &state $1 &wheel  $1 ]
|a0 @File       [ &vector $2 &success  $2 &stat   $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
|b0 @DateTime   [ &year   $2 &month    $1 &day    $1 &hour  $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]

( variables )
|0000

( pseudo-random number generator )
@rng [ &x $2 &y $2 ]

( timer to use for flashing effect )
@timer $1

( color to draw walls )
@tint $1

( cell to focus on during maze generatio )
@focus $2

( directions: n e s w )
@directions $4 ( 00 01 02 03 )

( step one cell over in respective direction )
@cell-offsets $8

( boolean used to generate a new maze )
@regenerate $1

( cell occupied by the character )
@charx $2
@chary $2

|0100

    ( intialize rng )
    ;init-rng JSR2

    #03 .tint STZ
    #00 .regenerate STZ

    ( initialize dierctions )
    #00 .directions #00 ADD STZ
    #01 .directions #01 ADD STZ
    #02 .directions #02 ADD STZ
    #03 .directions #03 ADD STZ

    ( initialize the character )
    #0002 .charx STZ2
    #0000 .chary STZ2

    ( initialize cell offsets - calculated based on #columns )
    NORTH .cell-offsets #00 ADD STZ2
    EAST .cell-offsets #02 ADD STZ2
    SOUTH .cell-offsets #04 ADD STZ2
    WEST .cell-offsets #06 ADD STZ2

    ( theme: #102 #def #ec2 #775 )
    #1de7 .System/r DEO2 
    #0ec7 .System/g DEO2 
    #2f25 .System/b DEO2
    
    ( testing )
    ;clear-maze JSR2

    ( we mark the border as having been seen to simplify bounds checking )
(    ;mark-border JSR2 )

    ( generate the maze )
    ;create-maze JSR2

    ( cut exits )
    ;create-exits JSR2

    ( first draw of the maze )
    ;draw-maze JSR2

    ( set up redraw hook )
    ;draw .Screen/vector DEO2
    ;on-key .Controller/vector DEO2
BRK

@draw ( -> )
    .timer LDZ INC #06 MOD DUP
    .timer STZ
    #00 NEQ ,&done JCN
(    .tint LDZ #09 EOR .tint STZ  ( enables flashing ) )
    .regenerate LDZ #00 EQU ,&paint JCN

    ( if regenerate was true, then create a new maze )
    #00 .regenerate STZ
    ;clear-maze JSR2
(    ;mark-border JSR2 )
    ;create-maze JSR2
    ;create-exits JSR2
    ;draw-maze JSR2

    ( draw the maze )
    &paint
    ;draw-maze JSR2

    &done
BRK

@try-move ( drow dcol -> )
    .charx LDZ2 ADD2 SWP2 ( col+dcol row+drow )
    .chary LDZ2 ADD2 SWP2 ( row+drow dcol )
    OVR2 OVR2 ( row col row col )
    CELL LOAD ( col row val )
    #01 AND ,&ok JCN
    POP2 POP2 RTN
    &ok .charx STZ2 .chary STZ2 RTN

@on-key ( -> )
    .Controller/button DEI
    DUP ,&move JCN
    POP ( #01 .regenerate STZ ) BRK

    &move-up    #ffff #0000 ;try-move JSR2 POP BRK
    &move-down  #0001 #0000 ;try-move JSR2 POP BRK
    &move-left  #0000 #ffff ;try-move JSR2 POP BRK
    &move-right #0000 #0001 ;try-move JSR2 POP BRK

    &move
    DUP #10 AND ,&move-up JCN
    DUP #20 AND ,&move-down JCN
    DUP #40 AND ,&move-left JCN
    DUP #80 AND ,&move-right JCN
    EMIT-BYTE NEWLINE BRK

@wall-sprite
    ffff ffff ffff ffff 

@open-sprite
    0000 0000 0000 0000

@char-sprite
    0000 183c 3c18 0000

@draw-maze ( -> )
    #0000 ( row )
    &loop
    DUP2 ( row row )
    ;draw-row JSR2 ( row )
    INC2 ( row+1 )
    DUP2 ROWS LTH2 ,&loop JCN
    POP2
RTN

@draw-row ( row* -> )
    #0000 ( row col )
    &loop
    OVR2 OVR2 ( row col row col )
    ;draw-cell JSR2 ( row col )
    INC2 ( row col+1 )
    DUP2 COLS LTH2 ,&loop JCN
    POP2 POP2
RTN

@draw-cell ( row* col* -> )
    SWP2 DUP2 #0008 MUL2 .Screen/y DEO2 ( draw at y=row*8 )
    SWP2 DUP2 #0008 MUL2 .Screen/x DEO2 ( draw at x=col*8 )

    OVR2 OVR2 
    .charx LDZ2 EQU2 STH
    .chary LDZ2 EQU2 STHr AND
    ,&draw-char JCN

    ( OVR2 OVR2 ) CELL LOAD ( load cell byte at maze+index )
    #01 AND ( get bit 1, wall bit )
    ,&draw-open JCN
    ( POP2 POP2 ) ;wall-sprite ,&end JMP

    &draw-open
(    .charx LDZ2 EQU2 STH
    .chary LDZ2 EQU2 STHr AND
    ,&draw-char JCN )
    ;open-sprite ,&end JMP

    &draw-char
    [ POP2 POP2 ] ;char-sprite ,&end JMP

    &end
    .Screen/addr DEO2
    .tint LDZ .Screen/sprite DEO ( draw the cell )
RTN

@init-rng ( -> )
    ( seed .rng/x in seconds )
    #00 .DateTime/minute DEI #003c MUL2
    #00 .DateTime/second DEI ADD2
    #0001 ORA2 .rng/x STZ2 ( x <-  min*60+sec|1 )

    ( seed .rng/y in hours )
    #00 .DateTime/day DEI #0018 MUL2
    #00 .DateTime/hour DEI ADD2
    #0001 ORA2 .rng/y STZ2 ( y <- day*24+hour|1 )
RTN

@mark-border ( -> )
    #0000
    &yloop
    DUP2 #0000 CELL #02 XSTORE ( set row 0 )
    DUP2 COLS DEC2 CELL #02 XSTORE ( set row cols-1 )
    INC2 DUP2 ROWS LTH2 ,&yloop JCN
    POP2

    #0000
    &xloop
    #0000 OVR2 CELL #02 XSTORE ( set 0 col )
    ROWS DEC2 OVR2 CELL #02 XSTORE ( set rows-1 col )
    INC2 DUP2 COLS LTH2 ,&xloop JCN
    POP2
RTN

@create-exits ( -> )
    #0000 #0002 CELL DUP2
    #01 XSTORE SOUTH ADD2 #01 XSTORE

    ROWS #0002 SUB2 COLS #0003 SUB2 CELL DUP2
    #01 XSTORE SOUTH ADD2 #01 XSTORE
RTN

( initialize the entire maze memory to 0 values )
@clear-maze ( -> )
    ROWS COLS MUL2 ( limit* )
    #0000 #0000 CELL ( limit* cell* )
    &loop
    DUP2 #00 XSTORE
    INC2 GTH2k ,&loop JCN
    POP2 POP2
RTN

( a move is illegal if it changes both  x and y. )
( that occurs when the player wraps around the border. )
@illegal-move ( cell* -> bool^ )
    DUP2 CELLS LTH2 ,&inbounds JCN POP2 #01 RTN
    &inbounds
    DUP2
    DUP2
    COLS MOD2 ;focus LDA2 COLS MOD2 NEQ2 STH
    COLS DIV2 ;focus LDA2 COLS DIV2 NEQ2 STHr
    AND
    STHk #20 ADD EMIT SPACE EMIT-SHORT SPACE ;focus LDA2 EMIT-SHORT NEWLINE STHr
    RTN

@log-focus
    EMIT SPACE ;focus LDA2 EMIT-SHORT NEWLINE RTN

@xstore
    ROT ROT STORE RTN

@is-unseen ( cell* -> bool^ )
    DUP2
    LOAD
    DUP EMIT-BYTE SPACE
    #02 AND #00 EQU
    STHk #30 ADD EMIT SPACE EMIT-SHORT NEWLINE STHr
    RTN

@create-maze ( -> )
    ( create starting pt, must have even coords )
(    ;random-short JSR2 MAZEROWS MOD2 INC2 #0002 MUL2 ( row* )
    ;random-short JSR2 MAZECOLS MOD2 INC2 #0002 MUL2 ( row* col* ) )
(    ;random-short JSR2 MAZEROWS MOD2 #0002 MUL2 ( row* )
    ;random-short JSR2 MAZECOLS MOD2 #0002 MUL2 ( row* col* ) )
    #0000 #0000
    CELL DUP2 ;focus STA2 ( cell* )
    #07 XSTORE ( )

    &queue ( )
    #3f ;log-focus JSR2
    ;shuffle-directions JSR2 ( )
    #00 ( i^ )

    &search ( i^ )
    DUP .directions ADD LDZ ( i^ d^ )
    DUP #02 MUL .cell-offsets ADD LDZ2 ( i^ d^ off* )
    DUP2 ;focus LDA2 ADD2 ADD2 ( i^ d^ cell2* )
    DUP2 ;illegal-move JSR2 ,&notfound JCN
    DUP2 ;is-unseen JSR2 ( i^ d^ cell2* unseen^ )
    ,&found JCN ( i^ d^ cell2* )
    &notfound
    POP2 POP INC ( j=i+1 )
    DUP #04 LTH ( j^ j<4 )
    ,&search JCN ( j^ )
    POP ( )
    ,&backtrack JMP ( )

    &found ( addr^ d^ cell2* )
    #2a ;log-focus JSR2
    DUP2 #01 ( XSTORE ) ;xstore JSR2
    DUP2 ;focus LDA2 PATH ( addr^ d^ cell2* wall* )
    #01 ( XSTORE ) ;xstore JSR2 ( addr^ d^ cell2* )
    ;focus STA2 ( addr^ d^ )
    #3e ;log-focus JSR2
    #02 EOR #08 MUL ( addr^ link^ )
    #03 ORA ;focus LDA2 ( addr^ data^ cell* )
    STORE ( addr^ )
    POP ,&queue JMP ( )

    &backtrack ( )
    ;focus LDA2 LOAD #08 DIV ( link^ )
    #02 MUL .cell-offsets ADD LDZ2 ( offset* )
    ;focus LDA2 OVR2 ( offset* cell* offset* )
    ADD2 ADD2 ( old-cell* )
    DUP2 ;focus STA2 ( old-cell* )
    #3c ;log-focus JSR2
    LOAD #04 AND #00 NEQ ( is-start^ )
    ,&done JCN
    ;&queue JMP2
    
    &done ( )
RTN

@random-byte ( -> val^ )
    ;random-short JSR2
    POP
RTN

@random-short ( -> val* )
    .rng/x LDZ2 DUP2 <<5 EOR2    ( tmp: x^[x<<5] )
    .rng/y LDZ2 DUP2 .rng/x STZ2 ( tmp y )
    DUP2 >>1 EOR2                ( tmp y^[y>>1] )
    SWP2 DUP2 >>3 EOR2           ( y^[y>>1] tmp^[tmp>>3] )
    EOR2 DUP2 .rng/y STZ2        ( y^[y>>1] ^ tmp^[tmp>>3] )
RTN

@swap-directions ( d1^ d2^ -> )
    EQUk ( d1 d2 d1=d2 )
    ,&skip JCN
    .directions ADD SWP ( a2=d2+directions d1 )
    .directions ADD SWP ( a1=d1+directions a2 )
    LDZk ( a1 a2 x2 )
    ROT LDZk ( a2 x2 a1 x1 )
    SWP ( a2 x2 x1 a1 )
    ROT ( a2 x1 a1 x2 )
    SWP STZ ( a2 x1 )
    SWP STZ ( )
    RTN
    &skip
    POP2
RTN

@shuffle-directions
    #04 ( n=4 )
    &loop
    DUP ( n n )
    DEC ( n k=n-1 )
    ;random-byte JSR2 ( n k x )
    ROT ( k x n )
    MOD ( k r=x-mod-n )
    OVR ( k r k )
    ;swap-directions JSR2 ( k )
    DUP #00 ( k k 0 )
    GTH ( k k>0 )
    ,&loop JCN
    POP
RTN

( convenience for less branching when printing hex )
@digits
    30 31 32 33 34 35 36 37
    38 39 61 62 63 64 65 66

|8000

( 64x40 cells = 2560 bytes )
( )
( cell byte layout: )
(  * bit    1 -> 1=open, 0=wall )
(  * bit    2 -> 1=seen, 0=unseen )
(  * bit    3 -> 1=start, 0=not-start )
(  * bits 4-5 -> direction to previous link, 0=n 1=e 2=s 3=w )
(  * bit    6 -> 1=visited 0=unvisited )
( )
( we use the link to support backtracking without )
( needing a separate stack. )
@maze $2560