Const pi As Double = Acos(0)*2 Const pi2 As Double = 2 * pi Enum miliz = 0 infanterie kavallerie artillerie End Enum Enum schwert = 0 hellebarde spiess kanone muskete bajonett pistole lanze End Enum 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) '2 spieler 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(p1.x + p2.x, p1.y + p2.y) End Operator Operator - (p1 As tPosition, p2 As tPosition) As tPosition Return Type(p1.x - p2.x, p1.y - p2.y) End Operator Operator * (p1 As tPosition, f As Double) As tPosition Return Type(p1.x * f, p1.y * f) End Operator Operator / (p1 As tPosition, f As Double) As tPosition Return Type(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 bajonett : 1 As UInteger pistole : 1 As UInteger lanze : 1 As UInteger aktuellewaffe As UByte 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 array(krieger() As tKrieger) 'setzen richtung As Double 'winkel der bewegung geschwindigkeit As Double '...der bewegung in m/s feindindex As Integer 'arrayindex des anvisierten feindes motivation As UByte 'bei Infanterie und Kavallerie von 0 - 255 kampfkraft As Integer 'von 0 - 255 verwundung As UByte 'in % waffenlatenz As UByte 'sekunden bis zur (wieder)einsatzbereitschaft der waffe 'Private: Static As Integer maxEinsatzfaehig Static As Integer kmax0 Static As Integer sfmap() Static As tPosition schlachtfeld Static As UByte festgelaufen Static As Integer reichweite() Static As Integer latenz() Private: Static As tKrieger Ptr arrayptr Static As Integer arraygroesse 'Private: _ziel As tPosition _position As tPosition _zaehler As Integer _zaehler2 As Integer End Type Dim As Integer tKrieger.maxEinsatzfaehig Dim As Integer tKrieger.kmax0 Dim As Integer tKrieger.sfmap() Dim As tPosition tKrieger.schlachtfeld Dim As tKrieger Ptr tKrieger.arrayptr Dim As Integer tKrieger.arraygroesse Dim As UByte tKrieger.festgelaufen Dim As Integer tKrieger.reichweite() Dim As Integer tKrieger.latenz() ReDim As tKrieger krieger(1) 'array aller krieger auf dem schlachtfeld ReDim As Integer tKrieger.reichweite(lanze) tKrieger.reichweite(schwert) = 1 tKrieger.reichweite(hellebarde) = 2 tKrieger.reichweite(spiess) = 6 tKrieger.reichweite(kanone) = 1000 tKrieger.reichweite(muskete) = 400 tKrieger.reichweite(bajonett) = 2 tKrieger.reichweite(pistole) = 10 tKrieger.reichweite(lanze) = 4 ReDim As Integer tKrieger.latenz(lanze) tKrieger.latenz(schwert) = 1 tKrieger.latenz(hellebarde) = 2 tKrieger.latenz(spiess) = 0 tKrieger.latenz(kanone) = 180 tKrieger.latenz(muskete) = 20 tKrieger.latenz(bajonett) = 1 tKrieger.latenz(pistole) = 20 tKrieger.latenz(lanze) = 5 Property tKrieger.array(krieger() As tKrieger) 'setzt die internen variablen für arraypointer und -größe This.arrayptr = @krieger(0) this.arraygroesse = UBound(krieger) 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 Dim As tPosition tp index = (Cast(UInteger,@This) - Cast(UInteger,this.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 > 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) If verwundung < 80 Then 'schlachtfeldkarte aktualisieren If sfmap(p.x,p.y) = 0 Then Swap sfmap(p.x,p.y),sfmap(this._position.x,this._position.y) this._position = p 'neue position intern speichern this._zaehler = 0 this.festgelaufen = 0 Else 'nicht bewegen _zaehler += 1 EndIf If this._zaehler > 60 Then 'seit 60 sekunden festgelaufen tp = Type(this.position.x + (Int(Rnd * 100) - 50),this.position.y + 50 * IIf(index > this.kmax0,-1,1)) 'schlachtfeldgrenzen einhalten If tp.x < 0 Then tp.x = 0 ElseIf tp.x > schlachtfeld.x Then tp.x = schlachtfeld.x EndIf If tp.y < 0 Then tp.y = 0 ElseIf tp.y > schlachtfeld.y Then tp.y = schlachtfeld.y EndIf If sfmap(tp.x,tp.y) = 0 Then sfmap(this._position.x,this._position.y) = 0 'altes feld räumen this._position = tp sfmap(this._position.x,this._position.y) = index 'neues feld auf der karte besetzen this.feindindex = 0 this._zaehler = 0 EndIf EndIf 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 Declare Sub schlachtfeld_darstellen(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, max As Integer = 0) As Integer Declare Function naechsterFreund(index As Integer, krieger() As tKrieger) As Integer Declare Function zeitformat (sekunden As Integer) As String ? SizeOf(tKrieger) Dim As Integer test = 10000 '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 = 5000 .hellebarden = 5000 .spiesse = 100 .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 = 5000 .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(spieler(0).heer.milizen.anzahl + _ spieler(0).heer.infanteristen.anzahl + _ spieler(0).heer.kavalleristen.anzahl + _ spieler(0).heer.artilleristen.anzahl + _ spieler(1).heer.milizen.anzahl + _ spieler(1).heer.infanteristen.anzahl + _ spieler(1).heer.kavalleristen.anzahl + _ spieler(1).heer.artilleristen.anzahl) Dim As Integer k ', kmax0 Dim As Integer x, y tKrieger.schlachtfeld.x = Int(Rnd * 700) + 300 'grösse des schlachtfelds in metern tKrieger.schlachtfeld.y = Int(Rnd * 700) + 300 tKrieger.schlachtfeld = Type(800,800) 'zum testen If tKrieger.schlachtfeld.x > tKrieger.schlachtfeld.y Then Swap tKrieger.schlachtfeld.x,tKrieger.schlachtfeld.y EndIf ReDim tKrieger.sfmap(tKrieger.schlachtfeld.x, tKrieger.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 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 krieger(k).aktuellewaffe = schwert .schwerter -= 1 ElseIf .hellebarden Then krieger(k).hellebarde = 1 krieger(k).aktuellewaffe = hellebarde .hellebarden -= 1 ElseIf .spiesse Then krieger(k).spiess = 1 krieger(k).aktuellewaffe = spiess .spiesse -= 1 EndIf Next End With If x = 0 Then 'maximalen index von spieler 0 merken tKrieger.kmax0 = k EndIf Next ReDim Preserve krieger(k) 'referenzen auf die benötigten variablen setzen krieger(0).array = krieger() 'referenz auf array setzen (muß nach jedem ReDim gemacht werden) tKrieger.maxEinsatzfaehig = UBound(krieger) ? " krieger ";UBound(krieger) 'schlachtfeld Dim As tPosition posmil ? "schlachtfeldarray ";tKrieger.schlachtfeld.x * tKrieger.schlachtfeld.y * SizeOf(Integer)/1024/1024;" MB" ? " kriegerarray ";UBound(krieger) * SizeOf(tKrieger)/1024/1024;" MB" ? krieger(1).schlachtfeld.x;" ";krieger(1).schlachtfeld.y 'krieger auf dem schlachtfeld platzieren 'spieler 0 --> unten posmil.x = 10 '10m vom linken rand posmil.y = tKrieger.schlachtfeld.y - 10 '10m vom unteren rand For x = 1 To tKrieger.kmax0 'spieler 0 (grün) With krieger(x) posmil.x += 3 '3m nach rechts If posmil.x > tKrieger.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(posmil.x, posmil.y) 'position in objektvariable schreiben End With Next 'spieler 1 --> oben posmil.x = tKrieger.schlachtfeld.x - 10 '10m vom rechten rand posmil.y = 10 '10m vom oberen rand For x = tKrieger.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 = tKrieger.schlachtfeld.x - 10 '10m vom rechten rand EndIf .position = Type(posmil.x, posmil.y) 'position in objektvariable schreiben End With Next For x = 1 To UBound(krieger) tKrieger.sfmap(krieger(x).position.x, krieger(x).position.y) = x Next '################################################################### 'kontrolle ScreenRes tKrieger.schlachtfeld.x, tKrieger.schlachtfeld.y, 32 Dim As Integer zaehler, t1, t2 Dim As Double entfmax = (tKrieger.schlachtfeld.x * tKrieger.schlachtfeld.x + tKrieger.schlachtfeld.y * tKrieger.schlachtfeld.y) Dim As Double entfFreund, entfFeind, entf Dim As tPosition p ReDim As Integer reihenfolge(UBound(krieger)) schlachtfeld_darstellen(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 Dim As Integer flag = 0, lebend0, lebend1, i Open Cons For Output As #1 ReDim reihenfolge(UBound(krieger)) For x = 1 To UBound(krieger) reihenfolge(x) = x krieger(x).feindindex = naechsterFeind(x, krieger(),100) Next Do tKrieger.festgelaufen = 1 zaehler += 1 'aussortieren 'letzten einsatzfähigen krieger suchen Do While krieger(reihenfolge(tKrieger.maxEinsatzfaehig)).verwundung >= 80 tKrieger.maxEinsatzfaehig -= 1 Loop lebend0 = 0 lebend1 = 0 '? tKrieger.sfmap(1,2) Dim As Integer Ptr ap = @tKrieger.sfmap(0,0) Clear *ap,0,Len(*ap) * tKrieger.schlachtfeld.x * tKrieger.schlachtfeld.y i = tKrieger.maxEinsatzfaehig For y = i To 1 Step -1 'oberen teil der tabelle durchsuchen If krieger(reihenfolge(y)).verwundung >= 80 Then 'kampfunfähigen krieger gefunden Swap reihenfolge(y), reihenfolge(tKrieger.maxEinsatzfaehig) 'nicht einsatzfähige aussortieren krieger(reihenfolge(tKrieger.maxEinsatzfaehig)).feindindex = 0 krieger(reihenfolge(tKrieger.maxEinsatzfaehig)).geschwindigkeit = 0 For z As Integer = 1 To tKrieger.maxEinsatzfaehig '- 1 'bei allen verbleibenden kriegern... If krieger(reihenfolge(z)).feindindex = reihenfolge(tKrieger.maxEinsatzfaehig) Then krieger(reihenfolge(z)).feindindex = 0 '...verweis auf ausgeschiedenen krieger löschen EndIf Next tKrieger.maxEinsatzfaehig -= 1 Else tKrieger.sfmap(krieger(reihenfolge(y)).position.x, krieger(reihenfolge(y)).position.y) = reihenfolge(y) If reihenfolge(y) > tKrieger.kmax0 Then lebend1 += 1 Else lebend0 += 1 EndIf EndIf Next 'reihenfolge durcheinanderwürfeln For x = 1 To tKrieger.maxEinsatzfaehig Swap reihenfolge(x),reihenfolge(Int(Rnd * tKrieger.maxEinsatzfaehig) + 1) Next Print #1, lebend0;" ";lebend1;" ";zeitformat(zaehler); If lebend0 < 1 OrElse lebend1 < 1 Then Exit Do 'schlacht beendet EndIf flag = 0 For x = 1 To tKrieger.maxEinsatzfaehig With krieger(reihenfolge(x)) flag = 1 'auf nächsten feind zubewegen If .feindindex = 0 Then 'feind mit der geringsten entfernung ermitteln .feindindex = naechsterFeind(reihenfolge(x), krieger(),100) EndIf .ziel = krieger(.feindindex).position 'position des anvisierten feindes als ziel setzen Dim As tPosition p = .ziel - .position Dim As Double distanz = p.x * p.x + p.y * p.y If distanz <= tKrieger.reichweite(.aktuellewaffe) * tKrieger.reichweite(.aktuellewaffe) Then krieger(.feindindex).feindindex = reihenfolge(x) 'angreifer wird neuer feind für angegriffenen kriegeer krieger(.feindindex).ziel = .position 'eigene position als ziel für angegriffenen krieger(.feindindex).verwundung += Int(Rnd * 20) If krieger(.feindindex).verwundung >= 80 Then krieger(.feindindex).feindindex = 0 .feindindex = 0 EndIf Else If distanz > .geschwindigkeit * .geschwindigkeit Then .position = .position + pol2kart(Type(.geschwindigkeit,.richtung)) 'krieger bewegen Else .position = .position + pol2kart(Type(0.45,.richtung)) EndIf EndIf End With Next If tKrieger.festgelaufen = 1 Then Print #1, " festgelaufen"; EndIf Print #1, "" schlachtfeld_darstellen(krieger()) g = InKey Loop While (g = "" Or g = "n") And flag = 1 Close 1 'Sleep '1000 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(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(pk.r * Cos(pk.phi), pk.r * Sin(pk.phi)) End Function Function naechsterFeind(index As Integer, krieger() As tKrieger, max As Integer = 0) As Integer Dim As Integer nF = 0, x, z, ze, schrittweite Dim As tPosition schlachtfeld = tKrieger.schlachtfeld Dim As Double entfFeind = (schlachtfeld.x * schlachtfeld.x + schlachtfeld.y * schlachtfeld.y), entfernung Dim As tPosition p Static As Integer einsatzfaehig(UBound(krieger)) Dim As Integer untergrenze, obergrenze, anzahl, i untergrenze = IIf(index > tKrieger.kmax0,1,tKrieger.kmax0 + 1) obergrenze = IIf(index > tKrieger.kmax0,tKrieger.kmax0,UBound(krieger)) If (max = 0) OrElse (UBound(krieger) <= max) Then For x = untergrenze To obergrenze If krieger(x).verwundung < 80 Then 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 EndIf Next Else Do While z < max x = Int(Rnd * (obergrenze - untergrenze)) + untergrenze - 1 'If x >= untergrenze AndAlso x <= obergrenze Then If krieger(x).verwundung < 80 Then z += 1 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 EndIf 'EndIf Loop EndIf Return nF End Function Function naechsterFreund(index As Integer, krieger() As tKrieger) As Integer Return 0 End Function Sub schlachtfeld_darstellen(krieger() As tKrieger) Dim As String text ScreenLock Cls For x As Integer = 1 To UBound(krieger) With krieger(x) If .verwundung >= 80 Then 'text = Str(x) + "/" + Str(krieger(x).verwundung) + "/" + Str(krieger(x).feindindex) PSet (.position.x, .position.y),RGB(255,0,0) 'Draw String(.position.x, .position.y),text,RGB(255,0,0) EndIf End With Next For x As Integer = 0 To tKrieger.schlachtfeld.x For y As Integer = 0 To tKrieger.schlachtfeld.y If (tKrieger.sfmap(x,y) <> 0) AndAlso (krieger(tKrieger.sfmap(x,y)).verwundung < 80) Then 'text = Str(tKrieger.sfmap(x,y)) + "/" + Str(krieger(tKrieger.sfmap(x,y)).verwundung) + "/" + Str(krieger(tKrieger.sfmap(x,y)).feindindex) PSet(x,y),IIf(tKrieger.sfmap(x,y) > tKrieger.kmax0,RGB(255,255,255),RGB(0,255,0)) 'Draw String(x,y),text,IIf(tKrieger.sfmap(x,y) > tKrieger.kmax0,RGB(255,255,255),RGB(0,255,0)) EndIf Next Next ScreenUnlock End Sub Function zeitformat (sekunden As Integer) As String Dim As Integer gh, gm, minuten Dim As String zeit minuten = Int(sekunden / 60) sekunden = sekunden Mod 60 zeit = "" gh = INT(minuten / 60) zeit = zeit + STR$(gh) + ":" gm = minuten - 60 * gh IF gm < 10 THEN zeit = zeit + "0" END IF zeit = zeit + Str$(gm) zeit = zeit + ":" IF sekunden < 10 THEN zeit = zeit + "0" END IF zeit = zeit + STR$(sekunden)' + ")" zeitformat = zeit End Function