edge-0.9.0.2: edge.hs

import Data.Function ( ($) )
import Control.Monad ( return )
import Text.Show ( Show )
import Data.Bool ( Bool ( True, False ), not )
import Data.Maybe ( Maybe ( Just, Nothing ) )
import Data.List ( null, head )
import System.IO.Error ( userError, ioError )
import Data.WrapAround ( wrappoint )
import Graphics.Gloss.Interface.IO.Game
    ( black, Display(InWindow), playIO )
import Lance ( new )
import Resources ( initResources, initLevels )
import Input ( handleInput )
import Universe
    ( Arena(lance, wrapMap),
      Universe(Universe, arena, aws, blipSoundSource, delayRemaining,
               level, levelMessageTimer, lives, panelActivationTimer,
               queueBlipSound, resourceTracker, skipLevel, startGameTimer,
               levels) )
import Display ( AWS(..), displayUniverse )
import AWS ()
import Step ( stepUniverse )
import Unit ()
import Unit.Simple.Turret ()
import qualified Unit.Simple.Turret as Turret ()
import ResourceTracker ( getSound )
import Sound.ALUT
    ( HasSetter(($=)),
      HasGetter(get),
      LoopingMode(Looping),
      ALError(ALError),
      ObjectName(genObjectNames),
      sourceGain,
      play,
      loopingMode,
      buffer,
      alErrors,
      distanceModel,
      withProgNameAndArgs,
      runALUT )
import Data.Maybe ()
import System.IO ( stderr, hPutStrLn )
import Data.List ( intersperse, concat )
import Animation ( audioDistanceModel )
import System.Console.CmdTheLine
    ( TermInfo(termName, version),
      OptInfo(optDoc),
      eval,
      defTI,
      value,
      optInfo,
      opt )
import Control.Applicative ( (<$>) )
import qualified Paths_edge as P ( version )
import Data.Version ( showVersion )

displayMode a = InWindow "The Edge" a (0, 0)

sizePassed = value (opt "default"
                     ((optInfo [ "size", "s" ])
                       { optDoc = "assumed screen size, used\
                                  \ in layout of game visuals" }
                     ))

data EdgeOpts = EdgeOpts { size :: Maybe AWS }
  deriving Show

switchboard a = EdgeOpts { size = case a of
                                    "default" -> Just W1024
                                    "1024x768" -> Just W1024
                                    "1280x1024" -> Just W1280
                                    otherwise -> Nothing
                         } 

term = switchboard <$> sizePassed

termInfo = defTI { termName = "edge", version = showVersion P.version }

main = withProgNameAndArgs runALUT $ \progName args ->
         do a <- eval args (term, termInfo)
            case size a of
              Nothing -> ioError (userError
                           "Only 1024x768 and 1280x1024 are acceptable\
                           \ size arguments at this time.")
              Just b -> edge b

edge a = do universe <- initUniverse a
            distanceModel $= audioDistanceModel
   --         listenerPosition $= (Vertex3 0 0 0)
            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]