Skip to content

Commit

Permalink
web-xr
Browse files Browse the repository at this point in the history
  • Loading branch information
marcinjangrzybowski committed May 2, 2023
1 parent 3fdce1c commit 99196fb
Show file tree
Hide file tree
Showing 14 changed files with 1,699 additions and 52 deletions.
10 changes: 5 additions & 5 deletions data/input-to-viz/pi3s2/twisted2
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
Goal: A
Elaborates to: hcomp {ℓ} {A} {(~ i ∨ i) ∨ ~ j ∨ j ∨ ~ k ∨ k} (λ l → primPOr {ℓ} (~ i ∨ i) (~ j ∨ j ∨ ~ k ∨ k) {λ _ → A} (primPOr {ℓ} (~ i) i {λ _ → A} (λ _ → hcomp {ℓ} {A} {(~ l ∨ l) ∨ ~ k ∨ k ∨ ~ j ∨ j} (λ l₁ → primPOr {ℓ} (~ l ∨ l) (~ k ∨ k ∨ ~ j ∨ j) {λ _ → A} (primPOr {ℓ} (~ l) l {λ _ → A} (λ _ → s (~ l₁) (k ∨ j)) (λ _ → a)) (primPOr {ℓ} (~ k ∨ k) (~ j ∨ j) {λ _ → A} (primPOr {ℓ} (~ k) k {λ _ → A} (λ _ → s (~ l₁) (~ l ∧ j)) (λ _ → a)) (primPOr {ℓ} (~ j) j {λ _ → A} (λ _ → s (l ∨ ~ l₁) k) (λ _ → s (k ∨ ~ l₁) (~ l))))) a) (λ _ → hcomp {ℓ} {A} {(l ∨ ~ l) ∨ k ∨ ~ k ∨ j ∨ ~ j} (λ l₁ → primPOr {ℓ} (l ∨ ~ l) (k ∨ ~ k ∨ j ∨ ~ j) {λ _ → A} (primPOr {ℓ} l (~ l) {λ _ → A} (λ _ → s (~ l₁) (~ k ∨ ~ j)) (λ _ → a)) (primPOr {ℓ} (k ∨ ~ k) (j ∨ ~ j) {λ _ → A} (primPOr {ℓ} k (~ k) {λ _ → A} (λ _ → s (~ l₁) (l ∧ ~ j)) (λ _ → a)) (primPOr {ℓ} j (~ j) {λ _ → A} (λ _ → s (~ l ∨ ~ l₁) (~ k)) (λ _ → s (~ k ∨ ~ l₁) l)))) a)) (primPOr {ℓ} (~ j ∨ j) (~ k ∨ k) {λ _ → A} (primPOr {ℓ} (~ j) j {λ _ → A} (λ _ → hcomp {ℓ} {A} {(k ∨ ~ k) ∨ ~ l ∨ l ∨ i ∨ ~ i} (λ l₁ → primPOr {ℓ} (k ∨ ~ k) (~ l ∨ l ∨ i ∨ ~ i) {λ _ → A} (primPOr {ℓ} k (~ k) {λ _ → A} (λ _ → s (~ l₁) (l ∨ ~ i)) (λ _ → a)) (primPOr {ℓ} (~ l ∨ l) (i ∨ ~ i) {λ _ → A} (primPOr {ℓ} (~ l) l {λ _ → A} (λ _ → s (~ l₁) (k ∧ ~ i)) (λ _ → a)) (primPOr {ℓ} i (~ i) {λ _ → A} (λ _ → s (~ k ∨ ~ l₁) l) (λ _ → s (l ∨ ~ l₁) k)))) a) (λ _ → hcomp {ℓ} {A} {(~ k ∨ k) ∨ l ∨ ~ l ∨ ~ i ∨ i} (λ l₁ → primPOr {ℓ} (~ k ∨ k) (l ∨ ~ l ∨ ~ i ∨ i) {λ _ → A} (primPOr {ℓ} (~ k) k {λ _ → A} (λ _ → s (~ l₁) (~ l ∨ i)) (λ _ → a)) (primPOr {ℓ} (l ∨ ~ l) (~ i ∨ i) {λ _ → A} (primPOr {ℓ} l (~ l) {λ _ → A} (λ _ → s (~ l₁) (~ k ∧ i)) (λ _ → a)) (primPOr {ℓ} (~ i) i {λ _ → A} (λ _ → s (k ∨ ~ l₁) (~ l)) (λ _ → s (~ l ∨ ~ l₁) (~ k))))) a)) (λ _ → a))) a
Goal:
Elaborates to: hcomp {ℓ} {S²} {(~ i ∨ i) ∨ ~ j ∨ j ∨ ~ k ∨ k} (λ l → primPOr {ℓ} (~ i ∨ i) (~ j ∨ j ∨ ~ k ∨ k) {λ _ → S²} (primPOr {ℓ} (~ i) i {λ _ → S²} (λ _ → hcomp {ℓ} {S²} {(~ l ∨ l) ∨ ~ k ∨ k ∨ ~ j ∨ j} (λ l₁ → primPOr {ℓ} (~ l ∨ l) (~ k ∨ k ∨ ~ j ∨ j) {λ _ → S²} (primPOr {ℓ} (~ l) l {λ _ → S²} (λ _ → surf (~ l₁) (k ∨ j)) (λ _ → base)) (primPOr {ℓ} (~ k ∨ k) (~ j ∨ j) {λ _ → S²} (primPOr {ℓ} (~ k) k {λ _ → S²} (λ _ → surf (~ l₁) (~ l ∧ j)) (λ _ → base)) (primPOr {ℓ} (~ j) j {λ _ → S²} (λ _ → surf (l ∨ ~ l₁) k) (λ _ → surf (k ∨ ~ l₁) (~ l))))) base) (λ _ → hcomp {ℓ} {S²} {(l ∨ ~ l) ∨ k ∨ ~ k ∨ j ∨ ~ j} (λ l₁ → primPOr {ℓ} (l ∨ ~ l) (k ∨ ~ k ∨ j ∨ ~ j) {λ _ → S²} (primPOr {ℓ} l (~ l) {λ _ → S²} (λ _ → surf (~ l₁) (~ k ∨ ~ j)) (λ _ → base)) (primPOr {ℓ} (k ∨ ~ k) (j ∨ ~ j) {λ _ → S²} (primPOr {ℓ} k (~ k) {λ _ → S²} (λ _ → surf (~ l₁) (l ∧ ~ j)) (λ _ → base)) (primPOr {ℓ} j (~ j) {λ _ → S²} (λ _ → surf (~ l ∨ ~ l₁) (~ k)) (λ _ → surf (~ k ∨ ~ l₁) l)))) base)) (primPOr {ℓ} (~ j ∨ j) (~ k ∨ k) {λ _ → S²} (primPOr {ℓ} (~ j) j {λ _ → S²} (λ _ → hcomp {ℓ} {S²} {(k ∨ ~ k) ∨ ~ l ∨ l ∨ i ∨ ~ i} (λ l₁ → primPOr {ℓ} (k ∨ ~ k) (~ l ∨ l ∨ i ∨ ~ i) {λ _ → S²} (primPOr {ℓ} k (~ k) {λ _ → S²} (λ _ → surf (~ l₁) (l ∨ ~ i)) (λ _ → base)) (primPOr {ℓ} (~ l ∨ l) (i ∨ ~ i) {λ _ → S²} (primPOr {ℓ} (~ l) l {λ _ → S²} (λ _ → surf (~ l₁) (k ∧ ~ i)) (λ _ → base)) (primPOr {ℓ} i (~ i) {λ _ → S²} (λ _ → surf (~ k ∨ ~ l₁) l) (λ _ → surf (l ∨ ~ l₁) k)))) base) (λ _ → hcomp {ℓ} {S²} {(~ k ∨ k) ∨ l ∨ ~ l ∨ ~ i ∨ i} (λ l₁ → primPOr {ℓ} (~ k ∨ k) (l ∨ ~ l ∨ ~ i ∨ i) {λ _ → S²} (primPOr {ℓ} (~ k) k {λ _ → S²} (λ _ → surf (~ l₁) (~ l ∨ i)) (λ _ → base)) (primPOr {ℓ} (l ∨ ~ l) (~ i ∨ i) {λ _ → S²} (primPOr {ℓ} l (~ l) {λ _ → S²} (λ _ → surf (~ l₁) (~ k ∧ i)) (λ _ → base)) (primPOr {ℓ} (~ i) i {λ _ → S²} (λ _ → surf (k ∨ ~ l₁) (~ l)) (λ _ → surf (~ l ∨ ~ l₁) (~ k))))) base)) (λ _ → base))) base
————————————————————————————————————————————————————————————
k : I
j : I
i : I
s : _≡_ {ℓ} {_≡_ {ℓ} {A} a a} (λ _ → a) (λ _ → a)
a : A
A : Type ℓ
surf : _≡_ {ℓ} {_≡_ {ℓ} {S²} base base} (λ _ → base) (λ _ → base)
base :
: Type ℓ
ℓ : Level
14 changes: 10 additions & 4 deletions src/ConcreteCell.hs
Original file line number Diff line number Diff line change
Expand Up @@ -207,10 +207,16 @@ renderNamedCell "loop₁" = Just $
parTranslateLoop2 = 0.1


