Keskustelu: Koodit: 8th: Raycaster testi

\
\ Simple raycaster
\
\ Raycasting code "borrowed" from Lode Vandevenne and adapted for 8th programming language.
\
\ Original graphics files, before I messed them up are from Al Steven's raycaster demo: Tubas of Terror
\ published in Dr. Dobbs journal 1995. Used with permission.
\
true app:isgui !

var gui

: WIDTH  640 ;
: HEIGHT 480 ;

640 480 img:new var, buffer
640 480 img:new var, imgbuf

: MAP-WIDTH  24 ;
: MAP-HEIGHT 24 ;

: CEILING-HEIGHT 1.0 ;

: TEXTURE-WIDTH  64 ;
: TEXTURE-HEIGHT 85 ;

: SPRITE-WIDTH  64 ;
: SPRITE-HEIGHT 85 ;
: SPRITE-DIST 0.7 ;


"tiles/wall01.png"   app:asset img:new var, texture1
"tiles/wall02.png"   app:asset img:new var, texture2
"tiles/door01.png"   app:asset img:new var, texture3
"tiles/door02.png"   app:asset img:new var, texture4
"tiles/door03.png"   app:asset img:new var, texture5
"tiles/door04.png"   app:asset img:new var, texture6

"sprites/TUBA100.png"  app:asset img:new var, tuba0-sprite
"sprites/TUBA101.png"  app:asset img:new var, tuba1-sprite
"sprites/TUBA102.png"  app:asset img:new var, tuba2-sprite
"sprites/TUBA103.png"  app:asset img:new var, tuba3-sprite
"sprites/TUBA104.png"  app:asset img:new var, tuba4-sprite
"sprites/TUBA105.png"  app:asset img:new var, tuba5-sprite
"sprites/TUBA106.png"  app:asset img:new var, tuba6-sprite
"sprites/TUBA107.png"  app:asset img:new var, tuba7-sprite
"sprites/TUBA200.png"  app:asset img:new var, tuba8-sprite
"sprites/TUBA201.png"  app:asset img:new var, tuba9-sprite
"sprites/TUBA202.png"  app:asset img:new var, tuba10-sprite
"sprites/TUBA203.png"  app:asset img:new var, tuba11-sprite
"sprites/TUBA204.png"  app:asset img:new var, tuba12-sprite
"sprites/TUBA205.png"  app:asset img:new var, tuba13-sprite
"sprites/TUBA206.png"  app:asset img:new var, tuba14-sprite
"sprites/TUBA207.png"  app:asset img:new var, tuba15-sprite
"sprites/TUBA300.png"  app:asset img:new var, tuba16-sprite
"sprites/TUBA301.png"  app:asset img:new var, tuba17-sprite
"sprites/TUBA302.png"  app:asset img:new var, tuba18-sprite
"sprites/TUBA303.png"  app:asset img:new var, tuba19-sprite
"sprites/TUBA304.png"  app:asset img:new var, tuba20-sprite
"sprites/TUBA305.png"  app:asset img:new var, tuba21-sprite
"sprites/TUBA306.png"  app:asset img:new var, tuba22-sprite
"sprites/TUBA307.png"  app:asset img:new var, tuba23-sprite

"sprites/FLOWRPOT.png"  app:asset img:new var, flowerpot-sprite
"sprites/TABLE.png"     app:asset img:new var, table-sprite
"sprites/LIGHT.png"     app:asset img:new var, light-sprite

var texture

[ ` texture1 @ ` , ` texture3 @ ` ,  ` texture5 @ ` ] var, textures
[ ` texture2 @ ` , ` texture4 @ ` ,  ` texture6 @ ` ] var, dim-textures


[ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,3,1,1,1,1,1,1,1,1,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,0,1,
  1,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,
  1,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,
  1,0,0,0,0,0,1,1,0,1,1,0,0,0,0,1,1,1,1,1,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,
  2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,1,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3,
  1,1,0,0,0,0,0,0,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,1,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,1,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 ] [ 24, 24 ] mat:new  var, map


[ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,0,1,
  1,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,
  1,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,
  1,0,0,0,0,0,1,1,0,1,1,0,0,0,0,1,1,1,1,1,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,
  1,1,0,1,0,0,0,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,1,
  1,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,
  1,1,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,1,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 ] [ 24, 24 ] mat:new  var, collision-map



[
   [ ` tuba0-sprite @ ` , ` tuba1-sprite @ ` , ` tuba2-sprite @ ` , ` tuba3-sprite @ `, ` tuba4-sprite @ `, ` tuba5-sprite @ `, ` tuba6-sprite @ `, ` tuba7-sprite @ ` ],
   [ ` tuba8-sprite @ ` , ` tuba9-sprite @ ` , ` tuba10-sprite @ ` , ` tuba11-sprite @ `, ` tuba12-sprite @ `, ` tuba13-sprite @ `, ` tuba14-sprite @ `, ` tuba15-sprite @ ` ],
   [ ` tuba16-sprite @ ` , ` tuba17-sprite @ ` , ` tuba18-sprite @ ` , ` tuba19-sprite @ `, ` tuba20-sprite @ `, ` tuba21-sprite @ `, ` tuba22-sprite @ `, ` tuba23-sprite @ ` ]
]  var, tuba-sprites

[
   [ ` table-sprite @ ` , ` table-sprite @ ` , ` table-sprite @ ` , ` table-sprite @ `, ` table-sprite @ `, ` table-sprite @ `, ` table-sprite @ `, ` table-sprite @ ` ]
]  var, table-sprites

[
   [ ` flowerpot-sprite @ ` , ` flowerpot-sprite @ ` , ` flowerpot-sprite @ ` , ` flowerpot-sprite @ `, ` flowerpot-sprite @ `, ` flowerpot-sprite @ `, ` flowerpot-sprite @ `, ` flowerpot-sprite @ ` ]
]  var, flowerpot-sprites



defer: update-sprite

