'===========================================================================
' Subject: IMPROVED REALTIME PLASMA          Date: 08-04-98 (08:37)       
' Author:  Andrew S. Gibson                  Code: QB, PDS                
' Origin:  zapf_dingbat@juno.com           Packet: GRAPHICS.ABC
'===========================================================================
'--------------------------------
' QBFPLAS.BAS for QuickBASIC 4.5
'--------------------------------
' Realtime plasma by T.C.P. of DiABOLiC FORCE This source is PD. If you
' use it, credit me. Turbo Pascal -> Power Basic: Dieter Folger
' Power Basic -> QuickBASIC 4.5: Zapf DingBat
' Requires the Bit Manipulators Library by:
' Written By: Luis Espinoza (in quicklib form) it's included.
' Keys:
' F1 - change direction of flow
' F2 - change the Plasma table sub type generation
' F3 - Increase the Plasma shift speed.
' F4 - Decrease the Plasma shift speed.
' F5 - Increase the Plasma shift Influence.
' F6 - Decrease the Plasma shift Influence.
' F7 - Change the Main Plasma type.
' N - Change the palette.  I - Invert the palette.
' P - Start the palette slider.  B - make the palette flow backwards.
' T - Make a new Plasma table. Alt+D - Debug info.
'-----------------------------------------------
DEFINT A-Z
DECLARE FUNCTION LSHIFT% (BYVAL Byte%, BYVAL Bit%)      'Shift Left
DECLARE FUNCTION RSHIFT% (BYVAL Byte%, BYVAL Bit%)      'Shift Right
DECLARE FUNCTION READBIT% (BYVAL Byte%, BYVAL Bit%)     'Read Bit in Byte
DECLARE FUNCTION RESETBIT% (BYVAL Byte%, BYVAL Bit%)    'Reset Bit in Byte (0)
DECLARE FUNCTION SETBIT% (BYVAL Byte%, BYVAL Bit%)      'Set Bit in Byte (1)
DECLARE FUNCTION TOGGLEBIT% (BYVAL Byte%, BYVAL Bit%)   'Toggle Bit
DECLARE FUNCTION BAND% (BYVAL Byte1%, BYVAL Byte2%)     'Binary And
DECLARE FUNCTION BOR% (BYVAL Byte1%, BYVAL Byte2%)      'Binary Or
DECLARE FUNCTION BXOR% (BYVAL Byte1%, BYVAL Byte2%)     'Binary Xor
DECLARE FUNCTION BOC% (BYVAL Byte1%)                    'Ones Compliment
DECLARE SUB DBG ()
DECLARE SUB InitSetMode ()
DECLARE SUB InitPalset ()
DECLARE SUB MakePal ()
DECLARE SUB MakeTable ()
DECLARE SUB PalGet (c%, r%, g%, b%)
DECLARE SUB PalSet (c%, r%, g%, b%)
DECLARE SUB PokeInteger (Addr%, Word%)
DECLARE SUB PokeWord (BYVAL Segment, BYVAL Address, BYVAL Value) 'external library

CONST TRUE = -1, FALSE = 0, Original = TRUE, NEW = FALSE
CONST PI# = 3.14159265358979# 'higher resolution than Dieter Folger's def
'function keys constants, yes F11Key$ & F12Key$ are trapped by INKEY$
CONST F1Key$ = ";", F2Key$ = "<", F3Key$ = "=", F4Key$ = ">", F5Key$ = "?"
CONST F6Key$ = "@", F7Key$ = "A", F8Key$ = "B", F9Key$ = "C", F10Key$ = "D"
CONST F11Key$ = "…", F12Key$ = "†", AltD$ = " "

DIM SHARED Stab1(-511 TO 511), Stab2(-511 TO 511), Asynchronous
DIM SHARED direction, Influence, Speed, Backwards, PalSlide, I1, j1
DIM SHARED PlasmaType

'Seed the psuedo-random number generator with the current time.
DEF SEG = &H40
NewSeed& = PEEK(&H6C) + PEEK(&H6D) * 256& + PEEK(&H6E) * 65536
DEF SEG
NewSeed# = NewSeed& * 64& ^ 4& ' convert to huge integer
RANDOMIZE NewSeed#
 
SCREEN 13                               ' VGA Mode 320x200
OUT &H3D4, 9: OUT &H3D5, 3              'change to 320x100 mode

