2019-01-31 21:00:29 +00:00
|
|
|
-- {-# LANGUAGE ForeignFunctionInterface #-}
|
2019-01-29 22:55:45 +00:00
|
|
|
module Util where
|
|
|
|
|
2019-01-31 15:01:01 +00:00
|
|
|
import qualified SDL hiding (V2)
|
|
|
|
|
|
|
|
import qualified Graphics.Rendering.OpenGL as GL
|
|
|
|
|
|
|
|
import Data.Int (Int32(..))
|
2019-01-29 22:55:45 +00:00
|
|
|
|
|
|
|
import Options.Applicative
|
|
|
|
|
2019-01-31 13:47:18 +00:00
|
|
|
import Control.Monad (when)
|
|
|
|
|
2019-01-30 05:08:38 +00:00
|
|
|
import System.IO
|
|
|
|
|
2019-01-31 13:47:18 +00:00
|
|
|
import Foreign.C.Types (CInt(..))
|
|
|
|
|
2019-01-31 15:01:01 +00:00
|
|
|
import Linear
|
|
|
|
|
2019-01-29 22:55:45 +00:00
|
|
|
-- internal imports
|
|
|
|
|
|
|
|
import Types
|
|
|
|
|
2019-01-31 21:00:29 +00:00
|
|
|
-- foreign import ccall unsafe "glewInit"
|
|
|
|
-- glewInit :: IO CInt
|
2019-01-31 13:47:18 +00:00
|
|
|
|
2019-01-29 22:55:45 +00:00
|
|
|
glWindowConfig :: SDL.WindowConfig
|
|
|
|
glWindowConfig = SDL.defaultWindow
|
2019-01-31 15:01:01 +00:00
|
|
|
{ SDL.windowResizable = True
|
|
|
|
, SDL.windowOpenGL = Just SDL.defaultOpenGL
|
2019-01-29 22:55:45 +00:00
|
|
|
{ SDL.glProfile = SDL.Core SDL.Normal 3 3
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2019-01-30 05:08:38 +00:00
|
|
|
putErrLn :: String -> IO ()
|
2019-01-30 22:10:00 +00:00
|
|
|
putErrLn s = hPutStrLn stderr s
|
2019-01-30 05:08:38 +00:00
|
|
|
|
2019-01-29 22:55:45 +00:00
|
|
|
options :: Parser Options
|
|
|
|
options = Options
|
|
|
|
<$> switch
|
|
|
|
( long "fullscreen"
|
|
|
|
<> short 'f'
|
|
|
|
<> help "Toggle fullscreen"
|
|
|
|
<> showDefault
|
|
|
|
)
|
|
|
|
<*> switch
|
|
|
|
( long "flip"
|
|
|
|
<> short 'p'
|
|
|
|
<> help "Flip screens"
|
|
|
|
<> showDefault
|
|
|
|
)
|
2019-01-31 13:47:18 +00:00
|
|
|
<*> switch
|
|
|
|
( long "verbose"
|
|
|
|
<> short 'v'
|
|
|
|
<> help "Show verbose console output"
|
|
|
|
<> showDefault
|
|
|
|
)
|
2019-01-29 22:55:45 +00:00
|
|
|
<*> argument str
|
|
|
|
( help "Input file"
|
|
|
|
<> metavar "FILE"
|
|
|
|
)
|
2019-01-30 05:08:38 +00:00
|
|
|
|
2019-01-30 22:10:00 +00:00
|
|
|
makeWindowConfig :: SDL.Display -> SDL.WindowConfig
|
|
|
|
makeWindowConfig d =
|
|
|
|
glWindowConfig
|
|
|
|
{ SDL.windowPosition = SDL.Absolute (SDL.displayBoundsPosition d)
|
|
|
|
}
|
2019-01-31 13:47:18 +00:00
|
|
|
|
|
|
|
verb :: Options -> String -> IO ()
|
|
|
|
verb opts str = do
|
|
|
|
when (optVerbose opts) $
|
|
|
|
putStrLn str
|
2019-01-31 15:01:01 +00:00
|
|
|
|
|
|
|
fitViewport :: Double -> V2 Int32 -> IO ()
|
|
|
|
fitViewport ratio (V2 w h) = do
|
|
|
|
if fromIntegral w / fromIntegral h > ratio
|
|
|
|
then do
|
|
|
|
let nw = floor (fromIntegral h * ratio)
|
|
|
|
dw = floor ((fromIntegral w - fromIntegral nw) / 2 :: Double)
|
|
|
|
GL.viewport SDL.$= (GL.Position dw 0, GL.Size nw h)
|
|
|
|
else do
|
|
|
|
let nh = floor (fromIntegral w / ratio)
|
|
|
|
dh = floor ((fromIntegral h - fromIntegral nh) / 2 :: Double)
|
|
|
|
GL.viewport SDL.$= (GL.Position 0 dh, GL.Size w nh)
|