wxHaskell 描画

ホーム   目次

この章では、wxHaskellの描画について紹介します。wxHaskellの描画はDC(デバイスコンテキスト)を使って行われます。DCは、グラフィックのための高度なウィジェットです。


この例ではDCに線を引きます。

line.hs


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に点を描きます。

point.hs


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

定義済みカラーを使う場合は、コードに直接「カラー名」を記述します。

color.hs


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には様々な形を描くことができます。

shape.hs


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 フォルダをコードファイルと同じディレクトリに置いてください。

image.hs


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にテキストを描画します。

text.hs


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にしか入っていません。


21530 visits
Posted: Jan. 13, 2019
Update: Jan. 14, 2019

ホーム   目次   ページトップ