OpenGL Перспектива

import Graphics.UI.GLUT
import Data.IORef
import Data.Array

type F = GLfloat
type D = GLdouble

main = do
	getArgsAndInitialize
	createWindow "win"
	depthFunc $= Just Less
	st <- newIORef (-45,-45) :: IO (IORef (F,F))
	sc <- newIORef 0.1 :: IO (IORef F)
	fr <- newIORef (1,listArray (1,4) (replicate 4 1)) :: IO (IORef (Int,Array Int D))
	displayCallback $= onDraw st sc fr
	keyboardMouseCallback $= Just (onKey st sc fr)
	mainLoop

onKey :: IORef (F,F) -> IORef F -> IORef (Int,Array Int D) -> Key -> KeyState -> Modifiers -> Position -> IO()
onKey v sc _ (SpecialKey k) Down _ _ = case k of
	{
		KeyLeft	-> modifyIORef v (\(x,y) -> (x,y+1));
		KeyRight-> modifyIORef v (\(x,y) -> (x,y-1));
		KeyUp	-> modifyIORef v (\(x,y) -> (x-1,y));
		KeyDown -> modifyIORef v (\(x,y) -> (x+1,y));
		KeyPageUp	-> modifyIORef sc (*0.9);
		KeyPageDown -> modifyIORef sc (/0.9);
		_		-> return()
	} >> postRedisplay Nothing
onKey _ _ fr (Char c) Down _ _
	| c == '=' = modifyIORef fr (\(p,a) -> (p,a//[(p,a!p + d)])) >> postRedisplay Nothing
	| c == '-' = modifyIORef fr (\(p,a) -> (p,a//[(p,a!p - d)])) >> postRedisplay Nothing
	| c >= '0' && c <= '9' = modifyIORef fr (\(_,a) -> (read [c],a)) >> print c
	| c == 'p' = readIORef fr >>= print
	| otherwise = return()
	where d = 0.1
onKey _ _ _ _ _ _ _ = return()

onDraw :: IORef (F,F) -> IORef F -> IORef (Int,Array Int D) -> IO()
onDraw st sc fr = do
	clear [ColorBuffer,DepthBuffer]
	matrixMode $= Projection
	loadIdentity
	(Size w h) <- get windowSize
--	an <- readIORef fr
	perspective 90 ((fromIntegral w) / (fromIntegral h)) 0.1 50
--	readIORef fr >>= \(_,a) -> (\[fovy,aspect,near,far] -> perspective fovy aspect near far) (elems a)
	matrixMode $= Modelview 0
	loadIdentity
	readIORef st >>= \(x,y) -> rot x 1 0 0 >> rot y 0 1 0 
	readIORef sc >>= \s -> scale s s s
	kub
	flush

kub = do
	cl 1 1 1
	preservingMatrix $ trn 0 0 (-1) >> sq
	cl 1 0.5 0.5
	preservingMatrix $ trn 0 0 1 >> sq
	cl 0.5 0.5 1
	preservingMatrix (rot 90 0 1 0 >> trn 0 0 1 >> sq >> 
		cl 0.5 0.5 0.5 >> trn 0 0 (-2) >> sq)
	cl 0 0.8 0.2
	preservingMatrix (rot 90 1 0 0 >> trn 0 0 1 >> sq >>
		cl 0 0.9 0.8 >> trn 0 0 (-2) >> sq)

cl,trn :: F -> F -> F -> IO()
cl r g b = color (Color3 r g b)

trn x y z = translate$ Vector3 x y z

rot :: F -> F -> F -> F -> IO()
rot a x y z = rotate a $ Vector3 x y z

sq = renderPrimitive Polygon$ mapM_ vertex [Vertex3 (-1 :: F) (-1) 0, Vertex3 (-1) 1 0, Vertex3 1 1 0, Vertex3 1 (-1) 0]