' Stroboscope presentation
' made by Svjatoslav Agejenko
' in 2002
' H-Page: svjatoslav.eu
' E-Mail: svjatoslav@svjatoslav.eu
 
DECLARE SUB pag4 ()
DECLARE SUB getkey (a$)
DECLARE SUB mo ()
DEFINT A-Z
DECLARE SUB dra ()
DECLARE SUB get3d ()
DECLARE SUB pag3 ()
DECLARE SUB pag2 ()
DECLARE SUB getfnt ()
DECLARE SUB prn (x2%, y%, s%, c%, t$)
DECLARE SUB pag1 ()

DECLARE SUB start ()


DIM SHARED font(0 TO 7, 0 TO 15, 0 TO 207)
DIM SHARED det(1 TO 100)
DIM SHARED px1(1 TO 1000)
DIM SHARED py1(1 TO 1000)
DIM SHARED px2(1 TO 1000)
DIM SHARED py2(1 TO 1000)
DIM SHARED opx1(1 TO 1000)
DIM SHARED opy1(1 TO 1000)
DIM SHARED opx2(1 TO 1000)
DIM SHARED opy2(1 TO 1000)
DIM SHARED linc(1 TO 1000)

DIM SHARED myx, myy, myz
DIM SHARED myx1, myy1, myz1
DIM SHARED myx2, myy2, myz2
DIM SHARED tfra

DIM SHARED nl

start

pag1
pag2
pag3
pag4
END

DATA 0,0,5,-2
DATA 0,0,5,2
DATA 0, 0, 15, 0

DATA 15,-2,15,2
DATA 25,-2,25,2
DATA 15,-2,25,-2
DATA 15,2,25,2

DATA 25,0,35,0
DATA 35,-2,35,2
DATA 35,-2,40,0
DATA 35,2,40,0
DATA 40,-2,40,2

DATA 40,0,80,0
DATA 50,0,50,19
DATA 48,19,52,19
DATA 48,21,52,21
DATA 50,21,50,35

DATA 0,35,125,35
DATA 0,35,5,33
DATA 0,35,5,37

DATA 70,0,70,15
DATA 70,35,70,20
DATA 69,16,71,19
DATA 69,19,71,16
DATA 67,10,73,10
DATA 67,25,73,25
DATA 67,10,67,25
DATA 73,10,73,25

DATA 75,15,75,25
DATA 75,20,90,20
DATA 90,20,91,21
DATA 91,21,90,22
DATA 90,22,91,23
DATA 91,23,90,24
DATA 90,24,91,25
DATA 91,25,90,26
DATA 90,26,90,35

DATA 93,18,93,28
DATA 92,18,92,28

DATA 95,20,94,21
DATA 94,21,95,22
DATA 95,22,94,23
DATA 94,23,95,24
DATA 95,24,94,25
DATA 94,25,95,26
DATA 95,26,95,35

DATA 95, 20, 115, 20
DATA 115,20,115,15
DATA 115,7,115,0
DATA 125,35,125,26
DATA 123,26,127,26
DATA 123,24,127,24
DATA 125,24,125,0
DATA 125,0,110,0
DATA 110,-2,110,2
DATA 100,-2,100,2
DATA 100,-2,110,-2
DATA 100,2,110,2

DATA 100,0,90,0
DATA 90,-2,90,2
DATA 80,-2,80,2
DATA 80,-2,90,-2
DATA 80,2,90,2

DATA 113,5,117,5
DATA 113,17,117,17
DATA 113,5,113,17
DATA 117,5,117,17
DATA 115,11,125,11

DATA 105,-2,105,-5
DATA 105,-5,113,-5
DATA 113,-5,113,0
DATA 105,-2,104,-4
DATA 105,-2,106,-4

DATA 999,999,999,999

SUB dra

FOR a = 1 TO nl
x1 = px1(a) - myx
y1 = py1(a) - myy
x2 = px2(a) - myx
y2 = py2(a) - myy


x1 = x1 * 30 / myz + 160
y1 = y1 * 30 / myz + 100
x2 = x2 * 30 / myz + 160
y2 = y2 * 30 / myz + 100
LINE (opx1(a), opy1(a))-(opx2(a), opy2(a)), 0
LINE (x1, y1)-(x2, y2), linc(a)
opx1(a) = x1
opy1(a) = y1
opx2(a) = x2
opy2(a) = y2
NEXT a

END SUB

SUB get3d

nl = 0
5
READ x1, y1, x2, y2
IF x1 = 999 THEN GOTO 6
nl = nl + 1
px1(nl) = x1
py1(nl) = y1
px2(nl) = x2
py2(nl) = y2
linc(nl) = 11
GOTO 5
6
'PRINT nl, "of lines loaded"
'a$ = INPUT$(1)
END SUB

SUB getfnt

FOR c = 0 TO 15
OUT &H3C8, c
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT c

FOR a = 0 TO 207
LOCATE 1, 1
IF (a > 5) AND (a < 14) THEN GOTO 1
PRINT CHR$(a)
1
FOR y = 0 TO 15
FOR x = 0 TO 7
font(x, y, a) = POINT(x, y)
NEXT x
NEXT y
NEXT a
END SUB

SUB getkey (a$)

FOR a = 1 TO 50
b$ = INKEY$
NEXT a

7
a$ = INKEY$
IF a$ = "" THEN GOTO 7

FOR a = 1 TO 50
b$ = INKEY$
NEXT a

END SUB

SUB mo

myxv = myx2 - myx1
myyv = myy2 - myy1
myzv = myz2 - myz1

