エンジニアのソフトウェア的愛情

または私は如何にして心配するのを止めてプログラムを・愛する・ようになったか

半端にOpenGLに手を出す

MonadiusがOpenGLでグラフィックを作っているのを見て、amazon:入門HaskellのさめがめをOpenGLで作り直してみようかと、中途半端にいろいろ手を出してみる。

クリックしたところに八角形を表示するのができた。ウィンドウが再表示されると表示が消えてしまいます(まだ保存の方法を考えていない)。八角形なのは、丸の描き方がわからなかったから。「q」キーでウィンドウを閉じます。

import Graphics.UI.GLUT
import Control.Exception
import System.Exit

main = do
  getArgsAndInitialize
  createWindow "Sample"
  initialDisplayMode    $= [RGBAMode]
  displayCallback       $= myDisplay
  keyboardMouseCallback $= Just keyboardMouse
  myInit
  mainLoop

myInit = do
  clearColor $= Color4 0.0 0.0 1.0 1.0

myDisplay = do
  clear [ColorBuffer]
  flush

drawPoint (x, y) = do
  -- viewportでウィンドウのサイズを取り出して、
  -- マウスでクリックした位置を-1.0〜1.0の範囲に収まる値にする。
  (pos, Size width height) <- get viewport
  let x' = (fromIntegral $ x * 2 - width) / fromIntegral width
  let y' = (fromIntegral $ y * (-2) + height) / fromIntegral height
  renderPrimitive Polygon $ mapM_ vertex 
    [
    Vertex3 (-0.07 + x') (-0.07 + y') 0.0,
    Vertex3 ( 0.00 + x') (-0.10 + y') 0.0,
    Vertex3 ( 0.07 + x') (-0.07 + y') 0.0,
    Vertex3 ( 0.10 + x') ( 0.00 + y') 0.0,
    Vertex3 ( 0.07 + x') ( 0.07 + y') 0.0,
    Vertex3 ( 0.00 + x') ( 0.10 + y') 0.0,
    Vertex3 (-0.07 + x') ( 0.07 + y') 0.0,
    Vertex3 (-0.10 + x') ( 0.00 + y') (0.0 :: GLfloat)
    ]
  flush

keyboardMouse key keystate modifiers position = do
  case (key, keystate, position) of
    (Char 'q',               _,    _           ) -> throwIO $ ExitException ExitSuccess
    (MouseButton LeftButton, Down, Position x y) -> drawPoint (x, y)
    (_,                      _,    _           ) -> return ()