BPS #11: Punkt für Punkt - Auswertung

Übersicht BlitzBasic Beginners-Corner

Neue Antwort erstellen

Xeres

Moderator

Betreff: BPS #11: Punkt für Punkt - Auswertung

 BeitragMo, Aug 22, 2011 0:54
Antworten mit Zitat
Benutzer-Profile anzeigen
Der Weg ist das Ziel - wer hat einen Weg gefunden?

Das war die Aufgabe

Postet hier eure Ergebnisse, Codes, Gedanken. Lernt von den anderen, seht euch deren Quelltext an und versucht euren eigenen zu verbessern.

Diskussion
Postet zu euren Codes stets eine kurze Erklärung mit euren Gedanken in denen ihr simpel gesagt die Frage "Wieso habe ich XY auf diese Art gelöst?" beantwortet. Beiträge, die nur den Code enthalten werden wir aus dem Thread entfernen.

Nächste Aufgabe
In zwei Wochen, wird die Musterlösung nach editiert und die nächste Aufgabe eingestellt.

Viel Spaß & viel Erfolg!

Musterlösung:
BlitzBasic: [AUSKLAPPEN] 
AppTitle("Types / Waypoints / KI")

Global gfx_w=800, gfx_h=600
Graphics(gfx_w, gfx_h, 0, 2)
SetBuffer BackBuffer()
Local Timer = CreateTimer(60)

ClsColor(255,255,255)

Const KEY_ESCAPE = 1

Const MaxNachbar = 4

Type Twaypoint
    Field x, y
    Field name$
    Field Nachbar.Twaypoint[MaxNachbar]
End Type

Type Tki
    Field x, y
    Field name$
    Field Ziel_WP.Twaypoint
    Field Letzter_WP.Twaypoint
End Type

Local wp_A.Twaypoint = CreateWaypoint("A", gfx_w*.5, gfx_h*.1) 
Local wp_B.Twaypoint = CreateWaypoint("B", gfx_w*.25, gfx_h*.33) 
Local wp_C.Twaypoint = CreateWaypoint("C", gfx_w*.75, gfx_h*.33)
Local wp_D.Twaypoint = CreateWaypoint("D", gfx_w*.25, gfx_h*.66)
Local wp_E.Twaypoint = CreateWaypoint("E", gfx_w*.75, gfx_h*.66)
Local wp_F.Twaypoint = CreateWaypoint("F", gfx_w*.5, gfx_h*.5)
Local wp_G.Twaypoint = CreateWaypoint("G", gfx_w*.5, gfx_h*.9)

ConnectWaypoints(wp_A, wp_B)
ConnectWaypoints(wp_A, wp_C)
ConnectWaypoints(wp_B, wp_D)
ConnectWaypoints(wp_C, wp_E)
ConnectWaypoints(wp_F, wp_A)
ConnectWaypoints(wp_F, wp_D)
ConnectWaypoints(wp_F, wp_E)
ConnectWaypoints(wp_F, wp_G)
ConnectWaypoints(wp_G, wp_E)
ConnectWaypoints(wp_G, wp_D)

CreateKI("Bob", Rand(0,gfx_w), Rand(0,gfx_h))
CreateKI("Alice", Rand(0,gfx_w), Rand(0,gfx_h))
CreateKI("Nimbus", Rand(0,gfx_w), Rand(0,gfx_h))

Repeat
    Cls
    
    DrawWaypoints()
    UpdateKI()
    
    Flip(0)
    WaitTimer(Timer)
Until KeyHit(KEY_ESCAPE)
End

Function CreateWaypoint.Twaypoint(n$, x, y)
    Local WP.Twaypoint = New Twaypoint
    WP\name = n
    WP\x = x
    WP\y = y
    Return WP
End Function

Function ConnectWaypoints(WP1.Twaypoint, WP2.Twaypoint)
    Local z1=-1, z2=-1, i
    For i=0 To MaxNachbar
        If WP1\Nachbar[i] = Null And z1=-1 Then z1=i
        If WP2\Nachbar[i] = Null And z2=-1 Then z2=i
    Next
    
    If z1=-1 Then RuntimeError("ConnectWaypoints() : Waypoint '"+WP1\name+"' hat keinen Platz mehr für einen neuen Nachbar!")
    If z2=-1 Then RuntimeError("ConnectWaypoints() : Waypoint '"+WP2\name+"' hat keinen Platz mehr für einen neuen Nachbar!")
    
    WP1\Nachbar[z1] = WP2
    WP2\Nachbar[z2] = WP1
End Function

Function DrawWaypoints()
    Local WP.Twaypoint
    For WP = Each Twaypoint
        Color(0,255,0)
        Oval(WP\x-16, WP\y-16, 32, 32)
        Color(0,0,0)
        Text(WP\x, WP\y, WP\name, True, True)
    Next
End Function

Function CreateKI.Tki(n$, x, y)
    Local ki.Tki = New Tki
    ki\name = n
    ki\x = x
    ki\y = y
    
    Local Stopp = Rand(1,4)
    Local wp.Twaypoint= First Twaypoint
    Local i
    For i=0 To Stopp
        wp = After wp
    Next
    ki\Ziel_WP = wp
End Function

