← Back to branch summary

~ubuntu-branches/ubuntu/utopic/carettah/utopic

« back to all changes in this revision

Viewing changes to Render.hs

  • Committer: Package Import Robot
  • Author(s): Kiwamu Okabe
  • Date: 2012-05-13 21:52:34 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20120513215234-16l2iawob5vxrmd3
Tags: 0.1.2-1
New upstream version

Show diffs side-by-side

added added

removed removed

Lines of Context:
Render.hs
24
24
toDouble = fromIntegral
25
25
 
26
26
type LayoutFunc = G.PangoLayout -> G.Markup -> IO ()
 
27
type LayoutFuncGlowing = String -> CXy -> Double -> String -> IO (G.PangoLayout, G.PangoLayout, Double, Double)
27
28
 
28
29
stringToLayout :: String -> LayoutFunc -> CXy -> Double -> String -> IO (G.PangoLayout, Double, Double)
29
 
stringToLayout fname lFun (x, _) fsize text = do
 
30
stringToLayout fname func (x, _) fsize text = do
30
31
  lay <- G.cairoCreateContext Nothing >>= G.layoutEmpty
31
 
  void $ lFun lay text
 
32
  void $ func lay text
32
33
  G.layoutSetWrap lay G.WrapPartialWords
33
34
  setAW lay x
34
35
  fd <- liftIO G.fontDescriptionNew
53
54
truePosition _ _ (x', y') =
54
55
  error $ "called with x=" ++ show x' ++ " y=" ++ show y'
55
56
 
56
 
renderLayout' :: String -> LayoutFunc -> CXy -> Double -> String -> C.Render Double
57
 
renderLayout' fname lFun (x, y) fsize text = do
 
57
stringToLayoutGlowing :: LayoutFunc -> LayoutFunc -> LayoutFuncGlowing
 
58
stringToLayoutGlowing funcBack funcFront fname xy fsize text = do
 
59
  (layB, _, _) <- stringToLayout fname funcBack xy fsize text
 
60
  (lay, lw, lh) <- stringToLayout fname funcFront xy fsize text
 
61
  return (layB, lay, lw, lh)
 
62
 
 
63
renderLayout' :: String -> LayoutFuncGlowing -> CXy -> Double -> String -> C.Render Double
 
64
renderLayout' fname func (x, y) fsize text = do
58
65
  C.save
59
 
  (lay, lw, lh) <- liftIO $ stringToLayout fname lFun (x, y) fsize text
 
66
  (layB, lay, lw, lh) <- liftIO $ func fname (x, y) fsize text
60
67
  let (xt, yt) = truePosition fsize lw (x, y)
61
 
  C.moveTo xt yt
62
 
  G.showLayout lay
 
68
  mapM_ (moveShowLayout layB) 
 
69
    [(xt + xd, yt + yd) | xd <- [-0.7, 0.7], yd <- [-0.7, 0.7]]
 
70
  moveShowLayout lay (xt, yt)
63
71
  C.restore
64
72
  return $ yt + lh
 
73
  where
 
74
    moveShowLayout l (x', y') = C.moveTo x' y' >> G.showLayout l
65
75
 
66
76
renderLayoutM :: CXy -> Double -> String -> C.Render Double
67
 
renderLayoutM = renderLayout' "IPA P明朝" G.layoutSetText
 
77
renderLayoutM = 
 
78
  renderLayout' "IPA P明朝" (stringToLayoutGlowing fb ff)
 
79
  where
 
80
    fb l t = void $ G.layoutSetMarkup l ("<span foreground=\"white\">" ++ G.escapeMarkup t ++ "</span>")
 
81
    ff = G.layoutSetText
68
82
 
69
 
renderLayoutG' :: LayoutFunc -> CXy -> Double -> String -> C.Render Double
 
83
renderLayoutG' :: LayoutFuncGlowing -> CXy -> Double -> String -> C.Render Double
70
84
renderLayoutG' = renderLayout' "IPAゴシック"
71
85
 
72
86
renderLayoutG :: Attr -> CXy -> Double -> String -> C.Render Double
73
 
renderLayoutG (_, [], _) xy fs txt = 
74
 
  renderLayoutG' G.layoutSetText xy fs txt
75
 
renderLayoutG (_, classs, _) xy fs txt =
76
 
  renderLayoutG' f xy fs txt'
77
 
    where
78
 
      txt' = formatPangoMarkup (head classs) txt
79
 
      f l t = void $ G.layoutSetMarkup l t
 
87
renderLayoutG (_, [], _) = 
 
88
  renderLayoutG' (stringToLayoutGlowing fb ff)
 
89
  where
 
90
    fb l t = void $ G.layoutSetMarkup l ("<span foreground=\"white\">" ++ G.escapeMarkup t ++ "</span>")
 
91
    ff = G.layoutSetText
 
92
renderLayoutG (_, classs, _) =
 
93
  renderLayoutG' (stringToLayoutGlowing fb ff)
 
94
  where
 
95
    fb l t = void $ G.layoutSetMarkup l (formatPangoMarkupWhite (head classs) t)
 
96
    ff l t = void $ G.layoutSetMarkup l (formatPangoMarkup (head classs) t)
80
97
 
81
98
renderSurface :: Double -> Double -> Double -> C.Surface -> C.Render ()
82
99
renderSurface x y alpha surface = do