graphics/3D/ray casting engine/raycast.bas

   1 ' Ray casting engine, written by Svjatoslav Agejenko\r
   2 ' E-mail:   svjatoslav@svjatoslav.eu\r
   3 ' Homepage: svjatoslav.eu\r
   4 ' 2003.03\r
   5 \r
   6 ' Quality will be automatically adjusted,\r
   7 ' to keep constant framerate.\r
   8 \r
   9 ' at least P 200 MHz in DOS mode should be nice.\r
  10 \r
  11 ' keys to use:\r
  12 ' Arrow keys - move around\r
  13 ' 4, 6       - turn left, right\r
  14 ' 8, 2       - look up, down\r
  15 ' Enter      - Toggle full quality\r
  16 ' Space      - jump up (fly)\r
  17 ' ESC        - exit program\r
  18 \r
  19 DECLARE SUB makeland ()\r
  20 DECLARE FUNCTION getcol! (r!, g!, b!)\r
  21 DEFINT A-Y\r
  22 DECLARE SUB traceline (x%, y%, xl)\r
  23 DECLARE SUB dispframe ()\r
  24 DECLARE SUB tower (x%, y%)\r
  25 DECLARE SUB square (x1%, y1%, x2%, y2%, c%, h%)\r
  26 DECLARE SUB displand ()\r
  27 DECLARE SUB start ()\r
  28 DECLARE SUB setupal ()\r
  29 \r
  30 DIM SHARED landh(0 TO 180, 0 TO 180)\r
  31 DIM SHARED landc(0 TO 180, 0 TO 180)\r
  32 \r
  33 DIM SHARED zmyx, zmyy, zmyz\r
  34 DIM SHARED myx, myy, myz\r
  35 DIM SHARED zmyan, myan2\r
  36 DIM SHARED ste, stem, dist\r
  37 DIM SHARED tim$, frm, frmrate\r
  38 \r
  39 frmrate = 10    ' Desired framerate.\r
  40                 ' Lower framerate, better quality\r
  41 \r
  42 start\r
  43 makeland\r
  44 \r
  45 displand\r
  46 a$ = INPUT$(1)\r
  47 1\r
  48 LOCATE 1, 35\r
  49 PRINT frml\r
  50 \r
  51 frm = frm + 1\r
  52 IF tim$ <> TIME$ THEN\r
  53 tim$ = TIME$\r
  54 IF frm > frmrate THEN ste = ste - 1 ELSE ste = ste + 1\r
  55 IF ste < 1 THEN ste = 1\r
  56 stem = ste - 1\r
  57 frml = frm\r
  58 frm = 0\r
  59 END IF\r
  60 \r
  61 a$ = INKEY$\r
  62 IF a$ <> "" THEN\r
  63 SELECT CASE a$\r
  64 CASE "4"\r
  65 zmyan = zmyan + .1\r
  66 CASE "6"\r
  67 zmyan = zmyan - .1\r
  68 CASE "8"\r
  69 myan2 = myan2 + 5\r
  70 CASE "2"\r
  71 myan2 = myan2 - 5\r
  72 CASE CHR$(0) + "H"      ' foward\r
  73 zmyx = SIN(zmyan) * 3 + zmyx\r
  74 zmyy = COS(zmyan) * 3 + zmyy\r
  75 CASE CHR$(0) + "P"      ' backward\r
  76 zmyx = -SIN(zmyan) * 3 + zmyx\r
  77 zmyy = -COS(zmyan) * 3 + zmyy\r
  78 CASE CHR$(0) + "K"      ' left\r
  79 zmyx = COS(zmyan) * 3 + zmyx\r
  80 zmyy = -SIN(zmyan) * 3 + zmyy\r
  81 CASE CHR$(0) + "M"      ' left\r
  82 zmyx = -COS(zmyan) * 3 + zmyx\r
  83 zmyy = SIN(zmyan) * 3 + zmyy\r
  84 CASE " "                ' jump\r
  85 zmyzs = 2\r
  86 CASE CHR$(13)           ' full quality\r
  87 ste = 1\r
  88 CASE CHR$(27)           ' exit\r
  89 SYSTEM\r
  90 END SELECT\r
  91 END IF\r
  92 \r
  93 IF zmyx > 170 THEN zmyx = 170\r
  94 IF zmyy > 170 THEN zmyy = 170\r
  95 IF zmyx < 10 THEN zmyx = 10\r
  96 IF zmyy < 10 THEN zmyy = 10\r
  97 \r
  98 zmyz = zmyz + zmyzs\r
  99 zmyzs = zmyzs - .1\r
 100 IF zmyz < landh(myx, myy) + 10 THEN zmyz = landh(myx, myy) + 10: zmyzs = (zmyzs / 2) + .2\r
 101 \r
 102 myz = zmyz\r
 103 myy = zmyy\r
 104 myx = zmyx\r
 105 dispframe\r
 106 GOTO 1\r
 107 \r
 108 SUB dispframe\r
 109 \r
 110 l = 0\r
 111 zst = -.0031 * ste\r
 112 FOR z = .5 TO -.5 STEP zst\r
 113 traceline SIN(zmyan + z) * dist + myx, COS(zmyan + z) * dist + myy, l\r
 114 l = l + ste\r
 115 NEXT z\r
 116 \r
 117 END SUB\r
 118 \r
 119 SUB displand\r
 120 \r
 121 \r
 122 FOR z = 0 TO 180\r
 123 zs = 1\r
 124 IF z > 120 THEN zs = .7\r
 125 IF z > 160 THEN zs = .6\r
 126 FOR zx = 0 TO 180 STEP zs\r
 127 y1 = landh(zx, z) - 80\r
 128 zx1 = zx - 90\r
 129 z1 = 300 - z\r
 130 zx2 = zx1 / z1 * 190\r
 131 zy2 = y1 / z1 * 190\r
 132 \r
 133 LINE (zx2 + 160, 40 - zy2)-(zx2 + 160, 200), landc(zx, z)\r
 134 NEXT zx\r
 135 NEXT z\r
 136 \r
 137 LOCATE 1, 1\r
 138 PRINT "Press any key to continue..."\r
 139 \r
 140 END SUB\r
 141 \r
 142 DEFSNG A-Y\r
 143 FUNCTION getcol (r, g, b)\r
 144 IF r < 0 THEN r = 0\r
 145 IF g < 0 THEN g = 0\r
 146 IF b < 0 THEN b = 0\r
 147 IF r > 255 THEN r = 255\r
 148 IF g > 255 THEN g = 255\r
 149 IF b > 255 THEN b = 255\r
 150 getcol = INT(r / 43) * 36 + INT(g / 43) * 6 + INT(b / 43)\r
 151 END FUNCTION\r
 152 \r
 153 DEFINT A-Y\r
 154 SUB makeland\r
 155 \r
 156 square 0, 0, 180, 180, 15, 0\r
 157 \r
 158 FOR y = 0 TO 180\r
 159 FOR x = 0 TO 180\r
 160 x1 = (x \ 10) MOD 2\r
 161 y1 = (y \ 10) MOD 2\r
 162 c = (x1 + y1) MOD 2\r
 163 IF c = 0 THEN\r
 164   landc(x, y) = getcol(0, 0, 250)\r
 165 ELSE\r
 166   landc(x, y) = getcol(50, 50, 50)\r
 167 END IF\r
 168 NEXT x\r
 169 NEXT y\r
 170 \r
 171 FOR y = 10 TO 90\r
 172 FOR x = 90 TO 170\r
 173 v = SQR((ABS(50 - y)) ^ 2 + (ABS(130 - x)) ^ 2)\r
 174 h = SQR((60 - v) * (60 + v)) - 35\r
 175 IF h > 0 THEN landh(x, y) = h\r
 176 NEXT x\r
 177 NEXT y\r
 178 \r
 179 tower 20, 20\r
 180 tower 60, 20\r
 181 tower 40, 60\r
 182 \r
 183 FOR y = 100 TO 150\r
 184 FOR x = 0 TO 50\r
 185 landc(x, y) = getcol(SIN((x + y) / 2) * 125 + 125, SIN(x / 2) * 125 + 125, SIN(y / 2) * 125 + 125)\r
 186 landh(x, y) = 50 - x\r
 187 NEXT x\r
 188 NEXT y\r
 189 \r
 190 FOR za = 0 TO 20 STEP .1\r
 191 x = SIN(za) * (1 + (za * 2)) + 100\r
 192 y = COS(za) * (1 + (za * 2)) + 100\r
 193 landc(x, y) = 200\r
 194 landc(x + 1, y) = 200\r
 195 landc(x, y + 1) = 200\r
 196 landc(x + 1, y + 1) = 200\r
 197 NEXT za\r
 198 \r
 199 END SUB\r
 200 \r
 201 SUB setupal\r
 202 c = 0\r
 203 FOR r = 0 TO 5\r
 204 FOR g = 0 TO 5\r
 205 FOR b = 0 TO 5\r
 206 OUT &H3C8, c\r
 207 c = c + 1\r
 208 OUT &H3C9, r * 12\r
 209 OUT &H3C9, g * 12\r
 210 OUT &H3C9, b * 12\r
 211 NEXT b\r
 212 NEXT g\r
 213 NEXT r\r
 214 END SUB\r
 215 \r
 216 SUB square (x1, y1, x2, y2, c, h)\r
 217 \r
 218 FOR y = y1 TO y2\r
 219 FOR x = x1 TO x2\r
 220 landh(x, y) = h\r
 221 landc(x, y) = c\r
 222 NEXT x\r
 223 NEXT y\r
 224 \r
 225 END SUB\r
 226 \r
 227 SUB start\r
 228 SCREEN 13\r
 229 PRINT "please wait..."\r
 230 \r
 231 setupal\r
 232 \r
 233 zmyan = 4.14\r
 234 myan2 = 100\r
 235 ste = 1\r
 236 stem = ste - 1\r
 237 dist = 190\r
 238 tim$ = TIME$\r
 239 zmyx = 170\r
 240 zmyy = 170\r
 241 zmyz = 20\r
 242 \r
 243 END SUB\r
 244 \r
 245 SUB tower (x, y)\r
 246 \r
 247 FOR a = 10 TO 0 STEP -1\r
 248 square x - a, y - a, x + a, y + a, getcol(100, 0, a * 20), 20 - a\r
 249 NEXT a\r
 250 \r
 251 square x - 11, y - 11, x - 9, y - 9, getcol(255, 0, 0), 20\r
 252 square x + 9, y - 11, x + 11, y - 9, getcol(0, 255, 0), 20\r
 253 square x - 11, y + 9, x - 9, y + 11, getcol(0, 0, 255), 20\r
 254 square x + 9, y + 9, x + 11, y + 11, getcol(255, 255, 0), 20\r
 255 \r
 256 \r
 257 END SUB\r
 258 \r
 259 SUB traceline (x, y, xl%)\r
 260 \r
 261 IF x < 0 THEN\r
 262 zpr = myx / (myx - x)\r
 263 x = 0\r
 264 y = myy - ((myy - y) * zpr)\r
 265 END IF\r
 266 \r
 267 IF y < 0 THEN\r
 268 zpr = myy / (myy - y)\r
 269 y = 0\r
 270 x = myx - ((myx - x) * zpr)\r
 271 END IF\r
 272 \r
 273 IF x > 180 THEN\r
 274 zpr = (180 - myx) / (x - myx)\r
 275 x = 180\r
 276 y = myy - ((myy - y) * zpr)\r
 277 END IF\r
 278 \r
 279 IF y > 180 THEN\r
 280 zpr = (180 - myy) / (y - myy)\r
 281 y = 180\r
 282 x = myx - ((myx - x) * zpr)\r
 283 END IF\r
 284 \r
 285 lp = SQR(ABS(myx - x) ^ 2 + ABS(myy - y) ^ 2)\r
 286 \r
 287 imyx% = myx\r
 288 imyy% = myy\r
 289 imyz% = myz\r
 290 xp% = x - imyx%\r
 291 yp% = y - imyy%\r
 292 istem% = stem\r
 293 imyan2% = myan2\r
 294 \r
 295 yo% = 200\r
 296 FOR a% = 1 TO lp%\r
 297   cx% = xp% * a% / lp% + imyx%\r
 298   cy% = yp% * a% / lp% + imyy%\r
 299   yn% = imyan2% - ((landh(cx%, cy%) - imyz%) / a%) * 300\r
 300   IF yn% < yo% THEN\r
 301     LINE (xl%, yn%)-(xl% + istem%, yo% - 1), landc(cx%, cy%), BF\r
 302     yo% = yn%\r
 303   END IF\r
 304 NEXT a\r
 305 LINE (xl%, yo% - 1)-(xl% + istem%, 0), 0, BF\r
 306 \r
 307 END SUB\r
 308 \r