'===========================================================================
' Subject: REALTIME PLASMA FOR PB            Date: 06-18-98 (12:31)       
' Author:  Dieter Folger                     Code: PB                     
' Origin:  folger@bamberg.baynet.de        Packet: GRAPHICS.ABC
'===========================================================================
   '-----------------------------------------------
   ' PLASMA.BAS for Power Basic 3.x (Public Domain)
   '-----------------------------------------------
   ' 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
   '-----------------------------------------------
   DEFINT A-Z
   DIM Stab1?(0:255),Stab2?(0:255)
   Setmode                               ' VGA Mode 320x200
   FOR x=0 TO 63                         ' set palette
       x3 = x : x2 = x : x1 = x
       SHIFT RIGHT x3,3 : SHIFT RIGHT x2,2 : SHIFT RIGHT x1,1
       Setpal x,    x3,x,x
       Setpal 127-x,x3,x,x
       Setpal 127+x,x,x2,x1\3
       Setpal 254-x,x,x2,x1\3
   NEXT
   FOR x = 0 TO 255                      ' make table
       Stab1?(x) = CBYT(SIN(2 * 3.14159 * x/255)*128)
       Stab2?(x) = CBYT(COS(2 * 3.14159 * x/255)*128)
   NEXT
   i1? = 40
   j1? = 90
   DO
       K$=INKEY$
       INCR i1?                          ' i1 and j1 influence
       DECR j1?                          ' speed of plasma
       FOR y = 9 TO 89                   ' 9 -> 89 pixels vertical
           i2? = Stab1?((y+i1?) MOD 255)
           j2? = Stab1?(j1?)
           FOR x = 10 TO 149             ' 10 -> 149 pixels horizontal
               c1?= x-i2? : c2? = y-j2?  ' get color
               c? = Stab1?(c1?) + Stab2?(c2?)
               y8 = y : y6 = y : x1 = x
               SHIFT LEFT y8,8 : SHIFT LEFT y6,6 : SHIFT LEFT x1,1
               Address = y8 + y6 + x1    ' get pixel offset
               DEF SEG = &hA000          ' VGA segment
                   POKEI Address, c?     ' write 2 pixels
               DEF SEG
           NEXT
       NEXT
   LOOP UNTIL LEN(K$)
   SCREEN 1                              ' back to text mode
   END
   '----------
   SUB Setmode
   '----------
   !  mov ax,&h13
   !  int &h10
   !  mov dx,&h3D4
   !  mov al,9
   !  out dx,al
   !  inc dx
   !  in  al,dx
   !  and al,&h0E0
   !  add al,3
   !  out dx,al
   END SUB
   '--------------------------------------------------------------------------
   SUB Setpal(BYVAL c AS Byte,BYVAL r AS Byte,BYVAL g AS Byte,BYVAL b AS Byte)
   '--------------------------------------------------------------------------
   !  mov dx,&h3C8
   !  mov al,c
   !  out dx,al
   !  inc dx
   !  mov al,r
   !  out dx,al
   !  mov al,g
   !  out dx,al
   !  mov al,b
   !  out dx,al
   END SUB
   '=== eof ==================================================================