Page 1 sur 3

Démo "Dog"

Publié : mar. 14/mai/2019 15:08
par SPH
Salut,

je viens de faire mes derniers effets speciaux en 2D (la prochaine fois, ce sera de la 3D car il faut que je m'y mette)

La démo (et le .pb) est telechargeable ici : http://xmas.free.fr/demo_dog.zip

Pas mal ce qu'on peux faire en PB 8) :idea: :!: :wink:

Re: Démo "Dog"

Publié : mar. 14/mai/2019 19:51
par Ollivier
Tu peux pas poster le source ? Je n'accède pas aux zips.

Et il est où ton topo sur le logarithme de base 10 ? Tu l'as viré?

Re: Démo "Dog"

Publié : mar. 14/mai/2019 20:06
par SPH
Ollivier a écrit :Tu peux pas poster le source ? Je n'accède pas aux zips.
Tu n'as pas un logiciel style winzip ?
Le code source se trouvait dans le zip...

Code : Tout sélectionner

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Erreur", "Impossible d'initialiser l'écran.")
  End
EndIf
If InitSound() = 0
  MessageRequester("Error", "Sound system not available.") : End
EndIf

LoadMusic(0, "MOD.mod")


ExamineDesktops()
ddw=DesktopWidth(0)
ddh=DesktopHeight(0)

If OpenScreen(ddw,ddh,32,"DOG")=0
  MessageRequester("Erreur", "Impossible d'ouvrir l'écran.")
  End
EndIf

If LoadSprite(0,"dog.bmp")=0
  MessageRequester("Erreur", "Image introuvable.")
  End
EndIf

ClearScreen(0)





xxx.f=1.4
yyy.f=1.1
rx.f=200
ry.f=220
oldyyy=0
deca=0


FlipBuffers()
Delay(1000)

LoadFont (0, "Courier", 30)            ; Load Courrier Font, Size 15

For i= 5 To 255 Step 5
  StartDrawing(ScreenOutput())
  DrawingMode(0)                          ; Transparent TextBackground
  DrawingFont(FontID(0))                  ; Use the 'Courier' font
  DrawText(ddw/2-30,ddh/2-4, "DOG", RGB(i,i,i))
  StopDrawing() 
  FlipBuffers()
  Delay(1)
Next
Delay(2000)

For i= 250 To 0 Step -10
  StartDrawing(ScreenOutput())
  DrawingMode(0)                          ; Transparent TextBackground
  DrawingFont(FontID(0))                  ; Use the 'Courier' font
  DrawText(ddw/2-30,ddh/2-4, "DOG", RGB(i,i,i))
  StopDrawing() 
  FlipBuffers()
  Delay(1)
Next


ClearScreen(0)
FlipBuffers()

;;;;;;;;;;;;;;;;;;;;;;;;

ClipSprite(0,0,0,514,604)
DisplaySprite(0,0,0)

Dim p(514,604)
Dim p2(514,604)


StartDrawing(ScreenOutput())
For i=0 To 514
  For u=0 To 604
    p(i,u)=Point(i,u)
    p2(i,u)=p(i,u)
  Next
Next
StopDrawing() 
ClearScreen(0)


;;;;;;;;;;


; LoadFont (0, "Courier", 30)            ; Load Courrier Font, Size 15
StartDrawing(ScreenOutput())
DrawingMode(0)                          ; Transparent TextBackground

DrawingFont(FontID(0))                 ; Use the 'Courier' font
DrawText(ddw/2+ddw/64,ddh/2-46, "Code : SPH", RGB(255, 255,255))    ; Print our text
DrawText(ddw/2+ddw/64,ddh/2+0, "GFX : Cougar", RGB(255, 255,255))   ; Print our text
DrawText(ddw/2+ddw/64,ddh/2+46, "Music : Tristan LORACH", RGB(255, 255,255))    ; Print our text
                                                                                ; Box(ddw/2+ddw/64,ddh/2-46,530,130,RGB(255,0,0))
StopDrawing() 
GrabSprite(1,ddw/2+ddw/64,ddh/2-46,530,130)


temps= ElapsedMilliseconds()

;Goto la

PlayMusic(0)








;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)
  FlipBuffers()
  DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)
  FlipBuffers()
  
