Preserve manual SSD group orientation in typed client
ober
118d5e7b9eb71504e430e2638a90477ee54385aa
--- a/templates/ssd-review.ss +++ b/templates/ssd-review.ss @@ -559,12 +559,13 @@ ssdSessionBoundedSsdArea ssdAreaSelectionTooSmall ssdSessionStoreSsdArea ssdSessionSsdAreaOutsideCount ssdSessionSetSsdArea ssdSessionPruneGroupsOutsideSsdArea - createManualCells selectedOrManualCellIds + manualCellGridDimensions createManualCells selectedOrManualCellIds copyStringIds copyMutableStringIds ssdSessionNextCellId ssdSessionNextGroupId bboxForMutableCells forEachSsdSessionCell forEachSsdSessionGroup) (type Int32) + (type Float32) (type FloatArray) (type SsdCell) (type SsdGroup) @@ -783,15 +784,61 @@ (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 (manualCellDirectionPreferred (selectionAspect : Float32) + (columns : Int32) + (bestColumns : Int32)) : Bool + (if (>= selectionAspect (float32 1.0)) + (> columns bestColumns) + (< columns bestColumns))) + (def (manualCellGridDimensions (rect : FloatArray) + (count : Int32)) : (Pair Int32 Int32) + (let ((safeCount (if (< count (int32 1)) (int32 1) count)) + (width (maxFloat32 + (float32 1.0) + (- (float-array-ref rect (int32 2)) + (float-array-ref rect (int32 0))))) + (height (maxFloat32 + (float32 1.0) + (- (float-array-ref rect (int32 3)) + (float-array-ref rect (int32 1)))))) + (let ((selectionAspect (/ width height))) + (let ((best + (for/fold + ((state + (pair + (int32 1) + (pair safeCount (float32 1000000.0))))) + ((columns (in-range + (int32 1) + (+ safeCount (int32 1))))) + (let ((rows (manualCellRows safeCount columns))) + (let ((cellAspect + (maxFloat32 + (float32 0.01) + (/ (* selectionAspect (float32 rows)) + (float32 columns)))) + (emptySlots (- (* columns rows) safeCount))) + (let ((score + (+ (float32-abs (float32-ln cellAspect)) + (* (/ (float32 emptySlots) + (float32 safeCount)) + (float32 0.35)))) + (bestColumns (pair-first state)) + (bestRowsAndScore (pair-second state))) + (let ((bestScore (pair-second bestRowsAndScore))) + (if (or (< score (- bestScore (float32 0.000001))) + (and (< (float32-abs (- score bestScore)) + (float32 0.000001)) + (manualCellDirectionPreferred + selectionAspect + columns + bestColumns))) + (pair columns (pair rows score)) + state)))))))) + (pair (pair-first best) (pair-first (pair-second best))))))) (def (sessionManualCellCount (count : Int32)) : Int32 (if (< count (int32 1)) (int32 1) @@ -801,8 +848,9 @@ (def (createManualCells (session : SsdSession) (rect : FloatArray) (count : Int32)) : (MutableList String) - (let ((columns (manualCellColumns count))) - (let ((rows (manualCellRows count columns)) + (let ((grid (manualCellGridDimensions rect count))) + (let ((columns (pair-first grid)) + (rows (pair-second grid)) (width (let ((candidate (- (float-array-ref rect (int32 2)) (float-array-ref rect (int32 0))))) (if (> candidate (float32 1.0))