'===========================================================================
' Subject: MOVING PLASMA                     Date: 07-17-98 (21:02)       
' Author:  Anders Olofsson                   Code: QB, QBasic, PDS        
' Origin:  anders.olofsson@mail.bip.net    Packet: GRAPHICS.ABC
'===========================================================================
'
'  Moving plasma, by Anders Olofsson 1998.
'
'      E-mail: anders.olofsson@mail.bip.net
'
'-------------------------------------------------------
'         ***  Compile it! - 10 times faster ***
'
'   Press space to change palette rotation direction
'   Press "P" to get a new palette
'   Press "N" to get new plasma
'
'-------------------------------------------------------

DEFINT A-Z
DECLARE SUB CyclePalette (Dir%)
DECLARE SUB Paletteget (A%, R%, G%, B%)
DECLARE SUB MakeRandomPalette ()
DECLARE SUB Pal (A%, R%, G%, B%)
DECLARE SUB WriteString (Y%, x%, s$, C%)

CONST PaletteTimer = 30   ' Changes palette every .. second(s).



'-------------------------------------------------------


SCREEN 13

DIM Sine(525) AS INTEGER, Cosine(405) AS INTEGER

CurrentDir = 1

DEF SEG = &HA000

NewPattern:
Rad1! = (4 * ATN(1)) / (RND * 70 + 10)
Rad2! = (4 * ATN(1)) / (RND * 90 + 10)
FOR x = 0 TO 520: Sine(x) = SIN(Rad1! * x) * 255: NEXT
FOR x = 0 TO 400: Cosine(x) = COS(Rad2! * x) * 255: NEXT
Current1 = RND * 200: Current3 = RND * 200
Current2 = RND * 200: Current3 = RND * 200
GOSUB ChangePalette
C1 = RND * 4 + 1
C2 = RND * 4 + 1

DO
Current1 = Current1 + C1
Current2 = Current2 + C2
IF Current1 >= 200 THEN C1 = -C1
IF Current1 <= 0 THEN C1 = RND * 4 + 1: Current1 = 0
IF Current2 >= 200 THEN C2 = -C2
IF Current2 <= 0 THEN C2 = RND * 4 + 1: Current2 = 0

FOR Y = 0 TO 199
FOR x = 0 TO 319 STEP 2
  C = ABS((Sine(x + Current1) + Cosine(Y + Current2 \ 2) + Cosine(x \ 2) + Sine(Y * 2)) \ 2) \ 4
  IF C <= 0 THEN C = 1
  POKE 320& * Y + x, C
  POKE 320& * Y + x + 1, C
NEXT
NEXT

PaletteCounter! = TIMER

 Keys$ = UCASE$(INKEY$)
 CyclePalette CurrentDir
 IF Keys$ = " " AND CurrentDir = 2 THEN CurrentDir = 1: Keys$ = ""
 IF Keys$ = " " AND CurrentDir = 1 THEN CurrentDir = 2
 IF Keys$ = "P" THEN GOSUB ChangePalette: Keys$ = ""
 IF Keys$ = "N" THEN GOTO NewPattern
 IF TIMER - PaletteCounter! > PaletteTimer THEN GOSUB ChangePalette
LOOP UNTIL LEN(Keys$) AND Keys$ <> " "

FOR x = 0 TO 63                  'Fade out
 FOR C = 0 TO 255
  Paletteget C, R, G, B
  IF R THEN R = R - 1
  IF G THEN G = G - 1
  IF B THEN B = B - 1
  Pal C, R, G, B
 NEXT
 WAIT &H3DA, 8: WAIT &H3DA, 8, 1
NEXT

SCREEN 12: SCREEN 0
END

ChangePalette:
PaletteCounter! = TIMER
R = INP(64) \ 4: G = INP(64) \ 4: B = INP(64) \ 4
Pal 1, R, G, B
Pal 255, B, R, G
MakeRandomPalette
RETURN

SUB CyclePalette (Dir)

IF Dir = 1 THEN
FOR T = 2 TO 255
 Paletteget T, R, G, B
 Pal T - 1, R, G, B
NEXT

Paletteget 1, R, G, B
Pal 255, R, G, B

ELSE

Paletteget 255, R, G, B
Pal 1, R, G, B

FOR T = 254 TO 1 STEP -1
 Paletteget T, R, G, B
 Pal T + 1, R, G, B
NEXT

END IF

WAIT &H3DA, 8

END SUB

SUB MakeRandomPalette
DIM used(0 TO 255) AS STRING * 2: used(0) = CHR$(1) + CHR$(255): s = 1

DO
getnext: IF s = 0 THEN EXIT DO
         s = s - 1
         C1 = ASC(used(s)): C2 = ASC(RIGHT$(used(s), 1))
         Current = (C1 + C2) \ 2
IF C1 = C2 OR Current = C1 OR Current = C2 GOTO getnext

 Paletteget C1, r1, g1, b1: Paletteget C2, r2, g2, b2
  T = (ABS(C1 - C2) \ 8) * ((INP(64) MOD 3) - 1)
  R = (r1 + r2) \ 2 + T: G = (g1 + g2) \ 2 + T: B = (b1 + b2) \ 2 + T
 Pal Current, R, G, B
 used(s) = CHR$(C1) + CHR$(Current): s = s + 1
 used(s) = CHR$(Current) + CHR$(C2): s = s + 1
LOOP UNTIL s = 0
Pal 0, 0, 0, 0

END SUB

SUB Pal (A, R, G, B)
OUT &H3C8, A
OUT &H3C9, R
OUT &H3C9, G
OUT &H3C9, B

END SUB

SUB Paletteget (A, R, G, B)
OUT &H3C7, A
R = INP(&H3C9)
G = INP(&H3C9)
B = INP(&H3C9)
END SUB

SUB WriteString (Y, x, s$, C)
Memloc = 80 * (Y - 1) + (x - 1)
Memloc = Memloc * 2

DEF SEG = &HB800
 FOR T = 0 TO LEN(s$) - 1
  POKE Memloc, ASC(MID$(s$, T + 1, 1))
  POKE Memloc + 1, C
  Memloc = Memloc + 2
 NEXT T
DEF SEG

END SUB