Complete typed tactical map view
ober
8754f642a7fdc86187fffbd64de6ec0d3d256dfd
--- a/templates/original-tactics-parts/TacticalMapView.kt.ss +++ b/templates/original-tactics-parts/TacticalMapView.kt.ss @@ -28,7 +28,8 @@ (org json JSONArray) (org json JSONObject)) (typed-library (com jerboa originaltactics) - (export make-TacticalPoint TacticalPoint? + (export TacticalMapView + make-TacticalPoint TacticalPoint? make-TacticalShipPose TacticalShipPose? make-TacticalFireSolution TacticalFireSolution? make-TacticalArcFan TacticalArcFan? @@ -71,6 +72,10 @@ (type JSONArray) (type JSONObject) (type Number) + (type FloatArray) + (type ProjectedHelmPose) + (type ProjectedHelmMove) + (type ProjectedRangePoint) (record TacticalPoint ((x : Float32) @@ -134,6 +139,217 @@ (kotlin-call kotlin math cos)) (extern (tmvPi) : Float (kotlin-value kotlin math PI)) + (extern (tmvPaintAntiAliasFlag) : Int32 + (kotlin-value Paint ANTI_ALIAS_FLAG)) + (extern (tmvPaintStyleFill) : Style + (kotlin-value Paint Style FILL)) + (extern (tmvPaintStyleStroke) : Style + (kotlin-value Paint Style STROKE)) + (extern (tmvPaintAlignLeft) : Align + (kotlin-value Paint Align LEFT)) + (extern (tmvPaintAlignCenter) : Align + (kotlin-value Paint Align CENTER)) + (extern (tmvPaintCapRound) : Cap + (kotlin-value Paint Cap ROUND)) + (extern (tmvPaintJoinRound) : Join + (kotlin-value Paint Join ROUND)) + (extern (tmvColorWhite) : Int32 + (kotlin-value Color WHITE)) + (extern (tmvColorRgb (red : Int32) (green : Int32) + (blue : Int32)) : Int32 + (kotlin-call Color rgb)) + (extern (tmvColorArgb (alpha : Int32) (red : Int32) + (green : Int32) (blue : Int32)) : Int32 + (kotlin-call Color argb)) + (extern (tmvColorRed (color : Int32)) : Int32 (kotlin-call Color red)) + (extern (tmvColorGreen (color : Int32)) : Int32 (kotlin-call Color green)) + (extern (tmvColorBlue (color : Int32)) : Int32 (kotlin-call Color blue)) + (extern (tmvPaintColorSet (paint : Paint) (value : Int32)) : Unit + (kotlin-member-set color)) + (extern (tmvPaintStyleSet (paint : Paint) (value : Style)) : Unit + (kotlin-member-set style)) + (extern (tmvPaintStrokeWidthSet (paint : Paint) + (value : Float32)) : Unit + (kotlin-member-set strokeWidth)) + (extern (tmvPaintStrokeCapSet (paint : Paint) (value : Cap)) : Unit + (kotlin-member-set strokeCap)) + (extern (tmvPaintStrokeJoinSet (paint : Paint) (value : Join)) : Unit + (kotlin-member-set strokeJoin)) + (extern (tmvPaintTextSizeSet (paint : Paint) + (value : Float32)) : Unit + (kotlin-member-set textSize)) + (extern (tmvPaintFakeBoldSet (paint : Paint) (value : Bool)) : Unit + (kotlin-member-set isFakeBoldText)) + (extern (tmvPaintTextAlignSet (paint : Paint) (value : Align)) : Unit + (kotlin-member-set textAlign)) + (extern (tmvPaintPathEffectSet (paint : Paint) + (value : (Nullable DashPathEffect))) : Unit + (kotlin-member-set pathEffect)) + (extern (tmvPaintAlphaSet (paint : Paint) (value : Int32)) : Unit + (kotlin-member-set alpha)) + (extern (tmvPaintMeasureText (paint : Paint) + (value : String)) : Float32 + (kotlin-member-call measureText)) + (extern (tmvCanvasSave (canvas : Canvas)) : Int32 + (kotlin-member-call save)) + (extern (tmvCanvasRestoreToCount (canvas : Canvas) + (state : Int32)) : Unit + (kotlin-member-call restoreToCount)) + (extern (tmvCanvasScale (canvas : Canvas) (x : Float32) + (y : Float32)) : Unit + (kotlin-member-call scale)) + (extern (tmvCanvasTranslate (canvas : Canvas) (x : Float32) + (y : Float32)) : Unit + (kotlin-member-call translate)) + (extern (tmvCanvasRotate (canvas : Canvas) (degrees : Float32)) : Unit + (kotlin-member-call rotate)) + (extern (tmvCanvasDrawRect (canvas : Canvas) (left : Float32) + (top : Float32) (right : Float32) + (bottom : Float32) (paint : Paint)) : Unit + (kotlin-member-call drawRect)) + (extern (tmvCanvasDrawRoundRect (canvas : Canvas) (rect : RectF) + (rx : Float32) (ry : Float32) + (paint : Paint)) : Unit + (kotlin-member-call drawRoundRect)) + (extern (tmvCanvasDrawLine (canvas : Canvas) (x1 : Float32) + (y1 : Float32) (x2 : Float32) + (y2 : Float32) (paint : Paint)) : Unit + (kotlin-member-call drawLine)) + (extern (tmvCanvasDrawCircle (canvas : Canvas) (x : Float32) + (y : Float32) (radius : Float32) + (paint : Paint)) : Unit + (kotlin-member-call drawCircle)) + (extern (tmvCanvasDrawText (canvas : Canvas) (value : String) + (x : Float32) (y : Float32) + (paint : Paint)) : Unit + (kotlin-member-call drawText)) + (extern (tmvCanvasDrawPath (canvas : Canvas) (path : Path) + (paint : Paint)) : Unit + (kotlin-member-call drawPath)) + (extern (tmvCanvasDrawArc (canvas : Canvas) (rect : RectF) + (startAngle : Float32) (sweep : Float32) + (useCenter : Bool) (paint : Paint)) : Unit + (kotlin-member-call drawArc)) + (extern (tmvPathMoveTo (path : Path) (x : Float32) + (y : Float32)) : Unit + (kotlin-member-call moveTo)) + (extern (tmvPathLineTo (path : Path) (x : Float32) + (y : Float32)) : Unit + (kotlin-member-call lineTo)) + (extern (tmvPathClose (path : Path)) : Unit + (kotlin-member-call close)) + (extern (tmvPathReset (path : Path)) : Unit + (kotlin-member-call reset)) + (extern (tmvPathArcTo (path : Path) (rect : RectF) + (startAngle : Float32) (sweep : Float32)) : Unit + (kotlin-member-call arcTo)) + (extern (tmvViewInvalidate (view : TacticalMapView)) : Unit + (kotlin-member-call invalidate)) + (extern (tmvViewWidth (view : TacticalMapView)) : Int32 + (kotlin-member-get width)) + (extern (tmvViewHeight (view : TacticalMapView)) : Int32 + (kotlin-member-get height)) + (extern (tmvViewResources (view : TacticalMapView)) : Resources + (kotlin-member-get resources)) + (extern (tmvResourcesDisplayMetrics (resources : Resources)) : DisplayMetrics + (kotlin-member-get displayMetrics)) + (extern (tmvDisplayMetricsDensity (metrics : DisplayMetrics)) : Float32 + (kotlin-member-get density)) + (extern (tmvRectWidth (rect : RectF)) : Float32 + (kotlin-member-call width)) + (extern (tmvStringUppercase (value : String)) : String + (kotlin-member-call uppercase)) + (extern (tmvStringLowercase (value : String)) : String + (kotlin-member-call lowercase)) + (extern (tmvStringReplace (value : String) (old : String) + (replacement : String)) : String + (kotlin-member-call replace)) + (extern (tmvStringTrim (value : String)) : String + (kotlin-member-call trim)) + (extern (tmvStringContains (value : String) (part : String)) : Bool + (kotlin-member-call contains)) + (extern (tmvStringEquals (value : String) (other : String)) : Bool + (kotlin-member-call equals)) + (extern (tmvMakeScaleDetector + (context : Context) + (listener : SimpleOnScaleGestureListener)) : ScaleGestureDetector + (kotlin-call ScaleGestureDetector)) + (extern (tmvScaleFactor (detector : ScaleGestureDetector)) : Float32 + (kotlin-member-get scaleFactor)) + (extern (tmvScaleOnTouchEvent (detector : ScaleGestureDetector) + (event : MotionEvent)) : Bool + (kotlin-member-call onTouchEvent)) + (extern (tmvScaleIsInProgress (detector : ScaleGestureDetector)) : Bool + (kotlin-member-get isInProgress)) + (extern (tmvMotionActionMasked (event : MotionEvent)) : Int32 + (kotlin-member-get actionMasked)) + (extern (tmvMotionX (event : MotionEvent)) : Float32 + (kotlin-member-get x)) + (extern (tmvMotionY (event : MotionEvent)) : Float32 + (kotlin-member-get y)) + (extern (tmvMotionPointerCount (event : MotionEvent)) : Int32 + (kotlin-member-get pointerCount)) + (extern (tmvMotionActionDown) : Int32 + (kotlin-value MotionEvent ACTION_DOWN)) + (extern (tmvMotionActionMove) : Int32 + (kotlin-value MotionEvent ACTION_MOVE)) + (extern (tmvMotionActionUp) : Int32 + (kotlin-value MotionEvent ACTION_UP)) + (extern (tmvMotionActionCancel) : Int32 + (kotlin-value MotionEvent ACTION_CANCEL)) + (extern (tmvViewParent (view : TacticalMapView)) : ViewParent + (kotlin-member-get parent)) + (extern (tmvParentDisallowIntercept (parent : ViewParent) + (disallow : Bool)) : Unit + (kotlin-member-call requestDisallowInterceptTouchEvent)) + (extern (tmvSuperOnDraw (canvas : Canvas)) : Unit + (kotlin-call super onDraw)) + (extern (tmvUptimeMillis) : Int + (kotlin-call SystemClock uptimeMillis)) + (extern (tmvManeuverMapFromJson + (raw : (Nullable Any))) : (MutableMap Int32 String) + (kotlin-call maneuverMapFromJson)) + (extern (tmvProjectedHelmMoves + (position : (Nullable JSONObject)) + (maneuvers : (Map Int32 String)) + (currentImpulse : Int32) + (maxMoves : Int32)) : (MutableList ProjectedHelmMove) + (kotlin-call projectedHelmMoves)) + (extern (tmvProjectedRangeForecast + (alphaPosition : (Nullable JSONObject)) + (betaPosition : (Nullable JSONObject)) + (alphaManeuvers : (Nullable Any)) + (betaManeuvers : (Nullable Any)) + (currentImpulse : Int32) + (maxMoves : Int32) + (labelLimit : Int32)) : (MutableList ProjectedRangePoint) + (kotlin-call projectedRangeForecast)) + (extern (tmvProjectedMoveImpulse (move : ProjectedHelmMove)) : Int32 + (kotlin-member-get impulse)) + (extern (tmvProjectedMoveManeuver + (move : ProjectedHelmMove)) : (Nullable String) + (kotlin-member-get maneuver)) + (extern (tmvProjectedMovePose (move : ProjectedHelmMove)) : ProjectedHelmPose + (kotlin-member-get pose)) + (extern (tmvProjectedPoseQ (pose : ProjectedHelmPose)) : Int32 + (kotlin-member-get q)) + (extern (tmvProjectedPoseR (pose : ProjectedHelmPose)) : Int32 + (kotlin-member-get r)) + (extern (tmvProjectedPoseFacing (pose : ProjectedHelmPose)) : Int32 + (kotlin-member-get facing)) + (extern (tmvProjectedRangeImpulse (point : ProjectedRangePoint)) : Int32 + (kotlin-member-get impulse)) + (extern (tmvProjectedRangeValue (point : ProjectedRangePoint)) : Int32 + (kotlin-member-get range)) + (extern (tmvManeuverAbbreviation (maneuver : String)) : String + (kotlin-call maneuverAbbreviation)) + (extern (tmvShipDisplayLabel (ship : (Nullable JSONObject))) : String + (kotlin-call shipDisplayLabel)) + (extern (tmvCurrentBattleRange (battle : (Nullable JSONObject))) : String + (kotlin-call currentBattleRange)) + (extern (tmvScaleBy (view : TacticalMapView) + (factor : Float32)) : Unit + (kotlin-member-call scaleBy)) (def (tmvMaxInt (left : Int32) (right : Int32)) : Int32 (if (> left right) left right)) @@ -169,6 +385,36 @@ (if (nullable-null? value) fallback (tmvAnyToString (nullable-get value)))) + (def (tmvConfigurePaint (paint : Paint) (color : Int32) + (style : Style) (strokeWidth : Float32) + (roundCap : Bool) (roundJoin : Bool)) : Paint + (begin + (tmvPaintColorSet paint color) + (tmvPaintStyleSet paint style) + (tmvPaintStrokeWidthSet paint strokeWidth) + (if roundCap (tmvPaintStrokeCapSet paint (tmvPaintCapRound)) (begin)) + (if roundJoin (tmvPaintStrokeJoinSet paint (tmvPaintJoinRound)) (begin)) + paint)) + (def (tmvConfigureTextPaint (paint : Paint) (color : Int32) + (size : Float32) (bold : Bool) + (centered : Bool)) : Paint + (begin + (tmvPaintColorSet paint color) + (tmvPaintTextSizeSet paint size) + (tmvPaintFakeBoldSet paint bold) + (if centered + (tmvPaintTextAlignSet paint (tmvPaintAlignCenter)) + (tmvPaintTextAlignSet paint (tmvPaintAlignLeft))) + paint)) + (def (tmvConfigureDashPaint (paint : Paint) (first : Float32) + (second : Float32)) : Paint + (begin + (tmvPaintPathEffectSet + paint + (nullable-some + (new DashPathEffect + (float-array first second) (float32 0.0)))) + paint)) (def (tmvRawHexPointInt (q : Int32) (r : Int32)) : TacticalPoint (tmvRawHexPoint (float32 q) (float32 r))) @@ -243,4 +489,1382 @@ (TacticalShipPose-r (nullable-get end)) progress) (tmvLerpFacing (TacticalShipPose-facing (nullable-get start)) - (TacticalShipPose-facing (nullable-get end)) progress))))))))) + (TacticalShipPose-facing (nullable-get end)) progress))))) + + (def (tmvObjectField (json : (Nullable JSONObject)) + (key : String)) : (Nullable JSONObject) + (if (nullable-null? json) + (nullable-none JSONObject) + (json-object-opt-json-object (nullable-get json) key))) + (def (tmvAnyField (json : (Nullable JSONObject)) + (key : String)) : (Nullable Any) + (if (nullable-null? json) + (nullable-none Any) + (json-object-opt-any (nullable-get json) key))) + (def (tmvPoseField (json : (Nullable JSONObject)) + (key : String)) : (Nullable TacticalShipPose) + (let ((position (tmvObjectField json key))) + (if (nullable-null? position) + (nullable-none TacticalShipPose) + (nullable-some (tmvPoseFrom (nullable-get position)))))) + (def (tmvMakeScaleListener + (view : TacticalMapView)) : SimpleOnScaleGestureListener + (object (new SimpleOnScaleGestureListener) + (override (onScale (detector : ScaleGestureDetector)) : Bool + (begin + (tmvScaleBy view (tmvScaleFactor detector)) + #t)))) + (def (tmvMakeScaleDetectorFor + (context : Context) (view : TacticalMapView)) : ScaleGestureDetector + (tmvMakeScaleDetector context (tmvMakeScaleListener view))) + + (class TacticalMapView ((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 tacticalDashboard : (Nullable JSONObject) (nullable-none JSONObject) + (modifiers private)) + (var drawWidth : Float32 (float32 0.0) (modifiers private)) + (var drawHeight : Float32 (float32 0.0) (modifiers private)) + (var userScale : Float32 (float32 1.0) (modifiers private)) + (var userPanX : Float32 (float32 0.0) (modifiers private)) + (var userPanY : Float32 (float32 0.0) (modifiers private)) + (var lastTouchX : Float32 (float32 0.0) (modifiers private)) + (var lastTouchY : Float32 (float32 0.0) (modifiers private)) + (var movementProgress : Float32 (float32 1.0) (modifiers private)) + (var movementStartedAt : Int (int 0) (modifiers private)) + (var alphaMoveStart : (Nullable TacticalShipPose) + (nullable-none TacticalShipPose) (modifiers private)) + (var alphaMoveEnd : (Nullable TacticalShipPose) + (nullable-none TacticalShipPose) (modifiers private)) + (var betaMoveStart : (Nullable TacticalShipPose) + (nullable-none TacticalShipPose) (modifiers private)) + (var betaMoveEnd : (Nullable TacticalShipPose) + (nullable-none TacticalShipPose) (modifiers private)) + (var impactStartedAt : Int (int 0) (modifiers private)) + (var alphaImpactDamage : Int32 (int32 0) (modifiers private)) + (var betaImpactDamage : Int32 (int32 0) (modifiers private)) + (var alphaImpactShieldDamage : Int32 (int32 0) (modifiers private)) + (var betaImpactShieldDamage : Int32 (int32 0) (modifiers private)) + (var alphaImpactInternalDamage : Int32 (int32 0) (modifiers private)) + (var betaImpactInternalDamage : Int32 (int32 0) (modifiers private)) + (val scaleDetector : ScaleGestureDetector + (tmvMakeScaleDetectorFor context this) (modifiers private)) + + (val backgroundPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 247) (int32 249) (int32 252)) + (tmvPaintStyleFill) (float32 0.0) #f #f) (modifiers private)) + (val gridPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 201) (int32 210) (int32 222)) + (tmvPaintStyleStroke) (float32 1.5) #f #f) (modifiers private)) + (val strongGridPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 117) (int32 131) (int32 153)) + (tmvPaintStyleStroke) (float32 2.5) #f #f) (modifiers private)) + (val rangePaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 77) (int32 93) (int32 121)) + (tmvPaintStyleStroke) (float32 4.0) #f #f) (modifiers private)) + (val dashPaint : Paint + (tmvConfigureDashPaint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorArgb (int32 145) (int32 68) (int32 82) (int32 105)) + (tmvPaintStyleStroke) (float32 4.0) #t #t) + (float32 10.0) (float32 10.0)) (modifiers private)) + (val alphaPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 21) (int32 96) (int32 189)) + (tmvPaintStyleFill) (float32 0.0) #f #f) (modifiers private)) + (val betaPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 184) (int32 67) (int32 54)) + (tmvPaintStyleFill) (float32 0.0) #f #f) (modifiers private)) + (val greenPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 70) (int32 167) (int32 106)) + (tmvPaintStyleStroke) (float32 5.0) #t #f) (modifiers private)) + (val orangePaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 215) (int32 131) (int32 39)) + (tmvPaintStyleFill) (float32 0.0) #f #f) (modifiers private)) + (val purplePaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 106) (int32 83) (int32 168)) + (tmvPaintStyleFill) (float32 0.0) #f #f) (modifiers private)) + (val cyanPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 63) (int32 164) (int32 210)) + (tmvPaintStyleStroke) (float32 5.0) #t #f) (modifiers private)) + (val redPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 200) (int32 57) (int32 68)) + (tmvPaintStyleFill) (float32 0.0) #f #f) (modifiers private)) + (val whiteStrokePaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorWhite) (tmvPaintStyleStroke) (float32 4.0) #t #t) + (modifiers private)) + (val detailPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorArgb (int32 185) (int32 255) (int32 255) (int32 255)) + (tmvPaintStyleStroke) (float32 2.5) #t #t) (modifiers private)) + (val pillPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorArgb (int32 220) (int32 255) (int32 255) (int32 255)) + (tmvPaintStyleFill) (float32 0.0) #f #f) (modifiers private)) + (val panelPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorArgb (int32 218) (int32 14) (int32 22) (int32 34)) + (tmvPaintStyleFill) (float32 0.0) #f #f) (modifiers private)) + (val panelBorderPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorArgb (int32 190) (int32 92) (int32 116) (int32 150)) + (tmvPaintStyleStroke) (float32 2.0) #f #f) (modifiers private)) + (val impactPaint : Paint + (tmvConfigurePaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 245) (int32 185) (int32 60)) + (tmvPaintStyleStroke) (float32 8.0) #f #f) (modifiers private)) + (val titlePaint : Paint + (tmvConfigureTextPaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 28) (int32 35) (int32 48)) + (float32 31.0) #t #f) (modifiers private)) + (val textPaint : Paint + (tmvConfigureTextPaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 49) (int32 58) (int32 73)) + (float32 18.0) #f #f) (modifiers private)) + (val centeredPaint : Paint + (tmvConfigureTextPaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorRgb (int32 28) (int32 35) (int32 48)) + (float32 17.0) #t #t) (modifiers private)) + (val whiteTextPaint : Paint + (tmvConfigureTextPaint (new Paint (tmvPaintAntiAliasFlag)) + (tmvColorWhite) (float32 15.0) #t #t) (modifiers private)) + + (def (scaleBy (factor : Float32)) : Unit + (begin + (set! userScale + (tmvClampFloat (* userScale factor) (float32 0.6) (float32 2.8))) + (tmvViewInvalidate this))) + (def (setGame (nextGame : (Nullable JSONObject)) + (nextEvents : JSONArray (default (new JSONArray)))) : Unit + (let ((previousBattle (tmvObjectField game "battle-state")) + (nextBattle (tmvObjectField nextGame "battle-state"))) + (let ((previousAlpha (tmvPoseField previousBattle "alpha-position")) + (previousBeta (tmvPoseField previousBattle "beta-position")) + (nextAlpha (tmvPoseField nextBattle "alpha-position")) + (nextBeta (tmvPoseField nextBattle "beta-position"))) + (begin + (set! game nextGame) + (set! events nextEvents) + (if (nullable-null? nextGame) + (begin + (set! events (new JSONArray)) + (set! tacticalStatus (nullable-none JSONObject)) + (set! tacticalDashboard (nullable-none JSONObject)) + (finishMovementAnimation) + (clearImpactPulse) + (resetView)) + (begin + (if (and (not (nullable-null? previousAlpha)) + (and (not (nullable-null? previousBeta)) + (and (not (nullable-null? nextAlpha)) + (not (nullable-null? nextBeta))))) + (if (or (tmvPoseChanged (nullable-get previousAlpha) + (nullable-get nextAlpha)) + (tmvPoseChanged (nullable-get previousBeta) + (nullable-get nextBeta))) + (startMovementAnimation + (nullable-get previousAlpha) (nullable-get nextAlpha) + (nullable-get previousBeta) (nullable-get nextBeta)) + (finishMovementAnimation)) + (finishMovementAnimation)) + (updateImpactPulse nextEvents) + (tmvViewInvalidate this))))))) + (def (setTacticalStatus + (nextStatus : (Nullable JSONObject))) : Unit + (begin (set! tacticalStatus nextStatus) (tmvViewInvalidate this))) + (def (setTacticalDashboard + (nextDashboard : (Nullable JSONObject))) : Unit + (begin + (set! tacticalDashboard nextDashboard) + (let ((status (tmvObjectField nextDashboard "status"))) + (if (nullable-null? status) (begin) (set! tacticalStatus status))) + (tmvViewInvalidate this))) + (def (resetView) : Unit + (begin + (set! userScale (float32 1.0)) + (set! userPanX (float32 0.0)) + (set! userPanY (float32 0.0)) + (tmvViewInvalidate this))) + (def (onTouchEvent (event : MotionEvent)) : Bool + (modifiers override) + (begin + (tmvParentDisallowIntercept (tmvViewParent this) #t) + (tmvScaleOnTouchEvent scaleDetector event) + (let ((action (tmvMotionActionMasked event))) + (if (= action (tmvMotionActionDown)) + (begin + (set! lastTouchX (tmvMotionX event)) + (set! lastTouchY (tmvMotionY event))) + (if (= action (tmvMotionActionMove)) + (if (and (not (tmvScaleIsInProgress scaleDetector)) + (= (tmvMotionPointerCount event) (int32 1))) + (let ((density (densityScale))) + (begin + (set! userPanX + (+ userPanX (/ (- (tmvMotionX event) lastTouchX) + density))) + (set! userPanY + (+ userPanY (/ (- (tmvMotionY event) lastTouchY) + density))) + (set! lastTouchX (tmvMotionX event)) + (set! lastTouchY (tmvMotionY event)) + (tmvViewInvalidate this))) + (begin)) + (if (or (= action (tmvMotionActionUp)) + (= action (tmvMotionActionCancel))) + (tmvParentDisallowIntercept (tmvViewParent this) #f) + (begin)))) + #t))) + (def (onDraw (canvas : Canvas)) : Unit + (modifiers override) + (begin + (tmvSuperOnDraw canvas) + (updateAnimationProgress) + (let ((state (tmvCanvasSave canvas)) + (density (densityScale))) + (begin + (set! drawWidth (/ (float32 (tmvViewWidth this)) density)) + (set! drawHeight (/ (float32 (tmvViewHeight this)) density)) + (tmvCanvasScale canvas density density) + (drawContent canvas) + (tmvCanvasRestoreToCount canvas state))))) + (def (densityScale) : Float32 + (modifiers private) + (tmvMaxFloat + (tmvDisplayMetricsDensity + (tmvResourcesDisplayMetrics (tmvViewResources this))) + (float32 1.0))) + (def (updateAnimationProgress) : Unit + (modifiers private) + (if (= movementStartedAt (int 0)) + (begin) + (let ((elapsed (- (tmvUptimeMillis) movementStartedAt))) + (begin + (set! movementProgress + (tmvClampFloat (/ (float32 elapsed) (float32 420.0)) + (float32 0.0) (float32 1.0))) + (if (< movementProgress (float32 1.0)) + (tmvViewInvalidate this) + (finishMovementAnimation)))))) + (def (startMovementAnimation + (alphaStart : TacticalShipPose) (alphaEnd : TacticalShipPose) + (betaStart : TacticalShipPose) (betaEnd : TacticalShipPose)) : Unit + (begin + (set! alphaMoveStart (nullable-some alphaStart)) + (set! alphaMoveEnd (nullable-some alphaEnd)) + (set! betaMoveStart (nullable-some betaStart)) + (set! betaMoveEnd (nullable-some betaEnd)) + (set! movementProgress (float32 0.0)) + (set! movementStartedAt (tmvUptimeMillis)) + (tmvViewInvalidate this))) + (def (finishMovementAnimation) : Unit + (begin + (set! alphaMoveStart (nullable-none TacticalShipPose)) + (set! alphaMoveEnd (nullable-none TacticalShipPose)) + (set! betaMoveStart (nullable-none TacticalShipPose)) + (set! betaMoveEnd (nullable-none TacticalShipPose)) + (set! movementProgress (float32 1.0)) + (set! movementStartedAt (int 0)))) + + (def (drawContent (canvas : Canvas)) : Unit + (modifiers private) + (begin + (tmvCanvasDrawRect canvas (float32 0.0) (float32 0.0) + drawWidth drawHeight backgroundPaint) + (let ((battle (tmvObjectField game "battle-state"))) + (if (nullable-null? battle) + (drawEmptyState canvas) + (let ((alphaPosition + (json-object-opt-json-object + (nullable-get battle) "alpha-position")) + (betaPosition + (json-object-opt-json-object + (nullable-get battle) "beta-position"))) + (if (or (nullable-null? alphaPosition) + (nullable-null? betaPosition)) + (drawEmptyState canvas) + (drawBattle canvas (nullable-get battle) + (nullable-get alphaPosition) + (nullable-get betaPosition)))))))) + + (def (drawEmptyState (canvas : Canvas)) : Unit + (modifiers private) + (begin + (tmvPaintTextAlignSet titlePaint (tmvPaintAlignCenter)) + (tmvCanvasDrawText canvas "No active combat" + (/ drawWidth (float32 2.0)) + (- (/ drawHeight (float32 2.0)) (float32 12.0)) titlePaint) + (tmvPaintTextAlignSet textPaint (tmvPaintAlignCenter)) + (tmvCanvasDrawText canvas "Create or restore a game" + (/ drawWidth (float32 2.0)) + (+ (/ drawHeight (float32 2.0)) (float32 24.0)) textPaint))) + + (def (drawBattle (canvas : Canvas) (battle : JSONObject) + (alphaPosition : JSONObject) + (betaPosition : JSONObject)) : Unit + (modifiers private) + (let ((alphaPose + (tmvAnimatedPose (tmvPoseFrom alphaPosition) + alphaMoveStart alphaMoveEnd movementProgress)) + (betaPose + (tmvAnimatedPose (tmvPoseFrom betaPosition) + betaMoveStart betaMoveEnd movementProgress)) + (orders (tmvObjectField game "orders")) + (impulse + (if (nullable-null? game) (int32 0) + (json-object-opt-int32-default + (nullable-get game) "impulse" (int32 0))))) + (let ((alphaProjected + (tmvProjectedHelmMoves (nullable-some alphaPosition) + (tmvManeuverMapFromJson + (tmvAnyField orders "alpha-maneuvers")) + impulse (int32 8))) + (betaProjected + (tmvProjectedHelmMoves (nullable-some betaPosition) + (tmvManeuverMapFromJson + (tmvAnyField orders "beta-maneuvers")) + impulse (int32 8)))) + (let ((transform + (mapTransform alphaPose betaPose + alphaProjected betaProjected))) + (let ((alphaPoint + (tmvTransformPoint transform + (TacticalShipPose-q alphaPose) + (TacticalShipPose-r alphaPose))) + (betaPoint + (tmvTransformPoint transform + (TacticalShipPose-q betaPose) + (TacticalShipPose-r betaPose)))) + (begin + (drawGrid canvas transform alphaPosition betaPosition + alphaProjected betaProjected) + (drawTerrain canvas transform battle) + (drawRangeBands canvas alphaPoint transform (int32 -1)) + (drawRangeBands canvas betaPoint transform (int32 1)) + (drawRecentMovementWakes canvas transform) + (tmvCanvasDrawLine canvas + (TacticalPoint-x alphaPoint) (TacticalPoint-y alphaPoint) + (TacticalPoint-x betaPoint) (TacticalPoint-y betaPoint) + rangePaint) + (drawWeaponArcFans canvas transform alphaPose + (tmvObjectField tacticalStatus "alpha") + (tmvColorRgb (int32 21) (int32 96) (int32 189))) + (drawWeaponArcFans canvas transform betaPose + (tmvObjectField tacticalStatus "beta") + (tmvColorRgb (int32 184) (int32 67) (int32 54))) + (drawFireSolutions canvas alphaPoint betaPoint) + (drawMovementTrails canvas transform) + (drawProjectedHelmPlot canvas transform alphaProjected alphaPaint) + (drawProjectedHelmPlot canvas transform betaProjected betaPaint) + (drawProjectedRangeForecast canvas transform + alphaPosition betaPosition orders impulse) + (drawFireTargetLine canvas transform alphaPosition + (json-object-opt-json-object battle "alpha-fire-target") + alphaPaint) + (drawFireTargetLine canvas transform betaPosition + (json-object-opt-json-object battle "beta-fire-target") + betaPaint) + (drawSeekerTargetLines canvas transform battle) + (drawUnitCollection canvas transform + (json-object-opt-any battle "seeking-weapons") orangePaint "S") + (drawUnitCollection canvas transform + (json-object-opt-any battle "shuttles") purplePaint "U") + (drawShip canvas transform "ALPHA" alphaPose alphaPosition + (json-object-opt-json-object battle "alpha") alphaPaint + (int32 -1) + (shieldFacingIndex + (json-object-opt-any battle "alpha-shield-facing-hit"))) + (drawShip canvas transform "BETA" betaPose betaPosition + (json-object-opt-json-object battle "beta") betaPaint + (int32 1) + (shieldFacingIndex + (json-object-opt-any battle "beta-shield-facing-hit"))) + (drawImpactEffects canvas alphaPoint betaPoint) + (drawBlockedManeuverBadges canvas alphaPoint betaPoint) + (drawBattleBadge canvas battle) + (drawTerrainBadge canvas battle) + (drawTacticalOverlay canvas battle))))))) + + (def (mapTransform + (alpha : TacticalShipPose) (beta : TacticalShipPose) + (alphaProjected : (List ProjectedHelmMove)) + (betaProjected : (List ProjectedHelmMove))) : TacticalMapTransform + (modifiers private) + (let ((alphaRaw (tmvRawHexPoint + (TacticalShipPose-q alpha) (TacticalShipPose-r alpha))) + (betaRaw (tmvRawHexPoint + (TacticalShipPose-q beta) (TacticalShipPose-r beta)))) + (var ((minX (tmvMinFloat (TacticalPoint-x alphaRaw) + (TacticalPoint-x betaRaw))) + (maxX (tmvMaxFloat (TacticalPoint-x alphaRaw) + (TacticalPoint-x betaRaw))) + (minY (tmvMinFloat (TacticalPoint-y alphaRaw) + (TacticalPoint-y betaRaw))) + (maxY (tmvMaxFloat (TacticalPoint-y alphaRaw) + (TacticalPoint-y betaRaw)))) + (begin + (for/fold ((ignored (int32 0))) + ((index (in-range (int32 0) (list-size alphaProjected)))) + (let ((pose (tmvProjectedMovePose + (list-ref alphaProjected index)))) + (let ((point (tmvRawHexPointInt + (tmvProjectedPoseQ pose) + (tmvProjectedPoseR pose)))) + (begin + (set! minX (tmvMinFloat minX (TacticalPoint-x point))) + (set! maxX (tmvMaxFloat maxX (TacticalPoint-x point))) + (set! minY (tmvMinFloat minY (TacticalPoint-y point))) + (set! maxY (tmvMaxFloat maxY (TacticalPoint-y point))) + ignored)))) + (for/fold ((ignored (int32 0))) + ((index (in-range (int32 0) (list-size betaProjected)))) + (let ((pose (tmvProjectedMovePose + (list-ref betaProjected index)))) + (let ((point (tmvRawHexPointInt + (tmvProjectedPoseQ pose) + (tmvProjectedPoseR pose)))) + (begin + (set! minX (tmvMinFloat minX (TacticalPoint-x point))) + (set! maxX (tmvMaxFloat maxX (TacticalPoint-x point))) + (set! minY (tmvMinFloat minY (TacticalPoint-y point))) + (set! maxY (tmvMaxFloat maxY (TacticalPoint-y point))) + ignored)))) + (let ((spanX (tmvMaxFloat (float32 4.0) + (+ (- maxX minX) (float32 6.0)))) + (spanY (tmvMaxFloat (float32 4.0) + (+ (- maxY minY) (float32 5.0))))) + (let ((scale + (* (tmvClampFloat + (tmvMinFloat (/ drawWidth spanX) + (/ drawHeight spanY)) + (float32 16.0) (float32 64.0)) + userScale))) + (make-TacticalMapTransform scale + (make-TacticalPoint + (+ (- (/ drawWidth (float32 2.0)) + (* (/ (+ minX maxX) (float32 2.0)) scale)) + userPanX) + (+ (- (/ drawHeight (float32 2.0)) + (* (/ (+ minY maxY) (float32 2.0)) scale)) + userPanY))))))))) + + (def (drawGrid (canvas : Canvas) (transform : TacticalMapTransform) + (alphaPosition : JSONObject) (betaPosition : JSONObject) + (alphaProjected : (List ProjectedHelmMove)) + (betaProjected : (List ProjectedHelmMove))) : Int32 + (modifiers private) + (let ((centerQ + (/ (+ (json-object-opt-int32-default alphaPosition "q" (int32 0)) + (json-object-opt-int32-default betaPosition "q" (int32 0))) + (int32 2))) + (centerR + (/ (+ (json-object-opt-int32-default alphaPosition "r" (int32 0)) + (json-object-opt-int32-default betaPosition "r" (int32 0))) + (int32 2)))) + (for/fold ((ignored (int32 0))) + ((q (in-range (- centerQ (int32 15)) + (+ centerQ (int32 16))))) + (begin + (for/fold ((inner (int32 0))) + ((r (in-range (- centerR (int32 15)) + (+ centerR (int32 16))))) + (let ((point (tmvTransformPoint transform (float32 q) (float32 r)))) + (if (and (> (TacticalPoint-x point) (float32 -80.0)) + (and (< (TacticalPoint-x point) (+ drawWidth (float32 80.0))) + (and (> (TacticalPoint-y point) (float32 -80.0)) + (< (TacticalPoint-y point) + (+ drawHeight (float32 80.0)))))) + (begin + (drawHex canvas (TacticalPoint-x point) + (TacticalPoint-y point) + (TacticalMapTransform-scale transform) + (if (or (= q (int32 0)) (= r (int32 0))) + strongGridPaint gridPaint)) + inner) + inner))) + ignored)))) + (def (drawHex (canvas : Canvas) (cx : Float32) (cy : Float32) + (radius : Float32) (paint : Paint)) : Unit + (modifiers private) + (let ((path (new Path))) + (begin + (for/fold ((ignored (int32 0))) + ((index (in-range (int32 0) (int32 6)))) + (let ((angle (* (- (exact->inexact (* index (int32 60))) 30.0) + (/ (tmvPi) 180.0)))) + (let ((x (+ cx (float32 (* (tmvCos angle) + (exact->inexact radius))))) + (y (+ cy (float32 (* (tmvSin angle) + (exact->inexact radius)))))) + (begin + (if (= index (int32 0)) + (tmvPathMoveTo path x y) + (tmvPathLineTo path x y)) + ignored)))) + (tmvPathClose path) + (tmvCanvasDrawPath canvas path paint)))) + + (def (drawRangeBands (canvas : Canvas) (center : TacticalPoint) + (transform : TacticalMapTransform) + (side : Int32)) : Unit + (modifiers private) + (begin + (tmvPaintTextAlignSet centeredPaint (tmvPaintAlignCenter)) + (drawRangeBand canvas center transform (int32 4) side) + (drawRangeBand canvas center transform (int32 8) side) + (drawRangeBand canvas center transform (int32 15) side))) + (def (drawRangeBand (canvas : Canvas) (center : TacticalPoint) + (transform : TacticalMapTransform) + (range : Int32) (side : Int32)) : Unit + (modifiers private) + (let ((radius + (float32 (* (* (tmvSqrt 3.0) (exact->inexact range)) + (exact->inexact + (TacticalMapTransform-scale transform)))))) + (if (< radius (float32 18.0)) + (begin) + (begin + (tmvCanvasDrawCircle canvas (TacticalPoint-x center) + (TacticalPoint-y center) radius dashPaint) + (tmvCanvasDrawText canvas + (string-append "R" (int32->string range)) + (tmvClampFloat + (+ (TacticalPoint-x center) + (* (float32 side) (* radius (float32 0.70)))) + (float32 18.0) (- drawWidth (float32 18.0))) + (tmvClampFloat + (- (TacticalPoint-y center) (* radius (float32 0.70))) + (float32 20.0) (- drawHeight (float32 8.0))) + centeredPaint))))) + + (def (drawMovementTrails (canvas : Canvas) + (transform : TacticalMapTransform)) : Unit + (modifiers private) + (if (>= movementProgress (float32 1.0)) + (begin) + (begin + (drawMovementTrail canvas transform alphaMoveStart alphaMoveEnd) + (drawMovementTrail canvas transform betaMoveStart betaMoveEnd)))) + (def (drawMovementTrail (canvas : Canvas) + (transform : TacticalMapTransform) + (start : (Nullable TacticalShipPose)) + (end : (Nullable TacticalShipPose))) : Unit + (modifiers private) + (if (or (nullable-null? start) (nullable-null? end)) + (begin) + (let ((a (tmvTransformPoint transform + (TacticalShipPose-q (nullable-get start)) + (TacticalShipPose-r (nullable-get start)))) + (b (tmvTransformPoint transform + (TacticalShipPose-q (nullable-get end)) + (TacticalShipPose-r (nullable-get end))))) + (tmvCanvasDrawLine canvas + (TacticalPoint-x a) (TacticalPoint-y a) + (TacticalPoint-x b) (TacticalPoint-y b) dashPaint)))) + (def (drawRecentMovementWakes (canvas : Canvas) + (transform : TacticalMapTransform)) : Unit + (modifiers private) + (drawRecentMovementWakeAt canvas transform + (- (json-array-length events) (int32 1)) (int32 0))) + (def (drawRecentMovementWakeAt (canvas : Canvas) + (transform : TacticalMapTransform) + (index : Int32) (drawn : Int32)) : Unit + (modifiers private) + (if (or (< index (int32 0)) (>= drawn (int32 4))) + (begin) + (let ((event (json-array-opt-json-object events index))) + (if (nullable-null? event) + (drawRecentMovementWakeAt canvas transform + (- index (int32 1)) drawn) + (let ((payload + (json-object-opt-json-object + (nullable-get event) "payload"))) + (if (or (not (tmvStringEquals + (json-object-opt-string-default + (nullable-get event) "type" "") + "movement")) + (nullable-null? payload)) + (drawRecentMovementWakeAt canvas transform + (- index (int32 1)) drawn) + (let ((from (json-object-opt-json-object + (nullable-get payload) "from")) + (to (json-object-opt-json-object + (nullable-get payload) "to"))) + (begin + (if (or (nullable-null? from) (nullable-null? to)) + (begin) + (let ((a (tmvTransformPoint transform + (json-object-opt-float32-default + (nullable-get from) "q" (float32 0.0)) + (json-object-opt-float32-default + (nullable-get from) "r" (float32 0.0)))) + (b (tmvTransformPoint transform + (json-object-opt-float32-default + (nullable-get to) "q" (float32 0.0)) + (json-object-opt-float32-default + (nullable-get to) "r" (float32 0.0))))) + (tmvCanvasDrawLine canvas + (TacticalPoint-x a) (TacticalPoint-y a) + (TacticalPoint-x b) (TacticalPoint-y b) + dashPaint))) + (drawRecentMovementWakeAt canvas transform + (- index (int32 1)) (+ drawn (int32 1))))))))))) + + (def (drawProjectedHelmPlot (canvas : Canvas) + (transform : TacticalMapTransform) + (moves : (List ProjectedHelmMove)) + (paint : Paint)) : Int32 + (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))) + (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)))))))) + (def (drawFacingGuide (canvas : Canvas) (point : TacticalPoint) + (length : Float32) (angle : Float) + (paint : Paint)) : Unit + (modifiers private) + (tmvCanvasDrawLine canvas (TacticalPoint-x point) (TacticalPoint-y point) + (+ (TacticalPoint-x point) + (float32 (* (tmvCos angle) (exact->inexact length)))) + (+ (TacticalPoint-y point) + (float32 (* (tmvSin angle) (exact->inexact length)))) paint)) + (def (drawProjectedRangeForecast + (canvas : Canvas) (transform : TacticalMapTransform) + (alphaPosition : JSONObject) (betaPosition : JSONObject) + (orders : (Nullable JSONObject)) (impulse : Int32)) : Int32 + (modifiers private) + (let ((forecast + (tmvProjectedRangeForecast + (nullable-some alphaPosition) (nullable-some betaPosition) + (tmvAnyField orders "alpha-maneuvers") + (tmvAnyField orders "beta-maneuvers") + impulse (int32 8) (int32 5)))) + (for/fold ((ignored (int32 0))) + ((index (in-range (int32 0) (list-size forecast)))) + (let ((point (list-ref forecast index))) + (begin + (tmvCanvasDrawText canvas + (string-append "I" + (string-append + (int32->string (tmvProjectedRangeImpulse point)) + (string-append " R" + (int32->string (tmvProjectedRangeValue point))))) + (- drawWidth (float32 56.0)) + (+ (float32 72.0) (* (float32 index) (float32 21.0))) + centeredPaint) + ignored))))) + + (def (drawFireTargetLine (canvas : Canvas) + (transform : TacticalMapTransform) + (source : JSONObject)