make scrolling work better

Mends Ctrl-W when opening a file
Simplifies the complex logic allowing both programmatic and user scrolling

src/Renderer/DrawBlock/Sheet.fs

@@ -21,6 +21,17 @@ open BusWireRoutingHelpers
 /// Set in view function from react hook.
 let mutable canvasDiv:Types.Element option = None
 
+/// Used to filter OnScroll messages caused by recent scroll updates.
+/// These could reset scroll back to some previous value.
+let mutable recentProgrammaticScrollPos: XYPos list = []
+
+/// Used to filter out-of-sequence OnScroll messages.
+/// These could reset scroll to some previous value.
+/// Incremented by program UpdateScroll and OnScroll.
+let mutable scrollSequence: int = 0
+
+
+
 //-------------------------------------------------------------------------------------------------//
 //-----------------------------------Constants used in Sheet---------------------------------------//
 //-------------------------------------------------------------------------------------------------//
@@ -439,11 +450,12 @@ let ensureCanvasExtendsBeyondScreen model : Model =
  X = if xIsOk then 0. else newSize/2.- centre.X
  Y = if yIsOk then 0. else newSize/2. - centre.Y
  })
-
+ scrollSequence <- scrollSequence + 1
  match canvasDiv, model.ScreenScrollPos + circuitMove*model.Zoom with
  | Some el, pos ->
  el.scrollLeft <- pos.X
  el.scrollTop <- pos.Y
+
  | None,_-> ()
  let posDelta :(XYPos -> XYPos) = ((+) circuitMove)
  let posScreenDelta :(XYPos -> XYPos) = ((+) (circuitMove*model.Zoom))

src/Renderer/DrawBlock/SheetDisplay.fs

@@ -13,8 +13,9 @@ open Sheet
 open SheetSnap
 
 /// This actually writes to the DOM a new scroll position.
-/// In the special case that DOM has not yel been created it does nothing.
+/// In the special case that DOM has not yet been created it does nothing.
 let writeCanvasScroll (scrollPos:XYPos) =
+ //printf "%s" $"***writing canvas scroll: {scrollPos.X},{scrollPos.Y}"
  canvasDiv
  |> Option.iter (fun el -> el.scrollLeft <- scrollPos.X; el.scrollTop <- scrollPos.Y)
 
@@ -79,12 +80,14 @@ let displaySvgWithZoom
  OnMouseDown (fun ev -> (mouseOp Down ev))
  OnMouseUp (fun ev -> (mouseOp Up ev))
  OnMouseMove (fun ev -> mouseOp (if mDown ev then Drag else Move) ev)
- OnScroll (fun _ -> dispatch <| (UpdateScrollPosFromCanvas dispatch))
+ OnScroll (fun _ ->
+ match canvasDiv with
+ | None -> ()
+ |Some el ->
+ dispatch <| UpdateScrollPosFromCanvas(scrollSequence,{X= el.scrollLeft; Y=el.scrollTop}, dispatch))
  Ref (fun el ->
  canvasDiv <- Some el
- writeCanvasScroll model.ScreenScrollPos
- )
-
+ writeCanvasScroll model.ScreenScrollPos)
  OnWheel wheelUpdate
  ]
  [

src/Renderer/DrawBlock/SheetUpdate.fs

@@ -196,16 +196,8 @@ let update (msg : Msg) (issieModel : ModelType.Model): ModelType.Model*Cmd<Model
  wireCmd (BusWireT.SelectWires wires) ]
 
  | KeyPress CtrlW ->
- let model', paras = fitCircuitToWindowParas model
- writeCanvasScroll paras.Scroll
- model', 
- Cmd.batch 
- [
- sheetCmd (UpdateScrollPos paras.Scroll)
- sheetCmd UpdateBoundingBoxes
- ]
+ fitCircuitToScreenUpdate model
 
-
  | PortMovementStart ->
  match model.Action with
  | Idle -> 
@@ -254,45 +246,41 @@ let update (msg : Msg) (issieModel : ModelType.Model): ModelType.Model*Cmd<Model
  , Cmd.none
  | false -> model, Cmd.none
 
- | UpdateScrollPosFromCanvas dispatch ->
+ | UpdateScrollPosFromCanvas(sequence, pos, dispatch) ->
  let model =
