X-Git-Url: http://git.euphorik.ch/?a=blobdiff_plain;f=Parasitemia%2FParasitemiaUI%2FGUI.fs;h=0832a41985e18ae1563368303343597b32f65b5c;hb=refs%2Fheads%2Fmaster;hp=83e54c27f363f38776ee7e255f1f874b42a3c519;hpb=95f9edf71456c8bf89a91850800f66efc2c9d4da;p=master-thesis.git

diff --git a/Parasitemia/ParasitemiaUI/GUI.fs b/Parasitemia/ParasitemiaUI/GUI.fs
index 83e54c2..0832a41 100644
--- a/Parasitemia/ParasitemiaUI/GUI.fs
+++ b/Parasitemia/ParasitemiaUI/GUI.fs
@@ -18,6 +18,7 @@ open Types
 let run (defaultConfig : Config) (fileToOpen : string option) =
     let app = new Application ()
     let win = MainWindow ()
+    win.Title <- Constants.APPLICATION_NAME
 
     let state = State.State defaultConfig
     let mutable currentScale = 1.
@@ -50,17 +51,18 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
         frame.manuallyAdded.Fill <- color
         frame.border.Stroke <- color
 
-    let frameStrokeThickness (averageRBCSize : float) =
-        max 1. (averageRBCSize / 60.)
+    let frameStrokeThickness () =
+        state.CurrentImage |> Option.map (fun img -> max 1. (img.AverageRBCSize / 100.)) |> Option.defaultValue 1.
 
-    let frameFontSize (averageRBCSize : float) =
-        max 1. (averageRBCSize / 8.)
+    let frameFontSize () =
+        state.CurrentImage |> Option.map (fun img -> max 1. (img.AverageRBCSize / 6.)) |> Option.defaultValue 1.
 
-    let createRBCFrameFromExisting (srcImg : SourceImage) (rbc : RBC) (frame : RBCFrame) (frameThickness : float) (fontSize : float) : RBCFrame =
+    let createRBCFrameFromExisting (srcImg : SourceImage) (rbc : RBC) (frame : RBCFrame) (frameThickness : float) (fontSize : float) (isTextBelow : bool) : RBCFrame =
         frame.Visibility <- Visibility.Visible
         frame.Width <- rbc.size.Width
         frame.Height <- rbc.size.Height
         frame.Tag <- rbc
+        frame.IsTextBelow <- isTextBelow
         setRBCFrameStyle srcImg rbc frame
         frame.border.StrokeThickness <- frameThickness
         frame.txtRBCNumber.Text <- string rbc.num
@@ -80,14 +82,24 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
         statusMessageTimer.Stop ()
         statusMessageTimer.Start ()
 
-    let highlightRBCFrame (frame : RBCFrame) (highlight : bool) =
-        let rbc = frame.Tag :?> RBC
-        if highlight then
-            frame.border.StrokeThickness <- 3. * frame.border.StrokeThickness
-            if not rbc.infected && not rbc.setManually && not displayHealthy then frame.Opacity <- 1.
-        else
-            frame.border.StrokeThickness <- frame.border.StrokeThickness / 3.
-            if not rbc.infected && not rbc.setManually && not displayHealthy then frame.Opacity <- 0.
+    let highlightRBC (rbc : RBC) (highlight : bool) =
+        let highlightRBCFrame (rbcFrame : RBCFrame) (strokeThickness : float) =
+            if highlight then
+                rbcFrame.border.StrokeThickness <- 2. * strokeThickness
+                if not rbc.infected && not rbc.setManually && not displayHealthy then rbcFrame.Opacity <- 1.
+            else
+                rbcFrame.border.StrokeThickness <- strokeThickness
+                if not rbc.infected && not rbc.setManually && not displayHealthy then rbcFrame.Opacity <- 0.
+
+        for rbcFrame in win.stackRBC.Children |> Seq.cast<RBCFrame> do
+            if (rbcFrame.Tag :?> RBC) = rbc then
+                highlightRBCFrame rbcFrame 1.
+
+        let strokeThicknessCanvas = frameStrokeThickness ()
+
+        for rbcFrame in win.canvasCurrentImage.Children |> Seq.cast<RBCFrame> do
+            if (rbcFrame.Tag :?> RBC) = rbc then
+                highlightRBCFrame rbcFrame strokeThicknessCanvas
 
     let zoomToRBC (rbc : RBC) =
         win.scrollViewCurrentImage.ScrollToHorizontalOffset (rbc.center.X * currentScale - win.scrollViewCurrentImage.ViewportWidth / 2. + win.borderCurrentImage.BorderThickness.Left)
@@ -179,8 +191,8 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
         updateCurrentImageInformation ()
         updateGlobalParasitemia ()
 
