mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Keep text upright.
This commit is contained in:
parent
3852a8a492
commit
cab82b66dd
65
app/Icons.hs
65
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
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user