DefaultGUI.hs

{-#LANGUAGE FlexibleInstances , FlexibleContexts, DoRec, NoMonomorphismRestriction, TypeFamilies #-}
module Graphics.Tools.DefaultGUI (
   defaultGUI,
   testFunction,
   module Graphics.Tools.Tangible,
   module Graphics.Tools.Tangible.Instances,
   module Utils.Persist,
   module Graphics.Tools.WX,
   module GHC.Generics
   ) where

import Graphics.UI.WX hiding (image,value,parent,get)
import qualified Graphics.UI.WX as WX (value,parent,get)
import Graphics.Tools.WX
import Graphics.Tools.CV2WX()
import CV.Image as CV
import CV.Filters

import Data.IORef
import Control.Applicative
import Utils.Persist

import System.Directory (doesFileExist)
import qualified Data.Map as Map
import Graphics.Tools.Tangible
import Graphics.Tools.Tangible.Instances
import GHC.Generics

defaultGUI
  :: (Tangible α,
      Persist α,
      Default α,
      WxPaintable β,
      WxImage  (Image c d),
      Loadable (Image c d)) =>
        FilePath -- ^ File to store the filter parameters in
     -> FilePath -- ^ Initial image file
     -> (α -> Image c d -> β) -- ^ The processing function
     -> IO ()
defaultGUI storeFile imageFile = start . buildGUI imageFile . mkGUIOp storeFile

testFunction :: Int -> Image GrayScale  D32 -> Image GrayScale D32
testFunction i img = (!!i) . iterate (gaussian (3,3)) $ img

type GUIOp c d=
   IORef (Image c d)
   -> Frame () -> Panel () -> Frame ()
   -> IO (IO ())

mkGUIOp :: (Persist α, Default α, Tangible α, WxPaintable β) =>
      FilePath               -- ^ File to persist parameters
   -> (α -> Image c d -> β)  -- ^ A function to transform a tangible value and image to something
                             --   that WX knows how to paint
   -> GUIOp c d              -- ^ Operation that can be given to `defaultMain`

mkGUIOp storeFile function imageRef frame surface controls =
  let update lastValue value = do
         image <- readIORef imageRef
         let display = function value image
         set frame [outerSize := paintSize display]
         updateSurface surface display
         store <- readIORef lastValue
         let store' = Map.union (put "" value) store
         writeIORef lastValue store'
         writeFile storeFile (show store')
  in do
      e <- doesFileExist storeFile
      store  <- if e then read <$> readFile storeFile else return Map.empty
      lastValue <- newIORef store
      c <- present (get "" store) (update lastValue) controls
      set controls [layout := widget c]
      return (readIORef lastValue >>= update lastValue . get "")

buildGUI :: (WxImage (Image c d), Loadable (Image c d)) =>
            FilePath -> GUIOp c d -> IO ()
buildGUI imagePath guiOp = do
  -- Program state
  image <- CV.readFromFile imagePath
  imageRef <- newIORef image

  -- Main window
  f <- frame [ text := "Filter Tuner" ]

  -- Create the menu
  file   <- menuPane [text := "&File"]
  mopen  <- menuItem file [text  := "&Open Image\tCtrl+O"
                          , help := "Open image to be processed"]
  msave  <- menuItem file [text  := "&Save Image\tCtrl+O"
                          , help := "Save current image"]
  mclose <- menuQuit file []
  set f [menuBar := [file]]

  -- Create the image viewer
  imgPanel <- panel f []
  surface <- createSurface imgPanel image

  -- Create the control panel
  controls <- frameTool [] f
  update <- guiOp imageRef f surface controls

  -- Hook everything together
  set f [on (menu mopen)  := openFile f imageRef >> update
        ,on (menu mclose) := close f
        ,on (menu msave)  := saveFile f imageRef
                             ]
  set f [layout := row 2 [widget imgPanel]]

  -- Make sure the image is current
  set f [on idle := update >> return False]
  return ()

saveFile :: Window a -> IORef (Image c d) -> IO ()
saveFile f imageRef = do
  file <- fileSaveDialog f True False "Save as" [("Image file",["*.png","*.jpg","*.tif","*.tiff"])] "" ""
  case file of
   Nothing -> return ()
   Just filename -> readIORef imageRef >>= saveImage filename

openFile :: (CV.Sized a1, Loadable a1, CV.Size a1 ~ (Int, Int)) =>
            Window a -> IORef a1 -> IO ()
openFile f imageRef = do
   file <- fileOpenDialog f True True "Select Image"
             [("Image file",["*.png","*.jpg","*.tif","*.tiff"])] "" ""
   case file of
    Nothing -> return ()
    Just newFile -> do
                     img <- readFromFile newFile
                     writeIORef imageRef img

imageSize :: (Num b, CV.Sized a, CV.Size a ~ (b, b)) => a -> Size2D b
imageSize = uncurry Size . getSize

paintSurface' :: WxPaintable p => p -> DC a -> t -> IO ()
paintSurface' p dc _ = doPaint dc (point 0 0) p

createSurface :: WxPaintable p => Window a -> p -> IO (Panel ())
createSurface f p =
  panel f [ on paint := paintSurface' p, outerSize := paintSize p ]

updateSurface :: (Paint w, Dimensions w, WxPaintable p) => w -> p -> IO ()
updateSurface s p = do
  set s [ on paint := paintSurface p, outerSize := paintSize p ]
  repaint s

paintSurface :: WxPaintable p => p -> DC a -> t -> IO ()
paintSurface p dc _ = doPaint dc (point 0 0) p