-- renderNamedCell "s" = Just $
-- renderGCD'Points
-- (par1 , par2 , parTranslate)
-- (GCData "" $ FromLI 2 (\pc -> (unemerate pc , (unemerate pc + 1) , pc)))
renderNamedCell "surf" = Just $

renderGCD'
(par1 , par2 , parTranslate)
(GCData "" $ FromLI 2 (\pc -> (unemerate pc , (unemerate pc + 1))))


-- renderGCD'Points
-- (par1 , par2 , parTranslate)
-- (GCData "" $ FromLI 2 (\pc -> (unemerate pc , (unemerate pc + 1))))

renderNamedCell _ = Nothing

Expand Down
13 changes: 13 additions & 0 deletions src/DataExtra.hs
Original file line number Diff line number Diff line change
Expand Up @@ -261,3 +261,16 @@ mkMappable f l = Mapped l'' m

-- h :: [a] -> Map.Map b (Int , Int)
-- h = undefined


triageList :: forall a b . (a -> (Maybe b , Maybe b, Maybe b)) -> [a] -> ([b] , [b] , [b])
triageList f = w ([] , [] , [])
where
w :: ([b] , [b] , [b]) -> [a] -> ([b] , [b] , [b])
w ys [] = ys
w (ys , ys' , ys'') (x : xs) = w
(case (f x) of
(Just y , _ , _) -> (y : ys , ys' , ys'')
(_ , Just y , _) -> (ys , y: ys' , ys'')
(_ , _ , Just y) -> (ys , ys' , y : ys'')
_ -> error ("not exhaustive clasyfing function!")) xs
16 changes: 12 additions & 4 deletions src/DrawExpr.hs
Original file line number Diff line number Diff line change
Expand Up @@ -318,10 +318,18 @@ instance DrawingCtx GCContext ColorType (Either GCData ConcreteCellData) Default
-- else drw

drawCellCommon spt k addr _ _ =
if k == 0 then
[
( [[]] , ((["zeroCellCPI","m0"] , Midpoints) , gray 0))
] else []
case k of
0 -> [
( [[]] , ((["zeroCellCPI","m0"] , Midpoints) , gray 0))
]
3 -> Bf.second (const ((["cellSpace","animated-stripes"] , Basic) , gray 0.5)) <$>
(unitHyCubeSkel 3 2)

_ -> [];
-- if k == 0 then
-- [
-- ( [[]] , ((["zeroCellCPI","m0"] , Midpoints) , gray 0))
-- ] else []
-- let partOfSelectedCellBndr =
-- maybe False (not . isInternalAddress)
-- $ flip mbSubAddress addr =<< dptCursorAddress spt
Expand Down
40 changes: 32 additions & 8 deletions src/Drawing/Base.hs
Original file line number Diff line number Diff line change
Expand Up @@ -88,6 +88,8 @@ type DrawingGL = Drawing Color
type Pt3D = (Float , Float , Float)


data RenderableKind = PointK | LineK | TriangleK

data Renderable = Point Pt3D | Line (Pt3D , Pt3D) | Triangle (Pt3D , Pt3D , Pt3D)


Expand Down Expand Up @@ -134,24 +136,46 @@ traceDim x = trace
("zz: " ++ show (fmap (simplexDim . fst) x))
x


data MappedRenderables =
MappedRenderables
{ mrPoints :: Mapped (Renderable,Shade) (Maybe Address)
, mrLines :: Mapped (Renderable,Shade) (Maybe Address)
, mrTriangles :: Mapped (Renderable,Shade) (Maybe Address)
}

toRenderableDI :: Shadelike a => DrawingInterpreter a -> Drawing a
-> Either String
(Maybe Int , Mapped (Renderable,Shade) (Maybe Address))
(Maybe Int ,
MappedRenderables
-- Mapped (Renderable,Shade) (Maybe Address)
)
toRenderableDI di dr =
case ensureFold (length . head . fst) dr of
EFREmpty -> Right (Nothing , ifEmpty di)
EFREmpty -> Right (Nothing ,
MappedRenderables
(ifEmpty di)
(ifEmpty di)
(ifEmpty di))
EFREvery dim -> case fromDrawing di dim <*> pure dr of
Nothing -> Left ("not implementedDimInDrawingInterpreter " ++ show dim)
Just re' ->
let re = filter
let (re0 , re1 , re2) = triageList
(\case
(Triangle _ , _) -> True
_ -> False)
x@((Triangle _) , _) ->
(Nothing , Nothing , Just x)
x@((Line _) , _) ->
(Nothing , Just x , Nothing)
x@((Point _) , _) ->
(Just x , Nothing , Nothing)
)
re'
in Right (Just dim ,
mkMappable
(shadeMbAddress . snd)
re)
MappedRenderables
(mkMappable (shadeMbAddress . snd) re0)
(mkMappable (shadeMbAddress . snd) re1)
(mkMappable (shadeMbAddress . snd) re2)
)
_ -> error "mixed dimensions drawing"

mapStyle :: (a -> a) -> Drawing a -> Drawing a
Expand Down
15 changes: 8 additions & 7 deletions src/Drawing/GL.hs
Original file line number Diff line number Diff line change
Expand Up @@ -107,14 +107,15 @@ data WebGlDescriptor = WebGlDescriptor
, dLineWidth :: Int
, dInitCommands :: String
, dDrawCommands :: String
, dAddrMap :: [(String,(Int , Int))]
, dAddrMap :: [(String,((Int,Int),[Float]))]
}
deriving (Generic,Show)

instance FromJSON WebGlDescriptor
instance ToJSON WebGlDescriptor



webGlDescriptorStats :: WebGlDescriptor -> String
webGlDescriptorStats wgld = unlines
[ show (dPrimitiveMode wgld)
Expand Down Expand Up @@ -176,11 +177,11 @@ renderables2CVD =

-- type Descriptors = (Descriptor,Descriptor,Descriptor)
-- dAddrMap
initResources :: Mapped (Renderable,Shade) (Maybe Address) -> [WebGlDescriptor]
initResources (Mapped rs mp) =
let de0 = makeTrianglesResources Points (pointVs (renderables2CVD rs)) mp
de1 = makeTrianglesResources Lines (lineVs (renderables2CVD rs)) mp
de2 = makeTrianglesResources Triangles (triangleVs (renderables2CVD rs)) mp
initResources :: MappedRenderables -> [WebGlDescriptor]
initResources (MappedRenderables (Mapped rs0 mp0) (Mapped rs1 mp1) (Mapped rs2 mp2)) =
let de0 = makeTrianglesResources Points (pointVs (renderables2CVD rs1)) mp1
de1 = makeTrianglesResources Lines (lineVs (renderables2CVD rs1)) mp1
de2 = makeTrianglesResources Triangles (triangleVs (renderables2CVD rs2)) mp2

in reverse [de0 , de1 , de2]

Expand Down Expand Up @@ -228,7 +229,7 @@ makeTrianglesResources pm vertices mp =
(fromIntegral (div (length vertices) elemsPerVert) )
defaultLineWidth
(makeInitJSFun (execWriter traingleCommands)) ""
(map (\(x , (y , y')) -> (show x , (y * 3 , y' * 3)) )
(map (\(x , (y , y')) -> (show x , ((y * 3 , y' * 3),[])) )
(Map.toList mp))


Expand Down
76 changes: 52 additions & 24 deletions src/ShowExpWeb.hs
Original file line number Diff line number Diff line change
Expand Up @@ -255,12 +255,28 @@ printDescriptors l' = do
{ cwd = Just "/Users/marcin/cubeViz2" }
waitForProcess ph
writeFile "/tmp/cubeViz2Web/cvd.js" ("var cvdR = " ++ dJson ++ ";")
_ <- createProcess
(shell
"/Applications/Google\\ Chrome.app/Contents/MacOS/Google\\ Chrome --headless --screenshot file:///tmp/cubeViz2Web/index.html") { cwd = Just "/Users/marcin/" }
-- _ <- createProcess
-- (shell
-- "/Applications/Google\\ Chrome.app/Contents/MacOS/Google\\ Chrome --headless --screenshot file:///tmp/cubeViz2Web/index.html") { cwd = Just "/Users/marcin/" }
putStrLn "done"


clickPoints :: (Env, Context) -> ClCub () -> Map.Map String [Float]
clickPoints (ee , ctx) cub = mkDrawCub ClickPoints (ee , ctx) cub

& fmap (swap . Bf.bimap (head) (show . Just . fst . fst))
& Map.fromList

addClickPoints :: (Env, Context) -> ClCub () -> WebGlDescriptor -> WebGlDescriptor
addClickPoints (ee , ctx) cub wgd =
let cp = clickPoints (ee , ctx) cub
in wgd { dAddrMap = map
(\(k , v) ->
case Map.lookup k cp of
Nothing -> (k , v)
Just cPt -> (k , (fst v , cPt))
) (dAddrMap wgd) }


loadFile :: String -> IO (Either String SessionState)
loadFile fName =
Expand All @@ -277,12 +293,16 @@ updateGL appState =
(fst (asExpression appState))
((asCub appState))
let tryToRen = toRenderableDI drawingInterpreter drawings
ee = (fst (ssEnvExpr (asSession appState)))

acp = addClickPoints ee (asCub appState)
-- putStrLn $ show (clickPoints ee (asCub appState))
case tryToRen of
Left msg -> error msg
Right (_ , rens) ->
return (
return (fmap acp $ (
onDisplayAll usualVFG (asViewport appState)
(initResources $ rens))
(initResources $ rens)))

asExpression = ssEnvExpr . asSession

Expand All @@ -308,33 +328,30 @@ drawExpr as Scaffold ee e =
in concat (

[
mkDrawCub (CursorPT { cptCursorAddress = sptCA
, cptSecCursorAddress = sptSCA
, cptSelectedAddressCorners =
fromMaybe Set.empty $ do
(a , _) <- sptCA
Map.lookup a (asAddress2PointMap as)
})

,
-- mkDrawCub (CursorPT { cptCursorAddress = sptCA
-- , cptSecCursorAddress = sptSCA
-- , cptSelectedAddressCorners =
-- fromMaybe Set.empty $ do
-- (a , _) <- sptCA
-- Map.lookup a (asAddress2PointMap as)
-- })

-- ,

mkDrawCub (DefaultPT { dptCursorAddress = fmap fst sptCA
, dptShowFill = dpShowFilling $ asDisplayPreferences as
, dptFillFactor = 1.0
-- 0.5 * (sin (realToFrac $ asTime as) + 1)
, dptTags = dpShowTags $ asDisplayPreferences as
, dptShowLowDim = 1 -- 1 for 2D examples, 2 for 3D examples
})

-- , \ee e ->
-- fmap (second $ const (([] , Basic ) , nthColor 3))
-- (mkDrawCub FaceHandles ee e)

,

-- ,
-- mkDrawExpr (ScaffoldPT { sptDrawFillSkelet = True
-- , sptCursorAddress = sptCA
-- , sptMissingSubFaceCursor = sptMSFC
-- , sptScaffDim = 1})

mkDrawCub (ScaffoldPT { sptDrawFillSkelet = True
, sptCursorAddress = sptCA
, sptMissingSubFaceCursor = sptMSFC
, sptScaffDim = 1})


] <*> (pure ee) <*> (pure e)
Expand Down Expand Up @@ -399,6 +416,17 @@ drawingInterpreter =
3 -> Just toRenderablesIgnore)



-- embedDrawingIn3 :: Drawing a -> Drawing a
-- embedDrawingIn3 = map
-- (\x -> head $ ( case length (head (fst x)) of
-- 0 -> embed 2 (const 0) . embed 1 (const 0.5) . embed 0 (const 0.5)
-- 1 -> embed 2 (const 0) . embed 1 (const 0.5)
-- 2 -> embed 2 (const 0)
-- 3 -> id ) [x]
-- )


-- -- asCursorAddress :: AppState -> Maybe Address
-- -- asCursorAddress as =
-- -- let um = (asUserMode as) in
Expand Down
78 changes: 78 additions & 0 deletions web/codeViewShaders.js
Original file line number Diff line number Diff line change
@@ -0,0 +1,78 @@

var vsCodeView = `#version 300 es
in vec3 vPosition;
uniform mat4 poseMat;
uniform mat4 projMat;
uniform mat4 modelMat;
out vec2 vTex;
void
main()
{
// vCol = vColor;//vec3(1.0,0.0,0.0);//
vTex = vec2(vPosition.x , vPosition.y);
gl_Position =
(projMat)*(poseMat)*modelMat*
(vec4(vPosition.x , vPosition.y , vPosition.z ,1.0));
}
`;

var fsCodeView = `#version 300 es
precision highp float;
// The texture.
uniform sampler2D u_texture;
uniform sampler2D u_textureMap;
uniform vec2 coCu;
uniform float uTime;
out vec4 fColor;
in vec2 vTex;
void
main()
{
vec2 vTexCorrectedY = vec2(vTex.x*2.0 , 1.0 - vTex.y);
vec2 vTexMbInv;
if(gl_FrontFacing){
vTexMbInv = vec2(1.0 - vTexCorrectedY.x , vTexCorrectedY.y);
}else{
vTexMbInv = vTexCorrectedY;
}
vec4 co = texture(u_texture, vTexMbInv );
vec4 coMap = texture(u_textureMap, vTexMbInv );
vec4 coHover = texture(u_textureMap, coCu );
float hovered;
if(coHover.xyz == coMap.xyz && coHover.xyz!=vec3(1.0,1.0,1.0)){
hovered = 0.5+0.5*abs(sin(uTime/200.0));
}else{
hovered = 0.0;
}
if(abs(distance(coCu*vec2(1.0,2.0),vTexMbInv*vec2(1.0,2.0)))<0.02){
fColor = vec4(0.0,0.0,1.0,1.0);
}else{
fColor = co*vec4(1.0,1.0-hovered*0.5,1.0-hovered*0.5,1.0);
}
//vec4(step(0.5,co.x) , step(0.5,co.y) , step(0.5,co.z) , 1.0 );
// vec4(1.0,0.0,0.0,1.0);
// fColor = vec4(
// //vCol.rgb
// finalRGB
// , vCol.a);
}`;
Loading

0 comments on commit 99196fb

Please sign in to comment.