' by Svjatoslav Agejenko svjatoslav@svjatoslav.eu
' 2003.04

DECLARE FUNCTION getc% ()
DECLARE SUB mks ()
DEFINT A-Y
DECLARE SUB disp ()
DECLARE SUB shpal ()
DECLARE SUB start ()

DIM SHARED buf(1 TO 40, 1 TO 25) AS INTEGER
DIM SHARED col(1 TO 40, 1 TO 25) AS INTEGER
DIM SHARED snd(1 TO 20)
DIM SHARED sndp

start
'shpal

FOR y = 1 TO 25
  FOR x = 1 TO 40
    buf(x, y) = getc
  NEXT x
NEXT y

FOR y = 1 TO 25
  FOR x = 1 TO 40
    col(x, y) = 1
  NEXT x
NEXT y

act = 0
1
mks
frm = frm + 1
IF frm > 10000 THEN frm = 1
FOR y = 25 TO 2 STEP -1
  FOR x = 1 TO 40
    buf(x, y) = buf(x, y - 1)
  NEXT x
NEXT y
mks
FOR x = 1 TO 40
  buf(x, 1) = buf(x, 25)
NEXT x
buf(RND * 39 + 1, RND * 10 + 1) = getc
act = act + 1
disp
SELECT CASE act
CASE 1
	 FOR a = 1 TO 20
	   snd(a) = 0
	   IF RND * 100 < 2 THEN snd(a) = RND * 4000 + 4000
	 NEXT a
	 b = SIN(frm / 100) * 3 + 6
	 FOR a = 1 TO 20 STEP b
	   snd(a) = 10000
	 NEXT a

CASE 2
	 c = RND * 5
	 x1 = RND * 38 + 1
	 y = RND * 23 + 1
	 x2 = RND * 38 + 1
	 IF x1 > x2 THEN SWAP x1, x2
	 FOR x = x1 TO x2
	   col(x, y) = c
	 NEXT x
CASE 3
	 c = RND * 5
	 y1 = RND * 23 + 1
	 x = RND * 38 + 1
	 y2 = RND * 23 + 1
	 IF y1 > y2 THEN SWAP x1, x2
	 FOR y = y1 TO y2
	   col(x, y) = c
	 NEXT y
CASE 4
	IF RND * 100 < 20 THEN
	FOR y = 1 TO 25
	   FOR x = 1 TO 40
	     IF col(x, y) > 1 THEN col(x, y) = col(x, y) - 1
	   NEXT x
	 NEXT y
	END IF
CASE 5
	IF RND * 100 < 5 THEN
	FOR y = 1 TO 25 STEP 2
	   FOR x = 1 TO 40
	     col(x, y) = 1
	   NEXT x
	 NEXT y
	END IF
CASE 6
	IF RND * 100 < 5 THEN
	FOR x = 1 TO 40 STEP 2
	   FOR y = 1 TO 25
	     col(x, y) = 1
	   NEXT y
	 NEXT x
	END IF
CASE 7
	FOR a = 1 TO 30
	  col(RND * 39 + 1, RND * 23 + 1) = RND * 4 + 1
	NEXT a
CASE 8
	IF INKEY$ <> "" THEN SYSTEM
	act = 0
END SELECT
GOTO 1

SYSTEM

SUB disp

mks
LOCATE 1, 1
FOR y = 1 TO 10
FOR x = 1 TO 40
COLOR col(x, y), 0
PRINT CHR$(buf(x, y));
NEXT x
NEXT y
mks
FOR y = 11 TO 20
FOR x = 1 TO 40
COLOR col(x, y), 0
PRINT CHR$(buf(x, y));
NEXT x
NEXT y
mks
FOR y = 21 TO 25
FOR x = 1 TO 40
COLOR col(x, y), 0
PRINT CHR$(buf(x, y));
NEXT x
NEXT y
mks

END SUB

FUNCTION getc
IF RND * 100 > 50 THEN
  a = RND * 9 + 48
ELSE
  a = RND * 25 + 65
END IF
IF RND * 100 < 15 THEN a = 32
getc = a
END FUNCTION

SUB mks
sndp = sndp + 1
IF sndp > 20 THEN sndp = 1
SOUND snd(sndp), .07
'SOUND 0, .07
END SUB

SUB shpal

FOR a = 0 TO 16
COLOR a
PRINT a, "Palette test"
NEXT a
a$ = INPUT$(1)
END SUB

SUB start
RANDOMIZE TIMER
CLS
WIDTH 40, 25
VIEW PRINT 1 TO 25

  OUT &H3C8, 0
  OUT &H3C9, 0
  OUT &H3C9, 0
  OUT &H3C9, 0

FOR a = 1 TO 5
  OUT &H3C8, a

  b = a * 5
  g = a * 10 + 20
  r = a * 0

  IF r > 63 THEN r = 63
  IF g > 63 THEN g = 63
  IF b > 63 THEN b = 63
  OUT &H3C9, r
  OUT &H3C9, g
  OUT &H3C9, b
NEXT a

END SUB