'===========================================================================
' Subject: PIXEL TUNNEL (WORMHOLE EFFECT)    Date: 06-20-97 (11:00)       
' Author:  The ABC Programmer                Code: QB, QBasic, PDS        
' Origin:  voxel@freenet.edmonton.ab.ca    Packet: GRAPHICS.ABC
'===========================================================================
' °±²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²±°
'°±²Û                                                                Û²±°
'°±²Û PIXTUN.PAS - This source was coded by The Jerk of Hoaxers aka  Û²±°
'°±²Û Stian S›reng in February 1995. If you have any questions about Û²±°
'°±²Û this source, email to: stians@interlink.no, 100% answer. (Bug  Û²±°
'°±²Û reports are welcome!) Boy, can this source be optimized !!!    Û²±°
'°±²Û Feel free to use it at any time, as long as you give me the    Û²±°
'°±²Û credits for it. Tested on 486SX/30: ok, 486DX2/66: fast and    Û²±°
'°±²Û 386SX/25 slow. Conclusion: Requires mcga and a 486.            Û²±°
'°±²Û                                                         stians Û²±°
' °±²ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ²±°
'
' Converted to BASIC code by William Yu (06-20-97)  Public Domain.

DECLARE SUB pal (colr%, red%, green%, blue%)
DECLARE FUNCTION LShift% (Byte%, Bits%)

DEFINT A-Z

CONST Amount = 30     'number of circles

DIM circles(1 TO 360, 1 TO Amount) AS INTEGER
DIM ypts(1 TO 90, 1 TO Amount) AS INTEGER
DIM xpts(1 TO 90, 1 TO Amount) AS INTEGER
DIM xsinus(1 TO 720) AS INTEGER
DIM ysinus(1 TO 720) AS INTEGER
DIM r AS SINGLE


' ** Precalculate circles ** 

     PRINT "Calculating, please wait.."

     FOR a = 1 TO Amount
       r = 0
       FOR x = 1 TO 360
          r = r + (.0175) * 4
          circles(x, a) = INT(SIN(r) * (5 + (LShift%(a, 2)))) + (5 + (LShift%(a, 2)))
       NEXT x
     NEXT a

' ** Precalc x and y sinuses ** 

     r = 0
     FOR x = 1 TO 720
          r = r + .0175
          xsinus(x) = INT(SIN(r) * 140) + 140
          ysinus(x) = INT(COS(r) * 90) + 90
     NEXT x

     SCREEN 13

' ** Set grayscale palette ** 

     FOR a = 63 TO 0 STEP -1
       CALL pal(a, a, a, a)
     NEXT a
     sinptr = 0

' ** Main loop ** 

     DO
       WAIT &H3DA, 8

       IF sinptr > 358 THEN sinptr = 0     'loop sinus
       sinptr = sinptr + 2

' ** Draw and clear circles ** 

     FOR a = 1 TO Amount
       FOR x = 1 TO 90
         xx = xpts(x, a)          ' store old pts
         yy = ypts(x, a)
         PSET (xx, yy), 0
         xx = (circles(x, a) + xsinus((LShift%(a, 3)) + sinptr)) - a * 4 ' new pos 
         yy = (circles(x + 23, a) + ysinus(sinptr + 90 + (LShift%(a, 2)))) - (a * 4)
         IF ((xx > 0) AND (xx < 319)) THEN      '  check if inside bounds 
           IF ((yy > 0) AND (yy < 199)) THEN
             PSET (xx, yy), a + 5
             xpts(x, a) = xx
             ypts(x, a) = yy
           END IF
         END IF
       NEXT x
     NEXT a

     LOOP UNTIL INKEY$ <> ""

END

FUNCTION LShift% (Byte%, Bits%) STATIC
   LShift% = (Byte% * (2 ^ Bits%)) MOD 256
END FUNCTION

SUB pal (colr, red, green, blue)   'sets palette
     OUT &H3C8, colr
     OUT &H3C9, red
     OUT &H3C9, green
     OUT &H3C9, blue
END SUB