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

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