falls es jemanden interessiert, hier das reduzierte CodeBeispiel meiner Umsetzung. Das wichtigste ist eigentlich die Funktion PlaceAttachedPearls().
Zur Bedienung: Die großen Kreise sind die Köpfe, an diese können via Drag & Drop kleine Kreise (Perlen) angehängt werden. Werden die Köpfe verschoben, folgen die angehängten Perlen mit. Steuerung ist mit der linken Maustaste. Einfach auf einen Kopf/eine Perle klicken und mit festgehaltener linken Maustaste bewegen. Viel Spaß damit.
Code: Alles auswählen
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
Structure POINT
x.l
y.l
EndStructure
CompilerEndIf
Structure sItem ;Daten der Monster auf dem Brett
status.b[10] ;Für Kopf steht hier der Index der angehängten Perle +1, für Perlen steht hier der in [0] der Index des Kopfes +1, in [1]-[3] die RGB-Werte der Perle
pos.POINT ;Position auf dem Spielfeld
lastPos.POINT[30] ;Spur der Köpfe zum plazieren der Perle (für Perlen nicht benutzt)
EndStructure
Global NewList Heads.sItem() ;Die Köpfe zum Bewegen
Global NewList Pearls.sItem() ;Perlen können an Köpfe angehängt werden
Global dragmode.b=0 ;0 = nichts wird bewegt, 1=ein Kopf wird mit der Maus bewegt, 2=eine Perle wird mit der Maus bewegt
#winMain = 1
#Canvas = 1
#HeadSize = 40 ;Durchmesser der Köpfe
#PearlSize = 25 ;Durchmesser der Perlen
#displayTrack = 1 ;Auf 1 setzen um die Bewegungsspur der Köpfe anzuzeigen, 0 blendet die Spur beim Zeichnen aus
Procedure.l Distance(*pos1.POINT, *pos2.POINT) ;Abstand zwischen zwei Punkten
ProcedureReturn Sqr((*pos1\x-*pos2\x)*(*pos1\x-*pos2\x)+(*pos1\y-*pos2\y)*(*pos1\y-*pos2\y))
EndProcedure
Procedure DrawScreen() ;Perlen und Köpfe auf das Canvas-Gadget zeichnen
StartDrawing(CanvasOutput(#Canvas))
Box(0,0,800,600,RGB(255,255,255))
;Köpfe zeichnen
If ListIndex(Heads())<>-1 ;Zwischenspeichern, falls gerade ein Kopf ausgewählt ist, z.B. weil er verschoben wird
*curHead = @Heads()
Else
*curHead = 0
EndIf
ResetList(Heads())
While NextElement(Heads())
Circle(Heads()\pos\x, Heads()\pos\y,#HeadSize/2,RGB(255,0,0))
Wend
If *curHead ;Vorheriges Element wieder auswählen
ChangeCurrentElement(Heads(),*curHead)
EndIf
;Perlen zeichnen
If ListIndex(Pearls())<>-1 ;Zwischenspeichern, falls gerade ein Kopf ausgewählt ist, z.B. weil er verschoben wird
*curPearl = @Pearls()
Else
*curPearl = 0
EndIf
ResetList(Pearls())
While NextElement(Pearls())
Circle(Pearls()\pos\x, Pearls()\pos\y,#PearlSize/2,RGB(Pearls()\status[1],Pearls()\status[2],Pearls()\status[3]))
Wend
If *curPearl ;Vorheriges Element wieder auswählen
ChangeCurrentElement(Pearls(),*curPearl)
EndIf
If #displayTrack ;Bewegungsspur der Köpfe anzeigen
ResetList(Heads())
While NextElement(Heads())
For i = 0 To 29
Circle(Heads()\lastPos[i]\x, Heads()\lastPos[i]\y,3,RGB(0,0,0))
Next
Wend
If *curHead ;Vorheriges Element wieder auswählen
ChangeCurrentElement(Heads(),*curHead)
EndIf
EndIf
StopDrawing()
EndProcedure
Procedure.l SelectItem(List Elements.sItem(), ItemSize.l, ignoreElementID.l=-1) ;Heads()- oder Pearls()-Element unter der Maus auswählen
;ItemSize=Durchmesser in Pixeln; ignoreElement kann verwendet werden um bestimmte Indizes zu ignorieren, z.B. wenn ein Element über ein anderes geschoben wird und das darunterliegende identifiziert werden soll
If ListSize(Elements())=0
ProcedureReturn 0
EndIf
Mousepos.POINT
;Bestimmt die Position auf der Karte (nicht dem gezeigten Ausschnitt!!!)
Mousepos\x = WindowMouseX(#winMain)
Mousepos\y = WindowMouseY(#winMain)
;Abfrage erfolgt in umgekehrter Reihenfolge wie das Zeichnen, damit der oberste Gegenstand (zuletzt gezeichnet) zuerst ausgewählt wird
LastElement(Elements())
Repeat
With Elements()
If mousepos\x > \pos\x - ItemSize/2 And mousepos\x < \pos\x + ItemSize/2
If mousepos\y > \pos\y - ItemSize/2 And mousepos\y < \pos\y + ItemSize/2
;Gegenstand ausgewählt
If ListIndex(Elements()) <> ignoreElementID
ProcedureReturn 1
Break
EndIf
EndIf
EndIf
EndWith
Until Not PreviousElement(Elements())
EndProcedure
Procedure PlaceAttachedPearls(*Head.sItem) ;Berechnet die Position der angehängten Perlen des übergebenen Kopfes neu
tmpPos.Point
Distance.l ;Abstand zwischen Zentrum Kopf und Perle für die erste Perle, bzw. zwischen zwei Perlen für alle weitere
tmpDistance.l ;Distanz für Bezugspunkt, wird iterativ an Distance angenähert
PPos.POINT ;Zentrum des Kopfs bzw. der vorhergehenden Perle = Bezugspunkt für die aktuelle Perle
PPos\x = *Head\pos\x ;Für die erste Perle ist der Bezugspunkt das Zentrum des Kopfes
PPos\y = *Head\pos\y
tmpDistance = Distance(PPos,*Head\lastPos[0])
i=0 ;Laufvariable für die Spur
For num = 0 To 9 ;max. 10 Perlen pro Kopf
If *Head\status[num] = 0 ;Keine weiteren Perlen angehängt
Break
EndIf
If num=0
Distance = (#HeadSize + #PearlSize)/2
ElseIf num=1 ;Gilt dann auch entsprechend für alle weitere, so muss Distance nur 1x beschrieben werden
Distance = #PearlSize
EndIf
;ersten Punkt auf der Spur bestimmen, der zu weit weg ist
tmpDistance = Distance(PPos,*Head\lastPos[i])
While tmpDistance < Distance
i+1
If i=30 ;Ende der Spur erreicht
Break
EndIf
tmpDistance = Distance(PPos,*Head\lastPos[i])
Wend
If i=30 ;kein Platz mehr auf der Spur
tmpPos\x = *Head\lastPos[29]\x
tmpPos\y = *Head\lastPos[29]\y
Else
;Position zwischen den zwei Punkten der Spur intrapolieren in 5%-Schritten
l.f=0.0
;weiter annähern
dx.f=*Head\lastPos[i]\x - PPos\x
dy.f=*Head\lastPos[i]\y - PPos\y
CopyMemory(@*Head\lastPos[i],@tmpPos,SizeOf(POINT)) ;tmpPos wird iterativ in 5%-Schritten zwischen dem Punkt auf der Spur und dem Bezugspunkt verschoben, bis der Abstand stimmt
While tmpDistance > Distance+2 ;Eine Genauigkeit von 2 Pixeln ist ausreichend
l+0.05
If l > 1.09 ;passiert ggf. beim zurückschieben, Versuche es dann in die andere Richtung
l=0.1
While tmpDistance > Distance
l+0.05
If l > 1.09 ;passiert ggf. beim zurückschieben => Aufgeben und einfach plazieren
tmpPos\x = *Head\lastPos[i]\x
tmpPos\y = *Head\lastPos[i]\y
Break
EndIf
tmpPos\x = *Head\lastPos[i]\x + dx*l
tmpPos\y = *Head\lastPos[i]\y + dy*l
Wend
Break
EndIf
tmpPos\x = *Head\lastPos[i]\x - dx*l
tmpPos\y = *Head\lastPos[i]\y - dy*l
tmpDistance = Distance(PPos,tmpPos)
Wend
EndIf
;Position übernehmen
SelectElement(Pearls(),*Head\status[num]-1)
Pearls()\pos\x = tmpPos\x
Pearls()\pos\y = tmpPos\y
CopyMemory(@tmpPos,@PPos,SizeOf(POINT));Zentrum der letzten Perle auf der Spur als neuen Bezugspunkt speichern
Next
EndProcedure
Procedure AttachCurPearl() ;Fügt das aktuell ausgewählte Element in Pearls() dem aktuell ausgewähtlen Kopf aus Heads() hinzu
Pearls()\status[0] =ListIndex(Heads())+1
If Pearls()\status[0]=0
ProcedureReturn ;Kein Kopf ausgewählt
EndIf
For i = 0 To 9
If Heads()\status[i]=0
Heads()\status[i] = ListIndex(Pearls())+1
Break
EndIf
Next
If i=10 ;kein freier Platz
MessageRequester("Fehler","Pro Kopf können maximal 10 Perlen angehängt werden.")
Else
PlaceAttachedPearls(Heads())
EndIf
EndProcedure
Procedure DetachCurPearl(relocate.b=1);Löst das aktuell ausgewählte Element in Pearls() von seinem Kopf, wenn relocate = 1 wird es an das Ende der Reihe gesetzt, bei 0 wird die Position nicht verändert (relocate wird in diesem Beispiel aber nicht verwendet)
If Pearls()\status[0]=0 ;Nicht angehängt
ProcedureReturn
EndIf
*curHead = @Heads()
SelectElement(Heads(), Pearls()\status[0]-1)
*tmpElement = @Pearls() ;Ausgewähltes Trnasportmittel zwischenspeichern, es wird an das Ende der Kette gesetzt und gelöst
tmpPos0.POINT ;speichert die Position des vorherigen ELements zwischen
tmpPos1.POINT ;speichert die Position des aktuellen ELements zwischen
CopyMemory(@Pearls()\pos,@tmpPos0,SizeOf(POINT))
For i = 0 To 9
If Heads()\status[i]=ListIndex(Pearls())+1
For j=i+1 To 9
If Heads()\status[j]<>0
SelectElement(Pearls(),Heads()\status[j]-1)
CopyMemory(@Pearls()\pos,@tmpPos1,SizeOf(POINT)) ;Aktuelle Position speichern
CopyMemory(@tmpPos0,@Pearls()\pos,SizeOf(POINT)) ;Eins nach vorne rücken
CopyMemory(@tmpPos1,@tmpPos0,SizeOf(POINT)) ;aktuelle Position für nächstes Element speichern
Heads()\status[j-1] = Heads()\status[j]
Else
Heads()\status[j-1] = 0
Break
EndIf
Next
Heads()\status[9]=0
Break
EndIf
Next
ChangeCurrentElement(Pearls(),*tmpElement)
Pearls()\status[0] = 0 ;lösen
If relocate
CopyMemory(@tmpPos0,@Pearls()\pos,SizeOf(POINT)) ;Ans Ende der Kette setzen
EndIf
If *curHead = 0
ResetList(Heads())
Else
ChangeCurrentElement(Heads(), *curHead)
EndIf
EndProcedure
Procedure DragItem(*Element.sItem, isHead.b=0) ;Köpfe haben eine eigene Größe und es muss die Spur mitverfolgt werden
*Element\pos\x = WindowMouseX(#winMain)
*Element\pos\y = WindowMouseY(#winMain)
If isHead ;Spur nachzeichnen
tmpDistance = Distance(*Element\pos,*Element\lastPos[0])
If tmpDistance>#HeadSize/4 ;Neuen Punkt hinzufügen
;Track anpassen
MoveMemory(@*Element\lastPos[0],@*Element\lastPos[1],SizeOf(POINT)*29)
CopyMemory(@*Element\pos,@*Element\lastPos[0],SizeOf(POINT))
EndIf
PlaceAttachedPearls(*Element) ;angehängte Perlen neu plazieren
EndIf
EndProcedure
Procedure LeftButtonDown()
If SelectItem(Heads(),#HeadSize) ;Abfrage ob ein Kopf ausgewählt ist um diesen zu verschieben
dragmode = 1
ElseIf SelectItem(Pearls(),#PearlSize) ;Abfrage ob eine Perle ausgewählt wurde
If Pearls()\status[0]<>0 ;Perle ist bereits an einen Kopf angehängt -> abhängen
DetachCurPearl(0);Abhängen ohne Position zu verändern
EndIf
dragmode = 2
EndIf
EndProcedure
Procedure MouseMove() ;Event MouseMove
Select dragmode
Case 1 ;Köpfe
DragItem(Heads(),1)
Case 2 ;Perlen
DragItem(Pearls())
EndSelect
EndProcedure
Procedure LeftButtonUp() ;Event LeftButtonUp
Select dragmode
Case 1 ;Kopf
ResetList(Heads())
Case 2 ;Perle
;Prüfen ob auf einem Kopf abgelegt wurde und dann entsprechend an diesen anhängen
If SelectItem(Heads(),#HeadSize)
;Perle an Kopf anhängen
AttachCurPearl()
Else ;Prüfen ob auf einer Perle abgelegt wurde, die bereits an einem Kopf hängt
*curElement = @Pearls()
If SelectItem(Pearls(),#PearlSize,ListIndex(Pearls())) ;das Aktuelle Element wird bei der Überprüfung ignoriert
If Pearls()\status[0] ;das ELement unter der Maus ist einem Kopf zugeordnet -> verschobenes Element auch anhängen
SelectElement(Heads(),Pearls()\status[0] -1)
ChangeCurrentElement(Pearls(),*curElement)
AttachCurPearl()
EndIf
EndIf
EndIf
ResetList(Pearls())
EndSelect
dragmode = 0
EndProcedure
Procedure InitItems() ;Köpfe und Perlen erstellen und auf dem Bidschirm plazieren
For i = 0 To 3 ;Vier Köpfe auf dem Bildschirm plazieren
AddElement(Heads())
With Heads()
\pos\x = #HeadSize/2 + (#HeadSize+10)*i
\pos\y = (#HeadSize+10)
For j=0 To 29 ;Startspur plazieren
\lastPos[j]\x = \pos\x
\lastPos[j]\y = \pos\y + j*#HeadSize/4
Next
EndWith
Next
For i = 0 To 19 ;20 Perlen auf dem Bildschirm zufällig verteilen
AddElement(Pearls())
With Pearls()
\pos\x = Random(800-#PearlSize/2,#PearlSize/2)
\pos\y = Random(600-#PearlSize/2,#PearlSize/2)
;Zufällige Farbe
\status[1] = Random(128)
\status[2] = Random(128)
\status[3] = Random(128)
EndWith
Next
EndProcedure
OpenWindow(#winMain,0,0,800,600,"Perlenschnur",#PB_Window_ScreenCentered)
CanvasGadget(#Canvas,0,0,800,600)
InitItems() ;Köpfe und Perlen erstellen
Repeat
Event = WaitWindowEvent()
EventType = EventType()
Select EventType
Case #PB_EventType_MouseMove
MouseMove()
Case #PB_EventType_LeftButtonUp
LeftButtonUp()
Case #PB_EventType_LeftButtonDown
LeftButtonDown()
EndSelect
DrawScreen()
Until Event = #PB_Event_CloseWindow
