fixed scope problem in the constructor of Arrow

penrose.cabal

@@ -24,18 +24,19 @@ executable penrose
   main-is:             Main.hs
   other-modules:       Utils Server Style Substance Functions Runtime Shapes
   other-extensions:    AllowAmbiguousTypes, RankNTypes, UnicodeSyntax, NoMonomorphismRestriction, OverloadedStrings, DeriveGeneric, DuplicateRecordFields
-  build-depends:       base       >= 4.9 && <4.10,
-                       random     >= 1.1 && <1.2,
-                       containers >= 0.5 && <0.6,
-                       gloss      >= 1.11 && <1.12,
-                       megaparsec >= 5.3 && <5.4,
-                       ad         >= 4.3 && <4.4,
-                       aeson      >= 1.2 && <1.3,
-                       text       >= 1.2 && <1.3,
-                       websockets >= 0.11 && <0.12,
-                       old-time   >= 1.1 && <1.2,
-                       pretty     >= 1.1.3 && < 1.2,
-                       extra      >= 1.6 && < 1.7,
-                       process    >= 1.4.3 && < 1.5
+  build-depends:       base                >= 4.9 && <4.10,
+                       random              >= 1.1 && <1.2,
+                       andom-shuffle       >= 0.0.4 && < 0.1,
+                       containers          >= 0.5 && <0.6,
+                       gloss               >= 1.11 && <1.12,
+                       megaparsec          >= 5.3 && <5.4,
+                       ad                  >= 4.3 && <4.4,
+                       aeson               >= 1.2 && <1.3,
+                       text                >= 1.2 && <1.3,
+                       websockets          >= 0.11 && <0.12,
+                       old-time            >= 1.1 && <1.2,
+                       pretty              >= 1.1.3 && < 1.2,
+                       extra               >= 1.6 && < 1.7,
+                       process             >= 1.4.3 && < 1.5
   hs-source-dirs:      src
   default-language:    Haskell2010

src/Runtime.hs

@@ -75,7 +75,7 @@ type CompInfo = (Name, [S.Expr])
 
 initRng :: StdGen
 initRng = mkStdGen seed
-    where seed = 20 -- deterministic RNG with seed
+    where seed = 18 -- deterministic RNG with seed
 
 objFnNone :: ObjFnPenaltyState a
 objFnNone objs w f v = 0
@@ -293,10 +293,10 @@ computeInnerCurve :: Name -> Name -> Computation -> [S.Expr] -> CubicBezier -> M
 computeInnerCurve fname property comp args curve objDict =
              case property of
              "path" -> case comp of
-                          ComputeSurjection f -> 
+                          ComputeSurjection f ->
                             case args of
-                              [S.IntLit num, S.FloatLit lx, S.FloatLit ly, 
-                               S.FloatLit tx, S.FloatLit ty] -> 
+                              [S.IntLit num, S.FloatLit lx, S.FloatLit ly,
+                               S.FloatLit tx, S.FloatLit ty] ->
                                   let (path, g') = computeSurjection initRng num (lx, ly) (tx, ty) in
                                   trace ("path: " ++ (show path)) $ curve { pathcb = path }
                               _ -> error "Runtime (curve): args don't match comp type"
@@ -472,7 +472,7 @@ lookupNames dict ns = map check res
         res = map (`M.lookup` dict) ns
         check x = case x of
             Just x -> x
-            _ -> error ("lookupNames: at least one of the arguments don't exist: " ++ show ns)
+            _ -> error ("lookupNames: at least one of the arguments does not exist: " ++ show ns)
 
 -- TODO should take list of current objects as parameter, and be partially applied with that
 -- first param: list of parameter annotations for each object in the state
@@ -530,6 +530,7 @@ genInitState (decls, constrs) stys =
              let initStateComputed = trace ("| comps: " ++ show computations
                                      {-++ "\n| objs: " ++ show initStateConstr-}) $
                                      mapVals $ foldl computeOn (dictOfObjs initStateConstr) computations in
+                                     -- TODO: why passing initStateConstr here?
 
              -- Note: after creating these annotations, we can no longer change the size or order of the state.
              -- unpackAnnotate :: [Obj] -> [ [(Float, Annotation)] ]

src/Style.hs

@@ -452,11 +452,12 @@ procObjFn varMap fns _ = fns -- TODO: avoid functions
 -- TODO: Have a more principled expr look up routine
 lookupVarMap :: String -> VarMap -> String
 lookupVarMap s varMap = case M.lookup s varMap of
-    Just s -> s
+    Just s' -> s'
     Nothing -> case M.lookup s computationDict of
                Just f -> trace ("found function named: " ++ s) $ s
-               Nothing -> error $ "lookupVarMap: incorrect variable mapping from " ++ s
-                                ++ " or no computation"
+               Nothing -> s
+               -- TODO: there is a possibility of accessing unselected Substance variables here. As written here, we are assuming all ids from SUbstance are accessible in Style GLOBALLY. Is this okay?
+               -- error $ "lookupVarMap: incorrect variable mapping from " ++ s ++ " or no computation"
 
 -- | Resolve a Style expression, which could be operations among expressions such as a chained dot-access for an attribute through a couple of layers of indirection (TODO: hackiest part of the compiler, rewrite this)
 -- | An expression can be either a string (variable name) or float (literal)? Not sure

src/sty/cart-test.sty

@@ -3,7 +3,6 @@ global {
     constraint at(horiz, 200, 0)
     constraint at(vert, 0, 200)
     constraint at(topright, 200, 200)
-
     constraint at(domain, 0, 0)
     constraint at(codomain, 0, 0)
     objective horizontal(domain)
@@ -13,16 +12,16 @@ global {
 Set `domain` {
   shape = Arrow {
     -- TODO: not in scope?
-    -- start = origin
-    -- end = horiz
+    start = origin
+    end   = horiz
     label = Auto
   }
 }
 
 Set `codomain` {
   shape = Arrow {
-    -- start = origin
-    -- end = vert
+    start = origin
+    end   = vert
     label = Auto
   }
 }
@@ -35,7 +34,6 @@ Point p {
     shape  = Dot {
         label = Auto
     }
-
     objective centerLabel(p, p.label)
 } 
 
@@ -44,5 +42,6 @@ Map f x y {
         style = "dashed"
         -- TODO pass in origin, vert, horiz as args for computing bounding box
         path = computeSurjection(10, 400.0, 150.0, 600.0, 350.0)
+        -- path = computeSurjection(10, origin, vert, horiz)
     }
 }