Browse Source

Update for newer Brick + initial efforts towards s-exp data rep

Getty Ritter 7 years ago
parent
commit
0e7644aab3
6 changed files with 77 additions and 32 deletions
  1. 16 15
      data/scales/12tet.hps
  2. 2 1
      hypsibius.cabal
  3. 31 5
      src/Hypsibius/Data.hs
  4. 4 4
      src/Hypsibius/Event.hs
  5. 20 2
      src/Hypsibius/Formats/Scale.hs
  6. 4 5
      src/Main.hs

+ 16 - 15
data/scales/12tet.hps

@@ -1,15 +1,16 @@
-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
+ ;; this is a basic twelve-tone scale
+(hypsibius-scale
+ :name "twelve-tone equal temperament"
+ :size 1200
+ (note "A"  0)
+ (note "A♯" 100 :color black)
+ (note "B"  200)
+ (note "C"  300)
+ (note "C♯" 400 :color black)
+ (note "D"  500)
+ (note "D♯" 600 :color black)
+ (note "E"  700)
+ (note "F"  800)
+ (note "F♯" 900 :color black)
+ (note "G"  1000)
+ (note "G♯" 1100 :color black))

+ 2 - 1
hypsibius.cabal

@@ -23,7 +23,7 @@ executable hypsibius
   default-extensions:  OverloadedStrings,
                        ScopedTypeVariables
   ghc-options:         -Wall -threaded
-  build-depends:       base >=4.7 && <4.9
+  build-depends:       base >=4.7 && <4.10
                      , brick
                      , lens-family-core
                      , lens-family-th
@@ -31,4 +31,5 @@ executable hypsibius
                      , containers
                      , vty
                      , data-default
+                     , s-cargot
   default-language:    Haskell2010

+ 31 - 5
src/Hypsibius/Data.hs

@@ -3,27 +3,39 @@
 module Hypsibius.Data where
 
 import           Data.Sequence (Seq)
-import qualified Data.Sequence as S
 import           Data.Text (Text)
 import           Data.Word (Word8)
 import           Lens.Family2.TH
 
+-- | XXX: This is a temporary definition of 'Oscillator' for early
+--   prototyping purposes.
 data Oscillator
   = OscSine
   | OscSquare
     deriving (Eq, Show)
 
+-- | XXX: This is a temporary definition of 'Instrument' for early
+--   prototyping purposes.
 data Instrument = Instrument
   { _instrSource :: Oscillator
   } deriving (Eq, Show)
 
 $(makeLenses ''Instrument)
 
+
+-- | We'll maintain a list of instruments and refer to them using
+--   indices. For type safety, here is a wrapper around those
+--   indices.
 newtype InstrRef = InstrRef { _fromInstrRef :: Int }
   deriving (Eq, Show)
 
 $(makeLenses ''InstrRef)
 
+-- | A 'Note' here is an individual element of a scale, which we'll
+--   maintain a unique list of on a per-song basis, and most of the time
+--   we'll use indices into that list. A 'Note' has a frequency represented
+--   in cents and an appearance that the user will see when running the
+--   program, which should be no more than a few characters long.
 data Note = Note
   { _noteCents      :: Double
   , _noteAppearance :: Text
@@ -31,11 +43,15 @@ data Note = Note
 
 $(makeLenses ''Note)
 
+-- | We'll maintain a list of notes and refer to them using indices. For type
+--   safety, here is a wrapper around those indices.
 newtype NoteRef = NoteRef { _fromNoteRef :: Int }
   deriving (Eq, Show)
 
 $(makeLenses ''NoteRef)
 
+-- | A 'Scale' has a name, a total number of cents (which will almost always be
+--   1200 for traditional scales) and a list of notes associated with it.
 data Scale = Scale
   { _scaleName       :: Text
   , _scaleTotalCents :: Double
@@ -44,13 +60,10 @@ data Scale = Scale
 
 $(makeLenses ''Scale)
 
+-- | An 'Event' is a typical event associated with a song.
 data Event = Event
   deriving (Eq, Show)
 
-data Track = Track
-  {
-  } deriving (Eq, Show)
-
 data Beats
   = BeatsSimple Word8
   | BeatsAdditive [Word8]
@@ -59,6 +72,7 @@ data Beats
 
 $(makeTraversals ''Beats)
 
+
 data Signature = Signature
   { _sigPerBar   :: Beats
   , _sigBeatUnit :: Word8
@@ -66,6 +80,18 @@ data Signature = Signature
 
 $(makeLenses ''Signature)
 
+
+data TrackChunk = TrackChunk
+  { _tcSignature :: Signature
+  } deriving (Eq, Show)
+
+
+data Track = Track
+  {
+  } deriving (Eq, Show)
+
+
+
 data Song = Song
   { _songScale  :: Scale
   , _songTracks :: Seq Track

+ 4 - 4
src/Hypsibius/Event.hs

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

+ 20 - 2
src/Hypsibius/Formats/Scale.hs

@@ -2,12 +2,29 @@
 
 module Hypsibius.Formats.Scale (parse) where
 
+import           Data.SCargot
+import           Data.SCargot.Repr.Basic
 import           Data.Sequence (Seq)
 import qualified Data.Sequence as S
 import           Data.Text (Text)
-import qualified Data.Text as T
+-- import qualified Data.Text as T
 
-import           Hypsibius.Data (Note(..))
+import           Hypsibius.Data (Note(..), Scale(..))
+
+data Atom
+  = AIdent  Text
+  | AString Text
+  | AInt    Integer
+  | AFloat  Double
+  | AKWord Text
+    deriving (Eq, Show)
+
+parseScale :: Text -> Either String Scale
+parseScale = undefined
+
+parse = undefined
+
+{-
 
 parse :: Text -> Either String (Seq Note)
 parse t = case T.lines t of
@@ -23,3 +40,4 @@ parseLines (l:ls) =
       let n = Note (read (T.unpack cents)) name
       in (n S.<|) <$> parseLines ls
     rs -> Left ("Bad declaration: " ++ show rs)
+-}

+ 4 - 5
src/Main.hs

@@ -1,7 +1,7 @@
 module Main where
 
 import           Brick
-import qualified Control.Concurrent.Chan as Chan
+import qualified Brick.BChan as Brick
 import           Data.Default (def)
 import qualified Graphics.Vty as Vty
 
@@ -17,12 +17,11 @@ trackerApp = App
   , appChooseCursor = \_ _ -> Nothing
   , appHandleEvent  = Event.handle
   , appStartEvent   = Event.initialize
-  , appAttrMap      = def
-  , appLiftVtyEvent = Event.VtyEvent
+  , appAttrMap      = \ _ -> attrMap mempty []
   }
 
 main :: IO ()
 main = do
-  eventChan <- Chan.newChan
-  _ <- customMain (Vty.mkVty def) eventChan trackerApp State.newState
+  eventChan <- Brick.newBChan 32
+  _ <- customMain (Vty.mkVty mempty) (Just eventChan) trackerApp State.newState
   return ()