Zozieaux

[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

[comtois]

wow , géniale , ça pourrait faire un joli écran de veille

[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 ?

[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

[dlolo]

Et hop la petite fonction en assembleur en 2 secondes

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

[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é
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 

[dlolo]

Ah oui encore mieux, c'est vrazi que j'avais des trucs bizzares mais là c'est nickel.
Merci pour les modifs.

[Oliv]

Cool

[Anonyme2]

Whooooooooo

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

Bravo

[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 !

[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

[Dräc]

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

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 !