graphics/presentations/KHK Intellektika 2004 demo/KHKDEMO.BAS

   1 DECLARE SUB playsound (a$)\r
   2 DECLARE SUB turnon ()\r
   3 DECLARE SUB ellips (x!, y!, s!, v!, t!)\r
   4 DECLARE SUB prn (x!, y!, msg$, siz!, col1!)\r
   5 DECLARE SUB timerAdd (element!, time!, value!)\r
   6 DECLARE SUB timerdisp ()\r
   7 DECLARE SUB timerinit ()\r
   8 DECLARE SUB timerprocess ()\r
   9 DECLARE SUB mo (x!, y!, an!, s!, w!)\r
  10 DIM SHARED depth\r
  11 DIM SHARED pi\r
  12 \r
  13 DIM SHARED sh1, sh2, sv1, sv2, hp, vp\r
  14 DIM SHARED timerTime(0 TO 50, 0 TO 100)\r
  15 DIM SHARED timerValue(0 TO 50, 0 TO 100)\r
  16 \r
  17 DIM SHARED timerCplace(0 TO 50)\r
  18 DIM SHARED timerCtime(0 TO 50)\r
  19 DIM SHARED timerCvalue(0 TO 50)\r
  20 DIM SHARED timerLast\r
  21 \r
  22 \r
  23 pi = 3.14128\r
  24 \r
  25 turnon\r
  26 \r
  27 SCREEN 7, , , 1\r
  28 \r
  29 timerinit\r
  30 s = 50\r
  31 2\r
  32 s1 = SIN(timerCvalue(1) * 1.3) * .5 + 1.1\r
  33 s2 = COS(timerCvalue(1) * 1.3) * .5 + 1.1\r
  34 \r
  35 \r
  36 frm = frm + 1\r
  37 sv1 = 5 * s1\r
  38 sv2 = 2\r
  39 vp = SIN(timerCvalue(1) * 1.3)\r
  40 \r
  41 sh1 = 2 * s2\r
  42 sh2 = 1.4\r
  43 hp = SIN(timerCvalue(1)) * .7\r
  44 \r
  45 \r
  46 mo timerCvalue(2), timerCvalue(3), timerCvalue(4), timerCvalue(0), 0\r
  47 \r
  48 ellips 100, timerCvalue(6), timerCvalue(7) + 4, 14, .5\r
  49 ellips 100, timerCvalue(6), timerCvalue(7) + 2, 10, .5\r
  50 ellips 100, timerCvalue(6), timerCvalue(7), 0, .5\r
  51 prn timerCvalue(5), 10, "KHK", 7, 250\r
  52 \r
  53 prn timerCvalue(8), 130, "Infotehno-", 2, 0\r
  54 prn timerCvalue(8), 150, "   loogia", 2, 0\r
  55 \r
  56 timerprocess\r
  57 LOCATE 1, 1\r
  58 'PRINT timerCtime(0)\r
  59 IF timerCtime(0) > 26 THEN CHAIN "ray.bas"\r
  60 PCOPY 0, 1\r
  61 LINE (0, 0)-(319, 199), 15, BF\r
  62 GOTO 2\r
  63 SYSTEM\r
  64 \r
  65 SUB ellips (x, y, s, v, t)\r
  66 \r
  67 IF x > 0 THEN\r
  68 IF y > 0 THEN\r
  69 \r
  70 CIRCLE (x, y), s, v, , , t\r
  71 PAINT (x, y), v\r
  72 \r
  73 END IF\r
  74 END IF\r
  75 \r
  76 END SUB\r
  77 \r
  78 SUB mo (x, y, an, s, w)\r
  79 depth = depth + 1\r
  80 IF s < .2 THEN GOTO 1\r
  81 \r
  82 IF depth / 2 = depth \ 2 THEN c = 1 ELSE c = 3\r
  83 \r
  84 CIRCLE (x, y), s, c\r
  85 PAINT (x, y), c\r
  86 \r
  87 IF w <> 1 THEN\r
  88 x1 = SIN(an) * s * 2.5 + x\r
  89 y1 = COS(an) * s * 2.5 + y\r
  90 IF w = 3 THEN ns = s / sv2 ELSE ns = s / sv1\r
  91 mo x1, y1, an + vp, ns, 3\r
  92 END IF\r
  93 \r
  94 IF w <> 2 THEN\r
  95 x1 = SIN(an - pi / 2) * s * 2.5 + x\r
  96 y1 = COS(an - pi / 2) * s * 2.5 + y\r
  97 IF w = 4 THEN ns = s / sh2 ELSE ns = s / sh1\r
  98 mo x1, y1, an + hp, ns, 4\r
  99 END IF\r
 100 \r
 101 IF w <> 3 THEN\r
 102 x1 = SIN(an - pi) * s * 2.5 + x\r
 103 y1 = COS(an - pi) * s * 2.5 + y\r
 104 IF w = 1 THEN ns = s / sv2 ELSE ns = s / sv1\r
 105 mo x1, y1, an + vp, ns, 1\r
 106 END IF\r
 107 \r
 108 IF w <> 4 THEN\r
 109 x1 = SIN(an - pi * 1.5) * s * 2.5 + x\r
 110 y1 = COS(an - pi * 1.5) * s * 2.5 + y\r
 111 IF w = 2 THEN ns = s / sh2 ELSE ns = s / sh1\r
 112 mo x1, y1, an + hp, ns, 2\r
 113 END IF\r
 114 \r
 115 1\r
 116 depth = depth - 1\r
 117 END SUB\r
 118 \r
 119 SUB playsound (a$)\r
 120 REM SHELL "c:\progra~1\winamp\winamp.exe " + a$\r
 121 SCREEN 0\r
 122 SCREEN 7, , , 1\r
 123 \r
 124 END SUB\r
 125 \r
 126 SUB prn (x, y, msg$, siz, col1)\r
 127 IF x < 0 THEN GOTO prn1\r
 128 IF x > 319 THEN GOTO prn1\r
 129 \r
 130 DIM bck(10000)\r
 131 \r
 132 GET (0, 0)-(100, 7), bck\r
 133 LOCATE 1, 1\r
 134 PRINT msg$\r
 135 \r
 136 col = col1\r
 137 \r
 138 FOR x1 = 0 TO LEN(msg$) * 8 - 1\r
 139 FOR y1 = 0 TO 7\r
 140   IF POINT(x1, y1) > 0 THEN\r
 141     rx = x1 * siz + x\r
 142     ry = y1 * siz + y\r
 143     IF col1 > 100 THEN col = RND * 4 + 10\r
 144     IF col1 > 200 THEN\r
 145       LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, B\r
 146     ELSE\r
 147       LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF\r
 148     END IF\r
 149 '      LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF\r
 150   END IF\r
 151 NEXT y1\r
 152 NEXT x1\r
 153 \r
 154 \r
 155 PUT (0, 0), bck, PSET\r
 156 prn1:\r
 157 END SUB\r
 158 \r
 159 SUB timerAdd (element, time, value)\r
 160 \r
 161 FOR a = 0 TO 100\r
 162   IF (timerTime(element, a) = 0) AND (timerValue(element, a) = 0) THEN GOTO timer3\r
 163 NEXT a\r
 164 timer3:\r
 165 \r
 166 timerTime(element, a) = time\r
 167 timerValue(element, a) = value\r
 168 \r
 169 END SUB\r
 170 \r
 171 SUB timerdisp\r
 172 LOCATE 1, 1\r
 173 \r
 174 FOR a = 0 TO 10\r
 175   PRINT timerCplace(a), timerCtime(a), timerCvalue(a)\r
 176 NEXT a\r
 177 \r
 178 END SUB\r
 179 \r
 180 SUB timerinit\r
 181 timerLast = TIMER\r
 182 \r
 183 paus = 24\r
 184 \r
 185 ' stuff size\r
 186 timerAdd 0, 0, 50\r
 187 timerAdd 0, 7, 10\r
 188 timerAdd 0, 20, 10\r
 189 timerAdd 0, 24, 0\r
 190 timerAdd 0, 1000, 0\r
 191 \r
 192 \r
 193 ' stuff speed\r
 194 timerAdd 1, 0, .1\r
 195 timerAdd 1, 1000, 1000\r
 196 \r
 197 ' stuff X & Y\r
 198 timerAdd 2, 0, 160\r
 199 timerAdd 3, 0, 100\r
 200 \r
 201 timerAdd 2, 5, 160\r
 202 timerAdd 3, 5, 100\r
 203 \r
 204 timerAdd 2, 9, 280\r
 205 timerAdd 3, 9, 160\r
 206 \r
 207 timerAdd 2, 10, 280\r
 208 timerAdd 3, 10, 160\r
 209 \r
 210 timerAdd 2, 20, 40\r
 211 timerAdd 3, 20, 160\r
 212 \r
 213 timerAdd 2, 1000, 40\r
 214 timerAdd 3, 1000, 160\r
 215 \r
 216 ' stuff rotations\r
 217 timerAdd 4, 0, .1\r
 218 timerAdd 4, 10, .1\r
 219 timerAdd 4, 22, 18\r
 220 timerAdd 4, 2000, 10000\r
 221 \r
 222 ' KHK message X\r
 223 \r
 224 timerAdd 5, 0, -1\r
 225 timerAdd 5, 5, -1\r
 226 timerAdd 5, 9, 50\r
 227 timerAdd 5, 10, 30\r
 228 timerAdd 5, paus, 30\r
 229 timerAdd 5, paus + 2, 321\r
 230 \r
 231 ' Ellips Y & radius\r
 232 timerAdd 6, 0, -1\r
 233 timerAdd 6, 4, -1\r
 234 timerAdd 6, 10, 30\r
 235 timerAdd 6, 1000, 50\r
 236 \r
 237 timerAdd 7, 0, 1\r
 238 timerAdd 7, 6, 1\r
 239 timerAdd 7, 12, 130\r
 240 \r
 241 timerAdd 7, paus, 130\r
 242 timerAdd 7, paus + 2, 1\r
 243 \r
 244 ' "Infotehnoloogia" message\r
 245 \r
 246 timerAdd 8, 0, 320\r
 247 timerAdd 8, 11, 320\r
 248 timerAdd 8, 20, 100\r
 249 timerAdd 8, paus, 100\r
 250 timerAdd 8, paus + 1, -1\r
 251 \r
 252 \r
 253 END SUB\r
 254 \r
 255 SUB timerprocess\r
 256 \r
 257 timerCurrent = TIMER\r
 258 timerDiff = timerCurrent - timerLast\r
 259 timerLast = timerCurrent\r
 260 \r
 261 FOR a = 0 TO 50\r
 262   ctim = timerCtime(a) + timerDiff\r
 263   Cplace = timerCplace(a)\r
 264 timer2:\r
 265   IF timerTime(a, Cplace + 1) = -1 THEN\r
 266     ctim = 0\r
 267     Cplace = 0\r
 268   END IF\r
 269   IF timerTime(a, Cplace + 1) < ctim THEN\r
 270     IF timerTime(a, Cplace + 1) = 0 THEN\r
 271       timerCvalue(a) = timerValue(a, Cplace)\r
 272       GOTO timer1:\r
 273     END IF\r
 274     Cplace = Cplace + 1\r
 275     GOTO timer2\r
 276   END IF\r
 277 \r
 278   v1 = timerValue(a, Cplace)\r
 279   t1 = timerTime(a, Cplace)\r
 280   v2 = timerValue(a, Cplace + 1)\r
 281   t2 = timerTime(a, Cplace + 1)\r
 282 \r
 283   IF v1 = v2 THEN\r
 284     timerCvalue(a) = v1\r
 285   ELSE\r
 286     Tdiff1 = t2 - t1\r
 287     Tdiff2 = ctim - t1\r
 288     Vdiff = v2 - v1\r
 289     timerCvalue(a) = Tdiff2 / Tdiff1 * Vdiff + v1\r
 290   END IF\r
 291 timer1:\r
 292   timerCplace(a) = Cplace\r
 293   timerCtime(a) = ctim\r
 294 NEXT a\r
 295 \r
 296 END SUB\r
 297 \r
 298 SUB turnon\r
 299 'a$ = INPUT$(1)\r
 300 playsound "marine.mp3"\r
 301 \r
 302 SCREEN 7, , , 1\r
 303 \r
 304 FOR x = 0 TO 160 STEP 15\r
 305  \r
 306   LINE (160 - x - 5, 90 - 5)-(160 + x + 5, 110 + 5), 1, BF\r
 307   LINE (160 - x - 3, 90 - 3)-(160 + x + 3, 110 + 3), 3, BF\r
 308   LINE (160 - x, 90)-(160 + x, 110), 15, BF\r
 309 \r
 310   PCOPY 0, 1\r
 311   CLS\r
 312   SOUND 0, .5\r
 313 NEXT x\r
 314 \r
 315 FOR y = 10 TO 100 STEP 15\r
 316   CLS\r
 317 \r
 318   LINE (160 - x - 5, 90 - y - 5)-(160 + x + 5, 110 + y + 5), 1, BF\r
 319   LINE (160 - x - 3, 90 - y - 3)-(160 + x + 3, 110 + y + 3), 3, BF\r
 320   LINE (160 - x, 90 - y)-(160 + x, 110 + y), 15, BF\r
 321 \r
 322   PCOPY 0, 1\r
 323   SOUND 0, .5\r
 324 NEXT y\r
 325 \r
 326 FOR a = 1 TO 25\r
 327   prn RND * 250, RND * 180, STR$(INT(RND * 2)), 3, 0\r
 328   PCOPY 0, 1\r
 329   SOUND 0, 1\r
 330 NEXT a\r
 331 \r
 332 DIM buf(1 TO 1000)\r
 333 FOR b = 1 TO 30\r
 334 FOR a = 0 TO 195\r
 335   t = ABS(100 - a)\r
 336 \r
 337   IF RND * 50 < t THEN\r
 338     GET (1, a)-(318, a + 1), buf\r
 339     IF a > 100 THEN\r
 340       PUT (0, a), buf, PSET\r
 341     ELSE\r
 342       PUT (2, a), buf, PSET\r
 343     END IF\r
 344   END IF\r
 345 NEXT a\r
 346 PCOPY 0, 1\r
 347 'SOUND 0, 1\r
 348 NEXT b\r
 349 \r
 350 \r
 351 END SUB\r
 352 \r