The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 


  << Previous Topic | Next Topic >>Return to Index  

Raycaster Demo

January 8 2008 at 7:31 AM
  (no login)

 
' All the code is here to run textured...but you need the texture
' files. I decided to "hex" the assembly in here (along with
' the verbosely commented ASM I wrote it as), and DATA-fied the
' level. So, it's really long, but it'll run alone and fit into
' a plain text window.

' Another Ray Caster, by Tim Williams, 1-08-2008.

' As shown, typical framerate is up to 70FPS (face planted in a
' wall), to as low as 18 over long distances (set most of the
' level to zeroes to see that). Clearly, the raycasting inner
' loop needs fixed point math, and then ASM.

' ASM keyboard scancode reader by Joe Huber Jr. and Milo Sedlacek.

DEFINT A-Z
'$DYNAMIC

DECLARE SUB Automap ()
DECLARE SUB CollisionDetect (xMove AS SINGLE, yMove AS SINGLE)
DECLARE SUB CopyBuffer ()
DECLARE SUB ImageStrip (x, Height, Offset, Col)
DECLARE SUB KeyTest ()
DECLARE SUB LoadLevel (FileName$)
DECLARE SUB LoadTextures (FileNames() AS STRING)
DECLARE FUNCTION MultiKey (t)
DECLARE SUB Render ()

' Width of a block on the map
CONST MapBlock = 64
' Amount moved per step.
CONST ConstStep = 6
' Angle turned per step (angles are in 0.25 degree units!)
CONST AngleStep = 12
' Detail level: number of vertical strips per ray
CONST Detail = 1
' Height of a block on the map
CONST Height = 48
' Graphics mode, center and dimensions
CONST Mode = 13, xScreen = 320&, yScreen = 200&, xCenter = xScreen \ 2, yCenter = yScreen \ 2
' Number of wall textures
CONST MaxCol = 1

DIM SHARED xPlayer AS SINGLE, yPlayer AS SINGLE, AngPlayer, xMap, yMap, S(-360 TO 1799) AS SINGLE
DIM SHARED xSize, ySize
' Buffer is used by ImageStrip / Render and CopyBuffer
DIM SHARED Buffer(1)
'REDIM Buffer(32000)
' MapData and PicData are REDIM'd under LoadLevel and LoadWalls.
DIM SHARED MapData(1), PicData(1)
DIM SHARED WallFileNames(1 TO MaxCol) AS STRING

LoadLevel "" ' "LEVEL" 'Level is stored as DATA

' Mode must be set before loading textures because of the palette
SCREEN Mode
' A few Doom flats and patches:
'WallFileNames(1) = "FLOOR0_1"
'WallFileNames(2) = "FLOOR5_1"
'WallFileNames(3) = "WALL02_2"
'WallFileNames(4) = "WALL71_5"
'WallFileNames(5) = "MFLR8_3"
'WallFileNames(6) = "COMP03_1"
'LoadTextures WallFileNames()

' Initialize sine table. Caution: limit angles between 0 and 359.
' The fudge factor avoids division by zero.
FOR i = 0 TO 1799
S(i) = SIN(i * 4.363323E-03) + 1E-30
NEXT

AngPlayer = 0: AngStep = AngleStep

Render
ON ERROR GOTO ShutDown
DIM xMove AS SINGLE, yMove AS SINGLE
' Turn on key scanner. WARNING: CTRL+BREAK will not function in the loop!
z = MultiKey(-1)

DO
k$ = INKEY$ 'k$ should always be empty, but just in case...

' Keys. Use KeyTest to find scan codes for other bindings.
'Speed (RSHIFT) Note: apparently LSHIFT sometimes comes with the
' arrow keys, so LSHIFT cannot be used for speed.
IF MultiKey(54) THEN
MoveStep = ConstStep + ConstStep
AngStep = AngleStep + AngleStep
ELSE
MoveStep = ConstStep
AngStep = AngleStep
END IF
'Strafe (ALT)
IF MultiKey(56) THEN Strafe = -1 ELSE Strafe = 0
'Forward (W, UARR, NUM8)
IF MultiKey(17) OR MultiKey(72) THEN
xMove = MoveStep * S(AngPlayer + 360)
yMove = MoveStep * S(AngPlayer)
END IF
'Backward (S, DARR, NUM2)
IF MultiKey(31) OR MultiKey(80) THEN
xMove = xMove - MoveStep * S(AngPlayer + 360)
yMove = yMove - MoveStep * S(AngPlayer)
END IF
'Strafe left (A)
IF MultiKey(30) THEN
xMove = xMove + MoveStep * S(AngPlayer)
yMove = yMove - MoveStep * S(AngPlayer + 360)
END IF
'Strafe right (D)
IF MultiKey(32) THEN
xMove = xMove - MoveStep * S(AngPlayer)
yMove = yMove + MoveStep * S(AngPlayer + 360)
END IF
'Turn/strafe left (LARR)
IF MultiKey(75) THEN
IF Strafe THEN
xMove = xMove + MoveStep * S(AngPlayer)
yMove = yMove - MoveStep * S(AngPlayer + 360)
ELSE
AngPlayer = AngPlayer - AngStep
IF AngPlayer < 0 THEN AngPlayer = AngPlayer + 1440
xMove = xMove + 1E-30
END IF
END IF
'Turn/strafe right (RARR)
IF MultiKey(77) THEN
IF Strafe THEN
xMove = xMove - MoveStep * S(AngPlayer): yMove = yMove + MoveStep * S(AngPlayer + 360)
ELSE
AngPlayer = AngPlayer + AngStep
IF AngPlayer >= 1440 THEN AngPlayer = AngPlayer - 1440
xMove = xMove + 1E-30
END IF
END IF
'Automap (TAB)
IF MultiKey(15) THEN
WHILE MultiKey(15): WEND
z = MultiKey(-2)
Automap
z = MultiKey(-1)
xMove = 1E-30
END IF
'Quit (ESC)
IF MultiKey(1) THEN EXIT DO
IF xMove THEN
CollisionDetect xMove, yMove
Frames = Frames + 1
Render
LOCATE 1, 35
COLOR 48
PRINT FPS;
IF TIMER > Start! THEN
FPS = Frames: Frames = 0
Start! = TIMER + 1
END IF
xMove = 1E-30: yMove = 0
END IF
LOOP UNTIL k$ = CHR$(27)
' Turn off key scanner
z = MultiKey(-2)
ON ERROR GOTO 0
END

