darcs - INblobs

1 module Ports

2 ( Port

3 , Ports

4 , PortName

5 , PortZone(..)

7 , isTheSameAs

8 , isInterfacePort

9 , drawPorts

10 , drawPort

11 , drawFig

12 , drawPrincipalPort

13 , portZone

14 , isUp

15 ) where

17 import Math

18 import Constants

19 import Shape

20 import CommonIO

21 import Colors

22 import Graphics.UI.WX as WX

23 import Graphics.UI.WXCore

25 {- | 'Ports' represents the extra information for a generalization of nodes in which a node have special points where it can conect with other nodes (more conrrectly the ports of other nodes).

27 Each port is represented by its name and a point relative to the center of node shape.

28 -}

30 type PortName = String

31 type Port = (PortName, DoublePoint)

33 type Ports = [Port]

35 -- | Equality on ports. Right now it is exactly the same as @(==)@.

36 isTheSameAs :: Port -> Port -> Bool

37 isTheSameAs = (==)

39 isInterfacePort :: PortName -> Bool

40 isInterfacePort = (== "interface")

42 drawPorts :: Size -> DC () -> DoublePoint -> Ports -> [Prop (DC ())] -> IO ()

43 drawPorts ppi dc centre ports options =

44 case ports of

45 [("interface",position)] -> drawPrincipalPort ppi dc centre optionsIP position

46 p -> when (not $ null p)

47 (if hasPrincipalPorts

48 then do drawPrincipalPort ppi dc centre optionsPP (snd $ head p)

49 mapM_ ( drawPort ppi dc centre optionsP . snd ) (tail p)

50 else mapM_ ( drawPort ppi dc centre optionsP . snd ) p

51 )

53 where options' = [ brushKind := BrushSolid ] ++ options

54 optionsP = [ brushColor := kPortBrushColor

55 , penColor := kPortPenColor

56 ] ++ options'

57 optionsPP = [ brushColor := kPrincipalPortBrushColor

58 , penColor := kPrincipalPortPenColor

59 ] ++ options'

60 optionsIP = [ brushColor := kInterfacePortBrushColor

61 , penColor := kInterfacePortPenColor

62 ] ++ options'

64 drawPort :: Size -> DC () -> DoublePoint -> [Prop (DC ())] -> DoublePoint -> IO ()

65 drawPort ppi dc centre options point =

66 WX.circle dc

67 (logicalToScreenPoint ppi $ translate centre point)

68 (logicalToScreenX ppi kPortRadius)

69 options

71 drawPrincipalPort :: Size -> DC () -> DoublePoint -> [Prop (DC ())] -> DoublePoint -> IO ()

72 drawPrincipalPort ppi dc centre options point =

73 WX.polygon dc points options

74 where centro = logicalToScreenPoint ppi $ translate centre point

75 param = kPrincipalPortSize

76 points =

77 [ pointMove (vector param param) centro

78 , pointMove (vector param (- param)) centro

79 , pointMove (vector (- param) (- param)) centro

80 , pointMove (vector (- param) param) centro

81 ]

83 drawFig :: DC () -> Rect -> Shape -> Ports -> [Prop (DC ())] -> IO ()

84 drawFig dc r shape ports options =

85 do{

86 -- Scale if the DC we are drawing to has a different PPI from the screen

87 ; dcPPI <- dcGetPPI dc

88 ; screenPPI <- getScreenPPI

89 ; when (dcPPI /= screenPPI) $

90 dcSetUserScale dc

91 (fromIntegral (sizeW dcPPI ) / fromIntegral (sizeW screenPPI ))

92 (fromIntegral (sizeH dcPPI ) / fromIntegral (sizeH screenPPI ))

94 -- Set font

95 ; set dc [ fontFamily := FontDefault, fontSize := 10 ]

97 ; let ppi = screenPPI

98 -- center of drawing area

99 center = screenToLogicalPoint ppi $ rectCentralPoint r

100

101 ; logicalDraw ppi dc center shape options

102 ; drawPorts ppi dc center ports options

103 }

104

105

106 data PortZone = Ztop | Zbottom | Zleft | Zright deriving (Show)

107

108 -- | Divides the 2D space with y=x and y=-x rects

109 portZone :: Port -> PortZone

110 portZone (_, DoublePoint x y) | y > x && y <= -x = Zleft

111 | y >= x && y > -x = Zbottom

112 | y < x && y >= -x = Zright

113 | y <= x && y < -x = Ztop

114

115 -- | A different division in 2D space; the port is in the upper part of the node?

116 isUp :: Port -> Bool

117 isUp (_, DoublePoint _ y) = y <= 0