Add typed SSD damage panel
ober
102c5475f1c02afe452908901aa672e1d8e5f2f2
new file mode 100644 --- /dev/null +++ b/templates/original-tactics-parts/SsdDamageView.kt.ss @@ -0,0 +1,1762 @@ +(import (jerboa prelude)) + +(def fragment + '((typed-kotlin-file "com/jerboa/originaltactics/SsdDamageView.kt" + (kotlin-imports + (android content Context) + (android graphics Canvas) + (android graphics Color) + (android graphics Paint) + (android graphics Paint Align) + (android graphics Paint Style) + (android graphics RectF) + (android view View) + (org json JSONArray) + (org json JSONObject)) + (typed-library (com jerboa originaltactics) + (export SsdDamageView) + (type Any) (type Number) (type Context) (type Canvas) (type Paint) + (type Align) (type Style) (type RectF) (type View) + (type Resources) (type DisplayMetrics) (type JSONArray) (type JSONObject) + (type Int32) (type Float32) + + (extern (sdvPaintFlag) : Int32 (kotlin-value Paint ANTI_ALIAS_FLAG)) + (extern (sdvFill) : Style (kotlin-value Paint Style FILL)) + (extern (sdvStroke) : Style (kotlin-value Paint Style STROKE)) + (extern (sdvLeft) : Align (kotlin-value Paint Align LEFT)) + (extern (sdvCenter) : Align (kotlin-value Paint Align CENTER)) + (extern (sdvRight) : Align (kotlin-value Paint Align RIGHT)) + (extern (sdvWhite) : Int32 (kotlin-value Color WHITE)) + (extern (sdvRgb (r : Int32) (g : Int32) (b : Int32)) : Int32 + (kotlin-call Color rgb)) + (extern (sdvColorRed (color : Int32)) : Int32 (kotlin-call Color red)) + (extern (sdvColorGreen (color : Int32)) : Int32 (kotlin-call Color green)) + (extern (sdvColorBlue (color : Int32)) : Int32 (kotlin-call Color blue)) + (extern (sdvPaintColorSet (paint : Paint) (value : Int32)) : Unit + (kotlin-member-set color)) + (extern (sdvPaintStyleSet (paint : Paint) (value : Style)) : Unit + (kotlin-member-set style)) + (extern (sdvPaintStrokeSet (paint : Paint) (value : Float32)) : Unit + (kotlin-member-set strokeWidth)) + (extern (sdvPaintSizeSet (paint : Paint) (value : Float32)) : Unit + (kotlin-member-set textSize)) + (extern (sdvPaintBoldSet (paint : Paint) (value : Bool)) : Unit + (kotlin-member-set isFakeBoldText)) + (extern (sdvPaintAlignSet (paint : Paint) (value : Align)) : Unit + (kotlin-member-set textAlign)) + (extern (sdvPaintMeasure (paint : Paint) (text : String)) : Float32 + (kotlin-member-call measureText)) + (extern (sdvInvalidate (view : SsdDamageView)) : Unit + (kotlin-member-call invalidate)) + (extern (sdvSuperDraw (canvas : Canvas)) : Unit (kotlin-call super onDraw)) + (extern (sdvSave (canvas : Canvas)) : Int32 (kotlin-member-call save)) + (extern (sdvScale (canvas : Canvas) (x : Float32) (y : Float32)) : Unit + (kotlin-member-call scale)) + (extern (sdvRestore (canvas : Canvas) (state : Int32)) : Unit + (kotlin-member-call restoreToCount)) + (extern (sdvWidth (view : SsdDamageView)) : Int32 (kotlin-member-get width)) + (extern (sdvHeight (view : SsdDamageView)) : Int32 (kotlin-member-get height)) + (extern (sdvResources (view : SsdDamageView)) : Resources + (kotlin-member-get resources)) + (extern (sdvMetrics (resources : Resources)) : DisplayMetrics + (kotlin-member-get displayMetrics)) + (extern (sdvDensityValue (metrics : DisplayMetrics)) : Float32 + (kotlin-member-get density)) + (extern (sdvDrawRoundRect (canvas : Canvas) (rect : RectF) + (rx : Float32) (ry : Float32) + (paint : Paint)) : Unit + (kotlin-member-call drawRoundRect)) + (extern (sdvDrawText (canvas : Canvas) (text : String) + (x : Float32) (y : Float32) (paint : Paint)) : Unit + (kotlin-member-call drawText)) + (extern (sdvDrawCircle (canvas : Canvas) (x : Float32) (y : Float32) + (radius : Float32) (paint : Paint)) : Unit + (kotlin-member-call drawCircle)) + (extern (sdvDrawArc (canvas : Canvas) (bounds : RectF) + (start : Float32) (sweep : Float32) + (useCenter : Bool) (paint : Paint)) : Unit + (kotlin-member-call drawArc)) + (extern (sdvRectLeft (rect : RectF)) : Float32 (kotlin-member-get left)) + (extern (sdvRectTop (rect : RectF)) : Float32 (kotlin-member-get top)) + (extern (sdvRectRight (rect : RectF)) : Float32 (kotlin-member-get right)) + (extern (sdvRectBottom (rect : RectF)) : Float32 (kotlin-member-get bottom)) + (extern (sdvRectWidth (rect : RectF)) : Float32 (kotlin-member-call width)) + (extern (sdvRectHeight (rect : RectF)) : Float32 (kotlin-member-call height)) + (extern (sdvRectCenterX (rect : RectF)) : Float32 (kotlin-member-call centerX)) + (extern (sdvRectCenterY (rect : RectF)) : Float32 (kotlin-member-call centerY)) + (extern (sdvAsObject (value : Any)) : (Nullable JSONObject) + (kotlin-safe-cast JSONObject)) + (extern (sdvAsArray (value : Any)) : (Nullable JSONArray) + (kotlin-safe-cast JSONArray)) + (extern (sdvAsNumber (value : Any)) : (Nullable Number) + (kotlin-safe-cast Number)) + (extern (sdvAsString (value : Any)) : (Nullable String) + (kotlin-safe-cast String)) + (extern (sdvNumberToInt (value : Number)) : Int32 + (kotlin-member-call toInt)) + (extern (sdvAnyToString (value : Any)) : String + (kotlin-member-call toString)) + (extern (sdvJsonKeys (object : JSONObject)) : (Iterator String) + (kotlin-member-call keys)) + (extern (sdvIteratorHasNext (iterator : (Iterator String))) : Bool + (kotlin-member-call hasNext)) + (extern (sdvIteratorNext (iterator : (Iterator String))) : String + (kotlin-member-call next)) + (extern (sdvStringSetToList (items : (Set String))) : (List String) + (kotlin-member-call toList)) + (extern (sdvMapKeys (items : (Map String Int32))) : (Set String) + (kotlin-member-get keys)) + (extern (sdvStringMapKeys (items : (Map String String))) : (Set String) + (kotlin-member-get keys)) + (extern (sdvIntSetSize (items : (Set Int32))) : Int32 + (kotlin-member-get size)) + (extern (sdvStringSetSize (items : (Set String))) : Int32 + (kotlin-member-get size)) + (extern (sdvStringAsAny (value : String)) : Any + (kotlin-cast Any)) + (extern (sdvMutableStringListAddAt (items : (MutableList String)) + (index : Int32) (value : String)) : Unit + (kotlin-member-call add)) + (extern (sdvMutableObjectListAddAt (items : (MutableList JSONObject)) + (index : Int32) (value : JSONObject)) : Unit + (kotlin-member-call add)) + (extern (sdvJoinStrings (items : (List String)) + (separator : String)) : String + (kotlin-member-call joinToString)) + (extern (sdvStringReplace (text : String) (old : String) + (replacement : String)) : String + (kotlin-member-call replace)) + (extern (sdvStringDropLast (text : String) (count : Int32)) : String + (kotlin-member-call dropLast)) + (extern (sdvShipTechnicalLabel (ship : (Nullable JSONObject)) + (fallback : String)) : String + (kotlin-call shipTechnicalLabel)) + (extern (sdvShipDisplayLabel (ship : (Nullable JSONObject))) : String + (kotlin-call shipDisplayLabel)) + + (def (sdvPaint (color : Int32) (style : Style) + (stroke : Float32 (default (float32 0.0)))) : Paint + (let ((paint (new Paint (sdvPaintFlag)))) + (begin + (sdvPaintColorSet paint color) + (sdvPaintStyleSet paint style) + (if (> stroke (float32 0.0)) + (sdvPaintStrokeSet paint stroke) + (begin)) + paint))) + (def (sdvTextPaint (color : Int32) (size : Float32) + (bold : Bool)) : Paint + (let ((paint (new Paint (sdvPaintFlag)))) + (begin + (sdvPaintColorSet paint color) + (sdvPaintSizeSet paint size) + (sdvPaintBoldSet paint bold) + paint))) + (def (sdvDensity (view : SsdDamageView)) : Float32 + (let ((value (sdvDensityValue (sdvMetrics (sdvResources view))))) + (if (< value (float32 1.0)) (float32 1.0) value))) + (def (sdvMaxInt (a : Int32) (b : Int32)) : Int32 (if (> a b) a b)) + (def (sdvMinInt (a : Int32) (b : Int32)) : Int32 (if (< a b) a b)) + (def (sdvMaxFloat (a : Float32) (b : Float32)) : Float32 + (if (> a b) a b)) + (def (sdvMinFloat (a : Float32) (b : Float32)) : Float32 + (if (< a b) a b)) + (def (sdvClampInt (value : Int32) (low : Int32) (high : Int32)) : Int32 + (if (< value low) low (if (> value high) high value))) + (def (sdvClampFloat (value : Float32) (low : Float32) + (high : Float32)) : Float32 + (if (< value low) low (if (> value high) high value))) + (def (sdvMapValue (values : (Map String Int32)) (key : String)) : Int32 + (let ((value (map-ref-or-null values key))) + (if (nullable-null? value) (int32 0) (nullable-get value)))) + (def (sdvMapTotal (values : (Map String Int32))) : Int32 + (let ((keys (sdvStringSetToList (sdvMapKeys values)))) + (for/fold ((total (int32 0))) + ((index (in-range (int32 0) (list-size keys)))) + (+ total (sdvMapValue values (list-ref keys index)))))) + (def (sdvIntMapValue (values : (Map Int32 Int32)) + (key : Int32)) : Int32 + (let ((value (map-ref-or-null values key))) + (if (nullable-null? value) (int32 0) (nullable-get value)))) + (def (sdvIntMapTotal (values : (Map Int32 Int32))) : Int32 + (for/fold ((total (int32 0))) + ((shield (in-range (int32 1) (int32 7)))) + (+ total (sdvIntMapValue values shield)))) + + (class SsdDamageView ((context : Context)) + (extends View context) + (var game : (Nullable JSONObject) (nullable-none JSONObject) + (modifiers private)) + (var alphaTruth : (Nullable JSONObject) (nullable-none JSONObject) + (modifiers private)) + (var betaTruth : (Nullable JSONObject) (nullable-none JSONObject) + (modifiers private)) + (var drawWidth : Float32 (float32 0.0) (modifiers private)) + (var drawHeight : Float32 (float32 0.0) (modifiers private)) + (val backgroundPaint : Paint + (sdvPaint (sdvRgb (int32 12) (int32 17) (int32 25)) (sdvFill) (float32 0.0)) + (modifiers private)) + (val panelPaint : Paint + (sdvPaint (sdvRgb (int32 24) (int32 32) (int32 44)) (sdvFill) (float32 0.0)) + (modifiers private)) + (val borderPaint : Paint + (sdvPaint (sdvRgb (int32 75) (int32 90) (int32 116)) + (sdvStroke) (float32 2.0)) + (modifiers private)) + (val headerPaint : Paint + (sdvPaint (sdvRgb (int32 45) (int32 61) (int32 83)) (sdvFill) (float32 0.0)) + (modifiers private)) + (val boxPaint : Paint + (sdvPaint (sdvRgb (int32 85) (int32 103) (int32 130)) (sdvFill) (float32 0.0)) + (modifiers private)) + (val lostPaint : Paint + (sdvPaint (sdvRgb (int32 211) (int32 81) (int32 68)) (sdvFill) (float32 0.0)) + (modifiers private)) + (val outlinePaint : Paint + (sdvPaint (sdvRgb (int32 169) (int32 184) (int32 207)) + (sdvStroke) (float32 1.6)) + (modifiers private)) + (val recentHitPaint : Paint + (sdvPaint (sdvRgb (int32 246) (int32 190) (int32 72)) + (sdvStroke) (float32 3.4)) + (modifiers private)) + (val bandPaint : Paint + (sdvPaint (sdvRgb (int32 18) (int32 25) (int32 36)) (sdvFill) (float32 0.0)) + (modifiers private)) + (val shieldTrackPaint : Paint + (sdvPaint (sdvRgb (int32 43) (int32 54) (int32 70)) (sdvFill) (float32 0.0)) + (modifiers private)) + (val shieldValuePaint : Paint + (sdvPaint (sdvRgb (int32 91) (int32 171) (int32 209)) (sdvFill) (float32 0.0)) + (modifiers private)) + (val arcInactivePaint : Paint + (sdvPaint (sdvRgb (int32 38) (int32 49) (int32 65)) (sdvFill) (float32 0.0)) + (modifiers private)) + (val arcActivePaint : Paint + (sdvPaint (sdvRgb (int32 102) (int32 190) (int32 220)) (sdvFill) (float32 0.0)) + (modifiers private)) + (val arcStrokePaint : Paint + (sdvPaint (sdvRgb (int32 154) (int32 171) (int32 193)) + (sdvStroke) (float32 1.0)) + (modifiers private)) + (val titlePaint : Paint + (sdvTextPaint (sdvWhite) (float32 24.0) #t) (modifiers private)) + (val labelPaint : Paint + (sdvTextPaint (sdvRgb (int32 230) (int32 237) (int32 247)) + (float32 17.0) #t) + (modifiers private)) + (val smallPaint : Paint + (sdvTextPaint (sdvRgb (int32 161) (int32 177) (int32 199)) + (float32 15.0) #f) + (modifiers private)) + + (def (setData (nextGame : (Nullable JSONObject)) + (alpha : (Nullable JSONObject)) + (beta : (Nullable JSONObject))) : Unit + (begin + (set! game nextGame) + (set! alphaTruth alpha) + (set! betaTruth beta) + (sdvInvalidate this))) + (def (onDraw (canvas : Canvas)) : Unit + (modifiers override) + (begin + (sdvSuperDraw canvas) + (let ((state (sdvSave canvas)) (scale (sdvDensity this))) + (begin + (set! drawWidth (/ (float32 (sdvWidth this)) scale)) + (set! drawHeight (/ (float32 (sdvHeight this)) scale)) + (sdvScale canvas scale scale) + (try-finally (drawContent canvas) (sdvRestore canvas state)))))) + (def (drawContent (canvas : Canvas)) : Unit + (modifiers private) + (begin + (sdvDrawRoundRect canvas + (new RectF (float32 0.0) (float32 0.0) drawWidth drawHeight) + (float32 10.0) (float32 10.0) backgroundPaint) + (let ((battle + (if (nullable-null? game) + (nullable-none JSONObject) + (json-object-opt-json-object + (nullable-get game) "battle-state")))) + (if (nullable-null? battle) + (begin + (sdvPaintAlignSet titlePaint (sdvCenter)) + (sdvDrawText canvas "SSD Damage" + (/ drawWidth (float32 2.0)) + (+ (/ drawHeight (float32 2.0)) (float32 7.0)) titlePaint)) + (let ((gap (float32 10.0)) + (top (float32 10.0)) + (cardWidth (/ (- drawWidth (float32 30.0)) (float32 2.0)))) + (begin + (drawShipSsd canvas + (new RectF gap top (+ gap cardWidth) (- drawHeight gap)) + "ALPHA" "alpha" + (json-object-opt-json-object (nullable-get battle) "alpha") + alphaTruth) + (drawShipSsd canvas + (new RectF (+ (float32 20.0) cardWidth) top + (+ (float32 20.0) (* cardWidth (float32 2.0))) + (- drawHeight gap)) + "BETA" "beta" + (json-object-opt-json-object (nullable-get battle) "beta") + betaTruth))))))) + + (def (drawShipSsd (canvas : Canvas) (rect : RectF) (side : String) + (actor : String) (ship : (Nullable JSONObject)) + (truth : (Nullable JSONObject))) : Unit + (modifiers private) + (begin + (sdvDrawRoundRect canvas rect (float32 8.0) (float32 8.0) panelPaint) + (sdvDrawRoundRect canvas rect (float32 8.0) (float32 8.0) borderPaint) + (sdvDrawRoundRect canvas + (new RectF (sdvRectLeft rect) (sdvRectTop rect) + (sdvRectRight rect) (+ (sdvRectTop rect) (float32 27.0))) + (float32 8.0) (float32 8.0) headerPaint) + (sdvPaintAlignSet labelPaint (sdvLeft)) + (sdvPaintColorSet labelPaint (sdvWhite)) + (sdvDrawText canvas side (+ (sdvRectLeft rect) (float32 8.0)) + (+ (sdvRectTop rect) (float32 19.0)) labelPaint) + (sdvPaintAlignSet smallPaint (sdvRight)) + (sdvDrawText canvas + (fitText (sdvShipTechnicalLabel ship "-") smallPaint + (* (sdvRectWidth rect) (float32 0.46))) + (- (sdvRectRight rect) (float32 8.0)) + (+ (sdvRectTop rect) (float32 19.0)) smallPaint) + (sdvPaintAlignSet smallPaint (sdvLeft)) + (sdvPaintColorSet smallPaint (sdvRgb (int32 187) (int32 202) (int32 223))) + (sdvDrawText canvas + (fitText (sdvShipDisplayLabel ship) smallPaint + (- (sdvRectWidth rect) (float32 16.0))) + (+ (sdvRectLeft rect) (float32 8.0)) + (+ (sdvRectTop rect) (float32 47.0)) smallPaint) + (let ((destroyed + (counterMap + (if (nullable-null? ship) + (nullable-none Any) + (json-object-opt-any (nullable-get ship) "destroyed-boxes")))) + (recentHits (recentDamageTypes actor))) + (let ((destroyedTotal (sdvMapTotal destroyed)) + (remaining + (if (nullable-null? ship) (int32 0) + (json-object-opt-int32-default + (nullable-get ship) "remaining-internals" (int32 0))))) + (begin + (sdvPaintColorSet smallPaint + (if (> destroyedTotal (int32 0)) + (sdvRgb (int32 235) (int32 169) (int32 132)) + (sdvRgb (int32 161) (int32 177) (int32 199)))) + (sdvDrawText canvas + (string-append "Internal damage " + (string-append (int32->string destroyedTotal) + (string-append " Hull " (int32->string remaining)))) + (+ (sdvRectLeft rect) (float32 8.0)) + (+ (sdvRectTop rect) (float32 64.0)) smallPaint) + (sdvPaintColorSet smallPaint + (sdvRgb (int32 161) (int32 177) (int32 199))) + (let ((defenseArea + (new RectF (+ (sdvRectLeft rect) (float32 8.0)) + (+ (sdvRectTop rect) (float32 73.0)) + (- (sdvRectRight rect) (float32 8.0)) + (+ (sdvRectTop rect) (float32 146.0)))) + (weaponHeight + (if (> (sdvRectHeight rect) (float32 360.0)) + (float32 88.0) (float32 70.0)))) + (begin + (drawDefenseBand canvas defenseArea ship destroyed) + (let ((groups + (if (nullable-null? truth) + (nullable-none JSONArray) + (json-object-opt-json-array + (nullable-get truth) "groups")))) + (if (and (not (nullable-null? groups)) + (> (json-array-length (nullable-get groups)) (int32 0))) + (begin + (drawTruthGroups canvas + (new RectF (+ (sdvRectLeft rect) (float32 8.0)) + (+ (sdvRectBottom defenseArea) (float32 7.0)) + (- (sdvRectRight rect) (float32 8.0)) + (- (sdvRectBottom rect) (+ weaponHeight (float32 30.0)))) + (nullable-get groups) destroyed recentHits) + (drawLegend canvas rect destroyed + (groupLabelMap (nullable-get groups)) recentHits)) + (drawFallbackDamage canvas + (new RectF (+ (sdvRectLeft rect) (float32 8.0)) + (+ (sdvRectBottom defenseArea) (float32 9.0)) + (- (sdvRectRight rect) (float32 8.0)) + (- (sdvRectBottom rect) (+ weaponHeight (float32 8.0)))) + destroyed recentHits))) + (drawWeaponStrip canvas + (new RectF (+ (sdvRectLeft rect) (float32 8.0)) + (- (sdvRectBottom rect) (+ weaponHeight (float32 8.0))) + (- (sdvRectRight rect) (float32 8.0)) + (- (sdvRectBottom rect) (float32 8.0))) ship)))))))) + + (def (drawTruthGroups (canvas : Canvas) (area : RectF) + (groups : JSONArray) + (destroyed : (Map String Int32)) + (recentHits : (Set String))) : Unit + (modifiers private) + (if (or (<= (sdvRectWidth area) (float32 12.0)) + (<= (sdvRectHeight area) (float32 12.0))) + (begin) + (let ((bounds (truthBounds groups))) + (if (nullable-null? bounds) + (begin) + (let ((safeBounds (nullable-get bounds))) + (let ((scale + (sdvMinFloat + (/ (sdvRectWidth area) (sdvRectWidth safeBounds)) + (/ (sdvRectHeight area) (sdvRectHeight safeBounds))))) + (let ((projectedWidth (* (sdvRectWidth safeBounds) scale)) + (projectedHeight (* (sdvRectHeight safeBounds) scale)) + (remainingDestroyed (copyCounterMap destroyed))) + (let ((left (+ (sdvRectLeft area) + (/ (- (sdvRectWidth area) projectedWidth) + (float32 2.0)))) + (top (+ (sdvRectTop area) + (/ (- (sdvRectHeight area) projectedHeight) + (float32 2.0))))) + (begin + (for/fold ((ignored (int32 0))) + ((index (in-range (int32 0) + (json-array-length groups)))) + (let ((group (json-array-opt-json-object groups index))) + (if (nullable-null? group) + ignored + (let ((bbox + (json-object-opt-json-array + (nullable-get group) "bbox")) + (type + (typeKey + (json-object-opt-any + (nullable-get group) "box-type-id")))) + (if (or (nullable-null? bbox) (nullable-null? type)) + ignored + (let ((count + (sdvMaxInt (int32 1) + (json-object-opt-int32-default + (nullable-get group) "count" + (json-object-opt-int32-default + (nullable-get group) "cell-count" + (int32 0))))) + (key (nullable-get type))) + (let ((groupRect + (new RectF + (+ left (* (- (json-array-opt-float32 + (nullable-get bbox) (int32 0) + (float32 0.0)) + (sdvRectLeft safeBounds)) scale)) + (+ top (* (- (json-array-opt-float32 + (nullable-get bbox) (int32 1) + (float32 0.0)) + (sdvRectTop safeBounds)) scale)) + (+ left (* (- (json-array-opt-float32 + (nullable-get bbox) (int32 2) + (float32 0.0)) + (sdvRectLeft safeBounds)) scale)) + (+ top (* (- (json-array-opt-float32 + (nullable-get bbox) (int32 3) + (float32 0.0)) + (sdvRectTop safeBounds)) scale)))) + (lost + (sdvMinInt count + (sdvMapValue remainingDestroyed key)))) + (begin + (if (> lost (int32 0)) + (mutable-map-put! remainingDestroyed key + (- (sdvMapValue remainingDestroyed key) lost)) + (begin)) + (drawGroup canvas groupRect key + (json-object-opt-string-default + (nullable-get group) "label" key) + count lost) + (if (set-contains? recentHits key) + (sdvDrawRoundRect canvas groupRect + (float32 4.0) (float32 4.0) recentHitPaint) + (begin)) + ignored)))))))) + (begin)))))))))) + + (def (drawGroup (canvas : Canvas) (rect : RectF) (type : String) + (label : String) (count : Int32) (lost : Int32)) : Unit + (modifiers private) + (let ((ratio + (sdvClampFloat + (/ (float32 lost) (float32 (sdvMaxInt (int32 1) count))) + (float32 0.0) (float32 1.0))) + (baseColor (colorForBoxType type))) + (begin + (sdvPaintColorSet boxPaint + (if (>= ratio (float32 1.0)) + (sdvRgb (int32 83) (int32 61) (int32 65)) + (if (> ratio (float32 0.0)) + (dimColor baseColor (float32 0.68)) baseColor))) + (sdvDrawRoundRect canvas rect (float32 3.0) (float32 3.0) boxPaint) + (if (> ratio (float32 0.0)) + (sdvDrawRoundRect canvas + (new RectF (sdvRectLeft rect) (sdvRectTop rect) + (+ (sdvRectLeft rect) (* (sdvRectWidth rect) ratio)) + (sdvRectBottom rect)) + (float32 3.0) (float32 3.0) lostPaint) + (begin)) + (sdvDrawRoundRect canvas rect (float32 3.0) (float32 3.0) outlinePaint) + (if (and (> (sdvRectWidth rect) (float32 35.0)) + (> (sdvRectHeight rect) (float32 15.0))) + (begin + (sdvPaintAlignSet smallPaint (sdvCenter)) + (sdvPaintColorSet smallPaint (sdvWhite)) + (let ((text + (if (> lost (int32 0)) + (string-append (shortLabel label) + (string-append " " + (string-append (int32->string lost) + (string-append "/" (int32->string count))))) + (shortLabel label)))) + (sdvDrawText canvas + (fitText text smallPaint (- (sdvRectWidth rect) (float32 4.0))) + (sdvRectCenterX rect) (+ (sdvRectCenterY rect) (float32 5.0)) + smallPaint)) + (sdvPaintColorSet smallPaint + (sdvRgb (int32 161) (int32 177) (int32 199)))) + (begin))))) + + (def (drawDefenseBand (canvas : Canvas) (area : RectF) + (ship : (Nullable JSONObject)) + (destroyed : (Map String Int32))) : Unit + (modifiers private) + (if (or (< (sdvRectHeight area) (float32 45.0)) + (< (sdvRectWidth area) (float32 80.0))) + (begin) + (begin + (sdvDrawRoundRect canvas area (float32 6.0) (float32 6.0) bandPaint) + (let ((shields + (shieldValues + (if (nullable-null? ship) + (nullable-none JSONObject) + (json-object-opt-json-object (nullable-get ship) "shields")))) + (rawMax + (shieldValues + (if (nullable-null? ship) + (nullable-none JSONObject) + (json-object-opt-json-object + (nullable-get ship) "max-shields"))))) + (let ((maxShields + (if (= (sdvIntMapTotal rawMax) (int32 0)) shields rawMax)) + (currentTotal (sdvIntMapTotal shields))) + (let ((maxTotal + (sdvMaxInt currentTotal (sdvIntMapTotal maxShields)))) + (if (> maxTotal (int32 0)) + (drawShieldGrid canvas area shields maxShields + currentTotal maxTotal) + (drawPaPanelStatus canvas area ship destroyed)))))))) + + (def (drawShieldGrid (canvas : Canvas) (area : RectF) + (shields : (Map Int32 Int32)) + (maxShields : (Map Int32 Int32)) + (currentTotal : Int32) (maxTotal : Int32)) : Unit + (modifiers private) + (begin + (sdvPaintAlignSet smallPaint (sdvLeft)) + (sdvPaintColorSet smallPaint (sdvRgb (int32 190) (int32 205) (int32 224))) + (sdvDrawText canvas + (string-append "SHIELDS " + (string-append (int32->string currentTotal) + (string-append "/" (int32->string maxTotal)))) + (+ (sdvRectLeft area) (float32 6.0)) + (+ (sdvRectTop area) (float32 14.0)) smallPaint) + (let ((colWidth (/ (- (sdvRectWidth area) (float32 12.0)) (float32 3.0))) + (cellHeight + (sdvMinFloat (float32 22.0) + (/ (- (sdvRectHeight area) (float32 23.0)) (float32 2.0)))) + (firstTop (+ (sdvRectTop area) (float32 20.0)))) + (begin + (drawShieldSlot canvas area shields maxShields + (int32 6) (int32 0) (int32 0) colWidth cellHeight firstTop) + (drawShieldSlot canvas area shields maxShields + (int32 1) (int32 1) (int32 0) colWidth cellHeight firstTop) + (drawShieldSlot canvas area shields maxShields + (int32 2) (int32 2) (int32 0) colWidth cellHeight firstTop) + (drawShieldSlot canvas area shields maxShields + (int32 5) (int32 0) (int32 1) colWidth cellHeight firstTop) + (drawShieldSlot canvas area shields maxShields + (int32 4) (int32 1) (int32 1) colWidth cellHeight firstTop) + (drawShieldSlot canvas area shields maxShields + (int32 3) (int32 2) (int32 1) colWidth cellHeight firstTop))) + (sdvPaintColorSet smallPaint (sdvRgb (int32 161) (int32 177) (int32 199))))) + + (def (drawShieldSlot (canvas : Canvas) (area : RectF) + (shields : (Map Int32 Int32)) + (maxShields : (Map Int32 Int32)) + (number : Int32) (col : Int32) (row : Int32) + (colWidth : Float32) (cellHeight : Float32) + (firstTop : Float32)) : Unit + (modifiers private) + (let ((left (+ (+ (sdvRectLeft area) (float32 6.0)) + (* (float32 col) colWidth))) + (top (+ firstTop (* (float32 row) (+ cellHeight (float32 4.0)))))) + (let ((value (sdvIntMapValue shields number)) + (rawMax (sdvIntMapValue maxShields number))) + (drawShieldCell canvas + (new RectF left top (- (+ left colWidth) (float32 4.0)) + (+ top cellHeight)) + number value (if (> rawMax (int32 0)) rawMax value))))) + + (def (drawShieldCell (canvas : Canvas) (rect : RectF) + (number : Int32) (value : Int32) + (maxValue : Int32)) : Unit + (modifiers private) + (let ((safeMax (sdvMaxInt (int32 1) maxValue))) + (let ((ratio + (sdvClampFloat (/ (float32 value) (float32 safeMax)) + (float32 0.0) (float32 1.0)))) + (begin + (sdvDrawRoundRect canvas rect (float32 3.0) (float32 3.0) + shieldTrackPaint) + (sdvPaintColorSet shieldValuePaint (shieldColor ratio)) + (sdvDrawRoundRect canvas + (new RectF (sdvRectLeft rect) (sdvRectTop rect) + (+ (sdvRectLeft rect) (* (sdvRectWidth rect) ratio)) + (sdvRectBottom rect)) + (float32 3.0) (float32 3.0) shieldValuePaint) + (sdvDrawRoundRect canvas rect (float32 3.0) (float32 3.0) + outlinePaint) + (sdvPaintAlignSet smallPaint (sdvLeft)) + (sdvPaintColorSet smallPaint (sdvWhite)) + (sdvDrawText canvas (int32->string number) + (+ (sdvRectLeft rect) (float32 4.0)) + (- (sdvRectBottom rect) (float32 5.0)) smallPaint) + (sdvPaintAlignSet smallPaint (sdvRight)) + (sdvDrawText canvas + (string-append (int32->string value) + (string-append "/" (int32->string safeMax))) + (- (sdvRectRight rect) (float32 4.0)) + (- (sdvRectBottom rect) (float32 5.0)) smallPaint))))) + + (def (drawPaPanelStatus (canvas : Canvas) (area : RectF) + (ship : (Nullable JSONObject)) + (destroyed : (Map String Int32))) : Unit + (modifiers private) + (let ((boxes + (if (nullable-null? ship) (nullable-none Any) + (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")) + (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)) + (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 "/" (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") + (- (sdvRectRight area) (float32 6.0)) + (+ (sdvRectTop area) (float32 17.0)) smallPaint) + (let ((bar + (new RectF (+ (sdvRectLeft area) (float32 8.0)) + (+ (sdvRectTop area) (float32 31.0)) + (- (sdvRectRight area) (float32 8.0)) + (+ (sdvRectTop area) (float32 51.0))))) + (begin + (sdvDrawRoundRect canvas bar (float32 5.0) (float32 5.0) + shieldTrackPaint) + (sdvPaintColorSet shieldValuePaint + (sdvRgb (int32 200) (int32 139) (int32 48))) + (sdvDrawRoundRect canvas + (new RectF (sdvRectLeft bar) (sdvRectTop bar) + (+ (sdvRectLeft bar) (* (sdvRectWidth bar) ratio)) + (sdvRectBottom bar)) + (float32 5.0) (float32 5.0) shieldValuePaint) + (sdvDrawRoundRect canvas bar (float32 5.0) (float32 5.0) + outlinePaint) + (sdvPaintAlignSet smallPaint (sdvLeft)) + (sdvPaintColorSet smallPaint + (sdvRgb (int32 161) (int32 177) (int32 199))) + (let ((note + (if (and (<= paMax (int32 1)) (= paPanels (int32 0))) + "No shield/PA values in this template" + "Absorbs damage before internals"))) + (sdvDrawText canvas + (fitText note smallPaint + (- (sdvRectWidth area) (float32 12.0))) + (+ (sdvRectLeft area) (float32 6.0)) + (sdvMinFloat (- (sdvRectBottom area) (float32 7.0)) + (+ (sdvRectBottom bar) (float32 16.0))) + smallPaint))))))))))) + + (def (drawWeaponStrip (canvas : Canvas) (area : RectF) + (ship : (Nullable JSONObject))) : Unit + (modifiers private) + (if (or (< (sdvRectHeight area) (float32 38.0)) + (< (sdvRectWidth area) (float32 90.0))) + (begin) + (begin + (sdvDrawRoundRect canvas area (float32 6.0) (float32 6.0) bandPaint) + (sdvPaintAlignSet smallPaint (sdvLeft)) + (sdvPaintColorSet smallPaint (sdvRgb (int32 190) (int32 205) (int32 224))) + (sdvDrawText canvas "WEAPONS" (+ (sdvRectLeft area) (float32 6.0)) + (+ (sdvRectTop area) (float32 15.0)) smallPaint) + (let ((weapons + (sortedWeaponStatus + (if (nullable-null? ship) (nullable-none JSONArray) + (json-object-opt-json-array + (nullable-get ship) "weapon-status"))))) + (if (= (list-size weapons) (int32 0)) + (let ((fallback + (compactCounter + (counterMap + (if (nullable-null? ship) (nullable-none Any) + (json-object-opt-any (nullable-get ship) "weapons"))) + (int32 4)))) + (begin + (sdvPaintColorSet smallPaint + (sdvRgb (int32 161) (int32 177) (int32 199))) + (sdvDrawText canvas + (fitText + (if (string-blank? fallback) "No weapon status" fallback) + smallPaint (- (sdvRectWidth area) (float32 12.0))) + (+ (sdvRectLeft area) (float32 6.0)) + (+ (sdvRectTop area) (float32 35.0)) smallPaint))) + (let ((maxRows + (sdvMaxInt (int32 1) + (int32 (/ (- (sdvRectHeight area) (float32 22.0)) + (float32 19.0)))))) + (begin + (for/fold ((ignored (int32 0))) + ((index (in-range (int32 0) + (sdvMinInt maxRows (list-size weapons))))) + (begin + (drawWeaponRow canvas area + (+ (sdvRectTop area) + (+ (float32 34.0) (* (float32 index) (float32 19.0)))) + (list-ref weapons index)) + ignored)) + (if (> (list-size weapons) maxRows) + (begin + (sdvPaintAlignSet smallPaint (sdvRight)) + (sdvPaintColorSet smallPaint + (sdvRgb (int32 161) (int32 177) (int32 199))) + (sdvDrawText canvas + (string-append "+" + (int32->string (- (list-size weapons) maxRows))) + (- (sdvRectRight area) (float32 7.0)) + (- (sdvRectBottom area) (float32 6.0)) smallPaint)) + (begin))))))))) + + (def (drawWeaponRow (canvas : Canvas) (area : RectF) (y : Float32) + (weapon : JSONObject)) : Unit + (modifiers private) + (let ((kind (shortWeapon + (json-object-opt-string-default weapon "kind" "-"))) + (installed (sdvMaxInt (int32 0) + (json-object-opt-int32-default weapon "installed" (int32 0)))) + (armed (sdvMaxInt (int32 0) + (json-object-opt-int32-default weapon "armed" (int32 0)))) + (ready (sdvMaxInt (int32 0) + (json-object-opt-int32-default weapon "fireable" (int32 0)))) + (inArc (sdvMaxInt (int32 0) + (json-object-opt-int32-default + weapon "fireable-in-arc" (int32 0)))) + (arcs (arcCodes weapon))) + (let ((arcSummary (compactArcSummary arcs))) + (begin + (sdvPaintAlignSet smallPaint (sdvLeft)) + (sdvPaintColorSet smallPaint (sdvRgb (int32 224) (int32 233) (int32 245))) + (sdvDrawText canvas + (fitText kind smallPaint (* (sdvRectWidth area) (float32 0.28))) + (+ (sdvRectLeft area) (float32 6.0)) y smallPaint) + (sdvPaintColorSet smallPaint + (if (> inArc (int32 0)) + (sdvRgb (int32 155) (int32 223) (int32 182)) + (sdvRgb (int32 219) (int32 174) (int32 134)))) + (sdvDrawText canvas + (string-append (int32->string ready) + (string-append "/" (string-append (int32->string armed) + (string-append "/" (int32->string installed))))) + (+ (sdvRectLeft area) (* (sdvRectWidth area) (float32 0.30))) + y smallPaint) + (sdvPaintColorSet smallPaint (sdvRgb (int32 203) (int32 215) (int32 231))) + (sdvDrawText canvas + (fitText (if (string-blank? arcSummary) "-" arcSummary) smallPaint + (* (sdvRectWidth area) (float32 0.36))) + (+ (sdvRectLeft area) (* (sdvRectWidth area) (float32 0.48))) + y smallPaint) + (let ((chipCount (sdvMinInt (int32 3) (list-size arcs)))) + (var ((chipX (- (sdvRectRight area) + (+ (* (float32 chipCount) (float32 15.0)) + (float32 2.0))))) + (begin + (for/fold ((ignored (int32 0))) + ((index (in-range (int32 0) chipCount))) + (begin + (drawArcChip canvas (+ chipX (float32 7.0)) + (- y (float32 5.0)) (float32 7.0) + (list-ref arcs index)) + (set! chipX (+ chipX (float32 15.0))) + ignored)) + (begin)))))))) + + (def (drawLegend (canvas : Canvas) (rect : RectF) + (destroyed : (Map String Int32)) + (labels : (Map String String)) + (recentHits : (Set String))) : Unit + (modifiers private) + (let ((damageKeys (sortedDamageKeys destroyed)) + (recentKeys (sdvStringSetToList recentHits))) + (let ((text + (if (= (list-size damageKeys) (int32 0)) + (if (= (list-size recentKeys) (int32 0)) + "No internal boxes destroyed" + (string-append "Recent " + (joinDamageLabels recentKeys labels (int32 3) " "))) + (let ((damageText + (joinDamageCounts damageKeys destroyed labels + (int32 4)))) + (if (= (list-size recentKeys) (int32 0)) + damageText + (string-append damageText + (string-append " recent " + (joinDamageLabels recentKeys labels + (int32 2) " ")))))))) + (begin + (sdvPaintAlignSet smallPaint (sdvLeft)) + (sdvPaintColorSet smallPaint (sdvRgb (int32 187) (int32 202) (int32 223))) + (sdvDrawText canvas + (fitText text smallPaint (- (sdvRectWidth rect) (float32 16.0))) + (+ (sdvRectLeft rect) (float32 8.0)) + (- (sdvRectBottom rect) (float32 14.0)) smallPaint) + (sdvPaintColorSet smallPaint + (sdvRgb (int32 161) (int32 177) (int32 199))))))) + + (def (groupLabelMap (groups : JSONArray)) : (MutableMap String String) + (modifiers private) + (let ((out (mutable-map-empty String String))) + (begin + (for/fold ((ignored (int32 0))) + ((index (in-range (int32 0) (json-array-length groups)))) + (let ((group (json-array-opt-json-object groups index))) + (if (nullable-null? group) + ignored + (let ((type + (typeKey + (json-object-opt-any + (nullable-get group) "box-type-id"))) + (label + (string-trim + (json-object-opt-string-default + (nullable-get group) "label" "")))) + (begin + (if (and (not (nullable-null? type)) + (not (string-blank? label))) + (let ((key (nullable-get type))) + (if (map-contains-key? out key) + (begin) + (mutable-map-put! out key label))) + (begin)) + ignored))))) + out))) + + (def (drawFallbackDamage (canvas : Canvas) (area : RectF) + (destroyed : (Map String Int32)) + (recentHits : (Set String))) : Unit + (modifiers private) + (if (or (<= (sdvRectWidth area) (float32 12.0)) + (<= (sdvRectHeight area) (float32 12.0))) + (begin) + (let ((rows (sortedDamageKeys destroyed)) + (recent (sdvStringSetToList recentHits))) + (if (= (list-size rows) (int32 0)) + (begin + (sdvPaintAlignSet labelPaint (sdvCenter)) + (sdvPaintColorSet labelPaint + (sdvRgb (int32 204) (int32 216) (int32 233))) + (sdvDrawText canvas + (fitText + (if (= (list-size recent) (int32 0)) + "No internal boxes destroyed" + (string-append "Recent " (sdvJoinStrings recent " "))) + labelPaint (- (sdvRectWidth area) (float32 8.0))) + (sdvRectCenterX area) (sdvRectCenterY area) labelPaint)) + (begin + (sdvPaintAlignSet smallPaint (sdvLeft)) + (sdvPaintColorSet smallPaint + (sdvRgb (int32 220) (int32 230) (int32 243))) + (sdvDrawText canvas "SSD truth not linked; showing damage counters" + (sdvRectLeft area) (+ (sdvRectTop area) (float32 15.0)) smallPaint) + (let ((maxRows + (sdvMaxInt (int32 1) + (int32 (/ (- (sdvRectHeight area) (float32 28.0)) + (float32 22.0)))))) + (begin + (for/fold ((ignored (int32 0))) + ((index (in-range (int32 0) + (sdvMinInt maxRows (list-size rows))))) + (let ((key (list-ref rows index)) + (y (+ (sdvRectTop area) + (+ (float32 42.0) + (* (float32 index) (float32 22.0)))))) + (begin + (sdvDrawCircle canvas (+ (sdvRectLeft area) (float32 7.0)) + (- y (float32 5.0)) (float32 5.0) lostPaint) + (sdvDrawText canvas + (string-append "type " + (string-append key + (string-append ": " + (int32->string (sdvMapValue destroyed key))))) + (+ (sdvRectLeft area) (float32 20.0)) y smallPaint) + ignored))) + (if (> (list-size rows) maxRows) + (sdvDrawText canvas + (string-append "+" + (string-append + (int32->string (- (list-size rows) maxRows)) " more")) + (+ (sdvRectLeft area) (float32 20.0)) + (- (sdvRectBottom area) (float32 8.0)) smallPaint) + (begin)))) + (sdvPaintColorSet smallPaint + (sdvRgb (int32 161) (int32 177) (int32 199)))))))) + + (def (truthBounds (groups : JSONArray)) : (Nullable RectF) + (modifiers private) + (var ((found #f) + (left (float32 0.0)) (top (float32 0.0)) + (right (float32 0.0)) (bottom (float32 0.0))) + (begin + (for/fold ((ignored (int32 0))) + ((index (in-range (int32 0) (json-array-length groups)))) + (let ((group (json-array-opt-json-object groups index))) + (if (nullable-null? group) + ignored + (let ((bbox + (json-object-opt-json-array + (nullable-get group) "bbox"))) + (if (nullable-null? bbox) + ignored + (let ((x1 (json-array-opt-float32 + (nullable-get bbox) (int32 0) (float32 0.0))) + (y1 (json-array-opt-float32 + (nullable-get bbox) (int32 1) (float32 0.0))) + (x2 (json-array-opt-float32 + (nullable-get bbox) (int32 2) (float32 0.0))) + (y2 (json-array-opt-float32 + (nullable-get bbox) (int32 3) (float32 0.0)))) + (begin + (if found + (begin + (set! left (sdvMinFloat left x1)) + (set! top (sdvMinFloat top y1)) + (set! right (sdvMaxFloat right x2)) + (set! bottom (sdvMaxFloat bottom y2))) + (begin + (set! found #t) + (set! left x1) (set! top y1) + (set! right x2) (set! bottom y2))) + ignored))))))) + (if (or (not found) (or (<= right left) (<= bottom top))) + (nullable-none RectF) + (nullable-some (new RectF left top right bottom)))))) + + (def (shieldValues (raw : (Nullable JSONObject))) : (MutableMap Int32 Int32) + (modifiers private) + (let ((out (mutable-map-empty Int32 Int32))) + (begin + (if (nullable-null? raw) + (begin) + (begin + (for/fold ((ignored (int32 0))) + ((shield (in-range (int32 1) (int32 7)))) + (let ((value + (json-object-opt-float32-default + (nullable-get raw) + (string-append "shield-" (int32->string shield)) + (float32 0.0)))) + (begin + (if (> value (float32 0.0)) + (mutable-map-put! out shield + (float32-round->int32 value)) + (begin)) + ignored)))