[Beispiele] Sternenfeldscroller

gekkonier · Beitrag von **gekkonier** » 29.05.2009 09:48

Kann das jemand auf Linux und MacOS testen?
Habe weder das eine noch das andere am laufen!

Unter Windows funktionierts

Edit: was mich wundert ist warum plot nur funktioniert, wenn die InitSprite() verwendet wird???
Was haben gezeichnete Punkte mit Sprites zu tun?

Code: Alles auswählen

EnableExplicit

;-- CONFIGURATION

#screenwidth = 400
#screenheigth = 400
#starfieldcount = 400 ; how many stars
#starfielddepth = 4 ; in how many layers should be drawn!

;-- INIT STUFF

If InitSprite() = 0
  MessageRequester("Error","Sprite Engine!")
  End
EndIf
If InitKeyboard() = 0
  MessageRequester("Error","Keyboard Error!")
  End
EndIf
If OpenWindow(0,0,0,#screenwidth,#screenheigth,"Starfield Scroller - press esc to quit! - left/right for movement!", #PB_Window_ScreenCentered) = 0
  MessageRequester("Error","Window Error!")
  End
EndIf
If OpenWindowedScreen(WindowID(0),0,0,#screenwidth,#screenheigth,0,0,0) = 0
  MessageRequester("Error","Screen Error!")
  End
EndIf

;-- STARFIELD MVC

;-- Model

Structure Star
  xpos.i
  ypos.i
  zpos.i
EndStructure

Global Dim starfield.Star(#starfieldcount)

Define.i i

For i = 0 To #starfieldcount - 1
  starfield(i)\xpos = Random(#screenwidth-1)
  starfield(i)\ypos = Random(#screenheigth-1)
  starfield(i)\zpos = Random(#starfielddepth-1) + 1
Next

;-- Controller

Procedure starfieldmovedown()
  Define.i i
  For i = 0 To #starfieldcount - 1
    If starfield(i)\ypos < #screenheigth - starfield(i)\zpos
      starfield(i)\ypos = starfield(i)\ypos + starfield(i)\zpos
    Else
      starfield(i)\ypos = 0
    EndIf
  Next
EndProcedure

Procedure starfieldmoveright()
  Define.i i
  For i = 0 To #starfieldcount - 1
    If starfield(i)\xpos < #screenwidth - starfield(i)\zpos
      starfield(i)\xpos = starfield(i)\xpos + starfield(i)\zpos
    Else
      starfield(i)\xpos = 0
    EndIf
  Next
EndProcedure

Procedure starfieldmoveleft()
  Define.i i
  For i = 0 To #starfieldcount - 1
    If starfield(i)\xpos > starfield(i)\zpos
      starfield(i)\xpos = starfield(i)\xpos - starfield(i)\zpos
    Else
      starfield(i)\xpos = #screenwidth - starfield(i)\zpos
    EndIf
  Next
EndProcedure

Procedure starfieldupdate()
  starfieldmovedown()
  If KeyboardPushed(#PB_Key_Left)
    starfieldmoveright()
  EndIf
  If KeyboardPushed(#PB_Key_Right)
    starfieldmoveleft()
  EndIf
EndProcedure

;-- View

Procedure starfielddraw()
  Define.i i,plotx,ploty
  StartDrawing(ScreenOutput())
  For i = 0 To #starfieldcount - 1
    plotx.i = starfield(i)\xpos
    ploty.i = starfield(i)\ypos
    Plot(plotx,ploty,RGB(255,255,255))
  Next
  StopDrawing()
EndProcedure

;-- Mainloop

Repeat
  ; Window Events have to be handled..
  Define.i event
  Repeat
    event=WindowEvent()
  Until event=0
  ; Keyboard also, once per loop
  ExamineKeyboard()
 
  FlipBuffers()
  ClearScreen(RGB(0,0,0))
 
  starfieldupdate()
  starfielddraw()
 
  ; Give OS a chance to do something...
  Delay(1)
Until KeyboardPushed(#PB_Key_Escape)

Little John · Beitrag von **Little John** » 29.05.2009 10:30

Sieht ganz nett aus ... ich würde das aber nicht "Sternenfeld" nennen, sondern eher "Hektischer Schneefall".

Gruß, Little John

gekkonier · Beitrag von **gekkonier** » 29.05.2009 10:36

Wenn Sie es sagen *g*

Dadurch, dass es keine Zeitsteuerung in dem Beispiel gibt (wie schnell bewegt sich was in der Sekunde, etc.) kann es schon vorkommen dass auf sehr schnellen Rechnern das Teil abgeht wie eine wahnsinnige Giraffe!

Unter Windows in einem OpenWindowedScreen(...) kann man mittels SetFrameRate(FrameRate) eine billige Schnellregulierung einbauen - allerdings ist das wie gesagt nur für Windows funktioniell lt. Doku.

KeyKon · Beitrag von **KeyKon** » 29.05.2009 11:16

gekkonier hat geschrieben:Edit: was mich wundert ist warum plot nur funktioniert, wenn die InitSprite() verwendet wird???
Was haben gezeichnete Punkte mit Sprites zu tun?

Alle Screenbefehle hängen an InitSprite... Wenn du auf ein Image Plottest brauchste kein InitSprite, aber da du einen Screen öffnest und da drauf Malst brauchste das...

gekkonier · Beitrag von **gekkonier** » 29.05.2009 11:22

okay, danke für die Info

KeyKon · Beitrag von **KeyKon** » 29.05.2009 11:40

Ich konnts nich lassen ein bisschen mit deinem Code rummzuspielen:

Code: Alles auswählen

EnableExplicit

;-- CONFIGURATION

#screenwidth = 800
#screenheigth = 600
#starfieldcount = 2000 ; how many stars
#starfielddepth = 10000 ; in how many layers should be drawn!

#minspeed = 0.5
#maxspeed = 5

;-- INIT STUFF

If InitSprite() = 0
  MessageRequester("Error","Sprite Engine!")
  End
EndIf
If InitKeyboard() = 0
  MessageRequester("Error","Keyboard Error!")
  End
EndIf
;If OpenWindow(0,0,0,#screenwidth,#screenheigth,"Starfield Scroller - press esc to quit! - left/right for movement!", #PB_Window_ScreenCentered) = 0
;  MessageRequester("Error","Window Error!")
;  End
;EndIf
If OpenScreen(#screenwidth,#screenheigth,32,"Starfield") = 0
  MessageRequester("Error","Screen Error!")
  End
EndIf

;-- STARFIELD MVC

;-- Model

Structure Star
  xpos.d
  ypos.d
  zpos.i
EndStructure

Global Dim starfield.Star(#starfieldcount)

Define.i i

For i = 0 To #starfieldcount - 1
  starfield(i)\xpos = Random(#screenwidth-1)
  starfield(i)\ypos = Random(#screenheigth-1)
  starfield(i)\zpos = Random(#starfielddepth-1) + 1
Next

;-- Controller

Procedure starfieldmovedown()
  Define.i i
  For i = 0 To #starfieldcount - 1
    starfield(i)\ypos = starfield(i)\ypos + #minspeed + (starfield(i)\zpos*#maxspeed/#starfielddepth)
    If starfield(i)\ypos >= #screenheigth-1
      starfield(i)\ypos = 0
    EndIf
  Next
EndProcedure

Procedure starfieldmoveright()
  Define.i i
  For i = 0 To #starfieldcount - 1
    starfield(i)\xpos = starfield(i)\xpos + #minspeed + (starfield(i)\zpos*#maxspeed/#starfielddepth)
    If starfield(i)\xpos >= #screenwidth-1
      starfield(i)\xpos = 0
    EndIf
  Next
EndProcedure

Procedure starfieldmoveleft()
  Define.i i
  For i = 0 To #starfieldcount - 1
    starfield(i)\xpos = starfield(i)\xpos - #minspeed - (starfield(i)\zpos*#maxspeed/#starfielddepth)
    If starfield(i)\xpos <= 1
      starfield(i)\xpos = #screenwidth-1
    EndIf
  Next
EndProcedure

Procedure starfieldupdate()
  If Not KeyboardPushed(#PB_Key_Space)
    starfieldmovedown()
    If KeyboardPushed(#PB_Key_Left)
      starfieldmoveright()
    EndIf
    If KeyboardPushed(#PB_Key_Right)
      starfieldmoveleft()
    EndIf
  EndIf
EndProcedure

;-- View

Procedure starfielddraw()
  Define.i i,plotx,ploty
  StartDrawing(ScreenOutput())
  For i = 0 To #starfieldcount - 1
    plotx.i = Round(starfield(i)\xpos,0)
    ploty.i = Round(starfield(i)\ypos,0)
    
    
    Plot(plotx,ploty,RGB(32+(starfield(i)\zpos*223/#starfielddepth),32+(starfield(i)\zpos*223/#starfielddepth),32+(starfield(i)\zpos*223/#starfielddepth)))
  Next
  StopDrawing()
EndProcedure

;-- Mainloop

Repeat
  ; Window Events have to be handled..
  Define.i event
  Repeat
    ;event=WindowEvent()
  Until event=0
  ; Keyboard also, once per loop
  ExamineKeyboard()
 
  FlipBuffers()
  ClearScreen(RGB(0,0,0))
 
  starfieldupdate()
  starfielddraw()
 
  ; Give OS a chance to do something...
  Delay(1)
Until KeyboardPushed(#PB_Key_Escape)

Hab die Geschwindigkeit mal unabhängig von der Tiefe gemacht, dadurch kann man jetz die Tiefe sehr hoch stellen und man kann keine "Sternschichten" mehr sehen...

gekkonier · Beitrag von **gekkonier** » 29.05.2009 12:35

sehr schön!

Genau dafür ist der Code ja da!
Merci!

Kukulkan · Beitrag von **Kukulkan** » 29.05.2009 14:57

Hallo,

Da erlaube ich mir doch glatt, auf meinen Code vom Juni 2005 zu verweisen. Der hier jetzt gepostete läuft auch mit PB 4.20 (oder höher? War nur das ClearScreen() anzupassen):

http://www.purebasic.fr/german/viewtopi ... highlight=

Mit der Maus kann man den Fluchtpunkt der Perspektive ändern.

Mit den Tasten X, Y und Z kann man die Sterne bewegen. Ein Tastendruck schaltet die jeweilige Richtung ein/aus.

Als Standard startet es mit einer Z-Bewegung.

Code: Alles auswählen

; 3D-Stars (V. Schmid) 
Dim Punkte.f(2000,3)    ; Punkte mit X,Y und Z Koordinaten 
Dim BildPixel.l(2000,2) ; Berechnete Bildpunkte 
Dim d.l(3)              ; Hilfsvariable 
Dim Fluchtpunkt.f(3)    ; Fluchtpunktkoordinaten (X,Y,Z) 
; 
Global PKTAnz.l 
Global Counter.f 
; 
PKTAnz.l = 2000 
; Sterne generieren (zufällige Koordinaten) 
For x.l = 1 To PKTAnz.l 
  Punkte(x.l, 1) = Random(2000) - 1000 ; X 
  Punkte(x.l, 2) = Random(2000) - 1000 ; Y 
  Punkte(x.l, 3) = Random(2000) ; Z 
Next 
; 
If InitKeyboard() = 0 Or InitMouse() = 0 Or InitSprite() = 0 
  MessageRequester("Error", "Kann nicht initialisieren!") 
  End 
EndIf 
; 
; Initialisieren 
Fluchtpunkt(1) = 0    ; X 
Fluchtpunkt(2) = 0    ; Y 
Fluchtpunkt(3) = 2000 ; Z 
ZEbene.l = 1540 
; Welche Richtung wird gerade bewegt? 
BewegeX.b = 0 
BewegeY.b = 0 
BewegeZ.b = 1 
; 
If OpenScreen(1024, 768, 16, "Stars") 
  xOffset.l = 512 
  yOffset.l = 384 
  While KeyboardPushed(#PB_Key_Escape) = 0 
    FlipBuffers() 
    ClearScreen(RGB(0,0,0))

    ; Sterne bewegen 
    For x.l = 1 To PKTAnz.l 
      ; Z-Koordinaten der Sterne 
      If BewegeZ.b = 1 
        Punkte(x.l, 3) = Punkte(x.l, 3) + 5 
        If Punkte(x.l, 3) > 2000: Punkte(x.l, 3) = 0: EndIf 
      EndIf 
      ; Y-Koordinaten der Sterne 
      If BewegeY.b = 1 
        Punkte(x.l, 2) = Punkte(x.l, 2) + 5 
        If Punkte(x.l, 2) > 1000: Punkte(x.l, 2) = -1000: EndIf 
      EndIf 
      ; X-Koordinaten der Sterne 
      If BewegeX.b = 1 
        Punkte(x.l, 1) = Punkte(x.l, 1) - 5 
        If Punkte(x.l, 1) < -1000: Punkte(x.l, 1) = 1000: EndIf 
      EndIf 
    Next 
    
    ; Transfer der Sterne nach 2D 
    For x.l = 1 To PKTAnz.l 
      For j.l = 1 To 3 
        d(j.l) = Fluchtpunkt(j.l) - Punkte(x.l, j.l) 
      Next 
      Lambda.f = (ZEbene.l - Punkte(x.l, 3)) / d(3) 
      BildPixel(x.l, 1) = xOffset.l + Punkte(x.l, 1) + Lambda.f * d(1) ; X 
      BildPixel(x.l, 2) = yOffset.l + Punkte(x.l, 2) + Lambda.f * d(2) ; Y 
    Next 
    
    ; Zeichnen der Sterne 
    StartDrawing(ScreenOutput()) 
    Counter.f = Counter.f + 0.005 
    If Counter.f > 3.1415 * 2: Counter.f = 0: EndIf 
    For x.l = 1 To PKTAnz.l 
      If BildPixel(x.l, 1) > 0 And BildPixel(x.l, 1) < 1023 And BildPixel(x.l, 2) > 0 And BildPixel(x.l, 2) < 767 
        Farbe.l = Punkte(x.l, 3) / 8 
        If Farbe.l > 100 
          ; Stern 
          Farbwert2.l = RGB(Farbe.l - 60,Farbe.l - 60,Farbe.l - 60) 
          Plot(BildPixel(x.l, 1), BildPixel(x.l, 2), RGB(Farbe.l, Farbe.l, Farbe.l)) 
          Plot(BildPixel(x.l, 1) - 1, BildPixel(x.l, 2), Farbwert2.l) 
          Plot(BildPixel(x.l, 1) + 1, BildPixel(x.l, 2), Farbwert2.l) 
          Plot(BildPixel(x.l, 1), BildPixel(x.l, 2) - 1, Farbwert2.l) 
          Plot(BildPixel(x.l, 1), BildPixel(x.l, 2) + 1, Farbwert2.l) 
        Else 
          ; Punkt 
          Plot(BildPixel(x.l, 1), BildPixel(x.l, 2), RGB(Farbe.l, Farbe.l, Farbe.l)) 
        EndIf 
      EndIf 
    Next 
    StopDrawing() 
    
    ; Tasten für Ein-Auschalten der Richtungen 
    If KeyboardPushed(#PB_Key_X) 
      BewegeX.b = BewegeX.b + 1: If BewegeX.b = 2: BewegeX.b = 0:EndIf 
      Delay(150) 
    EndIf 
    
    If KeyboardPushed(#PB_Key_Y) 
      BewegeY.b = BewegeY.b + 1: If BewegeY.b = 2: BewegeY.b = 0:EndIf 
      Delay(150) 
    EndIf 
    
    If KeyboardPushed(#PB_Key_Z) 
      BewegeZ.b = BewegeZ.b + 1: If BewegeZ.b = 2: BewegeZ.b = 0:EndIf 
      Delay(150) 
    EndIf 
    
    ; Fluchtpunkt nach Maus ausrichten 
    Fluchtpunkt(1) = Fluchtpunkt(1) + MouseDeltaX() 
    Fluchtpunkt(2) = Fluchtpunkt(2) + MouseDeltaY() 
    
    ; Fluchtpunkt(1) = Fluchtpunkt(1) + Sin(Counter.f)*2 
    ; Fluchtpunkt(2) = Fluchtpunkt(2) + Cos(Counter.f)*2 
    ; Fluchtpunkt(3) = Fluchtpunkt(3) + Sin(Counter.f)*2 
    
    ; Tastatur abfragen 
    ExamineKeyboard() 
    ExamineMouse() 
  Wend 
  CloseScreen() 
  End 
Else 
  MessageRequester("Error", "Kann Bildschirm nicht öffnen!") 
EndIf

Viel Spass...

Volker

gekkonier · Beitrag von **gekkonier** » 29.05.2009 15:21

auch sehr fein!
coole sache das!

Beitrag von **Andesdaf** » 29.05.2009 15:46

schöne Sache.

PureBoard

[Beispiele] Sternenfeldscroller

[Beispiele] Sternenfeldscroller

Re: [Beispiel] Sternenfeldscroller