PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Zozieaux

http://forums.purebasic.com/french/viewtopic.php?t=2684

Page 1 sur 1

Zozieaux

Publié : sam. 09/avr./2005 19:41
par filperj
Je me suis amusé à coller bout-à-bout quelques effets en mode 8 bits, et à balancer de pauvres oiseaux au milieu...
Appuyez sur la barre espace pour changer la palette de couleurs.
Vous pouvez modifier les constantes #scrw et #scrh pour changer la résolution.
Débogueur déconseillé (ça rame trop)

Code : Tout sélectionner



;#scrw=320*2 : #scrh=240*2
;#scrw=800 : #scrh=600
#scrw=1024 : #scrh=768
;#scrw=1920 : #scrh=1200



Procedure prepal()
   CreatePalette(0)
   For c=0 To 255
      SetPaletteColor(c,RGB(c,c,c))
   Next
   CreatePalette(1)
   For c=0 To 255
      SetPaletteColor(255-c,RGB(c/2,c/3,255-c))
   Next
   CreatePalette(2)
   For c=0 To 63
      SetPaletteColor(c,RGB(c*4,c*4,c*2+128))
   Next
   For c=64 To 127
      n=(127-c)*4
      SetPaletteColor(c,RGB(n,n,n))
   Next
   For c=128 To 191
      SetPaletteColor(c,RGB((c-128)*4,(c-128)*4,0))
   Next
   For c=192 To 255
      SetPaletteColor(c,RGB(255,(255-c)*4,0))
   Next
   CreatePalette(3)
   For c=0 To 255
      SetPaletteColor(c,$ffffff*(c&1))
   Next
   CreatePalette(4)
   For c=0 To 31
      l=(c>>3)*50
      r=(c>>2)&1
      v=(c>>1)&1
      b=c&1
      SetPaletteColor(c,RGB(r*105+l,v*105+l,b*105+l))
   Next
   For c=32 To 255
      l=(c&31)*8
      r=c>>7
      v=(c>>6)&1
      b=(c>>5)&1
      SetPaletteColor(c,RGB(r*l,v*l,b*l))
   Next
EndProcedure
#nbpal=4



