Conditional.hs

module Zwirn.Core.Lib.Conditional where

{-
    Conditional.hs - conditional functions
    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 Data.Bifunctor (first)
import Data.Fixed (mod')
import Zwirn.Core.Lib.Core
import Zwirn.Core.Time
import Zwirn.Core.Types

ifthen :: (MultiMonad k) => ZwirnT k st i Bool -> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
ifthen bz xz yz = innerJoin $ zwirn q
  where
    q t st = first (fmap f) <$> unzwirn bz t st
      where
        f True = xz
        f False = yz

iff :: (MultiMonad k, HasSilence k) => ZwirnT k st i Bool -> ZwirnT k st i a -> ZwirnT k st i a
iff b x = ifthen b x silence

or :: (Applicative k) => ZwirnT k st i Bool -> ZwirnT k st i Bool -> ZwirnT k st i Bool
or = liftA2 (||)

and :: (Applicative k) => ZwirnT k st i Bool -> ZwirnT k st i Bool -> ZwirnT k st i Bool
and = liftA2 (&&)

not :: (Functor k) => ZwirnT k st i Bool -> ZwirnT k st i Bool
not = fmap Prelude.not

eq :: (Eq a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
eq = liftA2 (==)

leq :: (Ord a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
leq = liftA2 (<=)

geq :: (Ord a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
geq = liftA2 (>=)

le :: (Ord a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
le = liftA2 (<)

ge :: (Ord a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i Bool
ge = liftA2 (>)

while :: (MultiMonad k) => ZwirnT k st i Bool -> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
while b f x = ifthen b (apply f x) x

-- | the first value controls the period the second the length of applying the function in that period
everyFor :: (Monad k) => ZwirnT k st i Time -> ZwirnT k st i Time -> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
everyFor t1 t2 f x = (everyFor' <$> t1 <*> t2 <*> f) `innerApply` x
  where
    everyFor' 0 _ _ y = y
    everyFor' per for g y = zwirn $ \t st -> if mod' t per <= for then unzwirn (g y) t st else unzwirn y t st

-- | applies function every period for one cycle
every :: (Monad k) => ZwirnT k st i Time -> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
every x = everyFor x (pure 1)

everyBeatShiftWith :: (Monad k) => ZwirnT k st i Time -> ZwirnT k st i Time -> ZwirnT k st i Time -> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
everyBeatShiftWith bpcz shz nz fz xz = (everyBeatWith' <$> bpcz <*> shz <*> nz <*> fz) `innerApply` xz
  where
    everyBeatWith' :: Time -> Time -> Time -> (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
    everyBeatWith' _ _ 0 _ x = x
    everyBeatWith' 0 _ _ _ x = x
    everyBeatWith' bpc sh n f x = zwirn $ \t st -> if mod' (t + sh) (n / bpc) < (1 / bpc) then unzwirn (f x) t st else unzwirn x t st

everyBeatWith :: (Monad k) => ZwirnT k st i Time -> ZwirnT k st i Time -> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
everyBeatWith x = everyBeatShiftWith x (pure 0)

everyBeatShift :: (Monad k, State k st i) => ZwirnT k st i Time -> ZwirnT k st i Time -> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
everyBeatShift = everyBeatShiftWith (realToFrac <$> beatsPerCycle)

everyBeat :: (Monad k, State k st i) => ZwirnT k st i Time -> ZwirnT k st i (ZwirnT k st i a -> ZwirnT k st i a) -> ZwirnT k st i a -> ZwirnT k st i a
everyBeat = everyBeatShift (pure 0)