Repeat
  If all=0
    ClipSprite(0,0,0,514,604)
    DisplaySprite(0,120,ddh/8-50)
  EndIf
  
;   DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)
  
  If ElapsedMilliseconds()-temps>7950
    Goto la4
  EndIf ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  
  For i=600+ddh/8 To 600+200+ddh/8
    ;    Debug Cos(Radian(yyy))*ry
    u=Cos(Radian(yyy+i*3))*ry+Sin(Radian(xxx+i*2))*rx
    If u>604
      u-604
    EndIf
    If u<0
      u+604
    EndIf

    
    ClipSprite(0,0,u,514,1)
    DisplaySprite(0,120,i)
    yyy+0.1
  Next
  
  
  xxx=oldxxx+3.14
  oldxxx=xxx
  yyy=oldyyy+2.74
  oldyyy=yyy
  
  FlipBuffers() 
  ExamineKeyboard()
  
Until KeyboardPushed(#PB_Key_Escape)
End

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

la4:
u= 604
;    DisplaySprite(0,120,ddh/8-50)
Repeat
  
  StartDrawing(ScreenOutput())
  For i=0 To 514
    LineXY(i+120,u+ddh/8-50,i+120,ddh,p(i,u))
  Next
  StopDrawing() 
  FlipBuffers()
  ExamineKeyboard()
  
  u-2
Until u<0 Or KeyboardPushed(#PB_Key_Escape)

If u>=0
  End
EndIf



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;






Repeat
  
  For i=0 To ddh-1
    
    u=Cos(Radian(yyy+i/5))*ry+Cos(Radian(xxx))*rx
    
    If u>604
      u-604
    EndIf
    If u<0
      u+604
    EndIf
    ClipSprite(0,0,u,514,1)
    DisplaySprite(0,120,i)
    yyy+0.35
    ;     ry+1
    
  Next
  
  
  xxx=oldxxx+1.14
  oldxxx=xxx
  yyy=oldyyy+0.74
  oldyyy=yyy
  
  ;  End  
  If ElapsedMilliseconds()-temps>27000
    Goto la5
  EndIf
  
  
  FlipBuffers() 
  ExamineKeyboard()
  
Until KeyboardPushed(#PB_Key_Escape)

End

la5:









;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;; 2 ;;;;;
la:


ClipSprite(0,0,0,514,604)

ClearScreen(0)
DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)

FlipBuffers()
ClearScreen(0)
DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)

sq2=0
;;;;;;;;;;;
Repeat
  
  
  StartDrawing(ScreenOutput())
  For i=0 To 514
    For u=0 To 604
      rvb=p2(i,u)
      r.w=Red(rvb)
      If r>01
        r-2
      EndIf
      v.w=Green(rvb)
      If v>01
        v-2
      EndIf
      b.w=Blue(rvb)
      If b>01
        b-2
      EndIf
      p2(i,u)=RGB(r,v,b)
      rvb=(r+v+b)/3
      Plot(i+Random(sq2)-sq2/2+120,u+Random(sq2)-sq2/2+ddh/8,RGB(rvb,rvb,rvb))
      
    Next
  Next
  StopDrawing() 
  
  sq2+1
  
  FlipBuffers() 
  If sq2=1
    Delay(2000)
  EndIf
  
  
  ExamineKeyboard()
Until sq2>108 Or KeyboardPushed(#PB_Key_Escape)

If sq2<108
  End
EndIf


x1.f=10
y1.f=51
x2.f=100
y2.f=78
x3.f=23
y3.f=91

Dim r(514,604)
Dim v(514,604)
Dim b(514,604)

cmb=0

ClearScreen(0)
DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)

FlipBuffers()
ClearScreen(0)
DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)


Repeat
  
