[Haskell] Replicate a youtube video make audio
This commit is contained in:
parent
5e1e1563e6
commit
fc4cb83894
216
haskell/Music.hs
216
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 BL
|
||||
|
||||
-- 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.ByteString.Lazy as BSL
|
||||
import qualified Data.ByteString.Builder as BSB
|
||||
import qualified Data.Foldable
|
||||
import qualified System.Process
|
||||
import qualified Text.Printf
|
||||
|
||||
|
||||
-- Frequency in Hertz
|
||||
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 = "out.bin"
|
||||
|
||||
-- volume :: Float
|
||||
-- volume = 0.2
|
||||
save :: Wave -> FilePath -> IO ()
|
||||
save wav outfile
|
||||
-- Write to outfile
|
||||
= BSL.writeFile outfile
|
||||
|
||||
-- Number of samples per second
|
||||
-- ie, number of float values per second
|
||||
sampleRate :: Hz
|
||||
sampleRate = 48000
|
||||
-- Build lazy byte string
|
||||
$ BSB.toLazyByteString
|
||||
|
||||
-- step :: Float
|
||||
-- step = 0.01
|
||||
-- Combine all data points into single bytestring
|
||||
$ Data.Foldable.fold
|
||||
|
||||
-- build float little endian byte string for each data point
|
||||
$ map BSB.floatLE wav
|
||||
|
||||
duration :: Float
|
||||
duration = 2.0
|
||||
|
||||
wave :: Float -> Hz -> Seconds -> Signal
|
||||
wave volume freq duration
|
||||
= map (* volume) -- adjust volume
|
||||
$ map sin -- generate wave
|
||||
$ map (* step) [0.0 .. sampleRate * duration]
|
||||
where
|
||||
step = (freq * 2 * pi) / sampleRate
|
||||
|
||||
sound :: Signal
|
||||
sound = concat $ map (++)
|
||||
[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
|
||||
-- https://hackage.haskell.org/package/bytestring-0.12.1.0/docs/Data-ByteString-Lazy.html#t:LazyByteString
|
||||
save :: FilePath -> IO ()
|
||||
save outfile = BL.writeFile outfile $ B.toLazyByteString $ toBS sound
|
||||
|
||||
play :: IO ()
|
||||
play = do
|
||||
save outFile
|
||||
_ <- System.Process.runCommand
|
||||
$ Text.Printf.printf "ffplay -showmode 1 -f f32le -ar %f %s" sampleRate outFile
|
||||
play :: Wave -> IO ()
|
||||
play wav = do
|
||||
save (map (*volume) wav) outFile
|
||||
-- save wav outFile
|
||||
_ <- System.Process.runCommand $ Text.Printf.printf
|
||||
"ffplay -showmode 1 -f f32le -ar %f %s"
|
||||
sr outFile
|
||||
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
|
||||
|
||||
typecheck2 :: Term -> TypeChecker
|
||||
typecheck2 tm ctxt = case tm of
|
||||
-- Get typechecker that evaluates to type of given term
|
||||
tm2Typechecker :: Term -> TypeChecker
|
||||
tm2Typechecker tm = \ctxt -> case tm of
|
||||
Var i -> var i ctxt
|
||||
App tm1 tm2 -> app tm1 tm2 ctxt
|
||||
Lam t tm -> lam t tm ctxt
|
||||
App tm1 tm2 -> app (tm2Typechecker tm1) (tm2Typechecker tm2) ctxt
|
||||
Lam ty tm -> lam ty (tm2Typechecker tm) ctxt
|
||||
|
||||
-- Inject a variable
|
||||
var :: Int -> TypeChecker
|
||||
var i ctxt = Just $ ctxt !! i
|
||||
|
||||
app :: Term -> Term -> TypeChecker
|
||||
app tm1 tm2 ctxt = case typecheck2 tm1 ctxt of
|
||||
Just (Arrow ty1 ty2) ->
|
||||
(case typecheck2 tm2 ctxt of
|
||||
Just ty' -> if ty2 == ty' then Just ty2 else Nothing
|
||||
_ -> Nothing)
|
||||
app :: TypeChecker -> TypeChecker -> TypeChecker
|
||||
app tc1 tc2 = \ctxt -> case tc1 ctxt of
|
||||
Just (Arrow ty1 ty2) -> (case tc2 ctxt of
|
||||
Just ty' -> if ty1 == ty' then Just ty2 else Nothing
|
||||
_ -> Nothing)
|
||||
Nothing -> Nothing
|
||||
|
||||
lam :: Typ -> Term -> TypeChecker
|
||||
lam t tm ctxt = case typecheck2 tm (t:ctxt) of -- TODO: Attention. Probably wrong
|
||||
Just ty -> Just $ Arrow t ty
|
||||
_ -> Nothing
|
||||
lam :: Typ -> TypeChecker -> TypeChecker
|
||||
lam ty tc = \ctxt -> case tc (ty:ctxt) of -- TODO: Attention. Probably wrong
|
||||
Just ty' -> Just $ Arrow ty ty'
|
||||
_ -> Nothing
|
||||
|
||||
-- Typechecker whose i-th element in context has type ty
|
||||
have :: Int -> Typ -> TypeChecker -> TypeChecker
|
||||
|
@ -99,8 +100,14 @@ hasType ty tc = \ctxt -> case tc ctxt of
|
|||
|
||||
|
||||
-- λf:B -> N. λa:B. f a
|
||||
eg4 :: Term
|
||||
eg4 = Lam (Arrow Boolean Nat) $ Lam Boolean $ App (Var 1) (Var 0)
|
||||
tm1 :: Term
|
||||
tm1 = Lam (Arrow Boolean Nat) $ Lam Boolean $ App (Var 1) (Var 0)
|
||||
|
||||
tc1 = lam (Arrow Boolean Nat)
|
||||
-- $ lam Boolean $ app (var 1) (var 0)
|
||||
tc1 :: TypeChecker
|
||||
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