Align typed tactics math and SSD status views
ober
d73fecfa1a8299c37bc2ed1be2764d2deb9e0b07
--- a/templates/original-tactics-parts/HexMath.ss +++ b/templates/original-tactics-parts/HexMath.ss @@ -9,14 +9,18 @@ make-ProjectedHelmMove ProjectedHelmMove? make-ProjectedRangePoint ProjectedRangePoint? hexRangeFromPositions hexRange currentBattleRange + bearingToHex relativeBearingToTarget movementImpulsesForSpeed nextMoveImpulse maneuverMapFromJson projectedHelmMoves projectedHelmPoseAt - projectedRangeForecast maneuverAbbreviation) + projectedRangeForecast maneuverAbbreviation + scheduledProjectedHelmManeuver applyProjectedHelmMove + canProjectedTurn canProjectedSideslip) (type Any) (type Int32) (type JSONArray) (type JSONObject) (record ProjectedHelmPose ((q : Int32) (r : Int32) (facing : Int32) (speed : Int32) - (turnMode : String) (distanceSinceTurn : Int32))) + (turnMode : String) (distanceSinceTurn : Int32) + (sideslipAvailable : Bool))) (record ProjectedHelmMove ((impulse : Int32) @@ -139,6 +143,47 @@ "range") "-") (int32->string (nullable-get computed)))))) + (def (bearingToHex + (q1 : Int32) + (r1 : Int32) + (q2 : Int32) + (r2 : Int32)) + : + Int32 + (if (and (= q1 q2) (= r1 r2)) + (int32 0) + (var ((bestFacing (int32 0)) + (bestRange (int32 2147483647))) + (begin + (for/fold + ((ignored (int32 0))) + ((facing (in-range (int32 0) (int32 6)))) + (let ([range + (hexRange + (+ q1 (directionDeltaQ facing)) + (+ r1 (directionDeltaR facing)) + q2 + r2)]) + (begin + (if (< range bestRange) + (begin + (set! bestRange range) + (set! bestFacing facing)) + (begin)) + ignored))) + bestFacing)))) + (def (relativeBearingToTarget + (position : ProjectedHelmPose) + (target : ProjectedHelmPose)) + : + Int32 + (normalizedHelmFacing + (- (bearingToHex + (ProjectedHelmPose-q position) + (ProjectedHelmPose-r position) + (ProjectedHelmPose-q target) + (ProjectedHelmPose-r target)) + (ProjectedHelmPose-facing position)))) (def (movementImpulsesForSpeed (speed : Int32)) : (MutableList Int32) @@ -300,7 +345,11 @@ (json-object-opt-int32-default position "distance-since-turn" - (int32 0)))) + (int32 0)) + (json-object-opt-bool-default + position + "sideslip-available?" + #t))) (def (projectedHelmMoves (position : (Nullable JSONObject)) (maneuvers : (Map Int32 String)) @@ -332,9 +381,12 @@ (if (and (> impulse currentImpulse) (< (list-size out) (atLeastOne maxMoves))) - (let ([maneuver (map-ref-or-null - maneuvers - impulse)]) + (let ([maneuver + (scheduledProjectedHelmManeuver + pose + (map-ref-or-null + maneuvers + impulse))]) (begin (set! pose (applyProjectedHelmMove @@ -412,20 +464,32 @@ betaManeuversRaw) currentImpulse maxMoves)]) - (var ((previousRange (nullable-none Int32))) + (let ([impulses (mutable-list-empty Int32)]) + (begin + (for/fold + ((ignored (int32 0))) + ((impulse (in-range (int32 1) (int32 33)))) + (begin + (if (and (< (list-size impulses) + (atLeastOne labelLimit)) + (or (hasProjectedImpulse? + alphaProjected + impulse) + (hasProjectedImpulse? + betaProjected + impulse))) + (mutable-list-add! impulses impulse) + (begin)) + ignored)) + (var ((previousRange (nullable-none Int32))) (begin (for/fold ((ignored (int32 0))) - ((impulse - (in-range (int32 1) (int32 33)))) - (if (and (< (list-size out) - (atLeastOne labelLimit)) - (or (hasProjectedImpulse? - alphaProjected - impulse) - (hasProjectedImpulse? - betaProjected - impulse))) + ((index + (in-range + (int32 0) + (list-size impulses)))) + (let ([impulse (list-ref impulses index)]) (let ([alphaPose (projectedHelmPoseAt alphaPosition alphaProjected @@ -450,14 +514,17 @@ (ProjectedHelmPose-r (nullable-get betaPose)))]) - (let ([important (or (<= range + (let ([important (or (<= range (int32 2)) (or (nullable-null? previousRange) - (not (= range - (nullable-get - previousRange)))))]) + (or (not (= range + (nullable-get + previousRange))) + (= index + (- (list-size impulses) + (int32 1))))))]) (begin (set! previousRange (nullable-some range)) @@ -468,9 +535,8 @@ impulse range)) (begin)) - ignored))))) - ignored)) - out)))))) + ignored))))))) + out)))))))) (def (maneuverAbbreviation (maneuver : String)) : String @@ -488,6 +554,27 @@ (string-take maneuver (int32 3))))))))) + (def (scheduledProjectedHelmManeuver + (pose : ProjectedHelmPose) + (maneuver : (Nullable String))) + : + (Nullable String) + (if (nullable-null? maneuver) + (nullable-none String) + (let ([name (nullable-get maneuver)]) + (if (or (equal? name "left") + (equal? name "right")) + (if (canProjectedTurn pose) + maneuver + (nullable-none String)) + (if (or (equal? name "sideslip-left") + (equal? name "sideslip-right")) + (if (canProjectedSideslip pose) + maneuver + (nullable-none String)) + (if (equal? name "het") + maneuver + (nullable-none String))))))) (def (applyProjectedHelmMove (pose : ProjectedHelmPose) (maneuver : (Nullable String))) @@ -497,7 +584,7 @@ (moveForward pose) (let ([name (nullable-get maneuver)]) (if (equal? name "left") - (if (canProjectedTurn? pose) + (if (canProjectedTurn pose) (moveForward (make-ProjectedHelmPose (ProjectedHelmPose-q pose) (ProjectedHelmPose-r pose) @@ -506,10 +593,11 @@ (int32 1))) (ProjectedHelmPose-speed pose) (ProjectedHelmPose-turnMode pose) - (int32 0))) - pose) + (int32 0) + (ProjectedHelmPose-sideslipAvailable pose))) + (moveForward pose)) (if (equal? name "right") - (if (canProjectedTurn? pose) + (if (canProjectedTurn pose) (moveForward (make-ProjectedHelmPose (ProjectedHelmPose-q pose) (ProjectedHelmPose-r pose) @@ -518,21 +606,44 @@ (int32 1))) (ProjectedHelmPose-speed pose) (ProjectedHelmPose-turnMode pose) - (int32 0))) - pose) + (int32 0) + (ProjectedHelmPose-sideslipAvailable pose))) + (moveForward pose)) (if (equal? name "sideslip-left") - (moveInDirection - pose - (normalizedHelmFacing - (- (ProjectedHelmPose-facing pose) - (int32 1)))) + (if (canProjectedSideslip pose) + (let ([moved + (moveInDirection + pose + (normalizedHelmFacing + (- (ProjectedHelmPose-facing pose) + (int32 1))))]) + (make-ProjectedHelmPose + (ProjectedHelmPose-q moved) + (ProjectedHelmPose-r moved) + (ProjectedHelmPose-facing moved) + (ProjectedHelmPose-speed moved) + (ProjectedHelmPose-turnMode moved) + (ProjectedHelmPose-distanceSinceTurn moved) + #f)) + pose) (if (equal? name "sideslip-right") - (moveInDirection - pose - (normalizedHelmFacing - (+ (ProjectedHelmPose-facing - pose) - (int32 1)))) + (if (canProjectedSideslip pose) + (let ([moved + (moveInDirection + pose + (normalizedHelmFacing + (+ (ProjectedHelmPose-facing + pose) + (int32 1))))]) + (make-ProjectedHelmPose + (ProjectedHelmPose-q moved) + (ProjectedHelmPose-r moved) + (ProjectedHelmPose-facing moved) + (ProjectedHelmPose-speed moved) + (ProjectedHelmPose-turnMode moved) + (ProjectedHelmPose-distanceSinceTurn moved) + #f)) + pose) (if (equal? name "het") (moveForward (make-ProjectedHelmPose (ProjectedHelmPose-q pose) @@ -545,12 +656,22 @@ pose) (ProjectedHelmPose-turnMode pose) - (int32 0))) + (int32 0) + (ProjectedHelmPose-sideslipAvailable pose))) (moveForward pose))))))))) (def (moveForward (pose : ProjectedHelmPose)) : ProjectedHelmPose - (moveInDirection pose (ProjectedHelmPose-facing pose))) + (let ([moved + (moveInDirection pose (ProjectedHelmPose-facing pose))]) + (make-ProjectedHelmPose + (ProjectedHelmPose-q moved) + (ProjectedHelmPose-r moved) + (ProjectedHelmPose-facing moved) + (ProjectedHelmPose-speed moved) + (ProjectedHelmPose-turnMode moved) + (ProjectedHelmPose-distanceSinceTurn moved) + #t))) (def (directionDeltaQ (direction : Int32)) : Int32 @@ -583,14 +704,23 @@ (ProjectedHelmPose-speed pose) (ProjectedHelmPose-turnMode pose) (+ (ProjectedHelmPose-distanceSinceTurn pose) - (int32 1)))) - (def (canProjectedTurn? (pose : ProjectedHelmPose)) + (int32 1)) + (ProjectedHelmPose-sideslipAvailable pose))) + (def (canProjectedTurn (pose : ProjectedHelmPose)) : Bool (>= (ProjectedHelmPose-distanceSinceTurn pose) (turnModeRequiredDistance (ProjectedHelmPose-turnMode pose) (ProjectedHelmPose-speed pose)))) + (def (canProjectedTurn? (pose : ProjectedHelmPose)) + : + Bool + (canProjectedTurn pose)) + (def (canProjectedSideslip (pose : ProjectedHelmPose)) + : + Bool + (ProjectedHelmPose-sideslipAvailable pose)) (def (turnModeRequiredDistance (turnMode : String) (speed : Int32)) @@ -765,4 +895,3 @@ : Int32 (mod (+ (mod facing (int32 6)) (int32 6)) (int32 6))))))) - --- a/templates/original-tactics-parts/ShipStatusView.ss +++ b/templates/original-tactics-parts/ShipStatusView.ss @@ -703,11 +703,10 @@ (fallback : Float32)) : Float32 (if (nullable-null? obj) fallback - (float32 - (jsonOptInt - (nullable-get obj) - key - (statusFloatToInt fallback))))) + (json-object-opt-float32-default + (nullable-get obj) + key + fallback))) (def (counterValueForShip (ship : (Nullable JSONObject)) (field : String) --- a/templates/original-tactics-parts/SsdDamageView.kt.ss +++ b/templates/original-tactics-parts/SsdDamageView.kt.ss @@ -642,33 +642,61 @@ (json-object-opt-any (nullable-get ship) "boxes"))) (destroyedRaw (if (nullable-null? ship) (nullable-none Any) - (json-object-opt-any (nullable-get ship) "destroyed-boxes")))) - (let ((paPanels (counterValue boxes "52")) - (fromMap (sdvMapValue destroyed "52")) + (json-object-opt-any (nullable-get ship) "destroyed-boxes"))) + (paBoxesField + (numberValue + (if (nullable-null? ship) (nullable-none Any) + (json-object-opt-any + (nullable-get ship) "pa-panel-boxes")))) + (paMaxField + (numberValue + (if (nullable-null? ship) (nullable-none Any) + (json-object-opt-any + (nullable-get ship) "pa-panel-max")))) + (rawCharge + (numberValue + (if (nullable-null? ship) (nullable-none Any) + (json-object-opt-any + (nullable-get ship) "pa-panel-charge"))))) + (let ((paBoxes + (if (> paBoxesField (int32 0)) paBoxesField + (counterValue boxes "52"))) + (paDestroyed + (if (map-contains-key? destroyed "52") + (sdvMapValue destroyed "52") + (counterValue destroyedRaw "52"))) (degradation - (+ (counterValue boxes "99") (sdvMapValue destroyed "99")))) - (let ((paDestroyed - (if (> fromMap (int32 0)) fromMap - (counterValue destroyedRaw "52")))) - (let ((paMax (sdvMaxInt (int32 1) (+ paPanels paDestroyed)))) - (let ((ratio - (sdvClampFloat (/ (float32 paPanels) (float32 paMax)) + (+ (counterValue boxes "99") + (if (map-contains-key? destroyed "99") + (sdvMapValue destroyed "99") + (int32 0))))) + (let ((paMax + (sdvMaxInt (int32 1) + (if (> paMaxField (int32 0)) paMaxField + (+ paBoxes paDestroyed))))) + (let ((paCharge (sdvClampInt rawCharge (int32 0) paMax))) + (let ((paPanels (sdvMaxInt (int32 0) (- paBoxes paCharge))) + (ratio + (sdvClampFloat (/ (float32 paCharge) (float32 paMax)) (float32 0.0) (float32 1.0)))) (begin (sdvPaintAlignSet smallPaint (sdvLeft)) (sdvPaintColorSet smallPaint (sdvRgb (int32 190) (int32 205) (int32 224))) (sdvDrawText canvas - (string-append "PA PANELS " - (string-append (int32->string paPanels) + (string-append "PA CHARGE " + (string-append (int32->string paCharge) (string-append "/" (int32->string paMax)))) (+ (sdvRectLeft area) (float32 6.0)) (+ (sdvRectTop area) (float32 17.0)) smallPaint) (sdvPaintAlignSet smallPaint (sdvRight)) (sdvDrawText canvas (if (> degradation (int32 0)) - (string-append "DEG " (int32->string degradation)) - "NO SHIELDS") + (string-append "AV " + (string-append (int32->string paPanels) + (string-append " DEG " + (int32->string degradation)))) + (string-append "AV " (int32->string paPanels))) (- (sdvRectRight area) (float32 6.0)) (+ (sdvRectTop area) (float32 17.0)) smallPaint) (let ((bar @@ -694,7 +722,7 @@ (let ((note (if (and (<= paMax (int32 1)) (= paPanels (int32 0))) "No shield/PA values in this template" - "Absorbs damage before internals"))) + "Available PA; charged panels absorb damage"))) (sdvDrawText canvas (fitText note smallPaint (- (sdvRectWidth area) (float32 12.0)))