Exploring data and draw groups for http://try.purescript.org/ - see https://github.com/unconed/mathbox/blob/master/docs/primitives.md

Main.purs

module Main where

import Prelude hiding (add)
import Control.Monad.Eff (Eff)
import Data.Function.Uncurried 
import Data.Array
import Data.Foreign
import Data.List as L
import Data.Maybe (Maybe(..))
import Data.Tuple
import Optic.Core ((.~))
import Math
import Prim as P

import Mathbox.Classes as C
import Mathbox.Field
import Mathbox.Lenses as L
import Mathbox.Mathbox
import Mathbox.Types

type N = Number

type It1 = N
type It2 = Tuple N N

type Ch2 = Fn2 N N N
type Ch3 = Fn3 N N N N
type Ch4 = Fn4 N N N N N
type Ch5 = Fn5 N N N N N N
type Ch6 = Fn6 N N N N N N N

type In2 c i = Fn2 c N i
type In3 c i = Fn3 c N N i
type In4 c i = Fn4 c N N N i
type In5 c i = Fn5 c N N N N i
type In6 c i = Fn6 c N N N N N i
type In7 c i = Fn7 c N N N N N N i
type In8 c i = Fn8 c N N N N N N N i


-- DATA - 2 channels - 1 item

interval1 = Interval $ C.mkInterval { width = jv 5 }

interval2 speed = 
  Interval $ C.mkInterval { 
    width = jv 64, 
    expr = jvf expr, 
    channels = v 2 
  } where 
    expr :: In4 Ch2 It1
    expr = mkFn4 ( \emit x i t -> do
      let y = sin(x + speed * t) * 0.7
      runFn2 emit x y
    )

-- DATA - 3 channels - 1 item

area1 = Area $ C.mkArea { width = jv 3, height = jv 4}

area2 speed =
  Area $ C.mkArea { 
    rangeX = jv [(-0.5), 0.5], 
    rangeY = jv [-1.0, 1.0], 
    width = jv 3, 
    height = jv 4, 
    expr = jvf expr, 
    channels = v 3
  } where
    expr :: In6 Ch3 It1
    expr = mkFn6 ( \emit x y i j t -> do
      runFn3 emit x y (x + y + sin (speed * t))
    )


-- DATA - 4 channels - 1 item

volume speed r = Volume $ C.mkVolume {
  width = jv r,
  height = jv r,
  depth = jv r,
  expr = jvf expr,
  items = v 1,
  channels = v 4,
  live = v false
} where
  expr :: In4 Ch4 It1
  expr = mkFn4 ( \emit x y z -> do
    runFn4 emit x y z 1.0
  )


-- DATA - 2 channels - 2 items

interval3 speed = Interval $ C.mkInterval { 
  width = jv 16, 
  expr = jvf expr, 
  channels = v 2, 
  items = v 2
} where
  expr :: In4 Ch2 It2
  expr = mkFn4 ( \emit x i t -> do
    let y = sin(x + speed * t) * 0.7
    Tuple (runFn2 emit x 0.0) (runFn2 emit x y) 
  ) 

-- DRAW

line c = Line $ C.mkLine { color = v c, width = v 5.0 }
points c = Point $ C.mkPoint { color = v c, size = v 15.0 }
surface c = Surface $ C.mkSurface { color = v c }
vector c = Vector $ C.mkVector { color = v c, end = v true, width = v 5.0 }
face c = Face $ C.mkFace { color = v c, width = v 3.0 } -- TODO

-- DATA & DRAW

toShow = [ interval2 0.0, line red
         , interval1, points blue
         , area1, points pink
         , area1, line blue
         , area2 0.0, surface yellow
         , interval3 0.1, vector green
         , volume 0.1 3, points blue --line blue surface blue
         , volume 0.1 3, face blue
         ]

----------

camera =
  (Camera $ C.mkCamera { 
    proxy = v true, 
    position = jv [-1.0, -1.0, 4.0] 
  })
    
accessory =
  [ Axis $ C.mkAxis { width = v 4.0 }
  , Axis $ C.mkAxis { width = v 4.0, axis = v axis2 }
  , Axis $ C.mkAxis { width = v 4.0, axis = v axis3 }
  
  , Scale $ C.mkScale { divide = v 2.0 }
  , Ticks $ C.mkTicks { width = v 2.0 }
  , Format $ C.mkFormat { digits = jv 2.0 }
  , Label $ C.mkLabel { color = v red }
  
  , Grid $ C.mkGrid { divideX = v 20.0, divideY = v 10.0, width = v 1.0 }
  ]

cartesian :: Number -> Array MathboxPrimitive -> MathboxPrimitive
cartesian r nested = 
  (Cartesian $ C.mkCartesian { range = range, scale = scale }) (
    L.fromFoldable nested
  ) where
    range = v [[-2.0 * r, 2.0 * r], [-1.0 * r, r], [-1.0 * r, r]]
    scale = v [2.0 * r, r, r]

mathbox = cartesian 1.0 (camera : accessory <> toShow)

main = do
  mkMathbox { plugins: ["core", "controls", "cursor"], controls: { klass: orbitControls } } >>=
  applyOnThree (setThreeClearColor colorWhite 1.0) >>=  
  set ( L.focus .~ Just 3.0 $ mkSet ) >>=
  add (toJs mathbox)
  
v = Val
jv = Just <<< Val
jvf = jv <<< toForeign
yellow = unsafeMkColor "yellow"
red = unsafeMkColor "red"
blue = unsafeMkColor "blue"
pink = unsafeMkColor "pink"
green = unsafeMkColor "green"