Commit 47960fc7ec66a90aaa998a3d143de55d73d82fc7 - hypsibius

+2

-0

.gitignore less more

	1	*~
	2	dist-newstyle

+11

-0

LICENSE less more

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

+15

-0

data/scales/12tet.hps less more

	1	hypsibius scale
	2	# this is a basic twelve-tone scale
	3
	4	0 C
	5	100 C♯
	6	200 D
	7	300 D♯
	8	400 E
	9	500 F
	10	600 F♯
	11	700 G
	12	800 G♯
	13	900 A
	14	1000 A♯
	15	1100 B

+22

-0

data/scales/19tet.hps less more

	1	hypsibius scale
	2	# nineteen-tone equal temperament
	3
	4	0 A
	5	63 A♯
	6	126 B♭
	7	189 B
	8	253 B♯
	9	316 C
	10	379 C♯
	11	442 D♭
	12	505 D
	13	568 D♯
	14	632 E♭
	15	695 E
	16	758 E♯
	17	821 F
	18	884 F♯
	19	947 G♭
	20	1011 G
	21	1074 G♯
	22	1137 A♭⏎

+15

-0

data/scales/just-intonation.hps less more

	1	hypsibius scale
	2	# the twelve-tone scale in just intonation
	3
	4	0.00 C
	5	111.72 C♯
	6	203.91 D
	7	315.64 D♯
	8	386.31 E
	9	498.04 F
	10	582.51 F♯
	11	701.96 G
	12	813.69 G♯
	13	884.36 A
	14	996.09 A♯
	15	1088.27 B

+30

-0

hypsibius.cabal less more

	1	name: hypsibius
	2	version: 0.1.0.0
	3	-- synopsis:
	4	-- description:
	5	license: OtherLicense
	6	license-file: LICENSE
	7	author: Getty Ritter <gettyritter@gmail.com>
	8	maintainer: Getty Ritter <gettyritter@gmail.com>
	9	copyright: ©2016 Getty Ritter
	10	category: Music
	11	build-type: Simple
	12	cabal-version: >= 1.12
	13
	14	executable hypsibius
	15	hs-source-dirs: src
	16	main-is: Main.hs
	17	other-modules: State
	18	, Draw
	19	, Event
	20	default-extensions: OverloadedStrings,
	21	ScopedTypeVariables
	22	ghc-options: -Wall -threaded
	23	build-depends: base >=4.7 && <4.9
	24	, brick
	25	, lens-family-core
	26	, text
	27	, containers
	28	, vty
	29	, data-default
	30	default-language: Haskell2010

+8

-0

src/Draw.hs less more

+16

-0

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

+25

-0

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)

+2

-0

src/Formats.hs less more

	1	module Formats where
	2

+27

-0

src/Main.hs less more

	1	module Main where
	2
	3	import Brick
	4	import qualified Control.Concurrent.Chan as Chan
	5	import Data.Default (def)
	6	import qualified Graphics.Vty as Vty
	7
	8
	9	import qualified State
	10	import qualified Draw
	11	import qualified Event
	12
	13	trackerApp :: App State.State Event.Event Int
	14	trackerApp = App
	15	{ appDraw = Draw.draw
	16	, appChooseCursor = \_ _ -> Nothing
	17	, appHandleEvent = Event.handle
	18	, appStartEvent = Event.initialize
	19	, appAttrMap = def
	20	, appLiftVtyEvent = Event.VtyEvent
	21	}
	22
	23	main :: IO ()
	24	main = do
	25	eventChan <- Chan.newChan
	26	_ <- customMain (Vty.mkVty def) eventChan trackerApp State.newState
	27	return ()

+38

-0

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	}