Add full SSD review client and APK update flow
ober
09db4c3c41e027ee1637c802865c12208f64ae38
--- a/jandroid.ss +++ b/jandroid.ss @@ -209,6 +209,7 @@ (def (theme spec) (entry-value (entries spec) 'theme "@style/AppTheme")) (def (activity-screen-orientation spec) (entry-value (entries spec) 'activity-screen-orientation #f)) (def (activity-config-changes spec) (entry-value (entries spec) 'activity-config-changes #f)) +(def (file-provider? spec) (entry-value (entries spec) 'file-provider #f)) (def (permissions spec) (entry-values (entries spec) 'permission)) (def (permission-forms spec) (entry-forms (entries spec) 'permission)) (def (dependencies spec) (entry-values (entries spec) 'dependency)) @@ -637,6 +638,18 @@ " <category android:name=\"android.intent.category.LAUNCHER\" />\n" " </intent-filter>\n" " </activity>\n" + (if (file-provider? spec) + (string-append + " <provider\n" + " android:name=\"androidx.core.content.FileProvider\"\n" + " android:authorities=\"" (xml-escape (app-id spec)) ".files\"\n" + " android:exported=\"false\"\n" + " android:grantUriPermissions=\"true\">\n" + " <meta-data\n" + " android:name=\"android.support.FILE_PROVIDER_PATHS\"\n" + " android:resource=\"@xml/file_provider_paths\" />\n" + " </provider>\n") + "") " </application>\n" "</manifest>\n")) --- a/templates/ssd-review.ss +++ b/templates/ssd-review.ss @@ -2,18793 +2,7048 @@ (def fragment '( - (typed-kotlin-file "com/sfb/ssdreview/BoxType.kt" - (typed-library (com sfb ssdreview) - (export make-BoxType BoxType? BoxType-id BoxType-name box-type-display - boxTypeDisplays boxTypeById boxTypeDisplayById - addNullableBoxType) - (type Int) - (type Int32) - (record BoxType - ((id : String) - (name : String))) - (def (box-type-display (box : BoxType)) : String - (string-append - (string-append (BoxType-id box) " ") - (BoxType-name box))) - (def (boxTypeDisplays (items : (List BoxType))) : (MutableList String) - (for/fold ((out (mutable-list-empty String))) - ((i (in-range (int32 0) (list-size items)))) - (begin - (mutable-list-add! out (box-type-display (list-ref items i))) - out))) - (def (boxTypeById (items : (List BoxType)) (id : String)) : (Nullable BoxType) - (for/fold ((found (nullable-none BoxType))) - ((i (in-range (int32 0) (list-size items)))) - (if (nullable-null? found) - (let ((box (list-ref items i))) - (if (equal? (BoxType-id box) id) - (nullable-some box) - found)) - found))) - (def (boxTypeDisplayById (items : (List BoxType)) (id : String)) : String - (let ((box (boxTypeById items id))) - (if (nullable-null? box) - id - (box-type-display (nullable-get box))))) - (def (addNullableBoxType (items : (MutableList BoxType)) - (box : (Nullable BoxType))) : Unit - (if (nullable-null? box) - (begin) - (mutable-list-add! items (nullable-get box)))))) - - (typed-kotlin-file "com/sfb/ssdreview/BoxTypeResolve.kt" - (typed-library (com sfb ssdreview) - (export resolveBoxType boxTypeIsWeapon) - (type Int32) - (record BoxTypeMatch - ((count : Int32) - (found : (Nullable BoxType)))) - (def (boxTypeCompact (value : String)) : String - (string-filter-letter-or-digit (string-lowercase value))) - (def (boxTypeNonWeaponTerm? (normalized : String)) : Bool - (string-matches-regex? - normalized - ".*(charge|degradation|fighterbox|hangar|hit|internalweaponbay|link|mechlink|rail|round|stabilizer|targetaccentuator|targetacquisitiongear|targetacquisitionguide).*")) - (def (boxTypeWeaponTerm? (normalized : String)) : Bool - (string-matches-regex? - normalized - ".*(add|antiproton|atomicmissile|axiontorpedo|bioelectricbolt|bombthrower|bosondrill|cannon|clusterbomb|deathboltrack|disruptor|drone|energyhowitzer|esg|fireball|fusion|gausscannon|hellbore|hellgun|hypercannon|hyperdrone|implosionbolt|implosiontorpedo|ioncannon|ionpulsecannon|kineticcannon|kineticwave|laser|massdriver|megaphaser|missile|mine|morter|mortar|neutronbeam|neutrongun|novacannon|optionmount|particlebeam|particlecannon|phaser|photon|plasma|positronlancet|ppd|prospectingcannon|proton|pulsecannon|pulseemitter|quantumcannon|railgun|rocket|sfg|shortrangecannon|sonicpulser|spaceauger|stingtorpedo|subspacerocket|tachyonbeam|tachyongun|tachyonmissile|torp|torpedo|trh|trl|webbreaker|webcaster|websnare).*")) - (def (boxTypeIsWeapon (raw : String)) : Bool - (let ((normalized (boxTypeCompact raw))) - (if (string-blank? normalized) - #f - (if (boxTypeNonWeaponTerm? normalized) - #f - (boxTypeWeaponTerm? normalized))))) - (def (boxTypeExactMatch (box : BoxType) - (text : String) - (lowered : String) - (normalized : String)) : Bool - (or (equal? (BoxType-id box) text) - (or (equal? (string-lowercase (box-type-display box)) lowered) - (or (equal? (string-lowercase (BoxType-name box)) lowered) - (equal? (boxTypeCompact (BoxType-name box)) normalized))))) - (def (boxTypePartialMatch (box : BoxType) - (lowered : String) - (normalized : String)) : Bool - (or (string-contains? - (string-lowercase (box-type-display box)) - lowered) - (string-contains? (boxTypeCompact (BoxType-name box)) normalized))) - (def (findExactBoxType (items : (List BoxType)) - (text : String) - (lowered : String) - (normalized : String)) : (Nullable BoxType) - (for/fold ((found (nullable-none BoxType))) - ((i (in-range (int32 0) (list-size items)))) - (if (nullable-null? found) - (let ((box (list-ref items i))) - (if (boxTypeExactMatch box text lowered normalized) - (nullable-some box) - found)) - found))) - (def (findPartialBoxTypes (items : (List BoxType)) - (lowered : String) - (normalized : String)) : BoxTypeMatch - (for/fold ((match (make-BoxTypeMatch - (int32 0) - (nullable-none BoxType)))) - ((i (in-range (int32 0) (list-size items)))) - (let ((box (list-ref items i))) - (if (boxTypePartialMatch box lowered normalized) - (make-BoxTypeMatch - (+ (BoxTypeMatch-count match) (int32 1)) - (nullable-some box)) - match)))) - (def (singleBoxTypeMatch (match : BoxTypeMatch)) : (Nullable BoxType) - (if (= (BoxTypeMatch-count match) (int32 1)) - (BoxTypeMatch-found match) - (nullable-none BoxType))) - (def (resolveBoxType (items : (List BoxType)) - (raw : String)) : (Nullable BoxType) - (let ((text (string-trim raw))) - (if (string-blank? text) - (nullable-none BoxType) - (let ((normalized (boxTypeCompact text)) - (lowered (string-lowercase text))) - (let ((exact (findExactBoxType items text lowered normalized))) - (if (nullable-null? exact) - (singleBoxTypeMatch - (findPartialBoxTypes items lowered normalized)) - exact)))))))) - - (typed-kotlin-file "com/sfb/ssdreview/BoxTypeCsv.kt" - (typed-library (com sfb ssdreview) - (export parseBoxTypeCsvLine boxTypesFromCsvText) - (extern (boxTypeCsvStringLines (text : String)) : (List String) - (kotlin-member-call lines)) - (def (parseBoxTypeCsvLine (line : String)) : (Nullable BoxType) - (if (not (string-matches-regex? line "^[^,]+,.+$")) - (nullable-none BoxType) - (let ((id (string-trim (string-substring-before line ","))) - (name (string-trim (string-replace-regex line "^[^,]*," "")))) - (if (or (string-blank? id) (string-blank? name)) - (nullable-none BoxType) - (nullable-some (make-BoxType id name)))))) - (def (boxTypesFromCsvText (text : String)) : (MutableList BoxType) - (let ((lines (boxTypeCsvStringLines text))) - (for/fold ((items (mutable-list-empty BoxType))) - ((i (in-range (int32 1) (list-size lines)))) - (begin - (addNullableBoxType - items - (parseBoxTypeCsvLine (list-ref lines i))) - items)))))) - - (typed-kotlin-file "com/sfb/ssdreview/OcrWord.kt" - (typed-library (com sfb ssdreview) - (export make-OcrWord OcrWord? OcrWord-text OcrWord-conf OcrWord-bbox - ocrWordFromBounds) - (type Int32) - (type Float32) - (type FloatArray) - (record OcrWord - ((text : String) - (conf : Float32) - (bbox : FloatArray))) - (def (ocrWordFromBounds (text : String) - (left : Int32) - (top : Int32) - (right : Int32) - (bottom : Int32)) : OcrWord - (make-OcrWord - text - (float32 80.0) - (float-array - (float32 left) - (float32 top) - (float32 right) - (float32 bottom)))))) - - (typed-kotlin-file "com/sfb/ssdreview/SsdCell.kt" - (typed-library (com sfb ssdreview) - (export make-SsdCell SsdCell? SsdCell-id - SsdCell-x SsdCell-x-set! - SsdCell-y SsdCell-y-set! - SsdCell-w SsdCell-w-set! - SsdCell-h SsdCell-h-set! - SsdCell-detector - ssdCellCx ssdCellCy ssdCellRect - rectOverlapArea rectCenterInside iou adjacent - maxFloat32 minFloat32 - bboxForCells ssdCellsSortedByYThenX - mergeDuplicateCellsSorted mergeDuplicateCells) - (type Float32) - (type FloatArray) - (type Int32) - (record SsdCell - ((id : String) - (mut x : Float32) - (mut y : Float32) - (mut w : Float32) - (mut h : Float32) - (detector : String))) - (def (ssdCellCx (cell : SsdCell)) : Float32 - (+ (SsdCell-x cell) - (/ (SsdCell-w cell) (float32 2.0)))) - (def (ssdCellCy (cell : SsdCell)) : Float32 - (+ (SsdCell-y cell) - (/ (SsdCell-h cell) (float32 2.0)))) - (def (ssdCellRect (cell : SsdCell)) : FloatArray - (float-array - (SsdCell-x cell) - (SsdCell-y cell) - (+ (SsdCell-x cell) (SsdCell-w cell)) - (+ (SsdCell-y cell) (SsdCell-h cell)))) - (def (rectOverlapArea (a : FloatArray) (b : FloatArray)) : Float32 - (let ((x (if (< (float-array-ref a (int32 2)) - (float-array-ref b (int32 2))) - (- (float-array-ref a (int32 2)) - (if (> (float-array-ref a (int32 0)) - (float-array-ref b (int32 0))) - (float-array-ref a (int32 0)) - (float-array-ref b (int32 0)))) - (- (float-array-ref b (int32 2)) - (if (> (float-array-ref a (int32 0)) - (float-array-ref b (int32 0))) - (float-array-ref a (int32 0)) - (float-array-ref b (int32 0)))))) - (y (if (< (float-array-ref a (int32 3)) - (float-array-ref b (int32 3))) - (- (float-array-ref a (int32 3)) - (if (> (float-array-ref a (int32 1)) - (float-array-ref b (int32 1))) - (float-array-ref a (int32 1)) - (float-array-ref b (int32 1)))) - (- (float-array-ref b (int32 3)) - (if (> (float-array-ref a (int32 1)) - (float-array-ref b (int32 1))) - (float-array-ref a (int32 1)) - (float-array-ref b (int32 1))))))) - (if (or (<= x (float32 0.0)) (<= y (float32 0.0))) - (float32 0.0) - (* x y)))) - (def (rectCenterInside (rect : FloatArray) (area : FloatArray)) : Bool - (let ((cx (/ (+ (float-array-ref rect (int32 0)) - (float-array-ref rect (int32 2))) - (float32 2.0))) - (cy (/ (+ (float-array-ref rect (int32 1)) - (float-array-ref rect (int32 3))) - (float32 2.0)))) - (and (>= cx (float-array-ref area (int32 0))) - (<= cx (float-array-ref area (int32 2))) - (>= cy (float-array-ref area (int32 1))) - (<= cy (float-array-ref area (int32 3)))))) - (def (maxFloat32 (a : Float32) (b : Float32)) : Float32 - (if (> a b) a b)) - (def (minFloat32 (a : Float32) (b : Float32)) : Float32 - (if (< a b) a b)) - (def (iou (a : SsdCell) (b : SsdCell)) : Float32 - (let ((overlap (rectOverlapArea (ssdCellRect a) (ssdCellRect b)))) - (if (<= overlap (float32 0.0)) - (float32 0.0) - (/ overlap - (- (+ (* (SsdCell-w a) (SsdCell-h a)) - (* (SsdCell-w b) (SsdCell-h b))) - overlap))))) - (def (adjacent (a : SsdCell) (b : SsdCell)) : Bool - (let ((ax1 (SsdCell-x a)) - (ay1 (SsdCell-y a)) - (ax2 (+ (SsdCell-x a) (SsdCell-w a))) - (ay2 (+ (SsdCell-y a) (SsdCell-h a))) - (bx1 (SsdCell-x b)) - (by1 (SsdCell-y b)) - (bx2 (+ (SsdCell-x b) (SsdCell-w b))) - (by2 (+ (SsdCell-y b) (SsdCell-h b)))) - (let ((yOverlap (maxFloat32 - (float32 0.0) - (- (minFloat32 ay2 by2) - (maxFloat32 ay1 by1)))) - (xGap (maxFloat32 - (float32 0.0) - (maxFloat32 (- bx1 ax2) (- ax1 bx2)))) - (xOverlap (maxFloat32 - (float32 0.0) - (- (minFloat32 ax2 bx2) - (maxFloat32 ax1 bx1)))) - (yGap (maxFloat32 - (float32 0.0) - (maxFloat32 (- by1 ay2) (- ay1 by2)))) - (minH (minFloat32 (SsdCell-h a) (SsdCell-h b))) - (minW (minFloat32 (SsdCell-w a) (SsdCell-w b)))) - (let ((horizontal - (and (>= (* yOverlap (float32 2.0)) minH) - (<= xGap - (maxFloat32 - (float32 4.0) - (float32 - (float32-round->int32 - (* minW (float32 0.25)))))) - (<= (float32-abs (- (SsdCell-h a) (SsdCell-h b))) - (maxFloat32 - (float32 5.0) - (float32 - (float32-round->int32 - (* minH (float32 0.35)))))))) - (vertical - (and (>= (* xOverlap (float32 2.0)) minW) - (<= yGap - (maxFloat32 - (float32 4.0) - (float32 - (float32-round->int32 - (* minH (float32 0.25)))))) - (<= (float32-abs (- (SsdCell-w a) (SsdCell-w b))) - (maxFloat32 - (float32 5.0) - (float32 - (float32-round->int32 - (* minW (float32 0.35))))))))) - (or horizontal vertical))))) - (def (bboxForCells (cells : (List SsdCell))) : FloatArray - (if (= (list-size cells) (int32 0)) - (float-array (float32 0.0) (float32 0.0) (float32 0.0) (float32 0.0)) - (let ((first (list-ref cells (int32 0)))) - (float-array - (for/fold ((x (SsdCell-x first))) - ((i (in-range (int32 1) (list-size cells)))) - (minFloat32 x (SsdCell-x (list-ref cells i)))) - (for/fold ((y (SsdCell-y first))) - ((i (in-range (int32 1) (list-size cells)))) - (minFloat32 y (SsdCell-y (list-ref cells i)))) - (for/fold ((x2 (+ (SsdCell-x first) (SsdCell-w first)))) - ((i (in-range (int32 1) (list-size cells)))) - (let ((cell (list-ref cells i))) - (maxFloat32 x2 (+ (SsdCell-x cell) (SsdCell-w cell))))) - (for/fold ((y2 (+ (SsdCell-y first) (SsdCell-h first)))) - ((i (in-range (int32 1) (list-size cells)))) - (let ((cell (list-ref cells i))) - (maxFloat32 y2 (+ (SsdCell-y cell) (SsdCell-h cell))))))))) - (def (ssdCellGeneratedId (index : Int32)) : String - (string-append - "c" - (string-pad-start (int32->string index) (int32 4) #\0))) - (def (ssdCellWithId (cell : SsdCell) (id : String)) : SsdCell - (make-SsdCell id - (SsdCell-x cell) - (SsdCell-y cell) - (SsdCell-w cell) - (SsdCell-h cell) - (SsdCell-detector cell))) - (def (duplicateCellIndex (merged : (MutableList SsdCell)) - (cell : SsdCell)) : Int32 - (for/fold ((found (int32 -1))) - ((i (in-range (int32 0) (list-size merged)))) - (if (>= found (int32 0)) - found - (if (>= (iou cell (list-ref merged i)) (float32 0.55)) - i - found)))) - (def (preferReplacementCell (existing : SsdCell) (candidate : SsdCell)) : Bool - (and (not (equal? (SsdCell-detector existing) "android-color")) - (equal? (SsdCell-detector candidate) "android-color"))) - (def (ssdCellBeforeByYThenX? (candidate : SsdCell) (existing : SsdCell)) : Bool - (or (< (SsdCell-y candidate) (SsdCell-y existing)) - (and (not (< (SsdCell-y existing) (SsdCell-y candidate))) - (< (SsdCell-x candidate) (SsdCell-x existing))))) - (def (ssdCellSortedInsertIndex (sorted : (MutableList SsdCell)) - (cell : SsdCell)) : Int32 - (for/fold ((found (int32 -1))) - ((i (in-range (int32 0) (list-size sorted)))) - (if (>= found (int32 0)) - found - (if (ssdCellBeforeByYThenX? cell (list-ref sorted i)) - i - found)))) - (def (ssdCellsInsertSorted (sorted : (MutableList SsdCell)) - (cell : SsdCell)) : (MutableList SsdCell) - (let ((insertAt (ssdCellSortedInsertIndex sorted cell))) - (if (< insertAt (int32 0)) - (begin - (mutable-list-add! sorted cell) - sorted) - (let ((out (mutable-list-empty SsdCell))) - (begin - (for/fold ((ignored (int32 0))) - ((i (in-range (int32 0) (list-size sorted)))) - (begin - (if (= i insertAt) - (begin - (mutable-list-add! out cell) - (mutable-list-add! out (list-ref sorted i))) - (mutable-list-add! out (list-ref sorted i))) - ignored)) - out))))) - (def (ssdCellsSortedByYThenX (cells : (List SsdCell))) : (MutableList SsdCell) - (for/fold ((sorted (mutable-list-empty SsdCell))) - ((i (in-range (int32 0) (list-size cells)))) - (ssdCellsInsertSorted sorted (list-ref cells i)))) - (def (renumberCells (cells : (MutableList SsdCell))) : (MutableList SsdCell) - (let ((out (mutable-list-empty SsdCell))) - (begin - (for/fold ((ignored (int32 0))) - ((i (in-range (int32 0) (list-size cells)))) - (begin - (mutable-list-add! - out - (ssdCellWithId - (list-ref cells i) - (ssdCellGeneratedId (+ i (int32 1))))) - ignored)) - out))) - (def (mergeDuplicateCellsSorted (cells : (List SsdCell))) : (MutableList SsdCell) - (let ((merged (mutable-list-empty SsdCell))) - (begin - (for/fold ((ignored (int32 0))) - ((i (in-range (int32 0) (list-size cells)))) - (let ((cell (list-ref cells i))) - (let ((duplicateIndex (duplicateCellIndex merged cell))) - (begin - (if (>= duplicateIndex (int32 0)) - (let ((existing (list-ref merged duplicateIndex))) - (if (preferReplacementCell existing cell) - (mutable-list-set! merged duplicateIndex cell) - (mutable-list-set! merged duplicateIndex existing))) - (mutable-list-add! merged cell)) - ignored)))) - (renumberCells merged)))) - (def (mergeDuplicateCells (cells : (MutableList SsdCell))) : (MutableList SsdCell) - (let ((sorted - (for/fold ((out (mutable-list-empty SsdCell))) - ((i (in-range (int32 0) (list-size cells)))) - (ssdCellsInsertSorted out (list-ref cells i))))) - (let ((merged (mutable-list-empty SsdCell))) - (begin - (for/fold ((ignored (int32 0))) - ((i (in-range (int32 0) (list-size sorted)))) - (let ((cell (list-ref sorted i))) - (let ((duplicateIndex (duplicateCellIndex merged cell))) - (begin - (if (>= duplicateIndex (int32 0)) - (let ((existing (list-ref merged duplicateIndex))) - (if (preferReplacementCell existing cell) - (mutable-list-set! merged duplicateIndex cell) - (mutable-list-set! merged duplicateIndex existing))) - (mutable-list-add! merged cell)) - ignored)))) - (renumberCells merged))))))) - - (typed-kotlin-file "com/sfb/ssdreview/Component.kt" - (typed-library (com sfb ssdreview) - (export make-Component Component? Component-x1 Component-x1-set! - Component-y1 Component-y1-set! - Component-x2 Component-x2-set! - Component-y2 Component-y2-set! - Component-area Component-area-set! - Component-detector - componentW componentH componentAdd componentCell) - (type Int32) - (record Component - ((mut x1 : Int32) - (mut y1 : Int32) - (mut x2 : Int32) - (mut y2 : Int32) - (mut area : Int32) - (detector : String))) - (def (componentW (component : Component)) : Int32 - (+ (- (Component-x2 component) - (Component-x1 component)) - (int32 1))) - (def (componentH (component : Component)) : Int32 - (+ (- (Component-y2 component) - (Component-y1 component)) - (int32 1))) - (def (componentAdd (component : Component) (x : Int32) (y : Int32)) : Unit - (begin - (Component-x1-set! component - (if (< x (Component-x1 component)) x (Component-x1 component))) - (Component-y1-set! component - (if (< y (Component-y1 component)) y (Component-y1 component))) - (Component-x2-set! component - (if (> x (Component-x2 component)) x (Component-x2 component))) - (Component-y2-set! component - (if (> y (Component-y2 component)) y (Component-y2 component))) - (Component-area-set! component - (+ (Component-area component) (int32 1))))) - (def (componentCell (component : Component) (detector : String)) : (Nullable SsdCell) - (let ((w (componentW component)) - (h (componentH component))) - (let ((bboxArea (* w h))) - (if (or (or (< (Component-area component) (int32 40)) - (> (Component-area component) (int32 2000))) - (or (or (< w (int32 6)) - (> w (int32 80))) - (or (< h (int32 6)) - (> h (int32 80))))) - (nullable-none SsdCell) - (let ((safeArea (if (> bboxArea (int32 1)) - bboxArea - (int32 1)))) - (let ((density (/ (float32 (Component-area component)) - (float32 safeArea)))) - (if (<= density (float32 0.45)) - (nullable-none SsdCell) - (nullable-some - (make-SsdCell - "" - (float32 (Component-x1 component)) - (float32 (Component-y1 component)) - (float32 w) - (float32 h) - detector))))))))))) - - (typed-kotlin-file "com/sfb/ssdreview/SsdGroup.kt" - (typed-library (com sfb ssdreview) - (export make-SsdGroup SsdGroup? SsdGroup-id - SsdGroup-label SsdGroup-label-set! - SsdGroup-boxTypeId SsdGroup-boxTypeId-set! - SsdGroup-status SsdGroup-status-set! - SsdGroup-count SsdGroup-count-set! - SsdGroup-bbox SsdGroup-bbox-set! - SsdGroup-cellIds - SsdGroup-firingArc SsdGroup-firingArc-set! - SsdGroup-notes SsdGroup-notes-set!) - (type Int32) - (type FloatArray) - (record SsdGroup - ((id : String) - (mut label : String) - (mut boxTypeId : String) - (mut status : String) - (mut count : Int32) - (mut bbox : FloatArray) - (cellIds : (MutableList String)) - (mut firingArc : String) - (mut notes : String))))) - - (typed-kotlin-file "com/sfb/ssdreview/SsdSession.kt" - (typed-library (com sfb ssdreview) - (export make-SsdSession SsdSession? SsdSession-sessionId - SsdSession-sourceKey SsdSession-sourceName SsdSession-sourceUri - SsdSession-page SsdSession-pageCount SsdSession-dpi - SsdSession-imageWidth SsdSession-imageHeight - SsdSession-cells SsdSession-groups SsdSession-ocrWords - SsdSession-suppressedGroups - SsdSession-ssdArea SsdSession-ssdArea-set! - ssdSessionOrEmpty makeDetectionSession makeRemoteTruthMergeSession - ssdSessionAreaOrNone - ssdSessionCellInsideSsdArea ssdSessionGroupInsideSsdArea - ssdSessionSuppressedGroupPresent? - ssdSessionFindGroupById ssdSessionSelectedGroup - ssdCurrentSelectedGroup - ssdSessionSelectedGroupId ssdSessionRelativeGroupId - ssdCurrentRelativeGroupId - ssdSessionCellIdsForGroupId - ssdSessionGroupPresent ssdSessionGroupMissing - ssdGroupMissing ssdGroupOrEmpty - ssdSessionGroupContainsCellId - ssdSessionCellIdSet - ssdSessionFindCellById ssdSessionCellsByIds - ssdSessionBBoxForCellIds ssdSessionRecomputeGroup - ssdSessionApproveGroup ssdSessionAppendAreaToGroup - ssdGroupApplyResolvedLabel - ssdSessionSuppressGroupAsDeleted - appendUniqueCellIdsToGroup - ssdSessionAddDetectedCellsInsideArea ssdSessionAddOcrWords - ssdSessionBoundedSsdArea ssdAreaSelectionTooSmall - ssdSessionStoreSsdArea ssdSessionSsdAreaOutsideCount - ssdSessionSetSsdArea ssdSessionPruneGroupsOutsideSsdArea - createManualCells selectedOrManualCellIds - copyStringIds copyMutableStringIds - ssdSessionNextCellId ssdSessionNextGroupId - bboxForMutableCells - forEachSsdSessionCell forEachSsdSessionGroup) - (type Int32) - (type FloatArray) - (type SsdCell) - (type SsdGroup) - (type OcrWord) - (record SsdSession - ((sessionId : String) - (sourceKey : String) - (sourceName : String) - (sourceUri : String) - (page : Int32) - (pageCount : Int32) - (dpi : Int32) - (imageWidth : Int32) - (imageHeight : Int32) - (cells : (MutableList SsdCell)) - (groups : (MutableList SsdGroup)) - (ocrWords : (MutableList OcrWord)) - (suppressedGroups : (MutableList SsdGroup)) - (mut ssdArea : (Nullable FloatArray)))) - (def (forEachSsdSessionCell - (session : SsdSession) - (action : (-> SsdCell Unit))) : Unit - (begin - (for/fold ((ignored (int32 0))) - ((i (in-range - (int32 0) - (list-size (SsdSession-cells session))))) - (begin - (invoke action (list-ref (SsdSession-cells session) i)) - ignored)) - (begin))) - (def (forEachSsdSessionGroup - (session : SsdSession) - (action : (-> SsdGroup Unit))) : Unit - (begin - (for/fold ((ignored (int32 0))) - ((i (in-range - (int32 0) - (list-size (SsdSession-groups session))))) - (begin - (invoke action (list-ref (SsdSession-groups session) i)) - ignored)) - (begin))) - (def (ssdSessionOrEmpty (session : (Nullable SsdSession))) : SsdSession - (if (nullable-null? session) - (make-SsdSession - "" - "" - "" - "" - (int32 0) - (int32 0) - (int32 0) - (int32 0) - (int32 0) - (mutable-list-empty SsdCell) - (mutable-list-empty SsdGroup) - (mutable-list-empty OcrWord) - (mutable-list-empty SsdGroup) - (nullable-none FloatArray)) - (nullable-get session))) - (def (makeDetectionSession (sessionId : String) - (sourceKey : String) - (sourceName : String) - (sourceUri : String) - (page : Int32) - (pageCount : Int32) - (dpi : Int32) - (imageWidth : Int32) - (imageHeight : Int32)) : SsdSession - (make-SsdSession - sessionId - sourceKey - sourceName - sourceUri - page - pageCount - dpi - imageWidth - imageHeight - (mutable-list-empty SsdCell) - (mutable-list-empty SsdGroup) - (mutable-list-empty OcrWord) - (mutable-list-empty SsdGroup) - (nullable-none FloatArray))) - (def (copyOcrWords (words : (MutableList OcrWord))) : (MutableList OcrWord) - (for/fold ((out (mutable-list-empty OcrWord))) - ((i (in-range (int32 0) (list-size words)))) - (begin - (mutable-list-add! out (list-ref words i)) - out))) - (def (makeRemoteTruthMergeSession (source : SsdSession)) : SsdSession - (make-SsdSession - (SsdSession-sessionId source) - (SsdSession-sourceKey source) - (SsdSession-sourceName source) - (SsdSession-sourceUri source) - (SsdSession-page source) - (SsdSession-pageCount source) - (SsdSession-dpi source) - (SsdSession-imageWidth source) - (SsdSession-imageHeight source) - (mutable-list-empty SsdCell) - (mutable-list-empty SsdGroup) - (copyOcrWords (SsdSession-ocrWords source)) - (mutable-list-empty SsdGroup) - (nullable-none FloatArray))) - (def (ssdSessionAddOcrWords (session : SsdSession) - (words : (List OcrWord))) : Unit - (mutable-list-add-all! (SsdSession-ocrWords session) words)) - (def (ssdSessionAreaOrNone (session : (Nullable SsdSession))) : (Nullable FloatArray) - (if (nullable-null? session) - (nullable-none FloatArray) - (SsdSession-ssdArea (nullable-get session)))) - (def (ssdSessionCellInsideSsdArea (session : SsdSession) (cell : SsdCell)) : Bool - (if (nullable-null? (SsdSession-ssdArea session)) - #t - (rectCenterInside - (ssdCellRect cell) - (nullable-get (SsdSession-ssdArea session))))) - (def (ssdSessionGroupInsideSsdArea (session : SsdSession) (group : SsdGroup)) : Bool - (if (nullable-null? (SsdSession-ssdArea session)) - #t - (rectCenterInside - (SsdGroup-bbox group) - (nullable-get (SsdSession-ssdArea session))))) - (def (appendSsdAreaNote (existing : String)) : String - (if (string-blank? existing) - "Outside SSD area" - (string-append existing "; Outside SSD area"))) - (def (ssdSessionSuppressedGroupPresent? (session : SsdSession) - (id : String)) : Bool - (for/fold ((found #f)) - ((i (in-range (int32 0) - (list-size (SsdSession-suppressedGroups session))))) - (if found - found - (equal? - (SsdGroup-id (list-ref (SsdSession-suppressedGroups session) i)) - id)))) - (def (ssdSessionGroupsOutsideArea (session : SsdSession) - (area : FloatArray)) : (MutableList SsdGroup) - (for/fold ((out (mutable-list-empty SsdGroup))) - ((i (in-range (int32 0) (list-size (SsdSession-groups session))))) - (let ((group (list-ref (SsdSession-groups session) i))) - (if (rectCenterInside (SsdGroup-bbox group) area) - out - (begin - (mutable-list-add! out group) - out))))) - (def (ssdSessionSsdAreaOutsideCount (session : SsdSession)) : Int32 - (if (nullable-null? (SsdSession-ssdArea session)) - (int32 0) - (list-size - (ssdSessionGroupsOutsideArea - session - (nullable-get (SsdSession-ssdArea session)))))) - (def (ssdSessionPruneGroupsOutsideSsdArea (session : SsdSession)) : Int32 - (if (nullable-null? (SsdSession-ssdArea session)) - (int32 0) - (let ((outside (ssdSessionGroupsOutsideArea - session - (nullable-get (SsdSession-ssdArea session))))) - (if (and (> (list-size outside) (int32 0)) - (>= (list-size outside) (list-size (SsdSession-groups session)))) - (int32 0) - (begin - (for/fold ((ignored (int32 0))) - ((i (in-range (int32 0) (list-size outside)))) - (let ((group (list-ref outside i))) - (begin - (mutable-list-remove! (SsdSession-groups session) group) - (SsdGroup-status-set! group "suppressed") - (SsdGroup-notes-set! - group - (appendSsdAreaNote (SsdGroup-notes group))) - (if (ssdSessionSuppressedGroupPresent? - session - (SsdGroup-id group)) - (begin) - (mutable-list-add! - (SsdSession-suppressedGroups session) - group)) - ignored))) - (list-size outside)))))) - (def (ssdSessionBoundedSsdArea (session : SsdSession) - (rect : FloatArray)) : FloatArray - (let ((maxX (float32 (SsdSession-imageWidth session))) - (maxY (float32 (SsdSession-imageHeight session)))) - (float-array - (minFloat32 maxX (maxFloat32 (float32 0.0) (float-array-ref rect (int32 0)))) - (minFloat32 maxY (maxFloat32 (float32 0.0) (float-array-ref rect (int32 1)))) - (minFloat32 maxX (maxFloat32 (float32 0.0) (float-array-ref rect (int32 2)))) - (minFloat32 maxY (maxFloat32 (float32 0.0) (float-array-ref rect (int32 3))))))) - (def (ssdAreaSelectionTooSmall (area : FloatArray)) : Bool - (or (< (float32-abs (- (float-array-ref area (int32 0)) - (float-array-ref area (int32 2)))) - (float32 10.0)) - (< (float32-abs (- (float-array-ref area (int32 1)) - (float-array-ref area (int32 3)))) - (float32 10.0)))) - (def (ssdSessionStoreSsdArea (session : SsdSession) (area : FloatArray)) : Unit - (SsdSession-ssdArea-set! - session - (nullable-some - (float-array - (minFloat32 (float-array-ref area (int32 0)) - (float-array-ref area (int32 2))) - (minFloat32 (float-array-ref area (int32 1)) - (float-array-ref area (int32 3))) - (maxFloat32 (float-array-ref area (int32 0)) - (float-array-ref area (int32 2))) - (maxFloat32 (float-array-ref area (int32 1)) - (float-array-ref area (int32 3))))))) - (def (ssdSessionSetSsdArea (session : SsdSession) (area : FloatArray)) : Int32 - (begin - (ssdSessionStoreSsdArea session area) - (ssdSessionPruneGroupsOutsideSsdArea session))) - (def (manualCellColumns (count : Int32)) : Int32 - (for/fold ((columns (int32 1))) - ((i (in-range (int32 0) count))) - (if (< (* columns columns) count) - (+ columns (int32 1)) - columns))) - (def (manualCellRows (count : Int32) (columns : Int32)) : Int32 - (let ((rows (/ (+ count (- columns (int32 1))) columns))) - (if (< rows (int32 1)) (int32 1) rows))) - (def (sessionManualCellCount (count : Int32)) : Int32 - (if (< count (int32 1)) - (int32 1) - (if (> count (int32 400)) - (int32 400) - count))) - (def (createManualCells (session : SsdSession) - (rect : FloatArray) - (count : Int32)) : (MutableList String) - (let ((columns (manualCellColumns count))) - (let ((rows (manualCellRows count columns)) - (width (let ((candidate (- (float-array-ref rect (int32 2)) - (float-array-ref rect (int32 0))))) - (if (> candidate (float32 1.0)) - candidate - (float32 1.0)))) - (height (let ((candidate (- (float-array-ref rect (int32 3)) - (float-array-ref rect (int32 1))))) - (if (> candidate (float32 1.0)) - candidate - (float32 1.0))))) - (for/fold ((ids (mutable-list-empty String))) - ((i (in-range (int32 0) count))) - (let ((row (/ i columns)) - (column (mod i columns))) - (let ((x1 (+ (float-array-ref rect (int32 0)) - (/ (* width (float32 column)) - (float32 columns)))) - (y1 (+ (float-array-ref rect (int32 1)) - (/ (* height (float32 row)) - (float32 rows)))) - (x2 (+ (float-array-ref rect (int32 0)) - (/ (* width (float32 (+ column (int32 1)))) - (float32 columns)))) - (y2 (+ (float-array-ref rect (int32 1)) - (/ (* height (float32 (+ row (int32 1)))) - (float32 rows))))) - (let ((cell (make-SsdCell - (ssdSessionNextCellId session) - x1 - y1 - (- x2 x1) - (- y2 y1) - "android-manual"))) - (begin - (mutable-list-add! (SsdSession-cells session) cell) - (mutable-list-add! ids (SsdCell-id cell)) - ids)))))))) - (def (copyStringIds (ids : (List String))) : (MutableList String) - (for/fold ((out (mutable-list-empty String))) - ((i (in-range (int32 0) (list-size ids)))) - (begin - (mutable-list-add! out (list-ref ids i)) - out))) - (def (copyMutableStringIds (ids : (MutableList String))) : (MutableList String) - (for/fold ((out (mutable-list-empty String))) - ((i (in-range (int32 0) (list-size ids)))) - (begin - (mutable-list-add! out (list-ref ids i)) - out))) - (def (selectedOrManualCellIds (session : SsdSession) - (rect : FloatArray) - (detectedIds : (List String)) - (count : Int32)) : (MutableList String) - (if (> (list-size detectedIds) (int32 0)) - (copyStringIds detectedIds) - (createManualCells session rect (sessionManualCellCount count)))) - (def (ssdSessionFindCellById (session : SsdSession) - (id : String)) : (Nullable SsdCell) - (for/fold ((found (nullable-none SsdCell))) - ((i (in-range (int32 0) (list-size (SsdSession-cells session))))) - (if (nullable-null? found) - (let ((cell (list-ref (SsdSession-cells session) i))) - (if (equal? (SsdCell-id cell) id) - (nullable-some cell) - found)) - found))) - (def (ssdSessionFindGroupById (session : SsdSession) - (id : (Nullable String))) : (Nullable SsdGroup) - (if (nullable-null? id) - (nullable-none SsdGroup) - (let ((wanted (nullable-get id))) - (for/fold ((found (nullable-none SsdGroup))) - ((i (in-range (int32 0) (list-size (SsdSession-groups session))))) - (if (nullable-null? found) - (let ((group (list-ref (SsdSession-groups session) i))) - (if (equal? (SsdGroup-id group) wanted) - (nullable-some group) - found)) - found))))) - (def (ssdSessionFirstGroup (session : SsdSession)) : (Nullable SsdGroup) - (if (= (list-size (SsdSession-groups session)) (int32 0)) - (nullable-none SsdGroup) - (nullable-some (list-ref (SsdSession-groups session) (int32 0))))) - (def (ssdSessionSelectedGroup (session : SsdSession) - (id : (Nullable String))) : (Nullable SsdGroup) - (let ((found (ssdSessionFindGroupById session id))) - (if (nullable-null? found) - (ssdSessionFirstGroup session) - found))) - (def (ssdCurrentSelectedGroup (session : (Nullable SsdSession)) - (id : (Nullable String))) : (Nullable SsdGroup) - (if (nullable-null? session) - (nullable-none SsdGroup) - (ssdSessionSelectedGroup (nullable-get session) id))) - (def (ssdSessionSelectedGroupId (session : SsdSession) - (id : (Nullable String))) : (Nullable String) - (let ((group (ssdSessionSelectedGroup session id))) - (if (nullable-null? group) - (nullable-none String) - (nullable-some (SsdGroup-id (nullable-get group)))))) - (def (ssdSessionGroupIndexById (session : SsdSession) - (id : (Nullable String))) : Int32 - (if (nullable-null? id) - (int32 -1) - (let ((wanted (nullable-get id))) - (for/fold ((found (int32 -1))) - ((i (in-range (int32 0) (list-size (SsdSession-groups session))))) - (if (>= found (int32 0)) - found - (if (equal? (SsdGroup-id (list-ref (SsdSession-groups session) i)) wanted) - i - found)))))) - (def (ssdSessionRelativeGroupId (session : SsdSession) - (id : (Nullable String)) - (delta : Int32)) : (Nullable String) - (let ((size (list-size (SsdSession-groups session)))) - (if (= size (int32 0)) - (nullable-none String) - (let ((index (ssdSessionGroupIndexById session id))) - (let ((current (if (< index (int32 0)) (int32 0) index))) - (nullable-some - (SsdGroup-id - (list-ref - (SsdSession-groups session) - (mod (+ (+ current delta) size) size))))))))) - (def (ssdCurrentRelativeGroupId (session : (Nullable SsdSession)) - (id : (Nullable String)) - (delta : Int32)) : (Nullable String) - (if (nullable-null? session) - (nullable-none String) - (ssdSessionRelativeGroupId (nullable-get session) id delta))) - (def (ssdSessionCellIdsForGroupId (session : SsdSession) - (id : (Nullable String))) : (MutableList String) - (let ((group (ssdSessionFindGroupById session id))) - (if (nullable-null? group) - (mutable-list-empty String) - (SsdGroup-cellIds (nullable-get group))))) - (def (ssdSessionGroupPresent (session : SsdSession) - (group : SsdGroup)) : Bool - (not (nullable-null? - (ssdSessionFindGroupById - session - (nullable-some (SsdGroup-id group)))))) - (def (ssdSessionGroupMissing (session : SsdSession) - (group : SsdGroup)) : Bool - (not (ssdSessionGroupPresent session group))) - (def (ssdGroupMissing (group : (Nullable SsdGroup))) : Bool - (nullable-null? group)) - (def (ssdGroupOrEmpty (group : (Nullable SsdGroup))) : SsdGroup - (if (nullable-null? group) - (make-SsdGroup - "" - "" - "" - "" - (int32 0) - (float-array (float32 0.0) (float32 0.0) (float32 0.0) (float32 0.0)) - (mutable-list-empty String) - "" - "") - (nullable-get group))) - (def (ssdSessionGroupContainsCellId (session : SsdSession) - (groupId : (Nullable String)) - (cellId : String)) : Bool - (let ((group (ssdSessionFindGroupById session groupId)))