diff --git a/app/Icons.hs b/app/Icons.hs
index 3bcaad5..7d88608 100644
--- a/app/Icons.hs
+++ b/app/Icons.hs
@@ -141,10 +141,10 @@ apply0PortLocations = map p2 [
apply0NDia :: Int -> Diagram B
apply0NDia n = finalDia # centerXY where
- seperation = 0.6
+ seperation = circleRadius * 1.5
trianglePortsCircle = hcat [
reflectX apply0Triangle,
- hcat $ take n $ map (\x -> makePort x <> strutX seperation) [2,3..],
+ hcat $ take n $ map (\x -> makePort x <> circle (circleRadius * 0.5) # fc lineCol <> strutX seperation) [2,3..],
makePort 1 <> alignR (circle circleRadius # fc (apply0C colorScheme) # lwG defaultLineWidth # lc (apply0C colorScheme))
]
allPorts = makePort 0 <> alignL trianglePortsCircle
diff --git a/app/Main.hs b/app/Main.hs
index 3450865..3fa49f6 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -8,7 +8,7 @@ import Data.Maybe (fromMaybe)
import Data.Typeable(Typeable)
-import Icons(guardIcon, colorScheme, ColorStyle(..))
+import Icons(guardIcon, apply0NDia, colorScheme, ColorStyle(..))
import Rendering(toNames, portToPort, iconToPort, iconToIcon,
iconToIconEnds, iconHeadToPort, iconTailToPort, renderDrawing)
import Types(Icon(..), Drawing(..), EdgeEnd(..))
@@ -176,6 +176,45 @@ fact1Drawing = Drawing fact1Icons fact1Edges []
factLam1Drawing = Drawing factLam0Icons factLam0Edges [(fact0Name, fact1Drawing)]
+-- fact2 is like fact1, but uses fTimesAp port 2 to distrubute the argument,
+-- not fArg
+fact2Icons = toNames
+ [
+ (fG0, GuardIcon 2),
+ (fOne, TextBoxIcon "1"),
+ (fEq0, TextBoxIcon "== 0"),
+ (fMinus1, TextBoxIcon fMinus1),
+ (fTimes, TextBoxIcon fTimes),
+ (fRecurAp, Apply0Icon),
+ (fTimesAp, Apply0NIcon 2),
+ --(fArg, BranchIcon),
+ (fRes, ResultIcon)
+ ]
+
+fact2Edges = [
+ --iconToIconEnds fArg EndNone fEq0 EndAp1Arg,
+ iconTailToPort fEq0 EndAp1Arg fTimesAp 2,
+ iconTailToPort fEq0 EndAp1Result fG0 3,
+ --iconToIconEnds fArg EndNone fMinus1 EndAp1Arg,
+ iconTailToPort fMinus1 EndAp1Arg fTimesAp 2,
+ iconTailToPort fMinus1 EndAp1Result fRecurAp 1,
+ iconToPort fTimes fTimesAp 0,
+ iconToPort fOne fG0 2,
+ portToPort fTimesAp 1 fG0 4,
+ portToPort fRecurAp 2 fTimesAp 3,
+ --iconToPort fArg fTimesAp 2,
+ iconToPort fRes fG0 0
+ ]
+
+fact2Drawing = Drawing fact2Icons fact2Edges []
+
+factLam2Edges = [
+ iconToPort ("lam0" .> fTimesAp .> (2 :: Int)) "lam0" 0,
+ iconToPort "lam0" ("lam0" .> fRecurAp) 0,
+ iconToIcon "lam0" "fac"
+ ]
+factLam2Drawing = Drawing factLam0Icons factLam2Edges [(fact0Name, fact2Drawing)]
+
(arr1, arr2, arr3, arr4) = ("arr1", "arr2", "arr3", "arr4")
arrowTestIcons = toNames [
@@ -199,7 +238,7 @@ main1 = do
placedNodes <- renderDrawing factLam1Drawing
mainWith (placedNodes # bgFrame 1 (backgroundC colorScheme))
-main2 = mainWith (guardIcon 3 # bgFrame 0.1 black)
+main2 = mainWith (apply0NDia 3 # bgFrame 0.1 black)
main :: IO ()
main = main1
diff --git a/app/Rendering.hs b/app/Rendering.hs
index 13ba2d9..01f5bf5 100644
--- a/app/Rendering.hs
+++ b/app/Rendering.hs
@@ -96,7 +96,7 @@ getArrowOpts (t, h) = arrowOptions
lookupTail EndAp1Result = (arrowTail .~ arg1ResT) . (tailTexture .~ ap1ResultTexture)
lookupHead EndNone = id
- lookupHead EndAp1Arg = (arrowHead .~ arrowheadDart (0.4 @@ turn))
+ lookupHead EndAp1Arg = (arrowHead .~ dart)
. (headTexture .~ ap1ArgTexture) . (headStyle %~ ap1ArgStyle)
lookupHead EndAp1Result = (arrowHead .~ arg1ResH) . (headTexture .~ ap1ResultTexture)
diff --git a/examples/guard_factorial_1.svg b/examples/guard_factorial_1.svg
index fe8aa55..2e601f8 100644
--- a/examples/guard_factorial_1.svg
+++ b/examples/guard_factorial_1.svg
@@ -1,3 +1,3 @@
\ No newline at end of file
+ "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
\ No newline at end of file