PureBasic

Forums PureBasic
Nous sommes le Lun 14/Oct/2019 21:34

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 45 messages ]  Aller à la page Précédente  1, 2, 3  Suivante
Auteur Message
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 15:26 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4067
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 ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 17:55 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2090
version etoiles scintillantes (avec ajout de leger mouvement circulaire pour chaque etoiles )

Code:
;***********************************************
;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"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 18:20 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4067
: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 ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 19:21 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2090
ben des etoiles qui scintillent et qui bougent un peut (histoire de rester dans le suget "scroll" ) :mrgreen:

voici une variante

Code:
;***********************************************
;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

_________________
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"


Dernière édition par Zorro le Mer 21/Fév/2018 19:28, édité 1 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 19:27 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6856
Localisation: IDF (Yvelines)
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:

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.70 LTS
➽ Je papote aussi sur http://purebasic.chat

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne réponds pas aux MP techniques


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 19:30 
Hors ligne
Avatar de l’utilisateur

Inscription: Mar 31/Mai/2016 9:06
Messages: 2090
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"


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 20:24 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6856
Localisation: IDF (Yvelines)
Zorro a écrit:
regarde la variante juste au dessus de ton message ;)
Comment dire ..... C'est moche ? :mrgreen:

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.70 LTS
➽ Je papote aussi sur http://purebasic.chat

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne réponds pas aux MP techniques


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 20:26 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 4067
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 ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 20:29 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4224
Localisation: Arras, France
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:
;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:
; ******************************************************************************************************
; 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



Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 20:32 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6856
Localisation: IDF (Yvelines)
@djes : C'est fluide et c'est beau. Bravo.

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.70 LTS
➽ Je papote aussi sur http://purebasic.chat

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne réponds pas aux MP techniques


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 20:53 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4224
Localisation: Arras, France
falsam a écrit:
@djes : C'est fluide et c'est beau. Bravo.

Merci :)


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 20:59 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8767
@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 :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Mer 21/Fév/2018 21:05 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4224
Localisation: Arras, France
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.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 9:23 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4224
Localisation: Arras, France
J'ai mis le code à jour pour améliorer l'effet "univers 3d" selon la remarque d'Ar-S.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Vos plus beaux stars scroll
MessagePosté: Jeu 22/Fév/2018 9:43 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8767
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 :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 45 messages ]  Aller à la page Précédente  1, 2, 3  Suivante

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 1 invité


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye