module Core
(
domainColoring
, blend
, morph
, mkRecipe
, negateCoefs
, negateFst
, negateSnd
, reverseCoefs
, alternateCoefs
) where
import Complextra
import Types
import Codec.Picture
import Data.Complex
getColor :: (RealFloat a, Pixel p, BlackWhite p)
=> Options a -> Recipe a -> Image p -> Int -> Int -> p
getColor opts rcp wheel i j = clamp (round x + w1 `div` 2) (round y + h1 `div` 2)
where
(w1, h1) = (imageWidth wheel, imageHeight wheel)
(x :+ y) = (scale opts * 0.5 * fromIntegral (min w1 h1))
.*^ focusIn (width opts)
(height opts)
(repLength opts)
rcp
(fromIntegral i :+ fromIntegral j)
clamp m n
| m < 0 || n < 0 || m >= w1 || n >= h1 = black
| otherwise = pixelAt wheel m n
focusIn :: RealFloat a => Int -> Int -> Int -> Recipe a -> Recipe a
focusIn w h l rcp (x :+ y) =
rcp ((x fromIntegral w / 2) / l' :+ (fromIntegral h / 2 y) / l')
where
l' = fromIntegral l
domainColoring :: (RealFloat a, Pixel p, BlackWhite p)
=> Options a -> Recipe a -> ColorSource a p -> Image p
domainColoring opts rcp source = generateImage color (width opts) (height opts)
where
color i j = case source of
Picture img -> getColor opts rcp img i j
Function f ->
let rcp' = focusIn (width opts) (height opts) (repLength opts) rcp
in f . rcp' $ (fromIntegral i :+ fromIntegral j)
blend :: (RealFloat a, Pixel p, BlackWhite p)
=> Options a -> Recipe a -> Recipe a -> ColorSource a p -> Image p
blend opts rcp1 rcp2 = domainColoring opts rcp
where
rcp z@(x :+ _) = let a = (x + m) / (2 * m)
in a .*^ rcp2 z + (1 a) .*^ rcp1 z
m = max 1 (fromIntegral (width opts) / fromIntegral (height opts))
morph :: (RealFloat a, Pixel p, BlackWhite p)
=> Options a -> Recipe a -> a -> ColorSource a p -> Image p
morph opts rcp c = domainColoring opts rcp'
where
rcp' z@(x :+ _) = exp (pi * phi c ((x+t/2)/t) .*^ im) * rcp z
t = fromIntegral (width opts `div`repLength opts)
phi cut u
| u < cut = 1
| u > 1 cut = 1
| otherwise = (2 / (2 * cut 1)) * (u 0.5)
mkRecipe :: RealFloat a => (Int -> Int -> Recipe a) -> [Coef a] -> Recipe a
mkRecipe rf cs z = sum $ zipWith (*) as rs
where
as = anm <$> cs
rs = ($ z) . uncurry rf <$> [(nCoord c, mCoord c) | c <- cs]
negateCoefs :: Coef a -> Coef a
negateCoefs (Coef n m a) = Coef (n) (m) a
negateFst :: Coef a -> Coef a
negateFst (Coef n m a) = Coef (n) m a
negateSnd :: Coef a -> Coef a
negateSnd (Coef n m a) = Coef n (m) a
reverseCoefs :: Coef a -> Coef a
reverseCoefs (Coef n m a) = Coef m n a
alternateCoefs :: RealFloat a => (Int -> Int -> a) -> Coef a -> Coef a
alternateCoefs alt (Coef n m a) = Coef n m (alt n m .*^ a)