Add typed tactics command views
ober
0b55f143c3d3fe605d50e4fd6d8091eacc544924
new file mode 100644 --- /dev/null +++ b/templates/original-tactics-parts/BattleCommandView.kt.ss @@ -0,0 +1,852 @@ +(import (jerboa prelude)) + +(def fragment + '((typed-kotlin-file "com/jerboa/originaltactics/BattleCommandView.kt" + (kotlin-imports + (android content Context) + (android content res Resources) + (android graphics Canvas) + (android graphics Color) + (android graphics Paint) + (android graphics RectF) + (android view View) + (android util DisplayMetrics) + (org json JSONArray) + (org json JSONObject)) + (typed-library (com jerboa originaltactics) + (export BattleCommandView) + (type Any) + (type Context) + (type Resources) + (type DisplayMetrics) + (type Canvas) + (type Paint) + (type PaintStyle) + (type PaintAlign) + (type RectF) + (type View) + (type JSONArray) + (type JSONObject) + (type Number) + (type Int32) + (type Float32) + + (extern (bcvPaintAntiAliasFlag) : Int32 + (kotlin-value Paint ANTI_ALIAS_FLAG)) + (extern (bcvPaintStyleFill) : PaintStyle + (kotlin-value Paint Style FILL)) + (extern (bcvPaintStyleStroke) : PaintStyle + (kotlin-value Paint Style STROKE)) + (extern (bcvPaintAlignLeft) : PaintAlign + (kotlin-value Paint Align LEFT)) + (extern (bcvPaintAlignCenter) : PaintAlign + (kotlin-value Paint Align CENTER)) + (extern (bcvPaintAlignRight) : PaintAlign + (kotlin-value Paint Align RIGHT)) + (extern (bcvColorWhite) : Int32 + (kotlin-value Color WHITE)) + (extern (bcvColorRgb (red : Int32) (green : Int32) (blue : Int32)) : Int32 + (kotlin-call Color rgb)) + (extern (bcvPaintColorSet (paint : Paint) (value : Int32)) : Unit + (kotlin-member-set color)) + (extern (bcvPaintStyleSet (paint : Paint) (value : PaintStyle)) : Unit + (kotlin-member-set style)) + (extern (bcvPaintStrokeWidthSet (paint : Paint) (value : Float32)) : Unit + (kotlin-member-set strokeWidth)) + (extern (bcvPaintTextSizeSet (paint : Paint) (value : Float32)) : Unit + (kotlin-member-set textSize)) + (extern (bcvPaintFakeBoldSet (paint : Paint) (value : Bool)) : Unit + (kotlin-member-set isFakeBoldText)) + (extern (bcvPaintTextAlignSet (paint : Paint) (value : PaintAlign)) : Unit + (kotlin-member-set textAlign)) + (extern (bcvPaintMeasureText (paint : Paint) (text : String)) : Float32 + (kotlin-member-call measureText)) + (extern (bcvCanvasSave (canvas : Canvas)) : Int32 + (kotlin-member-call save)) + (extern (bcvCanvasScale (canvas : Canvas) (x : Float32) (y : Float32)) : Unit + (kotlin-member-call scale)) + (extern (bcvCanvasRestoreToCount (canvas : Canvas) (state : Int32)) : Unit + (kotlin-member-call restoreToCount)) + (extern (bcvCanvasDrawRoundRect (canvas : Canvas) (rect : RectF) + (rx : Float32) (ry : Float32) + (paint : Paint)) : Unit + (kotlin-member-call drawRoundRect)) + (extern (bcvCanvasDrawText (canvas : Canvas) (text : String) + (x : Float32) (y : Float32) + (paint : Paint)) : Unit + (kotlin-member-call drawText)) + (extern (bcvCanvasDrawCircle (canvas : Canvas) (x : Float32) + (y : Float32) (radius : Float32) + (paint : Paint)) : Unit + (kotlin-member-call drawCircle)) + (extern (bcvRectLeft (rect : RectF)) : Float32 + (kotlin-member-get left)) + (extern (bcvRectTop (rect : RectF)) : Float32 + (kotlin-member-get top)) + (extern (bcvRectRight (rect : RectF)) : Float32 + (kotlin-member-get right)) + (extern (bcvRectBottom (rect : RectF)) : Float32 + (kotlin-member-get bottom)) + (extern (bcvRectWidth (rect : RectF)) : Float32 + (kotlin-member-call width)) + (extern (bcvRectCenterX (rect : RectF)) : Float32 + (kotlin-member-call centerX)) + (extern (bcvViewInvalidate (view : BattleCommandView)) : Unit + (kotlin-member-call invalidate)) + (extern (bcvViewWidth (view : BattleCommandView)) : Int32 + (kotlin-member-get width)) + (extern (bcvViewHeight (view : BattleCommandView)) : Int32 + (kotlin-member-get height)) + (extern (bcvViewResources (view : BattleCommandView)) : Resources + (kotlin-member-get resources)) + (extern (bcvResourcesDisplayMetrics (resources : Resources)) : DisplayMetrics + (kotlin-member-get displayMetrics)) + (extern (bcvDisplayMetricsDensity (metrics : DisplayMetrics)) : Float32 + (kotlin-member-get density)) + (extern (bcvSuperOnDraw (canvas : Canvas)) : Unit + (kotlin-call super onDraw)) + (extern (bcvAsJsonObject (value : Any)) : (Nullable JSONObject) + (kotlin-safe-cast JSONObject)) + (extern (bcvAsJsonArray (value : Any)) : (Nullable JSONArray) + (kotlin-safe-cast JSONArray)) + (extern (bcvAsNumber (value : Any)) : (Nullable Number) + (kotlin-safe-cast Number)) + (extern (bcvAsString (value : Any)) : (Nullable String) + (kotlin-safe-cast String)) + (extern (bcvNumberToInt32 (value : Number)) : Int32 + (kotlin-member-call toInt)) + (extern (bcvAnyToString (value : Any)) : String + (kotlin-member-call toString)) + (extern (bcvStringReplace (text : String) (old : String) + (replacement : String)) : String + (kotlin-member-call replace)) + (extern (bcvJsonKeys (json : JSONObject)) : (Iterator String) + (kotlin-member-call keys)) + (extern (bcvIteratorHasNext (items : (Iterator String))) : Bool + (kotlin-member-call hasNext)) + (extern (bcvIteratorNext (items : (Iterator String))) : String + (kotlin-member-call next)) + (extern (bcvCurrentBattleRange (battle : (Nullable JSONObject))) : String + (kotlin-call currentBattleRange)) + (extern (bcvNextMoveImpulse (position : (Nullable JSONObject)) + (currentImpulse : Int32)) : (Nullable Int32) + (kotlin-call nextMoveImpulse)) + (extern (bcvManeuverAbbreviation (maneuver : String)) : String + (kotlin-call maneuverAbbreviation)) + (extern (bcvShipDisplayLabel (ship : (Nullable JSONObject))) : String + (kotlin-call shipDisplayLabel)) + + (def (bcvConfigurePaint (paint : Paint) (color : Int32) + (style : PaintStyle) + (strokeWidth : Float32)) : Paint + (begin + (bcvPaintColorSet paint color) + (bcvPaintStyleSet paint style) + (bcvPaintStrokeWidthSet paint strokeWidth) + paint)) + (def (bcvConfigureTextPaint (paint : Paint) (color : Int32) + (size : Float32) (bold : Bool)) : Paint + (begin + (bcvPaintColorSet paint color) + (bcvPaintTextSizeSet paint size) + (bcvPaintFakeBoldSet paint bold) + paint)) + (def (bcvMaxInt (a : Int32) (b : Int32)) : Int32 (if (> a b) a b)) + (def (bcvMaxFloat (a : Float32) (b : Float32)) : Float32 (if (> a b) a b)) + (def (bcvMinFloat (a : Float32) (b : Float32)) : Float32 (if (< a b) a b)) + (def (bcvClampFloat (value : Float32) (low : Float32) (high : Float32)) : Float32 + (bcvMinFloat high (bcvMaxFloat low value))) + (def (bcvNullableObjectField (json : (Nullable JSONObject)) + (key : String)) : (Nullable JSONObject) + (if (nullable-null? json) + (nullable-none JSONObject) + (json-object-opt-json-object (nullable-get json) key))) + (def (bcvNullableObjectInt (json : (Nullable JSONObject)) + (key : String) (fallback : Int32)) : Int32 + (if (nullable-null? json) + fallback + (json-object-opt-int32-default (nullable-get json) key fallback))) + (def (bcvNullableObjectAny (json : (Nullable JSONObject)) + (key : String)) : (Nullable Any) + (if (nullable-null? json) + (nullable-none Any) + (json-object-opt-any (nullable-get json) key))) + (def (bcvNumberValue (value : (Nullable Any))) : Int32 + (if (nullable-null? value) + (int32 0) + (let ((number (bcvAsNumber (nullable-get value)))) + (if (nullable-null? number) + (let ((text (bcvAsString (nullable-get value)))) + (if (nullable-null? text) + (int32 0) + (let ((parsed (string->int32-or-null (nullable-get text)))) + (if (nullable-null? parsed) + (int32 0) + (nullable-get parsed))))) + (bcvNumberToInt32 (nullable-get number)))))) + (def (bcvIntText (value : Int32)) : String (int32->string value)) + (def (bcvFloatRect (left : Float32) (top : Float32) + (right : Float32) (bottom : Float32)) : RectF + (new RectF left top right bottom)) + + (record BattleFireSolution + ((installed : Int32) (armed : Int32) (ready : Int32) (inArc : Int32))) + (record BattleWeaponFamily + ((kind : String) (installed : Int32) (armed : Int32) + (fireable : Int32) (inArc : Int32) (cooldown : Int32))) + (record BattlePlotText ((text : String) (count : Int32))) + + (class BattleCommandView ((context : Context)) + (extends View context) + (var game : (Nullable JSONObject) (nullable-none JSONObject) + (modifiers private)) + (var events : JSONArray (new JSONArray) + (modifiers private)) + (var tacticalStatus : (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 + (bcvConfigurePaint (new Paint (bcvPaintAntiAliasFlag)) + (bcvColorRgb (int32 23) (int32 29) (int32 39)) + (bcvPaintStyleFill) (float32 0.0)) (modifiers private)) + (val panelPaint : Paint + (bcvConfigurePaint (new Paint (bcvPaintAntiAliasFlag)) + (bcvColorRgb (int32 34) (int32 42) (int32 55)) + (bcvPaintStyleFill) (float32 0.0)) (modifiers private)) + (val borderPaint : Paint + (bcvConfigurePaint (new Paint (bcvPaintAntiAliasFlag)) + (bcvColorRgb (int32 83) (int32 98) (int32 122)) + (bcvPaintStyleStroke) (float32 2.0)) (modifiers private)) + (val alphaPaint : Paint + (bcvConfigurePaint (new Paint (bcvPaintAntiAliasFlag)) + (bcvColorRgb (int32 47) (int32 128) (int32 222)) + (bcvPaintStyleFill) (float32 0.0)) (modifiers private)) + (val betaPaint : Paint + (bcvConfigurePaint (new Paint (bcvPaintAntiAliasFlag)) + (bcvColorRgb (int32 215) (int32 92) (int32 72)) + (bcvPaintStyleFill) (float32 0.0)) (modifiers private)) + (val trackPaint : Paint + (bcvConfigurePaint (new Paint (bcvPaintAntiAliasFlag)) + (bcvColorRgb (int32 58) (int32 68) (int32 84)) + (bcvPaintStyleFill) (float32 0.0)) (modifiers private)) + (val fillPaint : Paint + (bcvConfigurePaint (new Paint (bcvPaintAntiAliasFlag)) + (bcvColorRgb (int32 70) (int32 167) (int32 106)) + (bcvPaintStyleFill) (float32 0.0)) (modifiers private)) + (val accentPaint : Paint + (bcvConfigurePaint (new Paint (bcvPaintAntiAliasFlag)) + (bcvColorRgb (int32 230) (int32 155) (int32 63)) + (bcvPaintStyleFill) (float32 0.0)) (modifiers private)) + (val titlePaint : Paint + (bcvConfigureTextPaint (new Paint (bcvPaintAntiAliasFlag)) + (bcvColorWhite) (float32 27.0) #t) (modifiers private)) + (val labelPaint : Paint + (bcvConfigureTextPaint (new Paint (bcvPaintAntiAliasFlag)) + (bcvColorRgb (int32 213) (int32 221) (int32 234)) + (float32 20.0) #f) (modifiers private)) + (val smallPaint : Paint + (bcvConfigureTextPaint (new Paint (bcvPaintAntiAliasFlag)) + (bcvColorRgb (int32 165) (int32 177) (int32 195)) + (float32 17.0) #f) (modifiers private)) + (val valuePaint : Paint + (bcvConfigureTextPaint (new Paint (bcvPaintAntiAliasFlag)) + (bcvColorWhite) (float32 19.0) #t) (modifiers private)) + + (def (setGame (nextGame : (Nullable JSONObject)) + (nextEvents : JSONArray (default (new JSONArray)))) : Unit + (begin + (set! game nextGame) + (set! events nextEvents) + (bcvViewInvalidate this))) + (def (setGameWithStatus (nextGame : (Nullable JSONObject)) + (nextEvents : JSONArray) + (nextStatus : (Nullable JSONObject))) : Unit + (kotlin-name setGame) + (begin + (set! game nextGame) + (set! events nextEvents) + (set! tacticalStatus nextStatus) + (bcvViewInvalidate this))) + (def (setTacticalStatus (nextStatus : (Nullable JSONObject))) : Unit + (begin + (set! tacticalStatus nextStatus) + (bcvViewInvalidate this))) + (def (onDraw (canvas : Canvas)) : Unit + (modifiers override) + (begin + (bcvSuperOnDraw canvas) + (let ((canvasState (bcvCanvasSave canvas)) + (scale + (bcvMaxFloat + (bcvDisplayMetricsDensity + (bcvResourcesDisplayMetrics (bcvViewResources this))) + (float32 1.0)))) + (begin + (set! drawWidth (/ (float32 (bcvViewWidth this)) scale)) + (set! drawHeight (/ (float32 (bcvViewHeight this)) scale)) + (bcvCanvasScale canvas scale scale) + (try-finally + (drawContent canvas) + (bcvCanvasRestoreToCount canvas canvasState)))))) + + (def (drawContent (canvas : Canvas)) : Unit + (modifiers private) + (begin + (bcvCanvasDrawRoundRect canvas + (bcvFloatRect (float32 0.0) (float32 0.0) drawWidth drawHeight) + (float32 10.0) (float32 10.0) backgroundPaint) + (if (nullable-null? game) + (drawEmpty canvas) + (let ((current (nullable-get game))) + (let ((battle (json-object-opt-json-object current "battle-state"))) + (if (nullable-null? battle) + (drawEmpty canvas) + (drawBattle canvas current (nullable-get battle)))))))) + (def (drawBattle (canvas : Canvas) (current : JSONObject) + (battle : JSONObject)) : Unit + (modifiers private) + (let ((gap (float32 10.0)) + (top (float32 82.0)) + (currentImpulse + (json-object-opt-int32-default current "impulse" (int32 0)))) + (begin + (drawHeader canvas current battle) + (drawOrderStrip canvas current battle) + (let ((feedHeight + (bcvMinFloat (float32 54.0) (* drawHeight (float32 0.32)))) + (orders (json-object-opt-json-object current "orders"))) + (let ((cardsBottom + (bcvMaxFloat (+ top (float32 76.0)) + (- (- drawHeight feedHeight) (float32 8.0)))) + (cardWidth + (/ (- drawWidth (* gap (float32 3.0))) (float32 2.0)))) + (begin + (drawShipCard canvas + (bcvFloatRect gap top (+ gap cardWidth) cardsBottom) + "ALPHA" + (json-object-opt-json-object battle "alpha") + (json-object-opt-json-object battle "alpha-position") + (bcvNullableObjectField tacticalStatus "alpha") + orders "alpha" currentImpulse alphaPaint) + (drawShipCard canvas + (bcvFloatRect (+ (* gap (float32 2.0)) cardWidth) top + (+ (* gap (float32 2.0)) (* cardWidth (float32 2.0))) + cardsBottom) + "BETA" + (json-object-opt-json-object battle "beta") + (json-object-opt-json-object battle "beta-position") + (bcvNullableObjectField tacticalStatus "beta") + orders "beta" currentImpulse betaPaint) + (drawEventFeed canvas + (bcvFloatRect gap (+ cardsBottom (float32 6.0)) + (- drawWidth gap) (- drawHeight (float32 8.0)))))))))) + (def (drawEmpty (canvas : Canvas)) : Unit + (modifiers private) + (begin + (bcvPaintTextAlignSet titlePaint (bcvPaintAlignCenter)) + (bcvCanvasDrawText canvas "Battle command" (/ drawWidth (float32 2.0)) + (- (/ drawHeight (float32 2.0)) (float32 2.0)) titlePaint) + (bcvPaintTextAlignSet smallPaint (bcvPaintAlignCenter)) + (bcvCanvasDrawText canvas "Start an engagement" (/ drawWidth (float32 2.0)) + (+ (/ drawHeight (float32 2.0)) (float32 24.0)) smallPaint))) + (def (drawHeader (canvas : Canvas) (current : JSONObject) + (battle : JSONObject)) : Unit + (modifiers private) + (let ((turn (json-object-opt-int32-default current "turn" (int32 1))) + (impulse (json-object-opt-int32-default current "impulse" (int32 0))) + (range (bcvCurrentBattleRange (nullable-some battle))) + (winner (json-object-opt-string-default current "winner" "undecided")) + (fired (json-object-opt-bool-default current "fired?" #f))) + (let ((fireState (if fired "FIRE RESOLVED" "FIRE READY")) + (outcome (if (equal? winner "undecided") + "NO DECISION" + (string-append (string-uppercase winner) " WINS")))) + (begin + (bcvPaintTextAlignSet titlePaint (bcvPaintAlignLeft)) + (bcvCanvasDrawText canvas + (string-append + (string-append (string-append "T" (bcvIntText turn)) ".") + (bcvIntText impulse)) + (float32 12.0) (float32 29.0) titlePaint) + (bcvPaintTextAlignSet valuePaint (bcvPaintAlignCenter)) + (bcvCanvasDrawText canvas (string-append "RANGE " range) + (/ drawWidth (float32 2.0)) (float32 29.0) valuePaint) + (bcvPaintTextAlignSet valuePaint (bcvPaintAlignRight)) + (bcvCanvasDrawText canvas + (fitText (string-append (string-append fireState " ") outcome) + valuePaint (* drawWidth (float32 0.44))) + (- drawWidth (float32 12.0)) (float32 29.0) valuePaint))))) + + (def (drawOrderStrip (canvas : Canvas) (current : JSONObject) + (battle : JSONObject)) : Unit + (modifiers private) + (let ((orders (json-object-opt-json-object current "orders"))) + (if (nullable-null? orders) + (begin) + (let ((orderJson (nullable-get orders)) + (currentImpulse + (json-object-opt-int32-default current "impulse" (int32 0)))) + (let ((fireImpulse + (json-object-opt-int32-default orderJson "fire-impulse" (int32 32))) + (alpha + (maneuverPlotText + (json-object-opt-any orderJson "alpha-maneuvers") + currentImpulse (int32 3))) + (beta + (maneuverPlotText + (json-object-opt-any orderJson "beta-maneuvers") + currentImpulse (int32 3))) + (rect + (bcvFloatRect (float32 10.0) (float32 39.0) + (- drawWidth (float32 10.0)) (float32 74.0)))) + (let ((ordersText + (string-append + (string-append + (string-append + (string-append + (string-append "FIRE I" (bcvIntText fireImpulse)) + " A ") + alpha) + " B ") + beta))) + (begin + (bcvCanvasDrawRoundRect canvas rect (float32 8.0) + (float32 8.0) panelPaint) + (bcvCanvasDrawRoundRect canvas rect (float32 8.0) + (float32 8.0) borderPaint) + (bcvPaintTextAlignSet valuePaint (bcvPaintAlignCenter)) + (bcvCanvasDrawText canvas + (fitText ordersText valuePaint + (- (bcvRectWidth rect) (float32 18.0))) + (bcvRectCenterX rect) + (+ (bcvRectTop rect) (float32 24.0)) valuePaint)))))))) + + (def (drawShipCard (canvas : Canvas) (rect : RectF) (side : String) + (ship : (Nullable JSONObject)) + (position : (Nullable JSONObject)) + (statusActor : (Nullable JSONObject)) + (orders : (Nullable JSONObject)) + (actor : String) (currentImpulse : Int32) + (sidePaint : Paint)) : Unit + (modifiers private) + (begin + (bcvCanvasDrawRoundRect canvas rect (float32 9.0) (float32 9.0) panelPaint) + (bcvCanvasDrawRoundRect canvas rect (float32 9.0) (float32 9.0) borderPaint) + (bcvCanvasDrawRoundRect canvas + (bcvFloatRect (bcvRectLeft rect) (bcvRectTop rect) + (bcvRectRight rect) (+ (bcvRectTop rect) (float32 28.0))) + (float32 9.0) (float32 9.0) sidePaint) + (bcvPaintTextAlignSet valuePaint (bcvPaintAlignLeft)) + (bcvCanvasDrawText canvas side (+ (bcvRectLeft rect) (float32 9.0)) + (+ (bcvRectTop rect) (float32 20.0)) valuePaint) + (bcvPaintTextAlignSet labelPaint (bcvPaintAlignLeft)) + (bcvCanvasDrawText canvas + (fitText (bcvShipDisplayLabel ship) labelPaint + (- (bcvRectWidth rect) (float32 18.0))) + (+ (bcvRectLeft rect) (float32 9.0)) + (+ (bcvRectTop rect) (float32 50.0)) labelPaint) + (let ((speed (bcvNullableObjectInt position "speed" (int32 0))) + (facing (bcvNullableObjectInt position "facing" (int32 0))) + (helm + (maneuverPlotText + (if (nullable-null? orders) + (nullable-none Any) + (json-object-opt-any (nullable-get orders) + (string-append actor "-maneuvers"))) + currentImpulse (int32 3))) + (move (bcvNextMoveImpulse position currentImpulse))) + (let ((moveText + (if (nullable-null? move) + "HOLD" + (string-append "M I" (bcvIntText (nullable-get move)))))) + (begin + (bcvPaintTextAlignSet smallPaint (bcvPaintAlignLeft)) + (bcvCanvasDrawText canvas + (fitText + (string-append + (string-append + (string-append + (string-append + (string-append + (string-append "SPD " (bcvIntText speed)) + " F") + (bcvIntText facing)) + " ") + moveText) + (string-append " HELM " helm)) + smallPaint (- (bcvRectWidth rect) (float32 18.0))) + (+ (bcvRectLeft rect) (float32 9.0)) + (+ (bcvRectTop rect) (float32 70.0)) smallPaint)))) + (let ((internalNow + (bcvNullableObjectInt ship "remaining-internals" (int32 0)))) + (drawMetricBar canvas (+ (bcvRectLeft rect) (float32 9.0)) + (+ (bcvRectTop rect) (float32 84.0)) + (- (bcvRectWidth rect) (float32 18.0)) "HULL" + internalNow (maxInternals ship internalNow))) + (let ((shieldNow (shieldTotal ship #f)) + (shieldMax (shieldTotal ship #t)) + (paPanels (counterValue (bcvNullableObjectAny ship "boxes") "52")) + (paMax (paPanelMax ship))) + (if (and (<= shieldMax (int32 0)) + (or (> paPanels (int32 0)) (> paMax (int32 1)))) + (drawMetricBar canvas (+ (bcvRectLeft rect) (float32 9.0)) + (+ (bcvRectTop rect) (float32 116.0)) + (- (bcvRectWidth rect) (float32 18.0)) "PA PANELS" + paPanels paMax) + (drawMetricBar canvas (+ (bcvRectLeft rect) (float32 9.0)) + (+ (bcvRectTop rect) (float32 116.0)) + (- (bcvRectWidth rect) (float32 18.0)) "SHIELDS" + shieldNow (bcvMaxInt shieldMax shieldNow)))) + (let ((weaponTotal + (counterTotal (bcvNullableObjectAny ship "weapons"))) + (armedTotal + (counterTotal (bcvNullableObjectAny ship "armed-weapons")))) + (drawMetricBar canvas (+ (bcvRectLeft rect) (float32 9.0)) + (+ (bcvRectTop rect) (float32 148.0)) + (- (bcvRectWidth rect) (float32 18.0)) "ARMED" + armedTotal (bcvMaxInt (int32 1) weaponTotal))) + (let ((solution (actorFireSolution statusActor))) + (begin + (bcvPaintTextAlignSet smallPaint (bcvPaintAlignLeft)) + (bcvCanvasDrawText canvas + (fitText + (if (> (BattleFireSolution-installed solution) (int32 0)) + (string-append + (string-append + (string-append "LOCK " + (bcvIntText (BattleFireSolution-inArc solution))) + (string-append "/" (bcvIntText (BattleFireSolution-ready solution)))) + (string-append " READY " + (string-append + (bcvIntText (BattleFireSolution-ready solution)) + (string-append "/" + (bcvIntText (BattleFireSolution-armed solution)))))) + "LOCK - READY -") + smallPaint (- (bcvRectWidth rect) (float32 18.0))) + (+ (bcvRectLeft rect) (float32 9.0)) + (bcvMinFloat (- (bcvRectBottom rect) (float32 30.0)) + (+ (bcvRectTop rect) (float32 180.0))) smallPaint))) + (let ((cool + (counterTotal + (bcvNullableObjectAny ship "direct-fire-cooldown"))) + (launch + (counterTotal + (bcvNullableObjectAny ship "seeking-launch-limits")))) + (bcvCanvasDrawText canvas + (fitText + (string-append + (string-append "COOL " (bcvIntText cool)) + (string-append " LAUNCH " (bcvIntText launch))) + smallPaint (- (bcvRectWidth rect) (float32 18.0))) + (+ (bcvRectLeft rect) (float32 9.0)) + (bcvMinFloat (- (bcvRectBottom rect) (float32 10.0)) + (+ (bcvRectTop rect) (float32 201.0))) smallPaint)))) + + (def (drawMetricBar (canvas : Canvas) (x : Float32) (y : Float32) + (barWidth : Float32) (label : String) + (value : Int32) (maxValue : Int32)) : Unit + (modifiers private) + (let ((safeMax (bcvMaxInt (int32 1) maxValue))) + (let ((ratio + (bcvClampFloat (/ (float32 value) (float32 safeMax)) + (float32 0.0) (float32 1.0)))) + (begin + (bcvPaintTextAlignSet smallPaint (bcvPaintAlignLeft)) + (bcvCanvasDrawText canvas label x (+ y (float32 13.0)) smallPaint) + (bcvPaintTextAlignSet valuePaint (bcvPaintAlignRight)) + (bcvCanvasDrawText canvas + (string-append (bcvIntText value) + (string-append "/" (bcvIntText safeMax))) + (+ x barWidth) (+ y (float32 13.0)) valuePaint) + (let ((bar + (bcvFloatRect x (+ y (float32 18.0)) + (+ x barWidth) (+ y (float32 27.0))))) + (begin + (bcvCanvasDrawRoundRect canvas bar (float32 5.0) + (float32 5.0) trackPaint) + (if (> ratio (float32 0.0)) + (begin + (bcvPaintColorSet fillPaint (barColor ratio)) + (bcvCanvasDrawRoundRect canvas + (bcvFloatRect (bcvRectLeft bar) (bcvRectTop bar) + (+ (bcvRectLeft bar) (* (bcvRectWidth bar) ratio)) + (bcvRectBottom bar)) + (float32 5.0) (float32 5.0) fillPaint)) + (begin)))))))) + + (def (drawEventFeed (canvas : Canvas) (rect : RectF)) : Unit + (modifiers private) + (begin + (bcvCanvasDrawRoundRect canvas rect (float32 8.0) (float32 8.0) panelPaint) + (bcvCanvasDrawRoundRect canvas rect (float32 8.0) (float32 8.0) borderPaint) + (bcvPaintTextAlignSet smallPaint (bcvPaintAlignLeft)) + (bcvPaintColorSet smallPaint + (bcvColorRgb (int32 165) (int32 177) (int32 195))) + (bcvCanvasDrawText canvas "TACTICAL LOG" + (+ (bcvRectLeft rect) (float32 9.0)) + (+ (bcvRectTop rect) (float32 18.0)) smallPaint) + (let ((start + (bcvMaxInt (int32 0) + (- (json-array-length events) (int32 3))))) + (if (= start (json-array-length events)) + (begin + (bcvPaintTextAlignSet labelPaint (bcvPaintAlignLeft)) + (bcvCanvasDrawText canvas "No combat events yet" + (+ (bcvRectLeft rect) (float32 9.0)) + (+ (bcvRectTop rect) (float32 42.0)) labelPaint)) + (begin + (for/fold ((y (+ (bcvRectTop rect) (float32 40.0)))) + ((index (in-range start (json-array-length events)))) + (let ((event (json-array-opt-json-object events index))) + (if (or (nullable-null? event) + (> y (- (bcvRectBottom rect) (float32 6.0)))) + y + (begin + (bcvPaintTextAlignSet labelPaint (bcvPaintAlignLeft)) + (bcvCanvasDrawText canvas + (fitText (summarizeEvent (nullable-get event)) + labelPaint (- (bcvRectWidth rect) (float32 28.0))) + (+ (bcvRectLeft rect) (float32 20.0)) y labelPaint) + (+ y (float32 19.0)))))) + (begin)))))) + + (def (summarizeEvent (event : JSONObject)) : String + (modifiers private) + (let ((turn (json-object-opt-int32-default event "turn" (int32 -1))) + (impulse (json-object-opt-int32-default event "impulse" (int32 -1))) + (actor (json-object-opt-string-default event "actor" "")) + (kind (json-object-opt-string-default event "type" "event"))) + (let ((prefix + (if (and (>= turn (int32 0)) (>= impulse (int32 0))) + (string-append + (string-append (string-append "T" (bcvIntText turn)) ".") + (bcvIntText impulse)) + (if (>= impulse (int32 0)) + (string-append "I" (bcvIntText impulse)) + "LOG"))) + (actorText + (if (string-blank? actor) + "" + (string-append " " (string-uppercase actor))))) + (string-append + (string-append (string-append prefix actorText) " ") + (bcvStringReplace kind "-" " "))))) + + (def (maneuverPlotText (raw : (Nullable Any)) + (currentImpulse : Int32) + (limit : Int32)) : String + (modifiers private) + (if (nullable-null? raw) + "CLEAR" + (let ((state + (for/fold ((out (make-BattlePlotText "" (int32 0)))) + ((impulse + (in-range (+ currentImpulse (int32 1)) (int32 33)))) + (if (>= (BattlePlotText-count out) limit) + out + (let ((maneuver + (maneuverAt (nullable-get raw) impulse))) + (if (string-blank? maneuver) + out + (make-BattlePlotText + (string-append + (BattlePlotText-text out) + (string-append + (if (= (BattlePlotText-count out) (int32 0)) "" "/") + (string-append + (string-append "I" (bcvIntText impulse)) + (string-append " " + (bcvManeuverAbbreviation maneuver))))) + (+ (BattlePlotText-count out) (int32 1))))))))) + (if (= (BattlePlotText-count state) (int32 0)) + "CLEAR" + (BattlePlotText-text state))))) + (def (maneuverAt (raw : Any) (impulse : Int32)) : String + (modifiers private) + (let ((obj (bcvAsJsonObject raw))) + (if (nullable-null? obj) + (let ((array (bcvAsJsonArray raw))) + (if (nullable-null? array) + "" + (maneuverAtArray (nullable-get array) impulse (int32 0)))) + (json-object-opt-string-default + (nullable-get obj) (bcvIntText impulse) "")))) + (def (maneuverAtArray (items : JSONArray) (wanted : Int32) + (index : Int32)) : String + (modifiers private) + (if (>= index (json-array-length items)) + "" + (let ((pairObject (json-array-opt-json-object items index))) + (if (nullable-null? pairObject) + (let ((pairArray + (let ((item (json-array-opt-any items index))) + (if (nullable-null? item) + (nullable-none JSONArray) + (bcvAsJsonArray (nullable-get item)))))) + (if (nullable-null? pairArray) + (maneuverAtArray items wanted (+ index (int32 1))) + (if (= (json-array-opt-int32 (nullable-get pairArray) + (int32 0) (int32 -1)) wanted) + (json-array-opt-string (nullable-get pairArray) + (int32 1)) + (maneuverAtArray items wanted (+ index (int32 1)))))) + (let ((pair + (json-object-opt-json-array + (nullable-get pairObject) "$pair"))) + (if (or (nullable-null? pair) + (not (= (json-array-opt-int32 (nullable-get pair) + (int32 0) (int32 -1)) wanted))) + (maneuverAtArray items wanted (+ index (int32 1))) + (json-array-opt-string (nullable-get pair) + (int32 1)))))))) + + (def (maxInternals (ship : (Nullable JSONObject)) + (current : Int32)) : Int32 + (modifiers private) + (let ((explicit (bcvNullableObjectInt ship "max-internals" (int32 0)))) + (if (> explicit (int32 0)) + explicit + (bcvMaxInt (int32 1) + (+ current + (counterTotal + (bcvNullableObjectAny ship "destroyed-boxes"))))))) + (def (shieldTotal (ship : (Nullable JSONObject)) + (maxValues : Bool)) : Int32 + (modifiers private) + (let ((preferred + (bcvNullableObjectField ship + (if maxValues "max-shields" "shields")))) + (if (nullable-null? preferred) + (counterTotal (bcvNullableObjectAny ship "shields")) + (counterObjectTotal (nullable-get preferred))))) + (def (paPanelMax (ship : (Nullable JSONObject))) : Int32 + (modifiers private) + (bcvMaxInt (int32 1) + (+ (counterValue (bcvNullableObjectAny ship "boxes") "52") + (counterValue (bcvNullableObjectAny ship "destroyed-boxes") "52")))) + (def (counterTotal (counter : (Nullable Any))) : Int32 + (modifiers private) + (if (nullable-null? counter) + (int32 0) + (let ((obj (bcvAsJsonObject (nullable-get counter)))) + (if (nullable-null? obj) + (let ((array (bcvAsJsonArray (nullable-get counter)))) + (if (nullable-null? array) + (bcvNumberValue counter) + (counterArrayTotal (nullable-get array) (int32 0)))) + (counterObjectTotal (nullable-get obj)))))) + (def (counterObjectTotal (obj : JSONObject)) : Int32 + (modifiers private) + (let ((pair (json-object-opt-json-array obj "$pair"))) + (if (nullable-null? pair) + (counterObjectKeysTotal obj (bcvJsonKeys obj) (int32 0)) + (bcvNumberValue + (json-array-opt-any (nullable-get pair) (int32 1)))))) + (def (counterObjectKeysTotal (obj : JSONObject) + (keys : (Iterator String)) + (total : Int32)) : Int32 + (modifiers private) + (if (not (bcvIteratorHasNext keys)) + total + (counterObjectKeysTotal obj keys + (+ total + (bcvNumberValue + (json-object-opt-any obj (bcvIteratorNext keys))))))) + (def (counterArrayTotal (array : JSONArray) (index : Int32)) : Int32 + (modifiers private) + (if (>= index (json-array-length array)) + (int32 0) + (let ((item (json-array-opt-any array index))) + (+ (counterTotal item) + (counterArrayTotal array (+ index (int32 1))))))) + (def (counterValue (counter : (Nullable Any)) + (wantedKey : String)) : Int32 + (modifiers private) + (if (nullable-null? counter) + (int32 0) + (let ((obj (bcvAsJsonObject (nullable-get counter)))) + (if (nullable-null? obj) + (let ((array (bcvAsJsonArray (nullable-get counter)))) + (if (nullable-null? array) + (int32 0) + (counterArrayValue (nullable-get array) wantedKey (int32 0)))) + (let ((pair (json-object-opt-json-array (nullable-get obj) "$pair"))) + (if (nullable-null? pair) + (bcvNumberValue + (json-object-opt-any (nullable-get obj) wantedKey)) + (if (equal? + (json-array-opt-string (nullable-get pair) (int32 0)) + wantedKey) + (bcvNumberValue + (json-array-opt-any (nullable-get pair) (int32 1))) + (int32 0)))))))) + (def (counterArrayValue (array : JSONArray) (wantedKey : String) + (index : Int32)) : Int32 + (modifiers private) + (if (>= index (json-array-length array)) + (int32 0) + (+ (counterValue (json-array-opt-any array index) wantedKey) + (counterArrayValue array wantedKey (+ index (int32 1)))))) + (def (actorFireSolution (actor : (Nullable JSONObject))) : BattleFireSolution + (modifiers private) + (let ((weapons (bcvNullableObjectField actor "weapon-status"))) + (let ((array + (if (nullable-null? actor) + (nullable-none JSONArray) + (json-object-opt-json-array (nullable-get actor) "weapon-status")))) + (if (nullable-null? array) + (make-BattleFireSolution (int32 0) (int32 0) (int32 0) (int32 0)) + (actorFireSolutionAt (nullable-get array) (int32 0) + (make-BattleFireSolution (int32 0) (int32 0) (int32 0) (int32 0))))))) + (def (actorFireSolutionAt (weapons : JSONArray) (index : Int32) + (out : BattleFireSolution)) : BattleFireSolution + (modifiers private) + (if (>= index (json-array-length weapons)) + out + (let ((weapon (json-array-opt-json-object weapons index))) + (if (nullable-null? weapon) + (actorFireSolutionAt weapons (+ index (int32 1)) out) + (actorFireSolutionAt weapons (+ index (int32 1)) + (make-BattleFireSolution + (+ (BattleFireSolution-installed out) + (bcvMaxInt (int32 0) + (json-object-opt-int32-default (nullable-get weapon) + "installed" (int32 0)))) + (+ (BattleFireSolution-armed out) + (bcvMaxInt (int32 0) + (json-object-opt-int32-default (nullable-get weapon) + "armed" (int32 0)))) + (+ (BattleFireSolution-ready out) + (bcvMaxInt (int32 0) + (json-object-opt-int32-default (nullable-get weapon) + "fireable" (int32 0)))) + (+ (BattleFireSolution-inArc out) + (bcvMaxInt (int32 0) + (json-object-opt-int32-default (nullable-get weapon) + "fireable-in-arc" (int32 0)))))))))) + (def (barColor (ratio : Float32)) : Int32 + (modifiers private) + (if (> ratio (float32 0.66)) + (bcvColorRgb (int32 70) (int32 167) (int32 106)) + (if (> ratio (float32 0.33)) + (bcvColorRgb (int32 230) (int32 155) (int32 63)) + (bcvColorRgb (int32 215) (int32 92) (int32 72))))) + + (def (fitText (text : String) (paint : Paint) + (maxWidth : Float32)) : String + (modifiers private) + (if (<= (bcvPaintMeasureText paint text) maxWidth) + text + (fitTextEnd text paint maxWidth + (- (string-length-int32 text) (int32 1))))) + (def (fitTextEnd (text : String) (paint : Paint) + (maxWidth : Float32) (end : Int32)) : String + (modifiers private) + (if (<= end (int32 1)) + (string-append (string-take text (int32 1)) "...") + (let ((candidate + (string-append (string-take text end) "..."))) + (if (<= (bcvPaintMeasureText paint candidate) maxWidth) + candidate + (fitTextEnd text paint maxWidth (- end (int32 1)))))))))))) new file mode 100644 --- /dev/null +++ b/templates/original-tactics-parts/BridgeHudView.kt.ss @@ -0,0 +1,929 @@ +(import (jerboa prelude)) + +(def fragment + '((typed-kotlin-file "com/jerboa/originaltactics/BridgeHudView.kt" + (kotlin-imports + (android content Context) + (android content res Resources) + (android graphics Canvas) + (android graphics Color) + (android graphics Paint) + (android graphics RectF) + (android view View) + (android util DisplayMetrics) + (org json JSONArray) + (org json JSONObject)) + (typed-library (com jerboa originaltactics) + (export BridgeHudView) + (type Any) + (type Context) + (type Resources) + (type DisplayMetrics) + (type Canvas) + (type Paint) + (type PaintStyle) + (type PaintAlign) + (type RectF) + (type View) + (type JSONArray) + (type JSONObject) + (type Number) + (type Int32) + (type Float32) + + (extern (bhvPaintAntiAliasFlag) : Int32 (kotlin-value Paint ANTI_ALIAS_FLAG)) + (extern (bhvPaintStyleFill) : PaintStyle (kotlin-value Paint Style FILL)) + (extern (bhvPaintStyleStroke) : PaintStyle (kotlin-value Paint Style STROKE)) + (extern (bhvPaintAlignLeft) : PaintAlign (kotlin-value Paint Align LEFT)) + (extern (bhvPaintAlignCenter) : PaintAlign (kotlin-value Paint Align CENTER)) + (extern (bhvPaintAlignRight) : PaintAlign (kotlin-value Paint Align RIGHT)) + (extern (bhvColorWhite) : Int32 (kotlin-value Color WHITE)) + (extern (bhvColorRgb (r : Int32) (g : Int32) (b : Int32)) : Int32 + (kotlin-call Color rgb)) + (extern (bhvPaintColorSet (paint : Paint) (value : Int32)) : Unit + (kotlin-member-set color)) + (extern (bhvPaintStyleSet (paint : Paint) (value : PaintStyle)) : Unit + (kotlin-member-set style)) + (extern (bhvPaintStrokeWidthSet (paint : Paint) (value : Float32)) : Unit + (kotlin-member-set strokeWidth)) + (extern (bhvPaintTextSizeSet (paint : Paint) (value : Float32)) : Unit + (kotlin-member-set textSize)) + (extern (bhvPaintFakeBoldSet (paint : Paint) (value : Bool)) : Unit + (kotlin-member-set isFakeBoldText)) + (extern (bhvPaintTextAlignSet (paint : Paint) (value : PaintAlign)) : Unit + (kotlin-member-set textAlign)) + (extern (bhvPaintMeasureText (paint : Paint) (text : String)) : Float32 + (kotlin-member-call measureText)) + (extern (bhvCanvasSave (canvas : Canvas)) : Int32 (kotlin-member-call save)) + (extern (bhvCanvasScale (canvas : Canvas) (x : Float32) (y : Float32)) : Unit + (kotlin-member-call scale)) + (extern (bhvCanvasRestoreToCount (canvas : Canvas) (state : Int32)) : Unit + (kotlin-member-call restoreToCount)) + (extern (bhvCanvasDrawRoundRect (canvas : Canvas) (rect : RectF) + (rx : Float32) (ry : Float32) + (paint : Paint)) : Unit + (kotlin-member-call drawRoundRect)) + (extern (bhvCanvasDrawText (canvas : Canvas) (text : String) + (x : Float32) (y : Float32) + (paint : Paint)) : Unit + (kotlin-member-call drawText)) + (extern (bhvCanvasDrawRect (canvas : Canvas) (left : Float32) + (top : Float32) (right : Float32) + (bottom : Float32) (paint : Paint)) : Unit + (kotlin-member-call drawRect)) + (extern (bhvViewInvalidate (view : BridgeHudView)) : Unit + (kotlin-member-call invalidate)) + (extern (bhvViewWidth (view : BridgeHudView)) : Int32 (kotlin-member-get width)) + (extern (bhvViewHeight (view : BridgeHudView)) : Int32 (kotlin-member-get height)) + (extern (bhvViewResources (view : BridgeHudView)) : Resources + (kotlin-member-get resources)) + (extern (bhvResourcesDisplayMetrics (resources : Resources)) : DisplayMetrics + (kotlin-member-get displayMetrics)) + (extern (bhvDisplayMetricsDensity (metrics : DisplayMetrics)) : Float32 + (kotlin-member-get density)) + (extern (bhvSuperOnDraw (canvas : Canvas)) : Unit (kotlin-call super onDraw)) + (extern (bhvRectLeft (rect : RectF)) : Float32 (kotlin-member-get left)) + (extern (bhvRectTop (rect : RectF)) : Float32 (kotlin-member-get top)) + (extern (bhvRectRight (rect : RectF)) : Float32 (kotlin-member-get right)) + (extern (bhvRectBottom (rect : RectF)) : Float32 (kotlin-member-get bottom)) + (extern (bhvRectWidth (rect : RectF)) : Float32 (kotlin-member-call width)) + (extern (bhvRectHeight (rect : RectF)) : Float32 (kotlin-member-call height)) + (extern (bhvRectCenterX (rect : RectF)) : Float32 (kotlin-member-call centerX)) + (extern (bhvAsJsonObject (value : Any)) : (Nullable JSONObject) + (kotlin-safe-cast JSONObject)) + (extern (bhvAsJsonArray (value : Any)) : (Nullable JSONArray) + (kotlin-safe-cast JSONArray)) + (extern (bhvAsNumber (value : Any)) : (Nullable Number) + (kotlin-safe-cast Number)) + (extern (bhvAsString (value : Any)) : (Nullable String) + (kotlin-safe-cast String)) + (extern (bhvNumberToInt32 (value : Number)) : Int32 + (kotlin-member-call toInt)) + (extern (bhvAnyToString (value : Any)) : String + (kotlin-member-call toString)) + (extern (bhvJsonKeys (json : JSONObject)) : (Iterator String) + (kotlin-member-call keys)) + (extern (bhvIteratorHasNext (items : (Iterator String))) : Bool + (kotlin-member-call hasNext)) + (extern (bhvIteratorNext (items : (Iterator String))) : String + (kotlin-member-call next)) + (extern (bhvStringReplace (text : String) (old : String) + (replacement : String)) : String + (kotlin-member-call replace)) + (extern (bhvCurrentBattleRange (battle : (Nullable JSONObject))) : String + (kotlin-call currentBattleRange)) + (extern (bhvShipDisplayLabel (ship : (Nullable JSONObject)) + (fallback : String)) : String + (kotlin-call shipDisplayLabel)) + (extern (bhvShipTechnicalLabel (ship : (Nullable JSONObject)) + (fallback : String)) : String + (kotlin-call shipTechnicalLabel)) + + (def (bhvConfigurePaint (paint : Paint) (color : Int32) + (style : PaintStyle) (stroke : Float32)) : Paint + (begin + (bhvPaintColorSet paint color) + (bhvPaintStyleSet paint style) + (bhvPaintStrokeWidthSet paint stroke) + paint)) + (def (bhvConfigureTextPaint (paint : Paint) (color : Int32) + (size : Float32) (bold : Bool)) : Paint + (begin + (bhvPaintColorSet paint color) + (bhvPaintTextSizeSet paint size) + (bhvPaintFakeBoldSet paint bold) + paint)) + (def (bhvMaxFloat (a : Float32) (b : Float32)) : Float32 (if (> a b) a b)) + (def (bhvMinFloat (a : Float32) (b : Float32)) : Float32 (if (< a b) a b)) + (def (bhvMaxInt (a : Int32) (b : Int32)) : Int32 (if (> a b) a b)) + (def (bhvClampFloat (value : Float32) (low : Float32) + (high : Float32)) : Float32 + (bhvMinFloat high (bhvMaxFloat low value))) + (def (bhvRect (left : Float32) (top : Float32) + (right : Float32) (bottom : Float32)) : RectF