-    and createRBCFrame (srcImg : SourceImage) (rbc : RBC) (frameThickness : float) (fontSize : float) : RBCFrame =
-        let frame = createRBCFrameFromExisting srcImg rbc (RBCFrame ()) frameThickness fontSize
+    and createRBCFrame (srcImg : SourceImage) (rbc : RBC) (frameThickness : float) (fontSize : float) (isTextBelow : bool) : RBCFrame =
+        let frame = createRBCFrameFromExisting srcImg rbc (RBCFrame ()) frameThickness fontSize isTextBelow
         frame.SetValue (Panel.ZIndexProperty, Int32.MaxValue - rbc.num) // To be sure the
         frame.menuRBCSetAsHealthy.Click.AddHandler (fun obj args -> setAsInfected srcImg (frame.Tag :?> RBC) false)
         frame.menuRBCSetAsInfected.Click.AddHandler (fun obj args -> setAsInfected srcImg (frame.Tag :?> RBC) true)
@@ -193,9 +205,9 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
                     frame.menuRBCSetAsHealthy.Visibility <- Visibility.Collapsed
                     frame.menuRBCSetAsInfected.Visibility <- Visibility.Visible
         )
-        frame.ContextMenuClosing.AddHandler (fun obj args -> if not frame.IsMouseOver then highlightRBCFrame frame false )
-        frame.MouseEnter.AddHandler (fun obj args -> highlightRBCFrame frame true)
-        frame.MouseLeave.AddHandler (fun obj args -> if not frame.grid.ContextMenu.IsOpen then highlightRBCFrame frame false)
+        frame.ContextMenuClosing.AddHandler (fun obj args -> if not frame.IsMouseOver then highlightRBC (frame.Tag :?> RBC) false )
+        frame.MouseEnter.AddHandler (fun obj args -> highlightRBC (frame.Tag :?> RBC) true)
+        frame.MouseLeave.AddHandler (fun obj args -> if not frame.grid.ContextMenu.IsOpen then highlightRBC (frame.Tag :?> RBC) false)
         frame
 
     and updateRBCFramesPreview () =
@@ -205,9 +217,9 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
             for rbc in srcImg.RBCs |> List.filter (fun rbc -> displayHealthy || rbc.infected) do
                 let previewInfected =
                     if currentPreview < win.stackRBC.Children.Count then
-                        createRBCFrameFromExisting srcImg rbc (win.stackRBC.Children.[currentPreview] :?> RBCFrame) 1. 12.
+                        createRBCFrameFromExisting srcImg rbc (win.stackRBC.Children.[currentPreview] :?> RBCFrame) 1. 12. false
                     else
-                        let f = createRBCFrame srcImg rbc 1. 12.
+                        let f = createRBCFrame srcImg rbc 1. 12. false
                         f.MouseLeftButtonUp.AddHandler (fun obj args -> zoomToRBC (f.Tag :?> RBC))
                         win.stackRBC.Children.Add f |> ignore
                         f
@@ -227,14 +239,14 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
         match state.CurrentImage with
         | Some srcImg ->
             let mutable currentCanvas = 0
-            let strokeThickness = frameStrokeThickness srcImg.AverageRBCSize
-            let fontSize = frameFontSize srcImg.AverageRBCSize
+            let strokeThickness = frameStrokeThickness ()
+            let fontSize = frameFontSize ()
             for rbc in srcImg.RBCs do
                 let frame =
                     if currentCanvas < win.canvasCurrentImage.Children.Count then
-                        createRBCFrameFromExisting srcImg rbc (win.canvasCurrentImage.Children.[currentCanvas] :?> RBCFrame) strokeThickness fontSize
+                        createRBCFrameFromExisting srcImg rbc (win.canvasCurrentImage.Children.[currentCanvas] :?> RBCFrame) strokeThickness fontSize true
                     else
-                        let f = createRBCFrame srcImg rbc strokeThickness fontSize
+                        let f = createRBCFrame srcImg rbc strokeThickness fontSize true
                         win.canvasCurrentImage.Children.Add f |> ignore
                         f
 
@@ -390,6 +402,9 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
         updateDocumentStatus ()
 
     let loadFile (filepath : string) =
