Plasma effect for PowerBASIC 
Author Message
 Plasma effect for PowerBASIC

'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



Tue, 11 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC
Is it really necessary to post these demo's on this newsgroup?  Similar
things can be found in the ABC packets...

--
|\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\|

|/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/|



Wed, 12 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC

Quote:

>Is it really necessary to post these demo's on this newsgroup?  Similar
>things can be found in the ABC packets...

So what?  
If you do not like free source code, don't read the email.  
I had to read yours and am not complaining...

Quote:
>--
>|\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\|

>|/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/|

The Missing Link
P.O,Box 9865 San Jose, CA 95157



Thu, 13 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC

Quote:

> Is it really necessary to post these demo's on this newsgroup?  Similar
> things can be found in the ABC packets...

I think It is a good idea.  I don't even use PB but I always read
through the demos from Dave

Phil



Thu, 13 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC

Quote:


>> Is it really necessary to post these demo's on this newsgroup?  Similar
>> things can be found in the ABC packets...

>I think It is a good idea.  I don't even use PB but I always read
>through the demos from Dave

>Phil

Whew!  At least YOUR reply was friendly!  Well, I guess it doesn't really
matter...  I read those FAQs and see so many people trying to stop binary
posting that I begin to think it's a crime :>.

--
|\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\|

|/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/|

P.S.
I didn't really look at it.  Now that I read it more closely, I see that
he has included remarks.  The more the remarks, the less the binary...



Thu, 13 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC
E-Mail?  What E-Mail?

--
|\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\|

|/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/|



Thu, 13 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC

 > Is it really necessary to post these demo's on this newsgroup?  Similar
 > things can be found in the ABC packets...

Yes its is!
I like to see those small demo's.
Bram.

--
Its (c)PciMail and (c)PciNews !
Virtual Simulations.                    Home of:
Play by Mail/E-Mail.                    Resolve Conflict, VGA Planets
PO.Box 479  2980 AL  Ridderkerk         Wargames, Nexus, Pollux
The Netherlands                         Dutch registration site for pollux

                                        http://www.xs4all.nl/~vsim
--------------------------------------------------------------------------



Fri, 14 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC

Quote:
> Is it really necessary to post these demo's on this newsgroup?  Similar
> things can be found in the ABC packets...

Similar yes.  But the stuff I found in ABC does not run in powerbasic without
modification.  And the stuff I posted was not exactly the same.  It's always
nice to see how different people accomplish the same result.  It helps
programmers grow (at least those of us who enjoy seeing source code from
others).

It amazes me that someone wouldn't want free source code.  I guess now I've
seen it all.

--Dave



Fri, 14 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC

Quote:
>> Is it really necessary to post these demo's on this newsgroup?  Similar
>> things can be found in the ABC packets...

><SNIP>
>It amazes me that someone wouldn't want free source code.  I guess now I've
>seen it all.

>--Dave

Dave, please don't ever allow yourself to be put off by such comments,
as the one above, made by the author referring to the "ABC packets".
Your input (and source code!) is valued. I look forward to it.

*BASIC coding for one and all*

I'm out of here,
Laurence



Fri, 14 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC

Quote:
> Dave, please don't ever allow yourself to be put off by such comments,
> as the one above, made by the author referring to the "ABC packets".
> Your input (and source code!) is valued. I look forward to it.

> *BASIC coding for one and all*

Not to worry, I'll continue to post lots of source code as time permits.

--Dave



Fri, 14 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC

Quote:

> Path:

news.pi.net!surfnet.nl!swsbe6.switch.ch!swidir.switch.ch!in2p3.fr!univ-lyon1.fr
!jussieu.fr!math.ohio-state.edu!howland.reston.ans.net!newsfeed.internetmci.com
!chi-news.cic.net!ddsw1!news.mcs.net!bug.rahul.net!rahul.net!a2i!hustle.rahul.n
et!rahul.net!a2i!news
Quote:

> Newsgroups: comp.lang.basic.misc,alt.lang.basic
> Subject: Re: Plasma effect for PowerBASIC
> Date: Sun, 25 Feb 1996 02:42:37 GMT
> Organization: The Missing Link
> Lines: 21



> NNTP-Posting-Host: 811.rahul.net
> X-Newsreader: Forte Free Agent 1.0.82
> Xref: news.pi.net comp.lang.basic.misc:7240 alt.lang.basic:4094


> >Is it really necessary to post these demo's on this newsgroup?  Similar
> >things can be found in the ABC packets...

> So what?  
> If you do not like free source code, don't read the email.  
> I had to read yours and am not complaining...

> >--
> >|\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\|

> >|/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/|

> The Missing Link
> P.O,Box 9865 San Jose, CA 95157


Right


Sat, 15 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC

The last line of the last functio gives the error: assembly syntax error or
something like that. that line is something like !mov FUNCTION,al

Can anybody help me out ?  I'd really like to make it work.



Sat, 15 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC

Quote:

> The last line of the last functio gives the error: assembly syntax error or

> something like that. that line is something like !mov FUNCTION,al

> Can anybody help me out ?  I'd really like to make it work.

The source requires PowerBASIC 3.2, what version of PowerBASIC do you have?

--Dave

--
PowerBASIC, Inc.       |  Try PowerBASIC 3 for yourself and see why it was
316 Mid Valley Center  |  chosen by PC Magazine Editors as the Best DOS
Carmel, Ca  93923      |  Basic compiler for its unlimited string space,
(800) 780-7707 Orders  |  built-in assembler, built-in array sorting, and
(408) 659-8000 Voice   |  more.  And now PowerBASIC does Windows!  We are
(408) 659-8008 Fax     |  now shipping the PB/DLL compiler for Visual Basic!



Sat, 15 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC

Quote:

>The last line of the last functio gives the error: assembly syntax error or
>something like that. that line is something like !mov FUNCTION,al
>Can anybody help me out ?  I'd really like to make it work.

It works okay in PB 3.2....

              Marc van den Dikkenberg
                       -----

           <http://www.xs4all.nl/~excel>



Sat, 15 Aug 1998 03:00:00 GMT  
 Plasma effect for PowerBASIC

Quote:

> 1) Well, *I* enjoy and appreciate the posts. Alot better than some I have seen
> in some of these NEWSGROUPS. Car ads, anti gay bashing, sales ads, etc. all in
> programming news groups.

> BASIC source in a BASIC news group -  Sounds like the right place to me!

Thanks Ed.  Good to see ya on the net.

--Dave



Tue, 18 Aug 1998 03:00:00 GMT  
 
 [ 18 post ]  Go to page: [1] [2]

 Relevant Pages 

1. Playing sound effects in PowerBasic

2. create a fade effect or any other effect like morph between two open forms

3. Creating Plasma Screens

4. Plasma clouds

5. Plasma graphic?

6. Plasma in QBasic 4.50

7. Plasma Generators

8. Coding plasmas...

9. Plasma in vb

10. Cheap Plasma TV N8

11. URGENT - Effects of the worm virus on Access DB

 

 
Powered by phpBB® Forum Software