gdritter repos hypsibius / f106804
Reorganized modules Getty Ritter 8 years ago
13 changed file(s) with 120 addition(s) and 95 deletion(s). Collapse all Expand all
+6
-3
hypsibius.cabal less more
1414 executable hypsibius
1515 hs-source-dirs: src
1616 main-is: Main.hs
17 other-modules: State
18 , Draw
19 , Event
17 other-modules: Hypsibius.Data
18 , Hypsibius.Draw
19 , Hypsibius.Event
20 , Hypsibius.Formats
21 , Hypsibius.Formats.Scale
22 , Hypsibius.State
2023 default-extensions: OverloadedStrings,
2124 ScopedTypeVariables
2225 ghc-options: -Wall -threaded
+0
-8
src/Draw.hs less more
1 module Draw where
2
3 import Brick
4
5 import State
6
7 draw :: State -> [Widget Int]
8 draw _ = [str "whoo"]
+0
-16
src/Event.hs less more
1 module Event where
2
3 import Brick (EventM, Next)
4 import qualified Brick
5 import qualified Graphics.Vty.Input.Events as Vty
6
7 import qualified State
8
9 data Event = VtyEvent Vty.Event
10
11 handle :: State.State -> Event -> EventM Int (Next State.State)
12 handle s (VtyEvent (Vty.EvKey Vty.KEsc _)) = Brick.halt s
13 handle s _ = Brick.continue s
14
15 initialize :: State.State -> EventM Int State.State
16 initialize s = return s
+0
-25
src/Formats/Scale.hs less more
1 {-# LANGUAGE ViewPatterns #-}
2
3 module Formats.Scale where
4
5 import Data.Sequence (Seq)
6 import qualified Data.Sequence as S
7 import Data.Text (Text)
8 import qualified Data.Text as T
9
10 import State (Note(..))
11
12 parse :: Text -> Either String (Seq Note)
13 parse t = case T.lines t of
14 ((T.takeWhile (/= '#') -> "hypsibius scale"):rs) -> parseLines rs
15 _ -> Left "Not a valid Hypsibius scale: missing header\n"
16
17 parseLines :: [Text] -> Either String (Seq Note)
18 parseLines [] = pure S.empty
19 parseLines (l:ls) =
20 case T.words (T.takeWhile (/= '#') l) of
21 [] -> parseLines ls
22 [cents, name] ->
23 let n = Note (read (T.unpack cents)) name
24 in (n S.<|) <$> parseLines ls
25 rs -> Left ("Bad declaration: " ++ show rs)
+0
-2
src/Formats.hs less more
1 module Formats where
2
+31
-0
src/Hypsibius/Data.hs less more
1 module Hypsibius.Data where
2
3 import Data.Sequence (Seq)
4 import qualified Data.Sequence as S
5 import Data.Text (Text)
6
7 data Instrument = Instrument
8 { instrSource :: Oscillator }
9 deriving (Eq, Show)
10
11 newtype InstrRef = InstrRef { fromInstrRef :: Int }
12 deriving (Eq, Show)
13
14 data Oscillator
15 = OscSine
16 | OscSquare
17 deriving (Eq, Show)
18
19 data Note = Note
20 { noteCents :: Double
21 , noteAppearance :: Text
22 } deriving (Eq, Show)
23
24 newtype NoteRef = NoteRef { fromNoteRef :: Int }
25 deriving (Eq, Show)
26
27 data Scale = Scale
28 { scaleName :: Text
29 , scaleTotalCents :: Double
30 , scaleNotes :: Seq Note
31 } deriving (Eq, Show)
+8
-0
src/Hypsibius/Draw.hs less more
1 module Hypsibius.Draw where
2
3 import Brick
4
5 import Hypsibius.State
6
7 draw :: State -> [Widget Int]
8 draw _ = [str "whoo"]
+16
-0
src/Hypsibius/Event.hs less more
1 module Hypsibius.Event where
2
3 import Brick (EventM, Next)
4 import qualified Brick
5 import qualified Graphics.Vty.Input.Events as Vty
6
7 import qualified Hypsibius.State as State
8
9 data Event = VtyEvent Vty.Event
10
11 handle :: State.State -> Event -> EventM Int (Next State.State)
12 handle s (VtyEvent (Vty.EvKey Vty.KEsc _)) = Brick.halt s
13 handle s _ = Brick.continue s
14
15 initialize :: State.State -> EventM Int State.State
16 initialize s = return s
+25
-0
src/Hypsibius/Formats/Scale.hs less more
1 {-# LANGUAGE ViewPatterns #-}
2
3 module Hypsibius.Formats.Scale (parse) where
4
5 import Data.Sequence (Seq)
6 import qualified Data.Sequence as S
7 import Data.Text (Text)
8 import qualified Data.Text as T
9
10 import Hypsibius.Data (Note(..))
11
12 parse :: Text -> Either String (Seq Note)
13 parse t = case T.lines t of
14 ((T.takeWhile (/= '#') -> "hypsibius scale"):rs) -> parseLines rs
15 _ -> Left "Not a valid Hypsibius scale: missing header\n"
16
17 parseLines :: [Text] -> Either String (Seq Note)
18 parseLines [] = pure S.empty
19 parseLines (l:ls) =
20 case T.words (T.takeWhile (/= '#') l) of
21 [] -> parseLines ls
22 [cents, name] ->
23 let n = Note (read (T.unpack cents)) name
24 in (n S.<|) <$> parseLines ls
25 rs -> Left ("Bad declaration: " ++ show rs)
+10
-0
src/Hypsibius/Formats.hs less more
1 module Hypsibius.Formats where
2
3 import Data.Sequence (Seq)
4 import qualified Data.Text.IO as T
5
6 import qualified Hypsibius.Formats.Scale as Scale
7 import Hypsibius.Data (Note)
8
9 readScale :: FilePath -> IO (Either String (Seq Note))
10 readScale = fmap Scale.parse . T.readFile
+20
-0
src/Hypsibius/State.hs less more
1 module Hypsibius.State where
2
3 import Data.Sequence (Seq)
4 import qualified Data.Sequence as S
5 import Data.Text (Text)
6
7 import Hypsibius.Data
8
9 data State = State
10 { stateFile :: Maybe FilePath
11 , stateInstruments :: Seq Instrument
12 , stateScale :: Seq Note
13 } deriving (Show)
14
15 newState :: State
16 newState = State
17 { stateFile = Nothing
18 , stateInstruments = S.empty
19 , stateScale = S.empty
20 }
+4
-3
src/Main.hs less more
66 import qualified Graphics.Vty as Vty
77
88
9 import qualified State
10 import qualified Draw
11 import qualified Event
9 import qualified Hypsibius.State as State
10 import qualified Hypsibius.Draw as Draw
11 import qualified Hypsibius.Event as Event
12 import qualified Hypsibius.Formats as Formats
1213
1314 trackerApp :: App State.State Event.Event Int
1415 trackerApp = App
+0
-38
src/State.hs less more
1 module State where
2
3 import Data.Sequence (Seq)
4 import qualified Data.Sequence as S
5 import Data.Text (Text)
6
7 data Instrument = Instrument
8 { instrSource :: Oscillator }
9 deriving (Eq, Show)
10
11 newtype InstrRef = InstrRef { fromInstrRef :: Int }
12 deriving (Eq, Show)
13
14 data Oscillator
15 = OscSine
16 | OscSquare
17 deriving (Eq, Show)
18
19 data Note = Note
20 { noteCents :: Double
21 , noteAppearance :: Text
22 } deriving (Eq, Show)
23
24 newtype NoteRef = NoteRef { fromNoteRef :: Int }
25 deriving (Eq, Show)
26
27 data State = State
28 { stateFile :: Maybe FilePath
29 , stateInstruments :: Seq Instrument
30 , stateScale :: Seq Note
31 } deriving (Show)
32
33 newState :: State
34 newState = State
35 { stateFile = Nothing
36 , stateInstruments = S.empty
37 , stateScale = S.empty
38 }