'===========================================================================
' Subject: PB PLASMA                         Date: 02-23-96 (20:23)       
' Author:  Dave Navarro, Jr.                 Code: PB                     
' Origin:  comp.lang.basic.misc            Packet: GRAPHICS.ABC
'===========================================================================
'PBPLASMA converted from Pascal by unknown CompuServe author
'
'Minor enhancements by Dave Navarro, Jr:
'  Integers are faster than bytes.
'  Integer divide (\) is faster than floating point divide (/).
'  I experimented with changing Rough! to fixed point BCD and
'  got some really strange results when playing with FIXDIGITS.

$optimize speed
$float procedure     'use fast math
$lib all off         'you don't need any

defint a-z

Max.x=319
Max.y=199        'screen size
Max.color=255    'number of colors to use
Rough!=2         'how "rough" you want the plasma to be.

TYPE RGBType
  R AS BYTE
  G AS BYTE
  B AS BYTE
END TYPE

DIM PAL(512) as RGBType

SHARED Max.x, Max.y, Rough!, Max.color, pal()

EXIT FAR AT Finish

IF ISFALSE IsVGA% THEN Print "No VGA found":END

randomize timer

Mode13Set

MakePalette             'build a smooth palette

Set13pixel 0, 0, (rnd*Max.color)+1          'set the corners
Set13pixel 0, Max.Y, (rnd*Max.color)+1
Set13pixel Max.x, 0, (rnd*Max.color)+1
Set13pixel Max.x, Max.Y, (rnd*Max.color)+1

'use Set13Pixel to plant "seed" pixels here, if wanted

t#=timer
Splitbox 0, 0, Max.x, Max.y
t#=timer-t#

ropal                    'rotate the palette

finish:
 textmode
 cls
 print t#
end



SUB Splitbox (x1, y1, x2, y2)            'this is the main subroutine
                                         '
  if (x2-x1<2) and (y2-y1<2) then exit sub
  if instat then exit far         'any key quits program
  x=(x1+x2)\2
  y=(y1+y2)\2
  Newcolor x1, y1, x, y1, x2, y1
  Newcolor x2, y1, x2, y, x2, y2
  Newcolor x1, y2, x, y2, x2, y2
  Newcolor x1, y1, x1, y, x1, y2
  if get13pixel(x,y) = 0 then
    colour = 
(get13pixel(x1,y1)+get13pixel(x2,y1)+get13pixel(x2,y2)+get13pixel(x1,y2))\4
      if colour < 1 then colour = 1
      if colour > Max.color then colour = Max.color
      Set13pixel x, y, colour
  end if
  Splitbox x1, y1, x, y
  Splitbox x, y1, x2, y
  Splitbox x, y, x2, y2
  Splitbox x1, y, x, y2
END SUB

SUB Newcolor (xa, ya, x, y, xb, yb)       'puts a new color based on 
average
                                          'of surrounding pixels plus a
                                          'random value
  if get13pixel(x,y) <> 0 then exit sub
  avg = Abs(xa-xb)+Abs(ya-yb)
  colour = (get13pixel(xa,ya)+get13pixel(xb,yb))\2 + ((rnd-0.5) * avg * 
rough!)
  if colour < 1 then colour = 1
  if colour > Max.color then colour = Max.color
  Set13Pixel x, y, colour
END SUB

SUB Makepalette      'this builds a 255 smooth color palette
                     'note it does nothing with color 0
                     'I didn't want the boarder to change.
                     'this loads an array with 511 RGB values.

  for c% = 1 to 63     'from red to yellow, start with one
    cn%=63-c%
    PAL(c%).R = 63
    PAL(c%).G = c%
    PAL(c%).B = 0
  next c%
  for c% = 0 to 63
    cn%=63-c%
    ci%=c%+64
    PAL(ci%).R = cn%    'yellow to blue
    PAL(ci%).G = cn%
    PAL(ci%).B = c%
  next c?
  for c = 0 to 63
    cn%=63-c%
    ci%=c%+128
    PAL(ci%).R = 0
    PAL(ci%).G = c
    PAL(ci%).B = 63      'blue to cyan(blue and green)
  next c
  for c = 0 to 63
    cn%=63-c%
    ci%=c%+192
    PAL(ci%).R = c       'cyan to red
    PAL(ci%).G = cn?
    PAL(ci%).B = cn?
  next c?

  for c = 1 to Max.color           'copy array to second half
    col? = PAL(c).R
    PAL(c+Max.color).R = col?
    col? = PAL(c).G
    PAL(c+Max.color).G = col?
    col? = PAL(c).B
    PAL(c+Max.color).B = col?
  next c
  for x = 1 to Max.color             'actual VGA palette setting code
    out &h3c8,x                'attribute   from red to yellow
    out &h3c9, PAL(x).R        'red?
    out &h3c9, PAL(x).G        'green?
    out &h3c9, PAL(x).B        'blue?
  next x
END SUB

SUB RoPal         'this "rotates" the palette for animation
                  'rather than moving the RGB data, I build two
                  'copies, and loop through both.
do
for i = 0 to Max.color
  for x = 1 to Max.color
    if instat then exit far         'any key quits program
    out &h3c8,x                  'attribute
    out &h3c9, PAL(x+i).R        'red?
    out &h3c9, PAL(x+i).G        'green?
    out &h3c9, PAL(x+i).B        'blue?
  next x?
next i
loop                           'loop until quit
END SUB

FUNCTION IsVGA%                'test for VGA
  ' Function: returns VGA status
  IsVGA% = bit(pbvScrnCard,5)
END FUNCTION

SUB Mode13Set    'set 320x200 256 color mode
 ! mov ax,&h13
 ! int &h10
END SUB

SUB TextMode     'sets text mode, resets palette
 ! mov ax,3
 ! int &h10
END SUB


SUB Set13Pixel (BYVAL X%, BYVAL Y%, BYVAL Colr%)
               'fast pixel plot
  ! mov ax,&hA000
  ! mov es,ax        ;es = VGA graphics memory
  ! mov cx,X%
  ! mov dx,Y%
  ! mov al,Byte Ptr Colr%
  ! xchg dl,dh       ;dx= y*256
  ! mov di,dx
  ! shr di,1
  ! shr di,1         ;di=y*64
  ! add di,dx        ;di=y*320
  ! add di,cx        ;di=y*320+x, i.e. pixel address
  ! mov es:[di],al   ;put pixel in VGA memory
END SUB

FUNCTION Get13Pixel% (BYVAL X%, BYVAL Y%)
  ! mov ax,&hA000
  ! mov es,ax        ;es = VGA graphics memory
  ! mov cx,X%
  ! mov dx,Y%
  ! xchg dl,dh       ;dx= y*256
  ! mov di,dx
  ! shr di,1
  ! shr di,1         ;di=y*64
  ! add di,dx        ;di=y*320
  ! add di,cx        ;di=y*320+x, i.e. pixel address
  ! mov al,es:[di]   ;get pixel from VGA memory
  ! xor ah, ah
  ! mov FUNCTION,al
END FUNCTION