Vos plus beaux stars scroll

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
SPH
Messages : 4721
Inscription : mer. 09/nov./2005 9:53

Re: Vos plus beaux stars scroll

Message par SPH »

Cool Dji a écrit :Hello,

Hop, j'ai codé ça vite fait en 10 lignes, mis sous youtube mais j'ai oublié d'enregistrer... :mrgreen:

https://www.youtube.com/watch?v=X6dJEAs0-Gk
30 minutes de video ??!!!
Et comme dirais Ar-s, tu n'as pas le droit de paumer un code faisant de si belles etoiles !! 8O

Refait ton code de toute urgence :o

Falsam : ton stars scroll me fait penser a ENYGMA de PHENOMENA (https://www.youtube.com/watch?v=iGpU3DicbLQ)
C'est bien, mais le double d'etoiles ne serait pas de refus :lol: :lol:
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Vos plus beaux stars scroll

Message par Zorro »

version etoiles scintillantes (avec ajout de leger mouvement circulaire pour chaque etoiles )

Code : Tout sélectionner

 ;***********************************************
;Titre  :*etoiles_scintillantes
;Auteur  : Zorro
;Date  :25/10/2016, mettre à jour: Demivec 31/10/2016
; ajout mouvement etoiles by Zorro :21/02/2018
;Heure  :11:42:32
;Version Purebasic :  PureBasic 5.50 (Windows - x86)
;Version de l'editeur :EPB V2.64
; Libairies necessaire : Aucune
;***********************************************

Enumeration
      #window = 0
EndEnumeration
ExamineDesktops()
Global Width=DesktopWidth(0)
Global Height =DesktopHeight(0)
Global nbr_etoiles = Width * Height / 1000  ; << on peut changer le nombre d'etoiles
;Global Taille_etoile=1   ; << on peut changer la taille des etoiles
; #Width = 800
; #Height = 600

Enumeration 1
  #taille_petit
  #taille_moyenne
  #taille_grand
EndEnumeration


Structure Stars
      x.i
      y.i
      couleur.i
      couleurVar.i ;varience
      taille.i
      luminosite.i ; pour niveau de gris (0 - 255)
      minLuminosite.i
      maxLuminosite.i
EndStructure
Global Dim Stars.Stars(nbr_etoiles)

Define i, hwnd, evnt, de

For i=1 To nbr_etoiles
  With Stars(i)
      \x.i=Random(Width-1,1)
      \y.i=Random(Height-1,1)   

      Select Random(99)
        Case 0 To 77
          \taille = #taille_petit
        Case 78 To 98
          \taille = #taille_moyenne
        Case 99 To 99
          \taille = #taille_grand
      EndSelect
     
      \minLuminosite = Random(63)
      \maxLuminosite = Random(195 + 10 * \taille, 195 - 90 + 10 * \taille)
      \luminosite = Random(\maxLuminosite, \minLuminosite)
      \couleurVar.i = Random(50, 15)
      \couleur = RGB(\luminosite - Random(\couleurVar),
                     \luminosite - Random(\couleurVar),
                     \luminosite - Random(\couleurVar))
    EndWith
Next i   
;- Initialisation de DirectX
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
      MessageRequester("Erreur", "Impossible d'initialiser DirectX", 0)
      CloseWindow(#window) : End
EndIf

;- Ouverture de la fenetre et de l'écran
hwnd = OpenWindow(#window, 0, 0,  Width, Height, "",#PB_Window_BorderLess   )
OpenWindowedScreen(hwnd, 0, 0, Width, Height, 0, 0, 0)

AddWindowTimer(#window, 0, 50)

;- début de la boucle
Repeat
      ExamineMouse()  ; on demande a purebasic de surveiller les event de souris !
      ExamineKeyboard() ; on demande a purebasic de surveiller les event de clavier!
     amplitude=10
      Repeat
        evnt=WindowEvent()
        Select evnt
          Case #PB_Event_Timer
            If EventTimer() = 0
              For i=1 To nbr_etoiles
                 With Stars(i)
                    Select \taille
                      Case #taille_petit
                        de = 10000
                      Case #taille_moyenne
                        de = 300
                      Case #taille_grand
                        de = 1
                    EndSelect
 
                    If Random(90000, de) > 89000
                      \luminosite = Random(\maxLuminosite, \minLuminosite)
							 \x.i=\x.i+ amplitude * Cos(angle.f*#PI/180)
							 \y.i = \y.i+ amplitude* Sin(angle.f*#PI/180)
							angle.f=angle.f+0.05
                    EndIf
                   
                    If Random(5) > 4
                      \couleur = RGB(\luminosite - Random(\couleurVar),
                                     \luminosite - Random(\couleurVar),
                                     \luminosite - Random(\couleurVar))
                    EndIf
                  EndWith
                 
                Next
            EndIf
           
            Case #PB_Event_CloseWindow
              End
          EndSelect
        Until evnt = 0
       
      ;- dessin des etoiles
      StartDrawing(ScreenOutput())
            For i=1 To nbr_etoiles
               Circle(Stars(i)\x, Stars(i)\y, Stars(i)\taille, Stars(i)\couleur)
            Next i
      StopDrawing()
      StartDrawing(ScreenOutput())
            DrawText(10, 10, "touche ESC pour quitter" ,RGB(255,255,0),RGB(0,0,0))
      StopDrawing()
      FlipBuffers() : ClearScreen(RGB(0,0,0))
     
Until KeyboardPushed(#PB_Key_Escape)

Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
SPH
Messages : 4721
Inscription : mer. 09/nov./2005 9:53

Re: Vos plus beaux stars scroll

Message par SPH »

:lol: qu'as tu voulu faire :?: :|
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Vos plus beaux stars scroll

Message par Zorro »

ben des etoiles qui scintillent et qui bougent un peut (histoire de rester dans le suget "scroll" ) :mrgreen:

voici une variante

Code : Tout sélectionner

 ;***********************************************
;Titre  :*etoiles_scintillantes
;Auteur  : Zorro
;Date  :25/10/2016, mettre à jour: Demivec 31/10/2016
; ajout mouvement etoiles by Zorro :21/02/2018
;Heure  :11:42:32
;Version Purebasic :  PureBasic 5.50 (Windows - x86)
;Version de l'editeur :EPB V2.64
; Libairies necessaire : Aucune
;***********************************************

Enumeration
      #window = 0
EndEnumeration
ExamineDesktops()
Global Width=DesktopWidth(0)
Global Height =DesktopHeight(0)
Global nbr_etoiles = Width * Height / 1000  ; << on peut changer le nombre d'etoiles
;Global Taille_etoile=1   ; << on peut changer la taille des etoiles
; #Width = 800
; #Height = 600

Enumeration 1
  #taille_petit
  #taille_moyenne
  #taille_grand
EndEnumeration


Structure Stars
      x.i
      y.i
      couleur.i
      couleurVar.i ;varience
      taille.i
      luminosite.i ; pour niveau de gris (0 - 255)
      minLuminosite.i
      maxLuminosite.i
EndStructure
Global Dim Stars.Stars(nbr_etoiles)

Define i, hwnd, evnt, de

For i=1 To nbr_etoiles
  With Stars(i)
      \x.i=Random(Width-1,1)
      \y.i=Random(Height-1,1)   

      Select Random(99)
        Case 0 To 77
          \taille = #taille_petit
        Case 78 To 98
          \taille = #taille_moyenne
        Case 99 To 99
          \taille = #taille_grand
      EndSelect
     
      \minLuminosite = Random(63)
      \maxLuminosite = Random(195 + 10 * \taille, 195 - 90 + 10 * \taille)
      \luminosite = Random(\maxLuminosite, \minLuminosite)
      \couleurVar.i = Random(50, 15)
      \couleur = RGB(\luminosite - Random(\couleurVar),
                     \luminosite - Random(\couleurVar),
                     \luminosite - Random(\couleurVar))
    EndWith
Next i   
;- Initialisation de DirectX
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
      MessageRequester("Erreur", "Impossible d'initialiser DirectX", 0)
      CloseWindow(#window) : End
EndIf

;- Ouverture de la fenetre et de l'écran
hwnd = OpenWindow(#window, 0, 0,  Width, Height, "",#PB_Window_BorderLess   )
OpenWindowedScreen(hwnd, 0, 0, Width, Height, 0, 0, 0)

AddWindowTimer(#window, 0, 100)

;- début de la boucle
Repeat
      ExamineMouse()  ; on demande a purebasic de surveiller les event de souris !
      ExamineKeyboard() ; on demande a purebasic de surveiller les event de clavier!
     amplitude=3
      Repeat
        evnt=WindowEvent()
        Select evnt
          Case #PB_Event_Timer
            If EventTimer() = 0
              For i=1 To nbr_etoiles
                 With Stars(i)
                    Select \taille
                      Case #taille_petit
                        de = 10000
								 \x.i=\x.i+ amplitude * Cos(anglep.f*#PI/180)
							 \y.i = \y.i+ amplitude* Sin(anglep.f*#PI/180)
							anglep.f=anglep.f-0.002
                      Case #taille_moyenne
                        de = 300
									 \x.i=\x.i+ amplitude * Cos(anglem.f*#PI/180)
							 \y.i = \y.i+ amplitude* Sin(anglem.f*#PI/180)
							anglem.f=anglem.f+0.008
                      Case #taille_grand
                        de = 1
								 \x.i=\x.i+ amplitude * Cos(angle.f*#PI/180)
							 \y.i = \y.i+ amplitude* Sin(angle.f*#PI/180)
							angle.f=angle.f+0.005
                    EndSelect
 
                    If Random(90000, de) > 89000
                      \luminosite = Random(\maxLuminosite, \minLuminosite)
							
                    EndIf
                   
                    If Random(5) > 4
                      \couleur = RGB(\luminosite - Random(\couleurVar),
                                     \luminosite - Random(\couleurVar),
                                     \luminosite - Random(\couleurVar))
                    EndIf
                  EndWith
                 
                Next
            EndIf
           
            Case #PB_Event_CloseWindow
              End
          EndSelect
        Until evnt = 0
       
      ;- dessin des etoiles
      StartDrawing(ScreenOutput())
            For i=1 To nbr_etoiles
               Circle(Stars(i)\x, Stars(i)\y, Stars(i)\taille, Stars(i)\couleur)
            Next i
      StopDrawing()
      StartDrawing(ScreenOutput())
            DrawText(10, 10, "touche ESC pour quitter" ,RGB(255,255,0),RGB(0,0,0))
      StopDrawing()
      FlipBuffers() : ClearScreen(RGB(0,0,0))
     
Until KeyboardPushed(#PB_Key_Escape)

; Epb
Dernière modification par Zorro le mer. 21/févr./2018 19:28, modifié 1 fois.
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Vos plus beaux stars scroll

Message par falsam »

Zorro a écrit :ben des etoiles qui scintillent et qui bougent un peut (histoire de rester dans le suget "scroll" ) :mrgreen:
je me demande si tu scrolles vraiment. Elles sont engluées tes étoiles. :mrgreen:
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Vos plus beaux stars scroll

Message par Zorro »

regarde la variante juste au dessus de ton message ;)
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Vos plus beaux stars scroll

Message par falsam »

Zorro a écrit :regarde la variante juste au dessus de ton message ;)
Comment dire ..... C'est moche ? :mrgreen:
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
SPH
Messages : 4721
Inscription : mer. 09/nov./2005 9:53

Re: Vos plus beaux stars scroll

Message par SPH »

J'aime pas...trop :|

je ne vois pas ou est le scroll la dedans :lol:
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: Vos plus beaux stars scroll

Message par djes »

Un code de 2005 (rapidement codé à l'époque, soyez indulgents...) adapté pour 2018...

Rotations à la souris, bouton gauche pour réinitialiser les étoiles, bouton droit pour un effet tunnel (bonus), molette pour rotation plus changement de perspective.

Le tout en fichier zip (j'ai inclus l'exe original, un peu différent).

matrix.pb

Code : Tout sélectionner

;Matrix calculations
;(c)djes 2006

;#PI=3.14159265

Structure matrix
 mat.f[9]
EndStructure

Structure vector
 x.f
 y.f
 z.f
EndStructure

;*************************************************************************************************************************************
Procedure.f pi()
 !FLDPI
EndProcedure

;*************************************************************************************************************************************

Procedure matrix_by_matrix_multiply(*a.matrix, *b.matrix) ;/* Return To a */

  tmp.matrix

  For i.l = 0 To 2
    For j.l = 0 To 2
      tmp\mat[i+j*3] = *a\mat[i+0*3] * *b\mat[0+j*3] + *a\mat[i+1*3] * *b\mat[1+j*3] + *a\mat[i+2*3] * *b\mat[2+j*3]
    Next
  Next
  For i = 0 To 2
    For j = 0 To 2
      *a\mat[i+j*3] = tmp\mat[i+j*3];
    Next j
  Next i
;/* 3dica:
;   ¦ a b c ¦   ¦ k l m ¦   ¦ ak+bn+cq al+bo+cr am+bp+cs ¦
;   ¦ d e f ¦ * ¦ n o p ¦ = ¦ dk+en+fq dl+eo+fr dm+ep+fs ¦
;   ¦ h i j ¦   ¦ q r s ¦   ¦ hk+in+jq hl+io+jr hm+ip+js ¦
;*/
EndProcedure

;*************************************************************************************************************************************

Procedure matrix_copy(*a.matrix, *b.matrix) ;/* Return To a */

 For i=0 To 8
  *a\mat[i]=*b\mat[i]
 Next i

EndProcedure

;*************************************************************************************************************************************

Procedure matrix_by_vector_multiply(*vekto.vector, *result.vector, *mat.matrix)

 vekx.f=*vekto\x
 veky.f=*vekto\y
 vekz.f=*vekto\z

 *result\x = *mat\mat[0] * vekx + *mat\mat[1] * veky + *mat\mat[2] * vekz;
 *result\y = *mat\mat[3] * vekx + *mat\mat[4] * veky + *mat\mat[5] * vekz;
 *result\z = *mat\mat[6] * vekx + *mat\mat[7] * veky + *mat\mat[8] * vekz;

;/*
; 3dica:
;                ¦ a b c 0 ¦
;   (Xi+Yj+Zk) * ¦ e f g 0 ¦ = (aX+eY+iZ+m)i + (bX+fY+jZ+n)j +
;                ¦ i j k 0 ¦   (cX+gY+kZ+o)k
;                ¦ m n o 1 ¦
;*/
EndProcedure

;*************************************************************************************************************************************

Procedure matrix_rotation(*m.matrix, tangage.f, cap.f, roulis.f)

 sx.f=Sin(tangage)
 sy.f=Sin(cap)
 sz.f=Sin(roulis)

 cx.f=Cos(tangage)
 cy.f=Cos(cap)
 cz.f=Cos(roulis)

 *m\mat[0+0*3] = cy * cz;
 *m\mat[0+1*3] = cy * sz;
 *m\mat[0+2*3] = -sy;

 *m\mat[1+0*3] = sx * sy * cz - cx * sz;
 *m\mat[1+1*3] = sx * sy * sz + cx * cz;
 *m\mat[1+2*3] = sx * cy;

 *m\mat[2+0*3] = cx * sy * cz + sx * sz;
 *m\mat[2+1*3] = cx * sy * sz - sx * cz;
 *m\mat[2+2*3] = cx * cy;

;/*3dica:
;                     ¦ cy*cz          cy*sz          -sy    0 ¦
;                     ¦ sx*sy*cz-cx*sz sx*sy*sz+cx*cz  sx*cy 0 ¦
;       [X]*[Y]*[Z] = ¦ cx*sy*cz+sx*sz cx*sy*sz-sx*cz  cx*cy 0 ¦
;                     ¦ 0              0               0     1 ¦
;*/
EndProcedure

;*************************************************************************************************************************************

Procedure matrix_rotation_around_axis(*m.matrix, *axis.vector, angle.f)

 nx.f=*axis\x
 ny.f=*axis\y
 nz.f=*axis\z

 ;normalize axis
 length.f = Sqr(nx*nx + ny*ny + nz*nz);

 ;// too close To 0, can't make a normalized vector
 If (length < 0.000001) 
  length=0.000001
 EndIf

 nx = nx/length
 ny = ny/length
 nz = nz/length

 sina.f=Sin(angle)
 cosa.f=Cos(angle)

 nx2.f=nx*nx
 ny2.f=ny*ny
 nz2.f=nz*nz

 *m\mat[0+0*3] = nx2 + (1-nx2)*cosa
 *m\mat[0+1*3] = nx*ny*(1-cosa)+nz*sina
 *m\mat[0+2*3] = nx*nz*(1-cosa)-ny*sina

 *m\mat[1+0*3] = nx*ny*(1-cosa)-nz*sina
 *m\mat[1+1*3] = ny2+(1-ny2)*cosa
 *m\mat[1+2*3] = ny*nz*(1-cosa)+nx*sina

 *m\mat[2+0*3] = nx*nz*(1-cosa)+ny*sina
 *m\mat[2+1*3] = ny*nz*(1-cosa)-nx*sina
 *m\mat[2+2*3] = nz2+(1-nz2)*cosa

EndProcedure

;*************************************************************************************************************************************

Procedure matrix_identity(*m.matrix)

 *m\mat[0+0*3] = 1: *m\mat[1+0*3] = 0: *m\mat[2+0*3] = 0;
 *m\mat[0+1*3] = 0: *m\mat[1+1*3] = 1: *m\mat[2+1*3] = 0;
 *m\mat[0+2*3] = 0: *m\mat[1+2*3] = 0: *m\mat[2+2*3] = 1;
;/* 3dica:
;     ¦ 1 0 0 0 ¦
;     ¦ 0 1 0 0 ¦
;     ¦ 0 0 1 0 ¦
;     ¦ 0 0 0 1 ¦
;*/
EndProcedure

;*************************************************************************************************************************************

Procedure matrix_rotate_around_object_axis(*obj_rotation_matrix.matrix, tangage.f, cap.f, roulis.f) ;/* Return To obj_rotation_matrix. */

 Protected axis_x.vector, axis_y.vector, axis_z.vector
 Protected axis_x_rotation_matrix.matrix, axis_y_rotation_matrix.matrix, axis_z_rotation_matrix.matrix

 ;rotation autour de l'axe x de l'objet
 axis_x\x=*obj_rotation_matrix\mat[0+0*3]
 axis_x\y=*obj_rotation_matrix\mat[0+1*3]
 axis_x\z=*obj_rotation_matrix\mat[0+2*3]
 matrix_rotation_around_axis(@axis_x_rotation_matrix, @axis_x, tangage)

 ;rotation autour de l'axe y de l'objet
 axis_y\x=*obj_rotation_matrix\mat[1+0*3]
 axis_y\y=*obj_rotation_matrix\mat[1+1*3]
 axis_y\z=*obj_rotation_matrix\mat[1+2*3]
 matrix_rotation_around_axis(@axis_y_rotation_matrix, @axis_y, cap)

 ;rotation autour de l'axe z de l'objet
 axis_z\x=*obj_rotation_matrix\mat[2+0*3]
 axis_z\y=*obj_rotation_matrix\mat[2+1*3]
 axis_z\z=*obj_rotation_matrix\mat[2+2*3]
 matrix_rotation_around_axis(@axis_z_rotation_matrix, @axis_z, roulis)

 matrix_by_matrix_multiply(@axis_x_rotation_matrix,@axis_y_rotation_matrix)
 matrix_by_matrix_multiply(@axis_x_rotation_matrix,@axis_z_rotation_matrix)
 matrix_by_matrix_multiply(*obj_rotation_matrix,@axis_x_rotation_matrix)
EndProcedure

;*************************************************************************************************************************************

Procedure.f radians(angle.f)
!FLDPI

 ProcedureReturn (angle*2.0*#PI)/360.0
EndProcedure

;*************************************************************************************************************************************

Procedure.f degrees(angle.f)
 ProcedureReturn (angle*360.0)/(2.0*#PI)
EndProcedure

;*************************************************************************************************************************************

Procedure vector_define(*vertex.vector, x, y, z)
 *vertex\x=x
 *vertex\y=y
 *vertex\z=z
EndProcedure

;*************************************************************************************************************************************

Procedure vectors_add(*vertex.vector, *vertex2add.vector)
 *vertex\x+*vertex2add\x
 *vertex\y+*vertex2add\y
 *vertex\z+*vertex2add\z
EndProcedure

;*************************************************************************************************************************************

Procedure vectors_sub(*vertex.vector, *vertex2sub.vector)
 *vertex\x-*vertex2sub\x
 *vertex\y-*vertex2sub\y
 *vertex\z-*vertex2sub\z
EndProcedure

;*************************************************************************************************************************************

Procedure vector_copy(*vertexsrc.vector, *vertexdest.vector)
 *vertexdest\x=*vertexsrc\x
 *vertexdest\y=*vertexsrc\y
 *vertexdest\z=*vertexsrc\z
EndProcedure

;*************************************************************************************************************************************

Procedure vector_rotate(*vertex.vector, *pivot.vector, tangage.f, cap.f, roulis.f)

 vectors_sub(*vertex, *pivot)

 If roulis <> 0
     x.f = Cos(roulis) * *vertex\x - Sin(roulis) * *vertex\z
     *vertex\z = Sin(roulis) * *vertex\x + Cos(roulis) * *vertex\z
     *vertex\x = x
 EndIf

 If tangage <> 0
     y.f = Cos(tangage) * *vertex\y - Sin(tangage) * *vertex\z
     *vertex\z = Sin(tangage) * *vertex\y + Cos(tangage) * *vertex\z
     *vertex\y = y
 EndIf

 If cap <> 0
     x.f = Cos(cap) * *vertex\x - Sin(cap) * *vertex\y
     *vertex\y = Sin(cap) * *vertex\x + Cos(cap) * *vertex\y
     *vertex\x = x
 EndIf

 vectors_add(*vertex, *pivot)

EndProcedure

;*************************************************************************************************************************************

Procedure vector_rotate2(*vertex.vector, *pivot.vector, tangage.f, cap.f, roulis.f )

  cr.f = Cos( tangage );
  sr.f = Sin( tangage );
  cp.f = Cos( roulis  );
  sp.f = Sin( roulis  );
  cy.f = Cos( cap );
  sy.f = Sin( cap );

  Dim m.f(12)
  m(0) = ( cp*cy );
  m(1) = ( cp*sy );
  m(2) = ( -sp );

  srsp.f = sr*sp;
  crsp.f = cr*sp;

  m(4) = ( srsp*cy-cr*sy );
  m(5) = ( srsp*sy+cr*cy );
  m(6) = ( sr*cp );

  m(8) = ( crsp*cy+sr*sy );
  m(9) = ( crsp*sy-sr*cy );
  m(10) = ( cr*cp );

  tmpx.f=*vertex\x
  tmpy.f=*vertex\y
  tmpz.f=*vertex\z

  *vertex\x = tmpx*m(0) + tmpy*m(1) + tmpz*m(2);
  *vertex\y = tmpx*m(4) + tmpy*m(5) + tmpz*m(6);
  *vertex\z = tmpx*m(8) + tmpy*m(9) + tmpz*m(10)

EndProcedure
3D Stars PB561.pb

Code : Tout sélectionner

; ****************************************************************************************************** 
; Starfield 3D
; (c)djes
; 3 avril 2005 : PB 4.00
; 21 février 2018 : PB 5.61
;
; ****************************************************************************************************** 

UsePNGImageDecoder()

IncludeFile "matrix.pb"

; ****************************************************************************************************** 

ScreenWidth = 1280
ScreenHeight = 768
ScreenDepth = 32

StarsNB.l = 2000
UniverseRadius = 500000

Dim stars.vector(StarsNB)
Dim stars_org.vector(StarsNB)

Define obj_rotation_matrix.Matrix
Define.f x, y, z, d, ppd, f
Define.f tangage, cap, roulis

; *** Petites variables pour la perspective

d = 100
ppd = 100
f = 1

; ****************************************************************************************************** 

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 
  MessageRequester("Error", "Graphic system can't be initialized", 0)
  End
EndIf

If OpenScreen(ScreenWidth, ScreenHeight, ScreenDepth, "Starfield 3D") = 0
  MessageRequester("Error", "Can't open screen, try another resolution", 0)
  End
EndIf  

CatchSprite(0, ?sprite, #PB_Sprite_AlphaBlending) ;charge le sprite
SpriteWidth = SpriteWidth(0) : SpriteHeight = SpriteHeight(0)

; ****************************************************************************************************** 
; *** initialise la matrice de rotation des étoiles

matrix_identity(@obj_rotation_matrix)
matrix_rotate_around_object_axis(@obj_rotation_matrix, tangage.f, cap.f, roulis.f)

Gosub RandomStars

; ****************************************************************************************************** 

Repeat
  
  ExamineKeyboard()
  ExamineMouse()
  
  roulis = MouseWheel() / 20
  cap = MouseDeltaX() / 500 
  tangage = MouseDeltaY() / 500 
  
  d + MouseWheel()
  
  If MouseButton(1)
    Gosub RandomStars
  EndIf
  
  If MouseButton(2)
    Gosub TunnelFX
  EndIf
  
  Gosub StarsComputing
  
  ClearScreen(0)
  
  SpriteBlendingMode( 2, 3) ; Petit effet de transparence
  Gosub StarsDrawing
  
  FlipBuffers()
  If IsScreenActive() = 0 ; le joueur a quitté  (par exemple avec Alt - tab) 
    ReleaseMouse(1)
    CloseScreen()
    OpenWindow(1, 1, 1, 1, 1, "Starfield 3D", #PB_Window_Minimize )
    Repeat : Event = WaitWindowEvent(2) : Until Event = #PB_Event_ActivateWindow
    CloseWindow(1)
    OpenScreen(ScreenWidth, ScreenHeight, ScreenDepth, "Starfield 3D") ;restaure l'affichage
    CatchSprite(0, ?sprite, #PB_Sprite_AlphaBlending) ;charge le sprite 
  EndIf 
  
Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1

End

; **************************************************************************************************** 

DataSection
  Sprite:
  IncludeBinary "Gfx/star5080FF_256.png" 
EndDataSection

; ****************************************************************************************************

RandomStars:
RandomSeed(ElapsedMilliseconds())
d = 100
For i = 0 To StarsNB - 1
  a.f = Random(UniverseRadius + UniverseRadius)
  x.f = -UniverseRadius + a
  a.f = Random(UniverseRadius + UniverseRadius)
  y.f = -UniverseRadius + a
  a.f = Random(UniverseRadius + UniverseRadius)
  z.f = -UniverseRadius + a
  vector_define(@stars_org(i), x, y, z)
Next i 
Return

; **************************************************************************************************** 

TunnelFX:
d = 50
For i = 0 To StarsNB - 1
  a.f = Random(#PI * UniverseRadius * 2)
  x.f = UniverseRadius * Sin(a/UniverseRadius)
  y.f = UniverseRadius * Cos(a/UniverseRadius)
  a.f = Random(UniverseRadius + UniverseRadius)
  z.f = -UniverseRadius + a
  vector_define(@stars_org(i), x, y, z)
Next i 
Return

; **************************************************************************************************** 

StarsComputing:
matrix_rotate_around_object_axis(@obj_rotation_matrix, tangage.f, cap.f, roulis.f)

For i = 0 To StarsNB - 1
  stars_org(i)\z - 1000
  If stars_org(i)\z <= -UniverseRadius
    stars_org(i)\z + UniverseRadius + UniverseRadius
  EndIf
  matrix_by_vector_multiply(@stars_org(i), @stars(i), @obj_rotation_matrix)
Next i

SortStructuredArray(stars(), 1, OffsetOf(vector\z), #PB_Float) ;trie les étoiles
Return

; **************************************************************************************************** 

StarsDrawing:
For i = 0 To StarsNB - 1
  z = stars(i)\z
  If z > 0
    x = ScreenWidth / 2 + (stars(i)\x * d) / (d + ppd + z * f)
    y = ScreenHeight / 2 + (stars(i)\y * d) / (d + ppd + z * f)
    If x > -SpriteWidth And x < ScreenWidth And y > -SpriteHeight And y < ScreenHeight And z < UniverseRadius
      c.l = 255 - z * 0.255
      s = SpriteWidth - (z * (SpriteWidth / UniverseRadius))
      ZoomSprite(0, s, s)
      RotateSprite(0, x + y, 0) 
      ;DisplayTransparentSprite(0, x - SpriteWidth/2, y - SpriteHeight/2, c) ;petit effet sympa
      DisplayTransparentSprite(0, x - s/2, y - s/2, c)
    EndIf
  EndIf
Next i
Return

Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Vos plus beaux stars scroll

Message par falsam »

@djes : C'est fluide et c'est beau. Bravo.
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: Vos plus beaux stars scroll

Message par djes »

falsam a écrit :@djes : C'est fluide et c'est beau. Bravo.
Merci :)
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Vos plus beaux stars scroll

Message par Ar-S »

@Djes, c'est sympa (ça donne le tournis)
Le seul petit bémol est que lorsque l'on bouge on a l'impression d'orienter un "Plane" et pas un univers 3D
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: Vos plus beaux stars scroll

Message par djes »

Ar-S a écrit :@Djes, c'est sympa (ça donne le tournis)
Le seul petit bémol est que lorsque l'on bouge on a l'impression d'orienter un "Plane" et pas un univers 3D
C'est vrai, il faut augmenter le nb d'étoiles et les distances. Si tu changes un peu la perspective en tournant plusieurs fois la molette, ça donne déjà un meilleur effet.
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: Vos plus beaux stars scroll

Message par djes »

J'ai mis le code à jour pour améliorer l'effet "univers 3d" selon la remarque d'Ar-S.
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Vos plus beaux stars scroll

Message par Ar-S »

C'est mieux, je reste cependant pas fan du déplacement de la souris. A defaut de l'effet "plat" athénué, je trouve l'effet de perspective trop prononcé.
Par contre j'aime bien les effets aux clics. même si c'est (beaucoup) trop rapide lorsqu'on clic. ça vient peut être de ma CG qui poutre. :wink:
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Répondre