keera-posture 0.2.1 → 0.2.2
raw patch · 9 files changed
+52/−40 lines, 9 filesdep ~keera-hails-reactivevalues
Dependency ranges changed: keera-hails-reactivevalues
Files
- CHANGELOG +5/−0
- keera-posture.cabal +6/−4
- src/Controller.hs +5/−5
- src/Controller/Conditions/Detector.hs +3/−3
- src/Controller/Conditions/MenuEnabledClick.hs +5/−5
- src/Controller/Conditions/Precalibration.hs +9/−9
- src/Controller/Conditions/Quit.hs +1/−2
- src/Controller/Conditions/Status.hs +3/−3
- src/Model/Model.hs +15/−9
CHANGELOG view
@@ -1,4 +1,9 @@ 2015-10-28 Ivan Perez <ivan.perez@keera.co.uk>++ * keera-posture.cabal: Adapts K Posture to K Hails 0.2. Bump (0.2.2).++2015-10-28 Ivan Perez <ivan.perez@keera.co.uk>+ * keera-posture.cabal: Relaxes dependencies, version bump (0.2.1). 2015-06-20 Ivan Perez <ivan.perez@keera.co.uk>
keera-posture.cabal view
@@ -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,
src/Controller.hs view
@@ -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
src/Controller/Conditions/Detector.hs view
@@ -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
src/Controller/Conditions/MenuEnabledClick.hs view
@@ -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 ()
src/Controller/Conditions/Precalibration.hs view
@@ -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
src/Controller/Conditions/Quit.hs view
@@ -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.
src/Controller/Conditions/Status.hs view
@@ -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 <IconNotificationEnabled> <NotificationEnabled> <Status> <UpdateFound> -- getStatusIcon :: Bool -> Bool -> Status -> Bool -> Maybe (String, String)
src/Model/Model.hs view
@@ -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 }