rhythm-game-tutorial 0.1 → 0.1.1
raw patch · 7 files changed
+684/−681 lines, 7 filesdep ~calldep ~objective
Dependency ranges changed: call, objective
Files
- LICENSE +30/−30
- assets/Monoidal Purity.txt +300/−300
- rhythm-game-tutorial.cabal +52/−52
- src/music-only.hs +21/−21
- src/tutorial-active.hs +97/−97
- src/tutorial-extended.hs +123/−120
- src/tutorial-passive.hs +61/−61
LICENSE view
@@ -1,30 +1,30 @@-Copyright (c) 2012, Fumiaki Kinoshita - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Fumiaki Kinoshita nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Copyright (c) 2012, Fumiaki Kinoshita++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Fumiaki Kinoshita nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
assets/Monoidal Purity.txt view
@@ -1,301 +1,301 @@----------------- ----------------- ----------------- - ----------------- ----------------- ----------------- - -----.----------- -.-------.------- -------------.--- - -----.----------- -.-----------.--- ---------.------- - -----.----------- -.-------.---.--- ----------------- - ----------------- -.--------------- -----.---.---.--- - ----------------- -.--------------- ----------------- - -------.--------- -------------.--- -.--------------- - -------------.-.- -.-------.------- -----.-.--------- - --.-.-.-.-------- -.-------.------- ---.-.-.--------- - -.-------------.- ---.-.---.-.-.--- -------.--.------ - ---.-----.-----.- -.---.-------.--- -------.---.----- - -----.-----.----- -.-----------.--- -----.---------.- - -------.---.----- -.---.-------.--- ---.-----------.- - ---.-.---------.- -.-----.-.-.-.--- ----------.------ - ---.-----.-----.- -.---.-------.--- -------.---.----- - -.---------.----- -----.---.------- -------.--------- - ---.-------.---.- -----.---.---.--- -------.--------- - -.-------------.- ---.-.---.-.-.--- -------.--.------ - ---.-----.-----.- -.---.-------.--- -------.---.----- - -----.-----.----- -.-----------.--- -----.---------.- - -------.---.----- -.---.-------.--- ---.-----------.- - ---.-.---------.- -.-----.-.-.-.--- ----------.------ - ---.-----.-----.- -.---.-------.--- -------.---.----- - -.---.---.---.--- ----------------- ---.---.---.---.- - -.-.-.-.-.-.-.-.- ----------------- --.-.-.-.-.-.-.-. - -------------.-.- -.--.--.--.------ ----------------- - -------------.-.- -.--.--.--.------ ----------------- - -------------.-.- ----------------- -.--.--.--.------ - -------------.-.- ----------------- -.--.--.--.------ - -------------.-.- -.--.--.--.------ ----------------- - -------------.-.- -.--.--.--.------ ----------------- - -------------.-.- ----------------- -.--.--.--.------ - -------------.-.- ----------------- -.--.--.--.------ - ----------------- ----------------- ---.-.---.--.--.- - ----------------- ---.-.---.--.--.- ----------------- - -.---.---.--.--.- ----------------- ----------------- - ----------------- -.---.---.--.--.- ----------------- - ----------------- ---------.--.--.- ---.-.----------- - ----------------- ---.-.----------- ---------.--.--.- - ---------.--.--.- ---.-.----------- ----------------- - ---.-.----------- ----------------- ---------.--.--.- - -------------.--- -.--------------- -----.----------- - -------------.--- ----------------- -----.----------- - -------------.--- ----------------- -----.----------- - -------------.--- ----------------- -----.----------- - -------------.--- -.-------.------- -----.----------- - -------------.--- -.-------.------- -----.----------- - -------------.--- -.-------.------- -----.----------- - -------------.--- -.-------.------- -----.----------- - -------------.--- -.-------.------- -----.----------- - -------------.--- -.-------.------- -----.----------- - -------------.--- -.-------.------- -----.----------- - -------------.--- -.-------.------- -----.----------- - ----------------- -.--------------- ----------------- - ----------------- -.--------------- ----------------- - ----------------- -.-------.------- ----------------- - -.---.---.-.-.-.- ----------------- ---.---.--.-.-.-. - - -.-------.-.---.- -.-.-.-------.--- -.-----.--.------ - ---.-----------.- -.---.---.---.--- -------.---.----- - -----.-----.----- -.-----------.--- -----.---------.- - -------.---.----- -.---.-------.--- ---.-----------.- - ---------.-.---.- ---.-.-------.--- -.-----.--.------ - -.---.-----.---.- ---.-----.---.--- -------.--------- - -----.----------- -.-----.---.---.- -------------.--- - ---.-------.---.- -----.---.---.--- -------.--------- - - -.-------.-.---.- -.-.-.-------.--- -.-----.--.------ - ---.-----------.- -.---.---.---.--- -------.---.----- - -----.-----.----- -.-----------.--- -----.---------.- - -------.---.----- -.---.-------.--- ---.-----------.- - ---------.-.---.- ---.-.-------.--- -.-----.--.------ - -.---.-----.---.- ---.-----.---.--- -------.--------- - -----.----------- -.-----.---.---.- -------------.--- - ---.---.--------- -.---.-----.---.- ---------.---.--- - -.--------------- -.--------------- +----------------+----------------+----------------++----------------+----------------+----------------++----.-----------+.-------.-------+------------.---++----.-----------+.-----------.---+--------.-------++----.-----------+.-------.---.---+----------------++----------------+.---------------+----.---.---.---++----------------+.---------------+----------------++------.---------+------------.---+.---------------++------------.-.-+.-------.-------+----.-.---------++-.-.-.-.--------+.-------.-------+--.-.-.---------++.-------------.-+--.-.---.-.-.---+------.--.------++--.-----.-----.-+.---.-------.---+------.---.-----++----.-----.-----+.-----------.---+----.---------.-++------.---.-----+.---.-------.---+--.-----------.-++--.-.---------.-+.-----.-.-.-.---+---------.------++--.-----.-----.-+.---.-------.---+------.---.-----++.---------.-----+----.---.-------+------.---------++--.-------.---.-+----.---.---.---+------.---------++.-------------.-+--.-.---.-.-.---+------.--.------++--.-----.-----.-+.---.-------.---+------.---.-----++----.-----.-----+.-----------.---+----.---------.-++------.---.-----+.---.-------.---+--.-----------.-++--.-.---------.-+.-----.-.-.-.---+---------.------++--.-----.-----.-+.---.-------.---+------.---.-----++.---.---.---.---+----------------+--.---.---.---.-++.-.-.-.-.-.-.-.-+----------------+-.-.-.-.-.-.-.-.++------------.-.-+.--.--.--.------+----------------++------------.-.-+.--.--.--.------+----------------++------------.-.-+----------------+.--.--.--.------++------------.-.-+----------------+.--.--.--.------++------------.-.-+.--.--.--.------+----------------++------------.-.-+.--.--.--.------+----------------++------------.-.-+----------------+.--.--.--.------++------------.-.-+----------------+.--.--.--.------++----------------+----------------+--.-.---.--.--.-++----------------+--.-.---.--.--.-+----------------++.---.---.--.--.-+----------------+----------------++----------------+.---.---.--.--.-+----------------++----------------+--------.--.--.-+--.-.-----------++----------------+--.-.-----------+--------.--.--.-++--------.--.--.-+--.-.-----------+----------------++--.-.-----------+----------------+--------.--.--.-++------------.---+.---------------+----.-----------++------------.---+----------------+----.-----------++------------.---+----------------+----.-----------++------------.---+----------------+----.-----------++------------.---+.-------.-------+----.-----------++------------.---+.-------.-------+----.-----------++------------.---+.-------.-------+----.-----------++------------.---+.-------.-------+----.-----------++------------.---+.-------.-------+----.-----------++------------.---+.-------.-------+----.-----------++------------.---+.-------.-------+----.-----------++------------.---+.-------.-------+----.-----------++----------------+.---------------+----------------++----------------+.---------------+----------------++----------------+.-------.-------+----------------++.---.---.-.-.-.-+----------------+--.---.--.-.-.-.+++.-------.-.---.-+.-.-.-------.---+.-----.--.------++--.-----------.-+.---.---.---.---+------.---.-----++----.-----.-----+.-----------.---+----.---------.-++------.---.-----+.---.-------.---+--.-----------.-++--------.-.---.-+--.-.-------.---+.-----.--.------++.---.-----.---.-+--.-----.---.---+------.---------++----.-----------+.-----.---.---.-+------------.---++--.-------.---.-+----.---.---.---+------.---------+++.-------.-.---.-+.-.-.-------.---+.-----.--.------++--.-----------.-+.---.---.---.---+------.---.-----++----.-----.-----+.-----------.---+----.---------.-++------.---.-----+.---.-------.---+--.-----------.-++--------.-.---.-+--.-.-------.---+.-----.--.------++.---.-----.---.-+--.-----.---.---+------.---------++----.-----------+.-----.---.---.-+------------.---++--.---.---------+.---.-----.---.-+--------.---.---++.---------------+.--------------- .---------------
rhythm-game-tutorial.cabal view
@@ -1,52 +1,52 @@-name: rhythm-game-tutorial -version: 0.1 -synopsis: Haskell rhythm game tutorial -description: -homepage: https://github.com/fumieval/rhythm-game-tutorial -bug-reports: https://github.com/fumieval/rhythm-game-tutorial/issues -license: BSD3 -license-file: LICENSE -author: Fumiaki Kinoshita -maintainer: Fumiaki Kinoshita <fumiexcel@gmail.com> -copyright: Copyright (C) 2012-2013 Fumiaki Kinoshita -category: Graphics, Monads -build-type: Simple -stability: experimental -cabal-version: >=1.10 - -data-files: - assets/*.wav - assets/*.png - assets/*.txt - -source-repository head - type: git - location: https://github.com/fumieval/rhythm-game-tutorial.git - -executable music-only - ghc-options: -threaded -O2 - main-is: music-only.hs - build-depends: base == 4.*, call >= 0.1.2 && <= 0.2, objective >= 0.6.3.1, lens == 4.*, mtl, containers, split - default-language: Haskell2010 - hs-source-dirs: src - -executable tutorial-passive - ghc-options: -threaded -O2 - main-is: tutorial-passive.hs - build-depends: base == 4.*, call >= 0.1.2 && <= 0.2, objective >= 0.6.3.1, lens == 4.*, mtl, containers, split - default-language: Haskell2010 - hs-source-dirs: src - -executable tutorial-active - ghc-options: -threaded -O2 - main-is: tutorial-active.hs - build-depends: base == 4.*, call >= 0.1.2 && <= 0.2, objective >= 0.6.3.1, lens == 4.*, mtl, containers, split - default-language: Haskell2010 - hs-source-dirs: src - -executable tutorial-extended - ghc-options: -threaded -O2 - main-is: tutorial-extended.hs - build-depends: base == 4.*, call >= 0.1.2 && <= 0.2, objective >= 0.6.3.1, lens == 4.*, mtl, containers, split - default-language: Haskell2010 - hs-source-dirs: src +name: rhythm-game-tutorial+version: 0.1.1+synopsis: Haskell rhythm game tutorial+description:+homepage: https://github.com/fumieval/rhythm-game-tutorial+bug-reports: https://github.com/fumieval/rhythm-game-tutorial/issues+license: BSD3+license-file: LICENSE+author: Fumiaki Kinoshita+maintainer: Fumiaki Kinoshita <fumiexcel@gmail.com>+copyright: Copyright (C) 2012-2013 Fumiaki Kinoshita+category: Graphics, Monads+build-type: Simple+stability: experimental+cabal-version: >=1.10++data-files:+ assets/*.wav+ assets/*.png+ assets/*.txt++source-repository head+ type: git+ location: https://github.com/fumieval/rhythm-game-tutorial.git++executable music-only+ ghc-options: -threaded -O2+ main-is: music-only.hs+ build-depends: base == 4.*, call >= 0.1.4 && <= 0.2, objective >= 1.0.1, lens == 4.*, mtl, containers, split+ default-language: Haskell2010+ hs-source-dirs: src++executable tutorial-passive+ ghc-options: -threaded -O2+ main-is: tutorial-passive.hs+ build-depends: base == 4.*, call >= 0.1.4 && <= 0.2, objective >= 1.0.1, lens == 4.*, mtl, containers, split+ default-language: Haskell2010+ hs-source-dirs: src++executable tutorial-active+ ghc-options: -threaded -O2+ main-is: tutorial-active.hs+ build-depends: base == 4.*, call >= 0.1.4 && <= 0.2, objective >= 1.0.1, lens == 4.*, mtl, containers, split+ default-language: Haskell2010+ hs-source-dirs: src++executable tutorial-extended+ ghc-options: -threaded -O2+ main-is: tutorial-extended.hs+ build-depends: base == 4.*, call >= 0.1.4 && <= 0.2, objective >= 1.0.1, lens == 4.*, mtl, containers, split+ default-language: Haskell2010+ hs-source-dirs: src
src/music-only.hs view
@@ -1,21 +1,21 @@-import Call -import Call.Util.Deck as Deck -import Control.Monad.State.Strict -import Control.Lens - -main = runSystemDefault $ do - music <- prepareMusic "assets/Monoidal Purity.wav" - playMusic music - stand - -type Music s = Inst (System s) (StateT Deck (System s)) (System s) - -prepareMusic :: FilePath -> System s (Music s) -prepareMusic path = do - wav <- readWAVE path - i <- new $ variable $ source .~ sampleSource wav $ Deck.empty - linkAudio $ \dt n -> i .- playback dt n - return i - -playMusic :: Music s -> System s () -playMusic m = m .- playing .= True +import Call+import Call.Util.Deck as Deck+import Control.Monad.State.Strict+import Control.Lens++main = runSystemDefault $ do+ music <- prepareMusic "assets/Monoidal Purity.wav"+ playMusic music+ stand++type Music s = Instance (StateT Deck (System s)) (System s)++prepareMusic :: FilePath -> System s (Music s)+prepareMusic path = do+ wav <- readWAVE path+ i <- new $ variable $ source .~ sampleSource wav $ Deck.empty+ linkAudio $ \dt n -> i .- playback dt n+ return i++playMusic :: Music s -> System s ()+playMusic m = m .- playing .= True
src/tutorial-active.hs view
@@ -1,97 +1,97 @@-{-# LANGUAGE Rank2Types, ImpredicativeTypes, ViewPatterns #-} -import Call -import Call.Util.Deck as Deck -import Control.Lens -import Control.Monad.State.Strict -import Data.Foldable (foldMap) -import qualified Data.Set as Set -import Data.Set (Set) -import System.IO.Unsafe -import Data.List -import Data.List.Split (splitWhen) -import Call.Util.Text as Text - -gameMain :: System s () -gameMain = do - music <- prepareMusic "assets/Monoidal Purity.wav" - - allTimings <- liftIO $ parseScore (60/160*4) <$> readFile "assets/Monoidal Purity.txt" - - text <- Text.simple defaultFont 24 - - timings <- new $ variable $ allTimings !! 0 - score <- new $ variable 0 - - linkPicture $ \_ -> do - l <- renderLane <$> (timings .- get) <*> getPosition music - s <- score .- get - return $ l <> color black (translate (V2 240 40) (text (show s))) - - linkKeyboard $ \ev -> case ev of - Down KeySpace -> do - (sc, ts') <- handle <$> getPosition music <*> (timings .- get) - timings .- put ts' - score .- modify (+sc) - _ -> return () -- Discard the other events - - playMusic music - -main = runSystemDefault (gameMain >> stand) - -type Music s = Inst (System s) (StateT Deck (System s)) (System s) - -prepareMusic :: FilePath -> System s (Music s) -prepareMusic path = do - wav <- readWAVE path - i <- new $ variable $ source .~ sampleSource wav $ Deck.empty - linkAudio $ \dt n -> i .- playback dt n - return i - -phases :: Set Time -- ^ timings - -> Time -- ^ life span - -> Time -- ^ the current time - -> [Float] -- ^ phase -phases s len t = map ((/len) . subtract t) -- transform to an interval [0, 1] - $ Set.toList - $ fst $ Set.split (t + len) s -- before the limit - -circle_png :: Bitmap -circle_png = unsafePerformIO $ readBitmap "assets/circle.png" - -circles :: [Float] -> Picture -circles = foldMap (\p -> V2 320 ((1 - p) * 480) `translate` bitmap circle_png) - -renderLane :: Set Time -> Time -> Picture -renderLane ts t = mconcat [color blue $ circles (phases ts 1 t) - , V2 320 480 `translate` color black (bitmap circle_png) -- criterion - ] - -getPosition :: Music s -> System s Time -getPosition m = m .- use pos - -playMusic :: Music s -> System s () -playMusic m = m .- playing .= True - -parseScore :: Time -> String -> [Set Time] -parseScore d = map (Set.fromAscList . concat . zipWith (map . (+)) [0,d..]) . Data.List.transpose . map (map f) . splitWhen (=="") . lines where - f l = [t | (t, c) <- zip [0, d/fromIntegral (length l)..] l, c == '.'] - -rate :: Time -> Int -rate dt - | dt < 0.05 = 4 - | dt < 0.1 = 2 - | otherwise = 1 - -handle :: Time -> Set Time -> (Int, Set Time) -handle t ts = case viewNearest t ts of - Nothing -> (0, ts) -- The song is over - Just (t', ts') -> (rate $ abs (t - t'), ts') - -viewNearest :: (Num a, Ord a) => a -> Set a -> Maybe (a, Set a) -viewNearest t ts = case Set.split t ts of - (sa@(Set.maxView -> Just (a, sa')), sb@(Set.minView -> Just (b, sb'))) - | t - a < b - t -> Just (a, sa' `Set.union` sb) - | otherwise -> Just (b, sa `Set.union` sb') - (Set.maxView -> Just (a, sa'), _) -> Just (a, sa') - (_, Set.minView -> Just (b, sb')) -> Just (t, sb') - _ -> Nothing +{-# LANGUAGE Rank2Types, ImpredicativeTypes, ViewPatterns #-}+import Call hiding (new')+import Call.Util.Deck as Deck+import Control.Lens+import Control.Monad.State.Strict+import Data.Foldable (foldMap)+import qualified Data.Set as Set+import Data.Set (Set)+import System.IO.Unsafe+import Data.List+import Data.List.Split (splitWhen)+import Call.Util.Text as Text++gameMain :: System s ()+gameMain = do+ music <- prepareMusic "assets/Monoidal Purity.wav"++ allTimings <- liftIO $ parseScore (60/160*4) <$> readFile "assets/Monoidal Purity.txt"++ text <- Text.simple defaultFont 24++ timings <- new $ variable $ allTimings !! 0+ score <- new $ variable 0++ linkPicture $ \_ -> do+ l <- renderLane <$> (timings .- get) <*> getPosition music+ s <- score .- get+ return $ l <> color black (translate (V2 240 40) (text (show s)))++ linkKeyboard $ \ev -> case ev of+ Down KeySpace -> do+ (sc, ts') <- handle <$> getPosition music <*> (timings .- get)+ timings .- put ts'+ score .- modify (+sc)+ _ -> return () -- Discard the other events++ playMusic music++main = runSystemDefault (gameMain >> stand)++type Music s = Instance (StateT Deck (System s)) (System s)++prepareMusic :: FilePath -> System s (Music s)+prepareMusic path = do+ wav <- readWAVE path+ i <- new $ variable $ source .~ sampleSource wav $ Deck.empty+ linkAudio $ \dt n -> i .- playback dt n+ return i++phases :: Set Time -- ^ timings+ -> Time -- ^ life span+ -> Time -- ^ the current time+ -> [Float] -- ^ phase+phases s len t = map ((/len) . subtract t) -- transform to an interval [0, 1]+ $ Set.toList+ $ fst $ Set.split (t + len) s -- before the limit++circle_png :: Bitmap+circle_png = unsafePerformIO $ readBitmap "assets/circle.png"++circles :: [Float] -> Picture+circles = foldMap (\p -> V2 320 ((1 - p) * 480) `translate` bitmap circle_png)++renderLane :: Set Time -> Time -> Picture+renderLane ts t = mconcat [color blue $ circles (phases ts 1 t)+ , V2 320 480 `translate` color black (bitmap circle_png) -- criterion+ ]++getPosition :: Music s -> System s Time+getPosition m = m .- use pos++playMusic :: Music s -> System s ()+playMusic m = m .- playing .= True++parseScore :: Time -> String -> [Set Time]+parseScore d = map (Set.fromAscList . concat . zipWith (map . (+)) [0,d..]) . Data.List.transpose . map (map f) . splitWhen (=="") . lines where+ f l = [t | (t, c) <- zip [0, d/fromIntegral (length l)..] l, c == '.']++rate :: Time -> Int+rate dt+ | dt < 0.05 = 4+ | dt < 0.1 = 2+ | otherwise = 1++handle :: Time -> Set Time -> (Int, Set Time)+handle t ts = case viewNearest t ts of+ Nothing -> (0, ts) -- The song is over+ Just (t', ts') -> (rate $ abs (t - t'), ts')++viewNearest :: (Num a, Ord a) => a -> Set a -> Maybe (a, Set a)+viewNearest t ts = case Set.split t ts of+ (sa@(Set.maxView -> Just (a, sa')), sb@(Set.minView -> Just (b, sb')))+ | t - a < b - t -> Just (a, sa' `Set.union` sb)+ | otherwise -> Just (b, sa `Set.union` sb')+ (Set.maxView -> Just (a, sa'), _) -> Just (a, sa')+ (_, Set.minView -> Just (b, sb')) -> Just (b, sb')+ _ -> Nothing
src/tutorial-extended.hs view
@@ -1,120 +1,123 @@-{-# LANGUAGE Rank2Types, ImpredicativeTypes, ViewPatterns #-} -import Call -import Call.Util.Deck as Deck -import Control.Lens -import Control.Monad.State.Strict -import Data.Foldable (foldMap) -import qualified Data.Set as Set -import Data.Set (Set) -import System.IO.Unsafe -import Data.List -import Data.List.Split (splitWhen) -import Call.Util.Text as Text -import Data.Functor.Request -import Control.Object - -gameMain :: System s () -gameMain = do - music <- prepareMusic "assets/Monoidal Purity.wav" - - allTimings <- liftIO $ parseScore (60/160*4) <$> readFile "assets/Monoidal Purity.txt" - - text <- Text.simple defaultFont 24 - - timings <- new $ variable allTimings - score <- new $ variable 0 - effects <- new $ variable [] - - linkPicture $ \dt -> do - [l0, l1, l2] <- forM [0..2] $ \i -> renderLane <$> (timings .- use (ix i)) <*> getPosition music - s <- score .- get - ps <- effects .- announceMaybe (request dt) - return $ translate (V2 (-120) 0) l0 - <> translate (V2 0 0) l1 - <> translate (V2 120 0) l2 - <> color black (translate (V2 240 40) (text (show s))) - <> mconcat ps - - let touchLane i = do - ((sc, obj), ts') <- handle <$> getPosition music <*> (timings .- use (ix i)) - effects .- modify (obj:) - timings .- ix i .= ts' - score .- modify (+sc) - - linkKeyboard $ \ev -> case ev of - Down KeySpace -> touchLane 1 - Down KeyF -> touchLane 0 - Down KeyJ -> touchLane 2 - _ -> return () -- Discard the other events - - playMusic music - -main = runSystemDefault (gameMain >> stand) - -type Music s = Inst (System s) (StateT Deck (System s)) (System s) - -prepareMusic :: FilePath -> System s (Music s) -prepareMusic path = do - wav <- readWAVE path - i <- new $ variable $ source .~ sampleSource wav $ Deck.empty - linkAudio $ \dt n -> i .- playback dt n - return i - -phases :: Set Time -- ^ timings - -> Time -- ^ life span - -> Time -- ^ the current time - -> [Float] -- ^ phase -phases s len t = map ((/len) . subtract t) -- transform to an interval [0, 1] - $ Set.toList - $ fst $ Set.split (t + len) s -- before the limit - -circle_png :: Bitmap -circle_png = unsafePerformIO $ readBitmap "assets/circle.png" - -_perfect_png = unsafePerformIO $ readBitmap "assets/perfect.png" -_good_png = unsafePerformIO $ readBitmap "assets/good.png" -_error_png = unsafePerformIO $ readBitmap "assets/error.png" - -circles :: [Float] -> Picture -circles = foldMap (\p -> V2 320 ((1 - p) * 480) `translate` bitmap circle_png) - -renderLane :: Set Time -> Time -> Picture -renderLane ts t = mconcat [color blue $ circles (phases ts 1 t) - , V2 320 480 `translate` color black (bitmap circle_png) -- criterion - ] - -getPosition :: Music s -> System s Time -getPosition m = m .- use pos - -playMusic :: Music s -> System s () -playMusic m = m .- playing .= True - -parseScore :: Time -> String -> [Set Time] -parseScore d = map (Set.fromAscList . concat . zipWith (map . (+)) [0,d..]) . Data.List.transpose . map (map f) . splitWhen (=="") . lines where - f l = [t | (t, c) <- zip [0, d/fromIntegral (length l)..] l, c == '.'] - -rate :: Time -> (Int, Object (Request Time Picture) Maybe) -rate dt - | dt < 0.05 = (4, pop _perfect_png) - | dt < 0.1 = (2, pop _good_png) - | otherwise = (1, pop _error_png) - -handle :: Time -> Set Time -> ((Int, Object (Request Time Picture) Maybe), Set Time) -handle t ts = case viewNearest t ts of - Nothing -> ((0, pop _error_png), ts) -- The song is over - Just (t', ts') -> (rate $ abs (t - t'), ts') - -viewNearest :: (Num a, Ord a) => a -> Set a -> Maybe (a, Set a) -viewNearest t ts = case Set.split t ts of - (sa@(Set.maxView -> Just (a, sa')), sb@(Set.minView -> Just (b, sb'))) - | t - a < b - t -> Just (a, sa' `Set.union` sb) - | otherwise -> Just (b, sa `Set.union` sb') - (Set.maxView -> Just (a, sa'), _) -> Just (a, sa') - (_, Set.minView -> Just (b, sb')) -> Just (t, sb') - _ -> Nothing - -pop :: Bitmap -> Object (Request Time Picture) Maybe -pop bmp = Control.Object.transit 0.5 $ \t -> return $ translate (V2 320 360) - $ translate (V2 0 (-80) ^* t) - $ color (V4 1 1 1 (realToFrac $ 1 - t)) - $ bitmap bmp +{-# LANGUAGE Rank2Types, ImpredicativeTypes, ViewPatterns #-}+import Call hiding (new')+import Call.Util.Deck as Deck+import Control.Lens+import Control.Monad.State.Strict+import Data.Foldable (foldMap)+import qualified Data.Set as Set+import Data.Set (Set)+import System.IO.Unsafe+import Data.List+import Data.List.Split (splitWhen)+import Call.Util.Text as Text+import Data.Functor.Request+import Control.Object++gameMain :: System s ()+gameMain = do+ setFPS 60+ music <- prepareMusic "assets/Monoidal Purity.wav"++ allTimings <- liftIO $ parseScore (60/160*4) <$> readFile "assets/Monoidal Purity.txt"++ text <- Text.simple defaultFont 24++ timings <- new $ variable allTimings+ score <- new $ variable 0+ effects <- new $ variable []++ linkPicture $ \dt -> do+ [l0, l1, l2] <- forM [0..2] $ \i -> renderLane <$> (timings .- use (ix i)) <*> getPosition music+ s <- score .- get+ ef <- effects .- gatherFst id (apprises (request dt))+ return $ translate (V2 (-120) 0) l0+ <> translate (V2 0 0) l1+ <> translate (V2 120 0) l2+ <> color black (translate (V2 240 40) (text (show s)))+ <> ef++ let touchLane i = do+ ((sc, obj), ts') <- handle <$> getPosition music <*> (timings .- use (ix i))+ effects .- modify (obj:)+ timings .- ix i .= ts'+ score .- modify (+sc)++ linkKeyboard $ \ev -> case ev of+ Down KeySpace -> touchLane 1+ Down KeyF -> touchLane 0+ Down KeyJ -> touchLane 2+ _ -> return () -- Discard the other events++ playMusic music++main = runSystemDefault (gameMain >> stand)++type Music s = Instance (StateT Deck (System s)) (System s)++prepareMusic :: FilePath -> System s (Music s)+prepareMusic path = do+ wav <- readWAVE path+ i <- new $ variable $ source .~ sampleSource wav $ Deck.empty+ linkAudio $ \dt n -> i .- playback dt n+ return i++phases :: Set Time -- ^ timings+ -> Time -- ^ life span+ -> Time -- ^ the current time+ -> [Float] -- ^ phase+phases s len t = map ((/len) . subtract t) -- transform to an interval [0, 1]+ $ Set.toList+ $ fst $ Set.split (t + len) s -- before the limit++circle_png :: Bitmap+circle_png = unsafePerformIO $ readBitmap "assets/circle.png"++_perfect_png = unsafePerformIO $ readBitmap "assets/perfect.png"+_good_png = unsafePerformIO $ readBitmap "assets/good.png"+_error_png = unsafePerformIO $ readBitmap "assets/error.png"++circles :: [Float] -> Picture+circles = foldMap (\p -> V2 320 ((1 - p) * 480) `translate` bitmap circle_png)++renderLane :: Set Time -> Time -> Picture+renderLane ts t = mconcat [color blue $ circles (phases ts 1 t)+ , V2 320 480 `translate` color black (bitmap circle_png) -- criterion+ ]++getPosition :: Music s -> System s Time+getPosition m = m .- use pos++playMusic :: Music s -> System s ()+playMusic m = m .- playing .= True++parseScore :: Time -> String -> [Set Time]+parseScore d = map (Set.fromAscList . concat . zipWith (map . (+)) [0,d..]) . Data.List.transpose . map (map f) . splitWhen (=="") . lines where+ f l = [t | (t, c) <- zip [0, d/fromIntegral (length l)..] l, c == '.']++type Effect m = Mortal (Request Time Picture) m ()++rate :: Monad m => Time -> (Int, Effect m)+rate dt+ | dt < 0.05 = (4, pop _perfect_png)+ | dt < 0.1 = (2, pop _good_png)+ | otherwise = (1, pop _error_png)++handle :: Monad m => Time -> Set Time -> ((Int, Effect m), Set Time)+handle t ts = case viewNearest t ts of+ Nothing -> ((0, pop _error_png), ts) -- The song is over+ Just (t', ts') -> (rate $ abs (t - t'), ts')++viewNearest :: (Num a, Ord a) => a -> Set a -> Maybe (a, Set a)+viewNearest t ts = case Set.split t ts of+ (sa@(Set.maxView -> Just (a, sa')), sb@(Set.minView -> Just (b, sb')))+ | t - a < b - t -> Just (a, sa' `Set.union` sb)+ | otherwise -> Just (b, sa `Set.union` sb')+ (Set.maxView -> Just (a, sa'), _) -> Just (a, sa')+ (_, Set.minView -> Just (b, sb')) -> Just (b, sb')+ _ -> Nothing++pop :: Monad m => Bitmap -> Effect m+pop bmp = Mortal $ Control.Object.transit 0.5 $ \t -> return $ translate (V2 320 360)+ $ translate (V2 0 (-80) ^* t)+ $ color (V4 1 1 1 (realToFrac $ 1 - t))+ $ bitmap bmp
src/tutorial-passive.hs view
@@ -1,61 +1,61 @@-{-# LANGUAGE Rank2Types, ImpredicativeTypes #-} -import Call -import Call.Util.Deck as Deck -import Control.Lens -import Control.Monad.State.Strict -import Data.Foldable (foldMap) -import qualified Data.Set as Set -import Data.Set (Set) -import System.IO.Unsafe -import Data.List -import Data.List.Split (splitWhen) - -gameMain :: System s () -gameMain = do - music <- prepareMusic "assets/Monoidal Purity.wav" - - allTimings <- liftIO $ (!!0) <$> parseScore (60/160*4) <$> readFile "assets/Monoidal Purity.txt" - - linkPicture $ \_ -> renderLane allTimings <$> getPosition music - - playMusic music - -main = runSystemDefault (gameMain >> stand) - -type Music s = Inst' (StateT Deck (System s)) (System s) - -prepareMusic :: FilePath -> System s (Music s) -prepareMusic path = do - wav <- readWAVE path - i <- new $ variable $ source .~ sampleSource wav $ Deck.empty - linkAudio $ \dt n -> i .- playback dt n - return i - -phases :: Set Time -- ^ timings - -> Time -- ^ life span - -> Time -- ^ the current time - -> [Float] -- ^ phase -phases s len t = map ((/len) . subtract t) -- transform to an interval [0, 1] - $ Set.toList - $ fst $ Set.split (t + len) s -- before the limit - -circle_png :: Bitmap -circle_png = unsafePerformIO $ readBitmap "assets/circle.png" - -circles :: [Float] -> Picture -circles = foldMap (\p -> V2 320 ((1 - p) * 480) `translate` bitmap circle_png) - -renderLane :: Set Time -> Time -> Picture -renderLane ts t = mconcat [color blue $ circles (phases ts 1 t) - , V2 320 480 `translate` color black (bitmap circle_png) -- criterion - ] - -getPosition :: Music s -> System s Time -getPosition m = m .- use pos - -playMusic :: Music s -> System s () -playMusic m = m .- playing .= True - -parseScore :: Time -> String -> [Set Time] -parseScore d = map (Set.fromAscList . concat . zipWith (map . (+)) [0,d..]) . Data.List.transpose . map (map f) . splitWhen (=="") . lines where - f l = [t | (t, c) <- zip [0, d/fromIntegral (length l)..] l, c == '.'] +{-# LANGUAGE Rank2Types, ImpredicativeTypes #-}+import Call+import Call.Util.Deck as Deck+import Control.Lens+import Control.Monad.State.Strict+import Data.Foldable (foldMap)+import qualified Data.Set as Set+import Data.Set (Set)+import System.IO.Unsafe+import Data.List+import Data.List.Split (splitWhen)++gameMain :: System s ()+gameMain = do+ music <- prepareMusic "assets/Monoidal Purity.wav"++ allTimings <- liftIO $ (!!0) <$> parseScore (60/160*4) <$> readFile "assets/Monoidal Purity.txt"++ linkPicture $ \_ -> renderLane allTimings <$> getPosition music++ playMusic music++main = runSystemDefault (gameMain >> stand)++type Music s = Instance (StateT Deck (System s)) (System s)++prepareMusic :: FilePath -> System s (Music s)+prepareMusic path = do+ wav <- readWAVE path+ i <- new $ variable $ source .~ sampleSource wav $ Deck.empty+ linkAudio $ \dt n -> i .- playback dt n+ return i++phases :: Set Time -- ^ timings+ -> Time -- ^ life span+ -> Time -- ^ the current time+ -> [Float] -- ^ phase+phases s len t = map ((/len) . subtract t) -- transform to an interval [0, 1]+ $ Set.toList+ $ fst $ Set.split (t + len) s -- before the limit++circle_png :: Bitmap+circle_png = unsafePerformIO $ readBitmap "assets/circle.png"++circles :: [Float] -> Picture+circles = foldMap (\p -> V2 320 ((1 - p) * 480) `translate` bitmap circle_png)++renderLane :: Set Time -> Time -> Picture+renderLane ts t = mconcat [color blue $ circles (phases ts 1 t)+ , V2 320 480 `translate` color black (bitmap circle_png) -- criterion+ ]++getPosition :: Music s -> System s Time+getPosition m = m .- use pos++playMusic :: Music s -> System s ()+playMusic m = m .- playing .= True++parseScore :: Time -> String -> [Set Time]+parseScore d = map (Set.fromAscList . concat . zipWith (map . (+)) [0,d..]) . Data.List.transpose . map (map f) . splitWhen (=="") . lines where+ f l = [t | (t, c) <- zip [0, d/fromIntegral (length l)..] l, c == '.']