'===========================================================================
' Subject: GEOMETRY SICKENER                 Date: 09-06-96 (12:31)       
' Author:  Ryan White                        Code: QB, QBasic, PDS        
' Origin:  BIGFOOT@SunBelt.Net             Packet: GRAPHICS.ABC
'===========================================================================
'GEOMETRY SICKENER
'By Ryan White
'This is a sample of my abilities with palettes and wierd designs.
'If you would like to get more of these type programs, write me at
'Bigfoot@Sunbelt.Net  or  Bigfoot@InfoAve.Net
'I have more than 575 Qbasic programs to my name, and it grows daily.
'Ah well, enjoy...

SCREEN 12
DEFINT A-Z
CLS
RANDOMIZE TIMER
pnts = 6
DIM x(pnts), y(pnts), xc(pnts), yc(pnts), xb(pnts), yb(pnts), co(15, 2), cn(15, 2)
ON KEY(1) GOSUB tt: KEY(1) ON       'Change colors
ON KEY(2) GOSUB makepoints: KEY(2) ON      'redo points
ON KEY(3) GOSUB clrdescrn: KEY(3) ON          'clear screen

GOSUB tt
GOSUB makepoints

st:
GOSUB doline
CLS
DO UNTIL INKEY$ <> ""
GOSUB bounce: GOSUB doline: cx = cx + 1: IF cx = 5 THEN cx = 0: GOSUB colorpuller  ': GOSUB doline0
LOOP
GOSUB daend

doline:
c = c + 1: IF c = 16 THEN c = 1
m = pnts - 1: o = pnts
DO UNTIL o = 0
LINE (x(o), y(o))-(x(m), y(m)), c
m = m - 1: IF m = -1 THEN o = o - 1: m = o - 1
LOOP
RETURN

clrdescrn:
CLS
RETURN

makepoints:
FOR n = 0 TO pnts
 x(n) = INT(RND * 640): y(n) = INT(RND * 480): xb(n) = 1: yb(n) = 1
NEXT n
RETURN

doline0:
m = pnts - 1: o = pnts
DO UNTIL o = 0
LINE (x(o), y(o))-(x(m), y(m)), 0
m = m - 1: IF m = -1 THEN o = o - 1: m = o - 1
LOOP
RETURN

bounce:
FOR m = 0 TO pnts
IF x(m) >= 639 THEN xc(m) = 1: xb = INT(RND * 8)
IF x(m) <= 0 THEN xc(m) = 0: xb = INT(RND * 8)
IF y(m) >= 479 THEN yc(m) = 1: yb = INT(RND * 6)
IF y(m) <= 0 THEN yc(m) = 0: yb = INT(RND * 6)
IF xc(m) = 1 THEN x(m) = x(m) - xb(m) ELSE x(m) = x(m) + xb(m)
IF yc(m) = 1 THEN y(m) = y(m) - yb(m) ELSE y(m) = y(m) + yb(m)
NEXT m
RETURN

daend:
CLS : SCREEN 0: WIDTH 80, 25: END

tt:
r = INT(RND * 5): g = INT(RND * 5): b = INT(RND * 5)
FOR attr% = 1 TO 15
rt% = attr% * r + 3: gt% = attr% * g + 3: bt% = attr% * b + 3
co(attr%, 0) = rt%: co(attr%, 1) = gt%: co(attr%, 2) = bt%
cn(attr%, 0) = rt%: cn(attr%, 1) = gt%: cn(attr%, 2) = bt%
OUT &H3C8, attr%: OUT &H3C9, rt%: OUT &H3C9, gt%: OUT &H3C9, bt%
NEXT attr%
RETURN

colorpuller:
FOR n = 15 TO 1 STEP -1: OUT &H3C7, n: FOR m = 0 TO 2: co(n, m) = INP(&H3C9): NEXT m: NEXT n
cn(1, 0) = co(15, 0): cn(1, 1) = co(15, 1): cn(1, 2) = co(15, 2)
FOR n = 15 TO 2 STEP -1: FOR m = 0 TO 2: cn(n, m) = co(n - 1, m): NEXT m: NEXT n
FOR n = 15 TO 1 STEP -1: OUT &H3C8, n: FOR m = 0 TO 2: OUT &H3C9, cn(n, m): NEXT m: NEXT n
RETURN