ShutDown:
PRINT "Fatal error, code:"; ERR
ERROR ERR
END

' Level data
DATA 32,32
DATA 7,1,2,3,4,5,6,7,1,2,3,4,5,6,7,1,2,3,4,5,6,7,1,2,3,4,5,6,7,1,2,6
DATA 4,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
DATA 3,0,X,0,0,0,0,0,0,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
DATA 2,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,1
DATA 7,3,2,1,3,2,1,0,1,1,0,3,1,1,1,1,0,0,1,0,0,0,0,0,0,0,0,1,1,0,0,1
DATA 6,5,0,0,0,1,0,0,0,0,0,4,0,0,0,2,0,0,1,0,0,0,0,0,0,0,0,1,1,0,0,1
DATA 5,0,5,0,0,3,0,0,0,0,0,5,0,0,0,1,0,0,1,0,0,0,0,0,0,0,0,1,1,0,0,1
DATA 4,1,0,0,1,2,0,0,0,0,0,6,0,0,0,0,0,0,1,0,0,1,2,1,1,0,0,0,0,0,0,1
DATA 3,0,0,3,0,0,0,0,0,0,0,7,0,0,0,0,0,0,1,0,0,1,1,6,6,0,0,0,0,0,0,1
DATA 2,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,1,6,6,1,1,1,1,0,0,1
DATA 1,0,0,0,0,0,5,0,5,0,0,1,0,0,0,0,0,0,1,0,0,0,1,6,6,1,6,6,1,0,0,1
DATA 7,1,2,1,3,1,2,0,2,1,3,1,0,0,0,0,0,0,0,0,0,0,2,1,1,5,6,6,1,0,0,1
DATA 6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,6,6,1,0,0,1
DATA 5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,6,6,1,0,0,1
DATA 4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,1,1,1,0,0,1
DATA 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
DATA 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3,0,0,0,1,0,0,0,0,0,0,0,0,0,1
DATA 1,0,0,0,0,1,1,0,1,1,0,0,0,0,0,0,0,2,0,0,0,0,2,0,0,0,0,0,1,2,1,1
DATA 7,0,0,0,1,1,0,0,0,1,1,0,0,0,0,0,0,1,0,0,0,0,0,3,0,0,0,0,1,0,0,1
DATA 6,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,2,0,0,0,0,0,0,4,0,0,0,1,0,0,1
DATA 5,0,0,0,2,0,0,0,0,0,2,0,0,0,0,0,0,3,0,0,0,0,0,5,0,5,0,0,3,0,0,1
DATA 4,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,6,0,0,0,6,0,2,0,0,1
DATA 3,0,0,0,1,1,0,0,0,1,1,1,2,0,0,0,0,0,0,0,0,7,0,0,0,0,0,0,2,0,0,1
DATA 2,0,0,0,0,1,1,3,1,1,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,1,0,1
DATA 1,0,0,0,0,0,1,2,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,1,3,0,0,0,0,0,0,1
DATA 7,0,0,0,0,0,0,0,0,0,0,0,3,0,0,0,0,0,0,0,0,0,0,2,2,0,0,0,0,0,0,1
DATA 6,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
DATA 5,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,2,3,2,4,2,0,0,0,0,0,0,0,0,0,0,1
DATA 4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
DATA 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
DATA 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
DATA 7,1,2,3,4,5,6,7,1,2,3,4,5,6,7,1,2,3,4,5,6,7,1,2,3,4,5,6,7,1,2,6