Function UpdateKI()
    Local ki.Tki
    For ki = Each Tki
        
        Local vx# = ki\Ziel_WP\x - ki\x
        Local vy# = ki\Ziel_WP\y - ki\y
        Local vbetrag# = Sqr(vx*vx+vy*vy)
        vx = vx/vbetrag
        vy = vy/vbetrag
        
        If vbetrag > 5 Then
            ki\x = ki\x + vx*3
            ki\y = ki\y + vy*3
        Else
            Local NewWP.Twaypoint
            Repeat
                NewWP = ki\Ziel_WP\Nachbar[Rand(0, MaxNachbar)]
                If NewWP <> Null Then 
                    If NewWP <> ki\Letzter_WP Then Exit
                EndIf
            Forever
            ki\Letzter_WP = ki\Ziel_WP
            ki\Ziel_WP = NewWP 
        EndIf
        
        Color(128,128,255)
        Oval(ki\x-8, ki\y-8, 16, 16)
        Color(0,0,0)
        Text(ki\x, ki\y+12, ki\name, True, True)
    Next
End Function
Win10 Prof.(x64)/Ubuntu 16.04|CPU 4x3Ghz (Intel i5-4590S)|RAM 8 GB|GeForce GTX 960
Wie man Fragen richtig stellt || "Es geht nicht" || Video-Tutorial: Sinus & Cosinus
THERE IS NO FAIR. THERE IS NO JUSTICE. THERE IS JUST ME. (Death, Discworld)
  • Zuletzt bearbeitet von Xeres am So, Sep 04, 2011 16:12, insgesamt 2-mal bearbeitet

count-doku

 BeitragMo, Aug 22, 2011 17:14
Antworten mit Zitat
Benutzer-Profile anzeigen
Jop Aufgabe ist gelöst.

Zuerst einmal der Code:
BlitzBasic: [AUSKLAPPEN] 
Graphics 800,600,32,2	;Grafikfenster erstellen
SetBuffer BackBuffer()  ;Auf den BackBuffer
SeedRnd MilliSecs()		;Damit des 6eck zufällig ist

;Types
Type TPoint ;Type für alle Punkte
	Field x,y ;Postion
	Field id  ;Eindeutige Nummer
End Type
Type TLink ;Type für die Verbindungen
	Field pls.TPoint ;Erster (Start-)point
	Field ple.TPoint ;Zweiter (End-)point
	Field id ;Eindeutige Nummer, again!
End Type
Type TChar ;Type für die Charaktere/Objekte whatever
	Field akt.TPoint,lastp ;Aktueller point ( type ref) , letzter point (id)
	Field x#,y#,winkel# ;Postion und Winkel zum nächsten point
	Field id,idact ; Eindeutige Nummer (again again!) und flag zum ID anzeigen
End Type

;Globals:
Global PointID,LinkID,CharID ; Globale Zählvariablen für die IDs
Global mx,my,mh[2],md[2] ;Mausvars
Global lastrand ;Letzter Random
Global POINTFLAG=1,LINKFLAG=1,CHARFLAG=1,TIMERFLAG=0 ;Anzeigeflags


;Multiplikator für unterschiedliche Auflösungen berechnen
Global xoff=0,yoff=0,xmul#,ymul#
xmul=GraphicsWidth()/800.0
ymul=GraphicsHeight()/600.0

;Punkte halbzufällig erstellen, ref für Verbindungen zwischenspeichern
Local p0.TPoint=CreatePunkt( xoff + ( ( 100 + Rand( -50,100 ) ) * xmul ),yoff + ( ( 300 + Rand( -150,150 ) ) * ymul ) ) ; Links
Local p5.TPoint=CreatePunkt( xoff + ( ( 700 + Rand( -100,50 ) ) * xmul ),yoff + ( ( 300 + Rand( -150,150 ) ) * ymul ) ) ; Rechts

Local p1.TPoint=CreatePunkt( xoff + ( ( 300 + Rand( -100,100 ) ) * xmul ),yoff + ( ( 100 + Rand( -50,100 ) ) * ymul ) ) ; Oben Links
Local p2.TPoint=CreatePunkt( xoff + ( ( 500 + Rand( -100,100 ) ) * xmul ),yoff + ( ( 100 + Rand( -50,100 ) ) * ymul ) ) ; Oben Rechts

Local p3.TPoint=CreatePunkt( xoff + ( ( 300 + Rand( -100,100 ) ) * xmul ),yoff + ( ( 500 + Rand( -100,50 ) ) * ymul ) ) ; Unten Links
Local p4.TPoint=CreatePunkt( xoff + ( ( 500 + Rand( -100,100 ) ) * xmul ),yoff + ( ( 500 + Rand( -100,50 ) ) * ymul ) ) ; Unten Rechts

Local p6.TPoint=CreatePunkt( xoff + ( ( 400 + Rand( -100,100 ) ) * xmul ),yoff + ( ( 400 + Rand( -100,100 ) ) * ymul ) ) ; Mitte

;Aussenring verbinden
CreateConnection(p0,p1)
CreateConnection(p1,p2)
CreateConnection(p2,p5)
CreateConnection(p5,p4)
CreateConnection(p4,p3)
CreateConnection(p3,p0)

;Verbindungen zum Innenpunkt
CreateConnection(p6,p0)
CreateConnection(p6,p5)
CreateConnection(p6,p1)

RandomConnection(p6,3);Verbindungen zur Mitte zufällig verteilen (konnte mich nicht entscheiden)

;Fünf Objekte auf dem Mittelpunkt starten
For i=0 To 4
	CreateChar(p6)
Next

