浏览代码

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

Getty Ritter 8 年之前
父节点
当前提交
0e7644aab3
共有 6 个文件被更改,包括 77 次插入32 次删除
  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,
   default-extensions:  OverloadedStrings,
                        ScopedTypeVariables
                        ScopedTypeVariables
   ghc-options:         -Wall -threaded
   ghc-options:         -Wall -threaded
-  build-depends:       base >=4.7 && <4.9
+  build-depends:       base >=4.7 && <4.10
                      , brick
                      , brick
                      , lens-family-core
                      , lens-family-core
                      , lens-family-th
                      , lens-family-th
@@ -31,4 +31,5 @@ executable hypsibius
                      , containers
                      , containers
                      , vty
                      , vty
                      , data-default
                      , data-default
+                     , s-cargot
   default-language:    Haskell2010
   default-language:    Haskell2010

+ 31 - 5
src/Hypsibius/Data.hs

@@ -3,27 +3,39 @@
 module Hypsibius.Data where
 module Hypsibius.Data where
 
 
 import           Data.Sequence (Seq)
 import           Data.Sequence (Seq)
-import qualified Data.Sequence as S
 import           Data.Text (Text)
 import           Data.Text (Text)
 import           Data.Word (Word8)
 import           Data.Word (Word8)
 import           Lens.Family2.TH
 import           Lens.Family2.TH
 
 
+-- | XXX: This is a temporary definition of 'Oscillator' for early
+--   prototyping purposes.
 data Oscillator
 data Oscillator
   = OscSine
   = OscSine
   | OscSquare
   | OscSquare
     deriving (Eq, Show)
     deriving (Eq, Show)
 
 
+-- | XXX: This is a temporary definition of 'Instrument' for early
+--   prototyping purposes.
 data Instrument = Instrument
 data Instrument = Instrument
   { _instrSource :: Oscillator
   { _instrSource :: Oscillator
   } deriving (Eq, Show)
   } deriving (Eq, Show)
 
 
 $(makeLenses ''Instrument)
 $(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 }
 newtype InstrRef = InstrRef { _fromInstrRef :: Int }
   deriving (Eq, Show)
   deriving (Eq, Show)
 
 
 $(makeLenses ''InstrRef)
 $(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
 data Note = Note
   { _noteCents      :: Double
   { _noteCents      :: Double
   , _noteAppearance :: Text
   , _noteAppearance :: Text
@@ -31,11 +43,15 @@ data Note = Note
 
 
 $(makeLenses ''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 }
 newtype NoteRef = NoteRef { _fromNoteRef :: Int }
   deriving (Eq, Show)
   deriving (Eq, Show)
 
 
 $(makeLenses ''NoteRef)
 $(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
 data Scale = Scale
   { _scaleName       :: Text
   { _scaleName       :: Text
   , _scaleTotalCents :: Double
   , _scaleTotalCents :: Double
@@ -44,13 +60,10 @@ data Scale = Scale
 
 
 $(makeLenses ''Scale)
 $(makeLenses ''Scale)
 
 
+-- | An 'Event' is a typical event associated with a song.
 data Event = Event
 data Event = Event
   deriving (Eq, Show)
   deriving (Eq, Show)
 
 
-data Track = Track
-  {
-  } deriving (Eq, Show)
-
 data Beats
 data Beats
   = BeatsSimple Word8
   = BeatsSimple Word8
   | BeatsAdditive [Word8]
   | BeatsAdditive [Word8]
@@ -59,6 +72,7 @@ data Beats
 
 
 $(makeTraversals ''Beats)
 $(makeTraversals ''Beats)
 
 
+
 data Signature = Signature
 data Signature = Signature
   { _sigPerBar   :: Beats
   { _sigPerBar   :: Beats
   , _sigBeatUnit :: Word8
   , _sigBeatUnit :: Word8
@@ -66,6 +80,18 @@ data Signature = Signature
 
 
 $(makeLenses ''Signature)
 $(makeLenses ''Signature)
 
 
+
+data TrackChunk = TrackChunk
+  { _tcSignature :: Signature
+  } deriving (Eq, Show)
+
+
+data Track = Track
+  {
+  } deriving (Eq, Show)
+
+
+
 data Song = Song
 data Song = Song
   { _songScale  :: Scale
   { _songScale  :: Scale
   , _songTracks :: Seq Track
   , _songTracks :: Seq Track

+ 4 - 4
src/Hypsibius/Event.hs

@@ -1,15 +1,15 @@
 module Hypsibius.Event where
 module Hypsibius.Event where
 
 
-import           Brick (EventM, Next)
+import           Brick (BrickEvent, EventM, Next)
 import qualified Brick
 import qualified Brick
 import qualified Graphics.Vty.Input.Events as Vty
 import qualified Graphics.Vty.Input.Events as Vty
 
 
 import qualified Hypsibius.State as State
 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
 handle s _ = Brick.continue s
 
 
 initialize :: State.State -> EventM Int State.State
 initialize :: State.State -> EventM Int State.State

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

@@ -2,12 +2,29 @@
 
 
 module Hypsibius.Formats.Scale (parse) where
 module Hypsibius.Formats.Scale (parse) where
 
 
+import           Data.SCargot
+import           Data.SCargot.Repr.Basic
 import           Data.Sequence (Seq)
 import           Data.Sequence (Seq)
 import qualified Data.Sequence as S
 import qualified Data.Sequence as S
 import           Data.Text (Text)
 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 :: Text -> Either String (Seq Note)
 parse t = case T.lines t of
 parse t = case T.lines t of
@@ -23,3 +40,4 @@ parseLines (l:ls) =
       let n = Note (read (T.unpack cents)) name
       let n = Note (read (T.unpack cents)) name
       in (n S.<|) <$> parseLines ls
       in (n S.<|) <$> parseLines ls
     rs -> Left ("Bad declaration: " ++ show rs)
     rs -> Left ("Bad declaration: " ++ show rs)
+-}

+ 4 - 5
src/Main.hs

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