'===========================================================================
' Subject: WIBBLES A CIRCLE ALONG SINWAVE    Date: 01-16-99 (14:24)       
' Author:  Graeme Jefferis                   Code: QB, QBasic, PDS        
' Origin:  pages.prodigy.com/qbasic/       Packet: GRAPHICS.ABC
'===========================================================================
'ｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲ
'
'                       The revenge of the Wibble!
'
'          A psychedelic, wibbly, maths*orgy(tm) experience.
'
'          Please take time to read the important text below.
'
'ｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲ

'This is Grimaces Wibble (a really old version, because I never
'like putting source code out for download... I might put a compiled,
'new, version here if there's any interest.
'
'Anyway : This Wibbles a circle along a sinwave, and alters the palette
'         a lot. Press space for a redraw when it gets too mashed up.
'
'Theory : 1st, draws a shaded circle. To wibble, it grabs a line of pixels
'along either the x or the y axis, and offsets them by an amount determined
'by sinwave SIN([x or y] / period) * amplitude :: do your A-level maths to
'work this out. Period and amplitude are random.
'The colour cycling is a very nice & very fast subroutine, Fade. There's
'also a Fade2 which does it backwards. This sub is only a few lines of
'code but it's invaluable. Use it if you want, the format is:

' CALL Fade (start, end, colour1, colour2)
'   start : The beginning of the fade.
'     end : The end of the fade.
' colour1 : The colour to start off with  [QBasic colour assignments]
' colour2 : The colour reached by the end of the fade.
'
' IE : CALL Fade (1,16,0,1)  Fades the first 16 colours to be graduated
'                            from black (0) to red (1)
'      CALL Fade (17,32,1,256) Fades the next 16 from red into green.
'      CALL Fade (33,64,256,65536) Fades the next 16 from green to blue
'      CALL Fade (65,80,65536,257) Fades from blue - yellow
'      CALL Fade (81,96,257,65537)            yellow - purple
'      CALL Fade (97,112,65537,65792)         purple - cyan
'      CALL Fade (113,128,65792,65793)        cyan - white
'
' And ther you have a really hoogooish 128 colour palette!
'
'Note : 'Fast' PC's get a *bonus* blend effect :) It's a bit slow for all
'       you 33MhZ'ers. Contact me if it's too slow/fast for your PC please...
'
' JEFFERIS@INTERALPHA.CO.UK    : Graeme Jefferis! Yay!
'
'  This is copyright Graeme Jefferis. If you wish to distribute it, no copy
' may be altered in any way. Please feel free to use the FADE and FADE2
' subroutines in your own programs : they are my most useful fluffy
' subroutines of all. If you wish to use other subroutines please contact
' me at the EMail address above.
'
' By owning, running, or viewing this program in any form, you have agreed
' to the above by my own default. If you are unsure then delete the program.
' I take a dim view of my code suddenly popping up on BBS's or web site's
' with my name changed. If it does so then, simply enough : no more wibbles :)
'
' Running this program is entirely your own responsibilty. If it damages
' your computer in any way, I will be happy to inform you of this fact :)
'
'  Be strange.                               --Grimace!

DECLARE SUB Fadey ()
DECLARE SUB NewPalette ()
DECLARE FUNCTION RndCol! ()
DECLARE SUB Fade (st AS INTEGER, en AS INTEGER, c1 AS LONG, c2 AS LONG)
DECLARE SUB Starter ()
DECLARE SUB Wibble (fast AS INTEGER)
DECLARE SUB Slow ()
DECLARE SUB Wobble (fast AS INTEGER)
DECLARE SUB Squibb ()
DECLARE SUB Fade2 (st AS INTEGER, en AS INTEGER, c1 AS LONG, c2 AS LONG)

RANDOMIZE TIMER
SCREEN 13: CLS

DIM slw AS INTEGER
DIM speed AS STRING
DO
PRINT "      The Wibble Program"
PRINT
INPUT "Fast PC? (Y/N) : "; speed
speed = UCASE$(speed)
LOOP UNTIL speed = "Y" OR speed = "N"
 
' Fade text out. Should really be in a seperate subroutine :)
FOR count = 63 TO 0 STEP -1
 PALETTE 15, count * (65536 + 257)
NEXT

CLS
IF speed = "N" THEN
  slw = 1:
ELSE
  slw = 0
END IF
CALL NewPalette
CALL Starter
DO
  DO
    CALL Wobble(slw)
    k$ = INKEY$
  LOOP UNTIL k$ <> ""
  IF k$ = " " THEN CALL Starter
LOOP UNTIL k$ = CHR$(13)

CLS
PALETTE 15, 0
PRINT "   -=( WIBBLE! )=-"
PRINT
PRINT
PRINT "  Press any key..."
FOR count = 0 TO 63
 PALETTE 15, count * (65536 + 257)
NEXT
DO
LOOP UNTIL INKEY$ <> ""
DO
LOOP UNTIL INKEY$ = ""
FOR count = 63 TO 0 STEP -1
 PALETTE 15, count * (65536 + 257)
NEXT


'ｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲ
'ｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲ
'ｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲﾛｲｱｰｱｲ

