1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
module GraphicsFont(
Font,
mkFont, withFont,
createFont, deleteFont,
) where
import GraphicsTypes
import GraphicsUtilities( bracket, bracket_ )
import qualified Win32
----------------------------------------------------------------
newtype Font = MkFont Win32.HFONT
mkFont :: Point -> Angle -> Bool -> Bool -> String ->
(Font -> Picture) -> Picture
withFont :: Font -> Picture -> Picture
createFont :: Point -> Angle -> Bool -> Bool -> String -> IO Font
deleteFont :: Font -> IO ()
----------------------------------------------------------------
mkFont size angle bold italic family p = \ hdc ->
bracket (createFont size angle bold italic family) deleteFont $ \ font ->
p font hdc
withFont (MkFont f) p hdc =
bracket_ (Win32.selectFont hdc f)
(Win32.selectFont hdc)
(p hdc)
createFont (width, height) escapement bold italic family =
Win32.createFont (fromDimension height) (fromDimension width)
(round (escapement * 1800/pi))
0 -- orientation
weight
italic False False -- italic, underline, strikeout
Win32.aNSI_CHARSET
Win32.oUT_DEFAULT_PRECIS
Win32.cLIP_DEFAULT_PRECIS
Win32.dEFAULT_QUALITY
Win32.dEFAULT_PITCH
family
>>= return . MkFont
where
weight | bold = Win32.fW_BOLD
| otherwise = Win32.fW_NORMAL
deleteFont (MkFont f) = Win32.deleteFont f
|
