Set on Fire by GPI

Share your advanced PureBasic knowledge/code with the community.
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by GPI.

A little grafik-Demo.
(Is this the right forum?)

EDIT: code cut out, because newer versions are below /edit

It runs fast enought on my PC!

PII 333, 256MB, Asus TNT2Ultra 32MB, AWE Gold 64 4MB
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by Henrik.

Me Likes GPI's fire ;o)
coulden't stop playing with fire for 20 min.
Maybe there should be a section on realmedia for demos, beta-apps and other fun stuff like the games latly here on the forum, like the ones not yet finnished (Polix's , Tomcat's, Freak's and Epyx's)

Just my thought, have to play with fire now ;o)
cya

best regards
henrik ------>
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by Num3.

Cool Fire...

Huh.. Huh...

--
Kind Regards
Rui Carvalho

Old programmers never die... They branch into a subroutine...
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by fred.

Yeah, very fun to play with .

Here the same code with modifiable screen dimensions (for speed testing) and Poke replacement with pointer for faster access.

Code: Select all

#ScreenWidth  = 320
#ScreenHeight = 240


Dim col(#ScreenWidth,#ScreenHeight)
Dim hotspot(#ScreenWidth,#ScreenHeight)

If InitSprite()
  If InitKeyboard()
    If OpenScreen(#ScreenWidth,#ScreenHeight,8,"PureFire")
      If InitPalette(255)
        If InitMouse()
          MouseLocate(160,100)
      
CreatePalette(0)
For i=0 To 63
  SetPaletteColor(i,RGB(i*4,0,0))
Next 
For i=0 To 63
  SetPaletteColor(i+64,RGB(255,i*4,0))
Next
For i=0 To 63
  SetPaletteColor(i+64+64,RGB(255,255,i*4))
Next
SetPaletteColor(255,RGB(255,255,255))


DisplayPalette(0) 
UsePalette(0)

StartDrawing(ScreenOutput())

LoadFont(0,"Van Dijk",30)
text$="Set on Fire by GPI"
DrawingFont(FontID())
DrawingMode(1)
FrontColor(255,255,255)
Locate((320-TextLength(text$))>>1,#ScreenHeight-1-60)
DrawText(text$)
CloseFont(0)

LineXY(0,#ScreenHeight-1,#ScreenWidth-1,#ScreenHeight-1)


For y=0 To #ScreenHeight-1
  For x=0 To #ScreenWidth-1
    If Point(x,y)>0
      hotspot(x,y)=1
    EndIf
  Next
Next
StopDrawing()
 
;For y=195 To #ScreenHeight-1
;  For x=0 To #ScreenWidth-1
;    hotspot(x,y)=random(2)
;  Next
;Next
      

dodown=0:dodownmax=1
Repeat
  dodown+1:If dodown=dodownmax:dodown=0:EndIf
  For y=0 To #ScreenHeight-1
    For x=0 To #ScreenWidth-1
      If hotspot(x,y)
        col(x,y)=Random(255)
      EndIf
    Next
  Next
  
  ;mouse
  hotspot(MouseX(),MouseY())=1
  
  For NY=1 To #ScreenHeight-1 
    nym1=ny-1:If nym1#ScreenHeight-1:nyp1=#ScreenHeight-1:EndIf
    For NX=0 To #ScreenWidth-1
      nxm1=nx-1:If nxm1#ScreenWidth-1:nxp1=#ScreenWidth-1:EndIf 
      
      A=col(NXp1,NY) 
      B=col(NXm1,NY)
      C=col(NX,NYp1)
      D=col(NX,NYm1)
      
      E=col(NXm1,NYm1) 
      F=col(NXp1,NYm1)
      G=col(NXm1,NYp1) 
      H=col(NXp1,NYp1)
    
      i=(A+B+C+D+E+F+G+H)>>3
      If dodown=0
        i-Random(1)
      EndIf
      If i191:i=191:EndIf
      
      col(nx,ny-1)=i
      
    Next 
  Next 
  
  Structure Byte
    b.b
  EndStructure
  
  StartDrawing(ScreenOutput())
  adr=DrawingBuffer()
  add=DrawingBufferPitch()
  For y=0 To #ScreenHeight-1
    *adr2.Byte=adr
    For x=0 To #ScreenWidth-1
      If hotspot(x,y)
        *adr2\b = 100 : *adr2+1
      Else
        *adr2\b = col(x,y) : *adr2+1
      EndIf
    Next
    adr+add
  Next
  StopDrawing()
  ExamineMouse()  
  ExamineKeyboard() 
  FlipBuffers() 
Until KeyboardPushed(#PB_Key_All)

        EndIf
      EndIf
    EndIf
  EndIf
EndIf

Fred - AlphaSND
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by GPI.

Here my new version:
Play with the constants at the beginning.

Code: Select all

#realx=320:#realy=200

#aufx=320:#aufy=200
;#aufx=640:#aufy=480
;#aufx=512:#aufy=384

#dodownmax=1  ; high of the flames (0=small 2=very big)
#downsub=5    ; dito+flicker (0=high flames, no flicker ,10=small high flicker)


If #realx>1,#aufy-1-Int(60/200*#aufy) )
DrawText(text$)
CloseFont(0)

LineXY(0,#aufy-1,#aufx-1,#aufy-1)


For y=0 To #aufy-1
  For x=0 To #aufx-1
    If Point(x,y)>0
      hotspot(x,y)=1
    EndIf
  Next
Next
StopDrawing()
     

dodown=0
Repeat
  dodown+1:If dodown>=#dodownmax:dodown=0:EndIf
  
  ;mouse
  mx=MouseX():my=MouseY()
  If mx>#aufx-1:mx=#aufx-1:EndIf
  If my>#aufy-1:my=#aufy-1:EndIf
  If hotspot(MX,MY)=0
    hotspot(MX,MY)=col(mX,mY)+1
  EndIf
  
  
  
  For NY=#aufy-1 To 0 Step -1 
    nym1=ny;:If nym1#aufy-1:nyn =#aufy-1:EndIf
    nyp1=ny+2:If nyp1>#aufy-1:nyp1=#aufy-1:EndIf
    For NX=0 To #aufx-1
      If hotspot(nx,ny)
        a=col(nx,ny)
        b=hotspot(nx,ny)
        If a=b : b=Random(330)+20:hotspot(nx,ny)=b:EndIf
        If a+10b:b=a-10:EndIf
        col(nx,ny)=b
      Else
        nxm1=nx-1:If nxm1#aufx-1:nxn =#aufx-1:EndIf
        nxp1=nx+1:If nxp1>#aufx-1:nxp1=#aufx-1:EndIf 
        
        A=col(NXp1,NYn) 
        B=col(NXm1,NYn)
        C=col(NXn,NYp1)
        D=col(NXn,NYm1)
        
        E=col(NXm1,NYm1) 
        F=col(NXp1,NYm1)
        G=col(NXm1,NYp1) 
        H=col(NXp1,NYp1)
        j=col(nxn ,nyn)
      
        i=Int((A+B+C+D+E+F+G+H+j)/9)
        If dodown=0
          CompilerIf #downsub=254:i=254:EndIf
        
        col(nx,ny)=i
      EndIf
    Next 
  Next 
;  hotspot(MouseX(),MouseY())=0
    
  StartDrawing(ScreenOutput())
  adr=DrawingBuffer()
  add=DrawingBufferPitch()
  
  Structure Byte
    b.b
  EndStructure
  
  For y=0 To #aufy-1
    *adr2.byte=adr
    For x=0 To #aufx-1
      If hotspot(x,y)
        *adr2\b=255:*adr2+1
      Else
        a=col(x,y):If a>254:a=254 :EndIf
        *adr2\b=a:*adr2+1
      EndIf
    Next
    adr+add
  Next
  StopDrawing()
  ExamineMouse()  
  ExamineKeyboard() 
  FlipBuffers() 
Until KeyboardPushed(#PB_Key_All)

        EndIf
      EndIf
    EndIf
  EndIf
EndIf


PII 333, 256MB, Asus TNT2Ultra 32MB, AWE Gold 64 4MB
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by GPI.

I think, this would my last version:

Code: Select all

#realx=1024:#realy=768
;#realx=800:#realy=600
;#realx=640:#realy=480
;#realx=512:#realy=384
;#realx=400:#realy=300
;#realx=320:#realy=240
;#realx=320:#realy=200

;#aufx=320:#aufy=200
;#aufx=640:#aufy=480
;#aufx=512:#aufy=384
;#aufx=400:#aufy=300
#aufx=#realx:#aufy=#realy

#updown=1 ; 0 or 1 Calculate from up to down (1) or down to up (0)

#mouselen=100 ; waittime, before the old mousepoints are deleted

#hotspotadd=0 ; Change the brightness of the hotspots

#dodownmax=0  ; high of the flames (0=small 2=very big)
#downsub=0    ; dito+flicker (0=high flames, no flicker ,10=small high flicker)

text$="Set on Fire by GPI" ; the text ;""=nowtext
#line=0

Structure Byte
  b.b
EndStructure
  
If #realx""
  LoadFont(0,"Van Dijk",30)
  DrawingFont(FontID())
  DrawingMode(1)
  FrontColor(255,255,255)
  Locate((#aufx-TextLength(text$))>>1,#aufy-1-Int(60/200*#aufy) )
  DrawText(text$)
  CloseFont(0)
EndIf

CompilerIf #line
  LineXY(0,#aufy-1,#aufx-1,#aufy-1)
CompilerEndIf

For y=0 To #aufy-1
  For x=0 To #aufx-1
    If Point(x,y)>0
      hotspot(x,y)=1
    EndIf
  Next
Next
StopDrawing()

     

dodown=0:count=0
Repeat
  CompilerIf #dodownmax>0
    dodown+1:If dodown>#dodownmax:dodown=0:EndIf
  CompilerEndIf
  count+1:If count>#mouselen:count=0:EndIf
  
  
  
  ;mouse
  quit=0
  While FirstElement(m())>0 And quit=0
    If m()\c=count
      hotspot(m()\x,m()\y)=0
      DeleteElement(m())
    Else
      quit=1
    EndIf
  Wend    
  mx=MouseX():my=MouseY()
  If mx>#aufx-1:mx=#aufx-1:EndIf
  If my>#aufy-1:my=#aufy-1:EndIf
  If omxmx Or omymy
    ax=omx-mx:If axay:ab=ax:Else:ab=ay:EndIf
    ax=omx-mx:ay=omy-my
    For i=1 To ab
      xx=mx+Int(ax*i/ab)
      yy=my+Int(ay*i/ab)
      If hotspot(xX,yY)=0
        LastElement(m())
        AddElement(m())
        m()\x=xx
        m()\y=yy
        m()\c=count
        hotspot(xX,yY)=col(xX,yY)+1
      EndIf
    Next
    omx=mx:omy=my
  EndIf
   
  
  StartDrawing(ScreenOutput())
  CompilerIf #updown
    adr=DrawingBuffer()
    add=DrawingBufferPitch()
    
    For NY=0 To #aufy-1
    
  CompilerElse
    sub=DrawingBufferPitch()
    adr=DrawingBuffer()+sub*(#aufy-1)
    
    For NY=#aufy-1 To 0 Step -1
    
  CompilerEndIf
  
    ny1 =ny+1:If ny1 >#aufy-1:ny1=#aufy-1:EndIf
    ny2 =ny+2:If ny2 >#aufy-1:ny2=#aufy-1:EndIf
    
    *adr2.byte=adr
    
    For NX=0 To #aufx-1
      nx1=nx-1:If nx1#aufx-1:nx3=#aufx-1:EndIf 
        
      i=Int( (col(nx1,ny1)+col(nx,ny1)+col(nx3,ny1)+col(nx1,ny2)+col(nx,ny2)+col(nx3,ny2))/6 )
      If dodown=0
        CompilerIf #downsub=254:i=254:EndIf
        
      If hotspot(nx,ny)
        a=col(nx,ny)
        b=hotspot(nx,ny)
        If a=b : b=Random(330)+20:hotspot(nx,ny)=b:EndIf
        If a+10b:b=a-10:EndIf
        col(nx,ny)=b
        
        i+#hotspotadd
        If i255:i=255:EndIf
        
      Else  
        col(nx,ny)=i
        
        If i>254:i=254:EndIf
      EndIf
      
      *adr2\b=i:*adr2+1
      
    Next 
    CompilerIf #updown
      adr+add
    CompilerElse
      adr-sub
    CompilerEndIf
    
  Next 
  StopDrawing()
  
  ExamineMouse()  
  ExamineKeyboard() 
  FlipBuffers() 
Until KeyboardPushed(#PB_Key_All)

End

PII 333, 256MB, Asus TNT2Ultra 32MB, AWE Gold 64 4MB
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by TronDoc.

Pretty cool! And only 22k .exe!!
I didn't now that I could draw with the
mouse in it the first time I tried it..
..am I supposed to see a cursor for the mouse?
Joe B.

elecTRONics DOCtor
{registeredPB}P150 32Mb w98/DOS/Linux NO DirX NO IE :wink:
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by GPI.

The mouse weren't show, if you open a screen.
Also i think, it doesn't look good with a mousecursor on the screen.

btw: play with the constant/variables at the beginning.

PII 333, 256MB, Asus TNT2Ultra 32MB, AWE Gold 64 4MB
Fred
Administrator
Administrator
Posts: 18252
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Post by Fred »

Same code slighty modified for v3.94:

Code: Select all

#ScreenWidth  = 320
#ScreenHeight = 240


Dim col(#ScreenWidth,#ScreenHeight)
Dim hotspot(#ScreenWidth,#ScreenHeight)

If InitSprite()
  If InitKeyboard()
    If OpenScreen(#ScreenWidth,#ScreenHeight,8,"PureFire")
      If InitPalette()
        If InitMouse()
          MouseLocate(160,100)
     
CreatePalette(0)
For i=0 To 63
  SetPaletteColor(i,RGB(i*4,0,0))
Next
For i=0 To 63
  SetPaletteColor(i+64,RGB(255,i*4,0))
Next
For i=0 To 63
  SetPaletteColor(i+64+64,RGB(255,255,i*4))
Next
SetPaletteColor(255,RGB(255,255,255))


DisplayPalette(0)
UsePalette(0)

LoadFont(0,"Van Dijk",30)
StartDrawing(ScreenOutput())
text$="Set on Fire by GPI"
DrawingFont(FontID())
DrawingMode(1)
FrontColor(255,255,255)
Locate((320-TextLength(text$))>>1,#ScreenHeight-1-60)
DrawText(text$)

LineXY(0,#ScreenHeight-1,#ScreenWidth-1,#ScreenHeight-1)


For y=0 To #ScreenHeight-1
  For x=0 To #ScreenWidth-1
    If Point(x,y)>0
      hotspot(x,y)=1
    EndIf
  Next
Next
StopDrawing()

CloseFont(0)
 
;For y=195 To #ScreenHeight-1
;  For x=0 To #ScreenWidth-1
;    hotspot(x,y)=random(2)
;  Next
;Next
     

dodown=0:dodownmax=1
Repeat
  dodown+1:If dodown=dodownmax:dodown=0:EndIf
  For y=0 To #ScreenHeight-1
    For x=0 To #ScreenWidth-1
      If hotspot(x,y)
        col(x,y)=Random(255)
      EndIf
    Next
  Next
 
  ;mouse
  hotspot(MouseX(),MouseY())=1
 
  For NY=1 To #ScreenHeight-1
    nym1=ny-1:If nym1<0:nym1=0:EndIf
    nyp1=ny+1:If nyp1>#ScreenHeight-1:nyp1=#ScreenHeight-1:EndIf
    For NX=0 To #ScreenWidth-1
      nxm1=nx-1:If nxm1<0:nxm1=0:EndIf
      nxp1=nx+1:If nxp1>#ScreenWidth-1:nxp1=#ScreenWidth-1:EndIf
     
      A=col(NXp1,NY)
      B=col(NXm1,NY)
      C=col(NX,NYp1)
      D=col(NX,NYm1)
     
      E=col(NXm1,NYm1)
      F=col(NXp1,NYm1)
      G=col(NXm1,NYp1)
      H=col(NXp1,NYp1)
   
      i=(A+B+C+D+E+F+G+H)>>3
      If dodown=0
        i-Random(1)
      EndIf
      If i<0:i=0:EndIf
      If i>191:i=191:EndIf
     
      col(nx,ny-1)=i
     
    Next
  Next
 
 
  StartDrawing(ScreenOutput())
  adr=DrawingBuffer()
  add=DrawingBufferPitch()
  For y=0 To #ScreenHeight-1
    *adr2.Byte=adr
    For x=0 To #ScreenWidth-1
      If hotspot(x,y)
        *adr2\b = 100 : *adr2+1
      Else
        *adr2\b = col(x,y) : *adr2+1
      EndIf
    Next
    adr+add
  Next
  StopDrawing()
  ExamineMouse() 
  ExamineKeyboard()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_All)

        EndIf
      EndIf
    EndIf
  EndIf
EndIf
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Thanks Fred - hadn't seen this one before.

cheers
Intrigued
Enthusiast
Enthusiast
Posts: 501
Joined: Thu Jun 02, 2005 3:55 am
Location: U.S.A.

Post by Intrigued »

I remember viewing this before... it gives me ideas again.

Thanks for sharing.

:)
Intrigued - Registered PureBasic, lifetime updates user
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Post by Psychophanta »

8 bitplanes seems to not work in modern VGA (i am trying on a ATI radeon 9600). Is there a way to downgrade a VGA to accept 8 (or less) bitplanes screen modes?
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
KarLKoX
Enthusiast
Enthusiast
Posts: 681
Joined: Mon Oct 06, 2003 7:13 pm
Location: France
Contact:

Post by KarLKoX »

It is working fine for me (Nvidia 7900 GT), try upgrading your gpu drivers.
"Qui baise trop bouffe un poil." P. Desproges

http://karlkox.blogspot.com/
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Post by Psychophanta »

Here is impossible to open a correct 320x240x8 screen! :?
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
KarLKoX
Enthusiast
Enthusiast
Posts: 681
Joined: Mon Oct 06, 2003 7:13 pm
Location: France
Contact:

Post by KarLKoX »

Try a dxdiag and see wich resolution and bpp your video card support, if it is listed and the pb code is not working, then it might be a gpu video card drivers bug.
"Qui baise trop bouffe un poil." P. Desproges

http://karlkox.blogspot.com/
Post Reply