0.4.4.8 added pairwise variants: circlep, rectp, vlinep, hlinep, line…

…p, ilinep, clipp, betweenp, lpfp, hpfp, bpfp, ~~:, +=:, linlinp

.gitignore

@@ -28,3 +28,8 @@ cabal.project.local
 cabal.project.local~
 .HTF/
 .ghc.environment.*
+.psci_modules/
+.purs-repl
+.spago/
+output/
+

CHANGELOG.md

@@ -1,5 +1,9 @@
 # ChangeLog
 
+0.4.4.8:
+
+-added pairwise variants: circlep, rectp, vlinep, hlinep, linep, ilinep, clipp, betweenp, lpfp, hpfp, bpfp, ~~:, +=:, linlinp
+
 0.4.4.7:
 
 -added pairwise variants of max, min, and gate (maxp, minp, gatep)

Makefile

@@ -34,11 +34,11 @@ clean:
 
 devBuild:
 	cabal --ghcjs --builddir=dev-result new-build all --disable-library-profiling --disable-documentation --ghcjs-options=-DGHCJS_GC_INTERVAL=60000
-	cp -f dev-result/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.7/x/punctual/build/punctual/punctual.jsexe/index.html .
-	cp -f dev-result/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.7/x/punctual/build/punctual/punctual.jsexe/rts.js .
-	cp -f dev-result/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.7/x/punctual/build/punctual/punctual.jsexe/lib.js .
-	cp -f dev-result/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.7/x/punctual/build/punctual/punctual.jsexe/out.js .
-	cp -f dev-result/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.7/x/punctual/build/punctual/punctual.jsexe/runmain.js .
+	cp -f dev-result/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.8/x/punctual/build/punctual/punctual.jsexe/index.html .
+	cp -f dev-result/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.8/x/punctual/build/punctual/punctual.jsexe/rts.js .
+	cp -f dev-result/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.8/x/punctual/build/punctual/punctual.jsexe/lib.js .
+	cp -f dev-result/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.8/x/punctual/build/punctual/punctual.jsexe/out.js .
+	cp -f dev-result/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.8/x/punctual/build/punctual/punctual.jsexe/runmain.js .
 
 devTest:
 	cabal --ghcjs new-test test:tests --disable-library-profiling --disable-documentation
@@ -50,8 +50,8 @@ buildBenchmark:
 	cabal --ghcjs --builddir=benchmark new-build punctual-benchmarks --disable-library-profiling --disable-documentation --ghcjs-options=-DGHCJS_GC_INTERVAL=60000
 
 runBenchmark:
-	node benchmark/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.7/b/punctual-benchmarks/build/punctual-benchmarks/punctual-benchmarks.jsexe/all.js
+	node benchmark/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.8/b/punctual-benchmarks/build/punctual-benchmarks/punctual-benchmarks.jsexe/all.js
 
 runBenchmarkInBrowser:
-	open benchmark/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.7/b/punctual-benchmarks/build/punctual-benchmarks/punctual-benchmarks.jsexe/index.html
+	open benchmark/build/x86_64-linux/ghcjs-8.6.0.1/punctual-0.4.4.8/b/punctual-benchmarks/build/punctual-benchmarks/punctual-benchmarks.jsexe/index.html
 

executable-src/Main.hs

@@ -38,7 +38,7 @@ headElement = do
 
 intro :: Text
 intro
-  ="-- Punctual, an audiovisual live coding language, version 0.4.4.7\n\
+  ="-- Punctual, an audiovisual live coding language, version 0.4.4.8\n\
    \-- Chromium/Chrome/Edge/Opera browser required\n\
    \-- Press Shift-Enter to (re)evaluate/activate code\n\
    \-- documentation @ https://github.com/dktr0/Punctual.git\n\
@@ -55,7 +55,7 @@ intro
 main :: IO ()
 main = do
   hSetBuffering stdout LineBuffering
-  putStrLn "Punctual standalone, version 0.4.4.7"
+  putStrLn "Punctual standalone, version 0.4.4.8"
   ctx <- getGlobalAudioContextPlayback 
   putStrLn "global audio context (playback mode) acquired"
   putStrLn "loading MusicW audio worklets..."

library-src/Sound/Punctual/FragmentShader.hs

@@ -10,6 +10,7 @@ import Data.Map as Map
 import Data.Foldable as Foldable
 import Data.Maybe
 import Data.List.Split
+import Data.List (zipWith4)
 import Data.Time
 import Data.Tempo
 import Control.Monad