' Assembly code for the ray drawing routine.
' (For assembler on the keyboard interrupt code, see the original.)
' Arrows and lines connect stack operations.
'
' ; Initialization:
' 0100 PUSH BP ; Save BP --> - - - - - - - - - - - - - - - - - -
' 0101 MOV BP,SP |
' ; Retrieve passed values (use BYVAL!): |
' 0103 MOV DX,[BP+0A] ; Put xOffset in DX |
' 0106 MOV AX,[BP+08] ; Get Height, put it in AX, |
' 0109 PUSH AX ; and save it for later --> - - - - - - - - - - |
' ; Generate "Top" value: | |
' 010A NEG AX | |
' 010C ADD AX,0064 ; Subtract AX from 100 (64h) | |
' 010F MOV CL,06 | |
' 0111 SHL AX,CL ; AX * 64 | |
' 0113 MOV BX,DX | |
' 0115 ADD BX,AX ; BX = xOffset + (64h * Height) | |
' 0117 MOV CL,02 | |
' 0119 SHL AX,CL ; AX * 4 (a total of x256) | |
' 011B ADD AX,BX | |
' ; Top is: AX = ((100 - Height) * 320) + xOffset | |
' ; Now to shuffle registers a bit... | |
' 011D POP CX ; Get Height <-- - - - - - - - - - - - - - - - |
' 011E PUSH DS ; Save DS and DI --> - - - - - - - - - - - - - |
' 011F PUSH DI ; | |
' 0120 MOV BX,[BP+06] ; Get color, | |
' 0123 PUSH BX ; then re-save it --> - - - - - - - - - - - - | |
' 0124 PUSH CX ; Save Height --> - - - - - - - - - - - - - | | |
' 0125 MOV BX,A000 ; | | | |
' 0128 MOV DS,BX ; Set video segment | | | |
' 012A MOV CX,DX ; Initialize write loop, CX is row | | | |
' 012C MOV BX,000B ; Set background color | | | |
' 012F CALL 015B ; Write top line segment ("ceiling") | | | |
' 0132 POP AX ; Get Height <-- - - - - - - - - - - - - - | | |
' 0133 PUSH CX ; Save current row --> - - - - - - - - - - | | |
' ; Generate "Bottom" value. Similar to Top. | | | |
' 0134 ADD AX,0064 ; Add 100 (64h) to Height | | | |
' 0137 MOV CL,06 | | | |
' 0139 SHL AX,CL ; AX * 64 | | | |
' 013B MOV BX,DX ; Get xOffset again | | | |
' 013D ADD BX,AX ; BX = xOffset + (64 * Height) | | | |
' 013F MOV CL,02 | | | |
' 0141 SHL AX,CL ; AX * 4 | | | |
' 0143 ADD AX,BX | | | |
' ; Bottom is: AX = ((100 + Height) * 320) + xOffset | | | |
' 0145 POP CX ; Restore row <-- - - - - - - - - - - - - - | | |
' 0146 POP BX ; Restore color <-- - - - - - - - - - - - - - | |
' 0147 CALL 015B ; Write middle line segment ("wall") | |
' 014A MOV BX,0006 ; Set background color ("floor") | |
' 014D MOV AX,FA00 ; Run to bottom of screen | |
' 0150 ADD AX,DX | |
' 0152 CALL 015B ; Write bottom line segment ("floor") | |
' ; Cleanup and end | |
' 0155 POP DI ; Restore DI and DS | |
' 0156 POP DS ; <-- - - - - - - - - - - - - - - - - - - - - - |
' 0157 POP BP ; Restore BP <-- - - - - - - - - - - - - - - - -
' 0158 RETF 0006 ; End procedure, return to QBASIC.
' ; Inner loop.
' ; Passed values: BL = color, CX = starting row, AX = ending row.
' ; CX and AX must have the same column offset!
' ; Writes a vertical line to the screen (set DS externally).
' ; Returns: CX incremented by at least 140h, CX >= AX, DI = CX - 140h.
' 015B MOV DI,CX
' 015D MOV [DI],BL ; Write pixel
' 015F ADD CX,0140 ; Increment by 320 (140h), one row
' 0163 CMP CX,AX ; Are we there yet?
' 0165 JNZ 015B ; Repeat to 015B while CX <> AX
' 0167 RET ; Go back to CALL
' (Technically there is stack action here too, but it's handled
' automatically by the CALL / RET operations.)
' -- 104 (68h) bytes

REM $STATIC
' Draws the complete automap.
' TODO: show only viewed blocks (poke bit in MapData?).
SUB Automap
IF xScreen \ xMap < yScreen \ yMap THEN Block = xScreen \ xMap ELSE Block = yScreen \ yMap
LINE (0, 0)-(xScreen - 1, yScreen - 1), 0, BF
FOR y = 0 TO yMap
FOR x = 0 TO xMap
Col = MapData(x + y * xMap) AND 15
IF Col > 0 THEN LINE (x * Block, y * Block)-(x * Block + Block - 1, y * Block + Block - 1), Col, BF
NEXT x, y
x = xPlayer * Block / MapBlock: y = yPlayer * Block / MapBlock
LINE (x - 2, y - 2)-(x + 2, y + 2), 12
LINE (x + 2, y - 2)-(x - 2, y + 2), 12
WHILE INKEY$ = "": WEND
END SUB

' Checks the map if the specified player movement is allowed (won't collide
' with a column). Automatically updates player coordinates.
SUB CollisionDetect (xMove AS SINGLE, yMove AS SINGLE)
' Check the specified moves, plus the bounding box (MoveStep)
xCheck = xPlayer + xMove + SGN(xMove) * ConstStep * 2
yCheck = yPlayer + yMove + SGN(yMove) * ConstStep * 2
IF MapData((xCheck \ MapBlock) + (yCheck \ MapBlock) * xMap) = 0 THEN
xPlayer = xPlayer + xMove
yPlayer = yPlayer + yMove
ELSE
' Determine how much movement is left on each axis
xBlock = xPlayer \ MapBlock: yBlock = yPlayer \ MapBlock
' The limits are (x/yBlock * MapBlock) + MoveStep and
' ((x/yBlock + 1) * MapBlock - MoveStep.

