diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,76 @@ +0.5.0.0 +------- + +- Hardened the behaviour of `creaTimedRes`. Now: + - it will error on non-positive durations + - it will error on non-positive number of cycle + - it allows the creation of expired `Reach` timers (1-length lists) + +0.4.3.0 +------- + +- Bumped dependencies +- Added README +- Released lun 4 ott 2021, 13:50:09 + +0.4.2.0 +------- + +- Added `lapse` function. +- Released Fri 22 Nov 2019 00:48:03 CET. + +0.4.1.0 +------- + +- Added convenience functions `creaTimerLoop` and `creaBoolTimerLoop`. +- Released Tue 28 May 2019 12:45:58 CEST. + +0.4.0.0 +------- + +- Fixed loop/expire bug. +- Released Thu 15 Mar 2018 11:51:15 CET. + +0.3.0.0 +------- + +- Reworked the API, added Reach ending, fixed bugs. +- Released on Thu 15 Mar 2018 08:49:30 CET. + +0.2.0.0 +------- + +- Renamed `fetch` to `fetchFrame`. +- Added `getFrames`. +- Added Functor instance +- Released on Thu 15 Mar 2018 03:33:20 CET + +0.1.2.0 +------- + +- Added Generic instance to Loop. +- Released on Thu 15 Mar 2018 00:42:29 CET. + +0.1.1.0 +------- + +- Added Generic instance to TimedRes. +- Released on Thu 15 Mar 2018 00:27:26 CET. + +0.1.0.2 +------- + +- Fixed tests. +- Released on Wed 14 Mar 2018 14:47:40 CET. + +0.1.0.1 +------- + +- Added a homepage and darcs repo. +- Released on Wed 14 Mar 2018 14:07:16 CET. + +0.1.0.0 +------- + +- Added basic animation/timer functionality. +- Released on Wed 14 Mar 2018 13:36:06 CET. diff --git a/changes.txt b/changes.txt deleted file mode 100644 --- a/changes.txt +++ /dev/null @@ -1,68 +0,0 @@ -0.4.3.0 -------- - -- Bumped dependencies -- Added README -- Released lun 4 ott 2021, 13:50:09 - -0.4.2.0 -------- - -- Added `lapse` function. -- Released Fri 22 Nov 2019 00:48:03 CET. - -0.4.1.0 -------- - -- Added convenience functions `creaTimerLoop` and `creaBoolTimerLoop`. -- Released Tue 28 May 2019 12:45:58 CEST. - -0.4.0.0 -------- - -- Fixed loop/expire bug. -- Released Thu 15 Mar 2018 11:51:15 CET. - -0.3.0.0 -------- - -- Reworked the API, added Reach ending, fixed bugs. -- Released on Thu 15 Mar 2018 08:49:30 CET. - -0.2.0.0 -------- - -- Renamed `fetch` to `fetchFrame`. -- Added `getFrames`. -- Added Functor instance -- Released on Thu 15 Mar 2018 03:33:20 CET - -0.1.2.0 -------- - -- Added Generic instance to Loop. -- Released on Thu 15 Mar 2018 00:42:29 CET. - -0.1.1.0 -------- - -- Added Generic instance to TimedRes. -- Released on Thu 15 Mar 2018 00:27:26 CET. - -0.1.0.2 -------- - -- Fixed tests. -- Released on Wed 14 Mar 2018 14:47:40 CET. - -0.1.0.1 -------- - -- Added a homepage and darcs repo. -- Released on Wed 14 Mar 2018 14:07:16 CET. - -0.1.0.0 -------- - -- Added basic animation/timer functionality. -- Released on Wed 14 Mar 2018 13:36:06 CET. diff --git a/src/Control/Timer/Tick.hs b/src/Control/Timer/Tick.hs --- a/src/Control/Timer/Tick.hs +++ b/src/Control/Timer/Tick.hs @@ -100,16 +100,10 @@ fmap f t = t { tSteps = fmap (\(i, a) -> (i, f a)) (tSteps t) } --- todo [release] modifice esempi per renderli one liner o ghci --- firnedly - ------------ -- CREATE -- ------------ --- todo 0-length frames [release] --- todo inverted timer (expires on Nothing) [release] - -- | A simple off/on timer expiring in fixed number of ticks. -- -- Example: @@ -146,19 +140,30 @@ -- 'Loop' controls the expiring behaviour, @[(Integer, a)]@ is a list of -- frames and their duration. creaTimedRes :: Loop -> [(Integer, a)] -> Timed a -creaTimedRes _ [] = error "Cannot create an empty TimedRes" +creaTimedRes _ [] = error "creaTimedRes: cannot create an empty TimedRes." +creaTimedRes _ ss | any ((<1) . fst) ss = + error "creaTimedRes: cannot have <1 durations." +creaTimedRes (Times t _) _ | t < 1 = + error "creaTimedRes: cannot have non-positive number \ + \of cycles." creaTimedRes l ss = TimedRes ss l l loopTicks expTicks - 0 False + 0 isExp where loopTicks = sum . map fst $ ss expTicks = case l of AlwaysLoop -> Nothing Times _ Reach -> Just $ sum . map fst $ init ss - Times _ Elapse -> Just $ loopTicks + Times _ Elapse -> Just loopTicks + isExp | length ss == 1 && + isReach l = True + | otherwise = False + isReach (Times _ Reach) = True + isReach _ = False + ------------- -- OPERATE -- ------------- @@ -195,7 +200,7 @@ expx = case tLoop tm of Times 1 eb -> tm { tLoop = Times 0 eb, tExpired = True } - _ -> error "non 1 Times in `expire`" + _ -> error "non 1 Times in `expire`." isElB (Times _ Elapse) = True isElB _ = False @@ -203,7 +208,7 @@ -- | Ticks the timer (multiple steps). ticks :: Integer -> Timed a -> Timed a ticks 1 t = tick t -ticks n t | n < 1 = error "negative number passed to `ticks`" +ticks n t | n < 1 = error "non-positive number passed to `ticks`." | otherwise = ticks (n-1) (tick t) -- | Ticks the timer until 'isExpired' is @True@. @@ -224,7 +229,7 @@ -- | Fetches the current resource of the timer. fetchFrame :: Timed a -> a -fetchFrame t = bl !! (fromIntegral $ tCurrTick t) +fetchFrame t = bl !! fromIntegral (tCurrTick t) where bl = concatMap (\(c, a) -> replicate (fromIntegral c) a) $ tSteps t @@ -232,12 +237,9 @@ getFrames :: Timed a -> [(Integer, a)] getFrames t = tSteps t --- todo having another input apart from []? maybe a function? - -- | Resets the timer to its original state. reset :: Timed a -> Timed a reset t = t { tCurrTick = 0, tExpired = False, tLoop = tOrigLoop t } --- todo elapsed time? ticking time? diff --git a/test/Control/Timer/TickSpec.hs b/test/Control/Timer/TickSpec.hs --- a/test/Control/Timer/TickSpec.hs +++ b/test/Control/Timer/TickSpec.hs @@ -3,6 +3,8 @@ import Control.Timer.Tick import Test.Hspec + +import qualified Test.QuickCheck as Q import qualified Control.Exception as E @@ -21,7 +23,30 @@ it "does not allow creation of empty timed resources" $ E.evaluate (creaTimedRes AlwaysLoop []) `shouldThrow` anyException + it "creates an already elapsed timer (Reach)" $ + let t = creaTimedRes (Times 1 Reach) [(1, 'a')] + in isExpired t `shouldBe` True + it "does not allow negative durations" $ + let t = creaTimedRes (Times 1 Elapse) [(0, 'a')] + in E.evaluate t `shouldThrow` anyException + it "always creates a lapseable timer" $ Q.property $ + let genPos :: Q.Gen Integer + genPos = Q.suchThat Q.arbitrary (>0) + genLoop :: Q.Gen Loop + genLoop = Q.oneof [Times <$> genPos + <*> Q.oneof [pure Reach, pure Elapse]] + + genTup :: Q.Gen (Integer, Char) + genTup = (,) <$> genPos <*> pure 'a' + + genTest = (,) <$> genLoop <*> Q.listOf1 genTup + + in Q.forAll genTest + (\(l, as) -> + let t = creaTimedRes l as + in isExpired (lapse t) == True) + describe "tick" $ do it "ticks a simple timer" $ let st = creaBoolTimer 1 in @@ -73,9 +98,12 @@ reset (ticks 30 t) `shouldBe` t describe "lapse" $ do - let t = creaBoolTimer 10 it "lapses the timer" $ - lapse t `shouldBe` ticks 10 t + let t = creaBoolTimer 10 + in lapse t `shouldBe` ticks 10 t + it "lapse Reach without hanging" $ + let t = creaTimedRes (Times 1 Reach) [(10, 'a')] + in isExpired (lapse t) `shouldBe` True describe "creaBoolTimerLoop" $ do let t = creaBoolTimerLoop 10 diff --git a/timers-tick.cabal b/timers-tick.cabal --- a/timers-tick.cabal +++ b/timers-tick.cabal @@ -1,5 +1,5 @@ name: timers-tick -version: 0.4.3.0 +version: 0.5.0.0 synopsis: tick based timers description: Tick-based timers and utilities, for games and discrete-time programs. @@ -10,10 +10,10 @@ author: Francesco Ariis homepage: http://ariis.it/static/articles/timers-tick/page.html maintainer: fa-ml@ariis.it -copyright: © 2018 Francesco Ariis +copyright: © 2018-2021 Francesco Ariis category: Control build-type: Simple -extra-source-files: README, changes.txt +extra-source-files: README, CHANGES cabal-version: >=1.10 flag developer @@ -37,6 +37,7 @@ main-is: Tests.hs build-depends: base == 4.* , hspec >= 2.5 && < 2.9 + , QuickCheck == 2.14.* other-modules: Control.Timer.Tick, Control.Timer.TickSpec type: exitcode-stdio-1.0