graphics/presentations/KHK j6ulud/ray.bas

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