+        let displayLoadingErrorMessage (message : string) =
+            MessageBox.Show (sprintf "The document cannot be loaded from \"%s\": %s" filepath message, "Error loading the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
+
         askSaveCurrent ()
         let previousFilePath = state.FilePath
         try
@@ -397,10 +412,14 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
             state.Load ()
             updateGUI ()
         with
+        | PiaZ.VersionFileNewerException fileVersion ->
+            state.FilePath <- previousFilePath
+            displayLoadingErrorMessage $"File version ({fileVersion}) is newer than supported one ({PiaZ.CURRENT_FILE_VERSION}), you may update Parasitemia to the latest version"
+
         | :? IOException as ex ->
             Log.Error "%O" ex
             state.FilePath <- previousFilePath
-            MessageBox.Show (sprintf "The document cannot be loaded from \"%s\"" filepath, "Error loading the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
+            displayLoadingErrorMessage "IO Error"
 
     let askLoadFile () =
         let dialog = OpenFileDialog (Filter = PiaZ.filter)
@@ -432,7 +451,7 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
                 MessageBox.Show (sprintf "The results cannot be exported in \"%s\"" state.FilePath, "Error exporting the files", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
 
     let importImage () =
-        let dialog = OpenFileDialog (Filter = "Image Files|*.png;*.jpg;*.tif;*.tiff", Multiselect = true)
+        let dialog = OpenFileDialog (Filter = "Image Files|*.png;*.jpg;.jpeg;.bmp;*.tif;*.tiff", Multiselect = true)
         let res = dialog.ShowDialog ()
         if res.HasValue && res.Value then
             let noSourceImage = state.SourceImages.Count () = 0
@@ -579,7 +598,7 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
     // Save.
     win.InputBindings.Add (
         Input.KeyBinding (
-            ViewModule.FunCommand ((fun obj -> saveCurrentDocument ()), (fun obj -> true)),
+            Utils.FunCommand ((fun obj -> saveCurrentDocument ()), (fun obj -> true)),
             Input.KeyGesture (Input.Key.S, Input.ModifierKeys.Control)
         )
     ) |> ignore
@@ -587,7 +606,7 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
     // Save as.
     win.InputBindings.Add (
         Input.KeyBinding (
-            ViewModule.FunCommand ((fun obj -> saveCurrentDocumentAsNewFile ()), (fun obj -> true)),
+            Utils.FunCommand ((fun obj -> saveCurrentDocumentAsNewFile ()), (fun obj -> true)),
             Input.KeyGesture (Input.Key.S, Input.ModifierKeys.Control ||| Input.ModifierKeys.Shift)
         )
     ) |> ignore
@@ -595,7 +614,7 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
     // Open.
     win.InputBindings.Add (
         Input.KeyBinding (
-            ViewModule.FunCommand ((fun obj -> askLoadFile ()), (fun obj -> true)),
+            Utils.FunCommand ((fun obj -> askLoadFile ()), (fun obj -> true)),
             Input.KeyGesture (Input.Key.O, Input.ModifierKeys.Control)
         )
     ) |> ignore
@@ -603,7 +622,7 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
     // New file.
     win.InputBindings.Add (
         Input.KeyBinding (
-            ViewModule.FunCommand ((fun obj -> newFile ()), (fun obj -> true)),
+            Utils.FunCommand ((fun obj -> newFile ()), (fun obj -> true)),
             Input.KeyGesture (Input.Key.N, Input.ModifierKeys.Control)
         )
     ) |> ignore
@@ -611,7 +630,7 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
     // Export results.
     win.InputBindings.Add (
         Input.KeyBinding (
-            ViewModule.FunCommand ((fun obj -> exportResults ()), (fun obj -> true)),
+            Utils.FunCommand ((fun obj -> exportResults ()), (fun obj -> true)),
             Input.KeyGesture (Input.Key.E, Input.ModifierKeys.Control)
         )
     ) |> ignore
@@ -619,7 +638,7 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
     // Import an image.
     win.InputBindings.Add (
         Input.KeyBinding (
-            ViewModule.FunCommand ((fun obj -> importImage ()), (fun obj -> true)),
+            Utils.FunCommand ((fun obj -> importImage ()), (fun obj -> true)),
             Input.KeyGesture (Input.Key.A, Input.ModifierKeys.Control)
         )
     ) |> ignore
@@ -627,7 +646,7 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
     // Show analysis dialog.
     win.InputBindings.Add (
         Input.KeyBinding (
-            ViewModule.FunCommand ((fun obj -> showAnalysisWindow ()), (fun obj -> state.SourceImages.Count () > 0)),
+            Utils.FunCommand ((fun obj -> showAnalysisWindow ()), (fun obj -> state.SourceImages.Count () > 0)),
             Input.KeyGesture (Input.Key.Y, Input.ModifierKeys.Control)
         )
     ) |> ignore
@@ -635,7 +654,7 @@ let run (defaultConfig : Config) (fileToOpen : string option) =
     // Toggle RBC highlight.
     win.InputBindings.Add (
         Input.KeyBinding (
-            ViewModule.FunCommand (
+            Utils.FunCommand (
                 (
                     fun obj ->
                         win.menuHightlightRBC.IsChecked <- not win.menuHightlightRBC.IsChecked