END IF
END SUB

' (Somewhat slow) buffer copy. Writes Buffer() to &HA000 for SCREEN 13.
SUB CopyBuffer
DIM Index AS LONG
WAIT &H3DA, 8
Pointer = VARPTR(Buffer(0))
FOR Index = 0 TO 63999
DEF SEG = VARSEG(Buffer(0))
Col = PEEK(Pointer + Index)
DEF SEG = &HA000
POKE Index, Col
NEXT
DEF SEG
END SUB

' Draws a strip of textured raycast goodness at screen coordinate x, strip
' length Height * 2, and offset (in PicData) as specified.
SUB ImageStrip (x, Height, Offset, Col)
' It seems Code has to be STATIC in the same subroutine.
STATIC Code AS STRING, FirstTime
IF FirstTime = 0 THEN
' Load machine code for line drawing
c$ = ""
c$ = c$ + "5589E58B560A8B460850F7D8056400B106D3E089D301C3B102D3E001D8591E57"
c$ = c$ + "8B5E065351BB00A08EDB89D1BB0B00E829005851056400B106D3E089D301C3B1"
c$ = c$ + "02D3E001D8595BE81100BB0600B800FA01D0E806005F1F5DCA060089CF881D81"
c$ = c$ + "C1400139C175F4C3E9"
FOR i = 0 TO 104 'Load ASM
d = VAL("&H" + MID$(c$, i * 2 + 1, 2))
Code = Code + CHR$(d)
NEXT i
FirstTime = -1
END IF

' Fast assembly write
DEF SEG = VARSEG(Code)
CALL ABSOLUTE(BYVAL x, BYVAL Height, BYVAL Col, SADD(Code))
DEF SEG
EXIT SUB

' Textured. Directly POKE'd, buffered, or PSET (slow!)
DIM Index AS LONG
DEF SEG = &HA000
'DEF SEG = VARSEG(Buffer(0))
Pointer = x
'Pointer = VARPTR(Buffer(0))
IF Height > yCenter THEN Height = yCenter
Top = yCenter - Height
Bottom = yCenter + Height
FOR y = 0 TO Top - 1
Index = xScreen * CLNG(y)
POKE Pointer + Index, 11
NEXT
xPic = Offset * xSize \ MapBlock + xSize * ySize * Col
FOR y = Top TO Bottom - 1
y0 = y - Top
yPic = y0 * ySize \ Height * 2
Col = PicData(xPic + yPic * xSize)
'Col = 15
Index = xScreen * y
'PSET (x, y), Col
POKE Pointer + Index, Col
NEXT
FOR y = Bottom TO yScreen
Index = xScreen * CLNG(y)
POKE Pointer + Index, 8
NEXT
DEF SEG
END SUB

' KEYTEST - helps you find new keycodes.
' By Joe Huber Jr. and Milo Sedlacek.
'Usage:
' CALL KEYTEST or KEYTEST
' This will show all 128 keycodes & their statuses.
' Press & hold a key & a 1 will appear somewhere.
' The number that the 1 is by will be the keycode
' for that key. Simple!
SUB KeyTest
SCREEN 0: CLS
z = MultiKey(-1)
PRINT "Press ESC to begin..."
WHILE MultiKey(1) = 1: WEND
CLS
DO
x = 1
y = 1
FOR i = 1 TO 128
Test = MultiKey(i)
LOCATE y, x
IF i < 100 THEN
PRINT USING "## = ##"; Test; i
ELSE
PRINT USING "## = ###"; Test; i
END IF
IF y < 23 THEN
y = y + 1
ELSE
y = 1
x = x + 12
END IF
NEXT i
LOOP WHILE MultiKey(1) = 0
z = MultiKey(-2)
END
END SUB

' Loads the specified level.
SUB LoadLevel (FileName$)
'OPEN FileName$ + ".RAY" FOR INPUT AS #1
'INPUT #1, xMap, yMap
READ xMap, yMap
REDIM MapData(xMap * yMap - 1)
xMap = xMap - 1: yMap = yMap - 1
FOR y = 0 TO yMap
FOR x = 0 TO xMap
'INPUT #1, k$
READ k$
IF k$ = "X" THEN
xPlayer = x * MapBlock + MapBlock / 2
yPlayer = y * MapBlock + MapBlock / 2
END IF
MapData(x + y * xMap) = VAL(k$)
NEXT x, y
'CLOSE
IF xPlayer = 0 OR yPlayer = 0 THEN ERROR 100
END SUB

