Const pi As Double = ACos(0)*2
Const pi2 As Double = 2 * pi
	
Type tPersonen
   anzahl As Integer
   kampfkraft As UByte
   motivation As UByte
End Type

Type tHeer
	milizen As tPersonen
	infanteristen As tPersonen
	kavalleristen As tPersonen
	artilleristen As tPersonen
	pferde As UInteger
	schwerter As UInteger
  hellebarden As UInteger
  spiesse As UInteger
  kanonen As UInteger
  musketen As UInteger
  pistolen As UInteger
  lanzen As UInteger
End Type

Type tFeldherr
   name_ As String
   rang As UByte
   kriegskasse As Integer
   heer As tHeer
End Type

Dim As tFeldherr spieler(1)

Type tPosition
	x As Double 'x - Position auf dem Schlachtfeld
	y As Double 'y - Position auf dem Schlachtfeld
End Type

'grundrechenarten für tPosition definieren
Operator + (p1 As tPosition, p2 As tPosition) As tPosition
	Return Type<tPosition>(p1.x + p2.x, p1.y + p2.y)
End Operator

Operator - (p1 As tPosition, p2 As tPosition) As tPosition
	Return Type<tPosition>(p1.x - p2.x, p1.y - p2.y)
End Operator

Operator * (p1 As tPosition, f As Double) As tPosition
	Return Type<tPosition>(p1.x * f, p1.y * f)
End Operator

Operator / (p1 As tPosition, f As Double) As tPosition
	Return Type<tPosition>(p1.x / f, p1.y / f)
End Operator


Type tPolar
	r As Double
	phi As Double
End Type

Type tKrieger
	zugehoerigkeit : 1 As UInteger '1 Bit: Freund = 0 / Feind = 1
  typ : 2 As UInteger '2 Bits: Milizionär, Infanterist, Kavallerist oder Geschütz
  'Bewaffnung --> je 1 Bit: 1 = Waffe vorhanden / 0 = Waffe nicht vorhanden
  schwert : 1 As UInteger
  hellebarde : 1 As UInteger
  spiess : 1 As UInteger
  muskete : 1 As UInteger
  pistole : 1 As UInteger
  lanze : 1 As UInteger
  Declare Property position As tPosition 'abfragen
  Declare Property position(p As tPosition) 'setzen
  Declare Property ziel As tPosition 'abfragen
  Declare Property ziel(z As tPosition) 'setzen
  richtung As Double 'winkel der bewegung
  geschwindigkeit As Double '...der bewegung in m/s
  kampfkraft As UByte 'von 0 - 255
  motivation As UByte 'bei Infanterie und Kavallerie von 0 - 255
	verwundung As UByte 'in %
	waffenlatenz As UByte 'sekunden bis zur (wieder)einsatzbereitschaft der waffe
  feindindex As Integer 'arrayindex des anvisierten feindes
  Private:
  _ziel As tPosition
  _position As tPosition
End Type

Dim Shared As tPosition schlachtfeld 'größe des schlachtfeldes 
ReDim Shared As Integer sfmap(1,1) 'karte des schlachtfeldes
ReDim Shared As tKrieger krieger(1) 'array aller krieger auf dem schlachtfeld

Property tKrieger.position As tPosition 'abfragen
	'fragt die position des kriegers auf dem schlachtfeld ab
	tKrieger.position = this._position
End Property
Property tKrieger.position(p As tPosition) 'setzen
	'setzt eine neue position des kriegers auf dem schlachtfeld, sofern diese frei ist und
	' auf dem schlachtfeld liegt
	Dim As Integer index, px, py
	Dim As Any Ptr p1, p2
	
	p1 = @This 'pointer auf aktuellen krieger
	p2 = @krieger(LBound(krieger)) 'pointer auf beginn des kriegerarrays
	index =  (Cast(UInteger,p1) - Cast(UInteger,p2)) / SizeOf(tKrieger) 'eigenen index im kriegerarray berechnen
	
	'schlachtfeldgrenzen einhalten
	If p.x < 0 Then
		p.x = 0
	ElseIf p.x > schlachtfeld.x Then
		p.x = schlachtfeld.x
	EndIf
	If p.y < 0 Then
		p.y = 0
	ElseIf p.y > schlachtfeld.y Then
		p.y = schlachtfeld.y
	EndIf
	
	'integerwerte der position
	px = Int(p.x) 
	py = Int(p.y)
	
	'schlachtfeldkarte aktualisieren
	If (sfmap(px,py) = index) Then 
		this._position = p 'eigene position auf der karte --> karte unverändert lassen
	ElseIf (sfmap(px,py) = 0) Then 'neues feld auf der karte ist unbesetzt
	  sfmap(Int(this._position.x),Int(this._position.y)) = 0 'alten index räumen
		this._position = p 'neue position intern speichern
		sfmap(px,py) = index 'neues feld auf der karte besetzen
	EndIf
