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 ()