;------------------------------------------------
;Hauptschleife
Local timer=CreateTimer(30) ; Timer, logisch?!
Local point.TPoint
lastrand=MilliSecs()+10000
While Not KeyHit(1)
	MouseUpdate();Mausdaten speichern
	If mh[0]  ; Mit Linksklick auf markiertem point neuen Charakter/neues Objekt erzeugen
		For point.TPoint=Each TPoint
			If RectsOverlap(mx,my,1,1,point\x-(3*xmul),point\y-(3*xmul),7*xmul,7*xmul)
				CreateChar(point)
				Exit
			End If
		Next
	End If
	If mh[1] Then RandomConnection(p6,3) ;Mit Rechtsklick Verbindung zum Mittelpunkt randomen
	;Flags updaten
	If KeyHit(59) Then TIMERFLAG=1-TIMERFLAG
	If KeyHit(60) Then POINTFLAG=1-POINTFLAG
	If KeyHit(61) Then LINKFLAG=1-LINKFLAG
	If KeyHit(62) Then CHARFLAG=1-CHARFLAG
		
	Cls
	If LINKFLAG Then DrawLinks()
	If POINTFLAG Then DrawPoints()
	If CHARFLAG Then DrawChars()
	
	If TIMERFLAG 
		If MilliSecs()>lastrand Then RandomConnection(p6,3):lastrand=MilliSecs()+10000
		Text 1,1,"Randomtimer an"
	End If
	WaitTimer timer
	Flip 0
Wend
End

;------------------------------------------------
;Neue Punkte, Verbindungen, Objekte erzeugen
Function CreatePunkt.TPoint(x,y) ; Erzeugt neuen point
	Local point.TPoint=New TPoint
	point\x=x ; Daten übernehmen
	point\y=y
	point\id=PointID
	PointID=PointID+1
	Return point.TPoint
End Function
Function CreateConnection.TLink(ps.TPoint,pe.TPoint) ; Erzeugt neue Verbindung
	Local link.TLink=New TLink
	link\pls=ps ; Daten übernehmen
	link\ple=pe
	link\id=LinkID
	LinkID=LinkID+1
	Return link.TLink
End Function
Function CreateChar.TChar(startpoint.TPoint) ; Erzeugt neues Objekt / neuen Charakter
	Local char.TChar=New TChar
	char\akt=startpoint ; Daten übernehmen
	char\x=startpoint\x
	char\y=startpoint\y
	char\id=CharID
	CharID=CharID+1
	Return char.TChar
End Function
;------------------------------------------------
;Runtime-Funktionen
Function DrawPoints() ;Zeichnet alle Punkte mit weißen Kreisen
	Local point.TPoint
	Color 255,255,255
	For point.TPoint=Each TPoint 
		Oval point\x-(3*xmul),point\y-(3*xmul),7*xmul,7*xmul,1
		If RectsOverlap(mx,my,1,1,point\x-(3*xmul),point\y-(3*xmul),7*xmul,7*xmul) ; Wenn die Maus drüber ist -> ID zeigen
			Text 1,1,"point: "+point\id
		End If
	Next
End Function
Function DrawLinks() ;Zeichnet Verbindungen mit roten Linien
	Local link.TLink
	Color 255,0,0
	For link.TLink=Each TLink 
		Line link\pls\x,link\pls\y,link\ple\x,link\ple\y
	Next
End Function
Function DrawChars() ;Zeichnet die Charaktere / Objekte und ruft UpdateChar für die KI auf
	Local char.TChar
	Color 0,0,255
	For char.TChar=Each TChar ; Alle Objekte/Charaktere durchgehen
		UpdateChar(char.TChar) ; Char bewegen
		Rect char\x-(2*xmul),char\y-(2*xmul),5*xmul,5*xmul,1 ; Charakter/Objekt zeichnen
		If RectsOverlap(mx,my,1,1,char\x-(2*xmul),char\y-(2*xmul),5*xmul,5*xmul) ; Wenn die Maus drüber ist -> ID zeigen
			Text 1,1,"Objekt: "+char\id ; ID zeigen
			If mh[1] ; Daten dauerhaft zeigen
				char\idact=1-char\idact
			End If
		End If
		If char\idact
			Text char\x-15-(2*xmul),char\y-15-(2*xmul),char\id ; ID schreiben
		End If
	Next
End Function
Function UpdateChar(char.TChar) ;Berechnet die Bewegungsrichtung
	Local link.TLink,speed=1.2
	If RectsOverlap(char\x-(2*xmul),char\y-(2*xmul),1,1,char\akt\x-(3*xmul),char\akt\y-(3*xmul),7*xmul,7*xmul) ; Wenn Zielpunkt erreicht
		i=0:o=0
		For link.TLink=Each TLink ; Angrenzende links zählen
			If (link\pls=char\akt Or link\ple=char\akt) And link\id<>char\lastp
				i=i+1
			End If
		Next
		i=Rand(0,i) ; Per RAND einen auswählen
		For link.TLink=Each TLink
			If (link\pls=char\akt Or link\ple=char\akt) And link\id<>char\lastp ; Rückweg auf gleichem Weg verhindern
				If o=i ; Neuen Weg wählen
					If link\pls=char\akt 
						char\akt=link\ple
					ElseIf link\ple=char\akt
						char\akt=link\pls
					End If
					char\lastp=link\id
					Exit
				End If
				o=o+1
			End If
		Next
	End If
	If CheckLinks(char\akt,GetPointFromID(char\lastp))=0 Then speed=3
	char\winkel# =ATan2(char\akt\y-char\y, char\akt\x-char\x) ; Winkel zum Zielpunkt berechnen
	char\x=char\x+Cos(char\winkel)*speed; Charakter/Objekt bewegen
	char\y=char\y+Sin(char\winkel)*speed
