Une petite flambée pour l'hivers

Sujets variés concernant le développement en PureBasic
Répondre
filperj
Messages : 395
Inscription : jeu. 22/janv./2004 1:13

Une petite flambée pour l'hivers

Message par filperj »

Un grand classique, celui-là!

Code : Tout sélectionner


#ScrW=320
#ScrH=240
#Moder=1

If InitSprite()And InitPalette() And InitKeyboard() And OpenScreen(#ScrW,#ScrH,8,"Feu")
  CreatePalette(0)
  For c=0 To 127
    SetPaletteColor(c,RGB(c,c,c))
  Next
  For c=128 To 239
    SetPaletteColor(c,240)
  Next
  For c=240 To 255
    SetPaletteColor(c,RGB(c,(c-240)*(255/15),0))
  Next
  DisplayPalette(0)
  Structure ScrLine
    x.b[#ScrW]
  EndStructure
  Structure VirtuScr
    y.ScrLine[#ScrH+1]
  EndStructure
  Global VirtuScr.VirtuScr
  Repeat
    Scrop=ScreenOutput()
    If Scrop And StartDrawing(Scrop)
      For y=2 To #ScrH
        VirtuScr\y[y-2]\x[0]=(VirtuScr\y[y-1]\x[0]+VirtuScr\y[y]\x[0]+VirtuScr\y[y]\x[1]+VirtuScr\y[y]\x[#ScrW-1])/4+#Moder
        VirtuScr\y[y-2]\x[#ScrW-1]=(VirtuScr\y[y]\x[#ScrW-2]+VirtuScr\y[y]\x[#ScrW-1]+VirtuScr\y[y-1]\x[#ScrW-1]+VirtuScr\y[y]\x[0])/4+#Moder
        For x=1 To #ScrW-2
          VirtuScr\y[y-2]\x[x]=(VirtuScr\y[y]\x[x-1]+VirtuScr\y[y]\x[x]+VirtuScr\y[y]\x[x+1]+VirtuScr\y[y-1]\x[x])/4+#Moder
        Next
        CopyMemory(@VirtuScr\y[y-2],DrawingBuffer()+DrawingBufferPitch()*(y-2),SizeOf(ScrLine))
      Next
      CopyMemory(@VirtuScr\y[#ScrH-1],DrawingBuffer()+DrawingBufferPitch()*(#ScrH-1),SizeOf(ScrLine))
      StopDrawing()
    EndIf
    For x=0 To #ScrW-1
      ;VirtuScr\y[#ScrH-1]\x[x]=Random(255) <- le compilo traduit mal cette expression ??
      PokeB(@VirtuScr\y[#ScrH]\x[x],Random(255))
    Next
    FlipBuffers()
    While IsScreenActive()=0
      Delay(20)
      FlipBuffers()
    Wend
    ExamineKeyboard()
  Until KeyboardReleased(#PB_Key_Escape)
EndIf

Petite variation:

Code : Tout sélectionner


#ScrW=320   ;résolution d'écran
#ScrH=240
#Moder=-3   ;fait varier le "rythme"

If InitSprite()And InitPalette() And InitKeyboard() And OpenScreen(#ScrW,#ScrH,8,"Feu")
  CreatePalette(0)
  For c=0 To 63
    SetPaletteColor(c,RGB(c/2,c/2,c/2))
  Next
  For c=64 To 191
    SetPaletteColor(c,RGB(c-32,c/2,32))
  Next
  For c=192 To 255
    SetPaletteColor(c,RGB(c-32,96-(192-c),32))
  Next
  DisplayPalette(0)
  Structure ScrLine
    x.b[#ScrW]
  EndStructure
  Structure VirtuScr
    y.ScrLine[#ScrH+1]
  EndStructure
  Global VirtuScr.VirtuScr
  RandomSeed(ElapsedMilliseconds()) 
  Repeat
    Scrop=ScreenOutput()
    If Scrop And StartDrawing(Scrop)
      For y=1 To #ScrH-1
        VirtuScr\y[y-1]\x[0]=(VirtuScr\y[y+1]\x[0]+VirtuScr\y[y]\x[0]+VirtuScr\y[y]\x[1]+VirtuScr\y[y]\x[#ScrW-1])/4+#Moder
        VirtuScr\y[y-1]\x[#ScrW-1]=(VirtuScr\y[y+1]\x[#ScrW-1]+VirtuScr\y[y]\x[#ScrW-2]+VirtuScr\y[y]\x[#ScrW-1]+VirtuScr\y[y]\x[0])/4+#Moder
        For x=1 To #ScrW-2
          VirtuScr\y[y-1]\x[x]=(VirtuScr\y[y+1]\x[x]+VirtuScr\y[y]\x[x-1]+VirtuScr\y[y]\x[x]+VirtuScr\y[y]\x[x+1])/4+#Moder
        Next
        CopyMemory(@VirtuScr\y[y-1],DrawingBuffer()+DrawingBufferPitch()*(y-1),SizeOf(ScrLine))
      Next
      CopyMemory(@VirtuScr\y[#ScrH-1],DrawingBuffer()+DrawingBufferPitch()*(#ScrH-1),SizeOf(ScrLine))
      StopDrawing()
    EndIf
    For x=0 To #ScrW-1
      ;VirtuScr\y[#ScrH-1]\x[x]=Random(255) <- le compilo traduit mal cette expression ??
      PokeB(@VirtuScr\y[#ScrH]\x[x],Random(Randomer))
    Next
    RandomerBase=RandomerBase+1
    If RandomerBase&512
      Randomer=(~RandomerBase>>1)&255
    Else
      Randomer=(RandomerBase>>1)&255
    EndIf
    FlipBuffers()
    While IsScreenActive()=0
      Delay(20)
      FlipBuffers()
    Wend
    ExamineKeyboard()
  Until KeyboardReleased(#PB_Key_Escape)
EndIf
C'est zouli, non? :lol:
Le chaos l'emporte toujours sur l'ordre
parcequ'il est mieux organisé.
(Ly Tin Wheedle)
Haut
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :
Contacter Le Soldat Inconnu

Message par Le Soldat Inconnu »

Extra :D
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Haut
Oliv
Messages : 2117
Inscription : mer. 21/janv./2004 18:39

Message par Oliv »

Très Zouli
Haut
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

ça ressemble à un larsen video en bas de l'ecran.
Haut
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

saviez vous que FRED avait codé ça !

(bougez la souris !! ) :D

Code : Tout sélectionner

; English forum: 
; Author: Fred  (based on GPI's code)
; Date: 

#ScreenWidth  = 640
#ScreenHeight = 480


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)
                    
                    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<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 
                        
                        ;   Structure Byte     ; structure already declared in PB3.70+
                        ;     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
; ExecutableFormat=Windows
; FirstLine=1
; DisableDebugger
; EOF
Haut
filperj
Messages : 395
Inscription : jeu. 22/janv./2004 1:13

Message par filperj »

:D Très intéressant !
Le chaos l'emporte toujours sur l'ordre
parcequ'il est mieux organisé.
(Ly Tin Wheedle)
Haut
julien
Messages : 846
Inscription : ven. 30/janv./2004 15:06
Contact :
Contacter julien

Message par julien »

ça rechauffe !! Houu :D
Haut
filperj
Messages : 395
Inscription : jeu. 22/janv./2004 1:13

Message par filperj »

Le post de Dobro m'a donné des idées:
bougez la souris en maintenant le bouton gauche enfoncé pour dessiner
barre espace pour effacer

Code : Tout sélectionner


#ScrW=320*2
#ScrH=240*2

#Blanc=255-191
#Noir=255-128
#BobSouris=0
Declare CreePointeur(NumSpr.l)
Declare Dessine(x,y,etat)

If InitSprite()And InitPalette() And InitKeyboard() And InitMouse() And OpenScreen(#ScrW,#ScrH,8,"Feu")
  CreatePalette(0)
  For c=0 To 63
    SetPaletteColor(255-c,RGB(255,c*4,0))
  Next
  For c=64 To 127
    c2=(127-c)*4
    SetPaletteColor(255-c,RGB(c2,c2,0))
  Next
  For c=128 To 191
    c2=(c-128)*4
    SetPaletteColor(255-c,RGB(c2,c2,c2))
  Next
  For c=192 To 255
    c2=(255-c)
    SetPaletteColor(255-c,RGB(c2*4,c2*4,c2*3+64))
  Next
  DisplayPalette(0)
  Structure ScrLine
    x.b[#ScrW]
  EndStructure
  Structure VirtuScr
    y.ScrLine[#ScrH+2]
  EndStructure
  Global VirtuScr.VirtuScr
  Global Heater.VirtuScr
  CreePointeur(#BobSouris)
  Repeat
    ExamineKeyboard() : ExamineMouse()
    Dessine(MouseX(),MouseY(),MouseButton(1))
    Scrop=ScreenOutput()
    If Scrop And StartDrawing(Scrop)
      For y=0 To #ScrH-1
        xdep=Random(1)
        xfin=#ScrW+xdep-2
        dkx=1-2*xdep
        For x=xdep To xfin
          If Heater\y[y]\x[x]
            VirtuScr\y[y]\x[x]=255
          Else
            coul=(((VirtuScr\y[y+1]\x[x]&255)+(VirtuScr\y[y+1]\x[x+dkx]&255))+((VirtuScr\y[y+2]\x[x]&255)+(VirtuScr\y[y+2]\x[x+dkx]&255)))/4
            If coul
              VirtuScr\y[y]\x[x]=coul-1
            Else
              VirtuScr\y[y]\x[x]=coul
            EndIf
          EndIf
        Next
        CopyMemory(@VirtuScr\y[y],DrawingBuffer()+DrawingBufferPitch()*(y),SizeOf(ScrLine))
      Next
      StopDrawing()
    EndIf
    DisplayTransparentSprite(#BobSouris,MouseX(),MouseY())
    FlipBuffers()
    While IsScreenActive()=0
      Delay(20)
      FlipBuffers()
    Wend
    If KeyboardPushed(#PB_Key_Space)
      rtlzeromemory_(@Heater,SizeOf(VirtuScr))
    EndIf
  Until KeyboardReleased(#PB_Key_Escape)
EndIf



Procedure CreePointeur(NumSpr.l)
  CreateSprite(NumSpr,16,16)
  If StartDrawing(SpriteOutput(NumSpr))
    Buffer=DrawingBuffer()
    Pitch=DrawingBufferPitch()
    rtlfillmemory_(Buffer,16,#Noir)
    For y=1 To 14
      PokeB(Buffer+y*Pitch,#Noir)
      rtlfillmemory_(Buffer+y*Pitch+1,15-y,#Blanc)
      PokeB(Buffer+y*Pitch+15-y,#Noir)
    Next
    PokeB(Buffer+15*Pitch,#Noir)
    StopDrawing()
  EndIf
EndProcedure


Procedure Dessine(x,y,etat)
  Static oldx,oldy,oldetat
  If etat
    If oldetat
      If x<oldx
        xdep=x
        ydep=y
        xfin=oldx
        yfin=oldy
      Else
        xdep=oldx
        ydep=oldy
        xfin=x
        yfin=y
      EndIf
      oldx=x
      oldy=y
      diffx=xfin-xdep
      diffy=yfin-ydep
      If diffx>Abs(diffy)
        For x=xdep To xfin
          y=((x-xdep)*diffy)/diffx+ydep
          Heater\y[y]\x[x]=255
        Next
      ElseIf diffy
        If diffy<0
          pasy=-1
        Else
          pasy=1
        EndIf
        y=ydep
        Repeat
          x=((y-ydep)*diffx)/diffy+xdep
          Heater\y[y]\x[x]=255
          y+pasy
        Until y=yfin+pasy
      Else
        Heater\y[y]\x[x]=255
      EndIf
    Else
      oldx=x
      oldy=y
      oldetat=1
    EndIf
  Else
    oldetat=0
  EndIf
EndProcedure
Le chaos l'emporte toujours sur l'ordre
parcequ'il est mieux organisé.
(Ly Tin Wheedle)
Haut
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :
Contacter comtois

Message par comtois »

Wow , c'est super 8O
Haut
Oliv
Messages : 2117
Inscription : mer. 21/janv./2004 18:39

Message par Oliv »

Je me suis brulé :roll:
Haut
cookie
Messages : 71
Inscription : mar. 27/janv./2004 21:08
Contact :
Contacter cookie

Message par cookie »

dans le même esprit de feu:

Code : Tout sélectionner

If InitSprite() = 0
    MessageRequester("Erreur","Erreur: nécessite DX7 ou supérieur",0)
EndIf
If InitKeyboard() = 0
    MessageRequester("Erreur","Erreur: nécessite DX7 ou supérieur",0)
EndIf
If OpenScreen(640,480,16,"") 

SetRefreshRate(60)

;///////
y.w=0 
x.w=0 
screen_width.w=640 
screen_height.w=480 
Dim cool.w(screen_width,screen_height) 
Dim buf.w(screen_width,screen_height) 
yy.w=0 
xx.w=0 
For v=1 To screen_height-1 
  For u=1 To screen_width-1 
    cool(u,v)=Random(3) 
    buf(u,v)=0 
  Next u 
Next v 

Dim color(255) 
For i=0 To 84 
color(i)=Int(255/84*i)+0<<8+0<<16 
color(i+85)=255+Int(255/84*i)<<8+0<<16 
color(i+85+85)=255+255<<8+Int(255/84*i)<<16 
Next i 

;////////////
Repeat
  FlipBuffers()
  

 ExamineKeyboard() 
 ;///////////////
 StartDrawing(ScreenOutput()) 
  For y=1 To screen_height-1 
    For x=1 To screen_width-1 
      If buf(x,y) > 0 
        If buf(x,y) < 0 
          buf(x,y)=0 
        Else 
          buf(x,y)=((buf(x+1,y)+buf(x-1,y)+buf(x,y+1)+buf(x,y-1))/4-cool(x,y)) 
        EndIf        
        buf(x,y-1)=buf(x,y) 
        cool(x,y-1)=cool(x,y) 
        cool(x,y)=Random(3) 
        If buf(x,y) > 0 
          Plot(x,y,color(buf(x,y))) 
        EndIf 
      EndIf 
      buf(x,screen_height-2)=255 
    Next x 
  Next y 
  StopDrawing() 
;//////////////////////// 
  
Until KeyboardPushed(#PB_Key_Escape)



Else
  MessageRequester("Erreur","Erreur: Impossible d'afficher en plein écran",0)
EndIf
emprunté à une démo de Dreglor
Cookie
Haut
Répondre

Revenir à « Discussion générale »