diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,4 +1,9 @@ 2015-10-28 Ivan Perez + + * keera-posture.cabal: Adapts K Posture to K Hails 0.2. Bump (0.2.2). + +2015-10-28 Ivan Perez + * keera-posture.cabal: Relaxes dependencies, version bump (0.2.1). 2015-06-20 Ivan Perez diff --git a/keera-posture.cabal b/keera-posture.cabal --- a/keera-posture.cabal +++ b/keera-posture.cabal @@ -6,7 +6,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.2.1 +Version: 0.2.2 -- A short (one-line) description of the package. Synopsis: Get notifications when your sitting posture is inappropriate. @@ -36,6 +36,8 @@ -- Stability of the package (experimental, provisional, stable...) -- Stability: Experimental +Tested-With: GHC == 7.6.3 + Category: AI Build-type: Simple @@ -104,9 +106,9 @@ keera-hails-reactive-gtk, keera-hails-mvc-controller, keera-hails-mvc-solutions-config, - keera-hails-reactivevalues + keera-hails-reactivevalues > 0.2 else - Build-depends: base >= 4.0 && < 5, + Build-depends: base >= 4.0 && < 5, containers, cv-combinators, cmdargs, @@ -142,7 +144,7 @@ keera-hails-reactive-gtk, keera-hails-mvc-controller, keera-hails-mvc-solutions-config, - keera-hails-reactivevalues + keera-hails-reactivevalues > 0.2 -- Modules not exported by this package. Other-modules: Audio, diff --git a/src/Controller.hs b/src/Controller.hs --- a/src/Controller.hs +++ b/src/Controller.hs @@ -25,7 +25,7 @@ -- installing the hanlders for all the conditions -- and starting the view. startController :: IO () -startController = do +startController = do handleAllExceptions reportSevereError $ do myPutStrLn "Starting Keera Posture" installLanguage "keera-posture" @@ -60,16 +60,16 @@ -- Initialise the visual layer initView - + -- Create an empty model cenv <- createCEnv emptyBM - + -- Install the model and view handlers installHandlers cenv - + -- Modify the system initialisation initialiseSystem $ model cenv - + -- Run the view startView diff --git a/src/Controller/Conditions/Detector.hs b/src/Controller/Conditions/Detector.hs --- a/src/Controller/Conditions/Detector.hs +++ b/src/Controller/Conditions/Detector.hs @@ -38,7 +38,7 @@ when (isJust cal) $ E.handle (anyway $ wrongCam pm) $ do state <- createInitialState - let params = DetectionParams (fromJust cal) cor del + let params = DetectionParams (fromJust cal) cor del detectorProc <- initialiseDetector cam params state setter cameraStatusField pm (Just True) void $ detectorProc `runTill` updateStatus cenv params @@ -87,7 +87,7 @@ -- detection parameters updateStatus :: CEnv -> DetectionParams -> InternalState -> IO Bool updateStatus cenv params state = do - + -- Guarded rule: when detection is enabled, the posture status -- will be reflected in the application -- @@ -106,7 +106,7 @@ when detectionEnabled $ setter statusField pm (newStatus (detectionStatus params state)) return $ not detectionEnabled - + -- | Computes the new global state depending on the detection results newStatus :: DetectionStatus -> Status newStatus DetectionOk = StatusIdle diff --git a/src/Controller/Conditions/MenuEnabledClick.hs b/src/Controller/Conditions/MenuEnabledClick.hs --- a/src/Controller/Conditions/MenuEnabledClick.hs +++ b/src/Controller/Conditions/MenuEnabledClick.hs @@ -7,7 +7,7 @@ import Graphics.UI.Gtk.Reactive import CombinedEnvironment -import Model.Model (Status(..), isDisabled, isCalibrating) +import Model.Model (Status(..), isEnabled, isCalibrating) import Hails.MVC.Model.ProtectedModel.Reactive -- Detects interaction with the main window and the tray icon @@ -41,7 +41,7 @@ -- Disable notification if it was calibrating let notifEnabled = mkFieldAccessor notificationEnabledField (model cenv) - statusIfMustCalibrate =:> (isDisabled `liftW` notifEnabled) + statusIfMustCalibrate =:> (isEnabled `liftW` notifEnabled) nextState :: Status -> Status nextState StatusDisabled = StatusIdle @@ -58,11 +58,11 @@ -- -- Close the menu if the option is selected -- menu <- mainMenu $ mainWindowBuilder $ view cenv -- menuPopdown menu --- +-- -- -- status <- getStatus pm -- -- notifyEnabled <- getter notificationEnabledField pm --- - -- case status of +-- + -- case status of -- StatusDisabled -> do setStatus pm StatusIdle -- setter notificationEnabledField pm True -- StatusCallibrating -> return () diff --git a/src/Controller/Conditions/Precalibration.hs b/src/Controller/Conditions/Precalibration.hs --- a/src/Controller/Conditions/Precalibration.hs +++ b/src/Controller/Conditions/Precalibration.hs @@ -25,7 +25,7 @@ -- Signal that triggers changes let precalibrationNext = lMerge (windowCloseReactive preWin) - (buttonActivateField btn) + (buttonActivateField btn) -- Hide the precalibration window precalibrationNext =:> constW False (widgetVisibleReactive preWin) @@ -44,14 +44,14 @@ calImg <- calibrationImage ui fn <- getDataFileName "calibration-preview.png" - precalibrationNext =:> - ( (constW False (btnClsSensitive &&& btnCalSensitive)) - &&& (constW title1 (labelTextReactive lblT)) - &&& (constW explanation1 (labelTextReactive lblE)) - &&& (constW fn (imageFileReactive calImg)) - &&& (wrapDo_ (calibrate cenv)) + precalibrationNext =:> + ( (constW False (btnClsSensitive &.& btnCalSensitive)) + &.& (constW title1 (labelTextReactive lblT)) + &.& (constW explanation1 (labelTextReactive lblE)) + &.& (constW fn (imageFileReactive calImg)) + &.& (wrapDo_ (calibrate cenv)) ) - + -- import Graphics.UI.Gtk ---- | Hides the dialog when necessary, and shows the next step --condition :: CEnv -> IO() @@ -79,7 +79,7 @@ -- -- lblE <- calibrationExplanationLbl ui -- reactiveValueWrite (labelTextReactive lblE) title1 --- +-- -- calImg <- calibrationImage ui -- fn <- getDataFileName "calibration-preview.png" -- reactiveValueWrite (imageFileReactive calImg) fn diff --git a/src/Controller/Conditions/Quit.hs b/src/Controller/Conditions/Quit.hs --- a/src/Controller/Conditions/Quit.hs +++ b/src/Controller/Conditions/Quit.hs @@ -16,9 +16,8 @@ menuItemActivateField menu =:> ( (constW False (statusIconVisibleReactive icon)) - &&& (wrapDo_ mainQuit) + &.& (wrapDo_ mainQuit) ) - -- -- | Deinstalls the status icon and stops the view, effectively stopping the -- -- whole program. diff --git a/src/Controller/Conditions/Status.hs b/src/Controller/Conditions/Status.hs --- a/src/Controller/Conditions/Status.hs +++ b/src/Controller/Conditions/Status.hs @@ -27,7 +27,7 @@ fmap not $ statusIconIsEmbedded =<< (trayIcon . mainWindowBuilder . view) cenv where pm = model cenv - evs = [ Initialised, StatusChanged, CameraStatusChanged + evs = [ Initialised, StatusChanged, CameraStatusChanged , NotificationEnabledChanged, updateNotificationEvent ] ++ events notificationEnabledField @@ -40,7 +40,7 @@ condition cenv = onViewAsync $ do let (vw, pm) = (view &&& model) cenv -- View - icon <- trayIcon $ mainWindowBuilder vw + icon <- trayIcon $ mainWindowBuilder vw -- Model status <- getStatus pm @@ -62,7 +62,7 @@ -- | Table that determines the status image to be used depeding on the internal -- status of the program. --- +-- -- getStatusIcon -- getStatusIcon :: Bool -> Bool -> Status -> Bool -> Maybe (String, String) diff --git a/src/Model/Model.hs b/src/Model/Model.hs --- a/src/Model/Model.hs +++ b/src/Model/Model.hs @@ -1,5 +1,5 @@ -- | This model holds a complete set status of the program. It has some --- additional invariants that must always be respected. +-- additional invariants that must always be respected. module Model.Model where import Data.ExtraVersion @@ -90,7 +90,7 @@ deriving (Eq) -- | Possible detection methods to be used -data DetectionMethods = DetectionMethods +data DetectionMethods = DetectionMethods { detectionSlouchingEnabled :: Bool , detectionHunchingEnabled :: Bool } @@ -112,6 +112,12 @@ isDisabled StatusDisabled = True isDisabled _ = False +isEnabled :: Status -> Bool +isEnabled StatusIdle = True +isEnabled StatusFinding = True +isEnabled StatusNotifying = True +isEnabled _ = False + -- | Languages supported by this program data Language = English | Galician @@ -126,7 +132,7 @@ language = Just English , checkUpdates = True , sendReports = True - + -- Notification params , notificationEnabled = False , notificationMethods = NotificationMethods { notificationIconEnabled = True @@ -135,34 +141,34 @@ , notificationOverlayEnabled = True } , notificationDelay = 8 - + -- Algorithm params , detectionMethods = DetectionMethods { detectionSlouchingEnabled = True , detectionHunchingEnabled = True } - + , camera = 0 , cameraStatus = Nothing -- , cameraList = [] , calibrationParams = Nothing -- Just (287, 122, 232, 232) , correctionFactor = 0 - + -- Current status , status = StatusIdle , detectorRunning = False - + -- Sound , sound = Nothing , soundFilename = Nothing , playing = False - + -- Update check , programName = "Keera Posture" , programVersion = Version 0 1 ReleaseCandidate 0 , programMaxVersion = Nothing , programUpdateURI = "http://www.keera.es/projects/keera-posture/newest-version" - + , firstRun = Nothing }