rhythm-game-tutorial (empty) → 0.0

raw patch · 17 files changed

+684/−0 lines, 17 filesdep +basedep +calldep +containerssetup-changedbinary-added

Dependencies added: base, call, containers, lens, mtl, objective, split

Files

LICENSE +30/−0
Setup.hs +2/−0
assets/Monoidal Purity.txt +301/−0
assets/Monoidal Purity.wav too large to diff
assets/circle.png binary
assets/clap.wav binary
assets/clap1.wav binary
assets/error.png binary
assets/glow_blue.png binary
assets/glow_orange.png binary
assets/good.png binary
assets/perfect.png binary
rhythm-game-tutorial.cabal +52/−0
src/music-only.hs +21/−0
src/tutorial-active.hs +97/−0
src/tutorial-extended.hs +120/−0
src/tutorial-passive.hs +61/−0

+ LICENSE view

@@ -0,0 +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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ assets/Monoidal Purity.txt view

@@ -0,0 +1,301 @@+----------------
+----------------
+----------------
+
+----------------
+----------------
+----------------
+
+----.-----------
+.-------.-------
+------------.---
+
+----.-----------
+.-----------.---
+--------.-------
+
+----.-----------
+.-------.---.---
+----------------
+
+----------------
+.---------------
+----.---.---.---
+
+----------------
+.---------------
+----------------
+
+------.---------
+------------.---
+.---------------
+
+------------.-.-
+.-------.-------
+----.-.---------
+
+-.-.-.-.--------
+.-------.-------
+--.-.-.---------
+
+.-------------.-
+--.-.---.-.-.---
+------.--.------
+
+--.-----.-----.-
+.---.-------.---
+------.---.-----
+
+----.-----.-----
+.-----------.---
+----.---------.-
+
+------.---.-----
+.---.-------.---
+--.-----------.-
+
+--.-.---------.-
+.-----.-.-.-.---
+---------.------
+
+--.-----.-----.-
+.---.-------.---
+------.---.-----
+
+.---------.-----
+----.---.-------
+------.---------
+
+--.-------.---.-
+----.---.---.---
+------.---------
+
+.-------------.-
+--.-.---.-.-.---
+------.--.------
+
+--.-----.-----.-
+.---.-------.---
+------.---.-----
+
+----.-----.-----
+.-----------.---
+----.---------.-
+
+------.---.-----
+.---.-------.---
+--.-----------.-
+
+--.-.---------.-
+.-----.-.-.-.---
+---------.------
+
+--.-----.-----.-
+.---.-------.---
+------.---.-----
+
+.---.---.---.---
+----------------
+--.---.---.---.-
+
+.-.-.-.-.-.-.-.-
+----------------
+-.-.-.-.-.-.-.-.
+
+------------.-.-
+.--.--.--.------
+----------------
+
+------------.-.-
+.--.--.--.------
+----------------
+
+------------.-.-
+----------------
+.--.--.--.------
+
+------------.-.-
+----------------
+.--.--.--.------
+
+------------.-.-
+.--.--.--.------
+----------------
+
+------------.-.-
+.--.--.--.------
+----------------
+
+------------.-.-
+----------------
+.--.--.--.------
+
+------------.-.-
+----------------
+.--.--.--.------
+
+----------------
+----------------
+--.-.---.--.--.-
+
+----------------
+--.-.---.--.--.-
+----------------
+
+.---.---.--.--.-
+----------------
+----------------
+
+----------------
+.---.---.--.--.-
+----------------
+
+----------------
+--------.--.--.-
+--.-.-----------
+
+----------------
+--.-.-----------
+--------.--.--.-
+
+--------.--.--.-
+--.-.-----------
+----------------
+
+--.-.-----------
+----------------
+--------.--.--.-
+
+------------.---
+.---------------
+----.-----------
+
+------------.---
+----------------
+----.-----------
+
+------------.---
+----------------
+----.-----------
+
+------------.---
+----------------
+----.-----------
+
+------------.---
+.-------.-------
+----.-----------
+
+------------.---
+.-------.-------
+----.-----------
+
+------------.---
+.-------.-------
+----.-----------
+
+------------.---
+.-------.-------
+----.-----------
+
+------------.---
+.-------.-------
+----.-----------
+
+------------.---
+.-------.-------
+----.-----------
+
+------------.---
+.-------.-------
+----.-----------
+
+------------.---
+.-------.-------
+----.-----------
+
+----------------
+.---------------
+----------------
+
+----------------
+.---------------
+----------------
+
+----------------
+.-------.-------
+----------------
+
+.---.---.-.-.-.-
+----------------
+--.---.--.-.-.-.
+
+
+.-------.-.---.-
+.-.-.-------.---
+.-----.--.------
+
+--.-----------.-
+.---.---.---.---
+------.---.-----
+
+----.-----.-----
+.-----------.---
+----.---------.-
+
+------.---.-----
+.---.-------.---
+--.-----------.-
+
+--------.-.---.-
+--.-.-------.---
+.-----.--.------
+
+.---.-----.---.-
+--.-----.---.---
+------.---------
+
+----.-----------
+.-----.---.---.-
+------------.---
+
+--.-------.---.-
+----.---.---.---
+------.---------
+
+
+.-------.-.---.-
+.-.-.-------.---
+.-----.--.------
+
+--.-----------.-
+.---.---.---.---
+------.---.-----
+
+----.-----.-----
+.-----------.---
+----.---------.-
+
+------.---.-----
+.---.-------.---
+--.-----------.-
+
+--------.-.---.-
+--.-.-------.---
+.-----.--.------
+
+.---.-----.---.-
+--.-----.---.---
+------.---------
+
+----.-----------
+.-----.---.---.-
+------------.---
+
+--.---.---------
+.---.-----.---.-
+--------.---.---
+
+.---------------
+.---------------
+.---------------

+ assets/Monoidal Purity.wav view

file too large to diff

+ assets/circle.png view

binary file changed (absent → 1163 bytes)

+ assets/clap.wav view

binary file changed (absent → 22194 bytes)

+ assets/clap1.wav view

binary file changed (absent → 52122 bytes)

+ assets/error.png view

binary file changed (absent → 1316 bytes)

+ assets/glow_blue.png view

binary file changed (absent → 3695 bytes)

+ assets/glow_orange.png view

binary file changed (absent → 3747 bytes)

+ assets/good.png view

binary file changed (absent → 1285 bytes)

+ assets/perfect.png view

binary file changed (absent → 1150 bytes)

+ rhythm-game-tutorial.cabal view

@@ -0,0 +1,52 @@+name:                rhythm-game-tutorial
+version:             0.0
+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

+ src/music-only.hs view

@@ -0,0 +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

+ src/tutorial-active.hs view

@@ -0,0 +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

+ src/tutorial-extended.hs view

@@ -0,0 +1,120 @@+{-# 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

+ src/tutorial-passive.hs view

@@ -0,0 +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 == '.']