make screen resolution configurable

This commit is contained in:
nek0 2017-11-19 18:27:09 +01:00
parent 5be59df1c3
commit 437de1b61d
4 changed files with 56 additions and 12 deletions

View file

@ -27,8 +27,8 @@ import Logging as LL
import Debug.Trace
load :: IO StateData
load = do
load :: Word -> Word -> IO StateData
load w h = do
_ <- SDL.setMouseLocationMode SDL.RelativeLocation
GL.depthFunc $= Just GL.Less
@ -84,12 +84,19 @@ load = do
fragmentShaderHandle = foldl BS.append BS.empty
[ "varying vec2 f_texcoord;"
, "void main(void) {"
, " gl_FragColor = vec4(1.0,0.0,1.0,0.5);"
, " gl_FragColor = vec4(1,0,1,0.5);"
, "}"
]
fragmentShaderSelHandle = foldl BS.append BS.empty
[ "varying vec2 f_texcoord;"
, "void main(void) {"
, " gl_FragColor = vec4(1,1,0,0.5);"
, "}"
]
hProgram <- GLU.simpleShaderProgramBS vertexShader fragmentShaderHandle
sProgram <- GLU.simpleShaderProgramBS vertexShader fragmentShaderShip
cProgram <- GLU.simpleShaderProgramBS vertexShader fragmentShaderSelHandle
phys <- initPhysics
@ -109,7 +116,7 @@ load = do
(Just t)
(Just texture))
, vertHandles = createHandles hvao vhtl (loLocations sobj)
, proj = perspective (pi/2) (1600 / 900) 1 (-1)
, proj = perspective (pi/2) (fromIntegral w / fromIntegral h) 1 (-1)
, camera = Camera
{ cameraFocus = V3 0 0 0
, cameraRot = Euler 0 0 0
@ -119,6 +126,7 @@ load = do
, physicsObjects = po
, shipProgram = sProgram
, handleProgram = hProgram
, selHandleProgram = cProgram
}
initPhysics :: IO Physics

View file

@ -23,18 +23,47 @@ import System.Random (randomRIO)
import SpatialMath
import Options.Applicative
import Data.Semigroup ((<>))
import Init
import Types
import Foreign.C.Types (CInt(..))
import Debug.Trace as T
opts :: Parser Opts
opts = Opts
<$> option auto
( long "width"
<> short 'w'
<> value 1600
<> showDefault
<> metavar "NUM"
<> help "Screen width"
)
<*> option auto
( long "height"
<> short 'h'
<> value 900
<> showDefault
<> metavar "NUM"
<> help "Screen height"
)
main :: IO ()
main =
main = do
o <- execParser $ info opts
( fullDesc
<> progDesc "sample for hw game"
)
withAffection AffectionConfig
{ initComponents = All
, windowTitle = "hw"
, windowConfig = SDL.defaultWindow
{ SDL.windowInitialSize = SDL.V2 1600 900
{ SDL.windowInitialSize = SDL.V2
(CInt $ fromIntegral $ width o)
(CInt $ fromIntegral $ height o)
, SDL.windowOpenGL = Just SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 3 2
}
@ -43,8 +72,8 @@ main =
, preLoop = return ()
, eventLoop = handle
, updateLoop = update
, drawLoop = draw
, loadState = load
, drawLoop = draw (width o) (height o)
, loadState = load (width o) (height o)
, cleanUp = const (return ())
, canvasSize = Nothing
}
@ -77,10 +106,10 @@ update dt = do
vertHandles = nvhs
}
draw :: Affection StateData ()
draw =
draw :: Word -> Word -> Affection StateData ()
draw w h =
do
GL.viewport $= (GL.Position 0 0, GL.Size 1600 900)
GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))
StateData{..} <- getAffection
let view = lookAt
(cameraFocus camera +

View file

@ -9,6 +9,11 @@ import SpatialMath
import Physics.Bullet.Raw as Bullet
data Opts = Opts
{ width :: Word
, height :: Word
}
data StateData = StateData
{ ship :: Ship
, vertHandles :: [Ship]
@ -18,6 +23,7 @@ data StateData = StateData
, physicsObjects :: PhysicsObjects
, shipProgram :: GLU.ShaderProgram
, handleProgram :: GLU.ShaderProgram
, selHandleProgram :: GLU.ShaderProgram
}
data Ship = Ship
@ -27,7 +33,7 @@ data Ship = Ship
, shipRot :: Quaternion Float
, shipTexture :: Maybe GL.TextureObject
, shipUVs :: Maybe GL.BufferObject
}
} deriving (Eq)
data Camera = Camera
{ cameraFocus :: V3 Float

View file

@ -172,6 +172,7 @@ executable example03
, wavefront
, shoot
, split
, optparse-applicative
hs-source-dirs: examples/example03
default-language: Haskell2010
ghc-options: -Wall