fin

Main.hs

module Main where

--import Control.Monad
--import Data.Maybe

--import qualified Irg.Matrix as M
--import qualified Irg.Vector as V
import Data.List (sort,unfoldr)
import qualified Graphics.GL.Compatibility33 as GL
import qualified Graphics.UI.GLUT as GLUT
import Graphics.UI.GLUT (($=))

getWindowSize :: Num a => IO (a, a)
getWindowSize = do
  GLUT.Size width height <- GLUT.get GLUT.windowSize
  return (fromIntegral width,fromIntegral height)

bresenham :: (Num a, Ord a) => (a, a) -> (a, a) -> [(a, a)]
bresenham pa@(xa,ya) pb@(xb,yb) = map maySwitch . unfoldr go $ (x1,y1,0)
  where
    steep = abs (yb - ya) > abs (xb - xa)
    maySwitch = if steep then (\(x,y) -> (y,x)) else id
    [(x1,y1),(x2,y2)] = sort [maySwitch pa, maySwitch pb]
    deltax = x2 - x1
    deltay = abs (y2 - y1)
    ystep = if y1 < y2 then 1 else -1
    go (xTemp, yTemp, errory)
        | xTemp > x2 = Nothing
        | otherwise  = Just ((xTemp, yTemp), (xTemp + 1, newY, newError))
        where
          tempError = errory + deltay
          (newY, newError) = if (2*tempError) >= deltax
                            then (yTemp+ystep,tempError-deltax)
                            else (yTemp,tempError)

reshapeCallback :: GLUT.Size -> IO ()
reshapeCallback (GLUT.Size newWidth newHeight) = do
  GL.glViewport 0 0 newWidth newHeight
  GL.glMatrixMode GL.GL_PROJECTION
  GL.glLoadIdentity
  GLUT.ortho2D 0 (fromIntegral newWidth) (fromIntegral newHeight) 0
  GL.glMatrixMode GL.GL_MODELVIEW
  GL.glLoadIdentity

  GL.glClearColor 1 1 1 0
  GL.glClear GL.GL_COLOR_BUFFER_BIT
  let minFat = 1.0
  GL.glLineWidth minFat
  GL.glPointSize minFat
  GL.glColor3f 0 0 0

keyboardCallback :: Char -> GLUT.Position -> IO ()
keyboardCallback key (GLUT.Position x y) = do
  print key >> print x >> print y

  case key of
    '\r' -> GLUT.leaveMainLoop
    'r'  -> GL.glColor3f 1 0 0
    'g'  -> GL.glColor3f 0 1 0
    'b'  -> GL.glColor3f 0 0 1
    'k'  -> GL.glColor3f 0 0 0
    _    -> return ()

  (w, h) <- getWindowSize
  GL.glRecti w h (w-20) (h-20)
  GL.glFlush


mouseCallback :: GLUT.MouseButton -> GLUT.KeyState -> GLUT.Position -> IO ()
mouseCallback GLUT.LeftButton GLUT.Down (GLUT.Position x y) = do
  GL.glBegin GL.GL_LINES
  GL.glVertex2f (fromIntegral x+30) (fromIntegral y)
  GL.glVertex2f 30 0
  GL.glEnd
  --GL.glFlush
  GL.glBegin GL.GL_POINTS
  mapM_ (uncurry GL.glVertex2i) $ bresenham (0, 0) (fromIntegral x, fromIntegral y)
  GL.glEnd

mouseCallback GLUT.RightButton GLUT.Down _ = GLUT.get GLUT.windowSize >>= reshapeCallback
mouseCallback _ _ _ = return ()

withWindow :: IO ()
withWindow = do
  _ <- GLUT.initialize "irg" []
  GLUT.initialWindowPosition $= GLUT.Position 100 100
  GLUT.initialWindowSize $= GLUT.Size 600 400
  GLUT.initialDisplayMode $= [GLUT.RGBAMode]
  GLUT.actionOnWindowClose $= GLUT.MainLoopReturns

  _ <- GLUT.createWindow "irg"

  GLUT.reshapeCallback $= Just reshapeCallback
  GLUT.displayCallback $= GLUT.flush
  GLUT.keyboardCallback $= Just keyboardCallback
  GLUT.mouseCallback $= Just mouseCallback
  print "Start end"

  GLUT.get GLUT.initState >>= print
  GLUT.get GLUT.glVersion >>= print

  GLUT.mainLoop

main :: IO()
main = putStrLn "Hi!"