ibis/src/Util.hs

85 lines
1.8 KiB
Haskell
Raw Permalink Normal View History

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
2019-09-06 20:36:42 +00:00
, SDL.windowGraphicsContext = SDL.OpenGLContext 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)