Use arrow heads and tails for factorial.

app/Icons.hs

@@ -134,17 +134,18 @@ branchIcon :: Diagram B
 branchIcon = circle 0.3 # fc white # lc white
 
 -- GUARD ICON --
+guardSize = 0.7
 guardTriangle :: Int -> Diagram B
-guardTriangle x = triangleAndPort # alignL
+guardTriangle x = ((triangleAndPort ||| (hrule (guardSize * 0.8) # lc white # lwG defaultLineWidth)) # alignR) <> (makePort x) # alignL
   where
-    triangleAndPort = polygon (with & polyType .~ PolySides [90 @@ deg, 45 @@ deg] [1, 1])
+    triangleAndPort = polygon (with & polyType .~ PolySides [90 @@ deg, 45 @@ deg] [guardSize, guardSize])
-      # rotateBy (1/8)# lc white # lwG defaultLineWidth # alignT # alignR <> (makePort x # showOrigin)
+      # rotateBy (1/8)# lc white # lwG defaultLineWidth # alignT # alignR
 
 guardLBracket :: Int -> Diagram B
 guardLBracket x = ell # alignT # alignL <> makePort x
   where
     -- todo: use a path or trail here so that the corner is rounded correctly
-    ell = (hrule 1 # lc orange # lwG defaultLineWidth # alignR) <> (vrule 1 # lc orange # lwG defaultLineWidth # alignT)
+    ell = (hrule guardSize # lc orange # lwG defaultLineWidth # alignR) <> (vrule guardSize # lc orange # lwG defaultLineWidth # alignT)
 
 -- | The ports of the guard icon are as follows:
 -- Port 0: The top port for the result
@@ -158,6 +159,6 @@ guardIcon n = centerXY $ vcat (take n trianglesAndBrackets # alignT) <> makePort
     lBrackets = map guardLBracket [1,3..]
     trianglesAndBrackets =
       zipWith zipper trianglesWithPorts lBrackets
-    zipper tri lBrack = verticalLine === ((lBrack ||| hrule 0.4) # alignR <> (tri # alignL))
+    zipper tri lBrack = verticalLine === ((lBrack ||| strut (guardSize * 0.4)) # alignR <> (tri # alignL))
       where
         verticalLine = vrule 0.4 # lc white # lwG defaultLineWidth

app/Main.hs

@@ -15,11 +15,14 @@ import Data.Typeable(Typeable)
 
 import Lib
 import Icons(apply0Dia, apply0NDia)
-import Rendering(toNames, portToPort, iconToPort, iconToIcon, iconToIconEnds, renderDrawing)
+import Rendering(toNames, portToPort, iconToPort, iconToIcon,
+  iconToIconEnds, iconHeadToPort, iconTailToPort, renderDrawing)
 import Types(Icon(..), Drawing(..), EdgeEnd(..))
 
 -- TODO Now --
+-- todo: add example goal and status drawings for factorial to readme.
 -- todo: replace hrule and vrule with strutX and strutY
+-- todo: consolidate colors to one place
 -- todo: add port to bottom of guard.
 -- todo: use constants for icon name strings in Main
 -- todo: figure out how to deal with the difference between arrow heads and arrow tails
@@ -29,6 +32,7 @@ import Types(Icon(..), Drawing(..), EdgeEnd(..))
 -- todo: Find out how to hide unqualified names such that recursive drawings are connected correctly
 -- todo: Find out and fix why connectinos to sub-icons need to be qualified twice (eg. "lam0" .> "arg" .> "arg")
 -- todo: Rotate based on difference from ideal tangent angle, not line distance.
+-- todo: Try using connectPerim for port ot port connections. Hopefully this will draw a spline.
 -- todo: layout and rotate considering external connections.
 -- todo: figure out local vs. global icon positions
 
@@ -151,14 +155,12 @@ fact0Edges = [
     iconToPort "*" "*Ap" 0,
     iconToPort "one" "g0" 2,
     portToPort "*Ap" 1 "g0" 4,
-    --portToPort "*Ap" 3 "recurAp" 0,
     portToPort "recurAp" 2 "*Ap" 3,
     iconToPort "arg" "eq0Ap" 1,
     iconToPort "arg" "-1Ap" 1,
     iconToPort "arg" "*Ap" 2,
     portToPort "-1Ap" 2 "recurAp" 1,
     iconToPort "res" "g0" 0
-    --iconToIconEnds "-1" Ap1Result "eq0" Ap1Arg
   ]
 
 fact0Drawing = Drawing fact0Icons fact0Edges []
@@ -172,12 +174,49 @@ factLam0Icons = toNames [
 factLam0Edges = [
   iconToPort ("lam0" .> "arg" .> "arg") "lam0" 0,
   iconToPort "lam0" ("lam0" .> "recurAp") 0,
-  --portToPort "lam0" 0 ("lam0" .> "*Ap2") 3,
   iconToIcon "lam0" "fac"
   ]
 
 factLam0Drawing = Drawing factLam0Icons factLam0Edges [(fact0Name, fact0Drawing)]
 
+fact1Icons = toNames
+  [
+  ("g0", GuardIcon 2),
+  ("one", TextBoxIcon "1"),
+  ("eq0", TextBoxIcon "== 0"),
+  ("-1", TextBoxIcon "-1"),
+  ("*", TextBoxIcon "*"),
+  ("recurAp", Apply0Icon),
+  ("*Ap", Apply0NIcon 2),
+  ("arg", BranchIcon),
+  ("res", ResultIcon)
+  ]
+
+fact1Edges = [
+    --iconToPort "eq0" "eq0Ap" 0,
+    --portToPort "eq0Ap" 2 "g0" 1,
+    --iconToPort "-1" "-1Ap" 0,
+    iconToIconEnds "arg" EndNone "eq0" EndAp1Arg,
+    iconTailToPort "eq0" EndAp1Result "g0" 1,
+    iconToIconEnds "arg" EndNone "-1" EndAp1Arg,
+    iconTailToPort "-1" EndAp1Result "recurAp" 1,
+    --iconHeadTo
+    iconToPort "*" "*Ap" 0,
+    iconToPort "one" "g0" 2,
+    portToPort "*Ap" 1 "g0" 4,
+    portToPort "recurAp" 2 "*Ap" 3,
+    --iconToPort "arg" "eq0Ap" 1,
+    --iconToPort "arg" "-1Ap" 1,
+    iconToPort "arg" "*Ap" 2,
+    --portToPort "-1Ap" 2 "recurAp" 1,
+    iconToPort "res" "g0" 0
+    --iconToIconEnds "-1" Ap1Result "eq0" Ap1Arg
+  ]
+
+fact1Drawing = Drawing fact1Icons fact1Edges []
+
+factLam1Drawing = Drawing factLam0Icons factLam0Edges [(fact0Name, fact1Drawing)]
+
 -- This is left commented out for a future test of the manual connect functions.
 -- connectNodes g =
 --   g # connectIconToPort "res" "A" (PortName 2) # connectIconToPort "foo" "B" (PortName 0)
@@ -188,7 +227,7 @@ factLam0Drawing = Drawing factLam0Icons factLam0Edges [(fact0Name, fact0Drawing)
 
 main1 :: IO ()
 main1 = do
-  placedNodes <- renderDrawing factLam0Drawing
+  placedNodes <- renderDrawing factLam1Drawing
   mainWith (placedNodes # bgFrame 0.1 black)
 
 main2 = mainWith (apply0NDia 3 # bgFrame 0.1 black)

app/Rendering.hs

@@ -6,6 +6,8 @@ module Rendering (
   iconToPort,
   iconToIcon,
   iconToIconEnds,
+  iconHeadToPort,
+  iconTailToPort,
   toNames,
   renderDrawing
 ) where
@@ -41,7 +43,7 @@ mapFst f = map (\(x, y) -> (f x, y))
 toNames :: (IsName a) => [(a, b)] -> [(Name, b)]
 toNames = mapFst toName
 
-noEnds = (NoEnd, NoEnd)
+noEnds = (EndNone, EndNone)
 
 --portToPort :: (IsName a, IsName c) => a -> b -> c -> d -> Edge
 portToPort :: (IsName a, IsName b) => a -> Int -> b -> Int -> Edge
@@ -59,6 +61,10 @@ iconToIcon a   c   = Edge (toName a, Nothing, toName c, Nothing) noEnds
 iconToIconEnds :: (IsName a, IsName b) => a -> EdgeEnd -> b -> EdgeEnd -> Edge
 iconToIconEnds a b c d = Edge (toName a, Nothing, toName c, Nothing) (b, d)
 
+iconHeadToPort a endHead c d = Edge (toName a, Nothing, toName c, Just d) (EndNone, endHead)
+
+iconTailToPort a endTail c d = Edge (toName a, Nothing, toName c, Just d) (endTail, EndNone)
+
 edgesToGraph :: (Ord v) => [v] -> [(v, t, v , t1)] -> Gr v ()
 edgesToGraph names edges = mkGraph names simpleEdges
   where
@@ -73,27 +79,28 @@ getArrowOpts :: (RealFloat n, Typeable n) => (EdgeEnd, EdgeEnd) -> ArrowOpts n
 getArrowOpts (t, h) = arrowOptions
   where
     lookupEnd :: (RealFloat n, Typeable n) => EdgeEnd -> ArrowOpts n -> ArrowOpts n
-    lookupEnd NoEnd = id
+    lookupEnd EndNone = id
-    lookupEnd Ap1Arg = (arrowHead .~ thorn) . (headTexture .~ solid cyan)
+    lookupEnd EndAp1Arg = (arrowHead .~ thorn) . (headTexture .~ solid cyan)
-    lookupEnd Ap1Result = (arrowTail .~ arg1ResHT) . (tailTexture .~ solid cyan)
+    lookupEnd EndAp1Result = (arrowTail .~ arg1ResHT) . (tailTexture .~ solid cyan)
     arrowOptions =
       with & arrowHead .~ noHead
       & arrowTail .~ noTail
+      & lengths .~ large
       & shaftStyle %~ lwG defaultLineWidth . lc white
       & (lookupEnd t) & (lookupEnd h)
 
-plainLine = getArrowOpts (NoEnd, NoEnd)
+plainLine = getArrowOpts (EndNone, EndNone)
 
 connectMaybePorts :: Edge -> Diagram B -> Diagram B
-connectMaybePorts (Edge (icon0, Just port0, icon1, Just port1) _) =
+connectMaybePorts (Edge (icon0, Just port0, icon1, Just port1) ends) =
   connect'
-  plainLine
+  (getArrowOpts ends)
   (icon0 .> port0)
   (icon1 .> port1)
-connectMaybePorts (Edge (icon0, Nothing, icon1, Just port1) _) =
+connectMaybePorts (Edge (icon0, Nothing, icon1, Just port1) ends) =
-  connectOutside' plainLine icon0 (icon1 .> port1)
+  connectOutside' (getArrowOpts ends) icon0 (icon1 .> port1)
-connectMaybePorts (Edge (icon0, Just port0, icon1, Nothing) _) =
+connectMaybePorts (Edge (icon0, Just port0, icon1, Nothing) ends) =
-  connectOutside' plainLine (icon0 .> port0) icon1
+  connectOutside' (getArrowOpts ends) (icon0 .> port0) icon1
 connectMaybePorts (Edge (icon0, Nothing, icon1, Nothing) ends) =
   connectOutside' (getArrowOpts ends) icon0 icon1
 

app/Types.hs

@@ -19,7 +19,7 @@ type Connection = (Name, Maybe Int, Name, Maybe Int)
 -- and the name of the destination icon, and its optional port number.
 data Edge = Edge {edgeConnection :: Connection, edgeEnds :: (EdgeEnd, EdgeEnd)}
 
-data EdgeEnd = Ap1Result | Ap1Arg | NoEnd
+data EdgeEnd = EndAp1Result | EndAp1Arg | EndNone
 
 -- | A drawing is a map from names to Icons, a list of edges,
 -- and a map of names to subDrawings