'   If you really must contact me, the email address is good, but I am
'   often on the MUD/talker snowplains.

'       Telnet: Snowplains.enquiries.com               Port 3456
'        "Grimace".

SUB Fade (st AS INTEGER, en AS INTEGER, c1 AS LONG, c2 AS LONG)
DIM count AS INTEGER
FOR count = st TO en
PALETTE count, INT((count - st) / (en - st) * 63) * c2 + INT((en - count) / (en - st) * 63) * c1
NEXT
END SUB

SUB Fade2 (st AS INTEGER, en AS INTEGER, c1 AS LONG, c2 AS LONG)
DIM count AS INTEGER
FOR count = en TO st STEP -1
PALETTE count, INT((count - st) / (en - st) * 63) * c2 + INT((en - count) / (en - st) * 63) * c1
NEXT
END SUB

SUB Fadey
DIM X AS INTEGER
DIM y AS INTEGER

FOR X = 0 TO 319
 FOR y = 0 TO 199
  PSET (X, y), POINT(X - 1 + RND * 3, y - 1 + RND * 3)
 NEXT
NEXT
END SUB

SUB NewPalette
DIM c1 AS LONG, c2 AS LONG, c3 AS LONG, c4 AS LONG, c5 AS LONG, c6 AS LONG, c7 AS LONG
c1 = RndCol
c2 = RndCol
c3 = RndCol
c4 = RndCol
c5 = RndCol
c6 = RndCol
IF RND < .5 THEN
  CALL Fade(1, 20, c1, c2)
  CALL Fade(21, 40, c2, c3)
  CALL Fade(41, 60, c3, c4)
  CALL Fade(61, 80, c4, c5)
  CALL Fade(81, 100, c5, c6)
  CALL Fade(101, 120, c6, 0)
 ELSE
  CALL Fade2(101, 120, c6, 0)
  CALL Fade2(81, 100, c5, c6)
  CALL Fade2(61, 80, c4, c5)
  CALL Fade2(41, 60, c3, c4)
  CALL Fade2(21, 40, c2, c3)
  CALL Fade2(1, 20, c1, c2)
END IF
END SUB

FUNCTION RndCol
DIM c AS LONG
DO
c = 0
IF RND < .5 THEN c = c + 1
IF RND < .5 THEN c = c + 256
IF RND < .5 THEN c = c + 65536
LOOP UNTIL c <> 0
LET RndCol = c
END FUNCTION

SUB Slow
FOR p = 1 TO 100
ot = TIMER
NEXT
END SUB

SUB Squibb
DIM count AS INTEGER
IF RND < .5 THEN
  FOR count = 1 TO 120
   PALETTE count, 0
  NEXT
 ELSE
  FOR count = 120 TO 1 STEP -1
   PALETTE count, 0
  NEXT
END IF
CALL NewPalette
END SUB

SUB Starter
CLS : SCREEN 13
DIM count AS INTEGER
IF RND < .75 THEN
FOR count = 1 TO 120
CIRCLE (160, 100), count, count
CIRCLE (161, 100), count, count
NEXT
ELSE
FOR count = 1 TO 120
CIRCLE (160, 100), count * .6, count
CIRCLE (161, 100), count * .6, count
NEXT
END IF

'Amusing : add a STEP .5 to one of the first FOR...NEXT (And make count
'                                                        a SINGLE)
'          alter the plot routine to load a previously saved image...
'             (you could wibble some Anenome screens....)

END SUB

SUB Wibble (fast AS INTEGER)
DIM wib AS INTEGER
DIM m(1 TO 1000) AS INTEGER
a = RND * 50
f = RND * 50 + 1
neg = RND
IF RND < .5 THEN
  FOR X = 0 TO 319
    wib = a * SIN(X / f)
    IF wib > 0 THEN
      GET (X, 0)-(X, 199 - wib), m
      PUT (X, wib), m, PSET
      LINE (X, 0)-(X, wib - 1), 0
     ELSEIF wib < 0 THEN
      GET (X, -wib)-(X, 199), m
      PUT (X, 0), m, PSET
      LINE (X, 200 + wib)-(X, 199), 0
    END IF
    IF fast = 0 THEN CALL Slow
   NEXT
  ELSE
   FOR y = 0 TO 199
    wib = a * SIN(y / f)
    IF wib > 0 THEN
      GET (0, y)-(319 - wib, y), m
      PUT (wib, y), m, PSET
      LINE (0, y)-(wib - 1, y), 0
     ELSEIF wib < 0 THEN
      GET (-wib, y)-(319, y), m
      PUT (0, y), m, PSET
      LINE (320 + wib, y)-(319, y), 0
    END IF
    IF fast = 0 THEN CALL Slow
   NEXT
END IF
END SUB

SUB Wobble (fast AS INTEGER)
IF RND < .5 THEN
  CALL Wibble(fast)
 ELSE
  IF RND < .3 THEN
    CALL NewPalette
   ELSEIF RND < .85 THEN
    CALL Squibb
   ELSE
    IF fast = 0 THEN
      CALL Fadey
    END IF
  END IF
END IF
IF RND < .01 THEN CALL Starter
END SUB