End Property
Property tKrieger.ziel As tPosition 'abfragen
	'fragt die position ab, auf die sich der krieger zubewegt
	tKrieger.ziel = this._ziel
End Property
Property tKrieger.ziel(z As tPosition) 'setzen
	'setzt die position, auf die sich der krieger zubewegen soll und berechnet die richtung
	' der bewegung als winkel
	Dim As tPosition p = z - this.position
	
	this._ziel = z 'neues ziel intern speichern
	this.richtung = ATan2(p.y, p.x) 'winkel der bewegung berechnen
End Property


Enum
	miliz = 0
	infanterie
	kavallerie
	artillerie
End Enum

Declare Sub schlachtfeld_darstellen()
Declare Function kart2pol(pvon As tPosition = Type(0,0), pzu As tPosition = Type(0,0)) As tPolar
Declare Function pol2kart(pk As tPolar) As tPosition
Declare Function naechsterFeind(index As Integer) As Integer
Declare Function naechsterFreund(index As Integer, krieger() As tKrieger) As Integer

Dim As Integer test = 1000

'testarmeen erstellen
With spieler(0)
	.name_ = "Feldherr 0"
	.rang = 2
	.kriegskasse = 150000
	With .heer
		With .milizen
			.anzahl = test
			.kampfkraft = 50
			.motivation = 10
		End With
		With .infanteristen
			.anzahl = 0
			.kampfkraft = 200
			.motivation = 200
		End With
		With .kavalleristen
			.anzahl = 0
			.kampfkraft = 200
			.motivation = 200
		End With
		With .artilleristen
			.anzahl = 0
			.kampfkraft = 200
			.motivation = 200
		End With
		.pferde = 50
		.schwerter = 200
		.hellebarden = 2000
		.spiesse = 1000000
		.kanonen = 0
		.musketen = 120
		.pistolen = 150
		.lanzen = 200
	End With
End With

With spieler(1)
	.name_ = "Feldherr 1"
	.rang = 2
	.kriegskasse = 150000
	With .heer
		With .milizen
			.anzahl = test
			.kampfkraft = 50
			.motivation = 20
		End With
		With .infanteristen
			.anzahl = 0
			.kampfkraft = 200
			.motivation = 200
		End With
		With .kavalleristen
			.anzahl = 0
			.kampfkraft = 200
			.motivation = 200
		End With
		With .artilleristen
			.anzahl = 0
			.kampfkraft = 200
			.motivation = 200
		End With
		.pferde = 50
		.schwerter = 1000
		.hellebarden = 5000
		.spiesse = 1000000
		.kanonen = 0
		.musketen = 120
		.pistolen = 150
		.lanzen = 200
	End With
End With

anfang:
'krieger für die schlacht erstellen
ReDim As tKrieger krieger(0)
Dim Shared As Integer k, kmax0
Dim As Integer x, y

k = 0
For x = 0 To 1 'beide spieler
	'milizionäre
	
	With spieler(x).heer
		For y As Integer = 1 To .milizen.anzahl
			If .schwerter + .hellebarden + .spiesse = 0 Then
				Exit For
			EndIf
			k += 1
			ReDim Preserve krieger(k)
			krieger(k).zugehoerigkeit = x
		  krieger(k).typ = miliz
		  krieger(k).kampfkraft = .milizen.kampfkraft
			krieger(k).motivation = .milizen.motivation
			If .schwerter Then
				krieger(k).schwert = 1
				.schwerter -= 1
			ElseIf .hellebarden Then
				krieger(k).hellebarde = 1
				.hellebarden -= 1
			ElseIf .spiesse Then
				krieger(k).spiess = 1
				.spiesse -= 1
			EndIf
		Next
	End With
	If x = 0 Then 'maximalen index von spieler 0 merken
		kmax0 = k
	EndIf
Next

? "          krieger ";UBound(krieger)

'schlachtfeld

Dim As tPosition posmil

schlachtfeld.x = 500 'grösse des schlachtfelds in metern
schlachtfeld.y = 800

ReDim sfmap(schlachtfeld.x, schlachtfeld.y) 'schlachtfeldkartekarte anlegen

? "schlachtfeldarray ";schlachtfeld.x * schlachtfeld.y * SizeOf(Integer)/1024/1024;" MB"
? "     kriegerarray ";UBound(krieger) * SizeOf(tKrieger)/1024/1024;" MB"