- match canvasDiv with
- | None -> model
- | Some el -> 
- let canvas = document.getElementById "Canvas"
- // UpdateScrollPos here is needed to make CheckAutomaticScrolling work properly
- // Possibly UpdateScrollPos must be after view to trigger the next checkAutomaticScrolling
- // When checkAutomaticScrolling is sone in a better way, this could be removed
- dispatch <| UpdateScrollPos {X=canvas.scrollLeft; Y=canvas.scrollTop} 
- {model with ScreenScrollPos = {X= el.scrollLeft; Y = el.scrollTop}}
+ match sequence - scrollSequence >= 0, canvasDiv with
+ | _, None | false, _ -> model
+ | true, Some el -> 
+ recentProgrammaticScrollPos
+ |> List.exists (fun recent -> euclideanDistance recent pos < 0.001 )
+ |> function | true -> model
+  | false ->
+  //printfn "%s" $"Canvas -> model {pos.X},{pos.Y}"
+  {model with ScreenScrollPos = pos}
  model, Cmd.none
 
 
  | UpdateScrollPos scrollPos ->
- if model.ScrollUpdateIsOutstanding then 
- model, Cmd.none
- else
- let scrollDif = scrollPos - model.ScreenScrollPos
- let newLastScrollingPos =
- {
- Pos =
- {
- X = model.ScrollingLastMousePos.Pos.X + scrollDif.X / model.Zoom
- Y = model.ScrollingLastMousePos.Pos.Y + scrollDif.Y / model.Zoom
- }
- Move = model.ScrollingLastMousePos.Move
- }
- let cmd =
- if model.AutomaticScrolling then
- sheetCmd CheckAutomaticScrolling // Also check if there is automatic scrolling to continue
- else
- Cmd.none
- //Sheet.writeCanvasScroll scrollPos 
- { model with 
- ScreenScrollPos = scrollPos
- ScrollUpdateIsOutstanding = false
- ScrollingLastMousePos = newLastScrollingPos }, 
- cmd
+ //printfn "%s" $"Model -> canvas {scrollPos.X},{scrollPos.Y}"
+ let scrollDif = scrollPos - model.ScreenScrollPos * (1. / model.Zoom)
+ let newLastScrollingPos =
+ {
+ Pos = model.ScrollingLastMousePos.Pos + scrollDif
+ Move = model.ScrollingLastMousePos.Move
+ }
+ let cmd =
+ if model.AutomaticScrolling then
+ sheetCmd CheckAutomaticScrolling // Also check if there is automatic scrolling to continue
+ else
+ Cmd.none
+ // keep last 4 updates yo filte corresponding OnScroll events
+ recentProgrammaticScrollPos <- scrollPos :: List.truncate 4 recentProgrammaticScrollPos
+ scrollSequence <- scrollSequence + 1 // increment sequence counter
+ writeCanvasScroll scrollPos
+ { model with 
+ ScreenScrollPos = scrollPos
+ ScrollingLastMousePos = newLastScrollingPos }, 
+ cmd
 
  | AddNotConnected (ldcs, port, pos, rotation) ->
  let (newSymModel, ncID) = SymbolUpdate.addSymbol ldcs model.Wire.Symbol pos NotConnected ""
@@ -335,6 +323,7 @@ let update (msg : Msg) (issieModel : ModelType.Model): ModelType.Model*Cmd<Model
  let requiredOffset = oldScreenCentre - newScreenCentre
 
  // Update screen so that the zoom is centred around the middle of the screen.
+ printf "KeepZoomCentred"
  canvas.scrollLeft <- canvas.scrollLeft + requiredOffset.X * model.Zoom
  canvas.scrollTop <- canvas.scrollTop + requiredOffset.Y * model.Zoom
  model, Cmd.none
@@ -382,9 +371,10 @@ let update (msg : Msg) (issieModel : ModelType.Model): ModelType.Model*Cmd<Model
  let edgeDistance = abs (edge - mPos)
 
  if edgeDistance < scrollMargin && mMov >= -0.0000001 // just in case there are FP rounding errors
- then scrollSpeed * (scrollMargin - edgeDistance) / scrollMargin // Speed should be faster the closer the mouse is to the screen edge
+ then
+ //printf "automaticScrolling adjustment..."
+ scrollSpeed * (scrollMargin - edgeDistance) / scrollMargin // Speed should be faster the closer the mouse is to the screen edge
  else 0.0
