module Render ( getAspectRatio , getRenderFunctions , setViewport ) where import Control.Monad import Data.Array import Data.Char import Data.IORef import Foreign.Marshal import Graphics.UI.GLFW import Graphics.Rendering.OpenGL hiding (position) import Actor as A import Game import GraphUtils import Level import Text import Vector hudHeight = 0.2 solid :: GLfloat solid = 1 fullLevelSize = addBorder . levelSize where addBorder (w,h) = (w+2,h+2) getAspectRatio level = fromIntegral lh / fromIntegral lw + hudHeight where (lw,lh) = fullLevelSize level setViewport ref size@(Size w h) = do lr <- readIORef ref let r = (fromIntegral h/fromIntegral w) r' = recip r lr' = recip lr s = 2*min (max 1 (min lr' r')) (max (r/lr) lr') viewport $= (Position 0 0,size) matrixMode $= Projection loadIdentity scale (s*min 1 r) (s*min 1 r') (1 :: GLfloat) translate $ Vector3 (-0.5) (-0.5*lr) (0 :: GLfloat) matrixMode $= Modelview 0 setAspectRatio ref val = do writeIORef ref val setViewport ref =<< get windowSize getRenderFunctions aspectRatio charset = do let displayText = uncurry displayString charset rgbOverlay <- createTexture 24 24 True $ flip pokeArray $ concat [if b then [95,95,95,255] else c | y <- [0..23], x <- [0..23], let c = case x `div` 4 `mod` 3 of 0 -> [255,191,191,255] 1 -> [191,255,191,255] 2 -> [191,191,255,255] b = x `mod` 4 == 0 || x < 12 && y `mod` 12 == 0 || x >= 12 && y `mod` 12 == 6 ] return (renderGame aspectRatio displayText rgbOverlay ,renderMenu aspectRatio displayText rgbOverlay ) renderMenu aspectRatio displayText rgbOverlay score items item = do let charSize = 0.006 textCol = Color4 1 0 0 solid activeCol = Color4 0.93 0.79 0 solid menu = "DUNGEONS OF WOR":"":"":items++["","","HIGH SCORE "++show score] setAspectRatio aspectRatio 1 clear [ColorBuffer] loadIdentity texture Texture2D $= Enabled forM_ (zip menu [-3..]) $ \(text,i) -> do color $ if i == item then activeCol else textCol displayText (0.5-(fromIntegral (length text)*4*charSize)) (0.5+charSize*(7*fromIntegral (length items-1-2*i))) charSize text renderOverlay rgbOverlay flush swapBuffers renderGame aspectRatio displayText rgbOverlay levelState levelCount scores lives = do let curLevel = level levelState (lw,lh) = fullLevelSize curLevel height = fromIntegral lh / fromIntegral lw magn = 1 / fromIntegral lw setAspectRatio aspectRatio (getAspectRatio curLevel) clear [ColorBuffer] loadIdentity renderHud displayText height scores lives (actors levelState) levelCount curLevel preservingMatrix $ do translate $ Vector3 0 hudHeight (0 :: GLfloat) scale magn magn (1 :: GLfloat) renderLevel curLevel renderBullets (bullets levelState) renderActors (actors levelState) renderOverlay rgbOverlay flush swapBuffers renderOverlay rgbOverlay = do texture Texture2D $= Enabled textureBinding Texture2D $= Just rgbOverlay blendFunc $= (Zero,SrcColor) color $ Color4 1 1 1 solid let pscale = 100 renderPrimitive Quads $ do texCoord2 0 0 vertex3 0 0 0 texCoord2 pscale 0 vertex3 1 0 0 texCoord2 pscale pscale vertex3 1 1 0 texCoord2 0 pscale vertex3 0 1 0 blendFunc $= (SrcAlpha,OneMinusSrcAlpha) renderLevel level = do let (lw,lh) = fullLevelSize level height = fromIntegral lh / fromIntegral lw entries = [((y,x),[]) | (_,y,x) <- entrances level] texture Texture2D $= Disabled color $ Color4 0.2 0.5 1 solid forM_ (entries ++ assocs (legalMoves level)) $ \((y,x),ms) -> do let xc = fromIntegral (x+1) yc = fromIntegral (lh-y-2) unless (North `elem` ms) $ drawRectangle xc (yc+0.95) 1 0.05 unless (South `elem` ms) $ drawRectangle xc yc 1 0.05 unless (East `elem` ms) $ drawRectangle (xc+0.95) yc 0.05 1 unless (West `elem` ms) $ drawRectangle xc yc 0.05 1 renderActors as = do let players = filter ((`elem` [BlueWorrior,YellowWorrior]) . actorType) as texture Texture2D $= Enabled color $ Color4 1 1 1 solid forM_ as $ \a -> do let V x y = A.position a x' = fromIntegral x / fromIntegral fieldSize y' = fromIntegral y / fromIntegral fieldSize dist = case actorType a of Garwor -> 2*fieldSize Thorwor -> fieldSize _ -> maxBound visible = any ((\(V px py) -> abs (x-px) < dist || abs (y-py) < dist) . A.position) players when (visible && (not . null . animation) a) $ drawSprite (head (animation a)) (1.1+x') (1.1+y') 0.8 0.8 (facing a) renderBullets bs = do texture Texture2D $= Disabled color $ Color4 1 0.3 0.1 solid forM_ bs $ \(_,V x y) -> do let x' = fromIntegral x / fromIntegral fieldSize y' = fromIntegral y / fromIntegral fieldSize drawRectangle (1.45+x') (1.45+y') 0.1 0.1 renderHud displayText height scores lives actors levelCount level = do let r = Color4 1 0 0 solid b = Color4 0.25 0.63 1 solid y = Color4 0.93 0.79 0 solid d = Color4 0 0 0 solid charSize = 0.0028 radarTitle = if levelCount == 1 then "RADAR" else case levelName level of "pit" -> "THE PIT" "arena" -> "THE ARENA" _ -> "DUNGEON " ++ show levelCount (levelW,levelH) = levelSize level scoreB = hudHeight / 4 scoreW = 0.3 scoreH = scoreB*3 radarB = charSize radarW = radarF*fromIntegral levelW radarH = hudHeight-radarB*4-charSize*10 radarF = radarH/fromIntegral levelH snum1 = show (scores !! 0) snum2 = show (scores !! 1) lnum1 = show (lives !! 0) lnum2 = show (lives !! 1) numPlayers = length lives texture Texture2D $= Disabled color b drawRectangle 0 0 scoreW scoreH drawRectangle (0.5-radarW/2-radarB) 0 (radarW+radarB*2) (radarH+radarB*2) color y drawRectangle (1-scoreW) 0 scoreW scoreH color d drawRectangle scoreB scoreB (scoreW-2*scoreB) (scoreH-2*scoreB) drawRectangle (1-scoreW+scoreB) scoreB (scoreW-2*scoreB) (scoreH-2*scoreB) drawRectangle (0.5-radarW/2) radarB radarW radarH forM_ actors $ \actor -> do let (fx,fy) = fieldPos (position actor) rx = 0.5-radarW/2+radarF*fromIntegral fx ry = radarB+radarF*fromIntegral fy case actorType actor of Burwor -> color b >> drawRectangle rx ry radarF radarF Garwor -> color y >> drawRectangle rx ry radarF radarF Thorwor -> color r >> drawRectangle rx ry radarF radarF _ -> return () texture Texture2D $= Enabled color y displayText (1-scoreB-(fromIntegral (length snum1)*8*charSize)) (scoreB+scoreH/2-scoreB-5*charSize) charSize snum1 displayText (1-scoreW-3*radarB-(fromIntegral (length lnum1)*8*charSize)) (scoreB+scoreH/2-scoreB-5*charSize) charSize lnum1 when (numPlayers > 1) $ do color b displayText (scoreW-scoreB-(fromIntegral (length snum2)*8*charSize)) (scoreB+scoreH/2-scoreB-5*charSize) charSize snum2 displayText (scoreW+3*radarB) (scoreB+scoreH/2-scoreB-5*charSize) charSize lnum2 color r displayText (0.5-(fromIntegral (length radarTitle)*4*charSize)) (radarH+radarB*3) charSize radarTitle drawRectangle :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO () drawRectangle x y sx sy = renderPrimitive Quads $ mapM_ vertex [Vertex3 x y 0, Vertex3 (x+sx) y 0, Vertex3 (x+sx) (y+sy) 0, Vertex3 x (y+sy) 0] drawSprite :: TextureObject -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> Direction -> IO () drawSprite tid x y sx sy dir = do let (u1,v1,u2,v2,u3,v3,u4,v4) = case dir of North -> (1,1,1,0,0,0,0,1) East -> (1,1,0,1,0,0,1,0) South -> (0,1,0,0,1,0,1,1) West -> (0,1,1,1,1,0,0,0) textureBinding Texture2D $= Just tid renderPrimitive Quads $ do texCoord2 u1 v1 vertex3 x y 0 texCoord2 u2 v2 vertex3 (x+sx) y 0 texCoord2 u3 v3 vertex3 (x+sx) (y+sy) 0 texCoord2 u4 v4 vertex3 x (y+sy) 0