この章では、wxHaskellの描画について紹介します。wxHaskellの描画はDC(デバイスコンテキスト)を使って行われます。DCは、グラフィックのための高度なウィジェットです。
この例ではDCに線を引きます。
module Main where
import Graphics.UI.WX
main :: IO ()
main = start gui
gui :: IO ()
gui = do
f <- frame [text := "Line"]
p <- panel f [on paint := onPaint, bgcolor := black]
set f [layout := fill (widget p)
,clientSize := sz 400 250]
return ()
where
onPaint :: DC() -> Rect -> IO ()
onPaint dc rect = do
line dc (pt 15 25) (pt 200 25) [color := white]
line dc (pt 300 35) (pt 300 200) [color := white
,penKind :=
PenDash DashShort]
let points = [(pt 55 85), (pt 155 85),
(pt 105 180), (pt 55 85)]
polyline dc points [color := white]
PenDashには、DashDot、DashLogn、DashShort、DashDotShortがあります。
この例では、DCに点を描きます。
module Main where
import Graphics.UI.WX
import Control.Monad
import System.Random
main :: IO ()
main = start gui
gui :: IO ()
gui = do
f <- frame [text := "Point"]
p <- panel f [on paint := onPaint, bgcolor := blue]
set f [layout := fill (widget p)
,clientSize := sz 280 180]
return ()
where
onPaint :: DC() -> Rect -> IO ()
onPaint dc rect = do
forM_ [1..1000] $ \_ -> onPoint
where
onPoint :: IO ()
onPoint = do
let size = rectSize rect
x <- (getStdRandom $ randomR (0, sizeW size) :: IO Int)
y <- (getStdRandom $ randomR (0, sizeH size) :: IO Int)
drawPoint dc (pt x y) [color := white]
wxHaskellのカラーは、「rgb 数値 数値 数値」というコードで、RGB(赤、緑、青)の明るさを数値で指定して作ります。この時数値は16進数(0〜f)ではなく、10進数(0〜255)で記述します。
また、次の定義済みカラーもあります。
black、darkgrey、dimgrey、mediumgrey、grey、lightgrey、white、red、green、blue、yellow、mazenta、cyan
定義済みカラーを使う場合は、コードに直接「カラー名」を記述します。
module Main where
import Graphics.UI.WX
main :: IO ()
main = start gui
gui :: IO ()
gui = do
f <- frame [text := "Color"]
p <- panel f [on paint := onPaint]
set f [layout := fill (widget p)
,clientSize := sz 400 100]
return ()
where
onPaint :: DC() -> Rect -> IO ()
onPaint dc rect = do
drawRect dc (Rect 30 10 90 80) [color := rgb 255 187 0 -- #fb0
,brushColor := rgb 255 187 0
,brushKind := BrushSolid]
drawRect dc (Rect 150 10 90 80) [color := rgb 255 85 0 -- #f50
,brushColor := rgb 255 85 0
,brushKind := BrushSolid]
drawRect dc (Rect 270 10 90 80) [color := rgb 0 85 255 -- #05f
,brushColor := rgb 0 85 255
,brushKind := BrushSolid]
DCには様々な形を描くことができます。
module Main where
import Graphics.UI.WX
main :: IO ()
main = start gui
gui :: IO ()
gui = do
f <- frame [text := "Shape"]
p <- panel f [on paint := onPaint]
set f [layout := fill (widget p)
,clientSize := sz 330 220]
return ()
where
onPaint :: DC() -> Rect -> IO ()
onPaint dc rect = do
ellipse dc (Rect 10 10 70 70) [color := rgb 255 17 17
,brushColor := rgb 17 255 17
,brushKind := BrushSolid]
ellipse dc (Rect 110 10 100 70) [color := rgb 255 17 17
,brushColor := rgb 17 255 17
,brushKind := BrushSolid]
drawRect
dc (Rect 230 10 60 50) [color := rgb 255 17 17
,brushColor := rgb 17 255 17
,brushKind := BrushSolid]
ellipticArc
dc (Rect 30 100 60 100) 0 210
[color := rgb 255 17 17
,brushColor := rgb 17 255 17
,brushKind := BrushSolid]
let points = [(pt 150 100), (pt 200 120), (pt 240 180)
,(pt 210 200), (pt 150 150), (pt 100 200)]
polygon dc points [color := rgb 255 17 17
,brushColor := rgb 17 255 17
,brushKind := BrushSolid]
return()
このサンプルでは、DCに画像を表示します。
サンプルで使用する画像はここからダウンロードできます。解凍した img フォルダをコードファイルと同じディレクトリに置いてください。
module Main where
import Graphics.UI.WX
import Graphics.UI.WXCore
main :: IO ()
main = start gui
gui :: IO ()
gui = do
bm <- bitmapCreateFromFile "img/precipice2.jpg"
size <- bitmapGetSize bm
f <- frame [text :="Image"]
p <- panel f [on paint := onPaint bm]
set f [layout := fill (widget p)
,clientSize := size]
return ()
where
onPaint :: Bitmap() -> DC() -> Rect -> IO ()
onPaint bm dc rect = do
let rsize = rectSize rect
bmsize <- bitmapGetSize bm
drawBitmap dc bm (pt (getX rsize bmsize) (getY rsize bmsize)) True []
where
getX :: Size -> Size -> Int
getX p bm = do
((sizeW p) - (sizeW bm)) `div` 2
getY :: Size -> Size -> Int
getY p bm = do
((sizeH p) - (sizeH bm)) `div` 2
この例では、DCにテキストを描画します。
module Main where
import Graphics.UI.WX
main :: IO ()
main = start gui
gui :: IO ()
gui = do
f <- frame [text := "叙情詩"]
p <- panel f [on paint := onPaint]
set f [layout := fill (widget p)
,clientSize := sz 430 250]
return ()
where
onPaint :: DC() -> Rect -> IO ()
onPaint dc rect = do
drawText dc "Most relationships seem so transitory" (pt 10 30)
[fontFace := "Purisa"]
drawText dc "They're good but not the permanent one" (pt 10 60)
[fontFace := "Purisa"]
drawText dc "Who doesn't long for someone to hold" (pt 10 110)
[fontFace := "Purisa"]
drawText dc "Who knows how to love without being told" (pt 10 140)
[fontFace := "Purisa"]
drawText dc "Somebody tell me why I'm on my own" (pt 10 170)
[fontFace := "Purisa"]
drawText dc "If there's a soulmate for everyone" (pt 10 200)
[fontFace := "Purisa"]
PurisaというフォントはLinuxにしか入っていません。