I1 = CINT(RND * 511) 'starting influence
j1 = CINT(RND * 511) 'starting speed
direction = Original: Influence = CINT(RND * 15): Speed = CINT(RND * 15)
Asynchronous = FALSE: Backwards = FALSE: PalSlide = FALSE: PlasmaType = 0

MakePal
MakeTable
SLEEP 1: CLS
DO

    K$ = UCASE$(INKEY$)

    IF direction = Original THEN
       I1 = I1 + Influence    ' i1 and j1 influence, original
       j1 = j1 - Speed        ' speed of plasma
       IF I1 >= 511 THEN I1 = -511
       IF j1 <= -511 THEN j1 = 511
    ELSE
       I1 = I1 - Influence    ' i1 and j1 influence, other
       j1 = j1 + Speed        ' speed of plasma
       IF I1 <= -511 THEN I1 = 511
       IF j1 >= 511 THEN j1 = -511
    END IF
   
    IF Debug = TRUE THEN 'show stats, slows down plasma ? >:}
       DBG
    END IF
  
    FOR y = 9 TO 89                   ' 9 -> 89 pixels vertical
        i2 = Stab1((y + I1) MOD 255)
        j2 = Stab1(ABS(j1))
        FOR x = 10 TO 149             ' 10 -> 149 pixels horizontal
            c1 = x - i2: c2 = y - j2' get color
            IF c1 < -511 THEN c1 = -511 'prevent underflow
            IF c1 > 511 THEN c1 = 511   'prevent overflow
            IF c2 < -511 THEN c2 = -511 'prevent underflow
            IF c2 > 511 THEN c2 = 511   'prevent overflow
            c = Stab1(c1) + Stab2(c2)
            y8 = y: y6 = y: x1 = x
            y9 = LSHIFT%(y8, 8): y10 = LSHIFT%(y6, 6): x7 = LSHIFT%(x1, 1)
            Address = y9 + y10 + x7    ' get pixel offset
            PokeWord &HA000, Address, c      ' This is fast !
            PokeWord &HA000, Address + 1, c  ' write 2nd pixel >8)
        NEXT x
    NEXT y

    SELECT CASE RIGHT$(K$, 1)
    CASE AltD$: Debug = NOT Debug
         IF Debug = FALSE THEN CLS
    CASE F1Key$: direction = NOT direction 'alter direction
    CASE F2Key$: Asynchronous = NOT Asynchronous 'change table generator sub type
    CASE F3Key$: Speed = Speed + 1         'more speed
         IF Speed >= 15 THEN Speed = 15
    CASE F4Key$: Speed = Speed - 1         'less speed
         IF Speed <= 0 THEN Speed = 0
    CASE F5Key$: Influence = Influence + 1 'more influence
         IF Influence >= 15 THEN Influence = 15
    CASE F6Key$: Influence = Influence - 1 'less influence
         IF Influence <= 0 THEN Influence = 0
    CASE F7Key$: PlasmaType = PlasmaType + 1 'change table generator main type
         IF PlasmaType > 2 THEN PlasmaType = 0
         LOCATE 1, 1: PRINT STRING$(40, 32);
         LOCATE 1, 1: PRINT "Plasma type:"; STR$(PlasmaType) + AltD$ + "Sub type:";
         IF Asynchronous = FALSE THEN
            PRINT AltD$ + "0";
         ELSE
            PRINT AltD$ + "1";
         END IF
         SLEEP 1: LOCATE 1, 1: PRINT STRING$(40, 32);
    CASE CHR$(66)  'set direction of palette sliding,
         'Backwards = FALSE - forward rotation
         'Backwards = TRUE - backward rotation
       Backwards = NOT Backwards
       'write colors again to prevent replicative fading
       FOR ColorWrite = 0 TO 255
         PalGet ColorWrite, rd%, gn%, be%
         PalSet ColorWrite, rd%, gn%, be%
       NEXT ColorWrite
    CASE CHR$(73) 'Invert Palette
         FOR IPal = 0 TO 255
         PalGet IPal, rd%, gn%, be%
         PalSet IPal, NOT rd%, NOT gn%, NOT be%
         NEXT IPal
    CASE CHR$(78) 'new Palette
         MakePal
    CASE CHR$(80): PalSlide = NOT PalSlide 'Palette sliding on
    CASE CHR$(84) 'new SIN/COS table
         MakeTable
         SLEEP 1: CLS
    END SELECT
   
    'do palette sliding if enabled
    IF PalSlide = TRUE THEN GOSUB MovePalette

LOOP UNTIL K$ = CHR$(27)
SCREEN 0, 1                             ' back to text mode
END