End Function
Function RandomConnection(startpoint.TPoint,count=1);Verbindungen randomen
	Local link.TLink
	For link.TLink=Each TLink ;Links raussuchen
		If CheckLink(link,startpoint,Null)=1
			Repeat ;Endpunkt neu generieren 
				i=Rand(0,PointID-1)
				If CheckLinks(startpoint,GetPointFromID(i))=0 And i<>startpoint\id ; Keine 2Links übereinander / zu einem Punkt
					link\ple=GetPointFromID(i)
					count=count-1
					Exit
				End If
			Forever
		ElseIf CheckLink(link,startpoint,Null)=2
			Repeat
				i=Rand(0,PointID-1);Startpunkt neu generieren 
				If CheckLinks(startpoint,GetPointFromID(i))=0 And i<>startpoint\id ; Keine 2Links übereinander / zu einem Punkt
					link\pls=GetPointFromID(i)
					count=count-1
					Exit
				End If
			Forever
		End If	
		If count=0 Then Exit ;Wenn genug geändert wurde, exit
	Next
End Function
Function CheckLink(link.TLink,checkpoint.TPoint,otherpoint.TPoint) ;Prüft, ob eine Verbindung existiert in einem Link
	If otherpoint=Null
		If link\pls=checkpoint Then Return 1
		If link\ple=checkpoint Then Return 2
	Else
		If link\pls=checkpoint And otherpoint=link\ple Then Return 1
		If link\ple=checkpoint And otherpoint=link\pls Then Return 2
	EndIf
	Return 0
End Function	
Function CheckLinks(checkpoint.TPoint,otherpoint.TPoint) ;Prüft, ob eine Verbindung existiert
	For link.TLink=Each TLink
		If link\pls=checkpoint And otherpoint=link\ple Then Return 1
		If link\ple=checkpoint And otherpoint=link\pls Then Return 2
	Next
	Return 0
End Function	
Function GetPointFromID.TPoint(id%)
	For point.TPoint=Each TPoint
		If id=point\id Then Return point.TPoint
	Next
	Return Null
End Function
Function MouseUpdate() ; Liest die Maus und schreibts in Variablen/Blitzarrays
	mx=MouseX()
	my=MouseY()
	For i=0 To 2
		md[i]=MouseDown(i+1)
		mh[i]=MouseHit(i+1)
	Next
End Function

Ist ein wenig länger dafür (finde ich) gut strukturiert und kommentiert Wink
Die genaue Funktion kann man dem Code / Kommentaren entnehmen, sonst bitte fragen.

Grobe Beschreibung:
-Anfangs werden 6 Aussenpunkte und ein Innenpunkt erstellt,
danach verbunden.
-Die Objekte starten alle auf dem Mittelpunkt, und bewegen sich von dort zufällig auf den Wegen
-Die Richtungsänderung erfolgt bei RectsOverlap = 1
-Die neue Richtung ist <> als die Alte.
-Mit F1-F4 können verschiedene Funktionen an-/ausgeschaltet werden.
-In der Randomfunktion (F1) wird die Regel nur auf den Linien bewegen manchmal nciht eingehalten,
weil sich entsprechende Linien plötzlich ändern.

lg,
count-doku
 

LordCoder

Betreff: Seilbahnlösung

 BeitragMo, Aug 22, 2011 19:44
Antworten mit Zitat
Benutzer-Profile anzeigen
Aufgabe ebenfalls gelöst. Ich habe ein Programm, dass die sieben Punkte als Seilbahnstationen darstellt.

BlitzBasic: [AUSKLAPPEN] 


AppTitle"Weg"
; Ein paar Einstellungen
xMax=640 : yMax=480
Graphics xMax, yMax, 16, 1
SetBuffer BackBuffer()
SeedRnd MilliSecs()
Global speed=1

Dim possible (6) ; Ob einer der Punkte 0 bis 6 möglich ist
Dim xPunkte (6) ; xPosition für die 7 Punkte
Dim yPunkte (6) ; y Position für die 7 Punkte

; Punkte 0 bis 6 (fast) zufällig positionieren (zB: Punkt 1 muss immer 
;oben sein)
xPunkte(0) = Rand(xMax/3,xMax*2/3)
For i = 1 To 3 Step 2
 xPunkte(i) = Rand(20,xMax/3)
Next
For i = 2 To 4 Step 2
 xPunkte(i) = Rand(xMax*2/3,xMax-60)
Next
For i = 5 To 6
 xPunkte(i) = Rand(xMax/3,xMax*2/3)
Next

;Das selbe für die y Position
yPunkte(0) = Rand(20,yMax/3)
For i = 1 To 2
 yPunkte(i) = Rand(yMax/3,yMax/2)
Next
For i = 3 To 4
 yPunkte(i) = Rand(yMax/2,yMax*2/3)
Next
yPunkte(5)= yMax/2
yPunkte(6)= Rand(yMax*2/3,yMax-20)

; Eine Einstellung
For i = 0 To 6
 possible(i)=0
Next

;Fahrende Objekte, Typen vereinbarung
Type objects
 Field from
 Field x#
 Field y#
 Field target
 Field part#
 Field lengthx#
 Field lengthy#
End Type
Inp = Input("Anzahl? ") ; Hier kann man selber einstellen wiefiele
; Objekte herumfahren sollen
Global AnzahlObjects = Inp; Starteinstellungen für die Objects
Dim lengthx#(AnzahlObjects-1)
Dim lengthy#(AnzahlObjects-1)
Dim parts#(AnzahlObjects-1)
For i= 1 To AnzahlObjects
 car.objects = New objects
 pos = Rand (6)
 car\from = pos
 car\x# = xPunkte(pos)
 car\y# = yPunkte(pos)
 car\target = pos
 car\part# = 0
 car\lengthx# = 0
 car\lengthy# = 0
