'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
Plasma effect for PowerBASIC