PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

[Beispiele] Sternenfeldscroller

https://www.purebasic.fr/german/viewtopic.php?t=20104

Seite 1 von 1

[Beispiele] Sternenfeldscroller

Verfasst: 29.05.2009 09:48
von gekkonier
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)

Verfasst: 29.05.2009 10:30
von Little John
Sieht ganz nett aus ... ich würde das aber nicht "Sternenfeld" nennen, sondern eher "Hektischer Schneefall". ;-)

Gruß, Little John

Verfasst: 29.05.2009 10:36
von gekkonier
:mrgreen:
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.

Re: [Beispiel] Sternenfeldscroller

Verfasst: 29.05.2009 11:16
von KeyKon
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...

Verfasst: 29.05.2009 11:22
von gekkonier
okay, danke für die Info ;)

Verfasst: 29.05.2009 11:40
von KeyKon
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...

Verfasst: 29.05.2009 12:35
von gekkonier
sehr schön! ;)

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

Verfasst: 29.05.2009 14:57
von Kukulkan
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

Verfasst: 29.05.2009 15:21
von gekkonier
auch sehr fein!
coole sache das!
:allright:

Verfasst: 29.05.2009 15:46
von Andesdaf
schöne Sache. :allright:
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de