Life Goes On

まあまあだけど楽しんでる方です

Gtk2Hs(Carino)でお絵描き

ユーザインタフェースってどうも苦手で、Java でも Swing とか使ったことないのですが、お絵かきに挑戦してみました。
HaskellGUI を作るには、wxHaskell とか Gtk2Hs とかあるらしい。とりあえずサンプルが簡単に見つかった Gtk2Hs を選択。↓からダウンロードしてインストール
Downloads
プログラムの書き方は↓に分かりやすい例が載ってました。
http://home.telfort.nl/sp969709/gtk2hs/app1.html
お、なんか絵が出た!

どんな単位で関数を分割したらいいのか、まだよく分かりません。

import Data.Array
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.Events
import Graphics.Rendering.Cairo

maxWidth, maxHeight, offset :: Double
maxWidth = 500
maxHeight = 500
offset = 100

paintAndDraw :: Array Int (Double, Double) -> [Int] -> Render()
paintAndDraw ps is = do
    setSourceRGB 0 0 0
    paint
    setSourceRGB 1 1 0
    uncurry moveTo (ps ! last is)
    mapM_ (uncurry lineTo) $ map (ps!) is
    stroke

updateCanvas :: DrawingArea -> Render () -> Event -> IO Bool
updateCanvas canvas act e = do
    win <- widgetGetDrawWindow canvas
    renderWithDrawable win act
    return $ eventSent e

display :: String -> IO()
display name = do
    tsp <- readFile $ name++".tsp"
    tour <- readFile $ name++".tour"
    let dim = read $ words (lines tsp !! 3) !! 2
    let points = map ((\[_,x,y]->(read x,read y)).words) $ take dim $ drop 6 $ lines tsp
    let xmin = minimum $ map fst points
    let xmax = maximum $ map fst points
    let ymin = minimum $ map snd points
    let ymax = maximum $ map snd points
    let m = min (maxWidth/(xmax-xmin)) (maxHeight/(ymax-ymin))
    let pArray = listArray (1,dim) $ map (\(x,y)->(offset+(x-xmin)*m,offset+(ymax-y)*m)) points
    let indices = map read $ take dim $ drop 6 $ lines tour
    print dim
    initGUI
    window <- windowNew
    set window [windowTitle := "TSP Result : " ++ name,
                windowDefaultWidth := floor $ (xmax-xmin)*m+2*offset,
                windowDefaultHeight := floor $ (ymax-ymin)*m+2*offset ]
    frame <- frameNew
    containerAdd window frame
    canvas <- drawingAreaNew
    containerAdd frame canvas
    widgetShowAll window
    canvas `onExpose` updateCanvas canvas (paintAndDraw pArray indices)
    window `onDestroy` mainQuit
    mainGUI