FOR a = 1 TO tfra
myx = myx1 + (myxv * a / tfra)
myy = myy1 + (myyv * a / tfra)
myz = myz1 + (myzv * a / tfra)
dra
SOUND 0, 1
NEXT a
dra



END SUB

SUB pag1

SCREEN 13

a = 0
FOR c = 16 TO 31
OUT &H3C8, c
OUT &H3C9, a * 3
OUT &H3C9, a * 4.5
OUT &H3C9, a * 0
a = a + 1
NEXT c


SHELL "playmov.com"

OUT &H3C8, 101
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 0

OUT &H3C8, 102
OUT &H3C9, 63
OUT &H3C9, 10
OUT &H3C9, 10

OUT &H3C8, 103
OUT &H3C9, 60
OUT &H3C9, 60
OUT &H3C9, 0


a = 0
FOR c = 50 TO 65
OUT &H3C8, c
OUT &H3C9, a * 4.5
OUT &H3C9, a * 0
OUT &H3C9, (15 - a) * 4.5
a = a + 1
NEXT c

st$ = " Esitlus teemal:"

FOR t = 0 TO 400
IF t < 320 THEN
FOR y = 0 TO 199
c = POINT(319 - t, y)
IF c < 100 THEN c = c + 34
PSET (319 - t, y), c
NEXT y
x = 319 - t
IF x / 16 = x \ 16 THEN
s = x / 16
IF s <= LEN(st$) THEN
a$ = RIGHT$(LEFT$(st$, s), 1)
prn x, 20, 2, 101, a$
END IF
END IF
END IF

IF (t < 360) AND (t > 39) THEN
FOR y = 0 TO 13
c = POINT(359 - t, y)
IF c < 100 THEN c = c - 34
PSET (359 - t, y), c
NEXT y
FOR y = 55 TO 199
c = POINT(359 - t, y)
IF c < 100 THEN c = c - 34
PSET (359 - t, y), c
NEXT y
END IF


SOUND 0, .2
NEXT t

prn 31, 101, 3, 102, "STROBOSKOOP"
prn 29, 99, 3, 102, "STROBOSKOOP"
prn 30, 100, 3, 103, "STROBOSKOOP"


FOR x = 0 TO 160
FOR y = 100 TO 150
c = POINT(x, y)
IF c = 102 THEN c = 103: GOTO 2
IF c = 103 THEN c = 102: GOTO 2
2
PSET (x, y), c
NEXT y
SOUND 0, .1
NEXT x

FOR y = 199 TO 120 STEP -1
FOR x = 0 TO 319
c = POINT(x, y)
IF c = 102 THEN c = 103: GOTO 3
IF c = 103 THEN c = 102: GOTO 3
3
PSET (x, y), c
NEXT x
SOUND 0, .1
NEXT y

prn 49, 179, 1, 0, "autor: Svjatoslav Agejenko"
prn 51, 181, 1, 0, "autor: Svjatoslav Agejenko"
prn 50, 180, 1, 15, "autor: Svjatoslav Agejenko"

getkey a$

DIM buf(1 TO 30000)
FOR a = 1 TO 320 / 5
GET (0, 0)-(314, 100), buf(1)
PUT (5, 0), buf(1), PSET
LINE (0, 0)-(4, 100), 0, BF

GET (5, 101)-(319, 199), buf(1)
PUT (0, 101), buf(1), PSET
LINE (315, 101)-(319, 199), 0, BF
NEXT a


END SUB

SUB pag2
SCREEN 13
SCREEN 12


END SUB

SUB pag3

myx1 = 20
myy1 = 15
myz1 = 100
myx2 = 20
myy2 = 15
myz2 = 10
tfra = 20

mo

prn 147, 66, 1, 3, "100   D336B             180k    680k"
prn 180, 120, 1, 3, "50m 450V                          1m"
prn 180, 400, 2, 14, "P�him�tteline skeem"

getkey a$

LINE (0, 0)-(639, 390), 0, BF

myx1 = 20
myy1 = 15
myz1 = 10
myx2 = 80
myy2 = 5
myz2 = 4
tfra = 20
mo
getkey a$

myx1 = 80
myy1 = 5
myz1 = 4
myx2 = 40
myy2 = 5
myz2 = 4
tfra = 20
mo
getkey a$

myx1 = 40
myy1 = 5
myz1 = 4
myx2 = 20
myy2 = 15
myz2 = 10
tfra = 10
mo
prn 147, 66, 1, 3, "100   D336B             180k    680k"
prn 180, 120, 1, 3, "50m 450V                          1m"
getkey a$





END SUB

SUB pag4
CLS
SCREEN 13
prn 35, 100, 2, 14, "     T�nan"
prn 35, 140, 2, 14, "t�helepanu eest!"

DIM buf(1 TO 30000)

GET (0, 100)-(319, 199), buf(1)
FOR y = 100 TO 50 STEP -1
PUT (0, y), buf(1), PSET
SOUND 0, .5
NEXT y

getkey a$
SYSTEM
END SUB

SUB prn (x2, y, s, c, t$)
x = x2

FOR a = 1 TO LEN(t$)
b = ASC(RIGHT$(LEFT$(t$, a), 1))
FOR y1 = 0 TO 15
FOR x1 = 0 TO 7
IF font(x1, y1, b) > 0 THEN
LINE (x1 * s + x, y1 * s + y)-(x1 * s + s - 1 + x, y1 * s + s - 1 + y), c, BF
END IF
NEXT x1
NEXT y1
x = x + (8 * s)
NEXT a
END SUB

SUB start
SCREEN 12
get3d
getfnt

myx = 30
myy = 15
myz = 10
END SUB