From 4ca53c58c4c334a300b7195ba07136a8faf35d7d Mon Sep 17 00:00:00 2001
From: Robbie Gleichman <rgleichman@gmail.com>
Date: Sat, 24 Dec 2016 14:46:53 -0800
Subject: [PATCH] Allow case icon to embed apply and pattern apply icons.

---
 app/GraphAlgorithms.hs       |  5 +++++
 app/Icons.hs                 | 34 ++++++++++++++++++++++------------
 test/VisualTranslateTests.hs |  4 +++-
 todo.md                      |  4 ++++
 4 files changed, 34 insertions(+), 13 deletions(-)

diff --git a/app/GraphAlgorithms.hs b/app/GraphAlgorithms.hs
index f6fae56..fcd42d6 100644
--- a/app/GraphAlgorithms.hs
+++ b/app/GraphAlgorithms.hs
@@ -36,8 +36,13 @@ syntaxNodeIsEmbeddable parentType n mParentPort = case (parentType, n) of
   (ApplyParent, LikeApplyNode _ _) -> notResultPort
   (ApplyParent, LiteralNode _) -> notResultPort
   (CaseOrGuardParent, LiteralNode _) -> notResultPort
+  (CaseOrGuardParent, LikeApplyNode _ _) -> notResultPort
+  (CaseOrGuardParent, NestedPatternApplyNode _ _) -> notResultPort && notInputPort
   _ -> False
   where
+    notInputPort = case mParentPort of
+      Just (Port 0) -> False
+      _ -> True
     notResultPort = case mParentPort of
       -- TODO Don't use hardcoded port number
       Just (Port 1) -> False
diff --git a/app/Icons.hs b/app/Icons.hs
index 8637068..d964774 100644
--- a/app/Icons.hs
+++ b/app/Icons.hs
@@ -98,6 +98,14 @@ nestedApplyPortAngles args port maybeNodeName = case maybeNodeName of
     Nothing -> []
     Just icon -> getPortAngles icon port Nothing
 
+-- TODO reflect the angles for the right side sub-icons
+nestedGuardPortAngles :: Floating n => [Maybe (NodeName, Icon)] -> Port -> Maybe NodeName -> [Angle n]
+nestedGuardPortAngles args port maybeNodeName = case maybeNodeName of
+  Nothing -> guardPortAngles port
+  Just name -> case findIcon name args of
+    Nothing -> []
+    Just icon -> getPortAngles icon port Nothing
+
 getPortAngles :: (Floating n) => Icon -> Port -> Maybe NodeName -> [Angle n]
 getPortAngles icon port maybeNodeName = case icon of
   ApplyAIcon _ -> applyPortAngles port
@@ -111,8 +119,8 @@ getPortAngles icon port maybeNodeName = case icon of
   FlatLambdaIcon _ -> applyPortAngles port
   NestedApply _ args -> nestedApplyPortAngles args port maybeNodeName
   NestedPApp args -> nestedApplyPortAngles args port maybeNodeName
-  NestedCaseIcon _ -> guardPortAngles port
-  NestedGuardIcon _ -> guardPortAngles port
+  NestedCaseIcon args -> nestedGuardPortAngles args port maybeNodeName
+  NestedGuardIcon args -> nestedGuardPortAngles args port maybeNodeName
 
 -- END getPortAngles --
 
@@ -273,7 +281,7 @@ coloredTextBox :: SpecialBackend b n =>
   -> AlphaColour Double -> String -> SpecialQDiagram b n
 coloredTextBox textColor boxColor t =
   fontSize (local textBoxFontSize) (bold $ font "freemono" $ fc textColor $ text t)
-  <>  lwG (0.6 * defaultLineWidth) (lcA boxColor $ rectForText (length t))
+  <>  lwG (0.6 * defaultLineWidth) (lcA boxColor $ fcA (withOpacity (backgroundC colorScheme) 0.5) $ rectForText (length t))
 
 bindTextBox :: SpecialBackend b n =>
   String -> SpecialQDiagram b n
@@ -320,16 +328,14 @@ generalNestedGuard triangleColor lBracket bottomDia inputAndArgs name nestingLev
     finalDia = alignT (bottomDia <> makeQualifiedPort name (Port 1)) <> alignB (inputIcon === (bigVerticalLine <> guardDia <> makeQualifiedPort name (Port 0)))
 
     argPortNums = [2..]
-    innerIcons = fmap makeInnerIcon args
 
-    iconMapper portNum innerIcon
-      | even portNum = Right $ guardTriangle port ||| innerIcon
-      | otherwise = Left $ innerIcon ||| lBracket port
+    iconMapper portNum arg
+      | even portNum = Right $ guardTriangle port ||| makeInnerIcon True arg
+      | otherwise = Left $ makeInnerIcon False arg ||| lBracket port
       where
         port = makeQualifiedPort name (Port portNum)
 
-    -- TODO argPortNums is duplicated
-    (lBrackets, trianglesWithPorts) = partitionEithers $ zipWith iconMapper argPortNums innerIcons
+    (lBrackets, trianglesWithPorts) = partitionEithers $ zipWith iconMapper argPortNums args
 
     trianglesAndBrackets =
       zipWith zipper trianglesWithPorts lBrackets
@@ -338,14 +344,18 @@ generalNestedGuard triangleColor lBracket bottomDia inputAndArgs name nestingLev
       where
         verticalLine = strutY 0.4
 
-    inputIcon = makeInnerIcon input
+    inputIcon = makeInnerIcon False input
     
     guardDia = vcat (alignT trianglesAndBrackets)
     bigVerticalLine = alignT $ lwG defaultLineWidth $ lc triangleColor $ vrule (height guardDia)
 
-    makeInnerIcon mNameAndIcon = case mNameAndIcon of
+    makeInnerIcon innerReflected mNameAndIcon = case mNameAndIcon of
       Nothing -> mempty
-      Just (iconNodeName, icon) -> iconToDiagram icon iconNodeName nestingLevel reflect angle
+      Just (iconNodeName, icon) -> if innerReflected
+        then reflectX dia
+        else dia
+        where
+          dia = iconToDiagram icon iconNodeName nestingLevel (innerReflected /= reflect) angle
 
 guardLBracket :: SpecialBackend b n =>
   SpecialQDiagram b n -> SpecialQDiagram b n
diff --git a/test/VisualTranslateTests.hs b/test/VisualTranslateTests.hs
index 77ff947..1daa444 100644
--- a/test/VisualTranslateTests.hs
+++ b/test/VisualTranslateTests.hs
@@ -63,7 +63,9 @@ nestedTests = [
   "Foo (Bar x) (Baz y) = 1",
   "Foo (Bar x) = f 2",
   "Foo (Bar x) = f x",
-  "y x = case x of {Just w -> (let (z,_) = w in z)}"
+  "y x = case x of {Just w -> (let (z,_) = w in z)}",
+  "y = case x of 1 -> f 0",
+  "y (Port x) = case x of 0 -> 1"
   ]
 
 specialTests :: [String]
diff --git a/todo.md b/todo.md
index 1ee1b20..84a4afa 100644
--- a/todo.md
+++ b/todo.md
@@ -1,6 +1,10 @@
 # Todo
 
 ## Todo Now
+* Reflect the angles of the inner icons for nestedGuardPortAngles
+
+* Change the PApp icon so that from left to right it looks like: list of args, constructor name, result. If there is only one arg, then the arg port can have an additional angle of (1/2 turn).
+
 * Consider adding binding variable names to the lambda icon and match icon. Don't display the name if it is only one character.
 
 ## Todo Later