edge 0.8.18 → 0.8.20
raw patch · 6 files changed
+77/−29 lines, 6 filesdep +cmdtheline
Dependencies added: cmdtheline
Files
- Common.hs +2/−0
- Display.hs +19/−12
- Display.hs-boot +3/−0
- Universe.hs +2/−0
- edge.cabal +2/−2
- edge.hs +49/−15
Common.hs view
@@ -30,3 +30,5 @@ | otherwise = v : acc (inc u) vs allTrue = all id++pairDup x = (x, x)
Display.hs view
@@ -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
+ Display.hs-boot view
@@ -0,0 +1,3 @@+module Display where++data AWS
Universe.hs view
@@ -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 =
edge.cabal view
@@ -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
edge.hs view
@@ -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 =