Skip to content

Instantly share code, notes, and snippets.

@mikesol
Last active September 25, 2021 04:41
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mikesol/1ab7889bc82332f097ea7ab6c6f5a8f0 to your computer and use it in GitHub Desktop.
Save mikesol/1ab7889bc82332f097ea7ab6c6f5a8f0 to your computer and use it in GitHub Desktop.
Loop from Ableton
module Main where
import Prelude
import Control.Comonad (extract)
import Control.Comonad.Cofree ((:<))
import Control.Comonad.Cofree.Class (unwrapCofree)
import Data.Array.NonEmpty (fromNonEmpty, sortBy, toNonEmpty)
import Data.Int (toNumber)
import Data.List (List(..), (:))
import Data.List as L
import Data.Maybe (Maybe(..))
import Data.NonEmpty (NonEmpty, (:|))
import Data.Symbol (class IsSymbol)
import Data.Typelevel.Num (class Nat, class Pred, class Succ, D0, D16, D12)
import Data.Vec as V
import Effect (Effect)
import Heterogeneous.Folding (class FoldingWithIndex, hfoldlWithIndex)
import Prim.Row (class Cons, class Lacks)
import Record as R
import Type.Proxy (Proxy(..))
import WAGS.Create.Optionals (gain, playBuf, speaker)
import WAGS.Graph.AudioUnit (OnOff(..))
import WAGS.Graph.Parameter (ff)
import WAGS.Lib.BufferPool (AScoredBufferPool, Buffy(..), makeScoredBufferPool)
import WAGS.Lib.Learn (buffers, play, usingc)
import WAGS.Lib.Score (CfNoteStream)
import WAGS.Math (calcSlope)
import WAGS.Run (SceneI(..))
import WAGS.Template (fromTemplate)
import WAGS.WebAPI (BrowserAudioBuffer)
type Instruments'' (a :: Type) (r :: Row Type)
= (kick1 :: a, sideStick :: a, snare :: a, clap :: a, snareRoll :: a, kick2 :: a, closedHH :: a, shaker :: a, openHH :: a, tamb :: a, crash :: a, ride :: a | r)
type Instruments' (a :: Type)
= Instruments'' a ()
type Instruments a
= { | Instruments' a }
data Note i
= Note i i i
type World
= { buffers :: { | Instruments' BrowserAudioBuffer } }
notes :: Instruments (NonEmpty Array (Note Int))
notes =
{ kick1:
Note 127 0 12
:|
[ Note 127 24 36
, Note 127 72 84
, Note 127 144 154
, Note 127 168 181
, Note 127 216 227
, Note 127 264 274
, Note 126 384 393
, Note 127 408 419
, Note 127 456 467
, Note 127 528 537
, Note 127 552 563
, Note 127 600 610
, Note 127 648 658
, Note 127 768 778
, Note 126 792 802
, Note 126 840 853
, Note 126 912 921
, Note 127 936 947
, Note 126 984 995
, Note 127 1032 1042
, Note 127 1152 1162
, Note 127 1176 1186
, Note 127 1224 1236
, Note 126 1296 1306
, Note 127 1320 1332
, Note 126 1368 1380
, Note 127 1416 1428
]
, sideStick:
Note 108 96 120
:|
[ Note 108 288 312
, Note 108 480 504
, Note 108 672 696
, Note 108 864 888
, Note 108 1056 1080
, Note 108 1248 1272
, Note 108 1440 1464
]
, snare:
Note 127 288 312
:|
[ Note 127 672 698
, Note 127 1056 1081
, Note 127 1440 1460
, Note 110 1488 1496
, Note 110 1512 1520
]
, clap:
Note 127 96 120
:|
[ Note 113 288 312
, Note 125 480 504
, Note 113 672 696
, Note 125 864 888
, Note 113 1056 1080
, Note 125 1248 1272
, Note 113 1440 1464
]
, snareRoll:
Note 108 360 378
:|
[ Note 113 744 763
, Note 110 888 903
, Note 113 1128 1146
, Note 110 1272 1288
]
, kick2:
Note 111 0 6
:|
[ Note 111 24 30
, Note 110 144 150
, Note 111 168 174
, Note 110 384 389
, Note 111 408 414
, Note 112 528 534
, Note 111 552 559
, Note 111 768 776
, Note 111 792 800
, Note 111 912 920
, Note 111 936 943
, Note 111 1152 1158
, Note 110 1176 1183
, Note 111 1296 1302
, Note 111 1320 1326
]
, closedHH:
Note 126 24 33
:|
[ Note 126 72 84
, Note 127 120 132
, Note 127 168 181
, Note 126 216 233
, Note 127 264 280
, Note 126 360 378
, Note 126 408 425
, Note 126 456 473
, Note 123 504 522
, Note 126 552 569
, Note 126 600 617
, Note 127 648 667
, Note 124 744 762
, Note 124 792 810
, Note 125 840 858
, Note 124 888 906
, Note 124 936 954
, Note 125 984 1002
, Note 127 1032 1051
, Note 127 1128 1148
, Note 125 1176 1194
, Note 127 1224 1242
, Note 127 1272 1290
, Note 125 1320 1338
, Note 126 1368 1386
, Note 127 1416 1435
, Note 126 1512 1532
]
, shaker:
Note 110 0 14
:|
[ Note 111 48 61
, Note 111 96 112
, Note 111 144 161
, Note 111 192 210
, Note 111 240 260
, Note 110 288 308
, Note 110 336 355
, Note 111 384 403
, Note 111 432 452
, Note 107 480 500
, Note 110 528 547
, Note 111 576 597
, Note 111 624 645
, Note 111 672 694
, Note 111 720 740
, Note 60 768 788
, Note 70 792 803
, Note 80 816 837
, Note 90 840 854
, Note 100 864 884
, Note 111 888 901
, Note 100 912 933
, Note 90 936 948
, Note 80 960 981
, Note 70 984 997
, Note 60 1008 1029
, Note 64 1032 1046
, Note 70 1056 1077
, Note 88 1080 1093
, Note 94 1104 1126
, Note 100 1128 1141
, Note 105 1152 1173
, Note 111 1176 1190
, Note 105 1200 1220
, Note 100 1224 1237
, Note 95 1248 1270
, Note 85 1272 1287
, Note 80 1296 1317
, Note 85 1320 1333
, Note 90 1344 1366
, Note 95 1368 1381
, Note 100 1392 1414
, Note 111 1416 1429
, Note 100 1440 1462
, Note 90 1464 1478
, Note 100 1488 1507
, Note 111 1512 1525
]
, openHH:
Note 127 288 312
:|
[ Note 127 672 696
, Note 127 1056 1080
, Note 127 1440 1464
]
, tamb:
Note 115 96 120
:|
[ Note 115 288 312
, Note 115 480 504
, Note 115 672 696
, Note 115 864 888
, Note 115 1056 1080
, Note 115 1248 1272
, Note 115 1440 1464
]
, crash: Note 89 0 16 :| []
, ride:
Note 72 0 10
:|
[ Note 88 96 106
, Note 88 192 201
, Note 88 288 297
, Note 88 384 393
, Note 88 480 489
, Note 88 576 585
, Note 88 672 681
, Note 88 768 776
, Note 88 864 873
, Note 88 960 968
, Note 88 1056 1064
, Note 88 1152 1161
, Note 88 1248 1256
, Note 88 1344 1353
, Note 88 1440 1449
]
}
ticksInBeatI = 96 :: Int
beatsInMeasure = 4 :: Int
measuresInLoop = 4 :: Int
ticksInLoop = ticksInBeatI * beatsInMeasure * measuresInLoop :: Int
timedTicksInLoop = toNumber ticksInLoop * ticksToTime :: Number
ticksInBeat = toNumber ticksInBeatI :: Number
tempo = 90.0 :: Number
tmul = 60.0 / tempo :: Number
ticksToTime = tmul / ticksInBeat :: Number
newtype ScoreRep = ScoreRep
{ volume :: Number
, startsAt :: Number
, endsAt :: Number
, buffer :: Instruments BrowserAudioBuffer -> BrowserAudioBuffer
}
data InstrumentsToScore = InstrumentsToScore
instance instrumentsToScore ::
( Nat n
, Succ n nPlus1
, IsSymbol prop
, Lacks prop r''
, Cons prop BrowserAudioBuffer r'' (Instruments' BrowserAudioBuffer)
) =>
FoldingWithIndex InstrumentsToScore (Proxy prop) (V.Vec n (NonEmpty Array ScoreRep)) (NonEmpty Array (Note Int)) (V.Vec nPlus1 (NonEmpty Array ScoreRep)) where
foldingWithIndex InstrumentsToScore prop v nea = V.cons
( map
( \(Note vol st ed) -> ScoreRep
{ volume: toNumber vol / 127.0
, startsAt: toNumber st * tmul / ticksInBeat
, endsAt: toNumber ed * tmul / ticksInBeat
, buffer: (\(r :: Instruments BrowserAudioBuffer) -> R.get prop r)
}
)
nea
)
v
joinNonEmptyArray :: forall a. NonEmpty Array (NonEmpty Array a) -> NonEmpty Array a
joinNonEmptyArray = toNonEmpty <<< join <<< fromNonEmpty <<< map fromNonEmpty
posVecToNonEmptyArray :: forall s1 s2 a. Pred s1 s2 => V.Vec s1 a -> NonEmpty Array a
posVecToNonEmptyArray v = head :| V.toArray tail
where
{ head, tail } = V.uncons v
loopEnd = tmul * toNumber (beatsInMeasure * measuresInLoop) :: Number
scoreRepToScore :: NonEmpty Array ScoreRep -> CfNoteStream ScoreRep
scoreRepToScore nea = go 0.0 sorted
where
sorted' = toNonEmpty
$ sortBy (\(ScoreRep a) (ScoreRep b) -> compare a.startsAt b.startsAt)
$ fromNonEmpty nea
sorted = let h :| t = sorted' in h :| L.fromFoldable t
go sa (a@(ScoreRep a') :| Nil) = { startsAfter: sa, rest: a }
:< \_ -> go (loopEnd - a'.startsAt) sorted
go sa (a@(ScoreRep a') :| (b@(ScoreRep b') : c)) = { startsAfter: sa, rest: a }
:< \_ -> go (b'.startsAt - a'.startsAt) (b :| c)
type NBuf
= D16
type RBuf
= ScoreRep
type Acc
= { buffers :: AScoredBufferPool Unit NBuf RBuf }
-- to avoid jank
globalFF = 0.03 :: Number
acc :: Acc
acc =
{ buffers: makeScoredBufferPool
{ startsAt: 0.0
, noteStream: const
$ map
( \{ startsAfter, rest: sr@(ScoreRep { startsAt, endsAt }) } ->
{ startsAfter
, rest:
{ rest: const sr
, duration: const $ const $ const Just (endsAt - startsAt)
}
}
)
$ scoreRepToScore
$ joinNonEmptyArray
$ posVecToNonEmptyArray
$ (hfoldlWithIndex InstrumentsToScore (V.empty :: V.Vec D0 (NonEmpty Array ScoreRep)) notes :: V.Vec D12 (NonEmpty Array ScoreRep))
}
}
main :: Effect Unit
main = play $ usingc
( buffers
{ kick1: "https://freesound.org/data/previews/171/171104_2394245-hq.mp3"
, sideStick: "https://freesound.org/data/previews/209/209890_3797507-hq.mp3"
, snare: "https://freesound.org/data/previews/495/495777_10741529-hq.mp3"
, clap: "https://freesound.org/data/previews/183/183102_2394245-hq.mp3"
, snareRoll: "https://freesound.org/data/previews/50/50710_179538-hq.mp3"
, kick2: "https://freesound.org/data/previews/148/148634_2614600-hq.mp3"
, closedHH: "https://freesound.org/data/previews/269/269720_4965320-hq.mp3"
, shaker: "https://freesound.org/data/previews/432/432205_8738244-hq.mp3"
, openHH: "https://freesound.org/data/previews/416/416249_8218607-hq.mp3"
, tamb: "https://freesound.org/data/previews/207/207925_19852-hq.mp3"
, crash: "https://freesound.org/data/previews/528/528490_3797507-hq.mp3"
, ride: "https://freesound.org/data/previews/270/270138_1125482-hq.mp3"
}
)
acc
\(SceneI { time, headroomInSeconds, world: { buffers } }) control ->
let
actualized = control.buffers { time, headroomInSeconds, input: unit }
in
{ control: { buffers: unwrapCofree actualized }
, scene: speaker
( gain (if time < 5.0 then time / 5.0 else 1.0)
-- todo: use ffi to speed up
( fromTemplate (Proxy :: _ "instruments") (extract actualized) \_ -> case _ of
Just (Buffy { starting, startTime, rest: ScoreRep { startsAt, endsAt, volume, buffer } }) ->
gain (ff globalFF $ pure $ if time > startTime + (endsAt - startsAt) then calcSlope (startTime + (endsAt - startsAt)) volume (startTime + (endsAt - startsAt) + 0.5) 0.0 time else volume)
( playBuf
{ onOff:
ff globalFF
$
if starting then
ff (max 0.0 (startTime - time)) (pure OffOn)
else
pure On
}
(buffer buffers)
)
Nothing -> gain 0.0 (playBuf { onOff: Off } buffers.kick1)
)
)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment