SHARE
TWEET

qbasic cool raycaster

a guest Apr 16th, 2019 84 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  2. '
  3. ' mvandijk303@gmail.com
  4. '
  5. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  6.  
  7.  
  8. DECLARE SUB Throw (msg$)
  9. DECLARE SUB SystemInit ()
  10. DECLARE SUB SystemCleanup ()
  11. DECLARE FUNCTION SoundLoad% (filename$)
  12. DECLARE SUB WorldRenderWalls ()
  13. DECLARE SUB WorldRenderSprites ()
  14. DECLARE SUB PaletteLoad (filename$)
  15. DECLARE SUB WorldInit ()
  16. DECLARE SUB InputApply ()
  17. DECLARE SUB VideoSwap ()
  18. DECLARE SUB WorldRender ()
  19. DECLARE SUB WorldLoad (filename$)
  20. DECLARE SUB ASMinitCompiler ()
  21. DECLARE SUB ASMcompile (SOURCE$, target$)
  22. DECLARE FUNCTION ASMload$ (filename$)
  23.  
  24.  
  25. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  26. '
  27. ' Include library headers and do some system configuring.
  28. ' This includes optimizing QB45's float operations.
  29. '
  30. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  31.  
  32. '$INCLUDE: 'DirectQB.bi'
  33. '$INCLUDE: 'ffix.bi'
  34. DEFINT A-Z
  35. ffix
  36. DQBfpu
  37.  
  38.  
  39.  
  40. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  41. '
  42. ' Declare global variables.
  43. '
  44. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  45.  
  46. '
  47. ' World
  48. '
  49. DIM SHARED gWorldWidth%
  50. DIM SHARED gWorldHeight%
  51. DIM SHARED gWorld%(255, 255)
  52. DIM SHARED gWorldSeg%
  53. DIM SHARED gWorldOff%
  54.  
  55. '
  56. ' Camera
  57. '
  58. DIM SHARED gPosX#
  59. DIM SHARED gPosY#
  60. DIM SHARED gDirX#
  61. DIM SHARED gDirY#
  62. DIM SHARED gPlaneX#
  63. DIM SHARED gPlaneY#
  64. gPosX# = 15
  65. gPosY# = 15
  66. gDirX# = -1
  67. gDirY# = 0
  68. gPlaneX# = 0
  69. gPlaneY# = .66
  70.  
  71. '
  72. ' Renderer
  73. '
  74. DIM SHARED gPerpDists!(319)
  75. DIM SHARED gCameraXTable#(319)
  76. FOR i% = 0 TO 319 STEP 4
  77.         gCameraXTable#(i%) = 2 * i% / 320 - 1
  78. NEXT
  79.  
  80. '
  81. ' Audio
  82. '
  83. DIM SHARED gSoundFreq%
  84. DIM SHARED gSoundChannels%
  85. DIM SHARED gSoundNum%
  86. DIM SHARED gSoundSlot%
  87. gSoundFreq% = 9035
  88. gSoundChannels% = 4
  89. gSoundNum% = 4
  90.  
  91. '
  92. ' System
  93. '
  94. DIM SHARED gMemAlloc&
  95.  
  96.  
  97.  
  98. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  99. '
  100. ' Initialize engine.
  101. '
  102. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  103.  
  104. '
  105. ' Load ASM routines
  106. '
  107. DIM SHARED gDrawCol$
  108. DIM SHARED gDrawSpr$
  109. gDrawCol$ = ASMload$("DRAWCOL.BIN")
  110. gDrawSpr$ = ASMload$("DRAWSPR.BIN")
  111.  
  112. '
  113. ' Initialize engine and load world
  114. '
  115. SystemInit
  116. WorldLoad "TEST.UMR"
  117.  
  118. '
  119. ' Load sounds
  120. '
  121. DIM SHARED gSndDrone%
  122. 'gSndDrone% = SoundLoad(".\ASSETS\SFX\LSD.WAV")
  123. gSndDrone% = SoundLoad(".\ASSETS\SFX\OM_LOOP.WAV")
  124. DQBplaySound gSndDrone%, 4, 9035, LOOPED
  125.  
  126.  
  127.  
  128. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  129. '
  130. ' Enter engine main loop.
  131. '
  132. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  133. WHILE NOT DQBkey(1)
  134.  
  135.         '
  136.         ' Render
  137.         '
  138.         WorldRenderWalls
  139.         WorldRenderSprites
  140.         VideoSwap
  141.  
  142.         '
  143.         ' Logic
  144.         '
  145.         InputApply
  146. WEND
  147.  
  148.  
  149.  
  150. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  151. '
  152. ' Stop engine gracefully.
  153. '
  154. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  155.  
  156. SystemCleanup
  157.  
  158. REM $DYNAMIC
  159. SUB ASMcompile (SOURCE$, target$)
  160.  
  161. SOURCE$ = CHR$(34) + SOURCE$ + CHR$(34)
  162. target$ = CHR$(34) + target$ + CHR$(34)
  163.  
  164. SHELL "ASM\FASM\FASM.EXE " + SOURCE$ + " " + target$
  165.  
  166. END SUB
  167.  
  168. REM $STATIC
  169. SUB ASMinitCompiler
  170. SHELL "ASM\CSDPMI5B\CWSDPMI.EXE"
  171. END SUB
  172.  
  173. FUNCTION ASMload$ (filename$)
  174.  
  175. ' Open file
  176. DIM n%
  177. n% = FREEFILE
  178. OPEN filename$ FOR BINARY AS n%
  179.  
  180. ' Read bytes
  181. ' TODO(perf): read the bytes all at once
  182. DIM code$
  183. FOR i% = 0 TO LOF(n%)
  184.         code$ = code$ + INPUT$(1, n%)
  185. NEXT
  186.  
  187. ' Close file and return
  188. CLOSE n%
  189. ASMload$ = code$
  190. END FUNCTION
  191.  
  192. REM $DYNAMIC
  193. SUB InputApply
  194.  
  195. spd# = .025 * 2.5
  196. rot# = .025 * 1.5
  197. ' TODO: Perhaps use a SIN and COS tables
  198. cosRot# = COS(rot#)
  199. sinRot# = SIN(rot#)
  200. cosMinRot# = COS(-rot#)
  201. sinMinRot# = SIN(-rot#)
  202.  
  203.  
  204. ' Walk forward
  205. IF DQBkey(72) THEN
  206.         gPosX# = gPosX# + gDirX# * spd#
  207.         gPosY# = gPosY# + gDirY# * spd#
  208. END IF
  209.  
  210. ' Walk backward
  211. IF DQBkey(80) THEN
  212.         gPosX# = gPosX# - gDirX# * spd#
  213.         gPosY# = gPosY# - gDirY# * spd#
  214. END IF
  215.  
  216. ' Turn right
  217. IF DQBkey(77) THEN
  218.         oldDirX# = gDirX#
  219.         gDirX# = oldDirX# * cosMinRot# - gDirY# * sinMinRot#
  220.         gDirY# = oldDirX# * sinMinRot# + gDirY# * cosMinRot#
  221.  
  222.         oldPlaneX# = gPlaneX#
  223.         gPlaneX# = oldPlaneX# * cosMinRot# - gPlaneY# * sinMinRot#
  224.         gPlaneY# = oldPlaneX# * sinMinRot# + gPlaneY# * cosMinRot#
  225. END IF
  226.  
  227. ' Turn left
  228. IF DQBkey(75) THEN
  229.         oldDirX# = gDirX#
  230.         gDirX# = oldDirX# * cosRot# - gDirY# * sinRot#
  231.         gDirY# = oldDirX# * sinRot# + gDirY# * cosRot#
  232.  
  233.         oldPlaneX# = gPlaneX#
  234.         gPlaneX# = oldPlaneX# * cosRot# - gPlaneY# * sinRot#
  235.         gPlaneY# = oldPlaneX# * sinRot# + gPlaneY# * cosRot#
  236. END IF
  237.  
  238. END SUB
  239.  
  240. REM $STATIC
  241. SUB PaletteLoad (filename$)
  242. n% = FREEFILE
  243. OPEN filename$ FOR BINARY AS n%
  244. OUT &H3C8, 0
  245. FOR i% = 0 TO 765
  246.         GET n%, , a%
  247.         OUT &H3C9, a%
  248. NEXT
  249. CLOSE n%
  250. END SUB
  251.  
  252. FUNCTION SoundLoad% (filename$) STATIC
  253.  
  254. '
  255. ' See if DQB has problems loading the sound.
  256. '
  257. status% = DQBloadSound(gSoundSlot% + 1, filename$)
  258. IF status% > 0 THEN
  259.         Throw "Could not load sound '" + filename$ + "': " + DQBerror$ + "."
  260.         EXIT FUNCTION
  261. END IF
  262.  
  263. '
  264. ' Mark the sound slot as used.
  265. '
  266. gSoundSlot% = gSoundSlot% + 1
  267.  
  268.  
  269. SoundLoad% = gSoundSlot%
  270. END FUNCTION
  271.  
  272. SUB SystemCleanup
  273.  
  274. '
  275. ' Cleanup DirectQB
  276. '
  277. DQBremoveKeyboard
  278. DQBremoveSB
  279. DQBclose
  280.  
  281. '
  282. ' Deallocate memory
  283. '
  284. gMemAlloc& = SETMEM(65536)
  285.  
  286. '
  287. ' Prepare screen for normal rendering
  288. '
  289. DQBinitText
  290.  
  291. END SUB
  292.  
  293. SUB SystemInit
  294.  
  295. '
  296. ' Allocate extra memory
  297. '
  298. gMemAlloc& = SETMEM(-65536)
  299.  
  300. '
  301. ' Initialize DirectQB and check for errors
  302. '
  303. status% = DQBinit(1, gSoundNum%, 0)
  304. IF status% > 0 THEN
  305.         ERR$ = "DQBinit failed: "
  306.         SELECT CASE status%
  307.         CASE 1: Throw ERR$ + "386 or better CPU not detected."
  308.         CASE 2: Throw ERR$ + "Unable to find an expanded memory manager."
  309.         CASE 3: Throw ERR$ + "Not enough free EMS memory to allocate specified number of layers."
  310.         CASE 4: Throw ERR$ + "Library has already been initialized."
  311.         END SELECT
  312. END IF
  313.  
  314. '
  315. ' Start sound engine
  316. '
  317. status% = DQBinstallSB(TRUE, gSoundChannels%, gSoundFreq%, &H220, AUTO, AUTO)
  318. IF status% > 0 THEN
  319.         ERR$ = "DQBinstallSB failed: "
  320.         SELECT CASE status%
  321.         CASE 1: Throw ERR$ + "No sounds were allocated by DQBinit."
  322.         CASE 2: Throw ERR$ + "Soundcard not found or DSP failed to reset."
  323.         CASE 3: Throw ERR$ + "Old soundcard not supported."
  324.         CASE 4: Throw ERR$ + "Specified DMA channel is not supported."
  325.         CASE 5: Throw ERR$ + "Autodetection failed as the BLASTER variable is not set"
  326.         CASE 6: Throw ERR$ + "High mixing speed not supported."
  327.         CASE 7: Throw ERR$ + "Not enough memory to create the volume table."
  328.         END SELECT
  329. END IF
  330.  
  331. '                                                                          
  332. ' Prepare screen for rendering
  333. '
  334. DQBinitVGA
  335. PaletteLoad "ORANGE.PAL"
  336.  
  337. '
  338. ' Start keyboard listener
  339. '
  340. DQBinstallKeyboard
  341.  
  342. '
  343. ' Initialize the matrix
  344. '
  345. WorldInit
  346.  
  347. END SUB
  348.  
  349. SUB Throw (msg$)
  350.  
  351. SystemCleanup
  352.  
  353. SCREEN 13
  354. CLS
  355. COLOR &H7: PRINT "An error occured:"
  356. COLOR &HC: PRINT msg$
  357.        
  358. SLEEP
  359.  
  360. END SUB
  361.  
  362. REM $DYNAMIC
  363. SUB VideoSwap
  364. DQBcopyLayer 1, VIDEO
  365.  
  366. END SUB
  367.  
  368. REM $STATIC
  369. SUB WorldInit
  370. gWorldSeg% = VARSEG(gWorld%(0, 0))
  371. gWorldOff% = VARPTR(gWorld%(0, 0))
  372. END SUB
  373.  
  374. REM $DYNAMIC
  375. SUB WorldLoad (filename$)
  376.  
  377. ' Open file
  378. n& = FREEFILE
  379. OPEN filename$ FOR BINARY AS n&
  380.  
  381. ' Read world width and size
  382. DIM v AS STRING * 1
  383. GET n&, , v$
  384. gWorldWidth% = ASC(v$)
  385. GET n&, , v$
  386. gWorldHeight% = ASC(v$)
  387.  
  388. ' Read tiles
  389. FOR y% = 0 TO gWorldHeight% - 1
  390. FOR x% = 0 TO gWorldWidth% - 1
  391.         GET n&, , v$
  392.         gWorld%(x%, y%) = ASC(v$)
  393. NEXT
  394. NEXT
  395.  
  396. ' Close file
  397. CLOSE n&
  398.  
  399. END SUB
  400.  
  401. REM $STATIC
  402. SUB WorldRenderSprites
  403. DEF SEG = VARSEG(gDrawSpr$)
  404.  
  405.  
  406.  
  407. DEF SEG
  408. END SUB
  409.  
  410. SUB WorldRenderWalls
  411. DEF SEG = VARSEG(gDrawCol$)
  412.  
  413. ' Length of ray from current position to next X or Y-side
  414. DIM sideDistX#
  415. DIM sideDistY#
  416.  
  417. ' Perpendicular distance to wall
  418. DIM perpDist!
  419.  
  420. ' Direction to step in X or Y-direction (either +1 or -1)
  421. DIM stepX%
  422. DIM stepY%
  423.  
  424. ' Whether a wall had been hit and which side (NS or EW)
  425. DIM hit%
  426. DIM side%
  427.  
  428.  
  429. '
  430. ' Iterate through every other even column of the screen
  431. '
  432. FOR x% = 0 TO 319 STEP 4
  433.  
  434.         '
  435.         ' Calculate ray position and direction
  436.         '
  437.         cameraX# = gCameraXTable#(x%) ' X-coord in camera space
  438.         rayPosX# = gPosX#
  439.         rayPosY# = gPosY#
  440.         rayDirX# = gDirX# + gPlaneX# * cameraX#
  441.         rayDirY# = gDirY# + gPlaneY# * cameraX#
  442.  
  443.         '
  444.         ' Determine in which tile the camera is positioned
  445.         '
  446.         mapX% = INT(rayPosX#)
  447.         mapY% = INT(rayPosY#)
  448.  
  449.         '
  450.         ' Length of ray from one X or Y-side to next X or Y-side
  451.         '
  452.         deltaDistX# = SQR(1 + (rayDirY# * rayDirY#) / (rayDirX# * rayDirX#))
  453.         deltaDistY# = SQR(1 + (rayDirX# * rayDirX#) / (rayDirY# * rayDirY#))
  454.              
  455.         '
  456.         ' Reset wall hit flag
  457.         '
  458.         hit% = 0
  459.  
  460.         '
  461.         ' Calculate step and initial sideDist
  462.         '
  463.         IF rayDirX# < 0 THEN
  464.                 stepX% = -1
  465.                 sideDistX# = (rayPosX# - mapX%) * deltaDistX#
  466.         ELSE
  467.                 stepX% = 1
  468.                 sideDistX# = (mapX% + 1 - rayPosX#) * deltaDistX#
  469.         END IF
  470.         IF rayDirY# < 0 THEN
  471.                 stepY% = -1
  472.                 sideDistY# = (rayPosY# - mapY%) * deltaDistY#
  473.         ELSE
  474.                 stepY% = 1
  475.                 sideDistY# = (mapY% + 1 - rayPosY#) * deltaDistY#
  476.         END IF
  477.  
  478.         '
  479.         ' Perform DDA
  480.         '
  481.         DO
  482.                 ' Jump to next map square either in X-direction,
  483.                 ' or in Y-direction
  484.                 IF sideDistX# < sideDistY# THEN
  485.                         sideDistX# = sideDistX# + deltaDistX#
  486.                         mapX% = mapX% + stepX%
  487.                         side% = 0
  488.                 ELSE
  489.                         sideDistY# = sideDistY# + deltaDistY#
  490.                         mapY% = mapY% + stepY%
  491.                         side% = -1
  492.                 END IF
  493.  
  494.                 ' Check if the ray has hit a wall
  495.                 IF (gWorld%(mapX%, mapY%) > 0) THEN
  496.                         hit% = 1
  497.                 END IF
  498.         LOOP UNTIL hit% = 1
  499.  
  500.         '
  501.         ' Calculate distance projected on camera direction
  502.         ' (Oblique distance will give a fisheye effect)
  503.         '
  504.         IF side% = 0 THEN
  505.                 perpDist! = (mapX% - rayPosX# + (1 - stepX%) / 2) / rayDirX#
  506.         ELSE
  507.                 perpDist! = (mapY% - rayPosY# + (1 - stepY%) / 2) / rayDirY#
  508.         END IF
  509.              
  510.         '
  511.         ' Draw wall column
  512.         '
  513.         CALL ABSOLUTE(BYVAL x%, BYVAL perpDist!, BYVAL side%, SADD(gDrawCol$))
  514.        
  515.         '
  516.         ' Save column distance
  517.         '
  518.         gPerpDists!(x%) = perpDist!
  519. NEXT
  520. DEF SEG
  521.  
  522. END SUB
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top