Non-working beginnings of a tracker

.gitignore

@@ -0,0 +1,2 @@
+*~
+dist-newstyle

LICENSE

@@ -0,0 +1,11 @@
+                           Tumbolia Public License
+
+Copyright 2016, Getty Ritter <gdritter@galois.com>
+
+Copying and distribution of this file, with or without modification, are
+permitted in any medium without royalty provided the copyright notice and this
+notice are preserved.
+
+TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. opan saurce LOL

data/scales/12tet.hps

@@ -0,0 +1,15 @@
+hypsibius scale
+# this is a basic twelve-tone scale
+
+0    C
+100  C♯
+200  D
+300  D♯
+400  E
+500  F
+600  F♯
+700  G
+800  G♯
+900  A
+1000 A♯
+1100 B

data/scales/19tet.hps

@@ -0,0 +1,22 @@
+hypsibius scale
+# nineteen-tone equal temperament
+
+   0 A
+  63 A♯
+ 126 B♭
+ 189 B
+ 253 B♯
+ 316 C
+ 379 C♯
+ 442 D♭
+ 505 D
+ 568 D♯
+ 632 E♭
+ 695 E
+ 758 E♯
+ 821 F
+ 884 F♯
+ 947 G♭
+1011 G
+1074 G♯
+1137 A♭

data/scales/just-intonation.hps

@@ -0,0 +1,15 @@
+hypsibius scale
+# the twelve-tone scale in just intonation
+
+   0.00  C
+ 111.72  C♯
+ 203.91  D
+ 315.64  D♯
+ 386.31  E
+ 498.04  F
+ 582.51  F♯
+ 701.96  G
+ 813.69  G♯
+ 884.36  A
+ 996.09  A♯
+1088.27  B

hypsibius.cabal

@@ -0,0 +1,30 @@
+name:             hypsibius
+version:          0.1.0.0
+-- synopsis:
+-- description:
+license:          OtherLicense
+license-file:     LICENSE
+author:           Getty Ritter <gettyritter@gmail.com>
+maintainer:       Getty Ritter <gettyritter@gmail.com>
+copyright:        ©2016 Getty Ritter
+category:         Music
+build-type:       Simple
+cabal-version:    >= 1.12
+
+executable hypsibius
+  hs-source-dirs:      src
+  main-is:             Main.hs
+  other-modules:       State
+                     , Draw
+                     , Event
+  default-extensions:  OverloadedStrings,
+                       ScopedTypeVariables
+  ghc-options:         -Wall -threaded
+  build-depends:       base >=4.7 && <4.9
+                     , brick
+                     , lens-family-core
+                     , text
+                     , containers
+                     , vty
+                     , data-default
+  default-language:    Haskell2010

src/Draw.hs

@@ -0,0 +1,8 @@
+module Draw where
+
+import Brick
+
+import State
+
+draw :: State -> [Widget Int]
+draw _ = [str "whoo"]

src/Event.hs

@@ -0,0 +1,16 @@
+module Event where
+
+import           Brick (EventM, Next)
+import qualified Brick
+import qualified Graphics.Vty.Input.Events as Vty
+
+import qualified State
+
+data Event = VtyEvent Vty.Event
+
+handle :: State.State -> Event -> EventM Int (Next State.State)
+handle s (VtyEvent (Vty.EvKey Vty.KEsc _)) = Brick.halt s
+handle s _ = Brick.continue s
+
+initialize :: State.State -> EventM Int State.State
+initialize s = return s

src/Formats.hs

@@ -0,0 +1,2 @@
+module Formats where
+

src/Formats/Scale.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE ViewPatterns #-}
+
+module Formats.Scale where
+
+import           Data.Sequence (Seq)
+import qualified Data.Sequence as S
+import           Data.Text (Text)
+import qualified Data.Text as T
+
+import           State (Note(..))
+
+parse :: Text -> Either String (Seq Note)
+parse t = case T.lines t of
+  ((T.takeWhile (/= '#') -> "hypsibius scale"):rs) -> parseLines rs
+  _ -> Left "Not a valid Hypsibius scale: missing header\n"
+
+parseLines :: [Text] -> Either String (Seq Note)
+parseLines [] = pure S.empty
+parseLines (l:ls) =
+  case T.words (T.takeWhile (/= '#') l) of
+    [] -> parseLines ls
+    [cents, name] ->
+      let n = Note (read (T.unpack cents)) name
+      in (n S.<|) <$> parseLines ls
+    rs -> Left ("Bad declaration: " ++ show rs)

src/Main.hs

@@ -0,0 +1,27 @@
+module Main where
+
+import           Brick
+import qualified Control.Concurrent.Chan as Chan
+import           Data.Default (def)
+import qualified Graphics.Vty as Vty
+
+
+import qualified State
+import qualified Draw
+import qualified Event
+
+trackerApp :: App State.State Event.Event Int
+trackerApp = App
+  { appDraw         = Draw.draw
+  , appChooseCursor = \_ _ -> Nothing
+  , appHandleEvent  = Event.handle
+  , appStartEvent   = Event.initialize
+  , appAttrMap      = def
+  , appLiftVtyEvent = Event.VtyEvent
+  }
+
+main :: IO ()
+main = do
+  eventChan <- Chan.newChan
+  _ <- customMain (Vty.mkVty def) eventChan trackerApp State.newState
+  return ()

src/State.hs

@@ -0,0 +1,38 @@
+module State where
+
+import           Data.Sequence (Seq)
+import qualified Data.Sequence as S
+import           Data.Text (Text)
+
+data Instrument = Instrument
+  { instrSource :: Oscillator }
+  deriving (Eq, Show)
+
+newtype InstrRef = InstrRef { fromInstrRef :: Int }
+  deriving (Eq, Show)
+
+data Oscillator
+  = OscSine
+  | OscSquare
+    deriving (Eq, Show)
+
+data Note = Note
+  { noteCents      :: Double
+  , noteAppearance :: Text
+  } deriving (Eq, Show)
+
+newtype NoteRef = NoteRef { fromNoteRef :: Int }
+  deriving (Eq, Show)
+
+data State = State
+  { stateFile        :: Maybe FilePath
+  , stateInstruments :: Seq Instrument
+  , stateScale       :: Seq Note
+  } deriving (Show)
+
+newState :: State
+newState = State
+  { stateFile        = Nothing
+  , stateInstruments = S.empty
+  , stateScale       = S.empty
+  }