graphics/presentations/Stroboscope/strobo.bas

   1 ' Stroboscope presentation\r
   2 ' made by Svjatoslav Agejenko\r
   3 ' in 2002\r
   4 ' H-Page: svjatoslav.eu\r
   5 ' E-Mail: svjatoslavagejenko@gmail.com\r
   6  \r
   7 DECLARE SUB pag4 ()\r
   8 DECLARE SUB getkey (a$)\r
   9 DECLARE SUB mo ()\r
  10 DEFINT A-Z\r
  11 DECLARE SUB dra ()\r
  12 DECLARE SUB get3d ()\r
  13 DECLARE SUB pag3 ()\r
  14 DECLARE SUB pag2 ()\r
  15 DECLARE SUB getfnt ()\r
  16 DECLARE SUB prn (x2%, y%, s%, c%, t$)\r
  17 DECLARE SUB pag1 ()\r
  18 \r
  19 DECLARE SUB start ()\r
  20 \r
  21 \r
  22 DIM SHARED font(0 TO 7, 0 TO 15, 0 TO 207)\r
  23 DIM SHARED det(1 TO 100)\r
  24 DIM SHARED px1(1 TO 1000)\r
  25 DIM SHARED py1(1 TO 1000)\r
  26 DIM SHARED px2(1 TO 1000)\r
  27 DIM SHARED py2(1 TO 1000)\r
  28 DIM SHARED opx1(1 TO 1000)\r
  29 DIM SHARED opy1(1 TO 1000)\r
  30 DIM SHARED opx2(1 TO 1000)\r
  31 DIM SHARED opy2(1 TO 1000)\r
  32 DIM SHARED linc(1 TO 1000)\r
  33 \r
  34 DIM SHARED myx, myy, myz\r
  35 DIM SHARED myx1, myy1, myz1\r
  36 DIM SHARED myx2, myy2, myz2\r
  37 DIM SHARED tfra\r
  38 \r
  39 DIM SHARED nl\r
  40 \r
  41 start\r
  42 \r
  43 pag1\r
  44 pag2\r
  45 pag3\r
  46 pag4\r
  47 END\r
  48 \r
  49 DATA 0,0,5,-2\r
  50 DATA 0,0,5,2\r
  51 DATA 0, 0, 15, 0\r
  52 \r
  53 DATA 15,-2,15,2\r
  54 DATA 25,-2,25,2\r
  55 DATA 15,-2,25,-2\r
  56 DATA 15,2,25,2\r
  57 \r
  58 DATA 25,0,35,0\r
  59 DATA 35,-2,35,2\r
  60 DATA 35,-2,40,0\r
  61 DATA 35,2,40,0\r
  62 DATA 40,-2,40,2\r
  63 \r
  64 DATA 40,0,80,0\r
  65 DATA 50,0,50,19\r
  66 DATA 48,19,52,19\r
  67 DATA 48,21,52,21\r
  68 DATA 50,21,50,35\r
  69 \r
  70 DATA 0,35,125,35\r
  71 DATA 0,35,5,33\r
  72 DATA 0,35,5,37\r
  73 \r
  74 DATA 70,0,70,15\r
  75 DATA 70,35,70,20\r
  76 DATA 69,16,71,19\r
  77 DATA 69,19,71,16\r
  78 DATA 67,10,73,10\r
  79 DATA 67,25,73,25\r
  80 DATA 67,10,67,25\r
  81 DATA 73,10,73,25\r
  82 \r
  83 DATA 75,15,75,25\r
  84 DATA 75,20,90,20\r
  85 DATA 90,20,91,21\r
  86 DATA 91,21,90,22\r
  87 DATA 90,22,91,23\r
  88 DATA 91,23,90,24\r
  89 DATA 90,24,91,25\r
  90 DATA 91,25,90,26\r
  91 DATA 90,26,90,35\r
  92 \r
  93 DATA 93,18,93,28\r
  94 DATA 92,18,92,28\r
  95 \r
  96 DATA 95,20,94,21\r
  97 DATA 94,21,95,22\r
  98 DATA 95,22,94,23\r
  99 DATA 94,23,95,24\r
 100 DATA 95,24,94,25\r
 101 DATA 94,25,95,26\r
 102 DATA 95,26,95,35\r
 103 \r
 104 DATA 95, 20, 115, 20\r
 105 DATA 115,20,115,15\r
 106 DATA 115,7,115,0\r
 107 DATA 125,35,125,26\r
 108 DATA 123,26,127,26\r
 109 DATA 123,24,127,24\r
 110 DATA 125,24,125,0\r
 111 DATA 125,0,110,0\r
 112 DATA 110,-2,110,2\r
 113 DATA 100,-2,100,2\r
 114 DATA 100,-2,110,-2\r
 115 DATA 100,2,110,2\r
 116 \r
 117 DATA 100,0,90,0\r
 118 DATA 90,-2,90,2\r
 119 DATA 80,-2,80,2\r
 120 DATA 80,-2,90,-2\r
 121 DATA 80,2,90,2\r
 122 \r
 123 DATA 113,5,117,5\r
 124 DATA 113,17,117,17\r
 125 DATA 113,5,113,17\r
 126 DATA 117,5,117,17\r
 127 DATA 115,11,125,11\r
 128 \r
 129 DATA 105,-2,105,-5\r
 130 DATA 105,-5,113,-5\r
 131 DATA 113,-5,113,0\r
 132 DATA 105,-2,104,-4\r
 133 DATA 105,-2,106,-4\r
 134 \r
 135 DATA 999,999,999,999\r
 136 \r
 137 SUB dra\r
 138 \r
 139 FOR a = 1 TO nl\r
 140 x1 = px1(a) - myx\r
 141 y1 = py1(a) - myy\r
 142 x2 = px2(a) - myx\r
 143 y2 = py2(a) - myy\r
 144 \r
 145 \r
 146 x1 = x1 * 30 / myz + 160\r
 147 y1 = y1 * 30 / myz + 100\r
 148 x2 = x2 * 30 / myz + 160\r
 149 y2 = y2 * 30 / myz + 100\r
 150 LINE (opx1(a), opy1(a))-(opx2(a), opy2(a)), 0\r
 151 LINE (x1, y1)-(x2, y2), linc(a)\r
 152 opx1(a) = x1\r
 153 opy1(a) = y1\r
 154 opx2(a) = x2\r
 155 opy2(a) = y2\r
 156 NEXT a\r
 157 \r
 158 END SUB\r
 159 \r
 160 SUB get3d\r
 161 \r
 162 nl = 0\r
 163 5\r
 164 READ x1, y1, x2, y2\r
 165 IF x1 = 999 THEN GOTO 6\r
 166 nl = nl + 1\r
 167 px1(nl) = x1\r
 168 py1(nl) = y1\r
 169 px2(nl) = x2\r
 170 py2(nl) = y2\r
 171 linc(nl) = 11\r
 172 GOTO 5\r
 173 6\r
 174 'PRINT nl, "of lines loaded"\r
 175 'a$ = INPUT$(1)\r
 176 END SUB\r
 177 \r
 178 SUB getfnt\r
 179 \r
 180 FOR c = 0 TO 15\r
 181 OUT &H3C8, c\r
 182 OUT &H3C9, 0\r
 183 OUT &H3C9, 0\r
 184 OUT &H3C9, 0\r
 185 NEXT c\r
 186 \r
 187 FOR a = 0 TO 207\r
 188 LOCATE 1, 1\r
 189 IF (a > 5) AND (a < 14) THEN GOTO 1\r
 190 PRINT CHR$(a)\r
 191 1\r
 192 FOR y = 0 TO 15\r
 193 FOR x = 0 TO 7\r
 194 font(x, y, a) = POINT(x, y)\r
 195 NEXT x\r
 196 NEXT y\r
 197 NEXT a\r
 198 END SUB\r
 199 \r
 200 SUB getkey (a$)\r
 201 \r
 202 FOR a = 1 TO 50\r
 203 b$ = INKEY$\r
 204 NEXT a\r
 205 \r
 206 7\r
 207 a$ = INKEY$\r
 208 IF a$ = "" THEN GOTO 7\r
 209 \r
 210 FOR a = 1 TO 50\r
 211 b$ = INKEY$\r
 212 NEXT a\r
 213 \r
 214 END SUB\r
 215 \r
 216 SUB mo\r
 217 \r
 218 myxv = myx2 - myx1\r
 219 myyv = myy2 - myy1\r
 220 myzv = myz2 - myz1\r
 221 \r
 222 FOR a = 1 TO tfra\r
 223 myx = myx1 + (myxv * a / tfra)\r
 224 myy = myy1 + (myyv * a / tfra)\r
 225 myz = myz1 + (myzv * a / tfra)\r
 226 dra\r
 227 SOUND 0, 1\r
 228 NEXT a\r
 229 dra\r
 230 \r
 231 \r
 232 \r
 233 END SUB\r
 234 \r
 235 SUB pag1\r
 236 \r
 237 SCREEN 13\r
 238 \r
 239 a = 0\r
 240 FOR c = 16 TO 31\r
 241 OUT &H3C8, c\r
 242 OUT &H3C9, a * 3\r
 243 OUT &H3C9, a * 4.5\r
 244 OUT &H3C9, a * 0\r
 245 a = a + 1\r
 246 NEXT c\r
 247 \r
 248 \r
 249 SHELL "playmov.com"\r
 250 \r
 251 OUT &H3C8, 101\r
 252 OUT &H3C9, 63\r
 253 OUT &H3C9, 63\r
 254 OUT &H3C9, 0\r
 255 \r
 256 OUT &H3C8, 102\r
 257 OUT &H3C9, 63\r
 258 OUT &H3C9, 10\r
 259 OUT &H3C9, 10\r
 260 \r
 261 OUT &H3C8, 103\r
 262 OUT &H3C9, 60\r
 263 OUT &H3C9, 60\r
 264 OUT &H3C9, 0\r
 265 \r
 266 \r
 267 a = 0\r
 268 FOR c = 50 TO 65\r
 269 OUT &H3C8, c\r
 270 OUT &H3C9, a * 4.5\r
 271 OUT &H3C9, a * 0\r
 272 OUT &H3C9, (15 - a) * 4.5\r
 273 a = a + 1\r
 274 NEXT c\r
 275 \r
 276 st$ = " Esitlus teemal:"\r
 277 \r
 278 FOR t = 0 TO 400\r
 279 IF t < 320 THEN\r
 280 FOR y = 0 TO 199\r
 281 c = POINT(319 - t, y)\r
 282 IF c < 100 THEN c = c + 34\r
 283 PSET (319 - t, y), c\r
 284 NEXT y\r
 285 x = 319 - t\r
 286 IF x / 16 = x \ 16 THEN\r
 287 s = x / 16\r
 288 IF s <= LEN(st$) THEN\r
 289 a$ = RIGHT$(LEFT$(st$, s), 1)\r
 290 prn x, 20, 2, 101, a$\r
 291 END IF\r
 292 END IF\r
 293 END IF\r
 294 \r
 295 IF (t < 360) AND (t > 39) THEN\r
 296 FOR y = 0 TO 13\r
 297 c = POINT(359 - t, y)\r
 298 IF c < 100 THEN c = c - 34\r
 299 PSET (359 - t, y), c\r
 300 NEXT y\r
 301 FOR y = 55 TO 199\r
 302 c = POINT(359 - t, y)\r
 303 IF c < 100 THEN c = c - 34\r
 304 PSET (359 - t, y), c\r
 305 NEXT y\r
 306 END IF\r
 307 \r
 308 \r
 309 SOUND 0, .2\r
 310 NEXT t\r
 311 \r
 312 prn 31, 101, 3, 102, "STROBOSKOOP"\r
 313 prn 29, 99, 3, 102, "STROBOSKOOP"\r
 314 prn 30, 100, 3, 103, "STROBOSKOOP"\r
 315 \r
 316 \r
 317 FOR x = 0 TO 160\r
 318 FOR y = 100 TO 150\r
 319 c = POINT(x, y)\r
 320 IF c = 102 THEN c = 103: GOTO 2\r
 321 IF c = 103 THEN c = 102: GOTO 2\r
 322 2\r
 323 PSET (x, y), c\r
 324 NEXT y\r
 325 SOUND 0, .1\r
 326 NEXT x\r
 327 \r
 328 FOR y = 199 TO 120 STEP -1\r
 329 FOR x = 0 TO 319\r
 330 c = POINT(x, y)\r
 331 IF c = 102 THEN c = 103: GOTO 3\r
 332 IF c = 103 THEN c = 102: GOTO 3\r
 333 3\r
 334 PSET (x, y), c\r
 335 NEXT x\r
 336 SOUND 0, .1\r
 337 NEXT y\r
 338 \r
 339 prn 49, 179, 1, 0, "autor: Svjatoslav Agejenko"\r
 340 prn 51, 181, 1, 0, "autor: Svjatoslav Agejenko"\r
 341 prn 50, 180, 1, 15, "autor: Svjatoslav Agejenko"\r
 342 \r
 343 getkey a$\r
 344 \r
 345 DIM buf(1 TO 30000)\r
 346 FOR a = 1 TO 320 / 5\r
 347 GET (0, 0)-(314, 100), buf(1)\r
 348 PUT (5, 0), buf(1), PSET\r
 349 LINE (0, 0)-(4, 100), 0, BF\r
 350 \r
 351 GET (5, 101)-(319, 199), buf(1)\r
 352 PUT (0, 101), buf(1), PSET\r
 353 LINE (315, 101)-(319, 199), 0, BF\r
 354 NEXT a\r
 355 \r
 356 \r
 357 END SUB\r
 358 \r
 359 SUB pag2\r
 360 SCREEN 13\r
 361 SCREEN 12\r
 362 \r
 363 \r
 364 END SUB\r
 365 \r
 366 SUB pag3\r
 367 \r
 368 myx1 = 20\r
 369 myy1 = 15\r
 370 myz1 = 100\r
 371 myx2 = 20\r
 372 myy2 = 15\r
 373 myz2 = 10\r
 374 tfra = 20\r
 375 \r
 376 mo\r
 377 \r
 378 prn 147, 66, 1, 3, "100   D336B             180k    680k"\r
 379 prn 180, 120, 1, 3, "50m 450V                          1m"\r
 380 prn 180, 400, 2, 14, "P�him�tteline skeem"\r
 381 \r
 382 getkey a$\r
 383 \r
 384 LINE (0, 0)-(639, 390), 0, BF\r
 385 \r
 386 myx1 = 20\r
 387 myy1 = 15\r
 388 myz1 = 10\r
 389 myx2 = 80\r
 390 myy2 = 5\r
 391 myz2 = 4\r
 392 tfra = 20\r
 393 mo\r
 394 getkey a$\r
 395 \r
 396 myx1 = 80\r
 397 myy1 = 5\r
 398 myz1 = 4\r
 399 myx2 = 40\r
 400 myy2 = 5\r
 401 myz2 = 4\r
 402 tfra = 20\r
 403 mo\r
 404 getkey a$\r
 405 \r
 406 myx1 = 40\r
 407 myy1 = 5\r
 408 myz1 = 4\r
 409 myx2 = 20\r
 410 myy2 = 15\r
 411 myz2 = 10\r
 412 tfra = 10\r
 413 mo\r
 414 prn 147, 66, 1, 3, "100   D336B             180k    680k"\r
 415 prn 180, 120, 1, 3, "50m 450V                          1m"\r
 416 getkey a$\r
 417 \r
 418 \r
 419 \r
 420 \r
 421 \r
 422 END SUB\r
 423 \r
 424 SUB pag4\r
 425 CLS\r
 426 SCREEN 13\r
 427 prn 35, 100, 2, 14, "     T�nan"\r
 428 prn 35, 140, 2, 14, "t�helepanu eest!"\r
 429 \r
 430 DIM buf(1 TO 30000)\r
 431 \r
 432 GET (0, 100)-(319, 199), buf(1)\r
 433 FOR y = 100 TO 50 STEP -1\r
 434 PUT (0, y), buf(1), PSET\r
 435 SOUND 0, .5\r
 436 NEXT y\r
 437 \r
 438 getkey a$\r
 439 SYSTEM\r
 440 END SUB\r
 441 \r
 442 SUB prn (x2, y, s, c, t$)\r
 443 x = x2\r
 444 \r
 445 FOR a = 1 TO LEN(t$)\r
 446 b = ASC(RIGHT$(LEFT$(t$, a), 1))\r
 447 FOR y1 = 0 TO 15\r
 448 FOR x1 = 0 TO 7\r
 449 IF font(x1, y1, b) > 0 THEN\r
 450 LINE (x1 * s + x, y1 * s + y)-(x1 * s + s - 1 + x, y1 * s + s - 1 + y), c, BF\r
 451 END IF\r
 452 NEXT x1\r
 453 NEXT y1\r
 454 x = x + (8 * s)\r
 455 NEXT a\r
 456 END SUB\r
 457 \r
 458 SUB start\r
 459 SCREEN 12\r
 460 get3d\r
 461 getfnt\r
 462 \r
 463 myx = 30\r
 464 myy = 15\r
 465 myz = 10\r
 466 END SUB\r
 467 \r