Keep text upright.

app/Icons.hs

@@ -100,27 +100,44 @@ randomColorScheme = ColorStyle {
 lineCol :: (Floating a, Ord a) => Colour a
 lineCol = lineC colorScheme
 
+type TransformableDia a b c d = (Bool -> Float -> QDiagram a b c d)
+
 -- FUNCTIONS --
 -- Optimization: The apply0NDia's can be memoized.
-iconToDiagram ::
-   (RealFloat n, Typeable n, Renderable (Path V2 n) b,
-      Renderable (Text n) b) =>
-     Icon -> [(Name, QDiagram b V2 n Any)] -> QDiagram b V2 n Any
-iconToDiagram (ApplyAIcon n) _ = applyADia n
-iconToDiagram (PAppIcon n str) _ = pAppDia n str
-iconToDiagram (TextApplyAIcon n str) _ = textApplyADia n str
-iconToDiagram ResultIcon _ = resultIcon
-iconToDiagram BranchIcon _ = branchIcon
-iconToDiagram (TextBoxIcon s) _ = textBox s
-iconToDiagram (GuardIcon n) _ = guardIcon n
-iconToDiagram (CaseIcon n) _ = caseIcon n
-iconToDiagram CaseResultIcon _ = caseResult
-iconToDiagram (FlatLambdaIcon n) _ = flatLambda n
+-- iconToDiagram ::
+--    (RealFloat n, Typeable n, Renderable (Path V2 n) b,
+--       Renderable (Text n) b) =>
+--      Icon -> [(Name, QDiagram b V2 n Any)] -> TransformableDia b V2 n Any
+iconToDiagram ::_ =>
+  Icon -> [(Name, QDiagram b V2 Double Any)] -> nm -> Bool -> Double -> QDiagram b V2 Double Any
+iconToDiagram (ApplyAIcon n) _ = makeSymmetricTransDia $ applyADia n
+iconToDiagram (PAppIcon n str) _ = makeRotateSymmetricTransDia $ pAppDia n str
+iconToDiagram (TextApplyAIcon n str) _ = makeRotateSymmetricTransDia $ textApplyADia n str
+iconToDiagram ResultIcon _ = makeSymmetricTransDia resultIcon
+iconToDiagram BranchIcon _ = makeSymmetricTransDia branchIcon
+iconToDiagram (TextBoxIcon s) _ = makeSymmetricTransDia $ textBox s
+iconToDiagram (GuardIcon n) _ = makeTransformableDia $ guardIcon n
+iconToDiagram (CaseIcon n) _ = makeTransformableDia $ caseIcon n
+iconToDiagram CaseResultIcon _ = makeSymmetricTransDia caseResult
+iconToDiagram (FlatLambdaIcon n) _ = makeSymmetricTransDia $ flatLambda n
 iconToDiagram (LambdaRegionIcon n diagramName) nameToSubdiagramMap =
-  lambdaRegion n dia
+  makeTransformableDia $ lambdaRegion n dia
   where
     dia = fromMaybeError "iconToDiagram: subdiagram not found" $ lookup diagramName nameToSubdiagramMap
 
+--Get the decimal part of a float
+--reduceAngleRange :: Double -> Double
+reduceAngleRange :: Double -> Double
+reduceAngleRange x = x - (fromInteger (floor x))
+
+makeTransformableDia :: _ => QDiagram b V2 n m -> nm -> Bool -> n -> QDiagram b V2 n m
+makeTransformableDia dia nm reflect angle = nameDiagram nm $ rotateBy angle (if reflect then reflectX dia else dia)
+
+--makeSymmetricTransDia :: _ => QDiagram b V2 n m -> nm -> Bool -> n -> QDiagram b V2 n m
+makeSymmetricTransDia dia nm reflect angle = nameDiagram nm $ rotateBy (if reflect then angle + (1/2) else angle) dia
+
+makeRotateSymmetricTransDia dia nm reflect angle = nameDiagram nm $ dia (if reflect then angle + (1/2) else angle)
+
 -- | Names the diagram and puts all sub-names in the namespace of the top level name.
 nameDiagram :: (Floating n, Ord n, Semigroup m, Metric v, IsName nm) => nm -> QDiagram b v n m -> QDiagram b v n m
 nameDiagram name dia = named name (name .>> dia)
@@ -211,14 +228,18 @@ applyADia n = finalDia # centerXY where
   finalDia = topAndBottomLine === allPorts === topAndBottomLine
 
 --textApplyADia :: _ => Int -> String -> QDiagram b V2 n m
-textApplyADia :: (RealFloat n, Typeable n, Renderable (Path V2 n) b,
-  Renderable (Text n) b) =>
-  Int -> String -> QDiagram b V2 n Any
-textApplyADia numArgs functionName = textBox functionName ||| applyADia numArgs
+textApplyADia :: _ =>
+  Int -> String -> Double -> QDiagram b V2 Double Any
+textApplyADia = generalTextAppDia (textBoxTextC colorScheme) (opaque lineCol)
 
-pAppDia numArgs constructorName =
-  coloredTextBox (patternTextC colorScheme) (opaque (patternC colorScheme)) constructorName
-  ||| applyADia numArgs
+pAppDia :: _ =>
+  Int -> String -> Double -> QDiagram b V2 Double Any
+pAppDia = generalTextAppDia (patternTextC colorScheme) (opaque (patternC colorScheme))
+
+generalTextAppDia textCol borderCol numArgs str angle = rotateDia where
+  rotateDia = rotateBy angle $ (rotateBy textBoxRotation (coloredTextBox textCol borderCol str)) ||| applyADia numArgs
+  reducedAngle = reduceAngleRange angle
+  textBoxRotation = if (reducedAngle > (1/4)) && (reducedAngle < (3/4)) then (1/2) else 0
 
 -- TEXT ICON --
 textBoxFontSize :: (Num a) => a

app/Main.hs

@@ -30,7 +30,6 @@ import Translate(translateString, drawingsFromModule)
 -- Use clustered graphs. Make a test project.
 -- Consider making lines between patterns Pattern Color when the line is a reference.
 -- Consider using seperate parameter icons in functions.
--- Make constructors in patterns PatternColor.
 -- Add function name and type to LambdaIcons.
 -- Add proper RecConstr, and RecUpdate support.
 -- Let each bool, value pair in Guard icon be flipped to reduce line crossings. Do the same for case.

app/Rendering.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies #-}
+{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, TypeFamilies, PartialTypeSignatures #-}
 
 module Rendering (
   renderDrawing
@@ -50,12 +50,14 @@ drawingToGraphvizScaleFactor = 0.4
 -- The first argument is the subdiagram map used for the inside of lambdaIcons
 -- The second argument is the map of icons that should be converted to diagrams.
 --makeNamedMap :: IsName name => [(Name, Diagram B)] -> [(name, Icon)] -> [(name, Diagram B)]
-makeNamedMap ::
-   (RealFloat n, Typeable n, Renderable (Path V2 n) b,
-      Renderable (Diagrams.TwoD.Text.Text n) b, IsName nm) =>
-     [(Name, QDiagram b V2 n Any)]-> [(nm, Icon)] -> [(nm, QDiagram b V2 n Any)]
+
+--
+-- makeNamedMap ::
+--    (RealFloat n, Typeable n, Renderable (Path V2 n) b,
+--       Renderable (Diagrams.TwoD.Text.Text n) b, IsName nm) =>
+--      [(Name, QDiagram b V2 n Any)]-> [(nm, Icon)] -> [(nm, QDiagram b V2 n Any)]
 makeNamedMap subDiagramMap =
-  map (\(name, icon) -> (name, iconToDiagram icon subDiagramMap # nameDiagram name))
+  map (\(name, icon) -> (name, iconToDiagram icon subDiagramMap name))
 
 -- | Make an inductive Graph from a list of node names, and a list of Connections.
 edgesToGraph :: [Name] -> [(NameAndPort, NameAndPort)] -> Gr Name ()
@@ -177,7 +179,7 @@ connectedPorts edges name = map edgeToPort $ filter nameInEdge edges
 rotateNodes ::
    Semigroup m =>
      Map.Map Name (Point V2 Double)
-     -> [(Name, QDiagram b V2 Double m)]
+     -> [(Name, Bool -> Double -> QDiagram b V2 Double m)]
      -> [Connection]
      -> [(Name, QDiagram b V2 Double m)]
 rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap
@@ -185,11 +187,10 @@ rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap
     rotateDiagram (name, originalDia) = (name, transformedDia)
       where
         transformedDia = if flippedDist < unflippedDist
-          then rotateBy flippedAngle flippedDia
-          else rotateBy unflippedAngle originalDia
-        flippedDia = reflectX originalDia
-        (unflippedAngle, unflippedDist) = minAngleForDia originalDia
-        (flippedAngle, flippedDist) = minAngleForDia flippedDia
+          then originalDia True flippedAngle
+          else originalDia False unflippedAngle
+        (unflippedAngle, unflippedDist) = minAngleForDia (originalDia False 0)
+        (flippedAngle, flippedDist) = minAngleForDia (originalDia True 0)
         --minAngleForDia :: QDiagram b V2 Double m -> (Double, Double)
         minAngleForDia dia = minAngle where
         --ports = Debug.Trace.trace ((show $ names dia) ++ "\n") $ names dia
@@ -216,7 +217,7 @@ type LayoutResult a = Gr (GV.AttributeNode Name) (GV.AttributeNode a)
 placeNodes ::
    (Monoid m, Semigroup m) =>
      LayoutResult a
-     -> [(Name, QDiagram b V2 Double m)]
+     -> [(Name, Bool -> Double -> QDiagram b V2 Double m)]
      -> [Connection]
      -> QDiagram b V2 Double m
 placeNodes layoutResult nameDiagramMap edges = mconcat placedNodes
@@ -229,9 +230,9 @@ placeNodes layoutResult nameDiagramMap edges = mconcat placedNodes
     placeNode (name, diagram) = place (diagram # centerXY) (scaleFactor *^ (positionMap Map.! name))
 
 doGraphLayout ::
-   (Monoid m, Semigroup m) =>
+   _ =>
      Gr Name e
-     -> [(Name, QDiagram b V2 Double m)]
+     -> [(Name, Bool -> Double -> QDiagram b V2 Double m)]
      -> [Connection]
      -> IO (QDiagram b V2 Double m)
 doGraphLayout graph nameDiagramMap edges = do
@@ -264,7 +265,8 @@ doGraphLayout graph nameDiagramMap edges = do
       where
         --todo: Hack! Using (!!) here relies upon the implementation of Diagrams.TwoD.GraphViz.mkGraph
         -- to name the nodes in order
-        (_, dia) = nameDiagramMap !! nodeInt
+        (_, unTransformedDia) = (nameDiagramMap !! nodeInt)
+        dia = unTransformedDia False 0
 
         diaWidth = drawingToGraphvizScaleFactor * (width dia)
         diaHeight = drawingToGraphvizScaleFactor * (height dia)
@@ -275,9 +277,8 @@ doGraphLayout graph nameDiagramMap edges = do
 -- | Given a Drawing, produce a Diagram complete with rotated/flipped icons and
 -- lines connecting ports and icons. IO is needed for the GraphViz layout.
 renderDrawing ::
-   (Renderable (Path V2 Double) b,
-      Renderable (Text Double) b) =>
-     Drawing -> IO (QDiagram b V2 Double Any)
+  _ =>
+  Drawing -> IO (QDiagram b V2 Double Any)
 renderDrawing (Drawing nameIconMap edges subDrawings) = do
   subDiagramMap <- traverse renderSubDrawing subDrawings
   let diagramMap = makeNamedMap subDiagramMap nameIconMap