packages feed

hylogen 0.1.0.5 → 0.1.0.6

raw patch · 7 files changed

+467/−103 lines, 7 filesdep +vector-spacePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: vector-space

API changes (from Hackage documentation)

+ Hylogen.Globals: backBuffer :: Texture
+ Hylogen.Globals: ceil_ :: (HyloPrim a) => a -> a
+ Hylogen.Globals: clamp :: (HyloPrim a) => a -> a -> a -> a
+ Hylogen.Globals: eq :: (HyloPrim v) => v -> v -> Booly
+ Hylogen.Globals: false :: Booly
+ Hylogen.Globals: floor_ :: (HyloPrim a) => a -> a
+ Hylogen.Globals: geq :: (HyloPrim v) => v -> v -> Booly
+ Hylogen.Globals: gt :: (HyloPrim v) => v -> v -> Booly
+ Hylogen.Globals: inverseSqrt :: (HyloPrim a) => a -> a
+ Hylogen.Globals: leq :: (HyloPrim v) => v -> v -> Booly
+ Hylogen.Globals: linexp :: (Floating a) => (a, a, a, a) -> a -> a
+ Hylogen.Globals: linlin :: (Floating a) => (a, a, a, a) -> a -> a
+ Hylogen.Globals: lt :: (HyloPrim v) => v -> v -> Booly
+ Hylogen.Globals: max_ :: (HyloPrim a) => a -> a -> a
+ Hylogen.Globals: min_ :: (HyloPrim a) => a -> a -> a
+ Hylogen.Globals: neq :: (HyloPrim v) => v -> v -> Booly
+ Hylogen.Globals: true :: Booly
+ Hylogen.Globals: uvN :: Vec2
+ Hylogen.Types: Bbop :: String -> Booly -> Booly -> Booly
+ Hylogen.Types: Bcomp :: String -> a -> a -> Booly
+ Hylogen.Types: Bu :: String -> Booly
+ Hylogen.Types: Buop :: String -> Booly -> Booly
+ Hylogen.Types: Buoppre :: String -> Booly -> Booly
+ Hylogen.Types: Texture2D :: Texture -> Vec2 -> Vec4
+ Hylogen.Types: Tu :: String -> Texture
+ Hylogen.Types: V1select :: Booly -> Vec1 -> Vec1 -> Vec1
+ Hylogen.Types: V2bop :: String -> Vec2 -> Vec2 -> Vec2
+ Hylogen.Types: V2boppre :: String -> Vec2 -> Vec2 -> Vec2
+ Hylogen.Types: V2bops :: String -> Vec1 -> Vec2 -> Vec2
+ Hylogen.Types: V2select :: Booly -> Vec2 -> Vec2 -> Vec2
+ Hylogen.Types: V2uop :: String -> Vec2 -> Vec2
+ Hylogen.Types: V2uoppre :: String -> Vec2 -> Vec2
+ Hylogen.Types: V3bop :: String -> Vec3 -> Vec3 -> Vec3
+ Hylogen.Types: V3boppre :: String -> Vec3 -> Vec3 -> Vec3
+ Hylogen.Types: V3bops :: String -> Vec1 -> Vec3 -> Vec3
+ Hylogen.Types: V3select :: Booly -> Vec3 -> Vec3 -> Vec3
+ Hylogen.Types: V3uop :: String -> Vec3 -> Vec3
+ Hylogen.Types: V3uoppre :: String -> Vec3 -> Vec3
+ Hylogen.Types: V4bop :: String -> Vec4 -> Vec4 -> Vec4
+ Hylogen.Types: V4boppre :: String -> Vec4 -> Vec4 -> Vec4
+ Hylogen.Types: V4bops :: String -> Vec1 -> Vec4 -> Vec4
+ Hylogen.Types: V4select :: Booly -> Vec4 -> Vec4 -> Vec4
+ Hylogen.Types: V4uop :: String -> Vec4 -> Vec4
+ Hylogen.Types: V4uoppre :: String -> Vec4 -> Vec4
+ Hylogen.Types: class (Show v) => HyloPrim v
+ Hylogen.Types: data Booly
+ Hylogen.Types: data Texture
+ Hylogen.Types: fromVec1 :: HyloPrim v => Vec1 -> v
+ Hylogen.Types: instance Data.AdditiveGroup.AdditiveGroup Hylogen.Types.Vec1
+ Hylogen.Types: instance Data.AdditiveGroup.AdditiveGroup Hylogen.Types.Vec2
+ Hylogen.Types: instance Data.AdditiveGroup.AdditiveGroup Hylogen.Types.Vec3
+ Hylogen.Types: instance Data.AdditiveGroup.AdditiveGroup Hylogen.Types.Vec4
+ Hylogen.Types: instance Data.VectorSpace.VectorSpace Hylogen.Types.Vec1
+ Hylogen.Types: instance Data.VectorSpace.VectorSpace Hylogen.Types.Vec2
+ Hylogen.Types: instance Data.VectorSpace.VectorSpace Hylogen.Types.Vec3
+ Hylogen.Types: instance Data.VectorSpace.VectorSpace Hylogen.Types.Vec4
+ Hylogen.Types: instance GHC.Float.Floating Hylogen.Types.Vec2
+ Hylogen.Types: instance GHC.Float.Floating Hylogen.Types.Vec3
+ Hylogen.Types: instance GHC.Float.Floating Hylogen.Types.Vec4
+ Hylogen.Types: instance GHC.Num.Num Hylogen.Types.Booly
+ Hylogen.Types: instance GHC.Num.Num Hylogen.Types.Vec2
+ Hylogen.Types: instance GHC.Num.Num Hylogen.Types.Vec3
+ Hylogen.Types: instance GHC.Num.Num Hylogen.Types.Vec4
+ Hylogen.Types: instance GHC.Real.Fractional Hylogen.Types.Vec2
+ Hylogen.Types: instance GHC.Real.Fractional Hylogen.Types.Vec3
+ Hylogen.Types: instance GHC.Real.Fractional Hylogen.Types.Vec4
+ Hylogen.Types: instance GHC.Show.Show Hylogen.Types.Booly
+ Hylogen.Types: instance GHC.Show.Show Hylogen.Types.Texture
+ Hylogen.Types: instance Hylogen.Types.HyloPrim Hylogen.Types.Vec1
+ Hylogen.Types: instance Hylogen.Types.HyloPrim Hylogen.Types.Vec2
+ Hylogen.Types: instance Hylogen.Types.HyloPrim Hylogen.Types.Vec3
+ Hylogen.Types: instance Hylogen.Types.HyloPrim Hylogen.Types.Vec4
+ Hylogen.Types: select :: HyloPrim v => Booly -> v -> v -> v
+ Hylogen.Types: vbop :: HyloPrim v => String -> v -> v -> v
+ Hylogen.Types: vboppre :: HyloPrim v => String -> v -> v -> v
+ Hylogen.Types: vec :: HyloPrim v => HyloConstructor v -> v
+ Hylogen.Types: vu :: HyloPrim v => String -> v
+ Hylogen.Types: vuop :: HyloPrim v => String -> v -> v
+ Hylogen.Types: vuoppre :: HyloPrim v => String -> v -> v
- Hylogen.Globals: fract :: Vec1 -> Vec1
+ Hylogen.Globals: fract :: (HyloPrim a) => a -> a

