Alla raycaster testi 8th ohjelmointikielellä. Jätin teksturoidun lattian ja katon pois, koska en saanut niiden kanssa riittävää suorituskykyä. Animoidut 8:sta eri suunnasta näkyvät spritet toki toteutin.
Koodi, tarvittavat grafiikkatiedostot ja valmiit ajettavat binäärit Windows ja Linux käyttöjärjestelmille löytyypi täältä
\
\ 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 ;Aihe on jo aika vanha, joten et voi enää vastata siihen.