module Ports ( Port , Ports , PortName , PortZone(..) , isTheSameAs , isInterfacePort , drawPorts , drawPort , drawFig , drawPrincipalPort , portZone , isUp ) where import Math import Constants import Shape import CommonIO import Colors import Graphics.UI.WX as WX import Graphics.UI.WXCore {- | '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). Each port is represented by its name and a point relative to the center of node shape. -} type PortName = String type Port = (PortName, DoublePoint) type Ports = [Port] -- | Equality on ports. Right now it is exactly the same as @(==)@. isTheSameAs :: Port -> Port -> Bool isTheSameAs = (==) isInterfacePort :: PortName -> Bool isInterfacePort = (== "interface") drawPorts :: Size -> DC () -> DoublePoint -> Ports -> [Prop (DC ())] -> IO () drawPorts ppi dc centre ports options = case ports of [("interface",position)] -> drawPrincipalPort ppi dc centre optionsIP position p -> when (not $ null p) (if hasPrincipalPorts then do drawPrincipalPort ppi dc centre optionsPP (snd $ head p) mapM_ ( drawPort ppi dc centre optionsP . snd ) (tail p) else mapM_ ( drawPort ppi dc centre optionsP . snd ) p ) where options' = [ brushKind := BrushSolid ] ++ options optionsP = [ brushColor := kPortBrushColor , penColor := kPortPenColor ] ++ options' optionsPP = [ brushColor := kPrincipalPortBrushColor , penColor := kPrincipalPortPenColor ] ++ options' optionsIP = [ brushColor := kInterfacePortBrushColor , penColor := kInterfacePortPenColor ] ++ options' drawPort :: Size -> DC () -> DoublePoint -> [Prop (DC ())] -> DoublePoint -> IO () drawPort ppi dc centre options point = WX.circle dc (logicalToScreenPoint ppi $ translate centre point) (logicalToScreenX ppi kPortRadius) options drawPrincipalPort :: Size -> DC () -> DoublePoint -> [Prop (DC ())] -> DoublePoint -> IO () drawPrincipalPort ppi dc centre options point = WX.polygon dc points options where centro = logicalToScreenPoint ppi $ translate centre point param = kPrincipalPortSize points = [ pointMove (vector param param) centro , pointMove (vector param (- param)) centro , pointMove (vector (- param) (- param)) centro , pointMove (vector (- param) param) centro ] drawFig :: DC () -> Rect -> Shape -> Ports -> [Prop (DC ())] -> IO () drawFig dc r shape ports options = do{ -- Scale if the DC we are drawing to has a different PPI from the screen ; dcPPI <- dcGetPPI dc ; screenPPI <- getScreenPPI ; when (dcPPI /= screenPPI) $ dcSetUserScale dc (fromIntegral (sizeW dcPPI ) / fromIntegral (sizeW screenPPI )) (fromIntegral (sizeH dcPPI ) / fromIntegral (sizeH screenPPI )) -- Set font ; set dc [ fontFamily := FontDefault, fontSize := 10 ] ; let ppi = screenPPI -- center of drawing area center = screenToLogicalPoint ppi $ rectCentralPoint r ; logicalDraw ppi dc center shape options ; drawPorts ppi dc center ports options } data PortZone = Ztop | Zbottom | Zleft | Zright deriving (Show) -- | Divides the 2D space with y=x and y=-x rects portZone :: Port -> PortZone portZone (_, DoublePoint x y) | y > x && y <= -x = Zleft | y >= x && y > -x = Zbottom | y < x && y >= -x = Zright | y <= x && y < -x = Ztop -- | A different division in 2D space; the port is in the upper part of the node? isUp :: Port -> Bool isUp (_, DoublePoint _ y) = y <= 0