PureBoard

Verfasst: **08.01.2008 14:28**

diese procedure kann man aber recht einfach als macro schreiben. hat bei mir schon ausgereicht, um es richtig schnell zu machen.

Code: Alles auswählen

Macro bound(i,a,b)
  ( i + b*(0 Or i<a) - b*(0 Or i>b) )
EndMacro

Verfasst: **08.01.2008 16:30**

In meiner Version muss das ganze aber nicht x * y mal gemacht werden,
sondern nur (y + x*y/2) mal oft.
Und es sind weniger Berechnungen dafür notwendig, nämlich nur zwei
Additionen und zwei Vergleiche pro Koordinate.

Aber ich bin auch mal gespannt wie Stargate das mit seinem großen Sprite
macht.

Verfasst: **08.01.2008 16:56**

///Doppelpost:

Hab's grad noch schneller bekommen:

///Edit:
Hab noch ein bisschen daran rumgewerkelt, damit es beim Setzen,
Löschen und "Shufflen" nicht so ruckelt.

Code: Alles auswählen

InitSprite()
InitKeyboard()
InitMouse()

Global bb.l, bh.l, w.l, h.l, breite.l, array.l
bb = 800
bh = 600
breite.l = 3
w = bb / breite - 1
h = bh / breite - 1
array = 0
Dim f(w, h, 1)

If Not OpenWindow(0, 0, 0, bb, bh, "Test") : End : EndIf
If Not OpenWindowedScreen(WindowID(0), 0, 0, bb, bh, 0, 0, 0) : End : EndIf
If #PB_Compiler_OS = #PB_OS_Linux
  HideWindow(0, 1)
EndIf

;- bild
If CreateSprite(1, bb, bh, 0)
  StartDrawing(SpriteOutput(1))
    Box(0, 0, bb, bh, $FFFFFF)
  StopDrawing()
EndIf
If CreateSprite(0, breite, breite, 0)
  StartDrawing(SpriteOutput(0))
    Box(0, 0, breite, breite, 0)
  StopDrawing()
EndIf
If CreateSprite(2, breite, breite, 0)
  StartDrawing(SpriteOutput(2))
    Box(0, 0, breite, breite, $FFFFFF)
  StopDrawing()
EndIf

