Here is a simple raycaster sample in 8th:
\
\ Simple raycaster
\
\ Raycasting code "borrowed" from Lode Vandevenne and adapted for the 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.
\
needs nk/gui
needs nk/render-timed
needs nk/keyboard
needs math/trigd
libbin font/Roboto-Regular.ttf
font/Roboto-Regular.ttf font:new "font1" font:atlas! drop
640 constant WIDTH
480 constant HEIGHT
24 constant MAP-WIDTH
24 constant MAP-HEIGHT
1.0 constant CEILING-HEIGHT
64 constant TEXTURE-WIDTH
85 constant TEXTURE-HEIGHT
nullvar texture
"tiles/wall01.png" app:asset img:new constant texture1
"tiles/wall02.png" app:asset img:new constant texture2
"tiles/door01.png" app:asset img:new constant texture3
"tiles/door02.png" app:asset img:new constant texture4
"tiles/door03.png" app:asset img:new constant texture5
"tiles/door04.png" app:asset img:new constant texture6
[ @texture1 , @texture3 , @texture5 ] constant textures
[ @texture2 , @texture4 , @texture6 ] constant 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,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,0,0,0,0,0,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,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
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
\ Tiles per second.
5 constant MOVE-SPEED
3 constant ROT-SPEED
0 var, time
var old-time
var frame-time
ns? 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
: 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 if
\ Leave texture number on TOS.
n:int n:1-
break
else
drop
then
again
side @ !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:*/ line-height !
line-height @ n:neg half HEIGHT half+ draw-start !
draw-start @ 0 n:max draw-start !
line-height @ half HEIGHT half+ draw-end !
draw-end @ HEIGHT n:< !if
HEIGHT n:1- draw-end !
then
side @ !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:int n:- TEXTURE-WIDTH n:* texture-x !
side @ !if
textures swap a:_@ texture !
ray-dir-x @ if
TEXTURE-WIDTH texture-x @ n:- n:1- texture-x !
then
else
dim-textures swap a:_@ texture !
ray-dir-y @ !if
TEXTURE-WIDTH texture-x @ n:- n:1- texture-x !
then
then
>r \ store column
draw-start @ HEIGHT half- line-height @ half+
TEXTURE-HEIGHT line-height @ n:*/ texture-y-start !
draw-end @ HEIGHT half- line-height @ half+
TEXTURE-HEIGHT line-height @ n:*/ texture-y-end !
r> draw-start @ 1 draw-end @ draw-start @ n:- 4 a:close
texture @
"white"
texture-x @ texture-y-start @ 1 texture-y-end @ texture-y-start @ n:- 4 a:close
nk:draw-sub-image ;
: gen-view
' raycast-loop 0 WIDTH n:1- loop ;
ns
: secs
d:ticks d:ticks/sec n:/ ;
: draw-game
\ Ceiling
[ 0, 0, @WIDTH , ` HEIGHT 2 n:/ n:int ` ] 0 "darkgrey" nk:fill-rect
\ Walls
raycast:gen-view ;
: update-game
time @ old-time !
secs time !
time @ old-time @ n:- frame-time !
scan:RIGHT nk:scancode? if
dir-x @ >r
r@ ROT-SPEED frame-time @ n:* n:neg n:cos n:* dir-y @ ROT-SPEED frame-time @ n:* n:neg n:sin n:* n:- dir-x !
r> ROT-SPEED frame-time @ n:* n:neg n:sin n:* dir-y @ ROT-SPEED frame-time @ n:* n:neg n:cos n:* n:+ dir-y !
plane-x @ >r
r@ ROT-SPEED frame-time @ n:* n:neg n:cos n:* plane-y @ ROT-SPEED frame-time @ n:* n:neg n:sin n:* n:- plane-x !
r> ROT-SPEED frame-time @ n:* n:neg n:sin n:* plane-y @ ROT-SPEED frame-time @ n:* n:neg n:cos n:* n:+ plane-y !
then
scan:LEFT nk:scancode? if
dir-x @ >r
r@ ROT-SPEED frame-time @ n:* n:cos n:* dir-y @ ROT-SPEED frame-time @ n:* n:sin n:* n:- dir-x !
r> ROT-SPEED frame-time @ n:* n:sin n:* dir-y @ ROT-SPEED frame-time @ n:* n:cos n:* n:+ dir-y !
plane-x @ >r
r@ ROT-SPEED frame-time @ n:* n:cos n:* plane-y @ ROT-SPEED frame-time @ n:* n:sin n:* n:- plane-x !
r> ROT-SPEED frame-time @ n:* n:sin n:* plane-y @ ROT-SPEED frame-time @ n:* n:cos n:* n:+ plane-y !
then
scan:DOWN nk:scancode? if
pos-x @ dir-x @ MOVE-SPEED frame-time @ n:* n:* n:- n:int pos-y @ n:int collision-map @ mat:@ nip not if
pos-x @ dir-x @ MOVE-SPEED frame-time @ n:* n:* n:- pos-x !
then
pos-x @ n:int pos-y @ dir-y @ MOVE-SPEED frame-time @ n:* n:* n:- n:int collision-map @ mat:@ nip not if
pos-y @ dir-y @ MOVE-SPEED frame-time @ n:* n:* n:- pos-y !
then
then
scan:UP nk:scancode? if
dir-x @ MOVE-SPEED frame-time @ n:* n:* pos-x @ n:+ n:int pos-y @ n:int collision-map @ mat:@ nip not if
dir-x @ MOVE-SPEED frame-time @ n:* n:* pos-x @ n:+ pos-x !
then
pos-x @ n:int dir-y @ MOVE-SPEED frame-time @ n:* n:* pos-y @ n:+ n:int collision-map @ mat:@ nip not if
dir-y @ MOVE-SPEED frame-time @ n:* n:* pos-y @ n:+ pos-y !
then
then
scan:ESCAPE nk:scancode? if
bye
then ;
: new-win
{
name: "main",
wide: @WIDTH,
high: @HEIGHT,
resizable: false,
bg: "black",
title: "Raycaster"
}
nk:win ;
: main-render
{
title: "game",
bg: "black",
padding: [0,0],
flags: [ @nk:WINDOW_NO_SCROLLBAR ]
}
nk:begin
draw-game
nk:timer? if
update-game
then
nk:end ;
: app:main
new-win ' main-render 100 60 n:/ nk:render-timed ;
