'===========================================================================
' Subject: FAST PLASMA GENERATOR             Date: 05-24-97 (15:20)       
' Author:  Daniel Davies                     Code: QB, QBasic, PDS        
' Origin:  ia53@rapid.co.uk                Packet: GRAPHICS.ABC
'===========================================================================
'                    FAST PLASMA GENERATION IN QBASIC
'                            BY DANIEL DAVIES
'                        E-MAIL : ia53@rapid.co.uk
'
'                   originally Released 15th june 1996
'
'  * Introduction *
'
' This is a demonstration of how to do plasma effects on the PC in QBASIC
' it isn't very fast compared to the routines they use in demos coded in
' languages like C, Pascal, and assembler, but it's still faster than most
' generators for Q-Basic, the only exception that I've seen is another of
' my plasmas which can do this in real time when it's compiled.
'
'  * Disclaimer *
'
' I am responsible for nothing!   The program has been throughly tested
'
' I AM IN NO WAY RESPONSIBLE FOR ANY DAMAGE CAUSED BY THE USE OR MISUSE OF
' THIS SOFTWARE. NEITHER AM I RESPONSIBLE FOR ANY LOSS OF EARNINGS OR DAMAGE
' CAUSED BY THE USE OF THIS SOFTWARE. IT IS A GUIDE AND SHOULD NOT BE USED AS
' THE ONLY SOURCE OF INFORMATION.
'
'  * Operation *
'
' Operation is simple! Just load it up in qbasic and then run it
'
'  * Distribution *
'
' You are encouraged to copy this program and share it with others.  If you
' can personally pass this program to another BBS I would be most grateful.
'
'  * How is the effect is acheived? *
'
' To make the simplest type of plasma, get a full spread of colours down the
' screen, so that the top line is dark, and the bottom line is light. The
' sine wave acts on these colors and you've made your first plasma. it works
' by calculating the value of the sine across the screen, and then adding
' them to the colours so if the value is high the colour is darker, and if the
' value is 0 then the colour doesn't change, but if the value is below zero it
' gets lighter.
' This isn't the type of plasma used in this program because it's too boring.
' There are much cooler plasma affects to be had than the above like the one
' in this prog, in this you take two sine waves, one along each axes (X and Y,
' or if you prefer up and down) and then modify the colours accordingly.

'*************************** Declare Subroutines *****************************
'declare all subs/functions
DECLARE SUB palgen ()
DECLARE SUB MakePal (col%(), x%, y%)
DECLARE SUB setpal ()
DECLARE SUB cyclepal ()
DECLARE SUB getcolours ()
DECLARE SUB resetcolours ()
'*****************************************************************************

'***************************** Set Screen Mode *******************************
'set the screen to mode 13 so we've got loads of colours to play with
SCREEN 13
'*****************************************************************************

'*************************** Set Size Of Arrays ******************************
'set arrays for colour cycling
DIM SHARED RED%(512)
DIM SHARED GREEN%(512)
DIM SHARED BLUE%(512)

'set arrays for current values of all colours so that we can reset them
'to there exact values
DIM SHARED STARTCOLRED%(256)
DIM SHARED STARTCOLGREEN%(256)
DIM SHARED STARTCOLBLUE%(256)

'setting the sizes for sine lookup tables
DIM SINTAB1%(0 TO 360)
DIM SINTAB2%(0 TO 360)
'*****************************************************************************

'********************* Initialise Everything For The Program *****************
'call routine to get current colours
CALL getcolours

'generate some random numbers to make the sine table different every time
'and hence the plasma different
RANDOMIZE TIMER
q% = INT(RND * 25) + 1
s1a = (RND(1) * 20) + 55
s1b = (RND(1) * 10) + 20
s2a = (RND(1) * 20) + 55
s2b = (RND(1) * 8) + 11

