rgleichman/glance
1
1
Fork 0
mirror of https://github.com/rgleichman/glance.git synced 2024-11-30 05:47:46 +03:00
Code Issues Projects Releases Wiki Activity

Nested Apply Icon.

Browse Source
This commit is contained in:
Robbie Gleichman 2016-04-05 22:19:05 -07:00
parent 31dea15009
commit 5f958e07f2
3 changed files with 47 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
app/Icons.hs
View File

@ -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,12 +126,42 @@ 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
transformCorrectedTextBox :: SpecialBackend b =>
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
textBoxFontSize = 1

9
app/Main.hs
View File

@ -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

2
app/Types.hs
View File

@ -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)