' Svjatoslav Agejenko
' year: 2002

DECLARE SUB adus (a%)
DECLARE SUB pt (x%, y%)
DECLARE SUB addn (x%, y%)
DECLARE SUB smo (x1%, y1%, x2%, y2%, r%)
DECLARE SUB putsym (x%, y%, a%)
DECLARE SUB setpal (b%)
DECLARE SUB start ()
DECLARE SUB getfnt ()
DEFINT A-Z
DIM SHARED font1(1 TO 400, 1 TO 10)
DIM SHARED font2(1 TO 400, 1 TO 10)
DIM SHARED font3(1 TO 400, 1 TO 10)
DIM SHARED pag(0 TO 20, 0 TO 20)
DIM SHARED pah(0 TO 20, 0 TO 20)
DIM SHARED pat(0 TO 20, 0 TO 20)
DIM SHARED usx(0 TO 20)
DIM SHARED usy(0 TO 20)
DIM SHARED uso(0 TO 20)
DIM SHARED tmr AS DOUBLE
usm = 8

start

2
FOR a = 1 TO usm
IF uso(a) = 0 THEN adus a
addn usx(a), usy(a)
usy(a) = usy(a) + 1
IF usy(a) > 13 THEN usy(a) = 0
uso(a) = uso(a) - 1
NEXT a


FOR y = 0 TO 13
FOR x = 0 TO 18
a = pat(x, y)
a = a + 1
IF a = 2 THEN pah(x, y) = 2: pt x, y
IF a = 5 THEN pah(x, y) = 3: pt x, y
IF a = 30 THEN pag(x, y) = 0: pt x, y
pat(x, y) = a
NEXT x
NEXT y

3
IF ABS(tmr - TIMER) < .1 THEN GOTO 3
tmr = TIMER
IF INKEY$ <> "" THEN SYSTEM
GOTO 2

SUB addn (x, y)
pag(x, y) = RND * 8 + 1
pah(x, y) = 1
pat(x, y) = 0
pt x, y


END SUB

SUB adus (a)
usx(a) = RND * 18
usy(a) = RND * 13
uso(a) = RND * 5 + 3
END SUB

SUB getfnt
FOR a = 1 TO 9
LOCATE 1, 1
PRINT "Loading:" + STR$(a * 10) + "%"
LINE (49, 49)-(83, 83), 0, BF
putsym 50, 50, a
smo 50, 50, 82, 82, 1
GET (50, 50)-(82, 82), font1(1, a)

LINE (49, 49)-(83, 83), 0, BF
putsym 50, 50, a
smo 50, 50, 82, 82, 2
GET (50, 50)-(82, 82), font2(1, a)

LINE (49, 49)-(83, 83), 0, BF
putsym 50, 50, a
smo 50, 50, 82, 82, 3
GET (50, 50)-(82, 82), font3(1, a)

NEXT a
CLS
END SUB

SUB pt (x, y)
x1 = x * 32 + 12
y1 = y * 32 + 15

a = pag(x, y)
b = pah(x, y)

IF a = 0 THEN
LINE (x1, y1)-(x1 + 32, y1 + 32), 0, BF
ELSE
SELECT CASE b
CASE 1
PUT (x1, y1), font1(1, a), PSET
CASE 2
PUT (x1, y1), font2(1, a), PSET
CASE 3
PUT (x1, y1), font3(1, a), PSET
END SELECT
END IF

END SUB