@@ -262,16 +263,16 @@ graphToGLSL ah env (Gate mm x y) = binaryMatchedGraphs mm gate ah env x y
   y'' <- mapM assign y'
   binaryMatchedGLSLExprs gate ah x' y'' -}
 
-graphToGLSL ah env (Clip r x) = do
+graphToGLSL ah env (Clip mm r x) = do
   r' <- graphToGLSL (Just Vec2) env r >>= align Vec2
   x' <- graphToGLSL ah env x
-  sequence [ clip r'' x'' | r'' <- r', x'' <- x' ]
-
-graphToGLSL ah env (Between r x) = do
+  sequence $ combineBinary mm clip r' x'
+    
+graphToGLSL ah env (Between mm r x) = do
   r' <- graphToGLSL (Just Vec2) env r >>= align Vec2
   x' <- graphToGLSL ah env x
-  return [ between r'' x'' | r'' <- r', x'' <- x' ]
-
+  return $ combineBinary mm between r' x'
+    
 -- *** TODO: Step's semantics currently only make sense for single-channel outputs.
 graphToGLSL _ _ (Step [] _) = return [constantFloat 0]
 graphToGLSL ah env (Step (x:[]) _) = graphToGLSL ah env x
@@ -287,32 +288,32 @@ graphToGLSL _ env (Step xs y) = do
 
 -- binary functions, with position
 
-graphToGLSL ah env (Rect xy wh) = do
+graphToGLSL ah env (Rect mm xy wh) = do
   xy' <- graphToGLSL (Just Vec2) env xy >>= align Vec2
   wh' <- graphToGLSL (Just Vec2) env wh >>= align Vec2
-  binaryFunctionWithPositionGraphM rect env xy' wh' >>= alignHint ah
+  binaryFunctionWithPositionGraphM rect env mm xy' wh' >>= alignHint ah
 
-graphToGLSL ah env (Circle xy r) = do
+graphToGLSL ah env (Circle mm xy r) = do
   xy' <- graphToGLSL (Just Vec2) env xy >>= align Vec2
   r' <- graphToGLSL (Just GLFloat) env r >>= align GLFloat
-  binaryFunctionWithPositionGraph circle env xy' r' >>= alignHint ah
+  binaryFunctionWithPositionGraph circle env mm xy' r' >>= alignHint ah
 
-graphToGLSL ah env (VLine x w) = do
+graphToGLSL ah env (VLine mm x w) = do
   x' <- graphToGLSL (Just GLFloat) env x >>= align GLFloat
   w' <- graphToGLSL (Just GLFloat) env w >>= align GLFloat
-  binaryFunctionWithPositionGraph vline env x' w' >>= alignHint ah
+  binaryFunctionWithPositionGraph vline env mm x' w' >>= alignHint ah
 
-graphToGLSL ah env (HLine y w) = do
+graphToGLSL ah env (HLine mm y w) = do
   y' <- graphToGLSL (Just GLFloat) env y >>= align GLFloat
   w' <- graphToGLSL (Just GLFloat) env w >>= align GLFloat
-  binaryFunctionWithPositionGraph hline env y' w' >>= alignHint ah
+  binaryFunctionWithPositionGraph hline env mm y' w' >>= alignHint ah
 
 -- (simple) ternary functions
-graphToGLSL ah env (LinLin r1 r2 w) = do
+graphToGLSL ah env (LinLin mm r1 r2 w) = do
   r1' <- graphToGLSL (Just Vec2) env r1 >>= align Vec2
   r2' <- graphToGLSL (Just Vec2) env r2 >>= align Vec2
   w' <- graphToGLSL (Just GLFloat) env w >>= align GLFloat
