Nested Apply Icon.

app/Icons.hs

@@ -14,7 +14,9 @@ module Icons
     caseIcon,
     defaultLineWidth,
     ColorStyle(..),
-    colorScheme
+    colorScheme,
+
+    nestedApplyDia
     ) where
 
 import Diagrams.Prelude
@@ -35,7 +37,7 @@ lineCol = lineC colorScheme
 
 -- FUNCTIONS --
 -- Optimization: The apply0NDia's can be memoized.
-iconToDiagram :: SpecialBackend b => Icon -> [(Name, SpecialQDiagram b)] -> Bool -> Double -> SpecialQDiagram b
+iconToDiagram :: SpecialBackend b => Icon -> [(Name, SpecialQDiagram b)] -> TransformableDia b
 iconToDiagram (ApplyAIcon n) _ = identDiaFunc $ applyADia n
 iconToDiagram (PAppIcon n str) _ = pAppDia n str
 iconToDiagram (TextApplyAIcon n str) _ = textApplyADia n str
@@ -47,6 +49,7 @@ iconToDiagram (GuardIcon n) _ = identDiaFunc $ guardIcon n
 iconToDiagram (CaseIcon n) _ = identDiaFunc $ caseIcon n
 iconToDiagram CaseResultIcon _ = identDiaFunc caseResult
 iconToDiagram (FlatLambdaIcon n) _ = identDiaFunc $ flatLambda n
+iconToDiagram (NestedApply s args) _ = nestedApplyDia s args
 iconToDiagram (LambdaRegionIcon n diagramName) nameToSubdiagramMap =
   identDiaFunc $ lambdaRegion n dia
   where
@@ -123,11 +126,41 @@ reduceAngleRange x = x - fromInteger (floor x)
 generalTextAppDia :: SpecialBackend b =>
   Colour Double -> Colour Double -> Int -> String -> Bool -> Double -> SpecialQDiagram b
 generalTextAppDia textCol borderCol numArgs str reflect angle = rotateDia where
-  rotateDia = rotateBy textBoxRotation (reflectIfTrue reflect (coloredTextBox textCol (opaque borderCol) str)) |||
+  rotateDia = transformCorrectedTextBox str textCol borderCol reflect angle |||
     coloredApplyADia borderCol numArgs
-  reducedAngle = reduceAngleRange angle
+
-  textBoxRotation = if (reducedAngle > (1/4)) && (reducedAngle < (3/4)) then 1 / 2 else 0
+transformCorrectedTextBox :: SpecialBackend b =>
-  reflectIfTrue shouldReflect dia = if shouldReflect then reflectX dia else dia
+  String -> Colour Double -> Colour Double -> TransformableDia b
+transformCorrectedTextBox str textCol borderCol reflect angle =
+  rotateBy textBoxRotation (reflectIfTrue reflect (coloredTextBox textCol (opaque borderCol) str))
+  where
+    reducedAngle = reduceAngleRange angle
+    textBoxRotation = if (reducedAngle > (1/4)) && (reducedAngle < (3/4)) then 1 / 2 else 0
+    reflectIfTrue shouldReflect dia = if shouldReflect then reflectX dia else dia
+
+
+nestedApplyDia :: SpecialBackend b =>
+  String -> [Maybe (Name, Icon)] -> TransformableDia b
+nestedApplyDia funText args reflect angle = transformedText ||| centerY finalDia
+  where
+    transformedText = transformCorrectedTextBox funText (textBoxTextC colorScheme) (apply0C colorScheme) reflect angle
+    seperation = circleRadius * 1.5
+    verticalSeperation = circleRadius
+    appColor = apply0C colorScheme
+    n = length args
+    trianglePortsCircle = hsep seperation $
+      reflectX (fc appColor apply0Triangle) :
+      zipWith makeInnerIcon [2,3..] args ++
+      [makePort 1 <> alignR (circle circleRadius # fc appColor # lwG defaultLineWidth # lc appColor)]
+
+    allPorts = makePort 0 <> alignL trianglePortsCircle
+    topAndBottomLineWidth = width allPorts - circleRadius
+    argBox = rect topAndBottomLineWidth (height allPorts + verticalSeperation)# lc appColor # lwG defaultLineWidth # alignL
+    finalDia = argBox <> allPorts
+
+    makeInnerIcon portNum Nothing = makePort portNum <> portCircle
+    makeInnerIcon portNum (Just (iconName, icon)) = nameDiagram iconName $ iconToDiagram icon [] reflect angle
+
 
 -- TEXT ICON --
 textBoxFontSize :: (Num a) => a

app/Main.hs

@@ -5,7 +5,7 @@ import Diagrams.Prelude
 import Diagrams.Backend.SVG.CmdLine
 import qualified Language.Haskell.Exts as Exts
 
-import Icons(flatLambda, textBox, colorScheme, ColorStyle(..))
+import Icons(flatLambda, textBox, colorScheme, ColorStyle(..), nestedApplyDia)
 import Rendering(renderDrawing)
 import Util(toNames, portToPort, iconToPort, iconToIcon,
   iconToIconEnds, iconTailToPort)
@@ -257,7 +257,10 @@ main1 = do
   placedNodes <- renderDrawing factLam0Drawing
   mainWith ((placedNodes # bgFrame 1 (backgroundC colorScheme)) :: Diagram B)
 
-main2 = mainWith ((flatLambda 3 # bgFrame 0.1 black)  :: Diagram B)
+main2 = mainWith ((dia False 0 # bgFrame 0.1 black)  :: Diagram B)
+  where
+    args = [Nothing, Just (toName "foo", TextBoxIcon "3"), Just (toName "in", NestedApply "inner" [Just (toName "t", TextBoxIcon "t")])]
+    dia = nestedApplyDia "Hello world" args
 
 main3 :: IO ()
 main3 = do
@@ -493,4 +496,4 @@ main5 = do
 
 
 main :: IO ()
-main = main4
+main = main2

app/Types.hs

@@ -29,6 +29,8 @@ data Icon = ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int
   | LambdaRegionIcon Int Name | FlatLambdaIcon Int | ApplyAIcon Int
   | TextApplyAIcon Int String | PAppIcon Int String | CaseIcon Int | CaseResultIcon
   | BindTextBoxIcon String
+  -- TODO: NestedApply should have the type NestedApply (Maybe (Name, Icon)) [Maybe (Name, Icon)]
+  | NestedApply String [Maybe (Name, Icon)]
   deriving (Show)
 
 data NameAndPort = NameAndPort Name (Maybe Int) deriving (Show)