graphics/presentations/KHK jõulud/ray.bas

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