\ sprite list [ x, y, x-dir, speed, frame, frames, time, timer, sprite update-word ]
[
  [ 20.5, 14.5, -0.78540, 1.0, 0, 3, 0.1, 0,  ` tuba-sprites @ ` , ' update-sprite ],
  [ 20.5, 13.5, 0.78540, 0.8, 0, 3, 0.2, 0, ` tuba-sprites @ ` , ' update-sprite ],
  [ 18.5, 13.5, 0.78540, 1.0, 0, 3, 0.1, 0, ` tuba-sprites @ ` , ' update-sprite ],
  [ 19.5, 14.5, -0.78540, 0.8, 0, 3, 0.2, 0, ` tuba-sprites @ ` , ' update-sprite ],
  [ 17.5, 14.5, 0, 0, 0, 1, 0, 0, ` table-sprites @ ` ,  ' drop ],
  [ 17.5, 12.5, 0, 0, 0, 1, 0, 0, ` table-sprites @ ` ,  ' drop ],
  [ 16.5, 22.5, 0, 0, 0, 1, 0, 0, ` flowerpot-sprites @ ` ,  ' drop ],
  [ 18.5, 22.5, 0, 0, 0, 1, 0, 0, ` flowerpot-sprites @ ` ,  ' drop ]
] var, sprites


14.0 var, pos-x
16.0 var, pos-y
-0.6 var, dir-x
0.0  var, dir-y

var old-dir-x
var old-dir-y

0.0 var, plane-x
0.66 var, plane-y

3.0 var, move-speed
1.5 var, rot-speed

var frame-time
var accumulator
var new-time
var current-time
0.01 var, dt


: rgba  \ r g b a -- rgba
  4 a:close ;

: circle-ptx  \ x r radians -- x
  n:cos n:* n:+ ;

: circle-pty  \ y r radians -- x
  n:sin n:* n:- ;


ns: sprite


: x@  \ sprite -- sprite x
  0 a:@ ;

: y@  \ sprite -- sprite y
  1 a:@ ;

: dirx@  \ sprite -- sprite dirx
  2 a:@ ;

: speed@  \ sprite -- sprite speed
  3 a:@ ;

: frame@  \ sprite -- sprite frame
  4 a:@ ;

: frames@  \ sprite -- sprite frames
  5 a:@ ;

: time@  \ sprite -- sprite time
  6 a:@ ;

: timer@  \ sprite -- sprite time
  7 a:@ ;

: images@  \ sprite -- sprite images
  8 a:@ ;

: update-word@  \ sprite -- sprite update-word
  9 a:@ ;

: x!  \ sprite x -- sprite
  0 swap a:! ;

: y!  \ sprite y -- sprite
  1 swap a:! ;

: dirx!  \ sprite dirx -- sprite
  2 swap a:! ;

: speed!  \ sprite speed -- sprite
  3 swap a:! ;

: frame!  \ sprite frame -- sprite
  4 swap a:! ;

: frames!  \ sprite frames -- sprite
  5 swap a:! ;

: time!  \ sprite time -- sprite
  6 swap a:! ;

: timer!  \ sprite time-count -- sprite
  7 swap a:! ;

: images!  \ sprite images -- sprite
  8 swap a:! ;

: update-word!  \ sprite update-word -- sprite
  9 swap a:! ;

: update-sprites
  ( sprites @ swap a:@ nip update-word@ w:exec ) 0 sprites @ a:len nip n:1- loop ;


ns: raycast

\ vars used in raycasting walls
var camera-x
var ray-dir-x
var ray-dir-y
var map-x
var map-y
var side-dist-x
var side-dist-y
var delta-dist-x
var delta-dist-y
var perp-wall-dist
var step-x
var step-y
var side
var line-height
var draw-start
var draw-end
var wall-x
var texture-x
var texture-y-start
var texture-y-end

\ vars used in sprite casting
var zbuffer
var sprite-x
var sprite-y
var sprite-x-dir
var sprite-speed
var inv-det
var transform-x
var transform-y
var sprite-screen-x
var sprite-height
var draw-start-y
var draw-end-y
var draw-start-x
var draw-end-x
var sprite-width
var sprite-tex-x
var current-sprite


: half 2 n:/ ;
: half+ half n:+ ;
: half- half n:- ;


: raycast-loop
  dup
  2 WIDTH n:*/ n:1- camera-x !
  plane-x @ camera-x @ n:* dir-x @ n:+ ray-dir-x !
  plane-y @ camera-x @ n:* dir-y @ n:+ ray-dir-y !

  pos-x @ n:int map-x !
  pos-y @ n:int map-y !

  1 ray-dir-x @ n:/ n:abs delta-dist-x !
  1 ray-dir-y @ n:/ n:abs delta-dist-y !

  ray-dir-x @ 0 n:< if
    -1 step-x !
    pos-x @ map-x @ n:- delta-dist-x @ n:* side-dist-x !
  else
    1 step-x !
    map-x @ 1.0 n:+ pos-x @ n:- delta-dist-x @ n:* side-dist-x !
  then

  ray-dir-y @ 0 n:< if
    -1 step-y !
    pos-y @ map-y @ n:- delta-dist-y @ n:* side-dist-y !
  else
    1 step-y !
    map-y @ 1 n:+ pos-y @ n:- delta-dist-y @ n:* side-dist-y !
  then

  repeat
    side-dist-x @ side-dist-y @ n:< if
      delta-dist-x @ side-dist-x n:+!
      step-x @ map-x n:+!
      0 side !
    else
      delta-dist-y @ side-dist-y n:+!
      step-y @ map-y n:+!
      1 side !
    then

    map-x @ map-y @ map @ mat:@ nip dup 0 n:> if
      \ Leave texture number on TOS.
      n:int n:1-
      break
    else
      drop
    then
  again

  side @ 0 n:= if
    map-x @ pos-x @ n:- 1 step-x @ n:- half+ ray-dir-x @ n:/ perp-wall-dist !
  else
    map-y @ pos-y @ n:- 1 step-y @ n:- half+ ray-dir-y @ n:/ perp-wall-dist !
  then

  HEIGHT CEILING-HEIGHT perp-wall-dist @ n:*/ n:int line-height !

  line-height @ n:neg half HEIGHT half+ n:round n:int draw-start !
  draw-start @ 0 n:< if
    0 draw-start !
  then

  line-height @ half HEIGHT half+ n:round n:int draw-end !
  draw-end @ HEIGHT n:< not if
    HEIGHT n:1- draw-end !
  then

  side @ 0 n:= if
    perp-wall-dist @ ray-dir-y @ n:* pos-y @ n:+ wall-x !
  else
    perp-wall-dist @ ray-dir-x @ n:* pos-x @ n:+ wall-x !
  then

  wall-x @ dup n:floor n:- wall-x !

  wall-x @ TEXTURE-WIDTH n:* n:int texture-x !

  side @ 0 n:= if
    textures @ swap a:@ nip texture !
    ray-dir-x @ 0 n:> if
      TEXTURE-WIDTH texture-x @ n:- n:1- texture-x !
    then
  then

  side @ 1 n:= if
    dim-textures @ swap a:@ nip texture !
    ray-dir-y @ 0 n:< if
      TEXTURE-WIDTH texture-x @ n:- n:1- texture-x !
    then
  then

  >r  \ store column

  draw-start @ HEIGHT half- line-height @ half+ n:int
  TEXTURE-HEIGHT line-height @ n:*/ n:round n:int texture-y-start !

  draw-end @ HEIGHT half- line-height @ half+ n:int
  TEXTURE-HEIGHT line-height @ n:*/ n:round n:int texture-y-end !

  texture @ texture-x @ texture-y-start @ 1 texture-y-end @ texture-y-start @ n:- img:crop
  1 draw-end @ draw-start @ n:- img:scale
  buffer @ swap r> draw-start @ g:image-at drop

  zbuffer @ perp-wall-dist @ a:push drop ;


: draw-sprite
  >r
  transform-y @ 0 n:> r@ 0 n:> and r@ WIDTH n:< and transform-y @ zbuffer @ r@ a:@ nip n:< and if
    draw-start-y @ HEIGHT half- sprite-height @ half+ n:int
    SPRITE-HEIGHT sprite-height @ n:*/ n:round n:int texture-y-start !

    draw-end-y @ HEIGHT half- sprite-height @ half+ n:int
    SPRITE-HEIGHT sprite-height @ n:*/ n:round n:int texture-y-end !

    r@ sprite-width @ n:neg half sprite-screen-x @ n:+ n:- SPRITE-WIDTH n:* sprite-width @ n:/ n:int n:abs sprite-tex-x !

    current-sprite @ sprite-tex-x @ texture-y-start @ 1 texture-y-end @ img:crop
    1 sprite-height @ img:scale
    buffer @ swap r@ draw-start-y @ g:image-at drop
  then
  rdrop ;


: sprite-dist-cmp
  sprite:y@ swap sprite:x@ nip swap pos-y @ swap n:- dup n:* swap pos-x @ swap n:- dup n:* n:+
  swap
  sprite:y@ swap sprite:x@ nip swap pos-y @ swap n:- dup n:* swap pos-x @ swap n:- dup n:* n:+
  n:cmp ;


: sprite-cast-loop
  nip
  \ translate sprite position to relative to camera.
  sprite:x@ pos-x @ n:- sprite-x !
  sprite:y@ pos-y @ n:- sprite-y !

  sprite:dirx@ sprite-x-dir !  \ Get direction of the sprite.
  sprite:images@ swap
  sprite:frame@ nip a:@ nip \ Leave sprite images for the current frame on the TOS.

  \ Calculate angle between player position and sprite position. Round to the nearest 45 degrees.
  sprite-x @ sprite-y @ n:atan2
  n:neg 1.57080 n:- sprite-x-dir @ n:+ 0.78540 n:/ n:round n:int 8 n:mod a:@ nip current-sprite !

  1.0 plane-x @ dir-y @ n:* dir-x @ plane-y @ n:* n:- n:/ inv-det !

  dir-y @ sprite-x @ n:* dir-x @ sprite-y @ n:* n:- inv-det @ n:* transform-x !
  plane-y @ n:neg sprite-x @ n:* plane-x @ sprite-y @ n:* n:+ inv-det @ n:* transform-y !

  WIDTH half transform-x @ transform-y @ n:/ n:1+ n:* n:int sprite-screen-x !

  HEIGHT transform-y @ n:/ n:int n:abs sprite-height !
  sprite-height @ half n:neg HEIGHT half n:+ n:int draw-start-y !
  draw-start-y @ 0 n:< if
    0 draw-start-y !
  then
  sprite-height @ half HEIGHT half n:+ n:int draw-end-y !
  draw-end-y @ HEIGHT n:< not if
    HEIGHT n:1- draw-end-y !
  then
  HEIGHT transform-y @ n:/ n:int n:abs sprite-width !
  sprite-width @ n:neg half sprite-screen-x @ n:+ n:int draw-start-x !
  draw-start-x @ 0 n:< if
    0 draw-start-x !
  then
  sprite-width @ half sprite-screen-x @ n:+ n:int draw-end-x !
  draw-end-x @ WIDTH n:< not if
    WIDTH n:1- draw-end-x !
  then

  ' draw-sprite draw-start-x @ draw-end-x @ n:1- loop ;


: sprite-casting
  sprites @ ' sprite-dist-cmp a:sort
  ' sprite-cast-loop a:each drop ;


: gen-view
  buffer @ 0 0 640 2400 g:rect "gray22" g:fcolor g:fill
  0 240 640 480 g:rect "gray11" g:fcolor g:fill drop
  a:new zbuffer !
  ' raycast-loop 0 WIDTH n:1- loop
  sprite-casting
  buffer @ clone imgbuf ! drop ;


ns: user


: do-draw
  imgbuf @ 0 0 g:image-at drop
  \ Notify game thread, draw is complete.
  ( "task" g:m@ t:notify ) g:do  ;


: secs
  d:ticks d:ticks/sec n:/ ;


: keydown?  \ key -- f
  g:keyinfo nip "down" m:@ nip ;


: redraw \ g -- g
  raycast:gen-view g:invalidate ;


\ Delta timing routine.
\ Uses fixed time step for update.
\ Skips render frames if needed to keep up with the pace.
: update
  \ wait until GUI is up and running:
  -1 sleep
  gui @ redraw

  secs current-time !
  accumulator off

  repeat
    secs new-time !
    new-time @ current-time @ n:- frame-time !
    new-time @ current-time !

    frame-time @ accumulator n:+!

    repeat
      accumulator @ dt @ n:< if
        break
      else
        \ start update
        "cursor up" keydown? if
          dir-x @ move-speed @ n:* dt @ n:* pos-x @ n:+ n:int pos-y @ n:int collision-map @ mat:@ nip not if
            dir-x @ move-speed @ n:* dt @ n:* pos-x @ n:+ pos-x !
          then
          pos-x @ n:int dir-y @ move-speed @ n:* dt @ n:* pos-y @ n:+ n:int collision-map @ mat:@ nip not if
            dir-y @ move-speed @ n:* dt @ n:* pos-y @ n:+ pos-y !
          then
        then
        "alt + cursor up" keydown? if
          dir-x @ move-speed @ n:* dt @ n:* pos-x @ n:+ n:int pos-y @ n:int collision-map @ mat:@ nip not if
            dir-x @ move-speed @ n:* dt @ n:* pos-x @ n:+ pos-x !
          then
          pos-x @ n:int dir-y @ move-speed @ n:* dt @ n:* pos-y @ n:+ n:int collision-map @ mat:@ nip not if
            dir-y @ move-speed @ n:* dt @ n:* pos-y @ n:+ pos-y !
          then
        then
        "cursor down" keydown? if
          pos-x @ dir-x @ move-speed @ n:* dt @ n:* n:- n:int pos-y @ n:int collision-map @ mat:@ nip not if
            pos-x @ dir-x @ move-speed @ n:* dt @ n:* n:- pos-x !
          then
          pos-x @ n:int pos-y @ dir-y @ move-speed @ n:* dt @ n:* n:- n:int collision-map @ mat:@ nip not if
            pos-y @ dir-y @ move-speed @ n:* dt @ n:* n:- pos-y !
          then
        then
        "alt + cursor down" keydown? if
          pos-x @ dir-x @ move-speed @ n:* dt @ n:* n:- n:int pos-y @ n:int collision-map @ mat:@ nip not if
            pos-x @ dir-x @ move-speed @ n:* dt @ n:* n:- pos-x !
          then
          pos-x @ n:int pos-y @ dir-y @ move-speed @ n:* dt @ n:* n:- n:int collision-map @ mat:@ nip not if
            pos-y @ dir-y @ move-speed @ n:* dt @ n:* n:- pos-y !
          then
        then
        "cursor left" keydown? if
          dir-x @ >r
          r@ rot-speed @ dt @ n:* n:cos n:* dir-y @ rot-speed @ dt @ n:* n:sin n:* n:- dir-x !
          r> rot-speed @ dt @ n:* n:sin n:* dir-y @ rot-speed @ dt @ n:* n:cos n:* n:+ dir-y !
          plane-x @ >r
          r@ rot-speed @ dt @ n:* n:cos n:* plane-y @ rot-speed @ dt @ n:* n:sin n:* n:- plane-x !
          r> rot-speed @ dt @ n:* n:sin n:* plane-y @ rot-speed @ dt @ n:* n:cos n:* n:+ plane-y !
        then
        "alt + cursor left" keydown? if
          dir-x @ old-dir-x !
          dir-y @ old-dir-y !
          dir-x @ 90 deg>rad n:cos n:* dir-y @ 90 deg>rad n:sin n:* n:- dir-x !
          old-dir-x @ 90 deg>rad n:sin n:* dir-y @ 90 deg>rad n:cos n:* n:+ dir-y !

          dir-x @ move-speed @ n:* dt @ n:* pos-x @ n:+ n:int pos-y @ n:int collision-map @ mat:@ nip not if
            dir-x @ move-speed @ n:* dt @ n:* pos-x @ n:+ pos-x !
          then
          pos-x @ n:int dir-y @ move-speed @ n:* dt @ n:* pos-y @ n:+ n:int collision-map @ mat:@ nip not if
            dir-y @ move-speed @ n:* dt @ n:* pos-y @ n:+ pos-y !
          then

          old-dir-x @ dir-x !
          old-dir-y @ dir-y !
        then
        "cursor right" keydown? if
          dir-x @ >r
          r@ rot-speed @ dt @ n:* n:neg n:cos n:* dir-y @ rot-speed @ dt @ n:* n:neg n:sin n:* n:- dir-x !
          r> rot-speed @ dt @ n:* n:neg n:sin n:* dir-y @ rot-speed @ dt @ n:* n:neg n:cos n:* n:+ dir-y !
          plane-x @ >r
          r@ rot-speed @ dt @ n:* n:neg n:cos n:* plane-y @ rot-speed @ dt @ n:* n:neg n:sin n:* n:- plane-x !
          r> rot-speed @ dt @ n:* n:neg n:sin n:* plane-y @ rot-speed @ dt @ n:* n:neg n:cos n:* n:+ plane-y !
        then
        "alt + cursor right" keydown? if
          dir-x @ old-dir-x !
          dir-y @ old-dir-y !
          dir-x @ -90 deg>rad n:cos n:* dir-y @ -90 deg>rad n:sin n:* n:- dir-x !
          old-dir-x @ -90 deg>rad n:sin n:* dir-y @ -90 deg>rad n:cos n:* n:+ dir-y !

          dir-x @ move-speed @ n:* dt @ n:* pos-x @ n:+ n:int pos-y @ n:int collision-map @ mat:@ nip not if
            dir-x @ move-speed @ n:* dt @ n:* pos-x @ n:+ pos-x !
          then
          pos-x @ n:int dir-y @ move-speed @ n:* dt @ n:* pos-y @ n:+ n:int collision-map @ mat:@ nip not if
            dir-y @ move-speed @ n:* dt @ n:* pos-y @ n:+ pos-y !
          then

          old-dir-x @ dir-x !
          old-dir-y @ dir-y !
        then
        sprite:update-sprites
        \ end update
        accumulator @ dt @ n:- accumulator !
      then
    again
    \ start render
    redraw
    \ Wait untill draw is complete.
    -1 sleep
  again ;


: update-tuba
  >r
   r@ sprite:x@ nip r@ sprite:speed@ nip dt @ n:* SPRITE-DIST n:+ r@ sprite:dirx@ nip circle-ptx n:int r@ sprite:y@ nip n:int collision-map @ mat:@ nip not if
     r@ r@ sprite:x@ nip r@ sprite:speed@ nip dt @ n:* r@ sprite:dirx@ nip circle-ptx sprite:x! drop
   else
     r@ sprite:dirx@ rad>deg 180 n:+ 360 n:mod n:neg deg>rad sprite:dirx!
     r@ sprite:x@ nip r@ sprite:speed@ nip dt @ n:* r@ sprite:dirx@ nip circle-ptx sprite:x! drop
   then

   r@ sprite:x@ n:int swap sprite:y@ nip r@ sprite:speed@ nip dt @ n:* SPRITE-DIST n:+ r@ sprite:dirx@ nip circle-pty n:int collision-map @ mat:@ nip not if
     r@ r@ sprite:y@ nip r@ sprite:speed@ nip dt @ n:* r@ sprite:dirx@ nip circle-pty sprite:y! drop
   else
     r@ sprite:dirx@ n:neg sprite:dirx!
     r@ sprite:y@ nip r@ sprite:speed@ nip dt @ n:* r@ sprite:dirx@ nip circle-pty sprite:y! drop
   then

   r@ sprite:timer@ dt @ n:+ dup -rot sprite:timer! sprite:time@ nip n:< not if
     r@ sprite:frame@ n:1+ swap sprite:frames@ rot swap n:mod sprite:frame!
     0.0 sprite:timer! drop
   then

  rdrop ;

' update-tuba w:is update-sprite


: app:main
  \ Start the update task, but it will sleep until the GUI is ready:
  ' update t:task
  \ Define our GUI...
  {
    kind: "win",
    title: "Simple raycaster",
    wide: 640,
    high: 480,
    nobg: true,
    center: true,
    resizable: false,
    key-pressed: ( true ) ,
    font: "Arial 10",
    \ Gets invoked when the GUI is present.  Save the new gui handle, and start
    \ the update task (outside this callback):
    init: ( gui ! ( "task" g:m@ t:notify ) g:do ) ,
    draw: "do-draw"
  }
  \ And save the task in our GUI map:
  "task" rot m:!
  \ Create the GUI (don't have to save the gui item, we do that in 'init'):
  g:new ;