mirror of
https://github.com/rgleichman/glance.git
synced 2024-10-27 01:03:23 +03:00
Add argument dots to Apply0N. Add a fact2 example that uses the apply argument to distrubute the factorial function argument.
This commit is contained in:
parent
3c105a7a89
commit
77761e9611
@ -141,10 +141,10 @@ apply0PortLocations = map p2 [
|
|||||||
|
|
||||||
apply0NDia :: Int -> Diagram B
|
apply0NDia :: Int -> Diagram B
|
||||||
apply0NDia n = finalDia # centerXY where
|
apply0NDia n = finalDia # centerXY where
|
||||||
seperation = 0.6
|
seperation = circleRadius * 1.5
|
||||||
trianglePortsCircle = hcat [
|
trianglePortsCircle = hcat [
|
||||||
reflectX apply0Triangle,
|
reflectX apply0Triangle,
|
||||||
hcat $ take n $ map (\x -> makePort x <> strutX seperation) [2,3..],
|
hcat $ take n $ map (\x -> makePort x <> circle (circleRadius * 0.5) # fc lineCol <> strutX seperation) [2,3..],
|
||||||
makePort 1 <> alignR (circle circleRadius # fc (apply0C colorScheme) # lwG defaultLineWidth # lc (apply0C colorScheme))
|
makePort 1 <> alignR (circle circleRadius # fc (apply0C colorScheme) # lwG defaultLineWidth # lc (apply0C colorScheme))
|
||||||
]
|
]
|
||||||
allPorts = makePort 0 <> alignL trianglePortsCircle
|
allPorts = makePort 0 <> alignL trianglePortsCircle
|
||||||
|
43
app/Main.hs
43
app/Main.hs
@ -8,7 +8,7 @@ import Data.Maybe (fromMaybe)
|
|||||||
|
|
||||||
import Data.Typeable(Typeable)
|
import Data.Typeable(Typeable)
|
||||||
|
|
||||||
import Icons(guardIcon, colorScheme, ColorStyle(..))
|
import Icons(guardIcon, apply0NDia, colorScheme, ColorStyle(..))
|
||||||
import Rendering(toNames, portToPort, iconToPort, iconToIcon,
|
import Rendering(toNames, portToPort, iconToPort, iconToIcon,
|
||||||
iconToIconEnds, iconHeadToPort, iconTailToPort, renderDrawing)
|
iconToIconEnds, iconHeadToPort, iconTailToPort, renderDrawing)
|
||||||
import Types(Icon(..), Drawing(..), EdgeEnd(..))
|
import Types(Icon(..), Drawing(..), EdgeEnd(..))
|
||||||
@ -176,6 +176,45 @@ fact1Drawing = Drawing fact1Icons fact1Edges []
|
|||||||
|
|
||||||
factLam1Drawing = Drawing factLam0Icons factLam0Edges [(fact0Name, fact1Drawing)]
|
factLam1Drawing = Drawing factLam0Icons factLam0Edges [(fact0Name, fact1Drawing)]
|
||||||
|
|
||||||
|
-- fact2 is like fact1, but uses fTimesAp port 2 to distrubute the argument,
|
||||||
|
-- not fArg
|
||||||
|
fact2Icons = toNames
|
||||||
|
[
|
||||||
|
(fG0, GuardIcon 2),
|
||||||
|
(fOne, TextBoxIcon "1"),
|
||||||
|
(fEq0, TextBoxIcon "== 0"),
|
||||||
|
(fMinus1, TextBoxIcon fMinus1),
|
||||||
|
(fTimes, TextBoxIcon fTimes),
|
||||||
|
(fRecurAp, Apply0Icon),
|
||||||
|
(fTimesAp, Apply0NIcon 2),
|
||||||
|
--(fArg, BranchIcon),
|
||||||
|
(fRes, ResultIcon)
|
||||||
|
]
|
||||||
|
|
||||||
|
fact2Edges = [
|
||||||
|
--iconToIconEnds fArg EndNone fEq0 EndAp1Arg,
|
||||||
|
iconTailToPort fEq0 EndAp1Arg fTimesAp 2,
|
||||||
|
iconTailToPort fEq0 EndAp1Result fG0 3,
|
||||||
|
--iconToIconEnds fArg EndNone fMinus1 EndAp1Arg,
|
||||||
|
iconTailToPort fMinus1 EndAp1Arg fTimesAp 2,
|
||||||
|
iconTailToPort fMinus1 EndAp1Result fRecurAp 1,
|
||||||
|
iconToPort fTimes fTimesAp 0,
|
||||||
|
iconToPort fOne fG0 2,
|
||||||
|
portToPort fTimesAp 1 fG0 4,
|
||||||
|
portToPort fRecurAp 2 fTimesAp 3,
|
||||||
|
--iconToPort fArg fTimesAp 2,
|
||||||
|
iconToPort fRes fG0 0
|
||||||
|
]
|
||||||
|
|
||||||
|
fact2Drawing = Drawing fact2Icons fact2Edges []
|
||||||
|
|
||||||
|
factLam2Edges = [
|
||||||
|
iconToPort ("lam0" .> fTimesAp .> (2 :: Int)) "lam0" 0,
|
||||||
|
iconToPort "lam0" ("lam0" .> fRecurAp) 0,
|
||||||
|
iconToIcon "lam0" "fac"
|
||||||
|
]
|
||||||
|
factLam2Drawing = Drawing factLam0Icons factLam2Edges [(fact0Name, fact2Drawing)]
|
||||||
|
|
||||||
(arr1, arr2, arr3, arr4) = ("arr1", "arr2", "arr3", "arr4")
|
(arr1, arr2, arr3, arr4) = ("arr1", "arr2", "arr3", "arr4")
|
||||||
|
|
||||||
arrowTestIcons = toNames [
|
arrowTestIcons = toNames [
|
||||||
@ -199,7 +238,7 @@ main1 = do
|
|||||||
placedNodes <- renderDrawing factLam1Drawing
|
placedNodes <- renderDrawing factLam1Drawing
|
||||||
mainWith (placedNodes # bgFrame 1 (backgroundC colorScheme))
|
mainWith (placedNodes # bgFrame 1 (backgroundC colorScheme))
|
||||||
|
|
||||||
main2 = mainWith (guardIcon 3 # bgFrame 0.1 black)
|
main2 = mainWith (apply0NDia 3 # bgFrame 0.1 black)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = main1
|
main = main1
|
||||||
|
@ -96,7 +96,7 @@ getArrowOpts (t, h) = arrowOptions
|
|||||||
lookupTail EndAp1Result = (arrowTail .~ arg1ResT) . (tailTexture .~ ap1ResultTexture)
|
lookupTail EndAp1Result = (arrowTail .~ arg1ResT) . (tailTexture .~ ap1ResultTexture)
|
||||||
|
|
||||||
lookupHead EndNone = id
|
lookupHead EndNone = id
|
||||||
lookupHead EndAp1Arg = (arrowHead .~ arrowheadDart (0.4 @@ turn))
|
lookupHead EndAp1Arg = (arrowHead .~ dart)
|
||||||
. (headTexture .~ ap1ArgTexture) . (headStyle %~ ap1ArgStyle)
|
. (headTexture .~ ap1ArgTexture) . (headStyle %~ ap1ArgStyle)
|
||||||
lookupHead EndAp1Result = (arrowHead .~ arg1ResH) . (headTexture .~ ap1ResultTexture)
|
lookupHead EndAp1Result = (arrowHead .~ arg1ResH) . (headTexture .~ ap1ResultTexture)
|
||||||
|
|
||||||
|
File diff suppressed because one or more lines are too long
Before Width: | Height: | Size: 24 KiB After Width: | Height: | Size: 25 KiB |
Loading…
Reference in New Issue
Block a user