edge-0.9.1.0: Main.hs

{-|
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]