Make the args of pattern apply nodes vertical to make embedding cases nicer.

app/GraphAlgorithms.hs

@@ -36,7 +36,7 @@ syntaxNodeIsEmbeddable parentType n mParentPort = case (parentType, n) of
   (ApplyParent, LikeApplyNode _ _) -> notResultPort
   (ApplyParent, LiteralNode _) -> notResultPort
   (CaseOrGuardParent, LiteralNode _) -> notResultPort
-  (CaseOrGuardParent, LikeApplyNode _ _) -> notResultPort
+  (CaseOrGuardParent, LikeApplyNode _ _) -> notResultPort && notInputPort
   (CaseOrGuardParent, NestedPatternApplyNode _ _) -> notResultPort && notInputPort
   _ -> False
   where

app/Icons.hs

@@ -55,7 +55,7 @@ iconToDiagram icon = case icon of
   CaseResultIcon -> identDiaFunc caseResult
   FlatLambdaIcon n -> identDiaFunc $ flatLambda n
   NestedApply flavor args -> nestedApplyDia flavor args
-  NestedPApp args -> generalNestedDia apply0Triangle (repeat $ patternC colorScheme) args
+  NestedPApp args -> nestedPAppDia (repeat $ patternC colorScheme) args
   NestedCaseIcon args -> nestedCaseDia args
   NestedGuardIcon args -> nestedGuardDia args
 
@@ -68,6 +68,12 @@ applyPortAngles (Port x) = fmap (@@ turn) $ case x of
   1 -> [0]
   _ -> [1/4, 3/4]
 
+pAppPortAngles :: Floating n => Port -> [Angle n]
+pAppPortAngles (Port x) = fmap (@@ turn) $ case x of
+  0 -> [1/4]
+  1 -> [0]
+  _ -> [1/2]
+
 guardPortAngles :: Floating n => Port -> [Angle n]
 guardPortAngles (Port port) = case port of
   0 -> [1/4 @@ turn]
@@ -91,16 +97,17 @@ findIcon name args = icon where
     Nothing -> listToMaybe $ catMaybes $ fmap findSubSubIcon filteredArgs
     Just (argNum, (_, finalIcon)) -> Just (argNum, finalIcon)
     where
-      findSubSubIcon (argNum, (_, icon)) = case findNestedIcon name icon of
+      findSubSubIcon (argNum, (_, subIcon)) = case findNestedIcon name subIcon of
         Nothing -> Nothing
         Just x -> Just (argNum, x)
-  
-nestedApplyPortAngles :: SpecialNum n => [Maybe (NodeName, Icon)] -> Port -> Maybe NodeName -> [Angle n]
-nestedApplyPortAngles args port maybeNodeName = case maybeNodeName of
-  Nothing -> applyPortAngles port
+
+generalNestedPortAngles :: SpecialNum n =>
+  (Port -> [Angle n]) -> [Maybe (NodeName, Icon)] -> Port -> Maybe NodeName -> [Angle n]
+generalNestedPortAngles defaultAngles args port maybeNodeName = case maybeNodeName of
+  Nothing -> defaultAngles port
   Just name -> case findIcon name args of
     Nothing -> []
-    Just (argNum, icon) -> getPortAngles icon port Nothing
+    Just (_, icon) -> getPortAngles icon port Nothing
 
 reflectXAngle :: SpecialNum n => Angle n -> Angle n
 reflectXAngle x = reflectedAngle where
@@ -109,7 +116,7 @@ reflectXAngle x = reflectedAngle where
 
 -- TODO reflect the angles for the right side sub-icons
 nestedGuardPortAngles :: SpecialNum n => [Maybe (NodeName, Icon)] -> Port -> Maybe NodeName -> [Angle n]
-nestedGuardPortAngles args port@(Port portInt) maybeNodeName = case maybeNodeName of
+nestedGuardPortAngles args port maybeNodeName = case maybeNodeName of
   Nothing -> guardPortAngles port
   Just name -> case findIcon name args of
     Nothing -> []
@@ -118,7 +125,7 @@ nestedGuardPortAngles args port@(Port portInt) maybeNodeName = case maybeNodeNam
     Just (argNum, icon) -> if odd argNum && argNum >= 1
       -- The icon will be reflected
       then fmap reflectXAngle subAngles
-      else subAngles --fmap reflectXAngle subAngles
+      else subAngles
       where
         subAngles = getPortAngles icon port Nothing
 
@@ -133,8 +140,8 @@ getPortAngles icon port maybeNodeName = case icon of
   CaseIcon _ -> guardPortAngles port
   CaseResultIcon -> []
   FlatLambdaIcon _ -> applyPortAngles port
-  NestedApply _ args -> nestedApplyPortAngles args port maybeNodeName
-  NestedPApp args -> nestedApplyPortAngles args port maybeNodeName
+  NestedApply _ args -> generalNestedPortAngles applyPortAngles args port maybeNodeName
+  NestedPApp args -> generalNestedPortAngles pAppPortAngles args port maybeNodeName
   NestedCaseIcon args -> nestedGuardPortAngles args port maybeNodeName
   NestedGuardIcon args -> nestedGuardPortAngles args port maybeNodeName
 
@@ -213,6 +220,38 @@ generalTextAppDia textCol borderCol numArgs str name _ reflect angle = nameDiagr
   rotateDia = transformCorrectedTextBox str textCol borderCol reflect angle |||
     coloredApplyADia borderCol numArgs
 
+-- TODO Refactor with generalNestedDia
+nestedPAppDia :: SpecialBackend b n =>
+  [Colour Double] -> [Maybe (NodeName, Icon)] -> TransformableDia b n
+nestedPAppDia borderCols funcNodeNameAndArgs name nestingLevel reflect angle = named name $ case funcNodeNameAndArgs of
+  [] -> mempty
+  (maybeFunText:args) -> centerXY $ centerY finalDia ||| transformedText ||| resultCircleAndPort
+    where
+      borderCol = borderCols !! nestingLevel
+
+      transformedText = case maybeFunText of
+        Just _ -> makeInnerIcon True 0 maybeFunText
+        Nothing -> mempty
+      separation = circleRadius * 1.5
+      verticalSeparation = circleRadius
+      resultCircleAndPort = makeQualifiedPort name (Port 1) <> alignR (lc borderCol $ lwG defaultLineWidth $ fc borderCol $ circle circleRadius)
+      triangleAndPorts = vsep separation $
+        rotate quarterTurn (apply0Triangle borderCol) :
+        zipWith (makeInnerIcon False) [2,3..] args
+
+  
+      allPorts = makeQualifiedPort name (Port 0) <> alignT triangleAndPorts -- alignL (strutX separation ||| trianglePortsCircle)
+      topAndBottomLineWidth = width allPorts
+      -- boxHeight = height 
+      argBox = alignT $ lwG defaultLineWidth $ lc borderCol $ roundedRect topAndBottomLineWidth (height allPorts + verticalSeparation) (circleRadius * 0.5)
+      finalDia = argBox <> allPorts
+
+      makeInnerIcon _ portNum Nothing = makeQualifiedPort name (Port portNum) <> portCircle
+      makeInnerIcon True _ (Just (_, TextBoxIcon t)) = transformCorrectedTextBox t (textBoxTextC colorScheme) borderCol reflect angle
+      makeInnerIcon func _ (Just (iconNodeName, icon)) = iconToDiagram icon iconNodeName innerLevel reflect angle where
+        innerLevel = if func then nestingLevel else nestingLevel + 1
+  
+
 generalNestedDia :: SpecialBackend b n =>
   (Colour Double -> SpecialQDiagram b n) -> [Colour Double] -> [Maybe (NodeName, Icon)] -> TransformableDia b n
 generalNestedDia dia borderCols funcNodeNameAndArgs name nestingLevel reflect angle = named name $ case funcNodeNameAndArgs of

examples/tutorial.hs

@@ -196,8 +196,8 @@ y = (((2 + 4 * 4) - (7+ 2 + baz)*8)/21)
 (Just x) = Just 3
 
 {-
-Since constructors are functions, the match icon has the same shape as
-the apply icon. The match icon is magenta to help distinguish
+Since constructors are functions, the match icon has a same shape similar
+to the apply icon. The match icon is magenta to help distinguish
 it from the apply icon. In a future iteration of the Glance icons, the match and
 apply icons should be made more dissimilar so that they can not be confused with
 each other, even when displaying Glance drawings in black and white.

todo.md

@@ -1,7 +1,7 @@
 # Todo
 
 ## Todo Now
-* 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).
+* Don't allow guards to embed patterns. This is only happening because @ values come from the PApp, not the actual source.
 
 * Consider adding binding variable names to the lambda icon and match icon. Don't display the name if it is only one character.