Number.hs

module Zwirn.Core.Number where

{-
    Number.hs - lifting functions on numbers to 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 Data.Fixed (mod')
import Zwirn.Core.Core
import Zwirn.Core.Modulate (fastcat)
import Zwirn.Core.Time (Time)
import Zwirn.Core.Types

instance (Num a, Applicative k) => Num (ZwirnT k st i a) where
  (+) = liftA2 (+)
  (-) = liftA2 (-)
  (*) = liftA2 (*)
  negate = fmap negate
  abs = fmap abs
  signum = fmap signum
  fromInteger = pure . fromInteger

instance (Eq a, Fractional a, MultiMonad k, HasSilence k) => Fractional (ZwirnT k st i a) where
  fromRational = pure . fromRational
  recip xz = innerJoin $ fmap (\x -> if x == 0 then silence else pure $ recip x) xz

instance (Ord a, Floating a, MultiMonad k, HasSilence k) => Floating (ZwirnT k st i a) where
  pi = pure pi
  exp = fmap exp
  log xz = innerJoin $ fmap (\x -> if x <= 0 then silence else pure $ log x) xz
  sqrt xz = innerJoin $ fmap (\x -> if x < 0 then silence else pure $ sqrt x) xz
  (**) xz yz = innerJoin $ liftA2 (\x y -> if x <= 0 && abs y < 1 then silence else pure $ x ** y) xz yz
  logBase bz xz = innerJoin $ liftA2 (\b x -> if b < 0 || x <= 0 then silence else pure $ logBase b x) bz xz
  sin = fmap sin
  cos = fmap cos
  tan = fmap tan
  asin = fmap asin
  acos = fmap acos
  atan = fmap atan
  sinh = fmap sinh
  cosh = fmap cosh
  tanh = fmap tanh
  asinh = fmap asinh
  acosh = fmap acosh
  atanh = fmap atanh

mod :: (Real a, HasSilence k, MultiMonad k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
mod xz yz = innerJoin $ liftA2 (\x y -> if y == 0 then silence else pure $ mod' x y) xz yz

frac :: (Real a, MultiMonad k) => ZwirnT k st i a -> ZwirnT k st i a
frac = fmap (`mod'` 1)

trunc :: (RealFrac a, Integral b, Functor k) => ZwirnT k st i a -> ZwirnT k st i b
trunc = fmap truncate

ceil :: (RealFrac a, Integral b, Functor k) => ZwirnT k st i a -> ZwirnT k st i b
ceil = fmap ceiling

floor :: (RealFrac a, Integral b, Functor k) => ZwirnT k st i a -> ZwirnT k st i b
floor = fmap Prelude.floor

round :: (RealFrac a, Integral b, Functor k) => ZwirnT k st i a -> ZwirnT k st i b
round = fmap Prelude.round

gcd :: (Integral a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
gcd = liftA2 Prelude.gcd

lcm :: (Integral a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
lcm = liftA2 Prelude.lcm

range :: (Num a, Applicative k) => ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a -> ZwirnT k st i a
range lx lu lv = (\l u v -> (1 - v) * l + v * u) <$> lx <*> lu <*> lv

sine :: (Applicative k) => ZwirnT k st i Time
sine = fromSignal (\t -> (sin (2 * pi * t) + 1) / 2)

sine2 :: (Applicative k) => ZwirnT k st i Time
sine2 = fromSignal (\t -> sin (2 * pi * t))

cosine :: (Applicative k) => ZwirnT k st i Time
cosine = fromSignal (\t -> (cos (2 * pi * t) + 1) / 2)

cosine2 :: (Applicative k) => ZwirnT k st i Time
cosine2 = fromSignal (\t -> cos (2 * pi * t))

saw :: (Applicative k) => ZwirnT k st i Time
saw = fromSignal (`mod'` 1)

saw2 :: (Applicative k) => ZwirnT k st i Time
saw2 = fromSignal (\t -> (mod' t 1 * 2) - 1)

isaw :: (Applicative k) => ZwirnT k st i Time
isaw = fromSignal (\t -> 1 - mod' t 1)

isaw2 :: (Applicative k) => ZwirnT k st i Time
isaw2 = fromSignal (\t -> 1 - (mod' t 1 * 2))

square :: (Applicative k) => ZwirnT k st i Time
square = fromSignal (\t -> fromIntegral $ Prelude.floor $ mod' t 1 * 2)

square2 :: (Applicative k) => ZwirnT k st i Time
square2 = fromSignal (\t -> fromIntegral $ Prelude.floor (mod' t 1 * 2) - 1)

tri :: (Applicative k, HasSilence k) => ZwirnT k st i Time
tri = fastcat [saw, isaw]

tri2 :: (Applicative k, HasSilence k) => ZwirnT k st i Time
tri2 = fastcat [saw2, isaw2]