;   DisplaySprite(1,ddw/2+ddw/64,ddh/2-46)
  StartDrawing(ScreenOutput())
  
  
  For i=-20 To 30
    For u=-20 To 30
      
      xx1=i+257+Cos(Radian(x1))*120-Cos(Radian(x2))*120
      yy1=u+302+Sin(Radian(y1))*150+Cos(Radian(x2))*150
      xx2=i+257+Cos(Radian(x2))*120+Cos(Radian(x3))*120
      yy2=u+302+Cos(Radian(y2))*150-Sin(Radian(x3))*150
      xx3=i+257+Cos(Radian(x3))*120+Cos(Radian(x1))*120
      yy3=u+302+Sin(Radian(y3))*150+Sin(Radian(x1+y1))*150
      
      If xx1>0 And xx1<514
        If yy1>0 And yy1<604
          r(xx1,yy1)=Red(p(xx1,yy1))
          ;           ok1=1
          Plot(xx1+120,yy1+ddh/8,RGB(r(xx1,yy1),v(xx1,yy1),b(xx1,yy1)))
        EndIf
      EndIf
      If xx2>0 And xx2<514
        If yy2>0 And yy2<604
          v(xx2,yy2)=Green(p(xx2,yy2))
          ;           ok2=1
          Plot(xx2+120,yy2+ddh/8,RGB(r(xx2,yy2),v(xx2,yy2),b(xx2,yy2)))
        EndIf
      EndIf
      If xx3>0 And xx3<514
        If yy3>0 And yy3<604
          b(xx3,yy3)=Blue(p(xx3,yy3))
          ;           ok3=1
          Plot(xx3+120,yy3+ddh/8,RGB(r(xx3,yy3),v(xx3,yy3),b(xx3,yy3)))
        EndIf
      EndIf
      
      
    Next
  Next
  
  StopDrawing() 
  
  x1+1.2
  y1+0.52
  x2+0.7
  y2+1.14
  x3+1.35
  y3+0.88
  cmb+1
  
  
  FlipBuffers() 
  ExamineKeyboard()
  
Until cmb>2100 Or KeyboardPushed(#PB_Key_Escape)

If cmb<2100
  End
EndIf


FlipBuffers()
ClearScreen(0)
FlipBuffers()
ClearScreen(0)
Delay(500)

LoadFont (0, "Courier", 30)            ; Load Courrier Font, Size 15

For i= 5 To 255 Step 5
  StartDrawing(ScreenOutput())
  DrawingMode(0)                          ; Transparent TextBackground
  DrawingFont(FontID(0))                  ; Use the 'Courier' font
  DrawText(ddw/2-250,ddh/2-4, "Thanks for watching", RGB(i,i,i))
  StopDrawing() 
  FlipBuffers()
  Delay(1)
Next
Delay(2000)

For i= 250 To 0 Step -10
  StartDrawing(ScreenOutput())
  DrawingMode(0)                          ; Transparent TextBackground
  DrawingFont(FontID(0))                  ; Use the 'Courier' font
  DrawText(ddw/2-250,ddh/2-4, "Thanks for watching", RGB(i,i,i))
  StopDrawing() 
  FlipBuffers()
  Delay(1)
Next

Delay(500)

End


Re: Démo "Dog"

Publié : mar. 14/mai/2019 20:26
par Ar-S
Yeah sympa !
Quel retour vers le passé que de voir cette image ! :mrgreen:
@Ollivier : voilà l'image : http://share.ldvmultimedia.com/dog.bmp

Re: Démo "Dog"

Publié : mar. 14/mai/2019 20:33
par venom
SPH a écrit :Tu n'as pas un logiciel style winzip ?
Il pourrait même dezipper avec Purebasic 8)






@++

Re: Démo "Dog"

Publié : mar. 14/mai/2019 20:38
par SPH
Ar-S a écrit :Yeah sympa !
Tu l'as vu jusqu'a la "reconstruction" RGB ?

Re: Démo "Dog"

Publié : mar. 14/mai/2019 20:49
par Ar-S
Oui, l'effet marche au poil. Un peu trop long à mon goût mais il marche nickel.
Le 1er effet aussi est bien (le genre de déformation reflet) mais tu ne devrais pas le répéter. (un seul reflet suffirait).
Le second en loop passe bien par contre.
Voilà pour mon résumé :D
Bravo en tous cas.
Tu me surprendras toujours. Pas fichu de faire une GUI fonctionnelle et des codes 2D toujours surprenant :mrgreen:

Re: Démo "Dog"

Publié : mar. 14/mai/2019 20:52
par SPH
:mrgreen:

Re: Démo "Dog"

Publié : mar. 14/mai/2019 22:21
par Ollivier
ArS a écrit :@Ollivier : voilà l'image
Eh ! Mais c'est pas du CGA ça !
J'espère que tu ne vas pas me comptabiliser ça dans les trois images que tu m'as accordées !!

@SPH

Merci pour le code source. Je regarderai ça prochainement. Et tu ne te souviendrais pas où tu as fourré l'équation de calcul des factorielles avec un sinus dedans ? Ça doit dater de 2011, je ne sais pas pourquoi tu l'avais pondu. Ça semblait hors contexte, mais c'est une super équation. Donc si ça te dit quelquechose, ça m'intéresse...

Re: Démo "Dog"

Publié : mar. 14/mai/2019 22:39
par SPH
Ollivier a écrit :Et tu ne te souviendrais pas où tu as fourré l'équation de calcul des factorielles avec un sinus dedans ? Ça doit dater de 2011, je ne sais pas pourquoi tu l'avais pondu. Ça semblait hors contexte, mais c'est une super équation. Donc si ça te dit quelquechose, ça m'intéresse...
[HS] Si tu parles du code que j'ai pondu il y a quelques jours, je l'ai retiré du forum... pas simplement pour le retirer mais pour le perfectionner. Je le ressortirais dans quelques jours [/HS]

Re: Démo "Dog"

Publié : mer. 15/mai/2019 10:07
par Kwai chang caine
Sympa la démo spécial épileptique :mrgreen:
Merci 8)

"Dog" en N&B

Publié : mer. 15/mai/2019 19:57
par SPH
Salut,

curieusement, ce code ne transforme pas l'image couleur en noire et blanche.
Pkoi ??

Code : Tout sélectionner

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Erreur", "Impossible d'initialiser l'écran.")
  End
EndIf


ExamineDesktops()
ddw=DesktopWidth(0)
ddh=DesktopHeight(0)

If OpenScreen(ddw,ddh,32,"DOG N&B")=0
  MessageRequester("Erreur", "Impossible d'ouvrir l'écran.")
  End
EndIf

If LoadSprite(0,"dog.bmp")=0
  MessageRequester("Erreur", "Image introuvable.")
  End
EndIf


ClipSprite(0,0,0,514,604)
DisplaySprite(0,0,0)

Dim p(514,604)

StartDrawing(ScreenOutput())
For i=0 To 514
  For u=0 To 604
    p(i,u)=Point(i,u)
  Next
Next
StopDrawing() 
ClearScreen(0)

;;;;;;;;;;;

StartDrawing(ScreenOutput())
For i=0 To 514
  For u=0 To 604
    rvb=p(i,u)
    r.w=Red(rvb)
    v.w=Green(rvb)
    b.w=Blue(rvb)
    
    Plot(i,u,(r+v+b)/3) ;;;;;;;;;;;;;  curieux, ca ne donne pas une image en noire et blanche
    
  Next
Next
StopDrawing() 

FlipBuffers() 

Repeat
  ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
End


Re: Démo "Dog"

Publié : mer. 15/mai/2019 21:04
par venom
J'imagine que tu recherche un "niveau de gris" pas un vrai "noir et blanc".

ce code récupère chaque pixel, additionne le R+G+B et verifie si le pixel et supperieur ou inferieur a 255 <-- (cette valeur peut être changer pour avoir plus ou moins de blanc. Ligne 48 et 50) :wink: Si c'est inférieur, on transforme le pixel en noir. Si c'est supérieur on met un pixel blanc.

je balance le code si jamais ça peut servir a d'autre.

Code : Tout sélectionner


Structure img
     x.l
     y.l
     color.l
EndStructure

UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
UsePNGImageEncoder()

file$ = OpenFileRequester("fichier image", "", "image compatible|*.bmp;*.jpg;*.png;*.tga;*.tif", 0) ; <---- ont choisit une image bitmap
If LoadImage(1, file$) ; <--- ont charge l'image du dessus
     If StartDrawing(ImageOutput(1))
         width = ImageWidth(1) ; <--- ont prend la largeur de l'image
         height = ImageHeight(1) ; <--- ont prend la hauteur de l'image
         size = width * height ; <--- ont multiplie la largeur par la hauteur pour savoir le nombre de pixels au total
         Dim Array.img(size)
         
         ; <------------------------- ont récupère la  couleur de chaque pixel -----------------------
         i = 0
         For y = 0 To height - 1
           For x = 0 To width - 1
             color = Point(x, y)
             Array(i)\x = x
             Array(i)\y = y
             Array(i)\color = color
             i + 1
           Next
         Next
         ; <------------------------------------------------------------------------------------------
       StopDrawing()
     EndIf
EndIf

If OpenWindow(0, 0, 0, ImageWidth(1), ImageHeight(1), "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered) ; <------------------------- ont ouvre une fenêtre a la taille de l'image
     If CreateImage(0, ImageWidth(1), ImageHeight(1)) ; <------------------------- ont charge l'environnement image
       If StartDrawing(ImageOutput(0))
           
           For i = 0 To size - 1
             i = 0
             For y = 0 To height - 1
               For x = 0 To width - 1
                 i + 1
                 color = Point(x, y)
              If Red(Array(i)\color) + Green(Array(i)\color) + Blue(Array(i)\color) < 255 ; <---- on verifie si chaque pixel R + G + B est inferieur a 382
                Plot(Array(i)\x, Array(i)\y, RGB(0, 0, 0)) ; <---- on creer un pixel noir
              ElseIf Red(Array(i)\color) + Green(Array(i)\color) + Blue(Array(i)\color) > 255 ; <---- on verifie si chaque pixel R + G + B est supperieur a 382
                Plot(Array(i)\x, Array(i)\y, RGB(255, 255, 255)) ; <---- on creer un pixel blanc
              EndIf
               Next
             Next
           Next
   
         StopDrawing()
       EndIf
     EndIf
     
     ImageGadget(0, 0, 0, 0, 0, ImageID(0))

     Repeat
       EventID = WaitWindowEvent()
     Until EventID = #PB_Event_CloseWindow
EndIf
; <------------------------- et ont quitte





@++

Re: Démo "Dog"

Publié : mer. 15/mai/2019 21:23
par SPH
Sorry, je cherche toute la palette de gris (du noir au blanc) :|

Curieux que mon "Plot(i,u,(r+v+b)/3)" ne marche pas !

EDIT : je viens de trouver !!!!!!

look : Plot(i,u,RGB((r+v+b)/3,(r+v+b)/3,(r+v+b)/3))

Vicieux mais ca marche !! :arrow: 8)

Re: Démo "Dog"

Publié : mer. 15/mai/2019 22:46
par Ar-S
Oui c'est l'équivalent de RGBA(gray,gray,gray,255) de la proce ci dessous.. C'est tout de même plus lisible non ?
En reprenant ton code.. Mais en le modifiant. (une proce dans ta face :))

Code : Tout sélectionner

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Erreur", "Impossible d'initialiser l'écran.")
  End
EndIf

Declare NB()



; La proce qui va convertir ton sprite en N&B
Procedure NB()
  
  Protected Old, R, G, B, Color, x, y, Gray
  StartDrawing(SpriteOutput(0))
  
  For y = 0 To SpriteHeight(0)-1
    For x = 0 To SpriteWidth(0)-1
      
      Color = Point(x,y)
      
      R = Red(Color)
      G = Green(Color)
      B = Blue(Color)
      
      Gray = (R + G + B) / 3
      Old = RGBA(gray,gray,gray,255)  
      Plot ( x, y, Old)
      
    Next x
  Next  y
  
  StopDrawing()
  
EndProcedure





ExamineDesktops()
ddw=DesktopWidth(0)
ddh=DesktopHeight(0)

If OpenScreen(ddw,ddh,32,"DOG N&B")=0
  MessageRequester("Erreur", "Impossible d'ouvrir l'écran.")
  End
EndIf

If LoadSprite(0,"dog.bmp")=0
  MessageRequester("Erreur", "Image introuvable.")
  End
EndIf



; Appel de la proce
NB()

; Il serait pas mal de bosser ton affichage dans la boucle...

Repeat
  ExamineKeyboard()
  ClearScreen(0)
  DisplaySprite(0,0,0)
  FlipBuffers()

Until KeyboardPushed(#PB_Key_Escape)
End