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

   1 DECLARE SUB playsound (a$)
   2 DECLARE SUB start ()
   3 DECLARE SUB turnoff ()
   4 DECLARE SUB dispimg (a$)
   5 DECLARE SUB turnon ()
   6 DECLARE SUB ellips (x!, y!, s!, v!, t!)
   7 DECLARE SUB prn (x!, y!, msg$, siz!, col1!)
   8 DECLARE SUB timerAdd (element!, time!, value!)
   9 DECLARE SUB timerdisp ()
  10 DECLARE SUB timerinit ()
  11 DECLARE SUB timerprocess ()
  12 DECLARE SUB mo (x!, y!, an!, s!, w!)
  13 DIM SHARED depth
  14 DIM SHARED pi
  15
  16 DIM SHARED sh1, sh2, sv1, sv2, hp, vp
  17 DIM SHARED timerTime(0 TO 50, 0 TO 100)
  18 DIM SHARED timerValue(0 TO 50, 0 TO 100)
  19
  20 DIM SHARED timerCplace(0 TO 50)
  21 DIM SHARED timerCtime(0 TO 50)
  22 DIM SHARED timerCvalue(0 TO 50)
  23 DIM SHARED timerLast
  24
  25
  26 pi = 3.14128
  27
  28 playsound "luule.mp3"
  29 SCREEN 13
  30 start
  31
  32 timerinit
  33 2
  34
  35
  36 timerprocess
  37 IF timerCtime(0) > 0 THEN
  38   IF im1 = 0 THEN
  39     dispimg "pikk.i01"
  40     im1 = 1
  41   END IF
  42 END IF
  43
  44
  45
  46 IF timerCtime(0) > 1.5 THEN
  47   IF im2 = 0 THEN
  48     dispimg "pikk4.i01"
  49     im2 = 1
  50   END IF
  51 END IF
  52
  53
  54 IF timerCtime(0) > 9 THEN
  55   IF im3 = 0 THEN
  56     dispimg "pikk3.i01"
  57     im3 = 1
  58   END IF
  59 END IF
  60
  61 IF timerCtime(0) > 17 THEN
  62   IF im4 = 0 THEN
  63     dispimg "pikk2.i01"
  64     im4 = 1
  65   END IF
  66 END IF
  67
  68 IF timerCtime(0) > 24 THEN
  69   IF im5 = 0 THEN
  70     dispimg "pikk1.i01"
  71     im5 = 1
  72   END IF
  73 END IF
  74
  75 IF timerCtime(0) > 33 THEN
  76   IF im6 = 0 THEN
  77     dispimg "pikk5.i01"
  78     im6 = 1
  79   END IF
  80 END IF
  81
  82 IF timerCtime(0) > 41 THEN
  83   IF im7 = 0 THEN
  84     dispimg "pikk.i01"
  85     im7 = 1
  86   END IF
  87 END IF
  88
  89
  90 IF timerCtime(0) > 43 THEN
  91   turnoff
  92 END IF
  93
  94 'LOCATE 1, 1
  95 'PRINT timerCtime(0)
  96 GOTO 2
  97 SYSTEM
  98
  99 SUB dispimg (a$)
 100
 101
 102 OPEN a$ FOR INPUT AS #1
 103 INPUT #1, xs
 104 INPUT #1, ys
 105
 106 FOR y = 1 TO ys
 107 FOR x = 1 TO xs
 108 INPUT #1, a
 109 PSET (x - 1, 200 - y), a
 110 NEXT x
 111 NEXT y
 112
 113
 114 CLOSE #1
 115 END SUB
 116
 117 SUB ellips (x, y, s, v, t)
 118
 119 IF x > 0 THEN
 120 IF y > 0 THEN
 121
 122 CIRCLE (x, y), s, v, , , t
 123 PAINT (x, y), v
 124
 125 END IF
 126 END IF
 127
 128 END SUB
 129
 130 SUB playsound (a$)
 131
 132 SHELL "c:\progra~1\winamp\winamp.exe " + a$
 133 SCREEN 0
 134 SCREEN 7, , , 1
 135
 136 END SUB
 137
 138 SUB prn (x, y, msg$, siz, col1)
 139 IF x < 0 THEN GOTO prn1
 140 IF x > 319 THEN GOTO prn1
 141
 142 DIM bck(10000)
 143
 144 GET (0, 0)-(100, 7), bck
 145 LOCATE 1, 1
 146 PRINT msg$
 147
 148 col = col1
 149
 150 FOR x1 = 0 TO LEN(msg$) * 8 - 1
 151 FOR y1 = 0 TO 7
 152   IF POINT(x1, y1) > 0 THEN
 153     rx = x1 * siz + x
 154     ry = y1 * siz + y
 155     IF col1 > 100 THEN col = RND * 4 + 10
 156     IF col1 > 200 THEN
 157       LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, B
 158     ELSE
 159       LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF
 160     END IF
 161 '      LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF
 162   END IF
 163 NEXT y1
 164 NEXT x1
 165
 166
 167 PUT (0, 0), bck, PSET
 168 prn1:
 169 END SUB
 170
 171 SUB start
 172 c = 0
 173 FOR r = 0 TO 5
 174 FOR g = 0 TO 5
 175 FOR B = 0 TO 5
 176 OUT &H3C8, c
 177 c = c + 1
 178 OUT &H3C9, r * 12
 179 OUT &H3C9, g * 12
 180 OUT &H3C9, B * 12
 181 NEXT B
 182 NEXT g
 183 NEXT r
 184
 185 END SUB
 186
 187 SUB timerAdd (element, time, value)
 188
 189 FOR a = 0 TO 100
 190   IF (timerTime(element, a) = 0) AND (timerValue(element, a) = 0) THEN GOTO timer3
 191 NEXT a
 192 timer3:
 193
 194 timerTime(element, a) = time
 195 timerValue(element, a) = value
 196
 197 END SUB
 198
 199 SUB timerdisp
 200 LOCATE 1, 1
 201
 202 FOR a = 0 TO 10
 203   PRINT timerCplace(a), timerCtime(a), timerCvalue(a)
 204 NEXT a
 205
 206 END SUB
 207
 208 SUB timerinit
 209 timerLast = TIMER
 210
 211 paus = 24
 212
 213 ' stuff size
 214 timerAdd 0, 0, 0
 215 timerAdd 0, 1000, 1000
 216
 217 END SUB
 218
 219 SUB timerprocess
 220
 221 timerCurrent = TIMER
 222 timerDiff = timerCurrent - timerLast
 223 timerLast = timerCurrent
 224
 225 FOR a = 0 TO 50
 226   ctim = timerCtime(a) + timerDiff
 227   Cplace = timerCplace(a)
 228 timer2:
 229   IF timerTime(a, Cplace + 1) = -1 THEN
 230     ctim = 0
 231     Cplace = 0
 232   END IF
 233   IF timerTime(a, Cplace + 1) < ctim THEN
 234     IF timerTime(a, Cplace + 1) = 0 THEN
 235       timerCvalue(a) = timerValue(a, Cplace)
 236       GOTO timer1:
 237     END IF
 238     Cplace = Cplace + 1
 239     GOTO timer2
 240   END IF
 241
 242   v1 = timerValue(a, Cplace)
 243   t1 = timerTime(a, Cplace)
 244   v2 = timerValue(a, Cplace + 1)
 245   t2 = timerTime(a, Cplace + 1)
 246
 247   IF v1 = v2 THEN
 248     timerCvalue(a) = v1
 249   ELSE
 250     Tdiff1 = t2 - t1
 251     Tdiff2 = ctim - t1
 252     Vdiff = v2 - v1
 253     timerCvalue(a) = Tdiff2 / Tdiff1 * Vdiff + v1
 254   END IF
 255 timer1:
 256   timerCplace(a) = Cplace
 257   timerCtime(a) = ctim
 258 NEXT a
 259
 260 END SUB
 261
 262 SUB turnoff
 263 x = 160
 264
 265 FOR y = 100 TO 1 STEP -1
 266
 267   LINE (160 - x - 5, 90 - y - 5)-(160 + x + 5, 110 + y + 5), 0, B
 268   LINE (160 - x - 3, 90 - y - 3)-(160 + x + 3, 110 + y + 3), 3, B
 269   LINE (160 - x, 90 - y)-(160 + x, 110 + y), 15, B
 270
 271   SOUND 0, .1
 272 NEXT y
 273
 274
 275
 276 FOR x = 160 TO 0 STEP -1
 277
 278   LINE (160 - x - 5, 90 - 5)-(160 + x + 5, 110 + 5), 0, B
 279   LINE (160 - x - 3, 90 - 3)-(160 + x + 3, 110 + 3), 1, B
 280   LINE (160 - x, 90)-(160 + x, 110), 15, B
 281   SOUND 0, .05
 282 NEXT x
 283
 284 playsound "silent.mp3"
 285 SCREEN 10
 286 SCREEN 13
 287 CLS
 288 1
 289 a$ = INPUT$(1)
 290 GOTO 1
 291
 292
 293 END SUB
 294