Fri Oct 14 17:00:25 WEST 2005 Malcolm.Wallace@cs.york.ac.uk
* multi-line text
Fix logicalDrawText to cope with multi-line strings. There are now
justification options too. Horizontally, within the box centred at the
given location, you can justify Left, Centre, or Right. Vertically, you
can justify the box so the Top, Middle, or Bottom is on the given
location.
{
hunk ./src/NetworkView.hs 48
- (\e -> drawText dc ("Exception while drawing: " ++ show e) (pt 50 50) [])
+ (\e -> logicalText dcPPI dc (DoublePoint 50 50)
+ ("Exception while drawing: "++show e)
+ (Justify LeftJ TopJ) [] )
hunk ./src/NetworkView.hs 70
- drawNode nodeNr ( kSELECTED_OPTIONS ++ [ penColor := wxcolor activeSelectionColor ])
+ drawNode nodeNr (kSELECTED_OPTIONS
+ ++ [ penColor := wxcolor activeSelectionColor ])
hunk ./src/NetworkView.hs 91
- drawLabel above (Node.getName node) center
+ drawLabel (offset above) False (Node.getName node) center
+ (justif above) [ textColor := wxcolor kNodeLabelColour ]
hunk ./src/NetworkView.hs 95
- drawLabel (not above) (show (Node.getInfo node)) center
+ drawLabel (offset (not above)) False (show (Node.getInfo node))
+ center (justif (not above))
+ [ textColor := wxcolor kNodeInfoColour ]
hunk ./src/NetworkView.hs 104
+ offset b = (if b then negate else id) kNODE_RADIUS
+ justif b = Justify CentreJ (if b then BottomJ else TopJ)
hunk ./src/NetworkView.hs 107
- drawLabel :: Bool -> String -> DoublePoint -> IO ()
- drawLabel above text (DoublePoint x y) =
+ drawLabel :: Double -> Bool -> String -> DoublePoint -> Justify
+ -> [Prop (DC ())] -> IO ()
+ drawLabel voffset boxed text (DoublePoint x y) justify opts =
hunk ./src/NetworkView.hs 111
- (textWidth, textHeight) <- logicalGetTextExtent ppi dc text
- ; let textY = if above
- then y - kNODE_RADIUS {- - kARROW_SIZE -} - textHeight
- else y + kNODE_RADIUS {- + kARROW_SIZE -}
- textX = x - textWidth / 2
- -- horizontalMargin = 0.2 -- centimeters
- -- verticalMargin = 0.01 -- centimeters
- -- ; logicalRect ppi dc
- -- (textX - horizontalMargin) textY
- -- (textWidth+2*horizontalMargin) (textHeight+2*verticalMargin)
- -- (solidFill labelBackgroundColor)
+ when boxed $ do
+ { (textWidth, textHeight) <- logicalGetTextExtent ppi dc text
+ ; let horizontalMargin = 0.2 -- centimeters
+ verticalMargin = 0.01 -- centimeters
+ topleftY = y+voffset - case justify of
+ Justify _ TopJ -> 0
+ Justify _ MiddleJ -> textHeight/2
+ Justify _ BottomJ -> textHeight
+ [_$_]
+ ; logicalRect ppi dc
+ (x - textWidth/2 - horizontalMargin) (topleftY)
+ (textWidth+2*horizontalMargin) (textHeight+2*verticalMargin)
+ (solidFill labelBackgroundColor)
+ }
hunk ./src/NetworkView.hs 126
- ; logicalText ppi dc (DoublePoint textX textY) text []
+ ; logicalText ppi dc (DoublePoint x (y+voffset)) text justify opts
hunk ./src/NetworkView.hs 138
- drawLabel True (show info) (middle via)
+ -- logicalTextRotated ppi dc (middle via) (show info) 45
+ -- [ textColor := wxcolor kEdgeInfoColour ]
+ drawLabel 0 False (show info) (middle via)
+ (Justify CentreJ BottomJ)
+ [ textColor := wxcolor kEdgeInfoColour ]
hunk ./src/NetworkView.hs 246
-logicalText :: Size -> DC () -> DoublePoint -> String -> [Prop (DC ())] -> IO ()
-logicalText ppi dc pos txt options =
- drawText dc txt (logicalToScreenPoint ppi pos) options
+data Justify = Justify Horizontal Vertical deriving Eq
+data Horizontal = LeftJ | CentreJ | RightJ deriving Eq
+data Vertical = TopJ | MiddleJ | BottomJ deriving Eq
+
+-- can deal with multi-line text
+logicalText :: Size -> DC () -> DoublePoint -> String -> Justify
+ -> [Prop (DC ())] -> IO ()
+logicalText ppi dc (DoublePoint x y) txt (Justify horiz vert) options =
+ do{ (width,height) <- logicalGetTextExtent ppi dc txt
+ ; eachLine width (startPos height) (lines txt)
+ }
+ where
+ startPos height = case vert of TopJ -> (x, y)
+ MiddleJ -> (x, y-height/2)
+ BottomJ -> (x, y-height)
+ eachLine _ _ [] = return ()
+ eachLine maxwidth (x,y) (txt:txts) =
+ do{ (w,h) <- logicalGetTextExtent ppi dc txt
+ ; let thisX = case horiz of LeftJ -> x-maxwidth/2
+ CentreJ -> x-w/2
+ RightJ -> x+(maxwidth/2)-w
+ ; drawText dc txt (logicalToScreenPoint ppi (DoublePoint thisX y))
+ options
+ ; eachLine maxwidth (x,y+h) txts
+ }
+
+-- currently assumes only single line of text
+logicalTextRotated :: Size -> DC () -> DoublePoint -> String -> Double
+ -> [Prop (DC ())] -> IO ()
+logicalTextRotated ppi dc pos txt angle options =
+ draw dc txt (logicalToScreenPoint ppi pos) options
+ where
+ draw = if angle<1 && angle>(-1) then drawText
+ else (\a b c e -> rotatedText a b c angle e)
+
hunk ./src/NetworkView.hs 303
- do{ textSize <- getTextExtent dc txt
+ do{ textSizes <- mapM (getTextExtent dc) (lines txt)
hunk ./src/NetworkView.hs 305
- ( screenToLogicalX ppi (sizeW textSize)
- , screenToLogicalY ppi (sizeH textSize)
+ ( screenToLogicalX ppi (maximum (map sizeW textSizes))
+ , screenToLogicalY ppi (sum (map sizeH textSizes))
}