[Haskell] Replicate a youtube video make audio
This commit is contained in:
parent
5e1e1563e6
commit
fc4cb83894
218
haskell/Music.hs
218
haskell/Music.hs
|
@ -1,65 +1,185 @@
|
||||||
-- https://hackage.haskell.org/package/bytestring-0.12.1.0/docs/Data-ByteString-Lazy.html#t:LazyByteString
|
import qualified Data.ByteString.Lazy as BSL
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Builder as BSB
|
||||||
|
|
||||||
-- https://hackage.haskell.org/package/bytestring-0.12.1.0/docs/Data-ByteString-Builder.html
|
|
||||||
import qualified Data.ByteString.Builder as B
|
|
||||||
|
|
||||||
import qualified Data.Foldable
|
import qualified Data.Foldable
|
||||||
import qualified System.Process
|
import qualified System.Process
|
||||||
import qualified Text.Printf
|
import qualified Text.Printf
|
||||||
|
|
||||||
|
|
||||||
|
-- Frequency in Hertz
|
||||||
type Hz = Float
|
type Hz = Float
|
||||||
type Seconds = Float
|
|
||||||
type Signal = [Float]
|
|
||||||
|
|
||||||
-- Byte strings with Little Endian 32 bit float
|
-- Time in seconds
|
||||||
|
type Sec = Float
|
||||||
|
|
||||||
-- B.floatLE n :: B.Builder
|
type Wave = [Float]
|
||||||
|
|
||||||
|
type Semitone = Int
|
||||||
|
type Beat = Float
|
||||||
|
|
||||||
outFile :: FilePath
|
outFile :: FilePath
|
||||||
outFile = "out.bin"
|
outFile = "out.bin"
|
||||||
|
|
||||||
-- volume :: Float
|
save :: Wave -> FilePath -> IO ()
|
||||||
-- volume = 0.2
|
save wav outfile
|
||||||
|
-- Write to outfile
|
||||||
-- Number of samples per second
|
= BSL.writeFile outfile
|
||||||
-- ie, number of float values per second
|
|
||||||
sampleRate :: Hz
|
|
||||||
sampleRate = 48000
|
|
||||||
|
|
||||||
-- step :: Float
|
|
||||||
-- step = 0.01
|
|
||||||
|
|
||||||
|
-- Build lazy byte string
|
||||||
duration :: Float
|
$ BSB.toLazyByteString
|
||||||
duration = 2.0
|
|
||||||
|
|
||||||
wave :: Float -> Hz -> Seconds -> Signal
|
-- Combine all data points into single bytestring
|
||||||
wave volume freq duration
|
$ Data.Foldable.fold
|
||||||
= map (* volume) -- adjust volume
|
|
||||||
$ map sin -- generate wave
|
|
||||||
$ map (* step) [0.0 .. sampleRate * duration]
|
|
||||||
where
|
|
||||||
step = (freq * 2 * pi) / sampleRate
|
|
||||||
|
|
||||||
sound :: Signal
|
-- build float little endian byte string for each data point
|
||||||
sound = concat $ map (++)
|
$ map BSB.floatLE wav
|
||||||
[wave 0.2 440 duration
|
|
||||||
wave 0.2 frq secs
|
|
||||||
|
|
||||||
toBS :: [Float] -> B.Builder
|
|
||||||
toBS wav = Data.Foldable.fold $ map B.floatLE wav
|
|
||||||
|
|
||||||
|
|
||||||
-- LazyByteString: Serializable-friendly form of ByteString
|
play :: Wave -> IO ()
|
||||||
-- https://hackage.haskell.org/package/bytestring-0.12.1.0/docs/Data-ByteString-Lazy.html#t:LazyByteString
|
play wav = do
|
||||||
save :: FilePath -> IO ()
|
save (map (*volume) wav) outFile
|
||||||
save outfile = BL.writeFile outfile $ B.toLazyByteString $ toBS sound
|
-- save wav outFile
|
||||||
|
_ <- System.Process.runCommand $ Text.Printf.printf
|
||||||
play :: IO ()
|
"ffplay -showmode 1 -f f32le -ar %f %s"
|
||||||
play = do
|
sr outFile
|
||||||
save outFile
|
|
||||||
_ <- System.Process.runCommand
|
|
||||||
$ Text.Printf.printf "ffplay -showmode 1 -f f32le -ar %f %s" sampleRate outFile
|
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
-----
|
||||||
|
|
||||||
|
-- Sample rate: Number of data points per second
|
||||||
|
sr :: Hz
|
||||||
|
sr = 48000
|
||||||
|
|
||||||
|
bpm :: Beat
|
||||||
|
bpm = 120.0
|
||||||
|
|
||||||
|
volume :: Float
|
||||||
|
volume = 0.4
|
||||||
|
--volume = 10
|
||||||
|
|
||||||
|
|
||||||
|
-- Generate a 'base wave' of given frequency and duration.
|
||||||
|
-- For use in `wave' function.
|
||||||
|
genBaseWave :: Hz -> Sec -> Wave
|
||||||
|
genBaseWave freq duration = map (sin . (*(step freq))) [0.0 .. (sr*duration - 1)]
|
||||||
|
where
|
||||||
|
-- Get step size for use in `genBaseWave'
|
||||||
|
step :: Hz -> Float
|
||||||
|
step freq = (2 * pi * freq) / sr
|
||||||
|
|
||||||
|
note :: Semitone -> Beat -> Wave
|
||||||
|
note n beatN = genWave (stFreq n) (beatN * beat1Duration )
|
||||||
|
where
|
||||||
|
beat1Duration = 60/bpm
|
||||||
|
|
||||||
|
-- |Generate a wave of given frequency and duration
|
||||||
|
genWave :: Hz -> Sec -> Wave
|
||||||
|
genWave freq duration
|
||||||
|
= zipWith3 (\a w d -> a * w * d) asc wav dsc
|
||||||
|
where
|
||||||
|
wav = genBaseWave freq duration
|
||||||
|
-- len = fromIntegral $ length wav
|
||||||
|
asc = map (min 1.0) [0.00, 0.001 .. ]
|
||||||
|
dsc = reverse $ take (length wav) asc
|
||||||
|
|
||||||
|
-- |Get frequency of a semitone
|
||||||
|
-- http://web.archive.org/web/20220524232706/https://pages.mtu.edu/~suits/NoteFreqCalcs.html
|
||||||
|
stFreq :: Semitone -> Hz
|
||||||
|
stFreq n = f0 + a ** (fromIntegral n)
|
||||||
|
where
|
||||||
|
a = 2 ** (1/12)
|
||||||
|
f0 = 440 -- standard pitch (A440)
|
||||||
|
|
||||||
|
mix :: Wave -> Wave -> Wave
|
||||||
|
mix = zipWith (\x y -> x + y)
|
||||||
|
|
||||||
|
freqDur :: [(Hz, Sec)]
|
||||||
|
freqDur =
|
||||||
|
[(220, 1),
|
||||||
|
(320, 1),
|
||||||
|
(440, 1)]
|
||||||
|
o1 = concat [genWave f d | (f, d) <- freqDur]
|
||||||
|
|
||||||
|
|
||||||
|
stBeats2 :: [(Semitone, Beat)]
|
||||||
|
stBeats2 =
|
||||||
|
[ (0, 0.25)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.5)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.5)
|
||||||
|
, (5, 0.25)
|
||||||
|
, (5, 0.25)
|
||||||
|
, (5, 0.25)
|
||||||
|
, (5, 0.25)
|
||||||
|
, (5, 0.25)
|
||||||
|
, (5, 0.25)
|
||||||
|
, (5, 0.5)
|
||||||
|
, (3, 0.25)
|
||||||
|
, (3, 0.25)
|
||||||
|
, (3, 0.25)
|
||||||
|
, (3, 0.25)
|
||||||
|
, (3, 0.25)
|
||||||
|
, (3, 0.25)
|
||||||
|
, (3, 0.5)
|
||||||
|
, (-2, 0.5)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.25)
|
||||||
|
, (0, 0.5)]
|
||||||
|
|
||||||
|
o2 = concat [note n bts | (n, bts) <- stBeats2]
|
||||||
|
o2' = concat [note n bts | (n, bts) <- stB']
|
||||||
|
where
|
||||||
|
stB' = map (\(n,bts) -> (n,bts*2)) stBeats2
|
||||||
|
|
||||||
|
|
||||||
|
stBeats3 :: [(Semitone, Beat)]
|
||||||
|
stBeats3 =
|
||||||
|
[ (0, 1)
|
||||||
|
, (1, 1)
|
||||||
|
, (2, 1)
|
||||||
|
, (3, 0.25)
|
||||||
|
, (4, 0.25)
|
||||||
|
, (5, 0.25)]
|
||||||
|
o3 = concat [note n bts | (n, bts) <- stBeats3]
|
||||||
|
|
||||||
|
|
||||||
|
stBeats4 :: [(Semitone, Beat)]
|
||||||
|
stBeats4 =
|
||||||
|
[ (240, 1.0)
|
||||||
|
, (270, 1.0)
|
||||||
|
, (300, 1.0)
|
||||||
|
, (320, 1.0)
|
||||||
|
, (360, 1.0)
|
||||||
|
, (400, 1.0)
|
||||||
|
, (450, 1.0)
|
||||||
|
, (480, 1.0)]
|
||||||
|
o4 = concat [note n bts | (n, bts) <- stBeats4]
|
||||||
|
|
||||||
|
|
||||||
|
-- sa re ga ma
|
||||||
|
freqDur5 :: [(Hz, Sec)]
|
||||||
|
freqDur5 =
|
||||||
|
[ (240, 2.0)
|
||||||
|
, (270, 2.0)
|
||||||
|
, (300, 2.0)
|
||||||
|
, (320, 2.0)
|
||||||
|
, (360, 2.0)
|
||||||
|
, (400, 2.0)
|
||||||
|
, (450, 2.0)
|
||||||
|
, (480, 2.0)]
|
||||||
|
o5 = concat [genWave f d | (f, d) <- freqDur5]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- w = wave
|
||||||
|
-- main :: IO ()
|
||||||
|
-- main = do
|
||||||
|
-- play a
|
||||||
|
|
|
@ -59,27 +59,28 @@ eg3 = App (Lam Boolean (Var 2)) (Var 0)
|
||||||
|
|
||||||
type TypeChecker = Ctxt -> Maybe Typ
|
type TypeChecker = Ctxt -> Maybe Typ
|
||||||
|
|
||||||
typecheck2 :: Term -> TypeChecker
|
-- Get typechecker that evaluates to type of given term
|
||||||
typecheck2 tm ctxt = case tm of
|
tm2Typechecker :: Term -> TypeChecker
|
||||||
|
tm2Typechecker tm = \ctxt -> case tm of
|
||||||
Var i -> var i ctxt
|
Var i -> var i ctxt
|
||||||
App tm1 tm2 -> app tm1 tm2 ctxt
|
App tm1 tm2 -> app (tm2Typechecker tm1) (tm2Typechecker tm2) ctxt
|
||||||
Lam t tm -> lam t tm ctxt
|
Lam ty tm -> lam ty (tm2Typechecker tm) ctxt
|
||||||
|
|
||||||
|
-- Inject a variable
|
||||||
var :: Int -> TypeChecker
|
var :: Int -> TypeChecker
|
||||||
var i ctxt = Just $ ctxt !! i
|
var i ctxt = Just $ ctxt !! i
|
||||||
|
|
||||||
app :: Term -> Term -> TypeChecker
|
app :: TypeChecker -> TypeChecker -> TypeChecker
|
||||||
app tm1 tm2 ctxt = case typecheck2 tm1 ctxt of
|
app tc1 tc2 = \ctxt -> case tc1 ctxt of
|
||||||
Just (Arrow ty1 ty2) ->
|
Just (Arrow ty1 ty2) -> (case tc2 ctxt of
|
||||||
(case typecheck2 tm2 ctxt of
|
Just ty' -> if ty1 == ty' then Just ty2 else Nothing
|
||||||
Just ty' -> if ty2 == ty' then Just ty2 else Nothing
|
_ -> Nothing)
|
||||||
_ -> Nothing)
|
|
||||||
Nothing -> Nothing
|
Nothing -> Nothing
|
||||||
|
|
||||||
lam :: Typ -> Term -> TypeChecker
|
lam :: Typ -> TypeChecker -> TypeChecker
|
||||||
lam t tm ctxt = case typecheck2 tm (t:ctxt) of -- TODO: Attention. Probably wrong
|
lam ty tc = \ctxt -> case tc (ty:ctxt) of -- TODO: Attention. Probably wrong
|
||||||
Just ty -> Just $ Arrow t ty
|
Just ty' -> Just $ Arrow ty ty'
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
-- Typechecker whose i-th element in context has type ty
|
-- Typechecker whose i-th element in context has type ty
|
||||||
have :: Int -> Typ -> TypeChecker -> TypeChecker
|
have :: Int -> Typ -> TypeChecker -> TypeChecker
|
||||||
|
@ -99,8 +100,14 @@ hasType ty tc = \ctxt -> case tc ctxt of
|
||||||
|
|
||||||
|
|
||||||
-- λf:B -> N. λa:B. f a
|
-- λf:B -> N. λa:B. f a
|
||||||
eg4 :: Term
|
tm1 :: Term
|
||||||
eg4 = Lam (Arrow Boolean Nat) $ Lam Boolean $ App (Var 1) (Var 0)
|
tm1 = Lam (Arrow Boolean Nat) $ Lam Boolean $ App (Var 1) (Var 0)
|
||||||
|
|
||||||
tc1 = lam (Arrow Boolean Nat)
|
tc1 :: TypeChecker
|
||||||
-- $ lam Boolean $ app (var 1) (var 0)
|
tc1 = lam (Arrow Boolean Nat) (lam Boolean (app (var 1) (var 0)))
|
||||||
|
|
||||||
|
-- Term with a hole: λf:B -> N. λa:B. _
|
||||||
|
-- tm2 :: Term
|
||||||
|
-- tm2 = Lam (Arrow Boolean Nat) (Lam Boolean _)
|
||||||
|
tc2 :: forall x. TypeChecker
|
||||||
|
tc2 = \ctxt -> Nothing
|
||||||
|
|
Loading…
Reference in New Issue