Next

;---   ---   ---
;---   Hauptprogramm   ---
;---   ---   ---

While Not KeyHit(1) 
 Cls
 Locate 1,1
 Print "To Exit just press ESC"
 MoveCar()
 draw()
 Flip
 Delay 25
Wend

; ---   ---   ---
; ---   Funktionen   ---
; ---   ---   ----

Function draw(); Zeichnet alles
 For i = 0 To 6 ; 1) 7 Punkte
  Plot xPunkte(i),yPunkte(i)
  Locate xPunkte(i),yPunkte(i)
  Print "Punkt " +(1+i)
 Next
 DrawRoad() ; 2) Striche zwischen Punkten
 car.objects = First objects : count =0; Objekte
 Repeat
  drawcar(Int(car\x#),Int(car\y#))
  Plot Int(car\x#),Int(car\y#)
  Locate car\x#-8,car\y#+6
  Print (count+1)
  car = After car
  count= count +1
 Until count=AnzahlObjects
End Function

Function MoveCar(); Alles Rechnen
 car.objects = First objects : count =0
 Repeat 
  If car\part#<0 Then 
   car\part#=0 ;Auf den Punkt fahren
   car\x# = xPunkte(car\target)
   car\y# = yPunkte(car\target)
  ElseIf car\part=0 Then
   Temp=car\from;Pause machen 
   car\from=car\target
   car\target = chooseway(car\from,Temp)   
   length(car\from,car\target,speed,count)
   car\part#=parts#(count)
   car\lengthx#=lengthx#(count)
   car\lengthy#=lengthy#(count)
  Else
   car\x#=car\x#+car\lengthx#;fahren
   car\y#=car\y#+car\lengthy#
   car\part# =car\part#-1
  EndIf
  car = After car
  count= count +1
 Until count=AnzahlObjects
End Function  
  ;Verbindungen; 01,02,05,13,24,35,36,45,46,56
Function DrawRoad() ; Einfach ein paar Striche zeichnen
 Line xPunkte(0),yPunkte(0), xPunkte(1),yPunkte(1) 
 Line xPunkte(0),yPunkte(0), xPunkte(2),yPunkte(2)
 Line xPunkte(0),yPunkte(0), xPunkte(5),yPunkte(5) 
 Line xPunkte(1),yPunkte(1), xPunkte(3),yPunkte(3) 
 Line xPunkte(2),yPunkte(2), xPunkte(4),yPunkte(4) 
 Line xPunkte(3),yPunkte(3), xPunkte(5),yPunkte(5) 
 Line xPunkte(3),yPunkte(3), xPunkte(6),yPunkte(6) 
 Line xPunkte(4),yPunkte(4), xPunkte(5),yPunkte(5) 
 Line xPunkte(4),yPunkte(4), xPunkte(6),yPunkte(6) 
 Line xPunkte(5),yPunkte(5), xPunkte(6),yPunkte(6)
End Function 



Function length(punkt1,punkt2,tempo,pos) ;Abstand zwischen 2 Punkten, um die x und y Verschiebung zu berechnen (bei konstantem Tempo)
 xDis = Abs(xPunkte(punkt1)-xPunkte(punkt2))
 yDis = Abs(yPunkte(punkt1)-yPunkte(punkt2))
 way# = Sqr(xDis*xDis+yDis*yDis)
 parts#(pos)=(way#/tempo)
 If xPunkte(punkt1) < xPunkte(punkt2) Then
  lengthx#(pos) = xDis/parts#(pos)
 Else 
  lengthx#(pos) = -xDis/parts#(pos)
 EndIf
 If yPunkte(punkt1) < yPunkte(punkt2) Then
  lengthy#(pos) = yDis/parts#(pos)
 Else 
  lengthy#(pos) = -yDis/parts#(pos)
 EndIf
End Function


Function chooseway(location,from) ;Je nach Punkt, welche Möglichkeiten offen sind, und nicht zurück

 For i=0 To 6
  possible(i)=0
 Next
 If location = 0 Then 
  If Not from=1 Then possible(1) = 1
  If Not from=2 Then possible(2) = 1
  If Not from=5 Then possible(5) = 1
 ElseIf location=1 Then
  If Not from=2 Then possible(3) = 1
  If Not from=0 Then possible(0) = 1
 ElseIf location=2 Then
  If Not from=0 Then possible(0) = 1
  If Not from=4 Then possible(4) = 1
 ElseIf location=3 Then
  If Not from=1 Then possible(1) = 1
  If Not from=5 Then possible(5) = 1
  If Not from=6 Then possible(6) = 1
 ElseIf location=4 Then
  If Not from=2 Then possible(2) = 1
  If Not from=5 Then possible(5) = 1
  If Not from=6 Then possible(6) = 1
 ElseIf location=5 Then
  If Not from=0 Then possible(0) = 1
  If Not from=3 Then possible(3) = 1
  If Not from=4 Then possible(4) = 1
  If Not from=6 Then possible(6) = 1
 ElseIf location=6 Then
  If Not from=3 Then possible(3) = 1
  If Not from=4 Then possible(4) = 1
  If Not from=5 Then possible(5) = 1
 EndIf


 If countposs() = 1 Then ; Je nachdem wieviele Verknüpfungen vorhanden sind
  Wert1=-1
  For i = 0 To 6
   If possible(i)=1 Then 
    Wert1 = i
   EndIf
  Next
   Return Wert1
 ElseIf countposs() = 2 Then
 Wert1=-1 : Wert2=-1
  For i = 0 To 6
   If possible(i)=1 Then 
    If Wert1<>-1 Then 
     Wert2 = i
    Else 
     Wert1 = i
    EndIf
   EndIf
  Next
  If Rand(1,2)=1 Then
   Return Wert1
  Else
   Return Wert2
  EndIf
 ElseIf countposs() = 3 Then
  Wert1=-1 : Wert2=-1 : Wert3=-1
  For i = 0 To 6
   If possible(i)=1 Then 
    If Wert1<>-1 Then 
     If Wert2<>-1 Then
      Wert3 = i
     Else
      Wert2 = i
     EndIf
    Else 
     Wert1 = i
    EndIf
   EndIf
  Next
  zufall = Rand(1,3)
  If zufall=1 Then
   Return Wert1
  ElseIf zufall=2
   Return Wert2
  ElseIf zufall=3
   Return Wert3
  EndIf
 ElseIf countposs() = 4 Then
  Wert1=-1 : Wert2=-1 : Wert3=-1 : Wert4=-1
  For i = 0 To 6
   If possible(i)=1 Then 
    If Wert1<>-1 Then 
     If Wert2<>-1 Then
      If Wert2<>-1 Then
       Wert4 = i
      Else
       Wert3 = i
      EndIf
     Else
      Wert2 = i
     EndIf
    Else 
     Wert1 = i
    EndIf
   EndIf
  Next
  zufall = Rand(1,4)
  If zufall=1 Then
   Return Wert1
  ElseIf zufall=2
   Return Wert2
  ElseIf zufall=3
   Return Wert3
  Else
   Return Wert4
  EndIf
 EndIf

End Function

Function countposs() ;Wird für die obige Funktion (chooseway) gebraucht
 sum=0
 For i=0 To 6
  If possible(i)=1 Then sum=sum+1
 Next
 Return sum
End Function

Function drawcar(x,y) ;  Zeichnet ein kleines Seilbähnchen, (drawcar, weil ich zuerst ein Auto zeichnete)
Line x,y, x,y+5
Rect x-10,y+5,20,15,0
End Function



Ich habe aber noch 2 Bugs:
- Oft kommt die Nachricht: Array out of bounds. Wenn ich es aber nocheinmal versuche, besteht der Fehler nicht mehr. Das passiert mir immer nachdem ich die anzahl der Objekte angegeben habe.

- Zweitens: Manchmal geht eine Seilbahn von Punkt 4 nach 2 und kehrt dann wieder um in richtung 4. Das dürfte es eignelich nicht machen. Ich hatte vorher schon ein solches Probleml . Das konnte ich aber finden. Ich weiss nicht warum es das macht, und ich weiss erst recht nicht, warum nur manchmal.

Falls jemand irgendwo nicht drauskommt gebe ich gerne Auskunft. (Ich glaube nicht, dass ich zuuuuu übersichtlich geschrieben habe.)

Danke für die Aufgabe.
Lg LordCoder
3. Platz BCC #60

Blitzprogger

 BeitragMo, Aug 22, 2011 19:55
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich mache auch mal mit : ) . Mein Code ist nicht halb so schön anzusehen wie der oben von count-doku oder LordCoder, aber er funktioniert. Es wird eine beliebige Anzahl von Punkten erstellt (Standardmässig 10) und beliebig viele "Autos". Der Code ist noch einmal kurz kommentiert, damit man ihn ein klein wenig besser lesen kann.
Es gibt je einen Type für Punkte, Verbindungen und Autos (oder Fahrer oder wasauchimmer).

BlitzBasic: [AUSKLAPPEN] 
Graphics 800,600,32,2
SetBuffer BackBuffer ()
SeedRnd MilliSecs ()

;punkte = anzahl punkte
;drivers = anzahl kleine rechtecke die unterwegs sind
Const punkte = 10
Const drivers = 20

;punkte
Type tp
	Field x,y,id
End Type

;verbindungen
Type tc
	Field id1,id2
End Type

;drivers oder fahrer (die kleinen rechtecke)
Type td
	Field x#,y#,id,r,g,b,s#
End Type

;die punkte werden erstellt
For i = 1 To punkte
	p.tp = New tp
	;standort
	p\x = Rand (20,780)
	p\y = Rand (20,580)
	p\id = i
Next

;die fahrer werden kreirt
For i = 1 To drivers
	d.td = New td
	;der startpunkt
	d\id = Rand (1,punkte)
	d\x = getx (d\id)
	d\y = gety (d\id)
	;sie kriegen eine zufallsfarbe
	d\r = Rand (0,255)
	d\g = Rand (0,255)
	d\b = Rand (0,255)
	;sie kriegen eine zufallsgeschwindigkeit
	d\s# = Rnd (0.5,2.0)
Next

;es werden Verbindungen zwischen den verbindungen hergestellt
For p.tp = Each tp
	For i = 0 To Rand (0,3)
		oid = Rand (1,punkte)
		If connection (p\id,oid) Then
		Else
			connect (p\id,oid)
		EndIf
	Next
Next

;hauptschleife
While Not KeyHit (1)
	Cls
	Color 255,255,255
	;punkte zeichnen
	For p.tp = Each tp
		Oval p\x-10,p\y-10,20,20,1
	Next
	Color 255,255,0
	;verbinduchen zeichnen
	For c.tc = Each tc
		Line getx (c\id1),gety (c\id1),getx (c\id2),gety (c\id2)
	Next
	;fahrer zeichnen
	Local w# ;winkel
	For d.td = Each td
		Color d\r,d\g,d\b
		Rect d\x-3,d\y-3,6,6,1
		;entkommentiert diese Linie, wenn ihr das ziel der fahrer angezeigt haben wollt
		;Line d\x,d\y,getx (d\id),gety (d\id)
		;die bewegung der fahrer wird höchst rechenlastig ermittelt, achtung, böse winkelrechnungen mit cos und sin!
		w# = ATan2 (getx (d\id)-d\x,gety (d\id)-d\y)+90
		d\x = d\x-Cos (w#)*d\s#
		d\y = d\y+Sin (w#)*d\s#
		;ist der fahrer am ziel?
		If RectsOverlap (d\x,d\y,1,1,getx (d\id)-5,gety (d\id)-5,10,10) Then
			d\x = getx (d\id)
			d\y = gety (d\id)
			nid = 0
			;suche ein neues ziel
			While nid = 0
				For c.tc = Each tc
					If c\id1 = d\id Then
						If Rand (0,4) = 0 Then nid = c\id2
					EndIf
					If c\id2 = d\id Then
						If Rand (0,4) = 0 Then nid = c\id1
					EndIf
				Next
			Wend
			d\id = nid
		EndIf
	Next
	Flip
Wend

End

;x von einem punkt
Function getx (tid)
	For p.tp = Each tp
		If p\id = tid Then
			Return p\x
		EndIf
	Next
End Function

;y von einem punkt
Function gety (tid)
	For p.tp = Each tp
		If p\id = tid Then
			Return p\y
		EndIf
	Next
End Function

;zwei punkte verbinden
Function connect (tid1,tid2)
	c.tc = New tc
	c\id1 = tid1
	c\id2 = tid2
End Function

;ist da eine verbindung?
Function connection (tid1,tid2)
	For c.tc = Each tc
		If tid1 = c\id1 Then
			If tid2 = c\id2 Then Return 1
		EndIf
		If tid2 = c\id1 Then
			If tid1 = c\id2 Then Return 1
		EndIf
	Next
	Return 0
End Function


mfg, Blitzprogger
Mein aktuelles Projekt, Irnithal: http://www.blitzforum.de/worklogs/415/

Unfreiwilliger Gewinner des BAC# 115. Wink

darth

 BeitragMo, Aug 22, 2011 22:47
Antworten mit Zitat
Benutzer-Profile anzeigen
Hallo,

ich hab mal einen mir neuen Weg versucht. Natürlich könnte man es (wie gewohnt?) mit Waypoints und Links lösen, aber ich wollte was cooles (weil ich so alternativ bin! ... ).
Ich präsentiere das Konzept der Connectivity-Matrix. (Ich hatte auch einmal einen Wikipedia-Link der sehr gut war, aber den finde ich gerade nicht Sad Sollte ich mal wieder darüber stolpern, werd ich ihn kurz reineditieren..)

BlitzBasic: [AUSKLAPPEN] 
Type TWayPoint
	Field x
	Field y
	
	Field name$
End Type

Function newWayPoint.TWayPoint(x, y, name$)
	Local w.TWayPoint = New TWayPoint
	
	w\x = x
	w\y = y
	
	w\name = name
	
	Return w
End Function

Const iPointNr = 7

Global AList.TWayPoint[iPointNr]

AList[0] = newWayPoint(0, -100, "A")
AList[1] = newWayPoint(Cos(150)*100, -Sin(150)*100, "B")
AList[2] = newWayPoint(Cos(30)*100, -Sin(30)*100, "C")
AList[3] = newWayPoint(Cos(210)*100, -Sin(210)*100, "D")
AList[4] = newWayPoint(Cos(-30)*100, -Sin(-30)*100, "E")
AList[5] = newWayPoint(0, 0, "F")
AList[6] = newWayPoint(0, 100, "G")


Der WaypointType ist ziemlich straight-forward. Position und einen Namen (der nur der Darstellungshalber drin ist, wird ansonsten nicht gebraucht). Dann werden die 7 Wegpunkte der Aufgabenstellung erstellt und der einfacheren Handhabung halberin eine globale Liste gespeichert.

BlitzBasic: [AUSKLAPPEN] 
Dim AGrid(iPointNr, iPointNr)

AGrid(0, 1) = 1 : AGrid(0, 2) = 1 : AGrid(0, 5) = 1
AGrid(1, 0) = 1 : AGrid(1, 3) = 1
AGrid(2, 0) = 1 : AGrid(2, 4) = 1
AGrid(3, 1) = 1 : AGrid(3, 5) = 1 : AGrid(3, 6) = 1
AGrid(4, 2) = 1 : AGrid(4, 5) = 1 : AGrid(4, 6) = 1
AGrid(5, 0) = 1 : AGrid(5, 3) = 1 : AGrid(5, 4) = 1 : AGrid(5, 6) = 1
AGrid(6, 3) = 1 : AGrid(6, 4) = 1 : AGrid(6, 5) = 1


Dann kommt der interessante Teil! Die Verbindungsmatrix ist eine quadratische Matrize, deren Einträge die Verbindungen zwischen zwei Punkten angeben (A_ij ist die Verbindung zwischen Punkt_i und Punkt_j). Dabei könnte man verschiedene Längen eingeben, hier ist jetzt alles normalisiert auf 1.
Was hat das für Vorzüge? Man findet Verbindungen viel schneller als wenn man sie in einem Type hätte. Wenn ich wissen will, wohin ich von Punkt D kann, muss ich nur in der entsprechenden Zeile nachschauen. Bei einer Liste müsste ich wohl alle durchsuchen und rausfinden wo D überall drin steht (oder ich gebe D eine eigene Liste mit SEINEN Verbindungen mit etcpp..) Speichermässig könnte man es als Sparse-Matrix implementieren, dann ist das auch nicht viel aufwändiger als eine Liste.

BlitzBasic: [AUSKLAPPEN] 
Type TWayPoint
	Field x
	Field y
	
	Field name$
End Type

Function newWayPoint.TWayPoint(x, y, name$)
	Local w.TWayPoint = New TWayPoint
	
	w\x = x
	w\y = y
	
	w\name = name
	
	Return w
End Function

Const iPointNr = 7

Global AList.TWayPoint[iPointNr]

AList[0] = newWayPoint(0, -100, "A")
AList[1] = newWayPoint(Cos(150)*100, -Sin(150)*100, "B")
AList[2] = newWayPoint(Cos(30)*100, -Sin(30)*100, "C")
AList[3] = newWayPoint(Cos(210)*100, -Sin(210)*100, "D")
AList[4] = newWayPoint(Cos(-30)*100, -Sin(-30)*100, "E")
AList[5] = newWayPoint(0, 0, "F")
AList[6] = newWayPoint(0, 100, "G")

Dim AGrid(iPointNr, iPointNr)

AGrid(0, 1) = 1 : AGrid(0, 2) = 1 : AGrid(0, 5) = 1
AGrid(1, 0) = 1 : AGrid(1, 3) = 1
AGrid(2, 0) = 1 : AGrid(2, 4) = 1
AGrid(3, 1) = 1 : AGrid(3, 5) = 1 : AGrid(3, 6) = 1
AGrid(4, 2) = 1 : AGrid(4, 5) = 1 : AGrid(4, 6) = 1
AGrid(5, 0) = 1 : AGrid(5, 3) = 1 : AGrid(5, 4) = 1 : AGrid(5, 6) = 1
AGrid(6, 3) = 1 : AGrid(6, 4) = 1 : AGrid(6, 5) = 1

Type TWalker
	Field x#
	Field y#
	
	Field actPoint
	Field lastPoint
	
	Field vx#
	Field vy#
End Type

Function newWalker.TWalker()
	Local w.TWalker = New TWalker
	
	w\lastPoint = -1
	w\actPoint = Rand(0, iPointNr -1)
	
	w\x = AList[ w\actPoint ]\x
	w\y = AList[ w\actPoint ]\y
	
	w\vx = 0
	w\vy = 0
	
	Return w
End Function

Graphics 800, 600, 0, 2
SetBuffer BackBuffer()
SeedRnd( MilliSecs() )

Origin 400, 300

Local tom.TWalker = newWalker()
Local joe.TWalker = newWalker()
Local bob.TWalker = newWalker()

Local Timer = CreateTimer(60)
While Not KeyHit(1)
	
	draw()
	
	For w.TWalker = Each TWalker
		update(w)
	Next
	
	; Debug: Connectivity - Matrix
	For x = 0 To iPointNr -1
		For y = 0 To iPointNr -1
			Color 255, 255, 255
			Text -370 +x *15, -270 +y *15, AGrid(x, y)
			
			Color 255, 0, 0
			If x = 0
				Text -385, -270 +y *15, AList[y]\name
			EndIf
			
			If y = 0
				Text -370 +x *15, -285, AList[x]\name
			EndIf
		Next
	Next
	
	Flip 0
	WaitTimer(Timer)
	Cls
Wend
End

Function draw()
	For x = 0 To iPointNr -1
		For y = 0 To iPointNr -1
			If AGrid(x, y) = 1
				Color 255, 255, 255
				
				Line AList[x]\x, AList[x]\y, AList[y]\x, AList[y]\y
			EndIf
			
			If x = y
				Color 255, 0, 0
				
				Text AList[x]\x, AList[x]\y, AList[x]\name
			EndIf
		Next
	Next
End Function

Function update(w.TWalker)
	Local dist#, dx#, dy#
	
	dx = w\x - AList[w\actPoint]\x
	dy = w\y - AList[w\actPoint]\y
	
	dist = Sqr( dx*dx + dy*dy )
	
	Local aimPoint = w\actPoint
	
	If dist < 5
		; Ziemlich gefährlich..
		;  bräuchte noch einen Escape für leere Listen,
		;  ansonsten müsste es eigentlich (mit genügend Zeit..) immer
		;  einen Zielpunkt finden
		While AGrid(w\actPoint, aimPoint) = 0
			aimPoint = Rand(0, iPointNr -1)
			
			If aimPoint = w\lastPoint
				aimPoint = w\actPoint
			EndIf
		Wend
		
		w\vx = AList[aimPoint]\x - w\x
		w\vy = AList[aimPoint]\y - w\y
		
		dist = Sqr( w\vx * w\vx + w\vy * w\vy )
		
		w\vx = w\vx /dist *0.8
		w\vy = w\vy /dist *0.8
		
		w\lastPoint = w\actPoint
		w\actPoint = aimPoint
	Else
		w\x = w\x + w\vx
		w\y = w\y + w\vy
	EndIf
	
	Color 0, 0, 255
	Line w\x, w\y, AList[w\actPoint]\x, AList[w\actPoint]\y
	
	Color 0, 255, 0
	Oval w\x -4, w\y -4, 8, 8
End Function


Der Rest ist dann etwas Beigemüsse. Einen Walker-Type der die Herumwanderer beinhaltet. Eine Funktion um das Netz zu zeichnen und eine um die Walker laufen zu lassen. Das wärs dann auch schon.

MfG,
Darth
Diese Signatur ist leer.

Neue Antwort erstellen


Übersicht BlitzBasic Beginners-Corner

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group