-  alignHint ah [ linlin r1'' r2'' w'' | r1'' <- r1', r2'' <- r2', w'' <- w' ]
+  alignHint ah $ combineTernary mm linlin r1' r2' w'
 
 -- get all channels of a result branch per channel of condition, by
 -- aligning result branches to each other + aligning condition to GLFloat
@@ -325,17 +326,17 @@ graphToGLSL ah env (IfThenElse x y z) = do
 
 -- ternary functions with position
 
-graphToGLSL ah env@(_,fxy) (ILine xy1 xy2 w) = do
+graphToGLSL ah env@(_,fxy) (ILine mm xy1 xy2 w) = do
   xy1' <- graphToGLSL (Just Vec2) env xy1 >>= align Vec2
   xy2' <- graphToGLSL (Just Vec2) env xy2 >>= align Vec2
   w' <- graphToGLSL (Just GLFloat) env w >>= align GLFloat
-  alignHint ah [ iline xy1'' xy2'' w'' fxy' | xy1'' <- xy1', xy2'' <- xy2', w'' <- w', fxy' <- fxy ]
+  alignHint ah $ combineQuaternary mm iline xy1' xy2' w' fxy
 
-graphToGLSL ah env@(_,fxy) (Line xy1 xy2 w) = do
+graphToGLSL ah env@(_,fxy) (Line mm xy1 xy2 w) = do
   xy1' <- graphToGLSL (Just Vec2) env xy1 >>= align Vec2
   xy2' <- graphToGLSL (Just Vec2) env xy2 >>= align Vec2
   w' <- graphToGLSL (Just GLFloat) env w >>= align GLFloat
-  alignHint ah [ line xy1'' xy2'' w'' fxy' | xy1'' <- xy1', xy2'' <- xy2', w'' <- w', fxy' <- fxy ]
+  alignHint ah $ combineQuaternary mm line xy1' xy2' w' fxy
 
 graphToGLSL _ _ _ = return [constantFloat 0]
 
@@ -389,12 +390,11 @@ binaryMatchedGLSLExprs f ah xs ys = case (exprsChannels xs == 1 || exprsChannels
     ys' <- align GLFloat ys
     alignHint ah [ f x y  | x <- xs', y <- ys' ]
 
+binaryFunctionWithPositionGraph :: (GLSLExpr -> GLSLExpr -> GLSLExpr -> GLSLExpr) -> GraphEnv -> MultiMode -> [GLSLExpr] -> [GLSLExpr] -> GLSL [GLSLExpr]
+binaryFunctionWithPositionGraph f (_,fxys) mm as bs = return $ combineTernary mm f as bs fxys
 
-binaryFunctionWithPositionGraph :: (GLSLExpr -> GLSLExpr -> GLSLExpr -> GLSLExpr) -> GraphEnv -> [GLSLExpr] -> [GLSLExpr] -> GLSL [GLSLExpr]
-binaryFunctionWithPositionGraph f (_,fxys) as bs = return [ f a b c | a <- as, b <- bs, c <- fxys ]
-
-binaryFunctionWithPositionGraphM :: (GLSLExpr -> GLSLExpr -> GLSLExpr -> GLSL GLSLExpr) -> GraphEnv -> [GLSLExpr] -> [GLSLExpr] -> GLSL [GLSLExpr]
-binaryFunctionWithPositionGraphM f (_,fxys) as bs = sequence [ f a b c | a <- as, b <- bs, c <- fxys ]
+binaryFunctionWithPositionGraphM :: (GLSLExpr -> GLSLExpr -> GLSLExpr -> GLSL GLSLExpr) -> GraphEnv -> MultiMode -> [GLSLExpr] -> [GLSLExpr] -> GLSL [GLSLExpr]
+binaryFunctionWithPositionGraphM f (_,fxys) mm as bs = sequence $ combineTernary mm f as bs fxys
 
 setfx :: GLSLExpr -> GLSLExpr -> GLSLExpr  -- Vec2 -> GLFloat -> Vec2
 setfx fxy x = exprExprToVec2 x (swizzleY fxy)
@@ -728,3 +728,32 @@ fragmentShader tempo texMap oldProgram newProgram = toText $ header <> body
     (gl_FragColor,assignments) = runGLSL $ fragmentShaderGLSL tempo texMap oldProgram newProgram
     gl_FragColor' = "gl_FragColor = " <> builder gl_FragColor <> ";\n"
     body = "\nvoid main() {\n" <> assignments <> gl_FragColor' <> "}"
+
+combineBinary :: MultiMode -> (x -> y -> z) -> [x] -> [y] -> [z]
+combineBinary Combinatorial f xs ys = [ f x y | x <- xs, y <- ys ]
+combineBinary PairWise f xs ys = zipWith f xs' ys'
+  where
+    n = maximum [length xs,length ys]
+    xs' = Prelude.take n (cycle xs)
+    ys' = Prelude.take n (cycle ys)
+
+combineTernary :: MultiMode -> (w -> x -> y -> z) -> [w] -> [x] -> [y] -> [z]
+combineTernary Combinatorial f ws xs ys = [ f w x y | w <- ws, x <- xs, y <- ys ]
+combineTernary PairWise f ws xs ys = zipWith3 f ws' xs' ys'
+  where
+    n = maximum [length ws,length xs,length ys]
+    ws' = Prelude.take n (cycle ws)
+    xs' = Prelude.take n (cycle xs)
+    ys' = Prelude.take n (cycle ys)
+
+combineQuaternary :: MultiMode -> (v -> w -> x -> y -> z) -> [v] -> [w] -> [x] -> [y] -> [z]
+combineQuaternary Combinatorial f vs ws xs ys = [ f v w x y | v <- vs, w <- ws, x <- xs, y <- ys ]
+combineQuaternary PairWise f vs ws xs ys = zipWith4 f vs' ws' xs' ys'
+  where
+    n = maximum [length vs,length ws,length xs,length ys]
+    vs' = Prelude.take n (cycle vs)
+    ws' = Prelude.take n (cycle ws)
+    xs' = Prelude.take n (cycle xs)
+    ys' = Prelude.take n (cycle ys)
+
+

library-src/Sound/Punctual/Graph.hs

@@ -20,8 +20,6 @@ data Graph =
   Px | Py | Aspect |
   Fx | Fy | Fxy | -- cartesian coordinates of current fragment
   FRt | FR | FT | -- polar coordinates of current fragment
-  SetFx Graph Graph | SetFy Graph Graph | SetFxy Graph Graph |
-  Zoom Graph Graph | Move Graph Graph | Tile Graph Graph | Spin Graph Graph |
   Lo | Mid | Hi | ILo | IMid | IHi |
   Cps | Time | Beat | EBeat | ETime |
   Rnd |
@@ -97,19 +95,28 @@ data Graph =
   Max MultiMode Graph Graph |
   Min MultiMode Graph Graph |
   Gate MultiMode Graph Graph |
-  Circle Graph Graph |
-  Rect Graph Graph |
-  Clip Graph Graph |
-  Between Graph Graph |
-  VLine Graph Graph |
-  HLine Graph Graph |
-  Step [Graph] Graph |
+  Circle MultiMode Graph Graph |
+  Rect MultiMode Graph Graph |
+  VLine MultiMode Graph Graph |
+  HLine MultiMode Graph Graph |
+  ILine MultiMode Graph Graph Graph |
+  Line MultiMode Graph Graph Graph |
+  Clip MultiMode Graph Graph |
+  Between MultiMode Graph Graph |
+  SetFx Graph Graph |
+  SetFy Graph Graph |
+  SetFxy Graph Graph |
+  Zoom Graph Graph |
+  Move Graph Graph |
+  Tile Graph Graph |
+  Spin Graph Graph |
+  Delay MultiMode Double Graph Graph |
+  LinLin MultiMode Graph Graph Graph |
+  LPF MultiMode Graph Graph Graph |
+  HPF MultiMode Graph Graph Graph |
+  BPF MultiMode Graph Graph Graph |
   IfThenElse Graph Graph Graph |
-  ILine Graph Graph Graph |
-  Line Graph Graph Graph |
-  LinLin Graph Graph Graph |
-  LPF Graph Graph Graph | HPF Graph Graph Graph | BPF Graph Graph Graph |
-  Delay Double Graph Graph
+  Step [Graph] Graph
   deriving (Show,Eq,Generic,NFData)
 
 instance Num Graph where
@@ -129,11 +136,11 @@ instance Fractional Graph where
 when :: Graph -> Graph -> Graph
 when x y = IfThenElse x y 0
 
-modulatedRangeGraph :: Graph -> Graph -> Graph -> Graph
-modulatedRangeGraph low high m = LinLin (Multi [-1,1]) (Multi [low,high]) m
+modulatedRangeLowHigh :: MultiMode -> Graph -> Graph -> Graph -> Graph
+modulatedRangeLowHigh mm low high x = LinLin mm (Multi [-1,1]) (Multi [low,high]) x
 
-(+-) :: Graph -> Graph -> Graph -> Graph
-a +- b = modulatedRangeGraph (a - (a*b)) (a + (a*b))
+modulatedRangePlusMinus :: MultiMode -> Graph -> Graph -> Graph -> Graph
+modulatedRangePlusMinus mm a b = modulatedRangeLowHigh mm (a - (a*b)) (a + (a*b))
 
 fit :: Graph -> Graph -> Graph
 fit ar x = IfThenElse ((GreaterThanOrEqual Combinatorial) Aspect ar) (Zoom (Multi [ar/Aspect,1]) $ x) (Zoom (Multi [1,Aspect/ar]) $ x)

library-src/Sound/Punctual/Parser.hs

@@ -401,39 +401,53 @@ graph3 = asum [
   -- other binary functions (with combinatorial semantics, generally speaking)
   reserved "fit" >> return fit,
   reserved "min" >> return (Min Combinatorial),
-  reserved "max" >> return (Max Combinatorial),
   reserved "minp" >> return (Min PairWise),
+  reserved "max" >> return (Max Combinatorial),
   reserved "maxp" >> return (Max PairWise),
-  reserved "hline" >> return HLine,
-  reserved "vline" >> return VLine,
-  reserved "circle" >> return Circle,
-  reserved "rect" >> return Rect,
-  reserved "clip" >> return Clip,
-  reserved "between" >> return Between,
-  reserved "when" >> return Sound.Punctual.Graph.when,
   reserved "gate" >> return (Gate Combinatorial),
   reserved "gatep" >> return (Gate PairWise),
+  reserved "circle" >> return (Circle Combinatorial),
+  reserved "circlep" >> return (Circle PairWise),
+  reserved "rect" >> return (Rect Combinatorial),
+  reserved "rectp" >> return (Rect PairWise),
+  reserved "vline" >> return (VLine Combinatorial),
+  reserved "vlinep" >> return (VLine PairWise),
+  reserved "hline" >> return (HLine Combinatorial),
+  reserved "hlinep" >> return (HLine PairWise),
+  reserved "clip" >> return (Clip Combinatorial),
+  reserved "clipp" >> return (Clip PairWise),
+  reserved "between" >> return (Between Combinatorial),
+  reserved "betweenp" >> return (Between PairWise),
   reserved "setfx" >> return SetFx,
   reserved "setfy" >> return SetFy,
   reserved "setfxy" >> return SetFxy,
   reserved "zoom" >> return Zoom,
   reserved "move" >> return Move,
   reserved "tile" >> return Tile,
   reserved "spin" >> return Spin,
+  reserved "when" >> return Sound.Punctual.Graph.when,
   double_graph_graph_graph <*> double,
   graph4 <*> graph
   ] <?> "expected Graph -> Graph -> Graph"
 
 graph4 :: H (Graph -> Graph -> Graph -> Graph)
 graph4 = asum [
-  reserved "lpf" >> return LPF,
-  reserved "hpf" >> return HPF,
-  reserved "bpf" >> return BPF,
-  reserved "~~" >> return modulatedRangeGraph,
-  reserved "+-" >> return (+-),
-  reserved "linlin" >> return LinLin,
-  reserved "iline" >> return ILine,
-  reserved "line" >> return Line
+  reserved "lpf" >> return (LPF Combinatorial),
+  reserved "lpfp" >> return (LPF PairWise),
+  reserved "hpf" >> return (HPF Combinatorial),
+  reserved "hpfp" >> return (HPF PairWise),
+  reserved "bpf" >> return (BPF Combinatorial),
+  reserved "bpfp" >> return (BPF PairWise),
+  reserved "~~" >> return (modulatedRangeLowHigh Combinatorial),
+  reserved "~~:" >> return (modulatedRangeLowHigh PairWise),
+  reserved "+-" >> return (modulatedRangePlusMinus Combinatorial),
+  reserved "+-:" >> return (modulatedRangePlusMinus PairWise),
+  reserved "linlin" >> return (LinLin Combinatorial),
+  reserved "linlinp" >> return (LinLin PairWise),
+  reserved "iline" >> return (ILine Combinatorial),
+  reserved "ilinep" >> return (ILine PairWise),
+  reserved "line" >> return (Line Combinatorial),
+  reserved "linep" >> return (Line PairWise)
   ] <?> "expected Graph -> Graph -> Graph -> Graph"
 
 lGraph_graph_graph :: H ([Graph] -> Graph -> Graph)
@@ -446,7 +460,10 @@ int_graph_graph = asum [
   ]
 
 double_graph_graph_graph :: H (Double -> Graph -> Graph -> Graph)
-double_graph_graph_graph = reserved "delay" >> return Delay
+double_graph_graph_graph = asum [
+  reserved "delay" >> return (Delay Combinatorial),
+  reserved "delayp" >> return (Delay PairWise)
+  ]
 
 graph2_graph :: H ((Graph -> Graph) -> Graph)
 graph2_graph = graph_graph2_graph <*> graph