Files

README.md view
@@ -1,38 +1,43 @@-# [*H Y L O G E N*](http://hylogen.com)+# [*H Y L O G E N*](https://hylogen.com) -Hylogen is a tiny language [embedded in Haskell](https://wiki.haskell.org/Embedded_domain_specific_language) for live-coding visuals.+Hylogen is a language [embedded in Haskell](https://wiki.haskell.org/Embedded_domain_specific_language) for live-coding visuals in WebGL.  ## Setup ``` cabal update cabal install hylogen ```+ ## Usage  ```haskell -- ./Main.hs module Main where- import Hylogen +main = putStrLn $ toGLSL $ color -main = putStrLn . toGLSL $ Vec4 (a, a, a, 1)+color = vec (a, a, a, 1)   where-    a = cos(X uv * sin(time/ 10) * 10 + X mouse)-      + sin(Y uv * sin(time / 10) * 10 + Y mouse)+    a = cos(X uvN * sin(time/ 10) * 10 + X mouse)+      + sin(Y uvN * sin(time / 10) * 10 + Y mouse) ``` -#### run hylogen+#### 1. run hylogen  ``` hylogen Main.hs ``` -#### play!+#### 2. play! Go to [localhost:5678](http://localhost:5678) in your browser.  Changes in `Main.hs` will now be propagated in realtime to your shader!  ## inspiration-- [The_Force](https://github.com/shawnlawson/The_Force).+- [The_Force](https://github.com/shawnlawson/The_Force) +## resources+[hackage](https://hackage.haskell.org/package/hylogen)++[examples](https://github.com/sleexyz/hylogen-yay)
app/Main.hs view
@@ -23,11 +23,14 @@  main :: IO () main = getArgs >>= \case-   [pathToWatch] -> do-      _ <- forkIO $ serveIndex-      runServer "127.0.0.1" 8080 $ handleConnection pathToWatch-   _ -> error "Name a file to watch!"+  [pathToWatch] -> main' pathToWatch+  _ -> error "Name a file to watch!" +main' :: FilePath ->  IO ()+main' pathToWatch = do+  _ <- forkIO $ serveIndex+  runServer "127.0.0.1" 8080 $ handleConnection pathToWatch+ handleConnection :: FilePath -> PendingConnection -> IO () handleConnection pathToWatch pending = do    let (dirToWatch, fileToWatch) = splitFileName pathToWatch@@ -55,24 +58,8 @@         "-i"++dirToWatch       , pathToWatch       ] ""-   putStrLn c+   putStrLn "updated"    return c-{--   color <- randomRIO (0::Float, 1)--   return $ unlines [-        "precision mediump float;"-      , "uniform float time;"-      , "uniform vec3 mouse;"-      , "const float PI = 3.141592653589793238462643383;"-      , "varying vec3 uv;"-      , ""-      , "void main() {"-      , "    gl_FragColor = vec4("++show color++", 0.0, 0.0, 1.0);"-      , "}"-      ]--}-  serveIndex :: IO () serveIndex = withSocketsDo $ do
app/index.html view
@@ -64,11 +64,13 @@      }      a {          text-decoration: inherit;+         color: white;      }       a:visited {          color: inherit;      }+     </style>   </head>   <body>@@ -85,20 +87,28 @@     <script>      const vsSource = ` attribute vec3 aPosition;-varying vec3 uv;+varying vec2 uvN; void main() {   gl_Position = vec4(aPosition, 1.0);-  uv = aPosition;+  uvN = aPosition.xy; } `;--     const initialFsSource = `+     const fsHeader=` precision mediump float;+const float pi = 3.141592653589793238462643383; uniform float time;-uniform vec3 mouse;-const float PI = 3.141592653589793238462643383;-varying vec3 uv;+uniform vec2 mouse;+uniform vec4 audio;+uniform sampler2D backBuffer;+varying vec2 uvN; +vec2 uv() {+  return 0.5 * uvN  + 0.5;+}++`++     const initialFsSource = ` void main() {     gl_FragColor = vec4(0.0, 0.0, 0.0, 1.0); }@@ -121,6 +131,7 @@           let success = gl.getShaderParameter(shader, gl.COMPILE_STATUS);          if (!success) {+           console.log(source);            throw "could not compile shader:" + gl.getShaderInfoLog(shader);          } @@ -152,15 +163,45 @@        gl.bindBuffer(gl.ARRAY_BUFFER, gl.createBuffer());        gl.bufferData(gl.ARRAY_BUFFER, new Float32Array([ -1,1,0, 1,1,0, -1,-1,0, 1,-1,0 ]), gl.STATIC_DRAW); +        // Assign attribute aPosition to each of the square's vertices.        gl.aPosition = gl.getAttribLocation(program, "aPosition");        gl.enableVertexAttribArray(gl.aPosition);        gl.vertexAttribPointer(gl.aPosition, 3, gl.FLOAT, false, 0, 0); +       // backBuffer stuff+       function createTarget() {+         let target = {+           texture: gl.createTexture(),+           framebuffer: gl.createFramebuffer()+         };+         // set up framebuffer+         gl.bindTexture( gl.TEXTURE_2D, target.texture);+         gl.texImage2D( gl.TEXTURE_2D, 0,  gl.RGBA, WIDTH, HEIGHT, 0,  gl.RGBA,  gl.UNSIGNED_BYTE, null);++         gl.texParameteri( gl.TEXTURE_2D,  gl.TEXTURE_WRAP_S,  gl.CLAMP_TO_EDGE);+         gl.texParameteri( gl.TEXTURE_2D,  gl.TEXTURE_WRAP_T,  gl.CLAMP_TO_EDGE);++         gl.texParameteri( gl.TEXTURE_2D,  gl.TEXTURE_MAG_FILTER,  gl.NEAREST);+         gl.texParameteri( gl.TEXTURE_2D,  gl.TEXTURE_MIN_FILTER,  gl.NEAREST);++         gl.bindFramebuffer( gl.FRAMEBUFFER, target.framebuffer);+         gl.framebufferTexture2D( gl.FRAMEBUFFER,  gl.COLOR_ATTACHMENT0,  gl.TEXTURE_2D, target.texture, 0);++         // clean up+         gl.bindTexture( gl.TEXTURE_2D, null);+         gl.bindFramebuffer( gl.FRAMEBUFFER, null);++         return target;+       }+       state.fb[0] = createTarget();+       state.fb[1] = createTarget();+        // remember the address within the fragment shader of each of my uniforms variables        gl.time = gl.getUniformLocation(program, "time");        gl.mouse = gl.getUniformLocation(program, "mouse");        gl.audio = gl.getUniformLocation(program, "audio");+       gl.backBuffer = gl.getUniformLocation(program, "backBuffer");         draw(gl, state); @@ -170,12 +211,26 @@      }       function draw (gl, state) {-        gl.uniform1f(gl.time, (new Date().getTime() / 1000 - state.time0));-       gl.uniform3f(gl.mouse, state.mouse.x, state.mouse.y, state.mouse.z);+       gl.uniform2f(gl.mouse, state.mouse.x, state.mouse.y);        gl.uniform4f(gl.audio, state.audio.low, state.audio.mid, state.audio.upper, state.audio.high); +       gl.uniform1i(gl.backBuffer, 0); // Do I need to check for null?++       gl.activeTexture(gl.TEXTURE0);+       gl.bindTexture(gl.TEXTURE_2D, state.fb[state.bit].texture);+       state.bit = (state.bit + 1) % 2;+       gl.bindFramebuffer( gl.FRAMEBUFFER, state.fb[state.bit].framebuffer);+       gl.clear(gl.COLOR_BUFFER_BIT);+        gl.drawArrays(gl.TRIANGLE_STRIP, 0, 4);++       gl.activeTexture(gl.TEXTURE0);+       gl.bindTexture(gl.TEXTURE_2D, state.fb[state.bit].texture);+       gl.bindFramebuffer( gl.FRAMEBUFFER, null);+       gl.clear(gl.COLOR_BUFFER_BIT);++       gl.drawArrays(gl.TRIANGLE_STRIP, 0, 4);      };       function animate (gl, state) {@@ -188,22 +243,22 @@      function setupState (state, canvas){        state.animationFrameRequest = null; +       state.bit = 0+       state.fb = [null, null];+        state.time0 = new Date() / 1000;  -       function setMouse (event, z) {+       function setMouse (event) {          let r = event.target.getBoundingClientRect();          state.mouse.x = (event.clientX - r.left) / (r.right - r.left) * 2 -1;          state.mouse.y = (event.clientY - r.bottom) / (r.top - r.bottom) * 2 - 1;--         if (z !== undefined) {-           state.mouse.z = z;-         }        };-       canvas.onmousedown = (event) => setMouse(event, 1);+       /* canvas.onmousedown = (event) => setMouse(event, 1); */+       /* canvas.onmouseup = (event) => setMouse(event, 0); */+        canvas.onmousemove = (event) => setMouse(event);-       canvas.onmouseup = (event) => setMouse(event, 0);-       state.mouse = {x: 0, y: 0, z: 0};+       state.mouse = {x: 0, y: 0};          state.audio = {low: 0.0, mid: 0.0, upper: 0.0, high: 0.0};@@ -268,7 +323,7 @@        function onFail(e) {          console.error(e);        }-       navigator.getUserMedia = navigator.getUserMedia || navigator.webkitGetUserMedia;+       navigator.getUserMedia = navigator.getUserMedia || navigator.webkitGetUserMedia || navigator.mozGetUserMedia || navigator.msGetUserMedia;        navigator.getUserMedia({audio: true}, onAccept, onFail);      } @@ -278,8 +333,10 @@      // stateful variables       const canvas = document.getElementById("canvas");-     canvas.width = Math.max(window.innerHeight, window.innerWidth);-     canvas.height = Math.max(window.innerHeight, window.innerWidth);+     let WIDTH = Math.max(window.innerHeight, window.innerWidth);+     let HEIGHT =  Math.max(window.innerHeight, window.innerWidth);+     canvas.width = WIDTH;+     canvas.height = HEIGHT;       const gl = canvas.getContext("webgl"); @@ -288,7 +345,7 @@      setupState(state, canvas);  -     loadProgram (gl, state,  vsSource, initialFsSource);+     loadProgram (gl, state,  vsSource, fsHeader + initialFsSource);        function fadeOut(elem) {@@ -318,7 +375,7 @@         wsConn.onmessage = function (m) {          console.log(m.data);-         loadProgram(gl, state,  vsSource, m.data);+         loadProgram(gl, state,  vsSource, fsHeader + m.data);        };      }
hylogen.cabal view
@@ -1,7 +1,7 @@ name:                hylogen-version:             0.1.0.5-synopsis:            a tiny EDSL for live-coding fragment shaders-description:         a tiny EDSL for live-coding fragment shaders+version:             0.1.0.6+synopsis:            an EDSL for live-coding fragment shaders+description:         an EDSL for live-coding fragment shaders homepage:            https://github.com/sleexyz/hylogen author:              Sean Lee license:             MIT@@ -19,6 +19,7 @@                      , Hylogen.Types                      , Hylogen.Globals   build-depends:       base >=4.8 && <4.9+                     , vector-space   hs-source-dirs:      src   default-language:    Haskell2010
src/Hylogen.hs view
@@ -24,16 +24,7 @@ import           Hylogen.Globals  toGLSL :: Vec4 -> String-toGLSL x = unlines $ [ boiler-                     , "void main() {"+toGLSL x = unlines $ [ "void main() {"                      , "    gl_FragColor = " <> show x <> ";"                      , "}"                      ]-  where-    boiler = unlines $ [ "precision mediump float;"-                       , "uniform float time;"-                       , "uniform vec3 mouse;"-                       , "uniform vec4 audio;"-                       , "const float PI = 3.141592653589793238462643383; "-                       , "varying vec3 uv;"-                       ]
src/Hylogen/Globals.hs view
@@ -5,25 +5,76 @@ import Hylogen.Types  --- | Vec1:+inverseSqrt :: (HyloPrim a) => a -> a+inverseSqrt = vuop "inversesqrt" -time :: Vec1-time = V1u "time"--- rand_ = V1uop "rand"+fract :: (HyloPrim a) => a -> a+fract = vuop "fract" +floor_ :: (HyloPrim a) => a -> a+floor_ = vuop "floor" -fract :: Vec1 -> Vec1-fract = V1uop "fract"+ceil_ :: (HyloPrim a) => a -> a+ceil_ = vuop "ceil" +min_ :: (HyloPrim a) => a -> a -> a+min_ = vboppre "min" +max_:: (HyloPrim a) => a -> a -> a+max_ = vboppre "max" +clamp :: (HyloPrim a) => a -> a -> a -> a+clamp x y z = (z `min_` y) `max_` x --- | Vec2: -uv, mouse :: Vec2-uv = V2u "uv"+linexp :: (Floating a) => (a, a, a, a) -> a -> a+linexp (a, b, c, d) x = c * ((d / c) ** ((x - a) / (b - a)))++linlin :: (Floating a) => (a, a, a, a) -> a -> a+linlin (a, b, c, d) x = c + (d - c) * ((x - a) / (b - a))+++time :: Vec1+time = V1u "time"++uv :: Vec2+uv = V2u "uv()"++uvN :: Vec2+uvN = V2u "uvN"++mouse :: Vec2 mouse = V2u "mouse"  --- coord_ = V4u "gl_FragCoord"+audio :: Vec4 audio = V4u "audio"++backBuffer :: Texture+backBuffer = Tu "backBuffer"++-- | Booly's++true :: Booly+true = Bu "true"++false :: Booly+false = Bu "false"++eq :: (HyloPrim v) => v -> v -> Booly+eq = Bcomp "=="++neq :: (HyloPrim v) => v -> v -> Booly+neq = Bcomp "!="++lt :: (HyloPrim v) => v -> v -> Booly+lt = Bcomp "<"++gt :: (HyloPrim v) => v -> v -> Booly+gt = Bcomp ">"++leq :: (HyloPrim v) => v -> v -> Booly+leq = Bcomp "<="++geq :: (HyloPrim v) => v -> v -> Booly+geq = Bcomp ">="
src/Hylogen/Types.hs view
@@ -1,30 +1,41 @@-{-# LANGUAGE DeriveFunctor#-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE ExplicitForAll #-}-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}  module Hylogen.Types where  import Data.Monoid+import Data.VectorSpace +-- | Darn I need injective type families.. waiting for GHC8+type family HyloConstructor v where+  HyloConstructor Vec1 = Float+  HyloConstructor Vec2 = (Vec1, Vec1)+  HyloConstructor Vec3 = (Vec1, Vec1, Vec1)+  HyloConstructor Vec4 = (Vec1, Vec1, Vec1, Vec1) +class (Show v) => HyloPrim v where+  vec :: HyloConstructor v -> v+  vu :: String -> v+  vuop :: String -> v -> v+  vuoppre :: String -> v -> v+  vbop :: String -> v -> v -> v+  vboppre :: String -> v -> v -> v+  select :: Booly -> v -> v -> v+  fromVec1 :: Vec1 -> v++ class Show a => HasX a class HasX a => HasY a class HasY a => HasZ a class HasZ a => HasW a  + data Vec1 where   Vec1 :: Float -> Vec1   V1u :: String -> Vec1@@ -32,11 +43,14 @@   V1uoppre :: String -> Vec1 -> Vec1   V1bop :: String -> Vec1 -> Vec1 -> Vec1   V1boppre :: String -> Vec1 -> Vec1 -> Vec1+  V1select :: Booly -> Vec1 -> Vec1 -> Vec1   X :: (HasX a) => a -> Vec1   Y :: (HasY a) => a -> Vec1   Z :: (HasZ a) => a -> Vec1   W :: (HasW a) => a -> Vec1 ++ instance Show Vec1 where   show expr = case expr of     Vec1 x -> show x@@ -45,38 +59,49 @@     V1uoppre u x -> "(" <> u <> show x <> ")"     V1bop b x y -> "(" <> show x <> " " <> b <> " " <> show y <> ")"     V1boppre b x y -> b <> "(" <> show x <> ", " <> show y <> ")"+    V1select b x y -> "( " <> show b <> " ? " <> show x <> " : " <> show y <> ")"     X x ->  show x <> ".x"     Y x ->  show x <> ".y"     Z x ->  show x <> ".z"     W x ->  show x <> ".w"  -instance Num Vec1 where-  (+) = V1bop "+"-  (*) = V1bop "*"-  negate = V1uoppre "-"-  abs = V1uop "abs"-  signum = V1uop "sign"-  fromInteger = Vec1  . fromInteger+instance HyloPrim Vec1 where+  vec = Vec1+  vu = V1u+  vuop = V1uop+  vuoppre = V1uoppre+  vbop = V1bop+  vboppre = V1boppre+  select = V1select+  fromVec1 = id +instance Num Vec1 where+  (+) = vbop "+"+  (*) = vbop "*"+  negate = vuoppre "-"+  abs = vuop "abs"+  signum = vuop "sign"+  fromInteger = Vec1 . fromInteger  instance Fractional Vec1 where-  (/) = V1bop "/"-  recip = V1bop "/" 1+  (/) = vbop "/"+  recip = vbop "/" 1   fromRational = Vec1 . fromRational + instance Floating Vec1 where-  pi = V1u "pi"-  exp = V1uop "exp"-  log = V1uop "log"-  sqrt = V1uop "sqrt"-  (**) = V1boppre "pow"-  sin = V1uop "sin"-  cos = V1uop "cos"-  tan = V1uop "tan"-  asin = V1uop "asin"-  acos = V1uop "acos"-  atan = V1uop "atan"+  pi = vu "pi"+  exp = vuop "exp"+  log = vuop "log"+  sqrt = vuop "sqrt"+  (**) = vboppre "pow"+  sin = vuop "sin"+  cos = vuop "cos"+  tan = vuop "tan"+  asin = vuop "asin"+  acos = vuop "acos"+  atan = vuop "atan"   sinh x = (exp x - exp (negate x))/2   cosh x = (exp x + exp (negate x))/2   tanh x = sinh x / cosh x@@ -84,18 +109,93 @@   acosh x = log $ x + sqrt(x**2 - 1)   atanh x = 0.5 * log ((1 + x)/(1 - x)) +instance AdditiveGroup Vec1 where+  zeroV = 0+  (^+^) = (+)+  negateV = negate+  (^-^) = (-) +instance VectorSpace Vec1 where+  type Scalar Vec1 = Vec1+  a *^ b = a * b+ -- | Vec2:  data Vec2 where   Vec2 :: (Vec1, Vec1) -> Vec2   V2u :: String -> Vec2+  V2uop :: String -> Vec2 -> Vec2+  V2uoppre :: String -> Vec2 -> Vec2+  V2bop :: String -> Vec2 -> Vec2 -> Vec2+  V2boppre :: String -> Vec2 -> Vec2 -> Vec2+  V2bops :: String -> Vec1 -> Vec2 -> Vec2+  V2select :: Booly -> Vec2 -> Vec2 -> Vec2 +instance HyloPrim Vec2 where+  vec = Vec2+  vu = V2u+  vuop = V2uop+  vuoppre = V2uoppre+  vbop = V2bop+  vboppre = V2boppre+  select = V2select+  fromVec1 x = Vec2 (x, x)++ instance Show Vec2 where   show expr = case expr of     Vec2 (x, y) -> "vec2(" <> show x <> ", " <> show y <> ")"     V2u x -> x+    V2uop u x -> u <> "(" <> show x <> ")"+    V2uoppre u x -> "(" <> u <> show x <> ")"+    V2bop b x y -> "(" <> show x <> " " <> b <> " " <> show y <> ")"+    V2boppre b x y -> b <> "(" <> show x <> ", " <> show y <> ")"+    V2bops b x y -> "(" <> show x <> " " <> b <> " " <> show y <> ")"+    V2select b x y -> "( " <> show b <> " ? " <> show x <> " : " <> show y <> ")" +instance Num Vec2 where+  (+) = vbop "+"+  (*) = vbop "*"+  negate = vuoppre "-"+  abs = vuop "abs"+  signum = vuop "sign"+  fromInteger = fromVec1 . fromInteger++instance Fractional Vec2 where+  (/) = vbop "/"+  recip = vbop "/" 1+  fromRational = fromVec1 . fromRational+++instance Floating Vec2 where+  pi = vu "pi"+  exp = vuop "exp"+  log = vuop "log"+  sqrt = vuop "sqrt"+  (**) = vboppre "pow"+  sin = vuop "sin"+  cos = vuop "cos"+  tan = vuop "tan"+  asin = vuop "asin"+  acos = vuop "acos"+  atan = vuop "atan"+  sinh x = (exp x - exp (negate x))/2+  cosh x = (exp x + exp (negate x))/2+  tanh x = sinh x / cosh x+  asinh x = log $ x + sqrt(x**2 + 1)+  acosh x = log $ x + sqrt(x**2 - 1)+  atanh x = 0.5 * log ((1 + x)/(1 - x))++instance AdditiveGroup Vec2 where+  zeroV = 0+  (^+^) = (+)+  negateV = negate+  (^-^) = (-)++instance VectorSpace Vec2 where+  type Scalar Vec2 = Vec1+  a *^ b = V2bops "*" a b+ instance HasX Vec2 instance HasY Vec2 @@ -105,29 +205,201 @@ data Vec3 where   Vec3 :: (Vec1, Vec1, Vec1) -> Vec3   V3u :: String -> Vec3+  V3uop :: String -> Vec3 -> Vec3+  V3uoppre :: String -> Vec3 -> Vec3+  V3bop :: String -> Vec3 -> Vec3 -> Vec3+  V3boppre :: String -> Vec3 -> Vec3 -> Vec3+  V3bops :: String -> Vec1 -> Vec3 -> Vec3+  V3select :: Booly -> Vec3 -> Vec3 -> Vec3 +instance HyloPrim Vec3 where+  vec = Vec3+  vu = V3u+  vuop = V3uop+  vuoppre = V3uoppre+  vbop = V3bop+  vboppre = V3boppre+  select = V3select+  fromVec1 x = Vec3 (x, x, x)+ instance Show Vec3 where   show expr = case expr of     Vec3 (x, y, z) -> "vec3(" <> show x <> ", " <> show y <> ", " <> show z <> ")"     V3u x -> x+    V3uop u x -> u <> "(" <> show x <> ")"+    V3uoppre u x -> "(" <> u <> show x <> ")"+    V3bop b x y -> "(" <> show x <> " " <> b <> " " <> show y <> ")"+    V3boppre b x y -> b <> "(" <> show x <> ", " <> show y <> ")"+    V3bops b x y -> "(" <> show x <> " " <> b <> " " <> show y <> ")"+    V3select b x y -> "( " <> show b <> " ? " <> show x <> " : " <> show y <> ")" +instance Num Vec3 where+  (+) = vbop "+"+  (*) = vbop "*"+  negate = vuoppre "-"+  abs = vuop "abs"+  signum = vuop "sign"+  fromInteger = fromVec1 . fromInteger++instance Fractional Vec3 where+  (/) = vbop "/"+  recip = vbop "/" 1+  fromRational = fromVec1 . fromRational+++instance Floating Vec3 where+  pi = vu "pi"+  exp = vuop "exp"+  log = vuop "log"+  sqrt = vuop "sqrt"+  (**) = vboppre "pow"+  sin = vuop "sin"+  cos = vuop "cos"+  tan = vuop "tan"+  asin = vuop "asin"+  acos = vuop "acos"+  atan = vuop "atan"+  sinh x = (exp x - exp (negate x))/2+  cosh x = (exp x + exp (negate x))/2+  tanh x = sinh x / cosh x+  asinh x = log $ x + sqrt(x**2 + 1)+  acosh x = log $ x + sqrt(x**2 - 1)+  atanh x = 0.5 * log ((1 + x)/(1 - x))++instance AdditiveGroup Vec3 where+  zeroV = 0+  (^+^) = (+)+  negateV = negate+  (^-^) = (-)++instance VectorSpace Vec3 where+  type Scalar Vec3 = Vec1+  a *^ b = V3bops "*" a b+ instance HasX Vec3 instance HasY Vec3 instance HasZ Vec3  + -- | Vec4:  data Vec4 where   Vec4 :: (Vec1, Vec1, Vec1, Vec1) -> Vec4   V4u :: String -> Vec4+  V4uop :: String -> Vec4 -> Vec4+  V4uoppre :: String -> Vec4 -> Vec4+  V4bop :: String -> Vec4 -> Vec4 -> Vec4+  V4boppre :: String -> Vec4 -> Vec4 -> Vec4+  V4bops :: String -> Vec1 -> Vec4 -> Vec4+  V4select :: Booly -> Vec4 -> Vec4 -> Vec4+  Texture2D :: Texture -> Vec2 -> Vec4 ++instance HyloPrim Vec4 where+  vec = Vec4+  vu = V4u+  vuop = V4uop+  vuoppre = V4uoppre+  vbop = V4bop+  vboppre = V4boppre+  select = V4select+  fromVec1 x = Vec4 (x, x, x, x)+ instance Show Vec4 where   show expr = case expr of     Vec4 (x, y, z, w) -> "vec4(" <> show x <> ", " <> show y <> ", " <> show z <> ", " <> show w <> ")"     V4u x -> x+    V4uop u x -> u <> "(" <> show x <> ")"+    V4uoppre u x -> "(" <> u <> show x <> ")"+    V4bop b x y -> "(" <> show x <> " " <> b <> " " <> show y <> ")"+    V4boppre b x y -> b <> "(" <> show x <> ", " <> show y <> ")"+    V4bops b x y -> "(" <> show x <> " " <> b <> " " <> show y <> ")"+    V4select b x y -> "( " <> show b <> " ? " <> show x <> " : " <> show y <> ")"+    Texture2D t v -> "texture2D(" <> show t <> ", " <> show v <> ")" +instance Num Vec4 where+  (+) = vbop "+"+  (*) = vbop "*"+  negate = vuoppre "-"+  abs = vuop "abs"+  signum = vuop "sign"+  fromInteger = fromVec1 . fromInteger++instance Fractional Vec4 where+  (/) = vbop "/"+  recip = vbop "/" 1+  fromRational = fromVec1 . fromRational+++instance Floating Vec4 where+  pi = vu "pi"+  exp = vuop "exp"+  log = vuop "log"+  sqrt = vuop "sqrt"+  (**) = vboppre "pow"+  sin = vuop "sin"+  cos = vuop "cos"+  tan = vuop "tan"+  asin = vuop "asin"+  acos = vuop "acos"+  atan = vuop "atan"+  sinh x = (exp x - exp (negate x))/2+  cosh x = (exp x + exp (negate x))/2+  tanh x = sinh x / cosh x+  asinh x = log $ x + sqrt(x**2 + 1)+  acosh x = log $ x + sqrt(x**2 - 1)+  atanh x = 0.5 * log ((1 + x)/(1 - x))++instance AdditiveGroup Vec4 where+  zeroV = 0+  (^+^) = (+)+  negateV = negate+  (^-^) = (-)++instance VectorSpace Vec4 where+  type Scalar Vec4 = Vec1+  a *^ b = V4bops "*" a b+ instance HasX Vec4 instance HasY Vec4 instance HasZ Vec4 instance HasW Vec4+++data Texture where+  Tu :: String -> Texture++instance Show Texture where+  show (Tu xs) = xs++-- | We implement Bool as a Num++data Booly where+  Bu:: String -> Booly+  Buop :: String -> Booly -> Booly+  Buoppre :: String -> Booly -> Booly+  Bbop :: String -> Booly -> Booly -> Booly+  Bcomp :: (HyloPrim a) => String -> a -> a -> Booly++instance Show Booly where+  show expr = case expr of+    Bu x -> x+    Buop u x -> u <> "(" <> show x <> ")"+    Buoppre u x -> "(" <> u <> show x <> ")"+    Bbop u x y -> "(" <> show x <> " " <> u <> " " <>  show y <> ")"+    Bcomp u x y -> "(" <> show x <> " " <> u <> " " <>  show y <> ")"++instance Num Booly where+  (+) = Bbop "||"+  (*) = Bbop "&&"+  negate = Buoppre "!"+  abs = id+  signum = id+  fromInteger x+    | x > 0 = Bu "true"+    | otherwise = Bu "false"+++-- data Expr a where+--   Node a :: ID -> a