SUB putsym (x, y, a)
SELECT CASE a
CASE 1
LINE (x + 10, y + 5)-(x + 10, y + 20), 14
LINE (x + 5, y + 15)-(x + 20, y + 15), 14
LINE (x + 15, y + 25)-(x + 20, y + 25), 14
LINE (x + 20, y + 25)-(x + 25, y + 20), 14
LINE (x + 25, y + 20)-(x + 25, y + 5), 14
CASE 2
LINE (x + 5, y + 15)-(x + 25, y + 10), 14
LINE (x + 15, y + 5)-(x + 10, y + 25), 14
LINE (x + 25, y + 5)-(x + 20, y + 20), 14
LINE (x + 20, y + 30)-(x + 30, y + 20), 14
CASE 3
LINE (x + 5, y + 5)-(x + 5, y + 25), 14
LINE (x + 5, y + 5)-(x + 25, y + 25), 14
LINE (x + 5, y + 25)-(x + 25, y + 25), 14
LINE (x + 10, y + 10)-(x + 25, y + 5), 14
CASE 4
LINE (x + 10, y + 5)-(x + 20, y + 5), 14
LINE (x + 20, y + 5)-(x + 25, y + 10), 14
LINE (x + 25, y + 20)-(x + 20, y + 25), 14
LINE (x + 20, y + 25)-(x + 10, y + 25), 14
LINE (x + 10, y + 25)-(x + 10, y + 5), 14
LINE (x + 5, y + 15)-(x + 20, y + 15), 14
CASE 5
LINE (x + 5, y + 5)-(x + 10, y + 10), 14
LINE (x + 10, y + 10)-(x + 10, y + 25), 14
LINE (x + 10, y + 25)-(x + 5, y + 30), 14
LINE (x + 10, y + 25)-(x + 15, y + 30), 14
LINE (x + 15, y + 30)-(x + 25, y + 30), 14
LINE (x + 10, y + 20)-(x + 25, y + 20), 14
CASE 6
LINE (x + 5, y + 5)-(x + 10, y + 5), 14
LINE (x + 5, y + 5)-(x + 5, y + 10), 14
LINE (x + 10, y + 10)-(x + 10, y + 15), 14
LINE (x + 10, y + 15)-(x + 20, y + 30), 14
LINE (x + 20, y + 30)-(x + 25, y + 30), 14
LINE (x + 5, y + 30)-(x + 10, y + 30), 14
LINE (x + 25, y + 15)-(x + 10, y + 30), 14
CASE 7
LINE (x + 5, y + 15)-(x + 10, y + 15), 14
LINE (x + 10, y + 15)-(x + 25, y + 5), 14
LINE (x + 5, y + 25)-(x + 10, y + 25), 14
LINE (x + 10, y + 25)-(x + 15, y + 5), 14
LINE (x + 20, y + 5)-(x + 20, y + 20), 14
PSET (x + 15, y + 25), 14
PSET (x + 22, y + 25), 14
CASE 8
'line (x+,y+)-(x+,y+),15
LINE (x + 15, y + 10)-(x + 15, y + 25), 14
LINE (x + 20, y + 15)-(x + 20, y + 25), 14
LINE (x + 5, y + 20)-(x + 10, y + 25), 14
LINE (x + 10, y + 25)-(x + 25, y + 25), 14
CASE 9
LINE (x + 5, y + 5)-(x + 25, y + 5), 14
LINE (x + 15, y + 5)-(x + 5, y + 20), 14
LINE (x + 15, y + 5)-(x + 25, y + 20), 14
LINE (x + 15, y + 5)-(x + 15, y + 25), 14
LINE (x + 5, y + 30)-(x + 20, y + 20), 14

END SELECT




END SUB

SUB setpal (b)
SELECT CASE b
CASE 2
FOR a = 0 TO 14
OUT &H3C8, a
OUT &H3C9, a * 2
OUT &H3C9, a * 4.5
OUT &H3C9, a * 3
NEXT a
CASE 1
FOR a = 0 TO 14
OUT &H3C8, a
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT a
OUT &H3C8, 15
OUT &H3C9, 20
OUT &H3C9, 63
OUT &H3C9, 63
END SELECT
END SUB

SUB smo (x1, y1, x2, y2, r)

c1 = 0

FOR y = y1 TO y2
FOR x = x1 TO x2
c = POINT(x, y)
c1 = c1 - 5
IF c1 < 0 THEN c1 = 0
IF c > c1 THEN c1 = c
PSET (x, y), c1
NEXT x
NEXT y

FOR x = x1 TO x2
c1 = 0
FOR y = y1 TO y2
c = POINT(x, y)
c1 = c1 - 5
IF c1 < 0 THEN c1 = 0
IF c > c1 THEN c1 = c
PSET (x, y), c1
NEXT y
NEXT x
 

FOR y = y1 TO y2
c1 = 0
FOR x = x2 TO x1 STEP -1
c = POINT(x, y)
c1 = c1 - 5
IF c1 < 0 THEN c1 = 0
IF c > c1 THEN c1 = c
PSET (x, y), c1
NEXT x
NEXT y


FOR x = x1 TO x2
c1 = 0
FOR y = y2 TO y1 STEP -1
c = POINT(x, y)
c1 = c1 - 5
IF c1 < 0 THEN c1 = 0
IF c > c1 THEN c1 = c
PSET (x, y), c1
NEXT y
NEXT x




IF r = 1 THEN GOTO 1
rr = r + 1


FOR y = y1 TO y2
c1 = 0
FOR x = x1 TO x2
c = POINT(x, y)
c1 = (c1 * r + c) / rr
c2 = c1 - r
IF c2 < 0 THEN c2 = 0
PSET (x, y), c2
NEXT x
NEXT y

FOR x = x1 TO x2
c1 = 0
FOR y = y1 TO y2
c = POINT(x, y)
c1 = c1 - 5
IF c1 < 0 THEN c1 = 0
IF c > c1 THEN c1 = c
PSET (x, y), c1
NEXT y
NEXT x


FOR y = y1 TO y2
c1 = 0
FOR x = x2 TO x1 STEP -1
c = POINT(x, y)
c1 = c1 - 5
IF c1 < 0 THEN c1 = 0
IF c > c1 THEN c1 = c
PSET (x, y), c1
NEXT x
NEXT y


FOR x = x1 TO x2
c1 = 0
FOR y = y2 TO y1 STEP -1
c = POINT(x, y)
c1 = c1 - 5
IF c1 < 0 THEN c1 = 0
IF c > c1 THEN c1 = c
PSET (x, y), c1
NEXT y
NEXT x

1



END SUB

SUB start
SCREEN 12
setpal 1
getfnt
setpal 2

END SUB