fixed directory name and file permissions
[qbasicapps.git] / graphics / presentations / KHK jõulud / khkdemo.bas
diff --git a/graphics/presentations/KHK jõulud/khkdemo.bas b/graphics/presentations/KHK jõulud/khkdemo.bas
new file mode 100755 (executable)
index 0000000..f56e70e
--- /dev/null
@@ -0,0 +1,352 @@
+DECLARE SUB playsound (a$)
+DECLARE SUB turnon ()
+DECLARE SUB ellips (x!, y!, s!, v!, t!)
+DECLARE SUB prn (x!, y!, msg$, siz!, col1!)
+DECLARE SUB timerAdd (element!, time!, value!)
+DECLARE SUB timerdisp ()
+DECLARE SUB timerinit ()
+DECLARE SUB timerprocess ()
+DECLARE SUB mo (x!, y!, an!, s!, w!)
+DIM SHARED depth
+DIM SHARED pi
+
+DIM SHARED sh1, sh2, sv1, sv2, hp, vp
+DIM SHARED timerTime(0 TO 50, 0 TO 100)
+DIM SHARED timerValue(0 TO 50, 0 TO 100)
+
+DIM SHARED timerCplace(0 TO 50)
+DIM SHARED timerCtime(0 TO 50)
+DIM SHARED timerCvalue(0 TO 50)
+DIM SHARED timerLast
+
+
+pi = 3.14128
+
+turnon
+
+SCREEN 7, , , 1
+
+timerinit
+s = 50
+2
+s1 = SIN(timerCvalue(1) * 1.3) * .5 + 1.1
+s2 = COS(timerCvalue(1) * 1.3) * .5 + 1.1
+
+
+frm = frm + 1
+sv1 = 5 * s1
+sv2 = 2
+vp = SIN(timerCvalue(1) * 1.3)
+
+sh1 = 2 * s2
+sh2 = 1.4
+hp = SIN(timerCvalue(1)) * .7
+
+
+mo timerCvalue(2), timerCvalue(3), timerCvalue(4), timerCvalue(0), 0
+
+ellips 100, timerCvalue(6), timerCvalue(7) + 4, 14, .5
+ellips 100, timerCvalue(6), timerCvalue(7) + 2, 10, .5
+ellips 100, timerCvalue(6), timerCvalue(7), 0, .5
+prn timerCvalue(5), 10, "KHK", 7, 250
+
+prn timerCvalue(8), 130, "Infotehno-", 2, 0
+prn timerCvalue(8), 150, "   loogia", 2, 0
+
+timerprocess
+LOCATE 1, 1
+'PRINT timerCtime(0)
+IF timerCtime(0) > 26 THEN CHAIN "ray.bas"
+PCOPY 0, 1
+LINE (0, 0)-(319, 199), 15, BF
+GOTO 2
+SYSTEM
+
+SUB ellips (x, y, s, v, t)
+
+IF x > 0 THEN
+IF y > 0 THEN
+
+CIRCLE (x, y), s, v, , , t
+PAINT (x, y), v
+
+END IF
+END IF
+
+END SUB
+
+SUB mo (x, y, an, s, w)
+depth = depth + 1
+IF s < .2 THEN GOTO 1
+
+IF depth / 2 = depth \ 2 THEN c = 1 ELSE c = 3
+
+CIRCLE (x, y), s, c
+PAINT (x, y), c
+
+IF w <> 1 THEN
+x1 = SIN(an) * s * 2.5 + x
+y1 = COS(an) * s * 2.5 + y
+IF w = 3 THEN ns = s / sv2 ELSE ns = s / sv1
+mo x1, y1, an + vp, ns, 3
+END IF
+
+IF w <> 2 THEN
+x1 = SIN(an - pi / 2) * s * 2.5 + x
+y1 = COS(an - pi / 2) * s * 2.5 + y
+IF w = 4 THEN ns = s / sh2 ELSE ns = s / sh1
+mo x1, y1, an + hp, ns, 4
+END IF
+
+IF w <> 3 THEN
+x1 = SIN(an - pi) * s * 2.5 + x
+y1 = COS(an - pi) * s * 2.5 + y
+IF w = 1 THEN ns = s / sv2 ELSE ns = s / sv1
+mo x1, y1, an + vp, ns, 1
+END IF
+
+IF w <> 4 THEN
+x1 = SIN(an - pi * 1.5) * s * 2.5 + x
+y1 = COS(an - pi * 1.5) * s * 2.5 + y
+IF w = 2 THEN ns = s / sh2 ELSE ns = s / sh1
+mo x1, y1, an + hp, ns, 2
+END IF
+
+1
+depth = depth - 1
+END SUB
+
+SUB playsound (a$)
+SHELL "c:\progra~1\winamp\winamp.exe " + a$
+SCREEN 0
+SCREEN 7, , , 1
+
+END SUB
+
+SUB prn (x, y, msg$, siz, col1)
+IF x < 0 THEN GOTO prn1
+IF x > 319 THEN GOTO prn1
+
+DIM bck(10000)
+
+GET (0, 0)-(100, 7), bck
+LOCATE 1, 1
+PRINT msg$
+
+col = col1
+
+FOR x1 = 0 TO LEN(msg$) * 8 - 1
+FOR y1 = 0 TO 7
+  IF POINT(x1, y1) > 0 THEN
+    rx = x1 * siz + x
+    ry = y1 * siz + y
+    IF col1 > 100 THEN col = RND * 4 + 10
+    IF col1 > 200 THEN
+      LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, B
+    ELSE
+      LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF
+    END IF
+'      LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF
+  END IF
+NEXT y1
+NEXT x1
+
+
+PUT (0, 0), bck, PSET
+prn1:
+END SUB
+
+SUB timerAdd (element, time, value)
+
+FOR a = 0 TO 100
+  IF (timerTime(element, a) = 0) AND (timerValue(element, a) = 0) THEN GOTO timer3
+NEXT a
+timer3:
+
+timerTime(element, a) = time
+timerValue(element, a) = value
+
+END SUB
+
+SUB timerdisp
+LOCATE 1, 1
+
+FOR a = 0 TO 10
+  PRINT timerCplace(a), timerCtime(a), timerCvalue(a)
+NEXT a
+
+END SUB
+
+SUB timerinit
+timerLast = TIMER
+
+paus = 24
+
+' stuff size
+timerAdd 0, 0, 50
+timerAdd 0, 7, 10
+timerAdd 0, 20, 10
+timerAdd 0, 24, 0
+timerAdd 0, 1000, 0
+
+
+' stuff speed
+timerAdd 1, 0, .1
+timerAdd 1, 1000, 1000
+
+' stuff X & Y
+timerAdd 2, 0, 160
+timerAdd 3, 0, 100
+
+timerAdd 2, 5, 160
+timerAdd 3, 5, 100
+
+timerAdd 2, 9, 280
+timerAdd 3, 9, 160
+
+timerAdd 2, 10, 280
+timerAdd 3, 10, 160
+
+timerAdd 2, 20, 40
+timerAdd 3, 20, 160
+
+timerAdd 2, 1000, 40
+timerAdd 3, 1000, 160
+
+' stuff rotations
+timerAdd 4, 0, .1
+timerAdd 4, 10, .1
+timerAdd 4, 22, 18
+timerAdd 4, 2000, 10000
+
+' KHK message X
+
+timerAdd 5, 0, -1
+timerAdd 5, 5, -1
+timerAdd 5, 9, 50
+timerAdd 5, 10, 30
+timerAdd 5, paus, 30
+timerAdd 5, paus + 2, 321
+
+' Ellips Y & radius
+timerAdd 6, 0, -1
+timerAdd 6, 4, -1
+timerAdd 6, 10, 30
+timerAdd 6, 1000, 50
+
+timerAdd 7, 0, 1
+timerAdd 7, 6, 1
+timerAdd 7, 12, 130
+
+timerAdd 7, paus, 130
+timerAdd 7, paus + 2, 1
+
+' "Infotehnoloogia" message
+
+timerAdd 8, 0, 320
+timerAdd 8, 11, 320
+timerAdd 8, 20, 100
+timerAdd 8, paus, 100
+timerAdd 8, paus + 1, -1
+
+
+END SUB
+
+SUB timerprocess
+
+timerCurrent = TIMER
+timerDiff = timerCurrent - timerLast
+timerLast = timerCurrent
+
+FOR a = 0 TO 50
+  ctim = timerCtime(a) + timerDiff
+  Cplace = timerCplace(a)
+timer2:
+  IF timerTime(a, Cplace + 1) = -1 THEN
+    ctim = 0
+    Cplace = 0
+  END IF
+  IF timerTime(a, Cplace + 1) < ctim THEN
+    IF timerTime(a, Cplace + 1) = 0 THEN
+      timerCvalue(a) = timerValue(a, Cplace)
+      GOTO timer1:
+    END IF
+    Cplace = Cplace + 1
+    GOTO timer2
+  END IF
+
+  v1 = timerValue(a, Cplace)
+  t1 = timerTime(a, Cplace)
+  v2 = timerValue(a, Cplace + 1)
+  t2 = timerTime(a, Cplace + 1)
+
+  IF v1 = v2 THEN
+    timerCvalue(a) = v1
+  ELSE
+    Tdiff1 = t2 - t1
+    Tdiff2 = ctim - t1
+    Vdiff = v2 - v1
+    timerCvalue(a) = Tdiff2 / Tdiff1 * Vdiff + v1
+  END IF
+timer1:
+  timerCplace(a) = Cplace
+  timerCtime(a) = ctim
+NEXT a
+
+END SUB
+
+SUB turnon
+a$ = INPUT$(1)
+playsound "marine.mp3"
+
+SCREEN 7, , , 1
+
+FOR x = 0 TO 160 STEP 15
+  LINE (160 - x - 5, 90 - 5)-(160 + x + 5, 110 + 5), 1, BF
+  LINE (160 - x - 3, 90 - 3)-(160 + x + 3, 110 + 3), 3, BF
+  LINE (160 - x, 90)-(160 + x, 110), 15, BF
+
+  PCOPY 0, 1
+  CLS
+  SOUND 0, .5
+NEXT x
+
+FOR y = 10 TO 100 STEP 15
+  CLS
+
+  LINE (160 - x - 5, 90 - y - 5)-(160 + x + 5, 110 + y + 5), 1, BF
+  LINE (160 - x - 3, 90 - y - 3)-(160 + x + 3, 110 + y + 3), 3, BF
+  LINE (160 - x, 90 - y)-(160 + x, 110 + y), 15, BF
+
+  PCOPY 0, 1
+  SOUND 0, .5
+NEXT y
+
+FOR a = 1 TO 25
+  prn RND * 250, RND * 180, STR$(INT(RND * 2)), 3, 0
+  PCOPY 0, 1
+  SOUND 0, 1
+NEXT a
+
+DIM buf(1 TO 1000)
+FOR b = 1 TO 30
+FOR a = 0 TO 195
+  t = ABS(100 - a)
+
+  IF RND * 50 < t THEN
+    GET (1, a)-(318, a + 1), buf
+    IF a > 100 THEN
+      PUT (0, a), buf, PSET
+    ELSE
+      PUT (2, a), buf, PSET
+    END IF
+  END IF
+NEXT a
+PCOPY 0, 1
+'SOUND 0, 1
+NEXT b
+
+
+END SUB
+