diff --git a/app/Icons.hs b/app/Icons.hs index 462c1ad..11171da 100644 --- a/app/Icons.hs +++ b/app/Icons.hs @@ -22,7 +22,7 @@ import Diagrams.TwoD.Text(Text) import Data.Maybe (fromMaybe) import Data.Typeable(Typeable) -import Types(Icon(..), Edge(..)) +import Types(Icon(..)) -- COLO(U)RS -- colorScheme :: (Floating a, Ord a) => ColorStyle a @@ -121,11 +121,12 @@ makePortDiagrams points = atPoints points (map makePort ([0,1..] :: [Int])) -- CONSTANTS -- +defaultLineWidth :: (Fractional a) => a defaultLineWidth = 0.15 -- APPLY0 ICON -- +circleRadius :: (Fractional a) => a circleRadius = 0.5 -apply0LineWidth = defaultLineWidth type GeneralDiagram b = (Transformable b, RealFloat (N b), Typeable (N b), HasStyle b, TrailLike b, V b ~ V2) => b @@ -143,7 +144,7 @@ apply0Triangle = eqTriangle (2 * circleRadius) # rotateBy (-1/12) # fc (apply0C apply0Line :: (Typeable (N b), HasStyle b, TrailLike b, V b ~ V2) => b -apply0Line = rect apply0LineWidth (2 * circleRadius) # fc lineCol # lw none +apply0Line = rect defaultLineWidth (2 * circleRadius) # fc lineCol # lw none --apply0Dia :: (Juxtaposable a, Semigroup a) => GeneralDiagram a apply0Dia :: @@ -154,13 +155,13 @@ apply0Dia = (resultCircle ||| apply0Line ||| apply0Triangle) <> makePortDiagrams apply0PortLocations :: Floating a => [P2 a] apply0PortLocations = map p2 [ - (circleRadius + apply0LineWidth + triangleWidth, 0), + (circleRadius + defaultLineWidth + triangleWidth, 0), (lineCenter,circleRadius), (-circleRadius,0), (lineCenter,-circleRadius)] where triangleWidth = circleRadius * sqrt 3 - lineCenter = circleRadius + (apply0LineWidth / 2.0) + lineCenter = circleRadius + (defaultLineWidth / 2.0) -- apply0N Icon-- -- | apply0N port locations: @@ -184,8 +185,11 @@ apply0NDia n = finalDia # centerXY where finalDia = topAndBottomLine === allPorts === topAndBottomLine -- TEXT ICON -- +textBoxFontSize :: (Num a) => a textBoxFontSize = 1 +monoLetterWidthToHeightFraction :: (Fractional a) => a monoLetterWidthToHeightFraction = 0.6 +textBoxHeightFactor :: (Fractional a) => a textBoxHeightFactor = 1.1 textBox :: @@ -247,6 +251,7 @@ branchIcon :: GeneralDiagram a branchIcon = circle 0.3 # fc lineCol # lc lineCol -- GUARD ICON -- +guardSize :: (Fractional a) => a guardSize = 0.7 guardTriangle :: @@ -282,6 +287,6 @@ guardIcon n = centerXY $ makePort 1 <> alignB (vcat (take n trianglesAndBrackets lBrackets = map guardLBracket [3, 5..] trianglesAndBrackets = zipWith zipper trianglesWithPorts lBrackets - zipper tri lBrack = verticalLine === ((lBrack # extrudeRight guardSize) # alignR <> (tri # alignL)) + zipper thisTriangle lBrack = verticalLine === ((lBrack # extrudeRight guardSize) # alignR <> (thisTriangle # alignL)) where verticalLine = vrule 0.4 # lc lineCol # lwG defaultLineWidth diff --git a/app/Main.hs b/app/Main.hs index 5d5aefd..38ed88c 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,14 +4,10 @@ module Main where import Diagrams.Prelude import Diagrams.Backend.SVG.CmdLine -import Data.Maybe (fromMaybe) - -import Data.Typeable(Typeable) - -import Icons(guardIcon, apply0NDia, colorScheme, ColorStyle(..)) +import Icons(apply0NDia, colorScheme, ColorStyle(..)) import Rendering(renderDrawing) import Util(toNames, portToPort, iconToPort, iconToIcon, - iconToIconEnds, iconHeadToPort, iconTailToPort) + iconToIconEnds, iconTailToPort) import Types(Icon(..), Drawing(..), EdgeEnd(..)) -- TODO Now -- diff --git a/app/Rendering.hs b/app/Rendering.hs index 88c4571..1b8313b 100644 --- a/app/Rendering.hs +++ b/app/Rendering.hs @@ -14,7 +14,7 @@ import qualified Data.GraphViz.Attributes.Complete as GVA --import Data.GraphViz.Commands import qualified Data.Map as Map import Data.Maybe(fromMaybe, isJust) -import qualified Debug.Trace +--import qualified Debug.Trace import Data.List(minimumBy) import Data.Function(on) import Data.Graph.Inductive.PatriciaTree (Gr) @@ -24,6 +24,7 @@ import Icons(colorScheme, Icon(..), iconToDiagram, nameDiagram, defaultLineWidth import Types(Edge(..), Connection, Drawing(..), EdgeEnd(..)) -- CONSTANT +scaleFactor :: (Fractional a) => a scaleFactor = 0.02 --scaleFactor = 0.04 @@ -42,7 +43,7 @@ makeNamedMap subDiagramMap = -- | Make an inductive Graph from a list of node names, and a list of Connections. edgesToGraph :: (Ord v) => [v] -> [(v, t, v , t1)] -> Gr v () -edgesToGraph names edges = mkGraph names simpleEdges +edgesToGraph iconNames edges = mkGraph iconNames simpleEdges where simpleEdges = map (\(a, _, c, _) -> (a, c, ())) edges @@ -79,9 +80,6 @@ getArrowOpts (t, h) = arrowOptions & shaftStyle %~ lwG defaultLineWidth . lc (lineC colorScheme) & lookupTail t & lookupHead h -plainLine :: (RealFloat n, Typeable n) => ArrowOpts n -plainLine = getArrowOpts (EndNone, EndNone) - -- | Given an Edge, return a transformation on Diagrams that will draw a line. connectMaybePorts :: (RealFloat n, Typeable n, Renderable (Path V2 n) b) => @@ -110,8 +108,8 @@ fromMaybeError s = fromMaybe (error s) -- ROTATING/FLIPPING ICONS -- -printSelf :: (Show a) => a -> a -printSelf a = Debug.Trace.trace (show a ++ "/n") a +--printSelf :: (Show a) => a -> a +--printSelf a = Debug.Trace.trace (show a ++ "/n") a {-# ANN totalLenghtOfLines "HLint: ignore Redundant bracket" #-} {-# ANN totalLenghtOfLines "HLint: ignore Move brackets to avoid $" #-} @@ -151,11 +149,11 @@ connectedPorts :: [Connection] -> Name -> [(Int, Name, Maybe Int)] connectedPorts edges name = map edgeToPort $ filter nameInEdge edges where isPort = isJust - nameInEdge (n1, p1, n2, p2) = (name == n1 && isPort p1) || (name == n2 && isPort p2) - edgeToPort (n1, p1, n2, p2) = - if name == n1 - then (fromMaybeError "connectedPorts: port is Nothing" p1, n2, p2) - else (fromMaybeError "connectedPorts: port is Nothing" p2, n1, p1) + nameInEdge (name1, port1, name2, port2) = (name == name1 && isPort port1) || (name == name2 && isPort port2) + edgeToPort (name1, port1, name2, port2) = + if name == name1 + then (fromMaybeError "connectedPorts: port is Nothing" port1, name2, port2) + else (fromMaybeError "connectedPorts: port is Nothing" port2, name1, port1) -- | rotateNodes rotates the nodes such that the distance of its connecting lines -- are minimized. @@ -169,13 +167,13 @@ rotateNodes :: -> [(Name, QDiagram b V2 Double m)] rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap where - rotateDiagram (name, dia) = (name, transformedDia) + rotateDiagram (name, originalDia) = (name, transformedDia) where transformedDia = if flippedDist < unflippedDist then rotateBy flippedAngle flippedDia - else rotateBy unflippedAngle dia - flippedDia = reflectX dia - (unflippedAngle, unflippedDist) = minAngleForDia dia + else rotateBy unflippedAngle originalDia + flippedDia = reflectX originalDia + (unflippedAngle, unflippedDist) = minAngleForDia originalDia (flippedAngle, flippedDist) = minAngleForDia flippedDia --minAngleForDia :: QDiagram b V2 Double m -> (Double, Double) minAngleForDia dia = minAngle where @@ -188,6 +186,7 @@ rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap getPortPoint :: Int -> P2 Double getPortPoint x = + -- TODO remove partial function head. head $ fromMaybeError "port not found" (lookup (name .> x) ports) makePortEdge :: (Int, Name, Maybe Int) -> (P2 Double, P2 Double)