' Loads the wall textures. Expected: uncompressed bitmaps with 40-byte
' header and 8 bit data (256 colors). All widths, heights and palettes
' must be equal to the first image's.
SUB LoadTextures (FileNames() AS STRING)
DIM k AS STRING * 1
' Load the first image for stats
FOR i = 1 TO MaxCol
OPEN FileNames(i) + ".BMP" FOR BINARY AS #1
Header$ = SPACE$(14)
Sizing$ = SPACE$(4)
GET #1, 1, Header$
GET #1, 15, Sizing$
InfoSize = CVI(Sizing$)
' Only 40-byte header
IF InfoSize <> 40 THEN ERROR 101
InfoHeader$ = SPACE$(40)
GET #1, 15, InfoHeader$
nBits = CVI(MID$(InfoHeader$, 15, 4))
' Only 8 bit BMP
IF nBits <> 8 THEN ERROR 102
Filesize = CVL(MID$(Header$, 3, 4))
Offset = CVL(MID$(Header$, 11, 4))
HeaderSize = CVL(MID$(InfoHeader$, 1, 4))
IF HeaderSize <> 40 THEN ERROR 103
xWidth = CVL(MID$(InfoHeader$, 5, 4))
yHeight = CVL(MID$(InfoHeader$, 9, 4))
GET #1, 54, k
IF i = 1 THEN
xSize = xWidth: ySize = yHeight
REDIM PicData(xSize * ySize * MaxCol)
' Set palette
FOR Col = 0 TO 255
GET #1, , k
B = INT(ASC(k) \ 4)
GET #1, , k
G = INT(ASC(k) \ 4)
GET #1, , k
R = INT(ASC(k) \ 4)
OUT &H3C8, Col
OUT &H3C9, R
OUT &H3C9, G
OUT &H3C9, B
GET #1, , k
NEXT
ELSE
IF xWidth <> xSize OR yHeight <> ySize THEN ERROR 104
END IF
CompType = CVL(MID$(InfoHeader$, 17, 4))
' Uncompressed
IF CompType > 0 THEN ERROR 105
GET #1, 1078, k
FOR y = ySize - 1 TO 0 STEP -1
Index = y * ySize + (i - 1) * xSize * ySize
FOR x = 0 TO xSize - 1
GET 1, , k
PicData(x + Index) = ASC(k)
NEXT
NEXT
CLOSE
NEXT i
END SUB

' MultiKey - main routine.
' By Joe Huber Jr. and Milo Sedlacek.
'Usage:
' X = MultiKey(t)
' for t = -1, -2, or 1 - 128.
' t = -1: IMPORTANT!!! Make sure you pass this value to
' the function before -2 and 1 - 128! It turns the
' interrupt on so you can start reading keys.
' Returns: 0
' t = -2: EXTREMELY IMPORTANT!!!!!!!!
' ALWAYS pass this before you end your program!
' If you don't, your computer won't be able to
' read your keyboard & you'll have to reset!
' i.e., CTRL-ALT-DEL won't work!!
' Returns: 0
' t = keycode (1-128): Returns status of a key.
' Returns: 1 if pressed, 0 if unpressed.
FUNCTION MultiKey (t)
STATIC KbControl(), KbMatrix(), FirstTime, StatusFlag
IF FirstTime = 0 THEN 'Initalize
DIM KbControl(128)
DIM KbMatrix(128)
Code$ = ""
Code$ = Code$ + "E91D00E93C00000000000000000000000000000000000000000000000000"
Code$ = Code$ + "00001E31C08ED8BE24000E07BF1400FCA5A58CC38EC0BF2400B85600FAAB"
Code$ = Code$ + "89D8ABFB1FCB1E31C08EC0BF2400BE14000E1FFCFAA5A5FB1FCBFB9C5053"
Code$ = Code$ + "51521E560657E460B401A8807404B400247FD0E088C3B700B0002E031E12"
Code$ = Code$ + "002E8E1E100086E08907E4610C82E661247FE661B020E6205F075E1F5A59"
Code$ = Code$ + "5B589DCF"
Pointer = VARPTR(KbControl(0))
DEF SEG = VARSEG(KbControl(0))
FOR i = 0 TO 155 'Load ASM
d = VAL("&H" + MID$(Code$, i * 2 + 1, 2))
POKE Pointer + i, d
NEXT i
i& = 16 'This stuff tells the interrupt where kbmatrix(0) is
n& = VARSEG(KbMatrix(0))
l& = n& AND &HFF
h& = ((n& AND &HFF00) \ 256)
POKE i&, l&
POKE i& + 1, h&
i& = i& + 2
n& = VARPTR(KbMatrix(0))
l& = n& AND &HFF
h& = ((n& AND &HFF00) \ 256)
POKE i&, l&
POKE i& + 1, h&
DEF SEG
FirstTime = -1
END IF
SELECT CASE t
CASE -1
IF StatusFlag = 0 THEN
DEF SEG = VARSEG(KbControl(0))
CALL ABSOLUTE(0) 'Run interrupt
DEF SEG
StatusFlag = 1
END IF
CASE -2
IF StatusFlag = 1 THEN
DEF SEG = VARSEG(KbControl(0)) 'Turn off interrupt
CALL ABSOLUTE(3)
DEF SEG
StatusFlag = 0
END IF
CASE 1 TO 128
MultiKey = KbMatrix(t) 'Return status
CASE ELSE
MultiKey = 0 'User Stupidity Error
END SELECT
END FUNCTION

