'===========================================================================
' Subject: CIRCULAR PLASMA + FIRE            Date: 03-06-97 (15:24)       
' Author:  Angelo Ken Pesce                  Code: QB, PDS                
' Origin:  ken@uniserv.uniplan.it          Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB wrpal (slot%, r%, g%, b%)
DECLARE SUB flam1 ()
DECLARE SUB back ()
DECLARE SUB initp ()
DECLARE SUB init ()
' ANGELO KEN PESCE 1997
' (COLOR) PLASMA EFFECT v5  PLASMA + FIRE
' Email: ken at uniserv.uniplan.it
' WWW: http://www.geocities.com/SiliconValley/Pines/9913/homepage.htm
' LOAD THIS PROGRAM USING QBX /AH OR QB /AH
'
' QUICKBASIC IS REALLY SLOW...
' I HAVE TO CONVERT THIS TO PASCAL OR C
' COMPILE IT USING ALTERNATE MATH OPTION OF QUICKBASIC PDS 7
' AND USE A PENTIUM PROCESSOR...


' $DYNAMIC
DEFINT A-Z

' INITIALIZE CIRCLE ARRAY
DIM SHARED aps(250, 250)
CALL init
SCREEN 13


' PALETTE INIT
CALL initp

' PATTER 1 AND PATTER 2 CENTER and INITIAL MOVEMENT
xp1 = 80 + 20: yp1 = 50 + 20
xp2 = 80 - 20: yp2 = 50 - 20
xm1 = 1
ym1 = -1
xm2 = -1
ym2 = 1

DO
' FIRST HALF **************************************************************
DEF SEG = &HA000
FOR x = 1 TO 159
ax = x + 125
x1 = ax - xp1
x2 = ax - xp2
px = x * 2
FOR y = 0 TO 50
ay = y + 125

y1 = ay - yp1
' THOSE CHECKS ARE REMOVED TO INCREASE SPEED
'IF x1 < 1 OR x1 > 250 OR y1 < 1 OR y1 > 250 THEN col1 = 0: GOTO ex1
col1 = aps(x1, y1)
ex1:

y2 = ay - yp2
' THOSE CHECKS ARE REMOVED TO INCREASE SPEED
'IF x2 < 1 OR x2 > 250 OR y2 < 1 OR y2 > 250 THEN col2 = 0: GOTO ex2
col2 = aps(x2, y2)
ex2:

IF col1 > 0 AND col2 > 0 THEN col = 0 ELSE col = col1 + col2

py = y * 2
POKE (py * 320 + px), col
POKE (py * 320 + px - 1), col

NEXT
NEXT

' SECOND HALF *************************************************************

DEF SEG = (&HA000 + &H7D0)

FOR x = 1 TO 159
ax = x + 125
x1 = ax - xp1
x2 = ax - xp2
px = x * 2
FOR y = 0 TO 49
ay = y + 125

y1 = ay - yp1 + 50
' THOSE CHECKS ARE REMOVED TO INCREASE SPEED
'IF x1 < 1 OR x1 > 250 OR y1 < 1 OR y1 > 250 THEN col1 = 0: GOTO ex3
col1 = aps(x1, y1)
ex3:

y2 = ay - yp2 + 50
' THOSE CHECKS ARE REMOVED TO INCREASE SPEED
'IF x2 < 1 OR x2 > 250 OR y2 < 1 OR y2 > 250 THEN col2 = 0: GOTO ex4
col2 = aps(x2, y2)
ex4:

IF col1 > 0 AND col2 > 0 THEN col = 0 ELSE col = col1 + col2
py = y * 2

POKE (py * 320 + px), col
POKE (py * 320 + px - 1), col
NEXT
NEXT

DEF SEG
GOSUB setmov

'FireEffect
CALL flam1

LOOP UNTIL INKEY$ <> ""

END

setmov:
' LET THEM MOVE!!!
xp1 = xp1 + xm1
yp1 = yp1 + ym1
xp2 = xp2 + xm2
yp2 = yp2 + ym2
IF xp1 > 80 + 20 THEN xm1 = -1 ELSE IF xp1 < 80 - 20 THEN xm1 = 1 ELSE GOTO 1
IF yp1 > 50 + 20 THEN ym1 = -1 ELSE IF yp1 < 50 - 20 THEN ym1 = 1
1
IF xp2 > 80 + 20 THEN xm2 = -1 ELSE IF xp2 < 80 - 20 THEN xm2 = 1 ELSE GOTO 2
IF yp2 > 50 + 20 THEN ym2 = -1 ELSE IF yp2 < 50 - 20 THEN ym2 = 1
2
RETURN

REM $STATIC
SUB flam1

DEF SEG = &HA000 + &H7D0
FOR r = 0 TO 100
a = INT(320 * RND)
POKE (99 * 320 + a), 79
POKE (99 * 320 + (a - 1)), 0
'POKE (97 * 320 + a), 79
'POKE (97 * 320 + (a - 1)), 0
NEXT

FOR yp = 21 TO 99 STEP 2
FOR xp = 0 TO 319
col = PEEK((yp + 2) * 320 + xp)
col = col + PEEK(yp * 320 + xp + 1)
IF col = 0 THEN GOTO fast
col = col + PEEK(yp * 320 + xp)
col = col / 3 - RND * 2
IF col < 16 THEN col = 16
POKE (yp - 2) * 320 + xp, col
fast:
NEXT
NEXT
DEF SEG
END SUB

SUB init

' I HAVE TO USE THIS "TRICK" IN ORDER TO USE INTEGERS

SCREEN 12
FOR i = 1 TO 180 STEP 16
FOR i1 = 1 TO 4
CIRCLE (125, 125), i + i1, i1 + ((180 - i) / 18)
CIRCLE (126, 125), i + i1, i1 + ((180 - i) / 18)
NEXT
FOR i1 = 1 TO 4
CIRCLE (125, 125), i + i1 + 4, (5 - i1) + ((180 - i) / 18)
CIRCLE (126, 125), i + i1 + 4, (5 - i1) + ((180 - i) / 18)
NEXT
NEXT


FOR x = 1 TO 250
FOR y = 1 TO 250
aps(x, y) = POINT(x, y)
NEXT
NEXT
END SUB

SUB initp
FOR i = 0 TO 15
PALETTE i, 256 * (i * 2)
NEXT

FOR i = 16 TO (16 + 63)
PALETTE i, 63
NEXT
FOR i = 0 TO 63
CALL wrpal(i / 4 + 16, i, 0, 0)
CALL wrpal(i / 4 + 32, 63, i, 0)
CALL wrpal(i / 4 + 64, 63, 63, i)
NEXT
END SUB

SUB wrpal (slot%, r%, g%, b%)
OUT &H3C7, slot%
OUT &H3C9, r%
OUT &H3C9, g%
OUT &H3C9, b%
END SUB