diff --git a/Common.hs b/Common.hs --- a/Common.hs +++ b/Common.hs @@ -30,3 +30,5 @@ | otherwise = v : acc (inc u) vs allTrue = all id + +pairDup x = (x, x) diff --git a/Display.hs b/Display.hs --- a/Display.hs +++ b/Display.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ExistentialQuantification #-} -module Display (displayUniverse) where +module Display (displayUniverse, AWS(..)) where import Animation import Universe @@ -19,9 +19,14 @@ import ResourceTracker import Math import Resources +import Common (pairDup) data Displayable = forall a. (Locatable a, Animation a) => Displayable a +-- |Assumed Window Size. +data AWS = W1280 | W1024 + deriving (Show) + displayUniverse u = return $ Pictures $ [ let (x, y) = k displayable in @@ -58,33 +63,33 @@ else [] ++ [ fromMaybe Blank (do lance' <- lance r Just (image lance' undefined)) - , f 0.5 (Translate (-65) 365 deflectorText) - , f 0.5 (Translate 65.0 370.0 $ + , f 0.5 (Translate (-65) (ap 365) deflectorText) + , f 0.5 (Translate 65.0 (ap 370) $ case lance r of Just x -> deflectorBar (deflectorCharge x) Nothing -> deflectorBar 0.8) - , f 0.5 (Translate 140.0 365.0 (levelText (level u))) - , f 0.5 (Translate (-140) 365 (livesText (lives u))) - , f 1.5 (Translate 420 300 + , f 0.5 (Translate 140 (ap 365) (levelText (level u))) + , f 0.5 (Translate (-140) (ap 365) (livesText (lives u))) + , f 1.5 (Translate (ap 420) (ap 300) (sensorPanel r (150, 150))) , case lance r of Nothing -> Blank Just l -> if not (godMode l) then Blank - else Translate (-20) 335 godText - , f 1 (Translate (-500) 365 + else Translate (-20) (ap 335) godText + , f 1 (Translate (am (-500)) (ap 365) (Color white (Scale 0.14 0.14 (Text "structural integrity")))) , f 1 (case lance r of Nothing -> Blank - Just l -> Translate (-330) 365 + Just l -> Translate (am (-330)) (ap 365) (Scale 0.14 0.14 (integrityAssessment (integrity l)))) - , g (Translate (-400.0) 340.0 + , g (Translate (am (-400)) (ap 340) (inventoryDisplay (lance r) (resourceTracker u))) , g (Translate (-200) 150 (levelMessage (levelMessageTimer u) (level u))) - , h 2 (i 20 (Translate (-450.0) (-230.0) helpColumn2)) - , h 2 (i 20 (Translate (-470.0) (-320.0) helpColumn1)) + , h 2 (i 20 (Translate (am (-450)) (am (-230)) helpColumn2)) + , h 2 (i 20 (Translate (am (-470)) (am (-320)) helpColumn1)) ] where f x = g . h x g x = if isNothing (lance (arena u)) then Blank else x @@ -94,6 +99,8 @@ w = Universe.wrapMap r s = fromMaybe Blank (getImage (resourceTracker u) "item-sigma.bmp") k x = vectorRelation w (M.center x) (focus r) + ap = case aws u of W1024 -> id; W1280 -> (+ 116) + am = case aws u of W1024 -> id; W1280 -> (\x -> x - 116) livesText n = Color white (Scale 0.14 0.14 diff --git a/Display.hs-boot b/Display.hs-boot new file mode 100644 --- /dev/null +++ b/Display.hs-boot @@ -0,0 +1,3 @@ +module Display where + +data AWS diff --git a/Universe.hs b/Universe.hs --- a/Universe.hs +++ b/Universe.hs @@ -12,6 +12,7 @@ import Item import Common import Sound.ALUT +import {-# SOURCE #-} Display (AWS) data Arena = Arena { lance :: Maybe Lance , focus :: WP @@ -37,6 +38,7 @@ , startGameTimer :: Time , queueBlipSound :: Bool , blipSoundSource :: Maybe Source + , aws :: AWS } blankArena width height = diff --git a/edge.cabal b/edge.cabal --- a/edge.cabal +++ b/edge.cabal @@ -8,7 +8,7 @@ -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.8.18 +Version: 0.8.20 -- A short (one-line) description of the package. Synopsis: Top view space combat arcade game @@ -68,7 +68,7 @@ , containers >= 0.4.2.1 && < 0.6 , ALUT >= 2.2 && < 2.3 , random >= 1.0.1.1 && < 1.1 - + , cmdtheline >= 0.2.1.1 && < 0.3 -- Modules not exported by this package. Other-modules: Lance , Asteroid diff --git a/edge.hs b/edge.hs --- a/edge.hs +++ b/edge.hs @@ -15,24 +15,57 @@ import System.IO import Data.List ( intersperse ) import Animation +import System.Console.CmdTheLine +import Control.Applicative +import qualified Paths_edge as P +import Data.Version ( showVersion ) -displayMode = InWindow "The Edge" (1024, 768) (0, 0) +displayMode a = InWindow "The Edge" a (0, 0) -main = withProgNameAndArgs runALUT $ \progName args -> do - universe <- initUniverse - 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 black 20 universe displayUniverse handleInput stepUniverse +sizePassed = value (opt "default" + ((optInfo [ "size", "s" ]) + { optDoc = "assumed screen size, used\ + \ in layout of game visuals" } + )) -initUniverse = +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 @@ -54,6 +87,7 @@ , startGameTimer = 0.0 , queueBlipSound = True , blipSoundSource = Nothing + , aws = b } playMusic rt =