' Render algorithm: casts a starting ray down the left side of the screen.
' Whatever it hits, that block is drawn as a quadrilateral. Then, instead
' of casting rays for each screen column, a ray is cast just to the side of
' this block. It will hit whatever's next, as will its edge, and so on,
' recursively until the right side of the screen is reached. The slowest
' part about ray casting is the ray casting, so this saves on a lot of work.
SUB Render
DIM xSlope AS SINGLE, ySlope AS SINGLE
DIM Travel AS SINGLE, TravelIntH AS SINGLE, TravelIntV AS SINGLE
DIM Index AS LONG
' Place viewing center a half step rearward of the player coordinates
xP = xPlayer - ConstStep * S(AngPlayer + 360)
yP = yPlayer - ConstStep * S(AngPlayer)
x = 0
WHILE x < xScreen
' Set ySlope to the screen tangent (xSlope is 1 in the rotation)
ySlope = (x - xCenter) / xCenter
' Rotate to angle
xSlope = S(AngPlayer + 360) - ySlope * S(AngPlayer) + 1E-30
ySlope = S(AngPlayer) + ySlope * S(AngPlayer + 360) + 1E-30
xRay = xP: yRay = yP
' IntStep nudges the ray to the next block, so the loop will finish.
IF xSlope > 0 THEN xIntStep = MapBlock ELSE xIntStep = -1
IF ySlope > 0 THEN yIntStep = MapBlock ELSE yIntStep = -1
' Find the initial intersections
xBlock = xRay \ MapBlock
xIntV = xBlock * MapBlock + xIntStep
'Divide by zero checking; fudge factors and SINGLE avoid this
'IF xSlope = 0 THEN TravelIntV = 32767 ELSE
TravelIntV = (xIntV - xP) / xSlope
yBlock = yRay \ MapBlock
yIntH = yBlock * MapBlock + yIntStep
'IF ySlope = 0 THEN TravelIntH = 32767 ELSE
TravelIntH = (yIntH - yP) / ySlope
DO
' Ray casting inner loop. The divide is slow, but perfectly
' accurate at least.
IF TravelIntH < TravelIntV THEN
Travel = TravelIntH
yRay = yP + Travel * ySlope
yBlock = yRay \ MapBlock
yIntH = yBlock * MapBlock + yIntStep
TravelIntH = (yIntH - yP) / ySlope
WallHoriz = -1
ELSE
Travel = TravelIntV
xRay = xP + Travel * xSlope
xBlock = xRay \ MapBlock
xIntV = xBlock * MapBlock + xIntStep
TravelIntV = (xIntV - xP) / xSlope
WallHoriz = 0
END IF
Col = MapData(xBlock + yBlock * xMap)
IF Col THEN EXIT DO
LOOP
' That cheap hack, IntStep, must be subtracted to get correct
' texture alignment (more or less).
xRay = xP + Travel * xSlope: yRay = yP + Travel * ySlope
xRay = xRay - xIntStep: yRay = yRay - yIntStep
xBlock = xRay \ MapBlock: yBlock = yRay \ MapBlock
x1 = xBlock * MapBlock: y1 = yBlock * MapBlock
IF xSlope > 0 THEN x1 = x1 + MapBlock
IF ySlope > 0 THEN y1 = y1 + MapBlock
IF WallHoriz THEN
Remainder = xRay MOD MapBlock
x2 = x1 + MapBlock: y2 = y1
ELSE
Remainder = yRay MOD MapBlock
x2 = x1: y2 = y1 + MapBlock
END IF
IF Col > 0 THEN
IF WallHoriz THEN Col = Col + 8
'IF Col > MaxCol THEN Col = MaxCol
'Col = Col - 1
IF Travel <= 0 THEN Travel = 1
Dist = Height * yCenter \ Travel
IF Dist >= yCenter THEN Dist = yCenter - 1
IF Dist < 1 THEN Dist = 1
'LINE (x, 0)-(x, yCenter - Dist - 1), 11
'LINE (x, yCenter - Dist)-(x, yCenter + Dist), Col
'LINE (x, yCenter + Dist + 1)-(x, yScreen), 8
ImageStrip x, CINT(Dist), Remainder, Col

GOTO NextPass

' Raycast textured
'Distance = Dist * 2 + 1
DEF SEG = &HA000
'DEF SEG = VARSEG(Buffer(0))
Pointer = x
'Pointer = VARPTR(Buffer(0)) + x
Top = yCenter - Dist
Bottom = yCenter + Dist
'FOR y = 0 TO Top - 1
' Index = xScreen * y
' POKE Pointer + Index, 11
'NEXT
'FOR y = Top TO Bottom - 1
' Index = xScreen * y
' POKE Pointer + Index, 0
'NEXT
xPic = Remainder * xSize \ MapBlock + xSize * ySize * Col
FOR y = Top TO Bottom
y0 = y - Top
yPic = y0 * ySize \ Distance
Col = PicData(xPic + yPic * xSize)
'Col = 15
Index = xScreen * y
'PSET (x, y), Col
POKE Pointer + Index, Col
NEXT
'FOR y = Bottom + 1 TO yScreen
' Index = xScreen * y
' POKE Pointer + Index, 8
'NEXT
DEF SEG

GOTO NextPass
' Polygon textured, per the proposed algorithm.
' Needs a short stack, because polygons in the background will
' advance past nearer polygons viewed on edge. Whole wall sides
' disappear!

