Calibration.hs

-- | Performs the calibration by runing the person finder for a few seconds or
-- until a person is recognized.
module Controller.Conditions.Calibration (calibrate) where

-- External imports
import           Control.Concurrent
import qualified Control.Exception       as E
import           Control.Exception.Extra
import           Control.Monad
import           Data.Maybe
import           Graphics.UI.Gtk         hiding (Image)

-- Internal imports
import CombinedEnvironment
import Model.Model (Status(..))
import Hails.MVC.Model.ProtectedModel.Reactive
import Paths
import I18N.Strings
import AI.CV.PostureProcessors

-- The following function is executed in a separate thread so that the
-- notification viewers are updated and the system remains responsive.
calibrate :: CEnv -> IO()
calibrate cenv = void $ forkOS $ do

 let pm = model cenv
 setStatus pm StatusCallibrating

 -- Remember if the system was enabled and restore the same state later.
 enabled <- getter notificationEnabledField pm
 setter notificationEnabledField pm False

 -- This value is completely random. It simply works, but there must be a
 -- better way.
 threadDelay 1000000

 -- What for the detector to die
 waitForDetector pm

 E.handle (anyway (do setter calibrationParamsField pm (Nothing :: Maybe (Int, Int, Int, Int))
                      wrongCam pm
                      showCalibrationResults cenv Nothing
                  )) $ do

   -- Run for a few seconds or until once face is detected
   cam <- getter cameraField pm
   res <- runFinder cam
   setter calibrationParamsField pm res

   -- If calibration went ok, reset the previous notification status
   when (isJust res) $ setter notificationEnabledField pm enabled

    -- TODO: Place the image in the pixbuf
   showCalibrationResults cenv res

    -- TODO: Enable the buttons

 -- Maybe this should appear somewhere else? But careful with the previous handle
 setStatus pm StatusIdle

-- | Present the calibration results (adapting the images and labels in the
-- dialog)
--
-- cvs is (Just _) if calibration went ok, otherwise it's Nothing
showCalibrationResults :: CEnv -> Maybe (Int, Int, Int, Int) -> IO()
showCalibrationResults cenv cvs = onViewAsync $ do
  let ui = mainWindowBuilder $ view cenv

  lblT   <- calibrationTitleLbl ui
  lblE   <- calibrationExplanationLbl ui
  calImg <- calibrationImage ui
  if isJust cvs
   then do fn <- getDataFileName "calibration-ok.png"
           imageSetFromFile calImg fn
           labelSetMarkup lblT title3
           labelSetText lblE explanation3
   else do fn <- getDataFileName "calibration-wrong.png"
           imageSetFromFile calImg fn
           labelSetMarkup lblT title2
           labelSetText lblE explanation2
    
  -- Showing the capture on the screen
  -- when (isJust img && length cvs == 1) $
  --   imageSetFromPixbuf calImg (fromJust img)

  btn1 <- calibrationCloseBtn ui
  btn2 <- calibrationRecalibrateBtn ui

  widgetSetSensitive btn1 True
  widgetSetSensitive btn2 True