{-| Module : Main Description : top level executable module Copyright : (c) Christopher Howard, 2016 License : GPL-3 Maintainer : ch.howard@zoho.com -} module Main where import Prelude (putStrLn, IO, String, Maybe(..), null, head, ($), return, Bool(..), not) import Text.Show ( Show ) import System.IO.Error ( userError, ioError ) import Data.WrapAround ( wrappoint ) import Graphics.Gloss.Interface.IO.Game ( black, Display(FullScreen), playIO ) import Sound.ALUT ( HasSetter(($=)), HasGetter(get), LoopingMode(Looping), ALError(ALError), ObjectName(genObjectNames), sourceGain, play, loopingMode, buffer, alErrors, distanceModel, withProgNameAndArgs, runALUT ) import System.IO ( stderr, hPutStrLn ) import Data.List ( intersperse, concat ) import System.Console.CmdTheLine (TermInfo(termName, version), OptInfo(optDoc), run, defTI, value, optInfo, opt) import Control.Applicative ( (<$>) ) import Data.Version ( showVersion ) import qualified Paths_edge as P ( version ) import Resources import Display import Step import Lance import Input import Universe import AWS import Unit import Unit.Simple.Turret import ResourceTracker import Animation displayMode a = FullScreen a data EdgeOpts = EdgeOpts { size :: Maybe AWS } deriving Show switchboard :: String -> IO () switchboard size = case size of "default" -> edge W1024 "1024x768" -> edge W1024 "1280x1024" -> edge W1280 otherwise -> do putStrLn "Invalid resolution, defaulting to 1024x768" edge W1024 sizeFl = value (opt "1024x768" ((optInfo [ "size", "s" ]) { optDoc = "resolution: supports 1024x768 or 1280x1024." } )) term = switchboard <$> sizeFl termInfo = defTI { termName = "edge", version = showVersion P.version } main = run (term, termInfo) edge a = do withProgNameAndArgs runALUT $ \_ _ -> do universe <- initUniverse a distanceModel $= audioDistanceModel errs <- get alErrors if not (null errs) then hPutStrLn stderr (concat (intersperse "," [ d | ALError _ d <- errs ])) else return () playMusic (resourceTracker universe) playIO (displayMode (case a of W1024 -> (1024, 768) W1280 -> (1280, 1024))) black 20 universe displayUniverse handleInput stepUniverse initUniverse b = do rt <- initResources rLevels <- initLevels rt let sArena = head rLevels let wmap = Universe.wrapMap sArena return Universe { arena = sArena { lance = Just (Lance.new rt wmap (wrappoint wmap (0, 0))) } , level = 0 , Universe.levels = rLevels , lives = 3 , delayRemaining = 2.0 , resourceTracker = rt , skipLevel = False , levelMessageTimer = Nothing , panelActivationTimer = 0.0 , startGameTimer = 0.0 , queueBlipSound = True , blipSoundSource = Nothing , aws = b } playMusic rt = do [source] <- genObjectNames 1 buffer source $= getSound rt "music.wav" sourceGain source $= 0.4 loopingMode source $= Looping play [source]