MovePalette:
IF Backwards = FALSE THEN
   PalGet 0, ored1%, ogrn1%, oblu1%
   FOR T% = 0 TO 254  'This loop rotates the palette outward (forward).
     PalGet T% + 1, red%, grn%, blu%
     PalSet T%, red%, grn%, blu%
   NEXT T%
   PalSet 255, ored1%, ogrn1%, oblu1%
ELSE
   PalGet 255, ored%, ogrn%, oblu%
   FOR T% = 254 TO 0 STEP -1 'This loop rotates the palette inward (Backward).
       PalGet T%, red%, grn%, blu%
       PalSet T% + 1, red%, grn%, blu%
   NEXT
   PalSet 0, ored%, ogrn%, oblu%
END IF
RETURN

SUB DBG
LOCATE 1, 1: PRINT STRING$(40, 32); : LOCATE 1, 1: PRINT "D: ";
IF direction = Original THEN PRINT "Fwd";  ELSE PRINT "Bwd";
PRINT AltD$ + "Spd:" + STR$(Speed) + AltD$; "Inf:" + STR$(Influence) + AltD$;
PRINT "i1:" + STR$(I1) + AltD$ + "j1:" + STR$(j1);
LOCATE 2, 1: PRINT "A"; : LOCATE 3, 1: PRINT "s"; : LOCATE 4, 1: PRINT "y"; : LOCATE 5, 1: PRINT "n";
LOCATE 6, 1: PRINT "c"; : LOCATE 7, 1: PRINT "-"; : LOCATE 2, 2: PRINT "P"; : LOCATE 3, 2: PRINT "S";
LOCATE 4, 2: PRINT "l"; : LOCATE 5, 2: PRINT "i"; : LOCATE 6, 2: PRINT "d"; : LOCATE 7, 2: PRINT "-";
IF Asynchronous = FALSE THEN
   LOCATE 8, 1: PRINT "N"; : LOCATE 9, 1: PRINT "o"; : LOCATE 10, 1: PRINT AltD$;
ELSE
   LOCATE 8, 1: PRINT "Y"; : LOCATE 9, 1: PRINT "e"; : LOCATE 10, 1: PRINT "s";
END IF
IF PalSlide = FALSE THEN
   LOCATE 8, 2: PRINT "N"; : LOCATE 9, 2: PRINT "o"; : LOCATE 10, 2: PRINT AltD$;
ELSE
   LOCATE 8, 2: PRINT "Y"; : LOCATE 9, 2: PRINT "e"; : LOCATE 10, 2: PRINT "s";
END IF
LOCATE 2, 39: PRINT "P"; : LOCATE 3, 39: PRINT "S"; : LOCATE 4, 39: PRINT "L";
LOCATE 5, 39: PRINT "D"; : LOCATE 6, 39: PRINT "i"; : LOCATE 7, 39: PRINT "r";
LOCATE 8, 39: PRINT "-"; : LOCATE 10, 39: : PRINT "w"; : LOCATE 11, 39: PRINT "d";
IF Backwards = FALSE THEN
   LOCATE 9, 39: PRINT "F";
ELSE
   LOCATE 9, 39: PRINT "B";
END IF
END SUB

SUB MakePal
Half = CINT(RND * 127) * 2: Full = CINT(RND * 254) * 2
FOR x = 0 TO 255                       ' set palette
    x3 = x: x2 = x: x1 = x
    x4 = RSHIFT%(x3, 3): x5 = RSHIFT%(x2, 2): x6 = RSHIFT%(x1, 1)
    PalSet x, x4, x, x * 2
    PalSet Half - x, x4, x, x
    PalSet Half + x, x, x5, x6 \ 3
    PalSet Full - x, x, x5, x6 \ 3
NEXT
END SUB