#maus = 3
If CreateSprite(#maus, 11, 16)
  StartDrawing(SpriteOutput(#maus))
    FrontColor(RGB(20, 0, 0))
    BackColor(RGB(0, 0, 0))
    LineXY(0, 0, 0, 15)
    LineXY(1, 15, 5, 11)
    LineXY(5, 11, 11, 11)
    LineXY(11, 11, 0, 0)
    FillArea(2, 5, RGB(20, 0, 0), RGB(20, 0, 0))
    TransparentSpriteColor(#maus, RGB(0, 0, 0))
  StopDrawing()
EndIf

Structure change
  x.l
  y.l
  new.l
EndStructure
NewList change.change()
Macro changefield(xp, yp, newp)
  If AddElement(change())
    change()\x = xp
    change()\y = yp
    change()\new = newp
    f(change()\x, change()\y, array) = newp
  EndIf
EndMacro

ClearList(change())
Repeat
  ClearScreen(RGB(255, 255, 255))
 
  ExamineKeyboard()
  ExamineMouse()
 
  UseBuffer(1)
  ForEach change()
    With change()
      If \new
        DisplaySprite(0, \x * breite, \y * breite)
      Else
        DisplaySprite(2, \x * breite, \y * breite)
      EndIf
    EndWith
  Next
  ClearList(change())
  
  For y = 0 To h
    ym = y - 1
    yp = y + 1
    If ym < 0 : ym = h : EndIf
    If yp > h : yp = 0 : EndIf
   
    For x = 0 To w
      xm = x - 1
      xp = x + 1
      If xm < 0 : xm = w : EndIf
      If xp > w : xp = 0 : EndIf
      
      If g
        livingaround = f(xm, ym, array)
        livingaround + f( x, ym, array)
        livingaround + f(xp, ym, array)
        livingaround + f(xm,  y, array)
        livingaround + f(xp,  y, array)
        livingaround + f(xm, yp, array)
        livingaround + f( x, yp, array)
        livingaround + f(xp, yp, array)
        exist = f(x, y, array)
        If livingaround = 3 Or (livingaround = 2 And exist)
          f(x, y, array ! 1) = 1
          If Not exist
            DisplaySprite(0, x * breite, y * breite)
          EndIf
        Else
          f(x, y, array ! 1) = 0
          If exist
            DisplaySprite(2, x * breite, y * breite)
          EndIf
        EndIf
      EndIf
    Next
  Next
 
  If g
    array ! 1
  EndIf
  UseBuffer(#PB_Default)
 
  DisplaySprite(1, 0, 0)
  DisplayTransparentSprite(#maus, MouseX(), MouseY())
 
  If KeyboardReleased(#PB_Key_R) ;RUN
    g ! 1
  EndIf
 
  If MouseButton(1)
    changefield(MouseX() / breite, MouseY()/breite, 1)
  EndIf
  If MouseButton(2)
    changefield(MouseX() / breite, MouseY()/breite, 0)
  EndIf
  If KeyboardPushed(#PB_Key_S) ;SHUFFLE
    For i = 0 To w * h / 100
      changefield(Random(w), Random(h), 1)
    Next
  EndIf
  FlipBuffers(0)
Until KeyboardPushed(#PB_Key_Escape) Or WindowEvent() = #PB_Event_CloseWindow

Verfasst: **10.01.2008 01:38**

Und hier NTQs letzte Version dann nochmals etwas überarbeitet, ein paar Zoomstufen eingebaut und weiter auf Speed getrimmt.
(Nun halt mit bis zu 1000 FPS.)

[Edit:]
Hab nochmals ein paar Veränderungen an der Bedienung vorgenommen:

Tastatur:
s = Start/Stop
i = Leben injizieren
c = alles löschen
2-7 = Zoomstufe ändern
+/- = Erhöhen bzw verringern der maximalen Framerate (Default ist nun 400 FPS)
ESC = Programm beenden

Maus:
LMB = Leben im Umfeld injizieren
RMB = Leben im Umfeld eliminieren
zzgl. Shift oder Strg = einzelnes, punktgenaues injizieren bzw. eliminieren von Leben (ideal für Pause-Modus)

Auch sterben Zellen nun ab oder mutieren, wenn sie sich zu lange nicht bewegen ("Heroes" lässt grüssen

).

Code: Alles auswählen

DisableDebugger

InitSprite() 
InitKeyboard() 

Global bb.l = 800 
Global bh.l = 600 
Global breite.l = 3 
Global w.l = bb / breite - 1 
Global h.l = bh / breite - 1 
Global array.l = 0
Define MaxFPS = 400
Define NextSecond = ElapsedMilliseconds()+1000
Define ActFPS = 0
Define FrameCounter = 0
Define altebreite = breite
Dim f(bb+1, bh+1, 2) 

If Not OpenWindow(0, 0, 0, bb, bh, "PureLife", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) : End : EndIf 
If Not OpenWindowedScreen(WindowID(0), 0, 0, bb / breite, bh / breite, 1, 0, 0) : End : EndIf 
SetFrameRate(MaxFPS)
If #PB_Compiler_OS = #PB_OS_Linux 
  HideWindow(0, 1) 
EndIf 

Structure change 
  x.l 
  y.l 
  new.l 
EndStructure 
NewList change.change() 
Macro changefield(xp, yp, newp) 
  If AddElement(change()) 
    change()\x = xp 
    change()\y = yp 
    change()\new = newp 
    f(change()\x, change()\y, array) = newp 
  EndIf 
EndMacro 

ClearList(change()) 
g = 1
Repeat 
  ClearScreen(RGB(255, 255, 255)) 
  
  ExamineKeyboard() 
	If StartDrawing(ScreenOutput())
		For y = 0 To h 
			ym = y - 1 
			yp = y + 1 
			If ym < 0 : ym = h : EndIf 
			If yp > h : yp = 0 : EndIf 
			
			For x = 0 To w 
				xm = x - 1 
				xp = x + 1 
				If xm < 0 : xm = w : EndIf 
				If xp > w : xp = 0 : EndIf 
				
				If g 
					livingaround = f(xm, ym, array) 
					livingaround + f( x, ym, array) 
					livingaround + f(xp, ym, array) 
					livingaround + f(xm,  y, array) 
					livingaround + f(xp,  y, array) 
					livingaround + f(xm, yp, array) 
					livingaround + f( x, yp, array) 
					livingaround + f(xp, yp, array) 
					exist = f(x, y, array) 
					If livingaround = 3 Or (livingaround = 2 And exist) 
						f(x, y, array ! 1) = 1
						f(x, y, 2) + 1
						If f(x, y, 2) > ActFPS << 2
							If Random(5) = 0
								For i = 0 To 15
									NewX = x + Random(10) - 5
									NewY = y + Random(10) - 5
									If NewX > 0 And NewX <= w And NewY > 0 And NewY <= h
										changefield(NewX , NewY, 1)
									EndIf
								Next
							Else
								f(x, y, array ! 1) = 0
							EndIf
						EndIf
					Else 
						f(x, y, array ! 1) = 0 
						f(x, y, 2) = 0 
					EndIf
				EndIf 
				If f(x, y, array)
					Plot( x, y, 0)
				EndIf
			Next 
		Next 
		
		If g 
			array ! 1 
		EndIf 
		FrameCounter + 1
		If ElapsedMilliseconds() >= NextSecond
			NextSecond = ElapsedMilliseconds()+1000
			ActFPS = FrameCounter
			SetWindowTitle(0, "PureLife   ("+Str(ActFPS)+" FPS)     (i) - inject life     (s) - start/stop life     +/- set MaxFPS ("+Str(MaxFPS)+")     (c) - clear     (2-7) - Zoom")
			FrameCounter = 0
		EndIf
		StopDrawing()
	EndIf
  
	If KeyboardReleased(#PB_Key_S) ;Start/Stop life
		g ! 1 
	EndIf 
  
	Event = WindowEvent()
	While Event
		Debug Event
		If Event = #PB_Event_CloseWindow : quit = #True : EndIf
		If Event = 513 : LMBPressed = #True  : EndIf
		If Event = 514 : LMBPressed = #False : EndIf
		If Event = 516 : RMBPressed = #True  : EndIf
		If Event = 517 : RMBPressed = #False : EndIf
		Event = WindowEvent()
	Wend
	If RMBPressed
		If KeyboardPushed(#PB_Key_LeftControl) Or KeyboardPushed(#PB_Key_RightControl) Or KeyboardPushed(#PB_Key_LeftShift) Or KeyboardPushed(#PB_Key_RightShift)
			changefield(WindowMouseX(0) / breite, WindowMouseY(0) / breite, 0)
		Else
			For i = 0 To 15
				NewX = WindowMouseX(0) / breite + Random(16) - 8
				NewY = WindowMouseY(0) / breite + Random(16) - 8
				If NewX > 0 And NewX <= w And NewY > 0 And NewY <= h
					changefield(NewX , NewY, 0)
				EndIf
			Next
		EndIf
	EndIf
	If LMBPressed
		If KeyboardPushed(#PB_Key_LeftControl) Or KeyboardPushed(#PB_Key_RightControl) Or KeyboardPushed(#PB_Key_LeftShift) Or KeyboardPushed(#PB_Key_RightShift)
			changefield(WindowMouseX(0) / breite, WindowMouseY(0) / breite, 1)
		Else
			For i = 0 To 15
				NewX = WindowMouseX(0) / breite + Random(16) - 8
				NewY = WindowMouseY(0) / breite + Random(16) - 8
				If NewX > 0 And NewX <= w And NewY > 0 And NewY <= h
					changefield(NewX , NewY, 1)
				EndIf
			Next
		EndIf
	EndIf
	
	If KeyboardPushed(#PB_Key_Subtract) ;decrease MaxFramerate
		If MaxFPS > 5 : MaxFPS - 1 : EndIf
		SetFrameRate(MaxFPS)
		SetWindowTitle(0, "PureLife   ("+Str(ActFPS)+" FPS)     (i) - inject life     (s) - start/stop life     +/- set MaxFPS ("+Str(MaxFPS)+")     (c) - clear     (2-7) - Zoom")
	ElseIf KeyboardPushed(#PB_Key_Add) ;increase MaxFramerate
		If MaxFPS < 1000 : MaxFPS + 1 : EndIf
		SetFrameRate(MaxFPS)
		SetWindowTitle(0, "PureLife   ("+Str(ActFPS)+" FPS)     (i) - inject life     (s) - start/stop life     +/- set MaxFPS ("+Str(MaxFPS)+")     (c) - clear     (2-7) - Zoom")
	EndIf 
  If KeyboardPushed(#PB_Key_I) ;inject life 
    For i = 0 To w * h / 100 
      changefield(Random(w), Random(h), 1) 
    Next 
  EndIf 
  If KeyboardPushed(#PB_Key_C) ;clear 
		For y = 0 To h 
			For x = 0 To w 
				f(x, y, array) = 0
			Next
		Next
  EndIf 
	; If KeyboardPushed(#PB_Key_1) : breite = 1 : EndIf  ;Zoomstufe 1
	If KeyboardPushed(#PB_Key_2) : breite = 2 : EndIf  ;Zoomstufe 2
	If KeyboardPushed(#PB_Key_3) : breite = 3 : EndIf  ;Zoomstufe 3
	If KeyboardPushed(#PB_Key_4) : breite = 4 : EndIf  ;Zoomstufe 4
	If KeyboardPushed(#PB_Key_5) : breite = 5 : EndIf  ;Zoomstufe 5
	If KeyboardPushed(#PB_Key_6) : breite = 6 : EndIf  ;Zoomstufe 6
	If KeyboardPushed(#PB_Key_7) : breite = 7 : EndIf  ;Zoomstufe 7
	If altebreite <> breite
		w = bb / breite - 1 
		h = bh / breite - 1
		FlipBuffers(1)
		Delay(100)
		CloseScreen()
		Delay(200)
		If Not OpenWindowedScreen(WindowID(0), 0, 0, bb / breite, bh / breite, 1, 0, 0) : End : EndIf
		Delay(200)
		altebreite = breite
	Else
	  FlipBuffers(0)
	EndIf
Until KeyboardPushed(#PB_Key_Escape) Or quit

Verfasst: **10.01.2008 11:29**

Schade, dass du es nicht so gelassen hast, dass es auch mit Linux
funktioniert. Und wie oft muss man noch erklären, dass man Konstanten nicht
als Zahlen schreibt, sondern die Konstanten benutzen soll.

Unter Linux hat PB noch einen Fehler mit 'OpenWindowedScreen'. Der Screen
wird nämlich nicht im Fenster geöffnet, sondern es wird ein neues Fenster
erstellt. Deswegen verstecke ich das normale Fenster auch unter Linux mit
'HideWIndow()'.

Verfasst: **10.01.2008 18:52**

NicTheQuick hat geschrieben:Schade, dass du es nicht so gelassen hast, dass es auch mit Linux
funktioniert. Und wie oft muss man noch erklären, dass man Konstanten nicht
als Zahlen schreibt, sondern die Konstanten benutzen soll.

Und schade dass Du nicht vor dem Posten nicht die Mühe gemacht hast Deine Kritik zu überprüfen.
Denn dann wäre Dir vermutlich aufgefallen das PB garkeine eigenen Konstanten für diese Events anbietet.
Die entsprechenden #WM_Konstanten würden Dir unter Linux nämlich auch nicht weiter helfen.

Ändere es doch einfach so ab, dass das mit den Events auch unter Linux funnzt (da ich hier auf dem System kein Linux mit drauf habe kann ich das leider nicht).

NicTheQuick hat geschrieben:Unter Linux hat PB noch einen Fehler mit 'OpenWindowedScreen'. Der Screen
wird nämlich nicht im Fenster geöffnet, sondern es wird ein neues Fenster
erstellt. Deswegen verstecke ich das normale Fenster auch unter Linux mit
'HideWindow()'.

Dein "HideWindow()" für Linux hab ich ja weiterhin drin gelassen (auch wenn ich es persönlich eher mit einem CompilerIf statt mit einem Laufzeit-If gelöst hätte).
Das Verstecken der Hauptfensters sollte also weiterhin funktionieren.
Was macht denn nun bei Dir die Probleme - das Umschalten der Zoomstufe .... oder der Stretch?
(Wie gesagt - hab hier auf dem System kein Linux mit dem ich das testen könnte.)

Verfasst: **10.01.2008 19:29**

Mit meiner Kritik habe ich ja die '#WM_'#Konstanten gemeint. Aber ist jetzt
auch nicht weiter wichtig.

Das Problem unter Linux ist folgendes:
'OpenWindow()' erstellt ein Fenster mit Angabe der Koordinaten an der
richtigen Stelle.
Danach öffnet 'OpenWindowedScreen()' ein neues Fenster an irgend einer
Position, also nicht über dem Fenster, das mit 'OpenWindow()' geöffnet
wurde.
Das heißt, dass 'WindowMouseXY()' dann nicht funktioniert. Ich mache dich
auch nicht dafür verantwortlich, falls du das jetzt denkst. Das können ja nur
die Linux-User wissen.
Aber den Bug mit dem 'OpenWindowedScreen()' gibt es unter Linux scheinbar
schon immer und gelöst werden will der wohl auch nicht. Und ich weß aus
anderen Programmen, dass man OpenGL-Screens in normale Fenster
einbauen kann.

Ich schätze, wenn man die Maus wieder über 'ExamineMouse()' laufen
lässt, wird es wieder funktionieren, weil sich dann 'MouseXY()' auf den
Screen bezieht.

Da ich aber gerade an meine Windows-Maschine sitze, habe ich noch keine
Lust es umzuschreiben.

PureBoard

Wie Game of Life optimieren?