Jam_2016_10_05.hs

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}

module Jam_2016_10_05 where

-- tempo sync

import Hylogen.WithHylide
import Data.Profunctor

pattern Vec2 x y <- (toList -> [x, y])
pattern Vec3 x y z <- (toList -> [x, y, z])
pattern Vec4 x y z w <- (toList -> [x, y, z, w])

type Optic p s t a b = p a b -> p s t
type Optic' p a b = p a b -> p a b
type Iso s t a b = forall p. (Profunctor p) => Optic p s t a b
type Iso' a b = forall p. (Profunctor p) => Optic p a b a b
type Fold r s t a b = Optic (Forget r) s t a b
type Getter s t a b = Fold a s t a b
view :: forall s t a b. Getter s t a b -> s -> a
view l = runForget (l (Forget id))

norm :: forall a b. (Floating a, Floating b) => Iso a b a b
norm = dimap (\x -> x * 0.5 + 0.5) (\x -> x * 2 - 1)



over :: Vec4 -> Vec4 -> Vec4
over x y = mix a x' y'
  where
    x' = clamp 0 1 x
    y' = clamp 0 1 y
    a = 1 - w_ x'

rep :: Veccable n => Vec n ->  Vec n -> Vec n
rep c p = mod_  p c - 0.5 * c

inMiddle :: Veccable v => (Vec v -> Vec v) -> Vec v -> Vec v
inMiddle = dimap (+0.5) (`subtract`0.5)

mirrorY :: Vec2 -> Vec2
mirrorY (Vec2 x y) =  vec2 (inMiddle abs x, y)

mirrorX :: Vec2 -> Vec2
mirrorX (Vec2 x y) =  vec2 (inMiddle abs x, y)

rgbF :: Vec1 -> Optic' (->) Vec2 Vec4
rgbF m q pos = vec4 (r, g, b, a)
  where
    r = q (pos + copy m) & x_
    g = q pos & y_
    b = q (pos - copy m) & z_
    a = q pos & w_


output = toProgram $ rgb
  & mix (0.1) bb
bb = bbEffects (texture2D backBuffer) (view norm uvN)
bbEffects = rgbF 0.1
rgb = vec4 (v, v, v, 1)
v = tan (sin . (*0.25) $  time) * mask
mask =  x_ audio
 & (*20)
 & (*shade)
shade = xshade - yshade
xshade = y_ (uvN + (copy $ tan . (*10) . cos . (*0.25) $ time ))
 &(*1)
 & sin
 & cos
yshade = x_ uvN
 & (\x -> x * (0.5 - y_ audio) * 10)
 & clamp (-1) 1
 & cos . abs . cos