Cord.hs

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Zwirn.Core.Lib.Cord where

{-
    Cord.hs - functions on parallel signals
    Copyright (C) 2025, Martin Gius

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

import Control.Monad (join)
import Data.Bifunctor (first)
import Data.Foldable (Foldable (..), foldl')
import Zwirn.Core.Cord as C
import Zwirn.Core.Core
import Zwirn.Core.Lib.Conditional (iff)
import Zwirn.Core.Lib.Core
import Zwirn.Core.Lib.Modulate (bump, fastcat, fastcyclecatpat, shift)
import Zwirn.Core.Lib.Number
import Zwirn.Core.Time
import Zwirn.Core.Tree
import qualified Zwirn.Core.Tree as Tree
import Zwirn.Core.Types
import Prelude hiding (Foldable (..))

-- | get the current depth of the cord
depth :: Cord st i a -> Cord st i Int
depth = C.depth

superimpose :: Cord st i (Cord st i a -> Cord st i a) -> Cord st i a -> Cord st i a
superimpose f x = stack [apply f x, x]

ghostWith :: Cord st i Time -> Cord st i (Cord st i a -> Cord st i a) -> Cord st i a -> Cord st i a
ghostWith t f x = stack [shift (t * 2.5) $ apply f x, shift (t * 1.5) $ apply f x, x]

-- | pick a certain layer out of a cord, wrapping around
pick :: Cord st i Int -> Cord st i a -> Cord st i a
pick iz x = (_pick <$> iz) `innerApply` x

inhabit :: Cord st i Int -> Cord st i a -> Cord st i a
inhabit iz xz = zwirn q
  where
    q t st = innerJoin $ (\v -> look (value v) $ unzwirn xz (time v) st) . fst <$> ik
      where
        ik = unzwirn iz t st

-- | pick a certain layer out of a cord, silence when out of bounds
pick' :: Cord st i Int -> Cord st i a -> Cord st i a
pick' i x = (withInner . look' <$> i) `innerApply` x

-- | pick a certain layer out of a cord, wrapping around
select :: Cord st i Double -> Cord st i a -> Cord st i a
select d x = Zwirn.Core.Lib.Cord.pick i x
  where
    i = join $ liftA2 (\l k -> if k > 0 && abs l <= 1 then pure $ Prelude.floor $ l * fromIntegral k else silence) d (C.depth x)

-- | insert cord a specific index
insert :: Cord st i Int -> Cord st i a -> Cord st i a -> Cord st i a
insert ic x y = flip ($ x) y . insert' =<< ic
  where
    insert' :: Int -> Cord st i a -> Cord st i a -> Cord st i a
    insert' i z ys = zwirn $ \t st -> insertT i (unzwirn z t st) (unzwirn ys t st)

-- | push to the top of the cord
push :: Cord st i a -> Cord st i a -> Cord st i a
push = withInner2 Tree.push

concat :: Cord st i a -> Cord st i a -> Cord st i a
concat = withInner2 Tree.concat

-- | remove the top of the cord
pop :: Cord st i a -> Cord st i a
pop = withInner Tree.pop

-- | remove cord at specific index
remove :: Cord st i Int -> Cord st i a -> Cord st i a
remove i x = (withInner . removeT <$> i) `innerApply` x

-- | apply function to specific index
at :: Cord st i Int -> Cord st i (Cord st i a -> Cord st i a) -> Cord st i a -> Cord st i a
at i f x = insert i (innerApply f $ pick i x) (remove i x)

applyCord :: (Num a) => Cord st i a -> Cord st i a -> Cord st i a
applyCord = liftA2Left (+)

reverse :: Cord st i a -> Cord st i a
reverse = liftList Prelude.reverse

rotate :: Cord st i Int -> Cord st i a -> Cord st i a
rotate iz xz = flip liftList xz . rotateList =<< iz
  where
    rotateList n xs
      | n > 0 = Prelude.take (length xs) (Prelude.drop n (cycle $ Prelude.reverse xs))
      | otherwise = Prelude.take (length xs) (Prelude.drop n (cycle xs))

take :: Cord st i Int -> Cord st i a -> Cord st i a
take iz xz = flip liftList xz . Prelude.take =<< iz

drop :: Cord st i Int -> Cord st i a -> Cord st i a
drop iz xz = flip liftList xz . Prelude.drop =<< iz

filter :: Cord st i (Cord st i a -> Cord st i Bool) -> Cord st i a -> Cord st i a
filter fz xz = iff bz xz
  where
    bz = cordmap fz xz

invert :: (Num a) => Cord st i a -> Cord st i a
invert = liftList invertList
  where
    invertList [] = []
    invertList (x : xs) = xs ++ [fmap (first $ fmap (+ 12)) x]

open :: (Num a) => Cord st i a -> Cord st i a
open = liftList openList
  where
    openList ds = case ds of
      (d : _ : _ : _) -> [fmap (first $ fmap (+ (-12))) d, fmap (first $ fmap (+ (-12))) (ds !! 2), ds !! 1] ++ Prelude.reverse (Prelude.take (length ds - 3) (Prelude.reverse ds))
      _ -> ds

expand :: (Num a) => Cord st i Int -> Cord st i a -> Cord st i a
expand iz xz = flip liftList xz . expandList =<< iz
  where
    expandList i ds = Prelude.take i $ concatMap (\x -> map (fmap $ first $ fmap (+ fromIntegral x)) ds) [0 :: Int, 12 ..]

enumFromToStack :: (Ord a, Num a) => Cord st i a -> Cord st i a -> Cord st i a
enumFromToStack xz yz = join $ en <$> xz <*> yz
  where
    en x y = stack $ map pure $ enumerateFromTo x y

enumFromThenToStack :: (Ord a, Num a) => Cord st i a -> Cord st i a -> Cord st i a -> Cord st i a
enumFromThenToStack xz yz zz = join $ en <$> xz <*> yz <*> zz
  where
    en x y z = stack $ map pure $ enumerateFromThenTo x y z

replicate :: Cord st i Int -> Cord st i a -> Cord st i a
replicate i x = (stack . flip Prelude.replicate x) =<< i

fold :: Cord st i (Cord st i a -> Cord st i (Cord st i a -> Cord st i a)) -> Cord st i a -> Cord st i a
fold fz xz = fold' fz =<< collect xz
  where
    fold' _ [] = silence
    fold' _ [x] = x
    fold' f (x : xs) = foldl' (\a b -> f `apply` a `apply` b) x xs

cordcat :: Cord st i a -> Cord st i a
cordcat x = fastcat =<< collect x

timerun :: Cord st i Time -> Cord st i Int
timerun tz = (fastcyclecatpat . flip zip (map pure [0 :: Int ..])) =<< collect tz

interpol :: Cord st i Time -> Cord st i Time
interpol x = _interpol =<< collect x

cordmap :: Cord st i (Cord st i a -> Cord st i b) -> Cord st i a -> Cord st i b
cordmap f x = (stack . map (apply f)) =<< collect x

layer :: Cord st i (Cord st i a -> Cord st i b) -> Cord st i a -> Cord st i b
layer f x = (stack . map (`apply` x)) =<< collect f

arp :: Cord st i a -> Cord st i a
arp x = apply (squeezeMap (pure . bump) ds) x
  where
    d = C.depth x
    ds = enumFromThenToStack @Time 0 ((\dp -> if dp == 0 then 0 else 1 / fromIntegral dp) <$> d) 1

echoWith :: Cord st i Int -> Cord st i Time -> Cord st i (Cord st i a -> Cord st i a) -> Cord st i a -> Cord st i a
echoWith cz tz fz xz = echoWith' =<< cz
  where
    echoWith' c = if c < 1 then silence else stack $ scanl (\ !prev _ -> apply fz $ shift tz prev) xz [0 .. c - 1]

followWith :: Cord st i Int -> Cord st i Time -> Cord st i (Cord st i a -> Cord st i a) -> Cord st i a -> Cord st i a
followWith cz tz fz xz = followWith' =<< cz
  where
    followWith' c = if c < 1 then silence else stack $ scanl (\ !prev _ -> apply fz $ bump tz prev) xz [0 .. c - 1]