Restore typed tactical map drawing parity
ober
f12994d74854a0245522d617582fec00ca3da84c
--- a/templates/original-tactics-parts/TacticalMapView.kt.ss +++ b/templates/original-tactics-parts/TacticalMapView.kt.ss @@ -125,6 +125,13 @@ (kotlin-member-call toInt)) (extern (tmvAnyToString (value : Any)) : String (kotlin-member-call toString)) + (extern (tmvStringIndexOf (value : String) (needle : String)) : Int32 + (kotlin-member-call indexOf)) + (extern (tmvStringSubstring (value : String) (start : Int32) + (end : Int32)) : String + (kotlin-member-call substring)) + (extern (tmvStringCompareTo (value : String) (other : String)) : Int32 + (kotlin-member-call compareTo)) (extern (tmvJsonKeys (json : JSONObject)) : (Iterator String) (kotlin-member-call keys)) (extern (tmvIteratorHasNext (items : (Iterator String))) : Bool @@ -147,6 +154,8 @@ (kotlin-value Paint Style STROKE)) (extern (tmvPaintAlignLeft) : Align (kotlin-value Paint Align LEFT)) + (extern (tmvPaintAlignRight) : Align + (kotlin-value Paint Align RIGHT)) (extern (tmvPaintAlignCenter) : Align (kotlin-value Paint Align CENTER)) (extern (tmvPaintCapRound) : Cap @@ -166,6 +175,8 @@ (extern (tmvColorBlue (color : Int32)) : Int32 (kotlin-call Color blue)) (extern (tmvPaintColorSet (paint : Paint) (value : Int32)) : Unit (kotlin-member-set color)) + (extern (tmvPaintColorGet (paint : Paint)) : Int32 + (kotlin-member-get color)) (extern (tmvPaintStyleSet (paint : Paint) (value : Style)) : Unit (kotlin-member-set style)) (extern (tmvPaintStrokeWidthSet (paint : Paint) @@ -219,6 +230,9 @@ (y : Float32) (radius : Float32) (paint : Paint)) : Unit (kotlin-member-call drawCircle)) + (extern (tmvCanvasDrawOval (canvas : Canvas) (rect : RectF) + (paint : Paint)) : Unit + (kotlin-member-call drawOval)) (extern (tmvCanvasDrawText (canvas : Canvas) (value : String) (x : Float32) (y : Float32) (paint : Paint)) : Unit @@ -343,6 +357,32 @@ (kotlin-member-get range)) (extern (tmvManeuverAbbreviation (maneuver : String)) : String (kotlin-call maneuverAbbreviation)) + (extern (tmvProjectedPoseAt + (position : (Nullable JSONObject)) + (moves : (List ProjectedHelmMove)) + (impulse : Int32)) : (Nullable ProjectedHelmPose) + (kotlin-call projectedHelmPoseAt)) + (extern (tmvStartingProjectedPose + (position : JSONObject)) : ProjectedHelmPose + (kotlin-call startingProjectedHelmPose)) + (extern (tmvApplyProjectedMove + (pose : ProjectedHelmPose) + (maneuver : (Nullable String))) : ProjectedHelmPose + (kotlin-call applyProjectedHelmMove)) + (extern (tmvMoveForward (pose : ProjectedHelmPose)) : ProjectedHelmPose + (kotlin-call moveForward)) + (extern (tmvMoveInDirection (pose : ProjectedHelmPose) + (direction : Int32)) : ProjectedHelmPose + (kotlin-call moveInDirection)) + (extern (tmvCanProjectedTurn (pose : ProjectedHelmPose)) : Bool + (kotlin-call canProjectedTurn_p)) + (extern (tmvTurnModeRequiredDistance (mode : String) + (speed : Int32)) : Int32 + (kotlin-call turnModeRequiredDistance)) + (extern (tmvMovementImpulses (speed : Int32)) : (MutableList Int32) + (kotlin-call movementImpulsesForSpeed)) + (extern (tmvNormalizedFacing (facing : Int32)) : Int32 + (kotlin-call normalizedHelmFacing)) (extern (tmvShipDisplayLabel (ship : (Nullable JSONObject))) : String (kotlin-call shipDisplayLabel)) (extern (tmvCurrentBattleRange (battle : (Nullable JSONObject))) : String @@ -588,6 +628,22 @@ (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) (tmvColorRgb (int32 70) (int32 167) (int32 106)) (tmvPaintStyleStroke) (float32 5.0) #t #f) (modifiers private)) + (val weaponArcPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorArgb (int32 24) (int32 21) (int32 96) (int32 189)) + (tmvPaintStyleFill) (float32 0.0) #f #f) (modifiers private)) + (val weaponArcStrokePaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorArgb (int32 72) (int32 21) (int32 96) (int32 189)) + (tmvPaintStyleStroke) (float32 2.0) #t #t) (modifiers private)) + (val projectedPathPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorArgb (int32 150) (int32 21) (int32 96) (int32 189)) + (tmvPaintStyleStroke) (float32 4.0) #t #t) (modifiers private)) + (val projectedPointPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorArgb (int32 220) (int32 21) (int32 96) (int32 189)) + (tmvPaintStyleFill) (float32 0.0) #f #f) (modifiers private)) (val orangePaint : Paint (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) (tmvColorRgb (int32 215) (int32 131) (int32 39)) @@ -608,6 +664,17 @@ (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) (tmvColorWhite) (tmvPaintStyleStroke) (float32 4.0) #t #t) (modifiers private)) + (val shipShadowStrokePaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorArgb (int32 150) (int32 20) (int32 26) (int32 36)) + (tmvPaintStyleStroke) (float32 7.0) #t #t) (modifiers private)) + (val shipBadgeBackPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorArgb (int32 190) (int32 20) (int32 26) (int32 36)) + (tmvPaintStyleFill) (float32 0.0) #f #f) (modifiers private)) + (val shipBadgePaint : Paint + (tmvConfigureTextPaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorWhite) (float32 13.0) #t #t) (modifiers private)) (val detailPaint : Paint (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) (tmvColorArgb (int32 185) (int32 255) (int32 255) (int32 255)) @@ -869,8 +936,8 @@ (tmvColorRgb (int32 184) (int32 67) (int32 54))) (drawFireSolutions canvas alphaPoint betaPoint) (drawMovementTrails canvas transform) - (drawProjectedHelmPlot canvas transform alphaProjected alphaPaint) - (drawProjectedHelmPlot canvas transform betaProjected betaPaint) + (drawProjectedHelmPlots canvas transform alphaPosition betaPosition + alphaProjected betaProjected) (drawProjectedRangeForecast canvas transform alphaPosition betaPosition orders impulse) (drawFireTargetLine canvas transform alphaPosition @@ -896,6 +963,10 @@ (json-object-opt-any battle "beta-shield-facing-hit"))) (drawImpactEffects canvas alphaPoint betaPoint) (drawBlockedManeuverBadges canvas alphaPoint betaPoint) + (drawVolleyBadge canvas battle betaPoint "alpha-volley" + "A" alphaPaint (int32 -1)) + (drawVolleyBadge canvas battle alphaPoint "beta-volley" + "B" betaPaint (int32 1)) (drawBattleBadge canvas battle) (drawTerrainBadge canvas battle) (drawTacticalOverlay canvas battle))))))) @@ -1127,47 +1198,119 @@ (def (drawProjectedHelmPlot (canvas : Canvas) (transform : TacticalMapTransform) + (label : String) + (position : JSONObject) (moves : (List ProjectedHelmMove)) - (paint : Paint)) : Int32 + (color : Int32) + (labelSide : Int32)) : Unit (modifiers private) (if (= (list-size moves) (int32 0)) - (int32 0) - (var ((previous (nullable-none TacticalPoint))) - (for/fold ((ignored (int32 0))) - ((index (in-range (int32 0) (list-size moves)))) - (let ((move (list-ref moves index))) - (let ((pose (tmvProjectedMovePose move))) + (begin) + (let ((path (new Path)) + (start (tmvTransformPoint transform + (json-object-opt-float32-default + position "q" (float32 0.0)) + (json-object-opt-float32-default + position "r" (float32 0.0))))) + (begin + (tmvPathMoveTo path + (TacticalPoint-x start) (TacticalPoint-y start)) + (for/fold ((ignored (int32 0))) + ((index (in-range (int32 0) (list-size moves)))) + (let ((pose (tmvProjectedMovePose (list-ref moves index)))) (let ((point (tmvTransformPoint transform (float32 (tmvProjectedPoseQ pose)) (float32 (tmvProjectedPoseR pose))))) (begin - (if (nullable-null? previous) - (begin) - (tmvCanvasDrawLine canvas - (TacticalPoint-x (nullable-get previous)) - (TacticalPoint-y (nullable-get previous)) - (TacticalPoint-x point) (TacticalPoint-y point) - dashPaint)) - (tmvCanvasDrawCircle canvas (TacticalPoint-x point) - (TacticalPoint-y point) (float32 7.0) paint) - (let ((maneuver (tmvProjectedMoveManeuver move))) - (tmvCanvasDrawText canvas - (if (nullable-null? maneuver) - (int32->string (tmvProjectedMoveImpulse move)) - (string-append - (int32->string (tmvProjectedMoveImpulse move)) - (string-append " " - (tmvManeuverAbbreviation - (nullable-get maneuver))))) - (TacticalPoint-x point) - (- (TacticalPoint-y point) (float32 11.0)) - centeredPaint)) - (drawFacingGuide canvas point - (* (TacticalMapTransform-scale transform) (float32 0.65)) - (tmvFacingAngleRadians - (float32 (tmvProjectedPoseFacing pose))) paint) - (set! previous (nullable-some point)) - ignored)))))))) + (tmvPathLineTo path + (TacticalPoint-x point) (TacticalPoint-y point)) + ignored)))) + (tmvPaintColorSet projectedPathPaint + (tmvColorArgb (int32 150) (tmvColorRed color) + (tmvColorGreen color) (tmvColorBlue color))) + (tmvPaintColorSet projectedPointPaint + (tmvColorArgb (int32 220) (tmvColorRed color) + (tmvColorGreen color) (tmvColorBlue color))) + (tmvCanvasDrawPath canvas path projectedPathPaint) + (drawProjectedHelmSteps canvas transform moves + labelSide (int32 0)) + (let ((lastMove + (list-ref moves (- (list-size moves) (int32 1))))) + (let ((lastPose (tmvProjectedMovePose lastMove))) + (let ((lastPoint (tmvTransformPoint transform + (float32 (tmvProjectedPoseQ lastPose)) + (float32 (tmvProjectedPoseR lastPose))))) + (begin + (tmvPaintColorSet centeredPaint color) + (tmvCanvasDrawText canvas + (string-append label " PLOT") + (TacticalPoint-x lastPoint) + (tmvMinFloat + (+ (TacticalPoint-y lastPoint) (float32 24.0)) + (- drawHeight (float32 6.0))) centeredPaint) + (tmvPaintColorSet centeredPaint + (tmvColorRgb (int32 28) (int32 35) (int32 48))))))))))) + (def (drawProjectedHelmSteps + (canvas : Canvas) (transform : TacticalMapTransform) + (moves : (List ProjectedHelmMove)) + (labelSide : Int32) (index : Int32)) : Unit + (modifiers private) + (if (>= index (list-size moves)) + (begin) + (let ((move (list-ref moves index))) + (let ((pose (tmvProjectedMovePose move)) + (maneuver (tmvProjectedMoveManeuver move))) + (let ((point (tmvTransformPoint transform + (float32 (tmvProjectedPoseQ pose)) + (float32 (tmvProjectedPoseR pose)))) + (last? (= index (- (list-size moves) (int32 1))))) + (begin + (tmvCanvasDrawCircle canvas + (TacticalPoint-x point) (TacticalPoint-y point) + (if last? (float32 7.0) (float32 5.0)) + projectedPointPaint) + (if (and (nullable-null? maneuver) (not last?)) + (begin) + (let ((text + (if (nullable-null? maneuver) + (int32->string + (tmvProjectedMoveImpulse move)) + (string-append + (int32->string + (tmvProjectedMoveImpulse move)) + (string-append ":" + (tmvManeuverAbbreviation + (nullable-get maneuver))))))) + (let ((width + (+ (tmvPaintMeasureText centeredPaint text) + (float32 12.0)))) + (let ((x (tmvClampFloat + (+ (TacticalPoint-x point) + (* (float32 labelSide) + (+ (* width (float32 0.45)) + (float32 10.0)))) + (+ (/ width (float32 2.0)) + (float32 6.0)) + (- drawWidth + (+ (/ width (float32 2.0)) + (float32 6.0))))) + (y (tmvClampFloat + (- (TacticalPoint-y point) + (float32 13.0)) + (float32 24.0) + (- drawHeight (float32 8.0))))) + (begin + (tmvCanvasDrawRoundRect canvas + (new RectF + (- x (/ width (float32 2.0))) + (- y (float32 18.0)) + (+ x (/ width (float32 2.0))) + (+ y (float32 4.0))) + (float32 8.0) (float32 8.0) pillPaint) + (tmvCanvasDrawText canvas text x + (- y (float32 3.0)) centeredPaint)))))) + (drawProjectedHelmSteps canvas transform moves + labelSide (+ index (int32 1))))))))) (def (drawFacingGuide (canvas : Canvas) (point : TacticalPoint) (length : Float32) (angle : Float) (paint : Paint)) : Unit @@ -1211,16 +1354,40 @@ (modifiers private) (if (nullable-null? target) (begin) - (let ((a (tmvTransformPoint transform - (json-object-opt-float32-default source "q" (float32 0.0)) - (json-object-opt-float32-default source "r" (float32 0.0)))) - (b (tmvTransformPoint transform - (json-object-opt-float32-default - (nullable-get target) "q" (float32 0.0)) - (json-object-opt-float32-default - (nullable-get target) "r" (float32 0.0))))) - (tmvCanvasDrawLine canvas (TacticalPoint-x a) (TacticalPoint-y a) - (TacticalPoint-x b) (TacticalPoint-y b) paint)))) + (let ((targetPosition + (json-object-opt-json-object + (nullable-get target) "position"))) + (if (nullable-null? targetPosition) + (begin) + (let ((a (tmvTransformPoint transform + (json-object-opt-float32-default + source "q" (float32 0.0)) + (json-object-opt-float32-default + source "r" (float32 0.0)))) + (b (tmvTransformPoint transform + (json-object-opt-float32-default + (nullable-get targetPosition) + "q" (float32 0.0)) + (json-object-opt-float32-default + (nullable-get targetPosition) + "r" (float32 0.0)))) + (reticle (* (TacticalMapTransform-scale transform) + (float32 0.36)))) + (begin + (tmvCanvasDrawLine canvas + (TacticalPoint-x a) (TacticalPoint-y a) + (TacticalPoint-x b) (TacticalPoint-y b) paint) + (tmvCanvasDrawCircle canvas + (TacticalPoint-x b) (TacticalPoint-y b) + reticle paint) + (tmvCanvasDrawLine canvas + (- (TacticalPoint-x b) reticle) (TacticalPoint-y b) + (+ (TacticalPoint-x b) reticle) (TacticalPoint-y b) + paint) + (tmvCanvasDrawLine canvas + (TacticalPoint-x b) (- (TacticalPoint-y b) reticle) + (TacticalPoint-x b) (+ (TacticalPoint-y b) reticle) + paint))))))) (def (drawFireSolutions (canvas : Canvas) (alpha : TacticalPoint) (beta : TacticalPoint)) : Unit @@ -1306,32 +1473,273 @@ (actor : (Nullable JSONObject)) (sideColor : Int32)) : Unit (modifiers private) - (let ((solution (actorFireSolution actor))) - (if (<= (TacticalFireSolution-armed solution) (int32 0)) + (let ((fans (actorWeaponArcFans actor))) + (if (= (list-size fans) (int32 0)) (begin) (let ((center (tmvTransformPoint transform (TacticalShipPose-q pose) (TacticalShipPose-r pose))) - (radius (* (TacticalMapTransform-scale transform) - (float32 4.8)))) - (begin - (tmvPaintColorSet greenPaint - (tmvColorArgb (int32 80) - (tmvColorRed sideColor) (tmvColorGreen sideColor) - (tmvColorBlue sideColor))) - (tmvCanvasDrawArc canvas - (new RectF - (- (TacticalPoint-x center) radius) - (- (TacticalPoint-y center) radius) - (+ (TacticalPoint-x center) radius) - (+ (TacticalPoint-y center) radius)) - (float32 - (- (* (tmvFacingAngleRadians - (TacticalShipPose-facing pose)) - (/ 180.0 (tmvPi))) 60.0)) - (float32 120.0) #t greenPaint) - (tmvPaintColorSet greenPaint - (tmvColorRgb (int32 70) (int32 167) (int32 106)))))))) + (radius (tmvMaxFloat + (hexCenterDistance transform (int32 5)) + (* (TacticalMapTransform-scale transform) + (float32 2.4)))) + (degrees (float32 + (* (tmvFacingAngleRadians + (TacticalShipPose-facing pose)) + (/ 180.0 (tmvPi)))))) + (drawBestWeaponArcFans canvas center radius degrees + sideColor fans (int32 0)))))) + (def (drawBestWeaponArcFans + (canvas : Canvas) (center : TacticalPoint) + (radius : Float32) (degrees : Float32) (sideColor : Int32) + (fans : (MutableList TacticalArcFan)) + (drawn : Int32)) : Unit + (modifiers private) + (if (or (= (list-size fans) (int32 0)) (>= drawn (int32 4))) + (begin) + (let ((bestIndex + (bestArcFanIndex fans (int32 1) (int32 0)))) + (let ((fan (list-ref fans bestIndex))) + (let ((alpha + (if (= (TacticalArcFan-strength fan) (int32 3)) + (int32 42) + (if (= (TacticalArcFan-strength fan) (int32 2)) + (int32 28) (int32 18))))) + (begin + (tmvPaintColorSet weaponArcPaint + (tmvColorArgb alpha (tmvColorRed sideColor) + (tmvColorGreen sideColor) (tmvColorBlue sideColor))) + (tmvPaintColorSet weaponArcStrokePaint + (tmvColorArgb (* alpha (int32 3)) + (tmvColorRed sideColor) (tmvColorGreen sideColor) + (tmvColorBlue sideColor))) + (drawWeaponArcFan canvas center radius degrees + (TacticalArcFan-code fan)) + (mutable-list-remove! fans fan) + (drawBestWeaponArcFans canvas center radius degrees + sideColor fans (+ drawn (int32 1))))))))) + (def (bestArcFanIndex (fans : (List TacticalArcFan)) + (index : Int32) (best : Int32)) : Int32 + (modifiers private) + (if (>= index (list-size fans)) best + (bestArcFanIndex fans (+ index (int32 1)) + (if (arcFanBefore? (list-ref fans index) (list-ref fans best)) + index best)))) + (def (arcFanBefore? (left : TacticalArcFan) + (right : TacticalArcFan)) : Bool + (modifiers private) + (if (> (TacticalArcFan-strength left) + (TacticalArcFan-strength right)) #t + (if (< (TacticalArcFan-strength left) + (TacticalArcFan-strength right)) #f + (let ((leftBucket (arcSortBucket (TacticalArcFan-code left))) + (rightBucket (arcSortBucket (TacticalArcFan-code right)))) + (if (< leftBucket rightBucket) #t + (if (> leftBucket rightBucket) #f + (< (tmvStringCompareTo + (TacticalArcFan-code left) + (TacticalArcFan-code right)) + (int32 0)))))))) + + (def (drawWeaponArcFan (canvas : Canvas) (center : TacticalPoint) + (radius : Float32) (facingDegrees : Float32) + (code : String)) : Int32 + (modifiers private) + (let ((sectors (firingArcSectors code)) + (bounds (new RectF + (- (TacticalPoint-x center) radius) + (- (TacticalPoint-y center) radius) + (+ (TacticalPoint-x center) radius) + (+ (TacticalPoint-y center) radius)))) + (for/fold ((ignored (int32 0))) + ((index (in-range (int32 0) (list-size sectors)))) + (let ((sector (list-ref sectors index))) + (begin + (if (>= (TacticalArcSector-sweep sector) (float32 359.0)) + (begin + (tmvCanvasDrawCircle canvas (TacticalPoint-x center) + (TacticalPoint-y center) radius weaponArcPaint) + (tmvCanvasDrawCircle canvas (TacticalPoint-x center) + (TacticalPoint-y center) radius weaponArcStrokePaint)) + (let ((start + (- (+ facingDegrees + (TacticalArcSector-centerOffset sector)) + (/ (TacticalArcSector-sweep sector) + (float32 2.0))))) + (begin + (tmvCanvasDrawArc canvas bounds start + (TacticalArcSector-sweep sector) #t weaponArcPaint) + (tmvCanvasDrawArc canvas bounds start + (TacticalArcSector-sweep sector) #t + weaponArcStrokePaint)))) + ignored))))) + (def (actorWeaponArcFans + (actor : (Nullable JSONObject))) : (MutableList TacticalArcFan) + (modifiers private) + (let ((out (mutable-list-empty TacticalArcFan))) + (if (nullable-null? actor) + out + (let ((weapons (json-object-opt-json-array + (nullable-get actor) "weapon-status"))) + (if (nullable-null? weapons) out + (begin + (actorWeaponArcFansAt + (nullable-get weapons) (int32 0) out) + out)))))) + (def (actorWeaponArcFansAt (weapons : JSONArray) (index : Int32) + (out : (MutableList TacticalArcFan))) : Unit + (modifiers private) + (if (>= index (json-array-length weapons)) + (begin) + (let ((weapon (json-array-opt-json-object weapons index))) + (begin + (if (nullable-null? weapon) + (begin) + (let ((strength + (if (> (json-object-opt-int32-default + (nullable-get weapon) + "fireable-in-arc" (int32 0)) (int32 0)) + (int32 3) + (if (> (json-object-opt-int32-default + (nullable-get weapon) + "fireable" (int32 0)) (int32 0)) + (int32 2) + (if (> (json-object-opt-int32-default + (nullable-get weapon) + "armed" (int32 0)) (int32 0)) + (int32 1) (int32 0)))))) + (if (or (<= strength (int32 0)) + (<= (json-object-opt-int32-default + (nullable-get weapon) + "installed" (int32 0)) (int32 0))) + (begin) + (let ((arcs (json-object-opt-json-array + (nullable-get weapon) "arc-codes"))) + (if (nullable-null? arcs) + (addArcFan out + (json-object-opt-string-default + (nullable-get weapon) "arc" "") strength) + (addArcFansFromArray out + (nullable-get arcs) (int32 0) strength)))))) + (actorWeaponArcFansAt weapons (+ index (int32 1)) out))))) + (def (addArcFansFromArray (out : (MutableList TacticalArcFan)) + (arcs : JSONArray) (index : Int32) + (strength : Int32)) : Unit + (modifiers private) + (if (>= index (json-array-length arcs)) + (begin) + (begin + (addArcFan out + (tmvAnyText (json-array-opt-any arcs index) "") strength) + (addArcFansFromArray out arcs (+ index (int32 1)) strength)))) + (def (addArcFan (out : (MutableList TacticalArcFan)) + (rawCode : String) (strength : Int32)) : Unit + (modifiers private) + (let ((code (tmvStringUppercase (tmvStringTrim rawCode)))) + (if (string-blank? code) (begin) + (addArcFanAt out code strength (int32 0))))) + (def (addArcFanAt (out : (MutableList TacticalArcFan)) + (code : String) (strength : Int32) + (index : Int32)) : Unit + (modifiers private) + (if (>= index (list-size out)) + (mutable-list-add! out (make-TacticalArcFan code strength)) + (let ((fan (list-ref out index))) + (if (tmvStringEquals (TacticalArcFan-code fan) code) + (if (> strength (TacticalArcFan-strength fan)) + (mutable-list-set! out index + (make-TacticalArcFan code strength)) + (begin)) + (addArcFanAt out code strength (+ index (int32 1))))))) + (def (firingArcSectors (code : String)) : (MutableList TacticalArcSector) + (modifiers private) + (let ((out (mutable-list-empty TacticalArcSector)) + (normalized + (tmvStringReplace (tmvStringUppercase code) " " ""))) + (let ((plus (tmvStringIndexOf normalized "+")) + (slash (tmvStringIndexOf normalized "/"))) + (begin + (if (or (tmvStringEquals normalized "360") + (tmvStringEquals normalized "ALL")) + (mutable-list-add! out + (make-TacticalArcSector (float32 0.0) (float32 360.0))) + (begin)) + (if (or (tmvStringEquals normalized "FA") + (tmvStringEquals normalized "F")) + (mutable-list-add! out + (make-TacticalArcSector (float32 0.0) (float32 120.0))) + (begin)) + (if (tmvStringEquals normalized "FH") + (mutable-list-add! out + (make-TacticalArcSector (float32 0.0) (float32 180.0))) + (begin)) + (if (or (tmvStringEquals normalized "RA") + (tmvStringEquals normalized "A")) + (mutable-list-add! out + (make-TacticalArcSector (float32 180.0) (float32 120.0))) + (begin)) + (if (tmvStringEquals normalized "RH") + (mutable-list-add! out + (make-TacticalArcSector (float32 180.0) (float32 180.0))) + (begin)) + (if (tmvStringEquals normalized "LF") + (mutable-list-add! out + (make-TacticalArcSector (float32 -60.0) (float32 120.0))) + (begin)) + (if (tmvStringEquals normalized "RF") + (mutable-list-add! out + (make-TacticalArcSector (float32 60.0) (float32 120.0))) + (begin)) + (if (or (tmvStringEquals normalized "L") + (tmvStringEquals normalized "LS")) + (mutable-list-add! out + (make-TacticalArcSector (float32 -90.0) (float32 180.0))) + (begin)) + (if (or (tmvStringEquals normalized "R") + (tmvStringEquals normalized "RS")) + (mutable-list-add! out + (make-TacticalArcSector (float32 90.0) (float32 180.0))) + (begin)) + (if (or (tmvStringEquals normalized "LP") + (tmvStringEquals normalized "PORT")) + (mutable-list-add! out + (make-TacticalArcSector (float32 -90.0) (float32 120.0))) + (begin)) + (if (or (tmvStringEquals normalized "RP") + (tmvStringEquals normalized "STARBOARD")) + (mutable-list-add! out + (make-TacticalArcSector (float32 90.0) (float32 120.0))) + (begin)) + (let ((separator (if (>= plus (int32 0)) plus slash))) + (if (< separator (int32 0)) + (begin) + (begin + (mutable-list-add-all! out + (firingArcSectors + (tmvStringSubstring normalized + (int32 0) separator))) + (mutable-list-add-all! out + (firingArcSectors + (tmvStringSubstring normalized + (+ separator (int32 1)) + (string-length-int32 normalized))))))) + out)))) + (def (arcSortBucket (code : String)) : Int32 + (modifiers private) + (let ((normalized (tmvStringUppercase code))) + (if (or (tmvStringEquals normalized "FA") + (or (tmvStringEquals normalized "F") + (tmvStringEquals normalized "FH"))) (int32 0) + (if (or (tmvStringEquals normalized "LF") + (or (tmvStringEquals normalized "RF") + (or (tmvStringEquals normalized "L") + (tmvStringEquals normalized "R")))) (int32 1) + (if (or (tmvStringEquals normalized "RA") + (or (tmvStringEquals normalized "RH") + (tmvStringEquals normalized "A"))) (int32 2) + (if (or (tmvStringEquals normalized "360") + (tmvStringEquals normalized "ALL")) (int32 3) + (int32 4))))))) (def (shieldFacingIndex (value : (Nullable Any))) : Int32 (modifiers private) @@ -1358,66 +1766,331 @@ (modifiers private) (let ((center (tmvTransformPoint transform (TacticalShipPose-q pose) (TacticalShipPose-r pose))) - (radius (* (TacticalMapTransform-scale transform) (float32 0.72)))) - (let ((state (tmvCanvasSave canvas))) - (begin - (tmvCanvasTranslate canvas (TacticalPoint-x center) - (TacticalPoint-y center)) - (tmvCanvasRotate canvas - (float32 (* (tmvFacingAngleRadians - (TacticalShipPose-facing pose)) - (/ 180.0 (tmvPi))))) - (drawRaceShipSilhouette canvas radius fill (shipRaceKey ship)) - (tmvCanvasRestoreToCount canvas state) - (drawShieldRing canvas center (* radius (float32 1.18)) ship hitShield) - (drawShipLabel canvas label + (radius (* (TacticalMapTransform-scale transform) (float32 0.54))) + (angle (tmvFacingAngleRadians (TacticalShipPose-facing pose)))) + (begin + (drawShieldRing canvas center (* radius (float32 1.35)) ship hitShield) + (drawFacingGuide canvas center (* radius (float32 1.9)) angle fill) + (drawRaceShipSilhouette canvas center radius angle ship fill) + (drawRaceBadge canvas center radius ship) + (drawShipLabel canvas label + (tmvClampFloat (+ (TacticalPoint-x center) - (* (float32 labelSide) (+ radius (float32 28.0)))) - (TacticalPoint-y center) ship position labelSide))))) - (def (drawRaceShipSilhouette (canvas : Canvas) (radius : Float32) - (fill : Paint) (race : String)) : Unit + (* (float32 labelSide) + (* (TacticalMapTransform-scale transform) (float32 1.25)))) + (float32 8.0) (- drawWidth (float32 8.0))) + (tmvClampFloat + (- (TacticalPoint-y center) + (* (TacticalMapTransform-scale transform) (float32 1.15))) + (float32 34.0) (- drawHeight (float32 12.0))) + ship position labelSide)))) + (def (drawRaceShipSilhouette + (canvas : Canvas) (center : TacticalPoint) (radius : Float32) + (angle : Float) (ship : (Nullable JSONObject)) + (fill : Paint)) : Unit (modifiers private) - (let ((path (new Path))) + (let ((state (tmvCanvasSave canvas)) + (iconRadius (* radius (float32 1.24))) + (race (shipRaceKey ship))) (begin + (tmvCanvasTranslate canvas (TacticalPoint-x center) + (TacticalPoint-y center)) + (tmvCanvasRotate canvas (float32 (* angle (/ 180.0 (tmvPi))))) + (if (tmvStringEquals race "federation") + (drawFederationSilhouette canvas iconRadius fill) + (if (tmvStringEquals race "klingon") + (drawKlingonSilhouette canvas iconRadius fill) + (if (tmvStringEquals race "romulan") + (drawRomulanSilhouette canvas iconRadius fill) + (if (tmvStringEquals race "kzinti") + (drawKzintiSilhouette canvas iconRadius fill) + (if (tmvStringEquals race "andromedan") + (drawAndromedanSilhouette canvas iconRadius fill) (if (tmvStringEquals race "tholian") - (begin - (tmvPathMoveTo path radius (float32 0.0)) - (tmvPathLineTo path (* radius (float32 -0.65)) - (* radius (float32 -0.72))) - (tmvPathLineTo path (* radius (float32 -0.65)) - (* radius (float32 0.72)))) - (if (tmvStringEquals race "andromedan") - (begin - (tmvPathMoveTo path radius (float32 0.0)) - (tmvPathLineTo path (float32 0.0) (* radius (float32 -0.82))) - (tmvPathLineTo path (- radius) (float32 0.0)) - (tmvPathLineTo path (float32 0.0) (* radius (float32 0.82)))) - (begin - (tmvPathMoveTo path radius (float32 0.0)) - (tmvPathLineTo path (* radius (float32 0.10)) - (* radius (float32 -0.42))) - (tmvPathLineTo path (* radius (float32 -0.95)) - (* radius (float32 -0.82))) - (tmvPathLineTo path (* radius (float32 -0.62)) - (float32 0.0)) - (tmvPathLineTo path (* radius (float32 -0.95)) - (* radius (float32 0.82))) - (tmvPathLineTo path (* radius (float32 0.10)) - (* radius (float32 0.42)))))) + (drawTholianSilhouette canvas iconRadius fill) + (if (tmvStringEquals race "gorn") + (drawGornSilhouette canvas iconRadius fill) + (if (tmvStringEquals race "hydran") + (drawHydranSilhouette canvas iconRadius fill) + (if (tmvStringEquals race "lyran") + (drawLyranSilhouette canvas iconRadius fill) + (if (tmvStringEquals race "isc") + (drawIscSilhouette canvas iconRadius fill) + (if (tmvStringEquals race "orion") + (drawOrionSilhouette canvas iconRadius fill) + (drawGenericSilhouette canvas iconRadius fill)))))))))))) + (tmvCanvasRestoreToCount canvas state)))) + + (def (drawFilledPath (canvas : Canvas) (path : Path) + (fill : Paint)) : Unit + (modifiers private) + (begin + (tmvCanvasDrawPath canvas path fill) + (tmvCanvasDrawPath canvas path shipShadowStrokePaint) + (tmvCanvasDrawPath canvas path whiteStrokePaint))) + + (def (drawFederationSilhouette (canvas : Canvas) (r : Float32) + (fill : Paint)) : Unit + (modifiers private) + (let ((body (new RectF (* r (float32 -0.88)) (* r (float32 -0.14)) + (* r (float32 0.10)) (* r (float32 0.14)))) + (port (new RectF (* r (float32 -0.92)) (* r (float32 -0.70)) + (* r (float32 0.18)) (* r (float32 -0.48)))) + (starboard (new RectF (* r (float32 -0.92)) (* r (float32 0.48)) + (* r (float32 0.18)) (* r (float32 0.70)))) + (saucer (new RectF (* r (float32 -0.08)) (* r (float32 -0.58)) + (* r (float32 1.10)) (* r (float32 0.58))))) + (begin + (tmvCanvasDrawRoundRect canvas body (* r (float32 0.10)) + (* r (float32 0.10)) fill) + (tmvCanvasDrawRoundRect canvas port (* r (float32 0.12)) + (* r (float32 0.12)) fill) + (tmvCanvasDrawRoundRect canvas starboard (* r (float32 0.12)) + (* r (float32 0.12)) fill) + (tmvCanvasDrawOval canvas saucer fill) + (tmvCanvasDrawRoundRect canvas body (* r (float32 0.10)) + (* r (float32 0.10)) whiteStrokePaint) + (tmvCanvasDrawRoundRect canvas port (* r (float32 0.12)) + (* r (float32 0.12)) whiteStrokePaint) + (tmvCanvasDrawRoundRect canvas starboard (* r (float32 0.12)) + (* r (float32 0.12)) whiteStrokePaint) + (tmvCanvasDrawOval canvas saucer whiteStrokePaint) + (tmvCanvasDrawLine canvas (* r (float32 0.16)) (float32 0.0) + (* r (float32 0.84)) (float32 0.0) detailPaint)))) + + (def (drawKlingonSilhouette (canvas : Canvas) (r : Float32) + (fill : Paint)) : Unit + (modifiers private) + (let ((wings (new Path))) + (begin + (tmvPathMoveTo wings (* r (float32 0.10)) (* r (float32 -0.14))) + (tmvPathLineTo wings (* r (float32 -1.06)) (* r (float32 -0.78))) + (tmvPathLineTo wings (* r (float32 -0.70)) (* r (float32 -0.18))) + (tmvPathLineTo wings (* r (float32 -0.20)) (float32 0.0)) + (tmvPathLineTo wings (* r (float32 -0.70)) (* r (float32 0.18))) + (tmvPathLineTo wings (* r (float32 -1.06)) (* r (float32 0.78))) + (tmvPathLineTo wings (* r (float32 0.10)) (* r (float32 0.14))) + (tmvPathClose wings) + (drawFilledPath canvas wings fill) + (let ((neck (new RectF (* r (float32 -0.18)) (* r (float32 -0.10)) + (* r (float32 0.76)) (* r (float32 0.10)))) + (head (new RectF (* r (float32 0.58)) (* r (float32 -0.28)) + (* r (float32 1.10)) (* r (float32 0.28))))) + (begin + (tmvCanvasDrawRoundRect canvas neck (* r (float32 0.08)) + (* r (float32 0.08)) fill) + (tmvCanvasDrawRoundRect canvas head (* r (float32 0.14)) + (* r (float32 0.14)) fill) + (tmvCanvasDrawRoundRect canvas neck (* r (float32 0.08)) + (* r (float32 0.08)) whiteStrokePaint) + (tmvCanvasDrawRoundRect canvas head (* r (float32 0.14)) + (* r (float32 0.14)) whiteStrokePaint)))))) + + (def (drawRomulanSilhouette (canvas : Canvas) (r : Float32) + (fill : Paint)) : Unit + (modifiers private) + (let ((path (new Path))) + (begin + (tmvPathMoveTo path (* r (float32 1.18)) (float32 0.0)) + (tmvPathLineTo path (* r (float32 0.18)) (* r (float32 -0.30))) + (tmvPathLineTo path (* r (float32 -1.12)) (* r (float32 -0.88))) + (tmvPathLineTo path (* r (float32 -0.64)) (float32 0.0)) + (tmvPathLineTo path (* r (float32 -1.12)) (* r (float32 0.88))) + (tmvPathLineTo path (* r (float32 0.18)) (* r (float32 0.30))) + (tmvPathClose path) + (drawFilledPath canvas path fill) + (tmvCanvasDrawLine canvas (* r (float32 -0.64)) (float32 0.0) + (* r (float32 0.72)) (float32 0.0) detailPaint)))) + + (def (drawKzintiSilhouette (canvas : Canvas) (r : Float32) + (fill : Paint)) : Unit + (modifiers private) + (begin + (drawFourPointHull canvas r fill (float32 -0.45) (float32 -0.70) + (float32 -0.20) (float32 -0.12)) + (drawFourPointHull canvas r fill (float32 0.45) (float32 0.70) + (float32 0.20) (float32 0.12)) + (let ((center (new Path))) + (begin + (tmvPathMoveTo center (* r (float32 1.05)) (float32 0.0)) + (tmvPathLineTo center (* r (float32 -0.38)) (* r (float32 -0.22))) + (tmvPathLineTo center (* r (float32 -0.70)) (float32 0.0)) + (tmvPathLineTo center (* r (float32 -0.38)) (* r (float32 0.22))) + (tmvPathClose center) + (drawFilledPath canvas center fill))))) + (def (drawFourPointHull (canvas : Canvas) (r : Float32) (fill : Paint) + (frontY : Float32) (backY : Float32) + (innerBackY : Float32) (innerFrontY : Float32)) : Unit + (modifiers private) + (let ((path (new Path))) + (begin + (tmvPathMoveTo path (* r (float32 0.95)) (* r frontY)) + (tmvPathLineTo path (* r (float32 -0.96)) (* r backY)) + (tmvPathLineTo path (* r (float32 -0.60)) (* r innerBackY)) + (tmvPathLineTo path (* r (float32 0.76)) (* r innerFrontY)) + (tmvPathClose path) + (drawFilledPath canvas path fill)))) + + (def (drawAndromedanSilhouette (canvas : Canvas) (r : Float32) + (fill : Paint)) : Unit + (modifiers private) + (let ((outer (new RectF (* r (float32 -1.08)) (* r (float32 -0.50)) + (* r (float32 1.08)) (* r (float32 0.50)))) + (inner (new RectF (* r (float32 -0.34)) (* r (float32 -0.30)) + (* r (float32 0.34)) (* r (float32 0.30))))) + (begin + (tmvCanvasDrawOval canvas outer fill) + (tmvCanvasDrawOval canvas outer whiteStrokePaint) + (tmvCanvasDrawOval canvas inner detailPaint) + (tmvCanvasDrawCircle canvas (* r (float32 -0.70)) (float32 0.0) + (* r (float32 0.18)) detailPaint) + (tmvCanvasDrawCircle canvas (* r (float32 0.70)) (float32 0.0) + (* r (float32 0.18)) detailPaint)))) + + (def (drawTholianSilhouette (canvas : Canvas) (r : Float32) + (fill : Paint)) : Unit + (modifiers private) + (let ((path (new Path))) + (begin + (tmvPathMoveTo path (* r (float32 1.10)) (float32 0.0)) + (tmvPathLineTo path (float32 0.0) (* r (float32 -0.92))) + (tmvPathLineTo path (* r (float32 -1.02)) (float32 0.0)) + (tmvPathLineTo path (float32 0.0) (* r (float32 0.92))) + (tmvPathClose path) + (drawFilledPath canvas path fill) + (tmvCanvasDrawLine canvas (* r (float32 -0.62)) (float32 0.0) + (* r (float32 0.62)) (float32 0.0) detailPaint) + (tmvCanvasDrawLine canvas (float32 0.0) (* r (float32 -0.56)) + (float32 0.0) (* r (float32 0.56)) detailPaint)))) + + (def (drawGornSilhouette (canvas : Canvas) (r : Float32) + (fill : Paint)) : Unit + (modifiers private) + (let ((body (new RectF (* r (float32 -0.92)) (* r (float32 -0.46)) + (* r (float32 0.28)) (* r (float32 0.46)))) + (head (new Path))) + (begin + (tmvCanvasDrawRoundRect canvas body (* r (float32 0.13)) + (* r (float32 0.13)) fill) + (tmvCanvasDrawRoundRect canvas body (* r (float32 0.13)) + (* r (float32 0.13)) whiteStrokePaint) + (tmvPathMoveTo head (* r (float32 1.08)) (float32 0.0)) + (tmvPathLineTo head (* r (float32 0.20)) (* r (float32 -0.42))) + (tmvPathLineTo head (* r (float32 0.20)) (* r (float32 0.42))) + (tmvPathClose head) + (drawFilledPath canvas head fill) + (tmvCanvasDrawLine canvas (* r (float32 -0.72)) (float32 0.0) + (* r (float32 0.18)) (float32 0.0) detailPaint)))) + + (def (drawHydranSilhouette (canvas : Canvas) (r : Float32) + (fill : Paint)) : Unit + (modifiers private) + (let ((body (new RectF (* r (float32 -0.88)) (* r (float32 -0.18)) + (* r (float32 1.00)) (* r (float32 0.18)))) + (port (new RectF (* r (float32 -0.75)) (* r (float32 -0.76)) + (* r (float32 0.48)) (* r (float32 -0.34)))) + (starboard (new RectF (* r (float32 -0.75)) (* r (float32 0.34)) + (* r (float32 0.48)) (* r (float32 0.76))))) + (begin + (tmvCanvasDrawRoundRect canvas body (* r (float32 0.12)) + (* r (float32 0.12)) fill) + (tmvCanvasDrawRoundRect canvas body (* r (float32 0.12)) + (* r (float32 0.12)) whiteStrokePaint) + (tmvCanvasDrawOval canvas port fill) + (tmvCanvasDrawOval canvas starboard fill) + (tmvCanvasDrawOval canvas port whiteStrokePaint) + (tmvCanvasDrawOval canvas starboard whiteStrokePaint)))) + + (def (drawLyranSilhouette (canvas : Canvas) (r : Float32) + (fill : Paint)) : Unit + (modifiers private) + (begin + (drawFourPointHull canvas r fill (float32 -0.28) (float32 -0.68) + (float32 -0.18) (float32 -0.08)) + (drawFourPointHull canvas r fill (float32 0.28) (float32 0.68) + (float32 0.18) (float32 0.08)) + (tmvCanvasDrawLine canvas (* r (float32 -0.52)) (float32 0.0) + (* r (float32 0.78)) (float32 0.0) detailPaint))) + + (def (drawIscSilhouette (canvas : Canvas) (r : Float32) + (fill : Paint)) : Unit + (modifiers private) + (let ((body (new RectF (* r (float32 -0.82)) (* r (float32 -0.20)) + (* r (float32 1.00)) (* r (float32 0.20)))) + (port (new RectF (* r (float32 -0.74)) (* r (float32 -0.76)) + (* r (float32 0.38)) (* r (float32 -0.38)))) + (starboard (new RectF (* r (float32 -0.74)) (* r (float32 0.38)) + (* r (float32 0.38)) (* r (float32 0.76))))) + (begin + (tmvCanvasDrawOval canvas body fill) + (tmvCanvasDrawOval canvas body whiteStrokePaint) + (tmvCanvasDrawOval canvas port fill) + (tmvCanvasDrawOval canvas starboard fill) + (tmvCanvasDrawOval canvas port whiteStrokePaint) + (tmvCanvasDrawOval canvas starboard whiteStrokePaint) + (tmvCanvasDrawCircle canvas (* r (float32 0.78)) (float32 0.0) + (* r (float32 0.20)) detailPaint)))) + + (def (drawOrionSilhouette (canvas : Canvas) (r : Float32) + (fill : Paint)) : Unit + (modifiers private) + (let ((path (new Path))) + (begin + (tmvPathMoveTo path (* r (float32 1.12)) (float32 0.0)) + (tmvPathLineTo path (* r (float32 -0.95)) (* r (float32 -0.56))) + (tmvPathLineTo path (* r (float32 -0.52)) (float32 0.0)) + (tmvPathLineTo path (* r (float32 -0.95)) (* r (float32 0.56))) (tmvPathClose path) - (tmvCanvasDrawPath canvas path fill) - (tmvCanvasDrawPath canvas path whiteStrokePaint) - (if (or (tmvStringEquals race "klingon") - (tmvStringEquals race "kzinti")) + (drawFilledPath canvas path fill) + (tmvCanvasDrawLine canvas (* r (float32 -0.45)) (float32 0.0) + (* r (float32 0.76)) (float32 0.0) detailPaint)))) + + (def (drawGenericSilhouette (canvas : Canvas) (r : Float32) + (fill : Paint)) : Unit + (modifiers private) + (let ((path (new Path))) + (begin + (tmvPathMoveTo path (* r (float32 1.35)) (float32 0.0)) + (tmvPathLineTo path (* r (float32 -0.85)) (* r (float32 0.90))) + (tmvPathLineTo path (* r (float32 -0.45)) (float32 0.0)) + (tmvPathLineTo path (* r (float32 -0.85)) (* r (float32 -0.90))) + (tmvPathClose path) + (drawFilledPath canvas path fill)))) + + (def (shipRaceBadge (ship : (Nullable JSONObject))) : String + (modifiers private) + (let ((race (shipRaceKey ship))) + (if (tmvStringEquals race "andromedan") "AND" + (if (tmvStringEquals race "federation") "FED" + (if (tmvStringEquals race "klingon") "KLI" + (if (tmvStringEquals race "romulan") "ROM" + (if (tmvStringEquals race "kzinti") "KZN" + (if (tmvStringEquals race "tholian") "THO" + (if (tmvStringEquals race "gorn") "GOR" + (if (tmvStringEquals race "hydran") "HYD" + (if (tmvStringEquals race "lyran") "LYR" + (if (tmvStringEquals race "isc") "ISC" + (if (tmvStringEquals race "orion") "ORI" ""))))))))))))) + (def (drawRaceBadge (canvas : Canvas) (center : TacticalPoint) + (radius : Float32) + (ship : (Nullable JSONObject))) : Unit + (modifiers private)