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
  Declare Property sf As tPosition
  Declare Property sf(ByRef schlachtfeld As tPosition)
  Declare Property sfm As Integer Ptr
  Declare Property sfm(sfmap() As Integer)
  Declare Property imax0 As Integer 'abfragen
  Declare Property imax0(ByRef kmax0 As Integer) 'setzen
  Declare Property array(krieger() As tKrieger) 'setzen
  Union
  	richtung As Double 'winkel der bewegung
  	_schlachtfeld As tPosition Ptr '
  End Union
  Union
  	geschwindigkeit As Double '...der bewegung in m/s
  	_map As Integer Ptr '
  End Union
  Union
  	feindindex As Integer 'arrayindex des anvisierten feindes
  	_imax0 As Integer Ptr '
  End Union
  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
  Private:
  _ziel As tPosition
  _position As tPosition
  _arrayptr As tKrieger Ptr
  _arraygroesse As Integer
End Type

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

Property tKrieger.array(krieger() As tKrieger)
	'setzt die internen variablen für arraypointer und -größe in allen elementen des arrays
	For x As Integer = 0 To UBound(krieger)
		(@krieger(0) + x)->_arrayptr = @krieger(0)
		(@krieger(0) + x)->_arraygroesse = UBound(krieger)
	Next
End Property

Property tKrieger.imax0 As Integer 'abfragen
	tKrieger.imax0 = *(_arrayptr->_imax0)
End Property
Property tKrieger.imax0(ByRef kmax0 As Integer) 'setzen
	_arrayptr->_imax0 = @kmax0
End Property

Property tKrieger.sfm As Integer Ptr 'abfragen
	tKrieger.sfm = _arrayptr->_map
End Property
Property tKrieger.sfm(sfmap() As Integer) 'setzen
	_arrayptr->_map = @sfmap(0,0)
End Property

Property tKrieger.sf As tPosition 'abfragen
	tKrieger.sf = *_arrayptr->_schlachtfeld
End Property
Property tKrieger.sf(ByRef schlachtfeld As tPosition) 'setzen
	_arrayptr->_schlachtfeld = @schlachtfeld
End Property

Property tKrieger.position As tPosition 'abfragen
	'fragt die position des kriegers auf dem schlachtfeld ab
	tKrieger.position = _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, x
	Dim As Integer Ptr p1, p2
		
	index =  (Cast(UInteger,@This) - Cast(UInteger,_arrayptr)) / SizeOf(tKrieger) 'eigenen index im kriegerarray berechnen
	'                         |                        |_pointer auf beginn des kriegerarrays
	'                         |__________________________pointer auf aktuellen krieger
			
	'schlachtfeldgrenzen einhalten
	If p.x < 0 Then
		p.x = 0
	ElseIf p.x > this.sf.x Then
		p.x = sf.x
	EndIf
	If p.y < 0 Then
		p.y = 0
	ElseIf p.y > sf.y Then
		p.y = sf.y
	EndIf
	
	'integerwerte der position
	px = Int(p.x) 
	py = Int(p.y)
	
	'schlachtfeldkarte aktualisieren
	x = ((sf.y + 1) * px + py) 'offset für neue position
	p1 = (sfm + x) 'pointer auf neue position (im array sfmap())
	x = ((sf.y + 1) * Int(_position.x) + Int(_position.y)) 'offset für derzeitige position
	p2 = (sfm + x) 'pointer auf derzeitige position (im array sfmap())
	If *p1 = index Then 
		this._position = p 'eigene position auf der karte --> karte unverändert lassen
	ElseIf *p1 = 0 Then 'neues feld auf der karte ist unbesetzt
	  *p2 = 0 'altes feld räumen
	  *p1 = index 'neues feld auf der karte besetzen
		_position = p 'neue position intern speichern
	EndIf
End Property
Property tKrieger.ziel As tPosition 'abfragen
	'fragt die position ab, auf die sich der krieger zubewegt
	tKrieger.ziel = _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 - position
	
	_ziel = z 'neues ziel intern speichern
	richtung = ATan2(p.y, p.x) 'winkel der bewegung berechnen
End Property


Enum
	miliz = 0
	infanterie
	kavallerie
	artillerie
End Enum

Declare Sub schlachtfeld_darstellen(sfmap() As Integer, krieger() As tKrieger)
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, krieger() As tKrieger) 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 krieger(0)
Dim As Integer k, kmax0 = 5
Dim As Integer x, y

schlachtfeld.x = 500 'grösse des schlachtfelds in metern
schlachtfeld.y = 800
ReDim sfmap(schlachtfeld.x, schlachtfeld.y) 'schlachtfeldkartekarte anlegen

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).array = krieger() 'referenz auf array setzen (muß nach jedem ReDim gemacht werden)
			
			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

'referenzen auf die benötigten variablen setzen
krieger(0).sf = schlachtfeld
krieger(0).imax0 = kmax0
krieger(0).sfm = sfmap()

? "          krieger ";UBound(krieger)

'schlachtfeld

Dim As tPosition posmil

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

'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 As Integer reihenfolge(UBound(krieger))

schlachtfeld_darstellen(sfmap(), krieger())

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
ReDim reihenfolge(UBound(krieger))
Do
	'reihenfolge durcheinanderwürfeln
	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), krieger())
			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(sfmap(), krieger())
	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, krieger() As tKrieger) As Integer
	Dim As Integer nF, x
	Dim As tPosition schlachtfeld = krieger(1).sf
	Dim As Double entfFeind = (schlachtfeld.x * schlachtfeld.x + schlachtfeld.y * schlachtfeld.y), entfernung
	Dim As tPosition p
	Dim As Integer kmax0 = krieger(index).imax0
		
	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(sfmap() As Integer, krieger() As tKrieger)
	ScreenLock
	Cls
	For x As Integer = 1 To UBound(krieger)
		With krieger(x)
			PSet (.position.x, .position.y),IIf(x > .imax0,RGB(255,255,255),RGB(0,255,0))
		End With
	Next
	ScreenUnLock
End Sub