PureBoard

Verfasst: **30.04.2006 19:35**

Hallo,

ich bin PureBasic-Anfänger, hab vorher mit Visual Basic 6.0 gearbeitet.
Ich bin grad einfach ein bischen am rumspielen um mich in PB (4.00 Beta 11) einzuarbeiten.

Nun habe ich eine Prozedur geschrieben, die mir ein Gitter aus hexagonalen Feldern zeichnet. Aber irgendwie erscheint mir die Prozedur sehr langsam, bei meinem Athlon 3200 läuft die Prozedur in einer Schleife grade mal 50 mal pro Sekunde durch. Also nicht das ich es wirklich schneller bräuchte, aber gerade als Anfänger würde es mich schon interessieren wie ich diese Prozedur optimieren kann.

So, hier der Code:

Code: Alles auswählen

Procedure DrawHexGrid(ImageID.l, PositionX.l, PositionY.l, Cols.l, Raws.l, HexSize.l)
Define.l r,d,dr,rh,nrh,drhmr,Raw,Col,ImgID_GridDraw,FColor

Raws = Raws / 2
Cols = Cols / 2
d = HexSize
r = Round(d / 2, 1)
rh = Round(r / 2, 1)
nrh = -1 * rh
dr = d + r
drhmr = d + rh - r

FColor = RGB(255,255,255)

ImgID_GridDraw = FreeImageID
FreeImageID = FreeImageID + 1
CreateImage(ImgID_GridDraw, (HexSize * Cols) + (r * Cols) + rh + 1, HexSize * Raws + r + 1)

StartDrawing(ImageOutput(ImgID_GridDraw))
FrontColor(FColor)
For Col = 0 To Cols
  For Raw = 0 To Raws
    Line(Col * dr - r, Raw * d, nrh, r)
    Line(Col * dr - r, Raw * d, r, 0)
    Line(Col * dr, Raw * d, rh, r)
    Line(Col * dr + rh, Raw * d + r, r, 0)
    Line(Col * dr + rh, Raw * d + r, nrh, r)
    Line(Col * dr + drhmr, Raw * d + r, rh, r)
  Next
Next
For Raw = 0 To Raws
  FillArea(0, Raw * d + r, FColor)
  FillArea(Cols * dr + rh, Raw * d, FColor)
Next
For Col = 0 To Cols
  FillArea(Col * dr + r, 0, FColor)
  FillArea(Col * dr - r, Raws * d + 1, FColor)
Next
StopDrawing()

StartDrawing(ImageOutput(ImageID))
DrawImage(ImageID(ImgID_GridDraw), PositionX, PositionY)
StopDrawing()

FreeImage(ImgID_GridDraw)
FreeImageID = FreeImageID - 1
EndProcedure

Verfasst: **01.05.2006 21:25**

Hi Thorium, ...

könntest Du evtl. Deinen Code noch ein wenig erweitern, so dass er eigenständig lauffähig und mit reellen Parametern bestückt ist?

Denn bei einer angenommenen Parameterangabe von z.B. Cols=5 und Raws=3 kann ich mir nicht denken, dass er dafür tatsächlich 20ms benötigt.

... 'n kleines lauffähiges Beispiel wäre also nett.

Gruß, PL.

Verfasst: **02.05.2006 17:07**

PureLust hat geschrieben:Hi Thorium, ...

könntest Du evtl. Deinen Code noch ein wenig erweitern, so dass er eigenständig lauffähig und mit reellen Parametern bestückt ist?

Denn bei einer angenommenen Parameterangabe von z.B. Cols=5 und Raws=3 kann ich mir nicht denken, dass er dafür tatsächlich 20ms benötigt.

... 'n kleines lauffähiges Beispiel wäre also nett.

Gruß, PL.

Kein Problem

Compiliert mit PB 4.00 Beta 11

Code: Alles auswählen

Declare DrawHexGrid(ImageID.l, PositionX.l, PositionY.l, Cols.l, Raws.l, HexSize.l)

Global FreeImageID.l

Define.l ImgID_Screen