SUB MakeTable
CLS : LOCATE 1, 1: PRINT "Making new Table..."
SELECT CASE PlasmaType
  CASE 0 'normal varies from lake to twisty taffy, original
    PRINT "Normal varies from lake to twisty taffy,"
    IF Asynchronous = FALSE THEN
       PRINT "original standard symmetry. "; : PRINT "(SIN/COS)"
       Half = CINT(RND * 255) 'standard symmetry
       FOR x = -511 TO 511 ' make table
       Stab1(x) = SIN(2 * PI# * x / 255) * Half '128, used to be that
       Stab2(x) = COS(2 * PI# * x / 255) * Half
       NEXT x
    ELSE
       PRINT "original standard asymmetry. "; : PRINT "(SIN/COS)"
       Half1 = CINT(RND * 255): Half2 = CINT(RND * 255) 'standard asymmetry
       FOR x = -511 TO 511 ' make table
       Stab1(x) = SIN(2 * PI# * x / 255) * Half1 '128, used to be that
       Stab2(x) = COS(2 * PI# * x / 255) * Half2
       NEXT x
    END IF
  CASE 1 'striated using ATN/COS
    PRINT "Multi-striated, ";
    IF Asynchronous = FALSE THEN
       PRINT "symmetry. "; : PRINT "(Curvy)"; : PRINT "(ATN/COS)";
       PRINT "Scenery changes."
       Half = CINT(RND * 255) 'striated symmetry
       FOR x = -511 TO 511 'make table
       Stab1(x) = ATN(2 * PI# * x / 255) * Half '128, used to be that
       Stab2(x) = COS(2 * PI# * x / 255) * Half
       NEXT x
    ELSE
       PRINT "asymmetry. "; : PRINT "(Curvy)"; : PRINT "(ATN/COS)";
       PRINT "Scenery changes."
       Half1 = CINT(RND * 255): Half2 = CINT(RND * 255) 'striated asymmetry
       FOR x = -511 TO 511 ' make table
       Stab1(x) = ATN(2 * PI# * x / 255) * Half1 '128, used to be that
       Stab2(x) = COS(2 * PI# * x / 255) * Half2
       NEXT x
    END IF
  CASE 2 'striated using ATN/SIN
    PRINT "Land & Horizon ";
    IF Asynchronous = FALSE THEN
       PRINT "symmetry. "; : PRINT "(Curvy)"; : PRINT "(ATN/SIN)";
       PRINT "Scenery changes."
       Half = CINT(RND * 255) 'striated symmetry
       FOR x = -511 TO 511 'make table
       Stab1(x) = ATN(2 * PI# * x / 255) * Half '128, used to be that
       Stab2(x) = SIN(2 * PI# * x / 255) * Half
       NEXT x
    ELSE
       PRINT "asymmetry. "; : PRINT "(Curvy)"; : PRINT "(ATN/SIN)";
       PRINT "Scenery changes."
       Half1 = CINT(RND * 255): Half2 = CINT(RND * 255) 'striated asymmetry
       FOR x = -511 TO 511 ' make table
       Stab1(x) = ATN(2 * PI# * x / 255) * Half1 '128, used to be that
       Stab2(x) = SIN(2 * PI# * x / 255) * Half2
       NEXT x
    END IF
'  CASE 3
'    PRINT "Land & Horizon ";
'    IF Asynchronous = FALSE THEN
'       PRINT "symmetry. "; : PRINT "(Curvy)"; : PRINT "(ATN/TAN)";
'       PRINT "Scenery changes.";
'       Half = CINT(RND * 255) 'striated symmetry
'       FOR x = -511 TO 511 'make table
'       Stab1(x) = ATN(2 * PI# * x / Half) * Half '128, used to be that
'       Stab2(x) = TAN(2 / PI# * x / Half) * Half
'       NEXT x
'    ELSE
'       PRINT "asymmetry. "; : PRINT "(Curvy)"; : PRINT "(ATN/TAN)";
'       PRINT "Scenery changes.";
'       Half1 = CINT(RND * 255): Half2 = CINT(RND * 255)                          'striated asymmetry
'       FOR x = -511 TO 511 ' make table
'       Stab1(x) = ATN(2 * PI# * x / Half1) * Half1 '128, used to be that
'       Stab2(x) = TAN(16384 / PI# * x / Half2) * Half2
'       NEXT x
'    END IF
END SELECT
END SUB

SUB PalGet (c%, r%, g%, b%)
OUT &H3C7, c%: r% = INP(&H3C9): g% = INP(&H3C9): b% = INP(&H3C9)
END SUB

SUB PalSet (c%, r%, g%, b%)
OUT &H3C8, c%: OUT &H3C9, r%: OUT &H3C9, g%: OUT &H3C9, b%
END SUB

SUB PokeInteger (Addr, Word)
'Bytes$ = MKI$(Word)
'First$ = LEFT$(Bytes$, 2): Second$ = RIGHT$(Bytes$, 2)
'IF First$ = "" THEN B1 = ASC(CHR$(0)) ELSE B1 = ASC(First$)
'IF Second$ = "" THEN B2 = ASC(CHR$(0)) ELSE B2 = ASC(Second$)
'POKE Addr, B1: POKE Addr + 1, B2
END SUB