Permalink
Browse files

Command Line Argument Parsing with Verbose Flag

  • Loading branch information...
1 parent 5af4916 commit beaf8df975084df41f10a3a9e6e62315687232b2 @btmura committed Jun 19, 2011
@@ -7,20 +7,27 @@ import Data.IORef
import Graphics.Rendering.FTGL
import Graphics.Rendering.OpenGL
import Graphics.UI.GLFW
+import System.Environment
import B1.Data.Action
import B1.Program.Chart.Dirty
import B1.Program.Chart.Resources
+import B1.Program.Chart.Options
import B1.Program.Chart.Screen
main :: IO ()
main = do
+ args <- getArgs
+ (options, nonOptions) <- readOptions args
+
initialize
createWindow
initClientState
- loadTextures
- resourcesRef <- createInitialResources
+ resourcesRef <- createInitialResources options
+ resources <- readIORef resourcesRef
+ loadTextures resources
+
windowDirtyRef <- newIORef False
windowSizeCallback $= myWindowSizeCallback resourcesRef windowDirtyRef
@@ -42,9 +49,9 @@ initClientState = do
clientState VertexArray $= Enabled
clientState ColorArray $= Enabled
-loadTextures :: IO ()
-loadTextures = do
- mapM_ (uncurry bindTexture) (zip [0 ..] fileNames)
+loadTextures :: Resources -> IO ()
+loadTextures resources = do
+ mapM_ (uncurry (bindTexture resources)) (zip [0 ..] fileNames)
texture Texture2D $= Disabled
where
fileNames =
@@ -53,22 +60,23 @@ loadTextures = do
, "res/tga/refresh-button.tga"
]
-bindTexture :: Int -> String -> IO ()
-bindTexture textureNumber fileName = do
+bindTexture :: Resources -> Int -> String -> IO ()
+bindTexture resources textureNumber fileName = do
textureBinding Texture2D $= Just (TextureObject (fromIntegral textureNumber))
textureFilter Texture2D $= ((Linear', Nothing), Linear')
loadResult <- loadTexture2D fileName [BuildMipMaps]
- putStrLn $ "Loading texture " ++ fileName ++ ": " ++ show loadResult
+ logMessage resources $ "Loading texture " ++ fileName ++ ": "
+ ++ show loadResult
-- | Initialize the resources that should be immutable like fonts.
-- The other fields will be filled in later.
-createInitialResources :: IO (IORef Resources)
-createInitialResources = do
+createInitialResources :: Options -> IO (IORef Resources)
+createInitialResources options = do
font <- createTextureFont "res/fonts/orbitron/orbitron-medium.ttf"
program <- loadProgram
["res/shaders/vertex-shader.txt"]
["res/shaders/fragment-shader.txt"]
- newIORef $ newResources font program
+ newIORef $ newResources (verbose options) font program
loadProgram :: [FilePath] -> [FilePath] -> IO Program
loadProgram vertexShaderPaths fragmentShaderPaths= do
@@ -0,0 +1,35 @@
+module B1.Program.Chart.Options
+ ( Options(..)
+ , readOptions
+ ) where
+
+import System.Console.GetOpt
+
+data Options = Options
+ { verbose :: Bool
+ }
+
+defaultOptions = Options
+ { verbose = False
+ }
+
+readOptions :: [String] -> IO (Options, [String])
+readOptions args =
+ case getOpt RequireOrder options args of
+ (options, nonOptions, []) ->
+ return (foldl (flip id) defaultOptions options, nonOptions)
+ (_, _, errors) ->
+ ioError (userError (concat errors ++ usageInfo header options))
+ where
+ progName = head args
+ header = "Usage: " ++ progName ++ " [OPTION...]"
+
+options :: [OptDescr (Options -> Options)]
+options =
+ [ Option "v" ["verbose"] (NoArg setVerbose)
+ "Output verbose messages to STDERR."
+ ]
+
+setVerbose :: Options -> Options
+setVerbose options = options { verbose = True }
+
@@ -10,6 +10,7 @@ module B1.Program.Chart.Resources
, mouseDragStartPosition
)
, newResources
+ , logMessage
, updateKeysPressed
, isKeyPressed
, getKeyPressed
@@ -27,15 +28,19 @@ module B1.Program.Chart.Resources
, updateWindowSize
) where
+import Control.Monad
import Data.Maybe
+import GHC.IO.Handle
+import GHC.IO.Handle.FD
import Graphics.Rendering.FTGL
import Graphics.Rendering.OpenGL
import Graphics.UI.GLFW
dragThreshold = 10::Int
data Resources = Resources
- { font :: Font
+ { verbose :: Bool
+ , font :: Font
, program :: Program
, windowWidth :: GLfloat
, windowHeight :: GLfloat
@@ -54,9 +59,10 @@ data Resources = Resources
, previousMouseWheelPosition :: Int
} deriving (Show, Eq)
-newResources :: Font -> Program -> Resources
-newResources font program = Resources
- { font = font
+newResources :: Bool -> Font -> Program -> Resources
+newResources verbose font program = Resources
+ { verbose = verbose
+ , font = font
, program = program
, windowWidth = 0
, windowHeight = 0
@@ -75,6 +81,12 @@ newResources font program = Resources
, previousMouseWheelPosition = 0
}
+logMessage :: Resources -> String -> IO ()
+logMessage resources message = do
+ when (verbose resources) $ do
+ hPutStr stderr $ message ++ "\n"
+ return ()
+
updateKeysPressed :: [Key] -> Resources -> Resources
updateKeysPressed keysPressed
resources@Resources { keysPressed = previousKeysPressed } = resources
@@ -61,5 +61,5 @@ createResources :: IO Resources
createResources = do
font <- createTextureFont "noSuchFont"
[program] <- genObjectNames 1
- return $ newResources font program
+ return $ newResources False font program

0 comments on commit beaf8df

Please sign in to comment.