If OpenWindow(0, 0, 0, 800, 600, "Testumgebung für hexagonale Algorythmen",#PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
  ImgID_Screen = FreeImageID
  FreeImageID = FreeImageID + 1
  CreateImage(ImgID_Screen, 800, 600)
  DrawHexGrid(ImgID_Screen, 20, 5, 50, 50, 20)
  StartDrawing(ImageOutput(ImgID_Screen))
  FillArea(0,0,RGB(255,255,255),RGB(150,150,150))
  StopDrawing()

  Define.l StartTime,EndTime,i
  StartTime = ElapsedMilliseconds()
  For i = 1 To 1
    DrawHexGrid(ImgID_Screen, 20, 5, 50, 50, 20)  
  Next
  EndTime = ElapsedMilliseconds()
  MessageRequester("Performacetest","Millisekunden: " + Str(endtime - starttime))
  

  CreateGadgetList(WindowID(0))
  ImageGadget(0, 0, 0, 0, 0, ImageID(0))
  
  Repeat
    EventID = WaitWindowEvent() 
  Until EventID = #PB_Event_CloseWindow  ; If the user has pressed on the window close button
  
EndIf

End

Procedure DrawHexGrid(ImageID.l, PositionX.l, PositionY.l, Cols.l, Raws.l, HexSize.l)
Define.l r,d,dr,rh,nrh,drhmr,Raw,Col,ImgID_GridDraw,FColor

Raws = Raws / 2
Cols = Cols / 2
d = HexSize
r = Round(d / 2, 1)
rh = Round(r / 2, 1)
nrh = -1 * rh
dr = d + r
drhmr = d + rh - r

FColor = RGB(255,255,255)

ImgID_GridDraw = FreeImageID
FreeImageID = FreeImageID + 1
CreateImage(ImgID_GridDraw, (HexSize * Cols) + (r * Cols) + rh + 1, HexSize * Raws + r + 1)

StartDrawing(ImageOutput(ImgID_GridDraw))
FrontColor(FColor)
For Col = 0 To Cols
  For Raw = 0 To Raws
    Line(Col * dr - r, Raw * d, nrh, r)
    Line(Col * dr - r, Raw * d, r, 0)
    Line(Col * dr, Raw * d, rh, r)
    Line(Col * dr + rh, Raw * d + r, r, 0)
    Line(Col * dr + rh, Raw * d + r, nrh, r)
    Line(Col * dr + drhmr, Raw * d + r, rh, r)
  Next
Next
For Raw = 0 To Raws
  FillArea(0, Raw * d + r, FColor)
  FillArea(Cols * dr + rh, Raw * d, FColor)
Next
For Col = 0 To Cols
  FillArea(Col * dr + r, 0, FColor)
  FillArea(Col * dr - r, Raws * d + 1, FColor)
Next
StopDrawing()

StartDrawing(ImageOutput(ImageID))
DrawImage(ImageID(ImgID_GridDraw), PositionX, PositionY)
StopDrawing()

FreeImage(ImgID_GridDraw)
FreeImageID = FreeImageID - 1
EndProcedure

Edit: Die Zeilen und Reihen werden nicht in der richtigen Anzahl gezeichnet, da bin ich etwas durcheinander gekommen, sollte jetzt aber nix zur Sache tun.

Verfasst: **02.05.2006 17:26**

Das Problem ist, dass Du Dir zu wenig Gedanken über den Lösungsweg gemacht hast. Computer sind zwar recht schnell, aber dennoch sollte man sie nur das absolute Minimum machen lassen.

Ich sehe bei Dir da mehrere Probleme.
Du zeichnest zig Hexagons und machst für jedes zig Berechnungen, anstatt das einmal vorweg zu machen und sie dann nur an der entsprechenden Stelle zu zeichnen.
Deine Hexagons überdecken sich, aber dennoch zeichnest Du 6 Linien für jedes.
Erst zeichnest Du in ein Image, dann kopierst Du das in ein anderes. Ich weiß nicht warum Du das tust, überleg Dir aber mal, ob es nicht reichen würde das erste Image nur einmal, oder bei Veränderungen zu zeichnen, und ansonsten direkt in das andere zu kopieren.

Wenn Dir das dann immernoch nicht reicht, dann gibt es auch noch ein paar andere Möglichkeiten...

Viel Spass,

Hades

Verfasst: **02.05.2006 17:40**

Hades hat geschrieben:Das Problem ist, dass Du Dir zu wenig Gedanken über den Lösungsweg gemacht hast.

Ja, das wird wohl die Wurzel des Problems sein, ich werd das ganze nochmal neu überdenken.

PureBoard

Performanceproblem

Performanceproblem