( Soul Grind - a game about infinite aggressive skating,
    featuring solo and (via xrxs) head-to-head modes
  MIT license
  Derek Stevens <nilix@nilfm.cc> ) 

%DEBUG  { ;print-hex JSR2 #0a .Console/write DEO }
%DEBUG2 { SWP ;print-hex JSR2 ;print-hex JSR2 #0a .Console/write DEO }

%TOS  { #00 SWP }  %TOB { SWP POP }

%MOD { DIVk MUL SUB }
%MOD2 { DIV2k MUL2 SUB2 }

%2**  { #10 SFT2 } %2// { #01 SFT2 }
%8**  { #30 SFT2 } %8// { #03 SFT2 }

%INC-X { .Screen/x DEI2 #0008 ADD2 .Screen/x DEO2 } ( -- )
%INC-Y { .Screen/y DEI2 #0008 ADD2 .Screen/y DEO2 }

%RTN { JMP2r }

( devices )

|00 @System     [ &vector $2 &wst      $1 &rst    $1 &pad   $4 &r      $2 &g      $2 &b    $2 &debug  $1 &halt $1 ]
|10 @Console    [ &vector $2 &read     $1 &pad    $5 &write $1 &error  $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 ]
|40 @Audio1     [ &vector $2 &position $2 &output $1 &pad   $3 &adsr   $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|50 @Audio2     [ &vector $2 &position $2 &output $1 &pad   $3 &adsr   $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|60 @Audio3     [ &vector $2 &position $2 &output $1 &pad   $3 &adsr   $2 &length $2 &addr $2 &volume $1 &pitch $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

@xrxs $1

@state $1
@ticker $1

@blader [
  &x $2
  &y $2
  &z $2
  &dx $2
  &dy $2
  &dz $2
  &stance $1
  &frame $1
  &anim-speed $1
  &trick $1
  &score $2
  &bailed $1
]

@map [
  &tile-offset $1
  &row1 $40
  &row2 $40
  &row3 $40
]

@rival [
  &last-trick $1
  &score $2
  &bailed $1
]

@center [
  &x $2
  &y $2
]

( program )

|0100 ( -> )

	( theme ) 
	#0fe5 .System/r DEO2 
	#0fc5 .System/g DEO2 
	#0f25 .System/b DEO2

  #0200 .Screen/width DEO2
  #0110 .Screen/height DEO2

  .Screen/width DEI2 #01 SFT2 .center/x STZ2k
  .Screen/height DEI2 #01 SFT2 .center/y STZ2k

  POP .blader/y STZ2
  POP .blader/x STZ2
  #0000 .blader/z STZ2
  #20 .blader/anim-speed STZ
  #0000 .blader/score STZ2
  #00 .blader/stance STZ
  #00 .blader/frame STZ

  #00 .state STZ
  #00 .ticker STZ

  ;main-loop .Screen/vector DEO2

BRK

@clear-screen ( -> )
 
  .Screen/width DEI2 #0000 &whilex EQU2k ,&endx JCN
    DUP2 ,&x STR2
    .Screen/height DEI2 #0000 &whiley EQU2k ,&endy JCN
      DUP2 ,&y STR2
      ,&x LDR2 .Screen/x DEO2
      ,&y LDR2 .Screen/y DEO2
      ;blank .Screen/addr DEO2
      #10 .Screen/sprite DEO
      #40 .Screen/sprite DEO
    #0008 ADD2 ,&whiley JMP &endy POP2 POP2
  #0008 ADD2 ,&whilex JMP &endx POP2 POP2
  
RTN

&x $2
&y $2

@press-start-screen ( -> )

  ( display title spritemap )
  ( flash "press start" )
  .ticker LDZ INC
  DUP .ticker STZ

  DUP #20 GTH ,&flash-text JCN
    ( draw text )
    [ ;txt-press-start
      .center/x LDZ2 OVR2 ;strlen JSR2 #20 SFT2 SUB2
      .Screen/height DEI2 #0010 SUB2
      #02 ] ;draw-string JSR2
  &flash-text
  #40 GTH ,&reset-ticker JCN
    RTN
  &reset-ticker
  #00 .ticker STZ

RTN

@main-loop ( -> )

  ;clear-screen JSR2

  .state LDZ

  DUP #00 NEQ ,&no-press-start JCN
    ;press-start-screen JSR2
    POP BRK
  &no-press-start
  ( DUP #03 GTH ,&no-menu JCN
    POP BRK
  &no-menu
  DUP #1f GTH ,&no-realm-menu JCN
    POP BRK
  &no-realm-menu
  DUP #2f GTH ,&no-realm-create JCN
    POP BRK
  &no-realm-create 
  DUP #3f GTH ,&no-realm-select JCN
    POP BRK
  &no-realm-select
  DUP #4f GTH ,&no-single-play JCN
    POP BRK
  &no-single-play
  DUP #5f GTH ,&no-multi-play JCN
    POP BRK
  &no-multi-play )
  POP

BRK

@draw-string ( addr x y color -- )
	
	STH ( save color )
	.Screen/y DEO2 ( set y )
	.Screen/x DEO2 ( set x )

  ( now the string address is at the top of the stack )
  &loop
    LDAk DUP #00 NEQ #20 MUL SUB TOS 8** ;font ADD2 .Screen/addr DEO2 
    STHkr .Screen/sprite DEO
    INC-X
    INC2
    LDAk #00 NEQ ,&loop JCN
  POP2
  POPr

RTN

@strlen ( addr -- len )

  DUP2
  &loop
    INC2 LDAk ,&loop JCN
  SWP2 SUB2
  
RTN

@print-hex ( value -- )
	
	STHk #04 SFT ,&parse JSR .Console/write DEO
	STHr #0f AND ,&parse JSR .Console/write DEO
	RTN
	&parse ( value -- char )
		DUP #09 GTH ,&above JCN #30 ADD RTN &above #09 SUB #60 ADD RTN

RTN

@blank $10

@txt-press-start "Press 20 "Start 00

@arrow [ 1018 1c1e 1c18 1000 ]
@cursor [ 80c0 e0f0 f8e0 1000 ]

@font [
  00 00 00 00 00 00 00 00 00 18 18 18 08 00 08 00    00 14 14 00 00 00 00 00 00 24 7e 24 24 7e 24 00 
  00 10 3c 50 38 14 78 10 00 00 44 08 10 20 44 00    00 18 20 32 2c 24 1a 00 00 18 10 20 00 00 00 00 
  00 04 08 08 08 08 04 00 00 20 10 10 10 10 20 00    00 00 44 28 10 28 44 00 00 00 10 10 7c 10 10 00 
  00 00 00 00 00 0c 08 10 00 00 00 00 3e 00 00 00    00 00 00 00 00 0c 0c 00 00 02 04 08 10 20 40 00 
  00 38 44 54 54 44 38 00 00 30 10 10 10 10 38 00    00 38 44 04 38 40 7c 00 00 38 44 18 04 44 38 00 
  00 08 18 28 48 7c 08 00 00 7c 40 78 04 44 38 00    00 38 40 78 44 44 38 00 00 7c 04 08 10 10 10 00 
  00 38 44 38 44 44 38 00 00 38 44 44 3c 04 38 00    00 18 18 00 00 18 18 00 00 18 18 00 00 18 10 20 
  00 00 08 10 20 10 08 00 00 00 00 3e 00 3e 00 00    00 00 10 08 04 08 10 00 00 38 44 1c 10 00 10 00 
  00 38 44 5c 58 40 3c 00 00 10 28 44 7c 44 44 00    00 78 44 78 44 44 78 00 00 38 44 40 40 44 38 00 
  00 78 44 44 44 44 78 00 00 7c 40 7c 40 40 7c 00    00 7c 40 7c 40 40 40 00 00 38 44 40 4c 44 3c 00 
  00 44 44 7c 44 44 44 00 00 7c 10 10 10 10 7c 00    00 7c 08 08 48 48 30 00 00 44 48 70 48 44 44 00 
  00 40 40 40 40 40 7c 00 00 44 6c 7c 54 44 44 00    00 44 64 74 5c 4c 44 00 00 38 44 44 44 44 38 00 
  00 78 44 44 78 40 40 00 00 38 44 44 4c 4c 3e 00    00 78 44 44 78 44 44 00 00 3c 40 38 04 04 78 00 
  00 7c 10 10 10 10 10 00 00 44 44 44 44 44 3c 00    00 44 44 28 28 10 10 00 00 44 44 44 54 6c 44 00 
  00 44 44 38 38 44 44 00 00 44 44 28 10 10 10 00    00 7c 04 18 30 40 7c 00 00 3c 30 30 30 30 3c 00 
  00 40 20 10 08 04 02 00 00 3c 0c 0c 0c 0c 3c 00    00 10 38 6c 00 00 00 00 00 00 00 00 00 00 7e 00 
  00 18 08 04 00 00 00 00 00 00 38 04 3c 44 3c 00    00 40 40 78 44 44 78 00 00 00 38 44 40 44 38 00 
  00 04 04 3c 44 44 3c 00 00 00 38 44 7c 40 3c 00    00 1c 20 78 20 20 20 00 00 00 3c 44 3c 04 44 38 
  00 40 40 78 44 44 44 00 00 30 00 70 10 10 18 00    00 0c 00 3c 04 04 44 38 00 00 44 48 70 48 44 00 
  00 70 10 10 10 10 1c 00 00 00 44 6c 7c 54 44 00    00 00 78 44 44 44 44 00 00 00 38 44 44 44 38 00 
  00 00 78 44 44 78 40 40 00 00 3c 44 44 3d 06 04    00 00 4c 50 60 40 40 00 00 00 3c 40 38 04 78 00 
  00 20 78 20 20 24 38 00 00 00 44 44 44 44 3c 00    00 00 44 44 28 28 10 00 00 00 44 44 54 7c 28 00 
  00 00 44 28 10 28 44 00 00 00 44 44 3c 04 78 00    00 00 7c 04 38 40 7c 00 00 1e 10 10 10 00 00 00 
  00 10 10 10 10 10 10 00 00 00 00 08 08 08 78 00    00 00 00 32 4c 00 00 00 3c 42 99 a1 a1 99 42 3c 
]