' Svjatoslav Agejenko  svjatoslav@svjatoslav.eu
' 2003.10


DECLARE SUB textpage ()
DECLARE SUB mkcircle ()
DECLARE SUB mklines ()
DECLARE SUB disp ()
DECLARE SUB fill ()
DIM SHARED pi
DIM SHARED an
DIM SHARED frm
DIM SHARED buf2(1 TO 50, 1 TO 80) AS STRING * 1
DIM SHARED buf(1 TO 50, 1 TO 80) AS STRING * 1
DIM SHARED col(1 TO 50, 1 TO 80) AS INTEGER

DIM SHARED vl, hl, vls, hls

WIDTH 80, 50
VIEW PRINT 1 TO 50
pi = 3.14159
OPEN "mkcircle.bas" FOR INPUT AS #1

CLS

hl = 20
hls = 1
vl = 20
vls = 1

1
frm = frm + 1

textpage
fill
mklines
mkcircle
disp
IF INKEY$ <> "" THEN GOTO 2
GOTO 1
2
CLOSE #1
SYSTEM

SUB disp
COLOR 7, 0
LOCATE 1, 1
FOR y = 1 TO 50
  FOR x = 1 TO 80
    COLOR col(y, x)
    PRINT buf(y, x);
    buf(y, x) = buf2(y, x)
    col(y, x) = 4
  NEXT x
NEXT y

END SUB

SUB fill
COLOR 4, 0
siz = SIN(frm / 7) + 1.1

an = an + SIN(frm / 30) / 10
rsx = 50 - SIN(an + pi / 4) * 12 * 20 * siz
rsy = 50 - COS(an + pi / 4) * 12 * 20 * siz

sxp = SIN(an) * 6 * siz
syp = COS(an) * 6 * siz
rsxp = SIN(an + pi / 2) * 6 * siz
rsyp = COS(an + pi / 2) * 6 * siz

FOR y = 1 TO 50
rsx = rsx + rsxp
rsy = rsy + rsyp

4
IF rsx > 100 THEN rsx = rsx - 100: GOTO 4
IF rsx < 0 THEN rsx = rsx + 100: GOTO 4
IF rsy > 100 THEN rsy = rsy - 100: GOTO 4
IF rsy < 0 THEN rsy = rsy + 100: GOTO 4

sx = rsx
sy = rsy

FOR x = 1 TO 80
  c = 0
  sx = sx + sxp
  sy = sy + syp
  
3
  IF sx > 100 THEN sx = sx - 100: GOTO 3
  IF sx < 0 THEN sx = sx + 100: GOTO 3
  IF sy > 100 THEN sy = sy - 100: GOTO 3
  IF sy < 0 THEN sy = sy + 100: GOTO 3

  IF sx < 12 OR sy < 12 THEN buf(y, x) = "*": col(y, x) = 9
  NEXT x
NEXT y
END SUB

SUB mkcircle
cs = (SIN(frm / 10) + 1.01) * 30
cy = SIN(frm / 12) * 30 + 40
cx = COS(frm / 17) * 15 + 25

FOR y = 1 TO 50
xp = SIN(y / 5 + frm / 30) * cs / 10

IF (y >= cy - cs) AND (y <= cy + cs) THEN

h1 = SQR((y - (cy - cs)) * ((cy + cs) - y))
IF (y >= cy - cs / 2) AND (y <= cy + cs / 2) THEN h2 = SQR((y - (cy - cs / 2)) * ((cy + cs / 2) - y)) ELSE h2 = 0


s = cx - h1 + xp
IF s < 1 THEN s = 1
e = cx - h2 + xp
IF e > 80 THEN e = 80

FOR x = s TO e
buf(y, x) = CHR$(RND * 40 + 48)
col(y, x) = RND * 15
NEXT x


s = cx + h2 + xp
IF s < 1 THEN s = 1
e = cx + h1 + xp
IF e > 80 THEN e = 80

FOR x = s TO e
buf(y, x) = CHR$(RND * 200 + 32)
col(y, x) = RND * 15
NEXT x

END IF


NEXT y



END SUB

SUB mklines
vl = vl + vls
IF vl > 49 THEN vls = -1
IF vl < 2 THEN vls = 1

hl = hl + hls
IF hl > 79 THEN hls = -1
IF hl < 2 THEN hls = 1

FOR x = 1 TO 80
  IF buf(vl, x) = "*" THEN c = 31 ELSE c = 10
  buf(vl, x) = "#"
  col(vl, x) = c
NEXT x

FOR y = 1 TO 50
  IF buf(y, hl) = "*" THEN c = 31 ELSE c = 10
  buf(y, hl) = "#"
  col(y, hl) = c
NEXT y
END SUB

SUB textpage
IF EOF(1) <> 0 THEN
  CLOSE 1
  OPEN "mkcircle.bas" FOR INPUT AS #1
END IF

LINE INPUT #1, a$

FOR y = 1 TO 49
FOR x = 1 TO 80
  buf2(y, x) = buf2(y + 1, x)
NEXT x
NEXT y

FOR x = 1 TO 80
  buf2(50, x) = " "
NEXT x

IF LEN(a$) > 80 THEN a$ = LEFT$(a$, 80)
FOR b = 1 TO LEN(a$)
  c$ = RIGHT$(LEFT$(a$, b), 1)
  buf2(50, b) = c$
NEXT b



END SUB