Global _virtuscr
_virtuscr=AllocateMemory(#scrw*#scrh)

Global _hrtimerfreq.large_integer , _oldchron.f , _vit.f

QueryPerformanceFrequency_(@_hrtimerfreq)

Procedure.f secs()
   QueryPerformanceCounter_(@hrnow.large_integer)
   !fild qword[esp]
   !fild qword[v__hrtimerfreq]
   !fdivp
   ProcedureReturn
EndProcedure

_oldchron=secs()
_vit=1

Procedure drawscr()
   newchron.f=secs()
   Static vitchr.f
   _vit=(newchron-vitchr)*2000
   vitchr=newchron
   If newchron-_oldchron>=0.025
      _oldchron=newchron
      scrop=ScreenOutput()
      If scrop And StartDrawing(scrop)
         buff=DrawingBuffer()
         pitch=DrawingBufferPitch()
         If buff And pitch
            For y=0 To #scrh-1
               CopyMemory(_virtuscr+y*#scrw,buff+pitch*y,#scrw)
            Next
         EndIf
         StopDrawing()
      EndIf
      FlipBuffers(0)
      While IsScreenActive()=0
         Delay(20)
         FlipBuffers()
      Wend
   EndIf
EndProcedure



Global _couleur

Procedure _LineXY(x1,y1,x2,y2)
   If x1=x2
      If x1<0 Or x1>=#scrw : ProcedureReturn : EndIf
      If y1>y2
         tmp=y1
         y1=y2
         y2=tmp
      EndIf
      If y1<0
         If y2<0 : ProcedureReturn : EndIf
         y1=0
      EndIf
      If y2>=#scrh
         If y1>=#scrh : ProcedureReturn : EndIf
         y2=#scrh-1
      EndIf
      *pix.byte=_virtuscr+y1*#scrw+x1
      derpix=_virtuscr+y2*#scrw+x1
      Repeat
         *pix\b=_couleur
         If *pix=derpix : Break : EndIf
         *pix+#scrw
      ForEver
      ProcedureReturn
     ElseIf x1>x2
      tmp=x1
      x1=x2
      x2=tmp
      tmp=y1
      y1=y2
      y2=tmp
   EndIf
   If x1<0
      If x2<0 : ProcedureReturn : EndIf
      y1=y2+((y1-y2)*(x2+1))/(x2-x1+1)
      x1=0
   EndIf
   If x2>=#scrw
      If x1>=#scrw : ProcedureReturn : EndIf
      y2=y1+((y2-y1)*(#scrw-x1))/(x2-x1)
      x2=#scrw-1
   EndIf
   If y1<0
      If y2<0 : ProcedureReturn : EndIf
      x1=x2+((x1-x2)*(y2+1))/(y2-y1+1)
      y1=0
     ElseIf y2<0
      x2=x1+((x2-x1)*(y1+1))/(y1-y2+1)
      y2=0
   EndIf
   If y1>=#scrh
      If y2>=#scrh : ProcedureReturn : EndIf
      x1=x2+((x1-x2)*(#scrh-y2))/(y1-y2)
      y1=#scrh-1
     ElseIf y2>=#scrh
      x2=x1+((x2-x1)*(#scrh-y1))/(y2-y1)
      y2=#scrh-1
   EndIf
   diffy=y2-y1
   If diffy=0
      fillmemory_(_virtuscr+y1*#scrw+x1,x2-x1+1,_couleur)
      ProcedureReturn
     ElseIf diffy<0
      sensy=-#scrw
      diffy=1-diffy
     Else
      sensy=#scrw
      diffy+1
   EndIf
   diffx=x2-x1+1
   *pix=_virtuscr+y1*#scrw+x1
   xr=diffx*diffy
   yr=xr
   While yr>0
      yr-diffx
      While xr>yr
         *pix\b=_couleur
         *pix+1
         xr-diffy
      Wend
      *pix+sensy
   Wend
EndProcedure

Global _quartpi.f
!fldpi
!fstp dword[v__quartpi]
_quartpi/4

Procedure drawbird(x,y,a.f,e.f)
   a*_quartpi
   larj=e*Cos(a)
   htr=e*Sin(a)
   _LineXY(x-2*larj,y,x-larj,y-htr)
   _LineXY(x-larj,y-htr,x,y)
   _LineXY(x,y,x+larj,y-htr)
   _LineXY(x+larj,y-htr,x+2*larj,y)
EndProcedure




Procedure fademem(mem,len)
   !mov ebx,[esp]
   !mov ecx,[esp+4]
   !shr ecx,2
   !.bcl:
   !mov eax,[ebx]
   !test eax,0FF000000h
   !setnz dh
   !test eax,0FF0000h
   !setnz dl
   !shl edx,16
   !and ah,ah
   !setnz dh
   !and al,al
   !setnz dl
   !sub eax,edx
   !mov [ebx],eax
   !add ebx,4
   !dec ecx
   !jnz .bcl
EndProcedure


Procedure bitdk(mem,len)
   _couleur+1
EndProcedure


Procedure martinet(scr,scrw,scrh)
   For y=1 To scrh-2 : For x=1 To scrw-2
      *pix.byte=scr+y*scrw+x
      *pix\b=((PeekB(*pix-1)+PeekB(*pix+1)+PeekB(*pix-scrw)+PeekB(*pix+scrw))>>2)+1
   Next : Next
EndProcedure

Procedure blur(scr,scrw,scrh)
   For y=1 To scrh-2 : For x=1 To scrw-2
      *pix.byte=scr+y*scrw+x
      *pix\b=((PeekB(*pix-1)+PeekB(*pix+1)+PeekB(*pix-scrw)+PeekB(*pix+scrw))>>2)
   Next : Next
EndProcedure


Procedure feu(scr,scrw,scrh)
   For y=0 To scrh-3
      dk=Random(1)
      If dk
         xdep=0
         xfin=scrw-2
        Else
         xdep=1
         xfin=scrw-1
         dk=-1
      EndIf
      For x=xdep To xfin
         *pix.byte=scr+y*scrw+x
         coul=((PeekB(*pix+scrw)&255)+(PeekB(*pix+scrw+dk)&255)+(PeekB(*pix+2*scrw)&255)+(PeekB(*pix+2*scrw+dk)&255))>>2
         If coul
            *pix\b=coul-1
           Else
            *pix\b=0
         EndIf
      Next
   Next
EndProcedure


#paf=0.00099



Structure zozio
   x.l
   y.l
   z.f
   a.f
   p.f
   v.f
EndStructure

#nbzoz=9
Dim zoz.zozio(#nbzoz)

Procedure zoziox()
   For zq=0 To #nbzoz
      *z.zozio=@zoz(zq)
      If *z\z<=0
         *z\x=Random(#scrw*2)-#scrw
         *z\y=Random(#scrh*2)-#scrh
         *z\z=20
         *z\p=#paf
         *z\v=0.0001*(Random(20)+2)
        Else
         *z\a+(*z\p*_vit)
         If *z\a<0
            *z\a=0
            *z\p=#paf
           ElseIf *z\a>1
            *z\a=1
            *z\p=-#paf
         EndIf
         drawbird(*z\x/*z\z+#scrw/2,*z\y/*z\z+#scrh/2,*z\a,#scrw/(4**z\z))
         *z\z-(*z\v*_vit)
      EndIf
   Next
EndProcedure

If InitSprite() And InitKeyboard() And InitPalette() And OpenScreen(#scrw,#scrh,8,"ZOZIOX")
   prepal()
   _couleur=255
   starttime=ElapsedMilliseconds()
   Repeat
      zoziox()
      drawscr()
      ExamineKeyboard()
      If KeyboardReleased(#pb_key_space)
         If palettecurr=#nbpal
            palettecurr=0
           Else
            palettecurr+1
         EndIf
         DisplayPalette(palettecurr)
      EndIf
      Select (((ElapsedMilliseconds()-starttime)>>14)&$3ffff)%5
         Case 0 : fademem(_virtuscr,#scrw*#scrh) : _couleur=255
         Case 1 : martinet(_virtuscr,#scrw,#scrh)
         Case 2 : feu(_virtuscr,#scrw,#scrh)
         Case 3 : blur(_virtuscr,#scrw,#scrh)
         Case 4 : bitdk(_virtuscr,#scrw*#scrh)
      EndSelect
   Until KeyboardPushed(#pb_key_escape)
EndIf
'Scusez le code bordélique :oops:

Publié : sam. 09/avr./2005 19:49
par comtois
wow , géniale , ça pourrait faire un joli écran de veille :)

Publié : sam. 09/avr./2005 20:57
par dlolo
Salut, j'ai une erreur sur :

Code : Tout sélectionner

fillmemory_(_virtuscr+y1*#scrw+x1,x2-x1+1,_couleur)
fillmemory_() is not a function...

Est-ce qu'il me manque une librairie ?

Publié : sam. 09/avr./2005 21:17
par filperj
fillmemory_() est une API window.
Peut-être que tu as la version démo de PB? Ou que tu est sous Linux?
Sinon, une alternative vite torchée (et pas du tout optimisée):

Code : Tout sélectionner

Procedure fillmemory_(addr,len,val)
   !mov edi,[esp]
   !mov ecx,[esp+4]
   !mov eax,[esp+8]
   !jecxz .fin
   !rep stosb
   !.fin:
EndProcedure

Publié : sam. 09/avr./2005 21:24
par dlolo
Et hop la petite fonction en assembleur en 2 secondes :wink:

Cool, j'ai vu ce que ça donne merci.
c'est fou ce qu'on peut faire en "quelques lignes"...

Publié : sam. 09/avr./2005 21:47
par filperj
Et hop la petite fonction en assembleur en 2 secondes Wink
Et même tellement vite fait que ça risque de remplir la mémoire du mauvais côté :oops:
Correction:

Code : Tout sélectionner


Procedure fillmemory_(addr,len,val)
   !mov edi,[esp]
   !mov ecx,[esp+4]
   !mov eax,[esp+8]
   !jecxz .fin
   !cld ;<- il faut s'assurer que le drapeau de direction est dans le bon sens
   !rep stosb
   !.fin:
EndProcedure

Publié : sam. 09/avr./2005 21:54
par dlolo
Ah oui encore mieux, c'est vrazi que j'avais des trucs bizzares mais là c'est nickel.
Merci pour les modifs.

Publié : dim. 10/avr./2005 10:10
par Oliv
Cool :D

Publié : dim. 10/avr./2005 11:19
par Anonyme2
Whooooooooo

Suis comme comtois, ça ferais un bel écran de veille :D

Bravo

Publié : dim. 10/avr./2005 11:27
par Dräc
C’est super !
En plus je ne sais pas comment tu as fait, mais le prog gère comme un grand le mode d’affichage 1024x768 alors que je n’ai qu’un 12’’ (800x600).
Bravo !

Publié : dim. 10/avr./2005 15:27
par filperj
je ne sais pas comment tu as fait, mais le prog gère comme un grand le mode d’affichage 1024x768 alors que je n’ai qu’un 12’’ (800x600).
:?: :?:
J'ai rien fait du tout!
Si tu as laissé les constantes #scrw et #scrh à 1024 et 768, le prog ouvre un écran de 1024x768x8 sans réfléchir davantage.

Peut-être que ta config ne supporte ces dimensions qu'avec une profondeur de 8 bits :roll:

Publié : dim. 10/avr./2005 18:27
par Dräc
filperj a écrit : :?: :?:
J'ai rien fait du tout!
Si tu as laissé les constantes #scrw et #scrh à 1024 et 768, le prog ouvre un écran de 1024x768x8 sans réfléchir davantage.

Peut-être que ta config ne supporte ces dimensions qu'avec une profondeur de 8 bits :roll:
Pour etre plus clair: je peux afficher un écran jusqu'à 1024x768x24 (ouah ! dément !), simplement il sera plus grand que mon écran physique (il suffit alors de se balader avec la souris pour tout voir).
Je suis donc de préférence en 800x600.
Or souvent les programmes imposent 1024x768 (vu que ces moniteurs sont devenus très courants) et en principe je suis obligé de toucher au code.
Là pour le coup, rien à faire: le prog déclenche le mode 1024x768 et lorsqu'il se termine il repasse en 800x600!

Nickel quoi !
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru