mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Change icon transformation to make it more composable.
This commit is contained in:
parent
80673a35ca
commit
f331e8dca8
53
app/Icons.hs
53
app/Icons.hs
@ -109,7 +109,7 @@ 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)
|
||||
type TransformableDia a b c d = (Bool -> Double -> QDiagram a b c d)
|
||||
|
||||
-- FUNCTIONS --
|
||||
-- Optimization: The apply0NDia's can be memoized.
|
||||
@ -118,35 +118,36 @@ type TransformableDia a b c d = (Bool -> Float -> QDiagram a b c d)
|
||||
-- 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 (BindTextBoxIcon s) _ = makeSymmetricTransDia $ bindTextBox s
|
||||
iconToDiagram (GuardIcon n) _ = makeTransformableDia $ guardIcon n
|
||||
iconToDiagram (CaseIcon n) _ = makeTransformableDia $ caseIcon n
|
||||
iconToDiagram CaseResultIcon _ = makeSymmetricTransDia caseResult
|
||||
iconToDiagram (FlatLambdaIcon n) _ = makeSymmetricTransDia $ flatLambda n
|
||||
Icon -> [(Name, QDiagram b V2 Double Any)] -> Bool -> Double -> QDiagram b V2 Double Any
|
||||
iconToDiagram (ApplyAIcon n) _ = identDiaFunc $ applyADia n
|
||||
iconToDiagram (PAppIcon n str) _ = diaFunc $ pAppDia n str
|
||||
iconToDiagram (TextApplyAIcon n str) _ = diaFunc $ textApplyADia n str
|
||||
iconToDiagram ResultIcon _ = identDiaFunc resultIcon
|
||||
iconToDiagram BranchIcon _ = identDiaFunc branchIcon
|
||||
iconToDiagram (TextBoxIcon s) _ = identDiaFunc $ textBox s
|
||||
iconToDiagram (BindTextBoxIcon s) _ = identDiaFunc $ bindTextBox s
|
||||
iconToDiagram (GuardIcon n) _ = identDiaFunc $ guardIcon n
|
||||
iconToDiagram (CaseIcon n) _ = identDiaFunc $ caseIcon n
|
||||
iconToDiagram CaseResultIcon _ = identDiaFunc caseResult
|
||||
iconToDiagram (FlatLambdaIcon n) _ = identDiaFunc $ flatLambda n
|
||||
iconToDiagram (LambdaRegionIcon n diagramName) nameToSubdiagramMap =
|
||||
makeTransformableDia $ lambdaRegion n dia
|
||||
identDiaFunc $ 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))
|
||||
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)
|
||||
-- Make an identity TransformableDia
|
||||
identDiaFunc :: _ => QDiagram b V2 n m -> TransformableDia b V2 n m
|
||||
identDiaFunc dia _ _ = 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
|
||||
--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)
|
||||
diaFunc dia reflect angle = dia reflect 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
|
||||
@ -200,7 +201,7 @@ applyA0Dia ::
|
||||
(RealFloat n, Typeable n, Monoid m, Semigroup m,
|
||||
TrailLike (QDiagram b V2 n m)) =>
|
||||
QDiagram b V2 n m
|
||||
applyA0Dia = ((resultCircle ||| apply0Line ||| (fc (apply0C colorScheme) apply0Triangle)) <> makePortDiagrams apply0PortLocations) # reflectX # centerXY
|
||||
applyA0Dia = ((resultCircle ||| apply0Line ||| fc (apply0C colorScheme) apply0Triangle) <> makePortDiagrams apply0PortLocations) # reflectX # centerXY
|
||||
|
||||
apply0PortLocations :: Floating a => [P2 a]
|
||||
apply0PortLocations = map p2 [
|
||||
@ -241,18 +242,20 @@ applyADia = coloredApplyADia (apply0C colorScheme)
|
||||
|
||||
--textApplyADia :: _ => Int -> String -> QDiagram b V2 n m
|
||||
textApplyADia :: _ =>
|
||||
Int -> String -> Double -> QDiagram b V2 Double Any
|
||||
Int -> String -> TransformableDia b V2 Double Any
|
||||
textApplyADia = generalTextAppDia (textBoxTextC colorScheme) (apply0C colorScheme)
|
||||
|
||||
pAppDia :: _ =>
|
||||
Int -> String -> Double -> QDiagram b V2 Double Any
|
||||
Int -> String -> TransformableDia b V2 Double Any
|
||||
pAppDia = generalTextAppDia (patternTextC colorScheme) (patternC colorScheme)
|
||||
|
||||
generalTextAppDia textCol borderCol numArgs str angle = rotateDia where
|
||||
rotateDia = rotateBy angle $ (rotateBy textBoxRotation (coloredTextBox textCol (opaque borderCol) str)) |||
|
||||
generalTextAppDia :: _ => Colour Double -> Colour Double -> Int -> String -> Bool -> Double -> QDiagram b V2 n Any
|
||||
generalTextAppDia textCol borderCol numArgs str reflect angle = rotateDia where
|
||||
rotateDia = rotateBy textBoxRotation (reflectIfTrue reflect (coloredTextBox textCol (opaque borderCol) str)) |||
|
||||
coloredApplyADia borderCol numArgs
|
||||
reducedAngle = reduceAngleRange angle
|
||||
textBoxRotation = if (reducedAngle > (1/4)) && (reducedAngle < (3/4)) then (1/2) else 0
|
||||
textBoxRotation = if (reducedAngle > (1/4)) && (reducedAngle < (3/4)) then 1 / 2 else 0
|
||||
reflectIfTrue shouldReflect dia = if shouldReflect then reflectX dia else dia
|
||||
|
||||
-- TEXT ICON --
|
||||
textBoxFontSize :: (Num a) => a
|
||||
|
10
app/Main.hs
10
app/Main.hs
@ -15,7 +15,7 @@ import Translate(translateString, drawingsFromModule)
|
||||
|
||||
-- TODO Now --
|
||||
-- Clean up Rendering and Icons.
|
||||
-- Test case x of {0 -> 1; y -> y}, see if the second match forms a loop.
|
||||
|
||||
-- Refactor Translate
|
||||
-- Add documentation.
|
||||
-- Update readme.
|
||||
@ -31,6 +31,11 @@ import Translate(translateString, drawingsFromModule)
|
||||
-- Give lines a black border to make line crossings easier to see.
|
||||
-- Give lines that cross the border of a lambda function a special color.
|
||||
|
||||
-- Translate todos:
|
||||
-- Fix test case x of {0 -> 1; y -> y}.
|
||||
|
||||
-- Have icon rotation just rotate internal items, not the entire diagram.
|
||||
-- Use a nested tree layout. A graph can take an optional (name, Icon) as filling a port.
|
||||
-- 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.
|
||||
@ -338,7 +343,8 @@ caseTests = [
|
||||
"y = case x of {Foo a -> a}",
|
||||
"y = case x of {Foo a -> f a; Bar a -> f a}",
|
||||
"y = case x of {F x -> x; G x -> x}",
|
||||
"y = case x of {F -> 0; G -> 1}"
|
||||
"y = case x of {F -> 0; G -> 1}",
|
||||
"z = case x of {0 -> 1; y -> y}"
|
||||
]
|
||||
|
||||
guardTests = [
|
||||
|
@ -60,7 +60,7 @@ drawingToGraphvizScaleFactor = 0.15
|
||||
-- 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 name))
|
||||
map (\(name, icon) -> (name, iconToDiagram icon subDiagramMap))
|
||||
|
||||
-- | Make an inductive Graph from a list of node names, and a list of Connections.
|
||||
edgesToGraph :: [Name] -> [(NameAndPort, NameAndPort)] -> Gr Name ()
|
||||
@ -187,13 +187,13 @@ rotateNodes ::
|
||||
-> [(Name, QDiagram b V2 Double m)]
|
||||
rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap
|
||||
where
|
||||
rotateDiagram (name, originalDia) = (name, transformedDia)
|
||||
rotateDiagram (name, originalDia) = (name, nameDiagram name transformedDia)
|
||||
where
|
||||
transformedDia = if flippedDist < unflippedDist
|
||||
then originalDia True flippedAngle
|
||||
else originalDia False unflippedAngle
|
||||
then rotateBy flippedAngle . reflectX $ originalDia True flippedAngle
|
||||
else rotateBy unflippedAngle $ originalDia False unflippedAngle
|
||||
(unflippedAngle, unflippedDist) = minAngleForDia (originalDia False 0)
|
||||
(flippedAngle, flippedDist) = minAngleForDia (originalDia True 0)
|
||||
(flippedAngle, flippedDist) = minAngleForDia (reflectX $ 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
|
||||
@ -206,7 +206,9 @@ rotateNodes positionMap nameDiagramMap edges = map rotateDiagram nameDiagramMap
|
||||
getPortPoint :: Int -> P2 Double
|
||||
getPortPoint x =
|
||||
-- TODO remove partial function head.
|
||||
head $ fromMaybeError ("port not found. Port: " ++ show name ++ ".> " ++ show x ++ ". Valid ports: " ++ show ports) (lookup (name .> x) ports)
|
||||
head $ fromMaybeError
|
||||
("rotateNodes: port not found. Port: " ++ show x ++ ". Valid ports: " ++ show ports)
|
||||
(lookup (toName x) ports)
|
||||
|
||||
makePortEdge :: (Int, Name, Maybe Int) -> (P2 Double, P2 Double)
|
||||
makePortEdge (portInt, otherIconName, _) =
|
||||
|
Loading…
Reference in New Issue
Block a user