'tell them what were up to
PRINT "calculating sine lookup table"
PRINT "percent finished "
'calculate the sine lookup tables
'we need two because the screen is modified along the X and Y axes
'we generate a lookup table because Qbasics Sin command is so slow
FOR z% = 0 TO 360
x% = z% + q%
SINTAB1%(z%) = 5 * (((35 * SIN(x% / s1a)) + (15 * SIN(x% / s1b))))
SINTAB2%(z%) = 10 * (((27 * SIN(x% / s2a)) + (6 * SIN(x% / s2b))))
LOCATE 2, 18
fin% = (.27777777777# * z%)
PRINT fin%; "%"
NEXT z%
CLS
setpal
'*****************************************************************************


'********************** Do The Hard Work To Make The Plasma ******************
'now for the creation of the plasma
FOR b% = 0 TO 200
FOR a% = 0 TO 320
col% = ((SINTAB2%(b%) + (((SINTAB1%(a%) + b%) MOD 254) + 1)) MOD 254) + 1
PSET (a%, b%), col%
NEXT a%
NEXT b%
'*****************************************************************************

'*************** Do Any Fancy Tricks Like rotating the pallette **************
'call the routine to cycle the pallette
CALL cyclepal
'*****************************************************************************

'***************************** Clean Everything ******************************
'clean everything up ready for exit
CALL resetcolours
SCREEN 0
WIDTH 80, 25
'*****************************************************************************


'************************************ DATA ***********************************
'now to give some pallete definitions so we don't have to use the crudy standard
'vga pallete
DATA 15,15,15,16,15,15,18,15,15,19,14,14,21,14,14,22,13,13,24,13,13,25,12,12,27,12,12
DATA 28,11,11,30,11,11,32,10,10,33,10,10,35,9,9,36,9,9,38,8,8,39,8,8,41,7,7,42,7,7
DATA 44,6,6,45,6,6,47,5,5,49,5,5,50,4,4,52,4,4,53,3,3,55,3,3,56,2,2,58,2,2,59,1,1,61,1,1
DATA 63,0,0,63,1,0,63,3,0,63,5,0,63,7,0,63,9,0,63,11,0,63,13,0,63,15,0,63,17,0,63,19,0
DATA 63,21,0,63,23,0,63,25,0,63,27,0,63,29,0,63,31,0,63,33,0,63,35,0,63,37,0,63,39,0
DATA 63,41,0,63,43,0,63,45,0,63,47,0,63,49,0,63,51,0,63,53,0,63,55,0,63,57,0,63,59,0
DATA 63,61,0,63,63,0,63,63,1,63,63,3,63,63,5,63,63,7,63,63,9,63,63,11,63,63,13,63,63,15
DATA 63,63,17,63,63,19,63,63,21,63,63,23,63,63,25,63,63,27,63,63,29,63,63,31,63,63,33
DATA 63,63,35,63,63,37,63,63,39,63,63,41,63,63,43,63,63,45,63,63,47,63,63,49,63,63,51
DATA 63,63,53,63,63,55,63,63,57,63,63,59,63,63,61,63,63,63,63,63,63,63,62,62,63,62,61
DATA 63,61,60,63,61,59,63,60,58,63,60,57,63,59,56,63,59,55,63,58,54,63,58,53,63,57,52
DATA 63,57,51,63,56,50,63,56,49,63,55,48,63,55,47,63,54,46,63,54,45,63,53,44,63,53,43
DATA 63,52,42,63,52,41,63,51,40,63,51,39,63,50,38,63,50,37,63,49,36,63,49,35,63,48,34
DATA 63,48,33,63,47,32,63,46,31,63,46,30,63,45,29,63,45,28,63,44,27,63,44,26,63,43,25
DATA 63,43,24,63,42,23,63,42,22,63,41,21,63,41,20,63,40,19,63,40,18,63,39,17,63,39,16
DATA 63,38,15,63,38,14,63,37,13,63,37,12,63,36,11,63,36,10,63,35,9,63,35,8,63,34,7
DATA 63,34,6,63,33,5,63,33,4,63,32,3,63,32,2,63,31,1,63,30,0,63,30,0,63,29,0,63,28,0
DATA 63,27,0,63,26,0,63,25,0,63,24,0,63,23,0,63,22,0,63,21,0,63,20,0,63,19,0,63,18,0
DATA 63,17,0,63,16,0,63,15,0,63,15,0,63,14,0,63,13,0,63,12,0,63,11,0,63,10,0,63,9,0
DATA 63,8,0,63,7,0,63,6,0,63,5,0,63,4,0,63,3,0,63,2,0,63,1,0,63,0,0,63,0,0,62,0,0
DATA 61,0,0,61,0,0,60,0,0,59,0,0,58,0,0,58,0,0,57,0,0,56,0,0,56,0,0,55,0,0,54,0,0
DATA 53,0,0,53,0,0,52,0,0,51,0,0,51,0,0,50,0,0,49,0,0,48,0,0,48,0,0,47,0,0,46,0,0
DATA 46,0,0,45,0,0,44,0,0,43,0,0,43,0,0,42,0,0,41,0,0,40,0,0,40,0,0,39,1,1,38,1,1
DATA 37,2,2,36,2,2,35,3,3,35,3,3,34,4,4,33,4,4,32,5,5,31,5,5,30,6,6,30,6,6,29,7,7
DATA 28,7,7,27,8,8,26,8,8,25,9,9,25,9,9,24,10,10,23,10,10,22,11,11,21,11,11,20,12,12
DATA 20,12,12,19,13,13,18,13,13,17,14,14,16,14,14,15,15,15,15,15,15,15,15,15
DATA 999,999,999

SUB cyclepal
'Cycle the pallete

RESTORE
SPEED% = 1
  a% = 0
 
  DO
  READ r%, g%, b%
  IF r% = 999 THEN EXIT DO
  RED%(a%) = r%
  GREEN%(a%) = g%
  BLUE%(a%) = b%
  a% = a% + 1
  LOOP

  FOR b% = 0 TO 255
  RED%(a% + b%) = RED%(b%)
  GREEN%(a% + b%) = GREEN%(b%)
  BLUE%(a% + b%) = BLUE%(b%)
  NEXT

 p% = 0
 OUT &H3C6, 255
 DO
 OUT &H3C7, 15
 
  FOR c% = 0 TO 255
  OUT &H3C9, RED%(c% + p%)
  OUT &H3C9, GREEN%(c% + p%)
  OUT &H3C9, BLUE%(c% + p%)
  NEXT c%


  p% = p% + SPEED%

  SELECT CASE p%
  CASE IS < a%
  WAIT &H3DA, 8
  WAIT &H3DA, 8
  WAIT &H3DA, 8
  WAIT &H3DA, 8

  CASE ELSE
  p% = 0

  END SELECT

  z$ = INKEY$
  z$ = UCASE$(z$)
  IF z$ = "1" THEN SPEED% = 1
  IF z$ = "2" THEN SPEED% = 2
  IF z$ = "3" THEN SPEED% = 3
  IF z$ = "4" THEN SPEED% = 4
  IF z$ = "5" THEN SPEED% = 5
  IF z$ = "6" THEN SPEED% = 6
  IF z$ = "7" THEN SPEED% = 7
  IF z$ = "8" THEN SPEED% = 8
  IF z$ = "9" THEN SPEED% = 9
  IF z$ = "0" THEN SPEED% = 0
  IF z$ = "Q" THEN GOTO endofplascolourcycling:
  IF z$ = "P" THEN palgen
  IF z$ = "R" THEN setpal
  LOOP
endofplascolourcycling:


END SUB

SUB getcolours
FOR a% = 0 TO 255

OUT &H3C8, a%
STARTCOLRED%(a%) = INP(&H3C9)
STARTCOLGREEN%(a%) = INP(&H3C9)
STARTCOLBLUE%(a%) = INP(&H3C9)
NEXT a%

END SUB

DEFINT A-Z
SUB MakePal (col%(), x%, y%)
RANDOMIZE TIMER
  z% = (x% + y%) \ 2
  IF col%(z%) >= 0 THEN EXIT SUB
  q% = ABS(x% - y%) \ 8
  c% = (col%(x%) + col%(y%)) \ 2 + INT((RND * 3) - 1) * q%
  IF c% < 0 THEN c% = 0
  IF c% > 63 THEN c% = 63
  col%(z%) = c%
  MakePal col%(), x%, z%
  MakePal col%(), y%, z%
END SUB

DEFSNG A-Z
SUB palgen
FOR a% = 0 TO 255
RED%(a%) = -1: GREEN%(a%) = -1: BLUE%(a%) = -1
NEXT a%

RANDOMIZE TIMER
RED%(0) = INT(RND * 63)
RANDOMIZE TIMER
GREEN%(0) = INT(RND * 63)
RANDOMIZE TIMER
BLUE%(0) = INT(RND * 63)
RANDOMIZE TIMER
RED%(255) = RED%(0) + INT((RND * 3) - 1)
RANDOMIZE TIMER
GREEN%(255) = GREEN%(0) + INT((RND * 3) - 1)
RANDOMIZE TIMER
BLUE%(255) = BLUE%(0) + INT((RND * 3) - 1)

MakePal RED%(), 0, 255
MakePal GREEN%(), 0, 255
MakePal BLUE%(), 0, 255

'define the pallette
FOR a% = 0 TO 255
OUT &H3C8, a%
OUT &H3C9, RED%(a%)
OUT &H3C9, GREEN%(a%)
OUT &H3C9, BLUE%(a%)
NEXT a%

  FOR b% = 0 TO 255
  RED%(a% + b%) = RED%(b%)
  GREEN%(a% + b%) = GREEN%(b%)
  BLUE%(a% + b%) = BLUE%(b%)
  NEXT

END SUB

SUB resetcolours

FOR a% = 0 TO 255
OUT &H3C8, a%
OUT &H3C9, STARTCOLRED%(a%)
OUT &H3C9, STARTCOLGREEN%(a%)
OUT &H3C9, STARTCOLBLUE%(a%)
NEXT a%

END SUB

SUB setpal

RESTORE
'define the pallette
FOR a% = 0 TO 255
READ RED%(a%), GREEN%(a%), BLUE%(a%)
OUT &H3C8, a%
OUT &H3C9, RED%(a%)
OUT &H3C9, GREEN%(a%)
OUT &H3C9, BLUE%(a%)
NEXT a%
 
  FOR b% = 0 TO 255
  RED%(a% + b%) = RED%(b%)
  GREEN%(a% + b%) = GREEN%(b%)
  BLUE%(a% + b%) = BLUE%(b%)
  NEXT

END SUB