'krieger auf dem schlachtfeld platzieren
'spieler 0 --> unten
posmil.x = 10 '10m vom linken rand
posmil.y = schlachtfeld.y - 10 '10m vom unteren rand
For x = 1 To kmax0 'spieler 0 (grün)
	With krieger(x)
		posmil.x += 3 '3m nach rechts
		If posmil.x > schlachtfeld.x - 10 Then 'rechter rand erreicht
			posmil.y -= 2 '2m nach oben (= nächste reihe)
			posmil.x = 10 '10m vom linken rand
		EndIf
		.position = Type<tPosition>(posmil.x, posmil.y) 'position in objektvariable schreiben
	End With
Next

'spieler 1 --> oben
posmil.x = schlachtfeld.x - 10 '10m vom rechten rand
posmil.y = 10 '10m vom oberen rand
For x = kmax0 + 1 To k 'spieler 1 (weiss)
	With krieger(x)
		posmil.x -= 3 '3m nach links
		If posmil.x < 10  Then 'linker rand erreicht
			posmil.y += 2 '2m nach unten (= nächste reihe) 
			posmil.x = schlachtfeld.x - 10 '10m vom rechten rand
		EndIf
		.position = Type<tPosition>(posmil.x, posmil.y) 'position in objektvariable schreiben
	End With
Next

'###################################################################

'kontrolle
ScreenRes schlachtfeld.x, schlachtfeld.y, 32

Dim As Integer zaehler, t1, t2
Dim As Double entfmax = (schlachtfeld.x * schlachtfeld.x + schlachtfeld.y * schlachtfeld.y)
Dim As Double entfFreund, entfFeind, entf
Dim As tPosition p
ReDim Shared As Integer reihenfolge(UBound(krieger))

schlachtfeld_darstellen()

Randomize Timer
For y As Integer = 1 To UBound(krieger)
	krieger(y).geschwindigkeit = 2.0 + Rnd 'individuelle geschwindigkeit zwischen 2m/s und 3m/s
Next

Dim g As String
Do
	'reihenfolge durcheinanderwürfeln
	ReDim reihenfolge(UBound(krieger))
	For x = 1 To UBound(krieger)
		reihenfolge(x) = x
	Next
	For x = 1 To UBound(krieger)
		Swap reihenfolge(x),reihenfolge(Int(Rnd * UBound(krieger)) + 1)	
	Next
	
	For x = 1 To UBound(krieger)
		With krieger(reihenfolge(x))		
					
			'auf nächsten feind zubewegen
			If .feindindex = 0 Then 'feind mit der geringsten entfernung ermitteln
				.feindindex = naechsterFeind(reihenfolge(x))
			EndIf
			.ziel = krieger(.feindindex).position 'position des anvisierten feindes als ziel setzen
			.position = .position + pol2kart(Type<tPolar>(.geschwindigkeit,.richtung)) 'krieger bewegen

		End With
	Next
	
	schlachtfeld_darstellen()
	Sleep 1
	
	g = InKey
Loop While g = ""
Select Case g
	Case Chr(27) 'esc
		End
	Case Else
		GoTo anfang
End Select

Function kart2pol(pvon As tPosition = Type(0,0), pzu As tPosition = Type(0,0)) As tPolar
	Dim As tPosition p = pzu - pvon
		
	Return Type<tPolar>(Sqr(p.x * p.x + p.y * p.y), ATan2(p.y, p.x))
		
End Function

Function pol2kart(pk As tPolar) As tPosition
	
  Return Type<tPosition>(pk.r * Cos(pk.phi), pk.r * Sin(pk.phi))
  
End Function

Function naechsterFeind(index As Integer) As Integer
	Dim As Integer nF, x
	Dim As Double entfFeind = (schlachtfeld.x * schlachtfeld.x + schlachtfeld.y * schlachtfeld.y), entfernung
	Dim As tPosition p
			
	For x = IIf(index > kmax0,1,kmax0 + 1) To IIf(index > kmax0,kmax0,UBound(krieger))
		p = krieger(index).position - krieger(x).position
		entfernung = p.x * p.x + p.y * p.y
		If entfernung < entfFeind Then
			entfFeind = entfernung
			nF = x
		EndIf
	Next
	Return nF
End Function

Function naechsterFreund(index As Integer, krieger() As tKrieger) As Integer
	
End Function

Sub schlachtfeld_darstellen()
	ScreenLock
	Cls
	For x As Integer = 1 To UBound(krieger)
		With krieger(x)
			PSet (.position.x, .position.y),IIf(.zugehoerigkeit,RGB(255,255,255),RGB(0,255,0))
		End With
	Next
	ScreenUnLock
End Sub