' Rotate coordinates
x1 = x1 - xP: y1 = y1 - yP: x2 = x2 - xP: y2 = y2 - yP
A = -AngPlayer + 1440
IF A >= 1440 THEN A = A - 1440
x1p = x1 * S(A + 360) - y1 * S(A)
y1p = x1 * S(A) + y1 * S(A + 360)
x2p = x2 * S(A + 360) - y2 * S(A)
y2p = x2 * S(A) + y2 * S(A + 360)
IF x1p < 1 OR x2p < 1 THEN GOTO NextPass
x1 = xCenter + xCenter * y1p / x1p: y1 = yCenter + yCenter * Height / x1p
x2 = xCenter + xCenter * y2p / x2p: y2 = yCenter + yCenter * Height / x2p
y3 = yScreen - y2: y4 = yScreen - y1
Col = Col + 8
LINE (x1, y1)-(x2, y2), Col
LINE (x2, y2)-(x2, y3), Col
LINE (x2, y3)-(x1, y4), Col
LINE (x1, y4)-(x1, y1), Col

' Advance x to the farthest edge of the polygon
IF x2 < x1 THEN SWAP x1, x2
IF x < x2 THEN x = x2
END IF
' Because x always advances by at least 1, the worst that can
' happen is everything gets drawn by ray instead of polygon.
' Ray casting is rather fast when up close, so this doesn't matter
' much.
NextPass: x = x + Detail
WEND
'CopyBuffer
END SUB

 
 Respond to this message   
AuthorReply

(Login Tusike)

Nice demo

January 8 2008, 11:58 AM 

What will the player have to do?

