Const pi As Double = Acos(0)*2 Const pi2 As Double = 2 * pi Enum 'kriegertypen miliz = 0 infanterie kavallerie artillerie End Enum Enum 'waffen schwert = 0 hellebarde spiess kanone muskete bajonett pistole lanze End Enum Enum 'befehle kaempfe = 1 verteidige gehezu status ausfuehren infobefehl End Enum Enum 'befehlsstatus unklar = 0 inausfuehrung ausgefuehrt kampfunfaehig 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 Operator = (p1 As tPosition, p2 As tPosition) As Integer If p1.x = p2.x AndAlso p1.y = p2.y Then Return TRUE Else Return FALSE EndIf End Operator Type tOffset x As Integer y As Integer End Type Operator = (o1 As tOffset, o2 As tOffset) As Integer If o1.x = o2.x AndAlso o1.y = o2.y Then Return TRUE Else Return FALSE EndIf End Operator Type tArray ReDim As tOffset offset(1) End Type Type tPolar r As Double phi As Double End Type Type tWaffe reichweite As Integer 'in metern wirkungmin As UByte 'in % wirkungmax As UByte 'in % latenz As Integer 'in sekunden rtw As Single 'relative trefferwahrscheinlichkeit. ergibt multipliziert mit der kampfkraft ' die absolute trefferwahrscheinlichkeit raw As Single 'relative abwehrwirkung 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 '--- 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 Function befehl(bef As UByte = 0, bpos As tPosition = Type(-1,-1)) As Byte Declare Function naechsterFeind(max As Integer = 0) As Integer Declare Function pol2kart(pk As tPolar) As tPosition '--- aktuellewaffe As UByte aktuellerbefehl As UByte befehlsstatus As UByte 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 UByte 'von 0 - 255 ermuedung As UByte 'von 0 - 255 verwundung As UByte 'in % waffenlatenz As UByte 'sekunden bis zur (wieder)einsatzbereitschaft der waffe munition As UByte 'für muskete/pistole Static As Integer maxEinsatzfaehig Static As Integer kmax0 Static As Integer sfmap() Static As tArray kreis() 'offsettabellen für umkreise Static As tPosition schlachtfeld Static As UByte festgelaufen Static As tWaffe waffe() Static As Integer lebend0 Static As Integer lebend1 Static As tKrieger krieger() _ziel As tPosition _position As tPosition _zaehler As Integer End Type 'STATIC - variablen deklarieren Dim As Integer tKrieger.maxEinsatzfaehig Dim As Integer tKrieger.kmax0 Dim As Integer tKrieger.sfmap() Dim As tArray tKrieger.kreis() Dim As tPosition tKrieger.schlachtfeld Dim As UByte tKrieger.festgelaufen Dim As Integer tKrieger.lebend0 Dim As Integer tKrieger.lebend1 ReDim As tWaffe tKrieger.waffe(lanze) ReDim As tKrieger tKrieger.krieger(1) 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, _px, _py, x, y Dim As Integer Ptr p1, p2 Dim As tPosition tp index = (Cast(UInteger,@This) - Cast(UInteger,@tKrieger.krieger(0))) / 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) _px = Int(_position.x) _py = Int(_position.y) If verwundung < 80 Then 'schlachtfeldkarte aktualisieren If sfmap(px, py) = 0 Then Swap sfmap(px, py), sfmap(_px, _py) _position = p 'neue position intern speichern _zaehler = 0 festgelaufen = 0 Else 'nicht bewegen _zaehler += 1 EndIf If _zaehler > 10 Then 'festgelaufen --> auf neue position im umkreis setzen feindindex = 0 'nächstes freie feld im umkreis suchen For x = 1 To UBound(kreis) 'konzentrische suchkreise With kreis(x) 'array mit offsettabellen für suchkreise (index = radius) 'For y = 1 To UBound(.offset) For y = _zaehler - 10 To UBound(.offset) tp = Type(_position.x + .offset(y).x, _position.y + .offset(y).y) '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(Int(tp.x), Int(tp.y)) = 0 Then sfmap(_px,_py) = 0 'altes feld räumen sfmap(Int(tp.x), Int(tp.y)) = index 'neues feld auf der karte besetzen _position = tp 'feindindex = 0 '_zaehler = 0 Exit For, For EndIf Next End With Next EndIf tp = _ziel - _position richtung = Atan2(tp.y, tp.x) 'winkel der bewegung neu berechnen 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 Function tKrieger.naechsterFeind(max As Integer = 0) As Integer Dim As Integer nF = 0, x, y, z, ze, schrittweite, index Dim As tPosition p Dim As tOffset sp Dim As Double entfFeind = this.schlachtfeld.x * this.schlachtfeld.x + this.schlachtfeld.y * this.schlachtfeld.y Dim As Double entfernung index = (Cast(UInteger,@This) - Cast(UInteger,@tKrieger.krieger(0))) / SizeOf(tKrieger) 'eigenen index im kriegerarray berechnen 'feind im umkreis suchen 'For x = 1 To 10 'konzentrische suchkreise ' With kreis(x) 'array mit offsettabellen für suchkreise (index = radius) ' For y = 1 To UBound(.offset) ' sp = Type(Int(this._position.x) + .offset(y).x, Int(this._position.y) + .offset(y).y) ' 'schlachtfeldgrenzen einhalten ' If (sp.x < 0) OrElse (sp.x > schlachtfeld.x) OrElse _ ' (sp.y < 0) OrElse (sp.y > schlachtfeld.y) Then ' Continue For ' EndIf ' z = sfmap(sp.x, sp.y) ' If (z <> 0) AndAlso ((z <= tKrieger.kmax0) AndAlso (index > tKrieger.kmax0)) OrElse ((z > tKrieger.kmax0) AndAlso (index <= tKrieger.kmax0)) Then ' Return z ' EndIf ' Next ' End With 'Next 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 (tKrieger.lebend0 <= max) OrElse (tKrieger.lebend1 <= max) Then 'nächsten feind aus allen kriegern ermitteln For x = untergrenze To obergrenze 'nur feindliche krieger If tKrieger.krieger(x).verwundung < 80 Then 'nur einsatzfähige krieger p = tKrieger.krieger(index).position - tKrieger.krieger(x).position entfernung = p.x * p.x + p.y * p.y If entfernung < entfFeind Then entfFeind = entfernung nF = x EndIf EndIf Next Else 'nächsten aus max zufällig ausgewählten kriegern ermitteln Do While z < max 'bis anzahl erreicht ist x = Int(Rnd * (obergrenze - untergrenze)) + untergrenze 'zufälliger feind If tKrieger.krieger(x).verwundung < 80 Then 'nur einsatzfähige krieger z += 1 p = tKrieger.krieger(index).position - tKrieger.krieger(x).position entfernung = p.x * p.x + p.y * p.y If entfernung < entfFeind Then entfFeind = entfernung nF = x EndIf EndIf Loop EndIf Return nF End Function Function tKrieger.befehl(bef As UByte = 0, bpos As tPosition = Type(-1,-1)) As Byte Dim As tPosition p Dim As Double distanz Dim As UInteger index = (Cast(UInteger,@This) - Cast(UInteger,@tKrieger.krieger(0))) / SizeOf(tKrieger) 'eigenen index im kriegerarray berechnen Dim As Single angriffsstaerke, abwehrstaerke Static As UByte status If verwundung < 80 Then Select Case bef Case kaempfe aktuellerbefehl = kaempfe feindindex = naechsterFeind(100) ziel = tKrieger.krieger(feindindex).position status = -bef Case verteidige aktuellerbefehl = verteidige ziel = bpos status = -bef Case gehezu aktuellerbefehl = gehezu ziel = bpos status = -bef Case status 'letzten status zurückgeben Case ausfuehren 'letzten befehl ausführen Select Case aktuellerbefehl Case kaempfe status = inausfuehrung 'auf nächsten feind zubewegen If feindindex = 0 Then 'feind mit der geringsten entfernung ermitteln feindindex = naechsterFeind(100) EndIf ziel = tKrieger.krieger(feindindex).position 'position des anvisierten feindes als ziel setzen p = ziel - position distanz = p.x * p.x + p.y * p.y 'entfernung zum aktuellen feind (zum quadrat) If waffenlatenz > 0 Then 'waffe nicht einsatzbereit waffenlatenz -= 1 ElseIf distanz <= tKrieger.waffe(aktuellewaffe).reichweite Then 'angreifen tKrieger.krieger(feindindex).feindindex = index 'angreifer wird neuer feind für angegriffenen kriegeer tKrieger.krieger(feindindex).ziel = position 'eigene position als ziel für angegriffenen tKrieger.krieger(feindindex)._zaehler = 0 'feindberührung --> kein festlaufen '######## waffeneinsatz angriffsstaerke = kampfkraft * tKrieger.waffe(aktuellewaffe).rtw abwehrstaerke = tKrieger.krieger(feindindex).kampfkraft * tKrieger.waffe(tKrieger.krieger(feindindex).aktuellewaffe).raw tKrieger.krieger(feindindex).verwundung += Int(Rnd * tKrieger.waffe(aktuellewaffe).wirkungmax) 'waffeneinsatz _zaehler = 0 'feindberührung --> kein festlaufen If aktuellewaffe = muskete Then If munition > 0 Then munition -= 1 Else aktuellewaffe = bajonett EndIf EndIf waffenlatenz += tKrieger.waffe(aktuellewaffe).latenz 'latenzzeit setzen If distanz < tKrieger.waffe(aktuellewaffe).reichweite - 0.4 Then 'distanz kleiner als die waffenreichweite position = position - pol2kart(Type(0.3,richtung)) 'vom feind entfernen EndIf Else 'laufen If distanz > geschwindigkeit * geschwindigkeit Then position = position + pol2kart(Type(geschwindigkeit,richtung)) 'krieger bewegen Else position = position + pol2kart(Type(0.45,richtung)) EndIf EndIf Case verteidige Case gehezu status = inausfuehrung p = ziel - position distanz = p.x * p.x + p.y * p.y 'entfernung von der zielposition (zum quadrat) If distanz < 0.5 Then status = ausgefuehrt EndIf If distanz > geschwindigkeit * geschwindigkeit Then position = position + pol2kart(Type(geschwindigkeit,richtung)) 'krieger bewegen ElseIf distanz > 0.5 Then position = position + pol2kart(Type(0.5,Atan2(p.y, p.x))) 'krieger bewegen Else position = ziel _zaehler = 0 'kein festlaufen EndIf End Select Case infobefehl status = aktuellerbefehl End Select Else status = kampfunfaehig EndIf Return status End Function Function tKrieger.pol2kart(pk As tPolar) As tPosition Return Type(pk.r * Cos(pk.phi), pk.r * Sin(pk.phi)) End Function 'parameter initialisieren tKrieger.waffe(schwert).reichweite = 1^2 tKrieger.waffe(hellebarde).reichweite = 2^2 tKrieger.waffe(spiess).reichweite = 6^2 tKrieger.waffe(kanone).reichweite = 1000^2 tKrieger.waffe(muskete).reichweite = 400^2 tKrieger.waffe(bajonett).reichweite = 1^2 tKrieger.waffe(pistole).reichweite = 10^2 tKrieger.waffe(lanze).reichweite = 4^2 tKrieger.waffe(schwert).latenz = 1 tKrieger.waffe(hellebarde).latenz = 2 tKrieger.waffe(spiess).latenz = 0 tKrieger.waffe(kanone).latenz = 180 tKrieger.waffe(muskete).latenz = 20 tKrieger.waffe(bajonett).latenz = 1 tKrieger.waffe(pistole).latenz = 20 tKrieger.waffe(lanze).latenz = 5 tKrieger.waffe(schwert).wirkungmin = 1.24 tKrieger.waffe(hellebarde).wirkungmin = 1 tKrieger.waffe(spiess).wirkungmin = 0 tKrieger.waffe(kanone).wirkungmin = 200.0 tKrieger.waffe(muskete).wirkungmin = 2 tKrieger.waffe(bajonett).wirkungmin = 1.1 tKrieger.waffe(pistole).wirkungmin = 5.0 tKrieger.waffe(lanze).wirkungmin = 3.0 tKrieger.waffe(schwert).wirkungmax = 1.24 tKrieger.waffe(hellebarde).wirkungmax = 100 tKrieger.waffe(spiess).wirkungmax = 0 tKrieger.waffe(kanone).wirkungmax = 100 tKrieger.waffe(muskete).wirkungmax = 50.0 tKrieger.waffe(bajonett).wirkungmax = 1.1 tKrieger.waffe(pistole).wirkungmax = 5.0 tKrieger.waffe(lanze).wirkungmax = 3.0 tKrieger.waffe(schwert).rtw = 1.24 tKrieger.waffe(hellebarde).rtw = 0.8 tKrieger.waffe(spiess).rtw = 0 tKrieger.waffe(kanone).rtw = 200.0 tKrieger.waffe(muskete).rtw = 0.8 tKrieger.waffe(bajonett).rtw = 1.1 tKrieger.waffe(pistole).rtw = 5.0 tKrieger.waffe(lanze).rtw = 3.0 tKrieger.waffe(schwert).raw = 1.24 tKrieger.waffe(hellebarde).raw = 0.5 tKrieger.waffe(spiess).raw = 0 tKrieger.waffe(kanone).raw = 200.0 tKrieger.waffe(muskete).raw = 0.5 tKrieger.waffe(bajonett).raw = 1.1 tKrieger.waffe(pistole).raw = 5.0 tKrieger.waffe(lanze).raw = 3.0 'offsettabellen für konzentrische kreise berechnen Dim As Integer r, z Dim As tOffset offs, offsvor ReDim tKrieger.kreis(400) 'maximaler radius For r = 1 To UBound(tKrieger.kreis) 'alle radien With tKrieger.kreis(r) ReDim .offset(1) z = 0 offsvor = Type(UBound(tKrieger.kreis) + 1, UBound(tKrieger.kreis) + 1) 'wert ausserhalb des größten kreises For phi As Double = 0 To pi/2 Step 1 / (8 * r) 'viertelkreis berechnen offs = Type(Int(r * Cos(phi) + .5), Int(r * Sin(phi) + .5)) 'kästchen berechnen If offs = offsvor Then 'berechneter wert = vorheriger wert Continue For 'nächsten wert berechnen EndIf offsvor = offs 'wert merken For y As Integer = IIf(r > 3, r - 2, 1) To r 'die letzten 2 suchkreise For x As Integer = 1 To UBound(tKrieger.kreis(y).offset) 'suchkreis durchsuchen If tKrieger.kreis(y).offset(x) = offs Then 'wert schon vorhanden Continue For, For, For 'nächsten wert berechnen EndIf Next Next z += 1 ReDim Preserve .offset(z) 'array erweitern .offset(z) = offs 'wert in array schreiben Next ReDim Preserve .offset(z - 1) End With Next For r = 1 To UBound(tKrieger.kreis) 'alle radien With tKrieger.kreis(r) z = UBound(.offset) ReDim Preserve .offset(z * 4) For y As Integer = 1 To z .offset(z + y) = Type(.offset(y).y * (-1), .offset(y).x) '2. viertelkreis .offset(2 * z + y) = Type(.offset(y).x * (-1), .offset(y).y * (-1)) '3. viertelkreis .offset(3 * z + y) = Type(.offset(y).y, .offset(y).x * (-1)) '4. viertelkreis Next End With Next '##################################### 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 naechsterFreund(index As Integer, krieger() As tKrieger) As Integer Declare Function zeitformat (sekunden As Integer) As String anfang: ? SizeOf(tKrieger) 'Dim As Integer test = 1000 Dim As Integer test = 1500 'Int(Rnd * 9900) + 100 'testarmeen erstellen With spieler(0) .name_ = "Feldherr 0" .rang = 2 .kriegskasse = 150000 With .heer With .milizen '.anzahl = test .anzahl = 500 .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 = 0 .hellebarden = 0 .spiesse = 100 .kanonen = 0 .musketen = 1000 .pistolen = 150 .lanzen = 200 End With End With With spieler(1) .name_ = "Feldherr 1" .rang = 2 .kriegskasse = 150000 With .heer With .milizen '.anzahl = Int(Rnd * 9900) + 100 .anzahl = 1600 .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 = 0 .hellebarden = 5000 .spiesse = 1000000 .kanonen = 0 .musketen = 0 .pistolen = 150 .lanzen = 200 End With End With 'anfang: 'krieger für die schlacht erstellen ReDim tKrieger.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 tKrieger.krieger(k).zugehoerigkeit = x tKrieger.krieger(k).typ = miliz tKrieger.krieger(k).kampfkraft = .milizen.kampfkraft tKrieger.krieger(k).motivation = .milizen.motivation If .musketen Then tKrieger.krieger(k).muskete = 1 tKrieger.krieger(k).aktuellewaffe = muskete tKrieger.krieger(k).munition = 100 .musketen -= 1 ElseIf .schwerter Then tKrieger.krieger(k).schwert = 1 tKrieger.krieger(k).aktuellewaffe = schwert .schwerter -= 1 ElseIf .hellebarden Then tKrieger.krieger(k).hellebarde = 1 tKrieger.krieger(k).aktuellewaffe = hellebarde .hellebarden -= 1 ElseIf .spiesse Then tKrieger.krieger(k).spiess = 1 tKrieger.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 tKrieger.krieger(k) 'referenzen auf die benötigten variablen setzen tKrieger.maxEinsatzfaehig = UBound(tKrieger.krieger) ? " krieger ";UBound(tKrieger.krieger) 'schlachtfeld Dim As tPosition posmil ? "schlachtfeldarray ";tKrieger.schlachtfeld.x * tKrieger.schlachtfeld.y * SizeOf(Integer)/1024/1024;" MB" ? " kriegerarray ";UBound(tKrieger.krieger) * SizeOf(tKrieger)/1024/1024;" MB" ? tKrieger.krieger(1).schlachtfeld.x;" ";tKrieger.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 tKrieger.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 tKrieger.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(tKrieger.krieger) tKrieger.sfmap(tKrieger.krieger(x).position.x, tKrieger.krieger(x).position.y) = x Next '################################################################### 'ablauf ScreenRes tKrieger.schlachtfeld.x, tKrieger.schlachtfeld.y, 32 'grafikscreen als schlachtfeld Dim As Integer sekunden ReDim As Integer reihenfolge(UBound(tKrieger.krieger)) tKrieger.lebend0 = tKrieger.kmax0 tKrieger.lebend1 = UBound(tKrieger.krieger) - tKrieger.kmax0 schlachtfeld_darstellen(tKrieger.krieger()) 'Sleep 5000 Randomize Timer For y As Integer = 1 To UBound(tKrieger.krieger) tKrieger.krieger(y).geschwindigkeit = 2.0 + Rnd 'individuelle geschwindigkeit zwischen 2m/s und 3m/s Next Dim g As String Dim As Integer flag = 0, i Open Cons For Output As #1 'kontrollmeldung zur konsole ReDim reihenfolge(UBound(tKrieger.krieger)) 'array für reihenfolge initialisieren 'befehle an die krieger ausgeben For x = 1 To UBound(tKrieger.krieger) reihenfolge(x) = x tKrieger.krieger(x).befehl(kaempfe) 'Dim As tPosition np = tKrieger.krieger(x).position + Type(0,100) * IIf(x > tKrieger.kmax0,1,-1) 'tKrieger.krieger(x).befehl(gehezu,np) Next sekunden = 0 Sleep 1000 'SCHLACHT Do ' jeder durchlauf entspricht 1 sekunde tKrieger.festgelaufen += 1 sekunden += 1 'schlachtfeldkarte auf 0 setzen Dim As Integer Ptr ap = @tKrieger.sfmap(0, 0) Clear *ap, 0, Len(*ap) * tKrieger.schlachtfeld.x * tKrieger.schlachtfeld.y tKrieger.lebend0 = 0 tKrieger.lebend1 = 0 'kampfunfähige krieger aussortieren 'letzten einsatzfähigen krieger suchen Do While tKrieger.krieger(reihenfolge(tKrieger.maxEinsatzfaehig)).verwundung >= 80 tKrieger.maxEinsatzfaehig -= 1 Loop i = tKrieger.maxEinsatzfaehig For y = i To 1 Step -1 'oberen teil der tabelle durchsuchen If tKrieger.krieger(reihenfolge(y)).verwundung >= 80 Then 'kampfunfähigen krieger gefunden Swap reihenfolge(y), reihenfolge(tKrieger.maxEinsatzfaehig) 'nicht einsatzfähige aussortieren tKrieger.krieger(reihenfolge(tKrieger.maxEinsatzfaehig)).feindindex = 0 tKrieger.krieger(reihenfolge(tKrieger.maxEinsatzfaehig)).geschwindigkeit = 0 For z As Integer = 1 To tKrieger.maxEinsatzfaehig 'bei allen verbleibenden kriegern... If tKrieger.krieger(reihenfolge(z)).feindindex = reihenfolge(tKrieger.maxEinsatzfaehig) Then tKrieger.krieger(reihenfolge(z)).feindindex = 0 '...verweis auf ausgeschiedenen krieger löschen EndIf Next tKrieger.maxEinsatzfaehig -= 1 Else 'einsatzfähig tKrieger.sfmap(Int(tKrieger.krieger(reihenfolge(y)).position.x), Int(tKrieger.krieger(reihenfolge(y)).position.y)) = reihenfolge(y) 'in schlachtfeldkarte eintragen If reihenfolge(y) > tKrieger.kmax0 Then tKrieger.lebend1 += 1 Else tKrieger.lebend0 += 1 EndIf EndIf Next Print #1, tKrieger.lebend0;" ";tKrieger.lebend1;" ";zeitformat(sekunden); If tKrieger.lebend0 < 1 OrElse tKrieger.lebend1 < 1 Then Exit Do 'schlacht beendet EndIf 'alle 30 sekunden einen neuen feind suchen If sekunden Mod 30 = 0 Then Print #1, " neuer Feind"; For x = 1 To tKrieger.maxEinsatzfaehig tKrieger.krieger(reihenfolge(x)).feindindex = 0 Next EndIf 'reihenfolge durcheinanderwürfeln For x = 1 To tKrieger.maxEinsatzfaehig Swap reihenfolge(x),reihenfolge(Int(Rnd * tKrieger.maxEinsatzfaehig) + 1) Next '---------------------------------------------------- 'befehlsausführung anstoßen Dim As Integer iaz = 0 flag = 0 For x = 1 To tKrieger.maxEinsatzfaehig 'alle einsatzfähigen krieger With tKrieger.krieger(reihenfolge(x)) If .befehl(ausfuehren) = inausfuehrung Then flag = 1 iaz += 1 EndIf End With Next 'Sleep '---------------------------------------------------- Print #1, iaz;" "; If tKrieger.festgelaufen > 0 Then Print #1, " festgelaufen"; EndIf Print #1, "" schlachtfeld_darstellen(tKrieger.krieger()) g = InKey Loop While (g = "" Or g = "n") And flag = 1 schlachtfeld_darstellen(tKrieger.krieger()) Close 1 Sleep 3000 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 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 'If .verwundung < 80 Then ' Draw String(.position.x, .position.y),Str(.verwundung),IIf(x > .imax0,RGB(255,255,255),RGB(0,255,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)) 'If tKrieger.sfmap(x,y) > tKrieger.kmax0 Then 'Else 'Draw String(x,y),text,IIf(tKrieger.sfmap(x,y) > tKrieger.kmax0,RGB(255,255,255),RGB(0,255,0)) 'EndIf EndIf Next Next Dim As Integer bl, grarm grarm = IIf(tKrieger.kmax0 > UBound(krieger) - tKrieger.kmax0,tKrieger.kmax0,UBound(krieger) - tKrieger.kmax0) '? grarm 'grarm =^ schlachtfeld.x '1 pixel =^ grarm / schlachtfeld.x 'balken =^ grarm / schlachtfeld.x * lebend bl = (tKrieger.schlachtfeld.x - 50) / grarm * tKrieger.lebend0 '/ 10 Line (0,12)-(bl,16),RGB(0,255,0),BF Draw String (bl + 5,12),Str(tKrieger.lebend0),RGB(0,255,0) bl = (tKrieger.schlachtfeld.x - 50) / grarm * tKrieger.lebend1 '/ 10 Line (0,5)-(bl,10),RGB(255,255,255),BF Draw String (bl + 5,5),Str(tKrieger.lebend1),RGB(255,255,255) 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