diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,11 @@ 2015-06-20 Ivan Perez + * keera-posture.cabal, src/Controller.hs: Version bump (0.1.4.4). + * keera-posture.cabal: Adds repository information to cabal file. + * src/Data/Extra/Ord.hs: Moves aux function to (new) aux module. + +2015-06-20 Ivan Perez + * keera-posture.cabal: Version bump. Prepends keera- to all dependencies, as names have changed when they were uploaded to hackage. 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.1.4.2 +Version: 0.1.4.4 -- A short (one-line) description of the package. Synopsis: Get notifications when your sitting posture is inappropriate. @@ -50,20 +50,19 @@ -- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.6 - Executable keera-posture -- .hs or .lhs file containing the Main module. Main-is: Main.hs hs-source-dirs: src/ if os(windows) - -- ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O2 -optl-mwindows ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O2 + -- ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O2 -optl-mwindows -- ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O2 -rtsopts=all extra-libraries: SDL_mixer else - -- ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O2 obj/OpenCVGtkPixbuf.o ghc-options: -threaded -Wall -fno-warn-unused-do-bind + -- ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O2 obj/OpenCVGtkPixbuf.o -- Packages needed in order to build this package. -- Build-depends: @@ -147,63 +146,67 @@ -- Modules not exported by this package. Other-modules: Audio, + AI.CV.PostureProcessors, + CombinedEnvironment, + Controller, Controller.Conditions, Controller.Conditions.Calibrate, Controller.Conditions.Calibration, - Controller.Conditions.PreferencesDetectionCorrection, - Controller.Conditions.NotifySound, - Controller.Conditions.PreferencesDialog, - Controller.Conditions.Quit, - Controller.Conditions.LanguageConfig, - Controller.Conditions.PreferencesDialogDestroy, - Controller.Conditions.Help, - Controller.Conditions.Detector, Controller.Conditions.Config, - Controller.Conditions.UpdateCheck, - Controller.Conditions.PreferencesSoundCustomise, - Controller.Conditions.Website, - Controller.Conditions.MenuEnabledClick, - Controller.Conditions.PreferencesDetectionDelay, + Controller.Conditions.Detector, + Controller.Conditions.Help, + Controller.Conditions.LanguageConfig, Controller.Conditions.MenuEnabled, - Controller.Conditions.PreferencesLanguageCombo, - Controller.Conditions.PreferencesDetectionCamera, - Controller.Conditions.PopupMenu, - Controller.Conditions.NotifyWindow, - Controller.Conditions.PreferencesUplink, + Controller.Conditions.MenuEnabledClick, Controller.Conditions.NotificationMenu, + Controller.Conditions.NotifySound, + Controller.Conditions.NotifyWindow, + Controller.Conditions.PopupMenu, Controller.Conditions.Postcalibration, Controller.Conditions.Precalibration, + Controller.Conditions.PreferencesDetectionCamera, + Controller.Conditions.PreferencesDetectionCorrection, + Controller.Conditions.PreferencesDetectionDelay, Controller.Conditions.PreferencesDetectionMethods, + Controller.Conditions.PreferencesDialog, + Controller.Conditions.PreferencesDialogDestroy, + Controller.Conditions.PreferencesLanguageCombo, + Controller.Conditions.PreferencesSoundCustomise, + Controller.Conditions.PreferencesUplink, + Controller.Conditions.Quit, Controller.Conditions.Status, + Controller.Conditions.UpdateCheck, + Controller.Conditions.Website, Controller.Conditions.Welcome, - CombinedEnvironment, - Paths.CustomPaths, - Model.ReactiveModel.Sound, - Model.ReactiveModel.ReactiveModelInternals, - Model.ReactiveModel.Detector, - Model.ReactiveModel.ModelEvents, - Model.ReactiveModel.Preferences, - Model.ReactiveModel.ReactiveFields, - Model.ReactiveModel.Status, - Model.ReactiveModel, + Data.Extra.Ord, + I18N.Strings, Model.Model, - Model.ProtectedModel, Model.ProtectedModel - Model.ProtectedModel.Sound, + Model.ProtectedModel, Model.ProtectedModel.Detector, - Model.ProtectedModel.ProtectedFields, Model.ProtectedModel.Preferences, - Model.ProtectedModel.Status, + Model.ProtectedModel.ProtectedFields, Model.ProtectedModel.ProtectedModelInternals, + Model.ProtectedModel.Sound, + Model.ProtectedModel.Status, + Model.ReactiveModel, + Model.ReactiveModel.Detector, + Model.ReactiveModel.ModelEvents, + Model.ReactiveModel.Preferences, + Model.ReactiveModel.ReactiveFields, + Model.ReactiveModel.ReactiveModelInternals, + Model.ReactiveModel.Sound, + Model.ReactiveModel.Status, + MyIO, Paths, - View.InitLanguagesCombo, - View.Objects, + Paths.CustomPaths, View, - Controller, - MyIO, - I18N.Strings, - AI.CV.PostureProcessors + View.InitLanguagesCombo, + View.Objects -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. - -- Build-tools: + -- Build-tools: hails +source-repository head + type: git + location: https://github.com/keera-studios/keera-posture.git diff --git a/src/AI/CV/PostureProcessors.hs b/src/AI/CV/PostureProcessors.hs --- a/src/AI/CV/PostureProcessors.hs +++ b/src/AI/CV/PostureProcessors.hs @@ -12,6 +12,9 @@ import Foreign.C.Types -- Internal imports +import Data.Extra.Ord + +-- Internal imports import Paths createInitialState :: IO InternalState @@ -145,13 +148,6 @@ -- Calculates the distance between two points varDistance :: CInt -> CInt -> Double varDistance v1 v2 = abs (fromIntegral v1 - fromIntegral v2) - --- withinRange (b1, b2) a returns the closes value to a in the range [b1, b2] -withinRange :: Ord a => (a, a) -> a -> a -withinRange (a, b) x - | x >= a && x <= b = x - | x < a = a - | otherwise = b data DetectionStatus = DetectionOk | DetectionWrong diff --git a/src/Controller.hs b/src/Controller.hs --- a/src/Controller.hs +++ b/src/Controller.hs @@ -40,7 +40,7 @@ let can = canStdErr || canStdOut hdl = if canStdErr then stderr else stdout when can $ mapM_ (hPutStrLn hdl) - [ "Keera Posture v0.1.4.2" + [ "Keera Posture v0.1.4.4" , "Copyright (C) 2010-2015 Ivan Perez Dominguez and Keera Studios Ltd (UK)" , __ "Licence: All rights reserved" , __ "This software includes modified and unmodified versions of" @@ -97,7 +97,7 @@ &= help "Shows the licence and exits" } &= program "keera-posture" - &= summary "Keera Posture 0.1.4.2 (c) 2010-2015 Ivan Perez - Keera Studios" + &= summary "Keera Posture 0.1.4.4 (c) 2010-2015 Ivan Perez - Keera Studios" &= details [ __ "Report bugs to support@keera.co.uk" , __ "Find more about Keera Posture at http://keera.co.uk" , __ "and http://github.com/keera-studios/keera-posture" diff --git a/src/Controller/Conditions/LanguageConfig.hs b/src/Controller/Conditions/LanguageConfig.hs --- a/src/Controller/Conditions/LanguageConfig.hs +++ b/src/Controller/Conditions/LanguageConfig.hs @@ -1,7 +1,7 @@ -- | Reads/Writes the language in a configuration file. module Controller.Conditions.LanguageConfig (installHandlers) where -import qualified Control.Exception as E +import qualified Control.Exception as E import Control.Exception.Extra import Control.Monad import System.FilePath @@ -15,8 +15,8 @@ installHandlers :: CEnv -> IO() installHandlers cenv = do let pm = model cenv - onEvent pm Initialised $ conditionRead cenv - onEvent pm LanguageChanged $ conditionSave cenv + onEvent pm Initialised $ conditionRead cenv + onEvent pm LanguageChanged $ conditionSave cenv -- | Saves the currently selected language ID String in a configuration file conditionSave :: CEnv -> IO () @@ -49,7 +49,7 @@ let language = languageStringToLanguage lang -- Update the model - let pm = model cenv + let pm = model cenv setter languageField pm language -- | Determines the language based on the language string diff --git a/src/Data/Extra/Ord.hs b/src/Data/Extra/Ord.hs new file mode 100644 --- /dev/null +++ b/src/Data/Extra/Ord.hs @@ -0,0 +1,8 @@ +module Data.Extra.Ord where + +-- | withinRange (b1, b2) a returns the closes value to a in the range [b1, b2] +withinRange :: Ord a => (a, a) -> a -> a +withinRange (a, b) x + | x >= a && x <= b = x + | x < a = a + | otherwise = b