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 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

-- | 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]