PS: I'm always amazed by 3D games, since I have no idea on how to code one. But check out my game Snake, it's 2D but still really great! Look for ProgramList Tusike in the Proud section. (I'm just trying to spread the game all over the world...)

-Tusike

 
 Respond to this message   
Flux
(no login)

Optimized Raycaster Demo, needs qbasic /run to proper start and shutdown by ESC

March 1 2012, 3:34 AM 

DECLARE SUB LoadLevel (FileName$)
DECLARE SUB CollisionDetect (xMove AS SINGLE, yMove AS SINGLE)
DECLARE SUB Render ()
DECLARE SUB ImageStrip (x%, Height%, Offset%, Col%)
DECLARE FUNCTION MultiKey% (t%)
DEFINT A-Z
REM $DYNAMIC
CONST MapBlock = 64
CONST ConstStep = 6
CONST AngleStep = 12
CONST Detail = 1
CONST Height = 48
CONST Mode = 13, xScreen = 320&, yScreen = 200&, xCenter = xScreen \ 2, yCenter = yScreen \ 2
DIM SHARED xWalker AS SINGLE, yWalker AS SINGLE, AngWalker, xMap, yMap, S(-360 TO 1799) AS SINGLE
DIM SHARED MapData(1), PicData(1)
LoadLevel ""
SCREEN Mode
FOR i = 0 TO 1799
S(i) = SIN(i * 4.363323E-03) + 1E-30
NEXT
DIM xMove AS SINGLE, yMove AS SINGLE
z = MultiKey(-1)
DO
'speed (space)
IF MultiKey(57) THEN
MoveStep = ConstStep + ConstStep
AngStep = AngleStep + AngleStep
ELSE
MoveStep = ConstStep
AngStep = AngleStep
END IF
'forward (up arrow)
IF MultiKey(72) THEN
xMove = MoveStep * S(AngWalker + 360)
yMove = MoveStep * S(AngWalker)
END IF
'backward (down arrow)
IF MultiKey(80) THEN
xMove = xMove - MoveStep * S(AngWalker + 360)
yMove = yMove - MoveStep * S(AngWalker)
END IF
'strafe left (left sign)
IF MultiKey(51) THEN
xMove = xMove + MoveStep * S(AngWalker)
yMove = yMove - MoveStep * S(AngWalker + 360)
END IF
'strafe right (right sign)
IF MultiKey(52) THEN
xMove = xMove - MoveStep * S(AngWalker)
yMove = yMove + MoveStep * S(AngWalker + 360)
END IF
'turn left (left arrow)
IF MultiKey(75) THEN
AngWalker = AngWalker - AngStep
IF AngWalker < 0 THEN AngWalker = AngWalker + 1440
END IF
'turn right (right arrow)
IF MultiKey(77) THEN
AngWalker = AngWalker + AngStep
IF AngWalker >= 1440 THEN AngWalker = AngWalker - 1440
END IF
'exit (esc)
IF MultiKey(1) THEN EXIT DO
CollisionDetect xMove, yMove
Render
xMove = 1E-30: yMove = 0
LOOP UNTIL k$ = CHR$(27)
SYSTEM
'32X32 LEVEL
DATA 32,32
DATA 1,2,3,4,5,6,7,8,1,2,3,4,5,6,7,8,1,2,3,4,5,6,7,8,1,2,3,4,5,6,7,8
DATA 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,X,7
DATA 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,6
DATA 4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5
DATA 5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4
DATA 6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3
DATA 7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2
DATA 8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8
DATA 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7
DATA 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,6
DATA 4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5
DATA 5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4
DATA 6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3
DATA 7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2
DATA 8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8
DATA 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7
DATA 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,6
DATA 4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5
DATA 5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4
DATA 6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3
DATA 7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2
DATA 8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
DATA 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8
DATA 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7
DATA 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,6
DATA 4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5
DATA 5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4
DATA 6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3
DATA 7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2
DATA 8,7,6,5,4,3,2,1,8,7,6,5,4,3,2,1,8,7,6,5,4,3,2,1,8,7,6,5,4,3,2,1
SUB CollisionDetect (xMove AS SINGLE, yMove AS SINGLE)
xCheck = xWalker + xMove + SGN(xMove) * ConstStep * 2
yCheck = yWalker + yMove + SGN(yMove) * ConstStep * 2
IF MapData((xCheck \ MapBlock) + (yCheck \ MapBlock) * xMap) = 0 THEN
xWalker = xWalker + xMove
yWalker = yWalker + yMove
END IF
END SUB
SUB ImageStrip (x, Height, Offset, Col)
STATIC Code AS STRING, FirstTime
IF FirstTime = 0 THEN
c$ = ""
c$ = c$ + "5589E58B560A8B460850F7D8056400B106D3E089D301C3B102D3E001D8591E57"
c$ = c$ + "8B5E065351BB00A08EDB89D1BB0B00E829005851056400B106D3E089D301C3B1"
c$ = c$ + "02D3E001D8595BE81100BB0600B800FA01D0E806005F1F5DCA060089CF881D81"
c$ = c$ + "C1400139C175F4C3E9"
FOR i = 0 TO 104
d = VAL("&H" + MID$(c$, i * 2 + 1, 2))
Code = Code + CHR$(d)
NEXT i
FirstTime = -1
END IF
CALL ABSOLUTE(BYVAL x, BYVAL Height, BYVAL Col, SADD(Code))
END SUB
SUB LoadLevel (FileName$)
READ xMap, yMap
REDIM MapData(xMap * yMap - 1)
xMap = xMap - 1: yMap = yMap - 1
FOR y = 0 TO yMap
FOR x = 0 TO xMap
READ k$
IF k$ = "X" THEN
xWalker = x * MapBlock + MapBlock / 2
yWalker = y * MapBlock + MapBlock / 2
END IF
MapData(x + y * xMap) = VAL(k$)
NEXT x, y
END SUB
FUNCTION MultiKey (t)
STATIC KbControl(), KbMatrix(), FirstTime, StatusFlag
IF FirstTime = 0 THEN
DIM KbMatrix(128)
Code$ = ""
Code$ = Code$ + "E91D00E93C00000000000000000000000000000000000000000000000000"
Code$ = Code$ + "00001E31C08ED8BE24000E07BF1400FCA5A58CC38EC0BF2400B85600FAAB"
Code$ = Code$ + "89D8ABFB1FCB1E31C08EC0BF2400BE14000E1FFCFAA5A5FB1FCBFB9C5053"
Code$ = Code$ + "51521E560657E460B401A8807404B400247FD0E088C3B700B0002E031E12"
Code$ = Code$ + "002E8E1E100086E08907E4610C82E661247FE661B020E6205F075E1F5A59"
Code$ = Code$ + "5B589DCF"
FOR i = 0 TO 155
d = VAL("&H" + MID$(Code$, i * 2 + 1, 2))
POKE Pointer + i, d
NEXT i
i& = 16
n& = VARSEG(KbMatrix(0))
l& = n& AND &HFF
h& = ((n& AND &HFF00) \ 256)
POKE i&, l&
POKE i& + 1, h&
FirstTime = -1
END IF
SELECT CASE t
CASE -1
CALL ABSOLUTE(0)
CASE 1 TO 128
MultiKey = KbMatrix(t)
END SELECT
END FUNCTION
SUB Render
DIM xGrade AS SINGLE, yGrade AS SINGLE
DIM Travel AS SINGLE, TravelIntH AS SINGLE, TravelIntV AS SINGLE
xP = xWalker - ConstStep * S(AngWalker + 360)
yP = yWalker - ConstStep * S(AngWalker)
WHILE x < xScreen
yGrade = (x - xCenter) / xCenter
xGrade = S(AngWalker + 360) - yGrade * S(AngWalker) + 1E-30
yGrade = S(AngWalker) + yGrade * S(AngWalker + 360) + 1E-30
xRay = xP: yRay = yP
IF xGrade > 0 THEN xIntStep = MapBlock ELSE xIntStep = -1
IF yGrade > 0 THEN yIntStep = MapBlock ELSE yIntStep = -1
xBlock = xRay \ MapBlock
xIntV = xBlock * MapBlock + xIntStep
TravelIntV = (xIntV - xP) / xGrade
yBlock = yRay \ MapBlock
yIntH = yBlock * MapBlock + yIntStep
TravelIntH = (yIntH - yP) / yGrade
DO
IF TravelIntH < TravelIntV THEN
Travel = TravelIntH
yRay = yP + Travel * yGrade
yBlock = yRay \ MapBlock
yIntH = yBlock * MapBlock + yIntStep
TravelIntH = (yIntH - yP) / yGrade
WallHoriz = -1
ELSE
Travel = TravelIntV
xRay = xP + Travel * xGrade
xBlock = xRay \ MapBlock
xIntV = xBlock * MapBlock + xIntStep
TravelIntV = (xIntV - xP) / xGrade
WallHoriz = 0
END IF
Col = MapData(xBlock + yBlock * xMap)
IF Col THEN EXIT DO
LOOP
IF WallHoriz THEN Col = Col + 8
Dist = Height * yCenter \ Travel
IF Dist >= yCenter THEN Dist = yCenter - 1
ImageStrip x, CINT(Dist), Remainder, Col
NextPass: x = x + Detail
WEND
END SUB

 
 Respond to this message   
Current Topic - Raycaster Demo
  << Previous Topic | Next Topic >>Return to Index  
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums