PureBasic

Vous avez codé un joli stars scroll ? Postez le code ici

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

ExamineDesktops()
xxx=DesktopWidth(0)
yyy=DesktopHeight(0)

;Ouverture de l'écran
If OpenScreen(xxx,yyy,32,"Exemple OpenScreen") = 0
  MessageRequester("Erreur", "Impossible d'ouvrir l'écran.")
  End
EndIf

Dim stars_x1(100)
Dim stars_y1(100)
For i=0 To 100
  stars_x1(i)=Random(xxx-1)
  stars_y1(i)=Random(yyy-1)
Next
Dim stars_x2(80)
Dim stars_y2(80)
For i=0 To 80
  stars_x2(i)=Random(xxx-1)
  stars_y2(i)=Random(yyy-1)
Next
Dim stars_x3(60)
Dim stars_y3(60)
For i=0 To 60
  stars_x3(i)=Random(xxx-1)
  stars_y3(i)=Random(yyy-1)
Next
Dim stars_x4(40)
Dim stars_y4(40)
For i=0 To 40
  stars_x4(i)=Random(xxx-1)
  stars_y4(i)=Random(yyy-1)
Next
Dim stars_x5(20)
Dim stars_y5(20)
For i=0 To 20
  stars_x5(i)=Random(xxx-1)
  stars_y5(i)=Random(yyy-1)
Next

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Boucle principale
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
timer=ElapsedMilliseconds()

Repeat
  
  ;Effacer complètement l'écran et afficher un fond gris
  ClearScreen(0)
  
  ;On lit les évènements clavier et souris
  ExamineKeyboard()
  
  StartDrawing(ScreenOutput())
  For i=0 To 100
    stars_x1(i)+1
    If stars_x1(i)>xxx-1
      stars_x1(i)-xxx
      stars_y1(i)=Random(yyy-1)
    EndIf
    Plot(stars_x1(i),stars_y1(i),RGB(80,80,80))
  Next
  For i=0 To 80
    stars_x2(i)+2
    If stars_x2(i)>xxx-1
      stars_x2(i)-xxx
      stars_y2(i)=Random(yyy-1)
    EndIf
    Plot(stars_x2(i),stars_y2(i),RGB(120,120,120))
  Next
  For i=0 To 60
    stars_x3(i)+3
    If stars_x3(i)>xxx-1
      stars_x3(i)-xxx
      stars_y3(i)=Random(yyy-1)
    EndIf
    Plot(stars_x3(i),stars_y3(i),RGB(160,160,160))
  Next
  For i=0 To 40
    stars_x4(i)+4
    If stars_x4(i)>xxx-1
      stars_x4(i)-xxx
      stars_y4(i)=Random(yyy-1)
    EndIf
    Plot(stars_x4(i),stars_y4(i),RGB(200,200,200))
  Next
  For i=0 To 20
    stars_x5(i)+5
    If stars_x5(i)>xxx-1
      stars_x5(i)-xxx
      stars_y5(i)=Random(yyy-1)
    EndIf
    Plot(stars_x5(i),stars_y5(i),RGB(240,240,240))
  Next  

  StopDrawing()
  
  FlipBuffers()
  
Until KeyboardPushed(#PB_Key_Escape) ;On quitte

Cool !!! J'aime bien l'effet de profondeur

Merci du partage

Code : Tout sélectionner


; Starfield
; By Dobro
; purebasic 4.00
#Police=1
#etoile=100

Enumeration ; les Gadgets		
		#Gadget_bouton1
		#Gadget_bouton2
		#sortie
EndEnumeration


Declare create_etoile3D()
;-creation etoiles
Structure etoile
		x.i
		Y.i 
		z.f
		pas.i
		couleur.i
EndStructure
Global Dim etoile.etoile(1000)



If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
		MessageBox_ (0,"Can't open DirectX 7 or later", "blahhhh", #MB_ICONINFORMATION|#MB_OK)
		End
EndIf
; ***********************************
FontID = LoadFont(#Police, "arial", 18, #PB_Font_Bold )
ExamineDesktops()
Global EcranX =800 ; DesktopWidth(0) ; GetSystemMetrics_(#SM_CXSCREEN):;=largeur de l'ecran
Global EcranY =200 ; DesktopHeight(0) ;GetSystemMetrics_(#SM_CYSCREEN):;=hauteur de l'ecran
WindowID = OpenWindow(1, 0, 0, 800, 600 , "hello",  #PB_Window_SystemMenu|#PB_Window_BorderLess |#PB_Window_ScreenCentered ) 
WindowID = WindowID(1) 
If OpenWindowedScreen(WindowID,0,200,EcranX,EcranY,0,0,0) = 0  ; l'emplacement de l'ecran
		End 
EndIf

ButtonGadget(#Gadget_bouton1, 50,500,100,30 ,"bouton1 exemple")
ButtonGadget(#Gadget_bouton2, 250,500,100,30 ,"bouton2 exemple")
TextGadget(#sortie,400,10,100,30,"")
SetFrameRate(60) 


create_etoile3D() ; precalcul de la position des etoiles dans une matrice 3D


Repeat 
		Event=WaitWindowEvent(10)   
		Select Event
				Case #PB_Event_Gadget ; on a cliqué un gadget ??
				Select EventGadget()						
						Case #Gadget_bouton1						
						SetGadgetText(#sortie, "bouton1")
						Case #Gadget_bouton2						
						SetGadgetText(#sortie, "bouton2")
				EndSelect
		EndSelect
		
		
		; *** Focale (transformation 3D->2D) ***
		;x' = (FOCALE * x) / z
		;Y' = (FOCALE * y) / z 
		;FOCALE représente la distance se trouvant entre le regard de l'utilisateur et la scène 3D.
		;Plus cette constante sera proche de 0, Plus le regard sera loin de la scène. 
		; ***********************************
		Speed=3
		FOCALE=300
		
		For i=1 To 1000
				etoile(i)\z=etoile(i)\z-Speed
				If etoile(i)\z<=1
						etoile(i)\z=1000   
				EndIf 
				
				; ********** projection ********************************
				xProjected = (FOCALE * etoile(i)\x) / etoile(i)\z+EcranX/2
				yProjected  = (FOCALE * etoile(i)\Y) / etoile(i)\z+ EcranY/2
				DisplayTransparentSprite(#etoile+i, xProjected,yProjected)
				; ****************************************************
				
		Next i
		
		
		
		
		
		FlipBuffers():; affiche l'ecran
		ClearScreen(RGB(0, 0, 0)) :;efface l'ecran
		
Until Event=#PB_Event_CloseWindow 

Procedure create_etoile3D()
		;-Creation des 1000 etoiles 3D
		;By Dobro
		For i=1 To 1000
				etoile(i)\x=-EcranX/2 + (Random(EcranX) + 1) 
				etoile(i)\Y=-EcranY/2 + (Random(EcranY) + 1) 
				etoile(i)\z=Random(1000)+1
				etoile(i)\pas=(Random(3)+1)*2
				etoile(i)\couleur=RGB(Random(255),Random(255),Random(255)) ; couleur des etoiles
				CreateSprite(#etoile+i,2,2)
				StartDrawing(SpriteOutput(#etoile+i))
						Circle(2,2,4,etoile(i)\couleur)
				StopDrawing()
		Next i
		
		
EndProcedure


; Epb

Interessant

Code : Tout sélectionner

Enumeration Sprites
  #Star
  #Star2
  #Star3
  #Star4
EndEnumeration

DisableDebugger

Declare IniSpr()
Declare CreaStar()
Declare iniStar()

#NbrStar = 600

Define.i   ev 
Global.b Quit
Global.i SL, SH, FL, FH


If InitSprite()<>0 And InitMouse()<>0 And InitKeyboard()<>0 
  
Else
  MessageRequester("erreur","initialisation")
  End
EndIf


; Gestion de la résolution
ExamineDesktops()
FL = DesktopWidth(0)
FH = DesktopHeight(0)


; *************************************************
;- Initialisation des éléments de stockage         *
; *************************************************

Structure star
  ID.i
  X.i
  Y.i
  Vit.i
EndStructure


Global Dim Star.Star(#NbrStar)
; ------------------------------------------------


Macro ET(Val)
  Star(i)\Val
EndMacro


; *************************************************
;-          CREATION DES SPRITES                    *
; *************************************************


Procedure CreaStar()
  CreateSprite(#Star,1,1)
  CreateSprite(#Star2,2,2)
    CreateSprite(#Star3,1,1)
    CreateSprite(#Star4,2,2)
    
 StartDrawing(SpriteOutput(#Star))
  Box(0,0,1,1,$FFFFFF)
  StopDrawing()
  
  StartDrawing(SpriteOutput(#Star2))
  Box(0,0,2,2,$acacac)
  StopDrawing()
  
  StartDrawing(SpriteOutput(#Star3))
  Box(0,0,1,1,$FFFFFF)
  StopDrawing()
  
 StartDrawing(SpriteOutput(#Star4))
  Box(0,0,2,2,$acacac)
  StopDrawing()
  
EndProcedure



; *************************************************
;-          INITIALISATION DES SPRITES             *
; *************************************************

Procedure iniStar()
  For i = 0 To #NbrStar
    ET(ID)    = Random(#Star4,#Star)
    ET(X)     = Random(FL) 
    ET(Y)     = Random(FH) 
    ET(Vit)   =Random(8,1)
  Next
EndProcedure



; *************************************************
;-              AFFICHAGE DES SPRITES              *
; *************************************************


Procedure ShowStar()
  For i=0 To #NbrStar
    DisplayTransparentSprite(ET(ID),ET(X),ET(Y),Random(255,200))
    
    ET(X) + ET(Vit)
    If ET(X) > FL
      ET(X) = - Random(25)
    EndIf
  Next
EndProcedure



; *************************************************
;-                   Programme                     *
; *************************************************
OpenScreen(FL, FH, 32, "")
SetFrameRate(60)

CreaStar()
iniStar()

Repeat
  
  ExamineKeyboard()
  ClearScreen(0)
  ShowStar()
  FlipBuffers()

Until KeyboardPushed(#PB_Key_Escape) 

End

Es tu vicieux au point de Ploter à tout va SPH ?

Cette fonction est gourmande, autant créer un,deux ou Xn sprite puis les afficher N fois à l'ecran.

Ar-S a écrit :Es tu vicieux au point de Ploter à tout va SPH ?
Cette fonction est gourmande, autant créer un,deux ou Xn sprite puis les afficher N fois à l'ecran.

J'avais testé il y a longtemps la rapidité d'un plot par rapport a un sprite. A l'epoque, un plot etait plus rapide et je pense qu'il en est de meme aujourdhui.

Je me mêle à la battle avec ce code qui emprunte des textures figurant dans le dossier d'installation de PureBasic.

Code : Tout sélectionner

EnableExplicit

Global StarsMax = 5000, StarSpeed.f = 0.1, Width, Height 

Structure Vector
  x.f
  y.f
  z.f
EndStructure
Global Dim Stars.Vector(StarsMax)

Declare LoadGame()
Declare StarsInit()
Declare StarsRender()

LoadGame()

Procedure LoadGame()
  InitSprite()
  InitKeyboard()
  UsePNGImageDecoder()
  
  If ExamineScreenModes()
    While NextScreenMode()
      Width = ScreenModeWidth()
      Height = ScreenModeHeight()    
    Wend
  EndIf
  
  OpenScreen(Width, Height, 32, "")
  
  LoadSprite(0, #PB_Compiler_Home+ "Examples\3D\Data\Textures\smoke.png", #PB_Sprite_AlphaBlending)
  ZoomSprite(0, 7, 7)
  
  LoadSprite(1, #PB_Compiler_Home+ "Examples\3D\Data\Textures\glass_Dirt.png", #PB_Sprite_AlphaBlending)
  ZoomSprite(1, Width, Height)
  
  LoadSprite(2, #PB_Compiler_Home+ "Examples\3D\Data\Textures\aureola.png", #PB_Sprite_AlphaBlending)
  ZoomSprite(2, Width/4, Height/4)
  
  StarsInit()
  SetFrameRate(60)
  
  Repeat  
    ExamineKeyboard()
    ClearScreen(RGB(0, 1, 8))
    StarsRender()
    FlipBuffers()
  Until KeyboardPushed(#PB_Key_Escape) 
EndProcedure

Procedure StarsInit()
  Protected n
  
  For n=0 To StarsMax
    Stars(n)\x = Random(Width) - Width/2
    Stars(n)\y = Random(Height) - Height/2 
    Stars(n)\z = Random(255)
  Next
EndProcedure

Procedure StarsRender()
  Protected n, x.f, y.f
  
  DisplayTransparentSprite(2, (Width-SpriteWidth(2))/2, (Height-SpriteHeight(2))/2, 50)
  
  For n = 0 To StarsMax
    Stars(n)\z - StarSpeed
    If Stars(n)\z < 1
      Stars(n)\z + 255 
    EndIf
    
    x = (Stars(n)\x / Stars(n)\z + Width/2.0)
    y = (Stars(n)\y / Stars(n)\z + Height/2.0)
    
    DisplayTransparentSprite(0, x, y, 255, RGB(n,n,n))
  Next
  DisplayTransparentSprite(1, 0, 0)
EndProcedure

Ca me donne envie d'en faire un aussi dans ce sens

Une approche 3D. Les commentaires sont dans le codes.

Code : Tout sélectionner

EnableExplicit

;
; Stars 3D
;
; La scene est cubique et se positionne sur 3 axes positionnés au centre de l'ecran
; - x Horizontal
; - y Vertical
; - z Profondeur

; Le point Zero de chaque axe et au centre de l'axe 

; Exemple avec l'axe x
; <---- (-10) ---------0--------- (+10) ---->   

; La camera est :
; - Centrée au point de coordonnée x:0, y:0, z0
; - Pivote à gauche ou à droite

; Les étoiles sont :
; - Positionnées aléatoirement sur les 3 axes 
; - En mouvements sur l'axe z d'avant en arriére
;


; Retourne aléatoirement un signe négatif ou positif
Macro RandomSign()
  ( Random(1)*2-1 ) 
EndMacro

;Dimension du screen
Global Width.f, Height.f 

;Camera et lumiere
Global Camera, Light

;Longueur et extrémités de chaque axe
Global EdgeLenght.f, nEdge.f, pEdge.f

;Etoiles 
Structure NewVector
  x.f
  y.f
  z.f
EndStructure

Structure NewStar
  position.NewVector
  entity.i
EndStructure
Global NewList Stars.NewStar()

;Au sommaire 
Declare GameLoad()
Declare StarsInit()
Declare RenderGame3D()
Declare RenderGame2D() 
Declare Exit()

;-Start
GameLoad()

Procedure GameLoad()
  Protected Window 
  
  If InitEngine3D() And  InitKeyboard() And InitSprite() And InitMouse() And InitSound()
    Window = OpenWindow(#PB_Any, 0, 0, 0, 0, "", #PB_Window_Maximize | #PB_Window_BorderLess)
    
    Width = WindowWidth(Window)
    Height = WindowHeight(Window)
    
    ;La longueur d'un bord du cube sera égale à la largeur de l'ecran / 100
    EdgeLenght = Width/100
    
    ;Quels sont les extrémités de chaque axe (nEdge = Extrémité négative, pEdge = Extrémité prositive)  
    nEdge  = -EdgeLenght/2
    pEdge  = EdgeLenght/2
    
    ;-[Screen]
    OpenWindowedScreen(WindowID(Window),0, 0, Width , Height)    
    KeyboardMode(#PB_Keyboard_International)  
    
    ;-[2D] Ce sprite se positionne au bas de l'ecran 
    CreateSprite(0, Width, 100, #PB_Sprite_AlphaBlending)   
    
    ;-[3D]
    
    ;-Camera & Lumiere
    Camera = CreateCamera(#PB_Any, 0, 0, 100, 100)
    CameraBackColor(Camera, RGB(0, 0, 0))
    
    Light = CreateLight(#PB_Any, RGB(255, 255, 255), 0, 1000, 200, #PB_Light_Point)
    
    ;Initialisation des etoiles 
    StarsInit()    
    
    ;-Boucle de rendu 3D
    While #True
      Repeat : Until WindowEvent() = 0
      FlipBuffers()  
      RenderGame3D()
      RenderWorld()
      RenderGame2D()
    Wend
  Else
    MessageRequester("Ooops !!", "Impossible d'initialiser l'environnement 3D")
    Exit()
  EndIf 
EndProcedure

;Initialisation des étoiles dans l'espace 3D
Procedure StarsInit()
  Protected StarMax = 1000, i
  Protected Mesh = CreateSphere(-1, 0.005)
  
  For i = 0 To StarMax
    AddElement(Stars())
    With Stars()
      \entity = CreateEntity(-1, MeshID(Mesh), #PB_Material_None)
      \position\x = (Random(EdgeLenght, 1) * RandomSign())/2
      \position\y = (Random(EdgeLenght, 1) * RandomSign())/2
      \position\z = (Random(EdgeLenght, 1) * RandomSign())/2
      MoveEntity(\entity, \position\x, \position\y, \position\z)
    EndWith
  Next
EndProcedure

Procedure RenderGame3D() 
  ;Evenements clavier
  If ExamineKeyboard()
    ;Fin
    If KeyboardReleased(#PB_Key_Escape)
      Exit()
    EndIf  
    
    ;Regarder à gauche
    If KeyboardPushed(#PB_Key_Left)
      RotateCamera(Camera, 0, 0.5, 0, #PB_Relative)
    EndIf
    
    ;Regarder à droite 
    If KeyboardPushed(#PB_Key_Right)
      RotateCamera(Camera, 0, -0.5, 0, #PB_Relative)
    EndIf    
  EndIf
  
  ;Evenements souris (Il y en a pas dans ce code)
  If ExamineMouse() : EndIf 
  
  ;Actualisation des étoiles dans l'espace 3D
  ForEach Stars()
    With Stars()
      
      ;Chaque étoile est en mouvement sur l'axe y d'avant en arriere
      \position\z + 0.1
            
      If \position\z >= pEdge
        ;Une étoile à atteint l'extrémité positive de l'axe Z
        ;On la repositionne à l'extrémité négative
        \position\z = nEdge
        
      ElseIf \position\z <= nEdge
        ;Une étoile à atteint l'extrémité négative de l'axe Z
        ;On la repositionne à l'extrémité positive
        \position\z = pEdge
      EndIf
      
      MoveEntity(\entity, \position\x, \position\y, \position\z, #PB_Absolute)
    EndWith
  Next
EndProcedure

Procedure RenderGame2D()
  ;Affichage de l'ange de rotation de la caméra
  StartDrawing(SpriteOutput(0))
    DrawingMode(#PB_2DDrawing_AllChannels)
    Box(0, 0, Width, 100, RGBA(20, 20, 20, 187))
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawText(20, 10, "Angle Camera " + Int(CameraYaw(Camera)))
    DrawText(20, 30, "Longueur d'un bord du cube contenant les étoiles : " + StrF(EdgeLenght, 2) + " gradué de " + StrF(nEdge, 2) + " à " + StrF(pEdge, 2))
    DrawText(20, 50, "Utiliser les fleches <--- ou ---> pour regarder à gauche ou à droite.")
    DrawText(20, 70, "Touche <Esc> pour quitter la scene.")    
  StopDrawing()
    
  DisplayTransparentSprite(0, 0, Height - 100)  
EndProcedure

Procedure Exit()
  End
EndProcedure

Hello,

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

https://www.youtube.com/watch?v=X6dJEAs0-Gk

C'est intéressant. 3 choses me gênent cependant.
J'ai essayé avec 800 étoiles, on a vraiment l'impression qu'il y en a que quelques dizaines à l’écran avant que ça boucle.
Ensuite cette boucle ne change pas la position des étoiles. Enfin, elle font plus boule de neige qu'étoiles une fois zoomée.
(je sais qui c'est pour l'exemple mais tant qu'à nous montrer de la belle 3D

)

Cool Dji t'as pas le droit de nous faire ça

Montre !

C'est super chouette même si les mouvements me font plus penser à une vie microscopique qu'à des étoiles.

Ar-S a écrit :J'ai essayé avec 800 étoiles, on a vraiment l'impression qu'il y en a que quelques dizaines à l’écran avant que ça boucle.

Les étoiles sont en mouvement dans un cube de dimension largeur du screen/100. La caméra étant au centre, les étoiles se répartissent en avant (cela tu les vois) en arrière (Tu ne les vois pas), au dessus (vue partielle) et en dessous (vue partielle). Peut être que ça explique ce peu d'étoiles visibles.[quote="Ar-S]Ensuite cette boucle ne change pas la position des étoiles.[/quote]je suis d'accord.

Ar-S a écrit :Enfin, elle font plus boule de neige qu'étoiles une fois zoomée.

Je ne sais pas créer des étoiles avec un code (Quoi que avec deux cubes imbriqués ça doit le faire) pour le moment interdiction d'avoir des étoiles dans l'intervale -0.9 à 0.9.

Le code est mis à jour avec ce que je viens de dire. Je vais réfléchir à la construction des étoiles.

C'est déjà bcp plus jolie comme ça

PureBasic

Vos plus beaux stars scroll

Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll

Re: Vos plus beaux stars scroll