-
  canvas.scrollLeft <- canvas.scrollLeft - (checkForAutomaticScrolling1D leftScreenEdge mPosX -mMovX) // Check left-screen edge
  canvas.scrollLeft <- canvas.scrollLeft + (checkForAutomaticScrolling1D rightScreenEdge mPosX mMovX) // Check right-screen edge
  canvas.scrollTop <- canvas.scrollTop - (checkForAutomaticScrolling1D upperScreenEdge mPosY -mMovY) // Check upper-screen edge
@@ -929,7 +919,6 @@ let init () =
  MouseCounter = 0
  LastMousePosForSnap = { X = 0.0; Y = 0.0 }
  CtrlKeyDown = false
- ScrollUpdateIsOutstanding = false
  PrevWireSelection = []
  Compiling = false
  CompilationStatus = {Synthesis = Queued; PlaceAndRoute = Queued; Generate = Queued; Upload = Queued}

src/Renderer/DrawBlock/SheetUpdateHelpers.fs

@@ -14,7 +14,15 @@ open BusWireRoutingHelpers
 open BlockHelpers
 open Browser
 
-
+let fitCircuitToScreenUpdate (model: Model) =
+ let model', paras = fitCircuitToWindowParas model
+ printf "Calculated Scroll = %A" paras.Scroll
+ model', 
+ Cmd.batch 
+ [
+ sheetCmd (SheetT.Msg.UpdateScrollPos paras.Scroll)
+ sheetCmd SheetT.Msg.UpdateBoundingBoxes
+ ]
 
 let rotateLabel (sym:Symbol) =
  let newRot =

src/Renderer/Model/DrawModelType.fs

@@ -537,7 +537,7 @@ module SheetT =
  | UpdateBoundingBoxes
  | UpdateSingleBoundingBox of ComponentId
  | UpdateScrollPos of XYPos
- | UpdateScrollPosFromCanvas of dispatch: ( Msg -> Unit)
+ | UpdateScrollPosFromCanvas of sequence: int * pos: XYPos * dispatch: ( Msg -> Unit)
  | AddNotConnected of (LoadedComponent list) * port:Port * pos:XYPos * rotation:Rotation
  | ManualKeyUp of string // For manual key-press checking, e.g. CtrlC
  | ManualKeyDown of string // For manual key-press checking, e.g. CtrlC
@@ -641,7 +641,6 @@ module SheetT =
  LastMousePosForSnap: XYPos
  MouseCounter: int
  CtrlKeyDown : bool
- ScrollUpdateIsOutstanding: bool
  PrevWireSelection : ConnectionId list
  ScalingBox: ScalingBox Option
  Compiling: bool

src/Renderer/Renderer.fs

@@ -147,7 +147,9 @@ let fileMenu (dispatch) =
  debugTraceUI <- Set.ofList ["update"])
  makeWinDebugItem "Trace off" None (fun _ ->
  debugTraceUI <- Set.ofList [])
- makeMenu false "Play" [
+ makeMenu false "Play" [
+ makeDebugItem "Set Scroll" None
+ (fun _ -> SheetDisplay.writeCanvasScroll {X=1000.;Y=1000.})
  makeDebugItem "Trace all times" None
  (fun _ -> TimeHelpers.instrumentation <- TimeHelpers.ImmediatePrint( 0.1, 0.1)
  if debugTraceUI = Set.ofList [] then debugTraceUI <- Set.ofList ["update";"view"])

src/Renderer/UI/FileMenuHelpers.fs

@@ -680,8 +680,11 @@ let private loadStateIntoModel (finishUI:bool) (compToSetup:LoadedComponent) wav
  // after the ctrl-w. We need anotehr ctrl-w to make sure this scroll event does not reset scroll
  // the order in which messages get processed is problematic here - and the solution ad hoc - a better
  // solution would be to understand exactly what determines event order in the event queue
- dispatch <| Sheet (SheetT.KeyPress SheetT.KeyboardMsg.CtrlW)
- dispatch SynchroniseCanvas
+ //dispatch <| Sheet (SheetT.KeyPress SheetT.KeyboardMsg.CtrlW)
+ //dispatch SynchroniseCanvas
+ //dispatch <| Sheet (SheetT.KeyPress SheetT.KeyboardMsg.CtrlW)
+ //dispatch SynchroniseCanvas
+
 
 /// Load a new project as defined by parameters.
 /// Ends any existing simulation