'===========================================================================
' Subject: DISTORTED TORUS                   Date: 05-15-97 (10:04)       
' Author:  Davey W. Taylor                   Code: QB, QBasic, PDS        
' Origin:  audio.squad@mailbox.swipnet.se  Packet: GRAPHICS.ABC
'===========================================================================
'Distorted TORUS
'Davey W Taylor
'audio.squad@mailbox.swipnet.se
DECLARE SUB MakePal (start.slot%, end.slot%)
DECLARE SUB ReadRGB (red%, grn%, blu%, slot%)
DECLARE SUB WriteRGB (red%, grn%, blu%, slot%)
TYPE rgb
red AS INTEGER
grn AS INTEGER
blu AS INTEGER
END TYPE
DIM pal(255) AS rgb
SCREEN 13
FOR n% = 0 TO 255
ReadRGB pal(n%).red, pal(n%).grn, pal(n%).blu, n%
NEXT n%
CALL WriteRGB(63, 63, 63, 1)
CALL WriteRGB(63, 0, 0, 63)
CALL WriteRGB(0, 63, 0, 127)
CALL WriteRGB(0, 0, 63, 191)
CALL WriteRGB(63, 63, 63, 255)
CALL MakePal(1, 63)
CALL MakePal(63, 127)
CALL MakePal(127, 191)
CALL MakePal(191, 255)
st = 0
en = 3.14
FOR n = 1 TO 4.8 STEP .01
sa = sa + n / 1000
s = s + sa
c = c + .4
CIRCLE (160, 200 - (n * 40)), s, c, st, en, .5
CIRCLE (160, 200 - (n * 40)), s + 1, c, st, en, .5
NEXT n
st = 3.14
en = 6.28
s = 0: sa = 0
c = 0
FOR n = 1 TO 7.3 STEP .01
sa = sa + n / 1000
s = s + sa
c = c + .4
CIRCLE (160, 200 - (n * 40)), s, c, st, en, .5
CIRCLE (160, 200 - (n * 40)), s + 1, c, st, en, .5
IF n > 6.6 THEN CIRCLE (160, 200 - (n * 40)), s + 2, c, st, en, .5
NEXT n
RANDOMIZE TIMER
FOR y% = 0 TO 200
FOR x% = 0 TO 320
PSET (x%, y%), POINT(x%, y%) + (RND * 8) - (RND * 16)
NEXT x%
NEXT y%
DO
WAIT &H3DA, 8
CALL ReadRGB(ored%, ogrn%, oblu%, 1)
FOR t% = 1 TO 254
CALL ReadRGB(red%, grn%, blu%, t% + 1)
CALL WriteRGB(red%, grn%, blu%, t%)
NEXT t%
CALL WriteRGB(ored%, ogrn%, oblu%, 255)
LOOP UNTIL INKEY$ <> ""

SUB MakePal (start.slot%, end.slot%)
num.slots% = end.slot% - start.slot%
CALL ReadRGB(sr%, sg%, sb%, start.slot%)
CALL ReadRGB(er%, eg%, eb%, end.slot%)
rr% = ABS(er% - sr%): rg% = ABS(eg% - sg%): rb% = ABS(eb% - sb%)
rs% = SGN(er% - sr%): gs% = SGN(eg% - sg%): bs% = SGN(eb% - sb%)
stepr = (rr% / num.slots%) * rs%
stepg = (rg% / num.slots%) * gs%
stepb = (rb% / num.slots%) * bs%
r = sr%: g = sg%: b = sb%
wr% = r: wg% = g: wb% = b
FOR t% = start.slot% TO end.slot%
CALL WriteRGB(wr%, wg%, wb%, t%)
r = r + stepr: wr% = r
g = g + stepg: wg% = g
b = b + stepb: wb% = b
NEXT t%
END SUB

SUB ReadRGB (red%, grn%, blu%, slot%)
OUT &H3C7, slot%
red% = INP(&H3C9)
grn% = INP(&H3C9)
blu% = INP(&H3C9)
END SUB

SUB WriteRGB (red%, grn%, blu%, slot%)
OUT &H3C8, slot%
OUT &H3C9, red%
OUT &H3C9, grn%
OUT &H3C9, blu%
END SUB