packages feed

roguestar-gl 0.2.1 → 0.2.2

raw patch · 22 files changed

+361/−46 lines, 22 filesdep +filepathdep ~rsaglnew-uploader

Dependencies added: filepath

Dependency ranges changed: rsagl

Files

Main.hs view
@@ -1,17 +1,72 @@ module Main (main) where-{- This is a small shell wrapper.-   What we do is we use the 'netpipes' program to set up a socket, and then we-   tell the shell to set the roguestar server running; we pause briefly to give-   it a chance to set up the socket. Then we open up the nice GL-   interface.-   The 'sleep 2' bit is ugly; we need it because if either one opens up and-   can't find the socket at 5618, it'll just exit - it won't wait for the other-   one to start up. It's a race condition, alas. -}-import System.Cmd (system) +import System.Process+import System.Exit+import Control.Concurrent+import System.Environment+import System.FilePath+import System.IO+import Control.Monad+import Paths_roguestar_gl+ main :: IO ()-main =  do system $ "faucet 5618 --out --in --unix --once " ++ "roguestar-engine version over begin" ++ " &"-           system "sleep 2" -- TODO: Figure out some in-Haskell way-           system $ "hose localhost 5618 --out --in --unix " ++ "roguestar-gl" ++ " &"-           return ()+main = +    do (should_echo_protocol,args) <- +           do args <- getArgs+	      return ("--echo-protocol" `elem` args,+		      filter (/= "--echo-protocol") $ args)+       n <- getNumberOfCPUCores+       bin_dir <- getBinDir+       let n_rts_string = if n == 1 then [] else ["-N" ++ show n]+       let gl_args = ["+RTS", "-G4"] ++ n_rts_string ++ ["-RTS"] ++ args+       let engine_args = ["+RTS"] ++ n_rts_string ++ ["-RTS"] ++ ["version","over","begin"]+       (e_in,e_out,e_err,roguestar_engine) <- runInteractiveProcess (bin_dir `combine` "roguestar-engine") engine_args Nothing Nothing+       (gl_in,gl_out,gl_err,roguestar_gl) <- runInteractiveProcess (bin_dir `combine` "roguestar-gl") gl_args Nothing Nothing+       forkIO $ pump e_out  $ [("",gl_in)] ++ (if should_echo_protocol then [("engine >>> gl *** ",stdout)] else [])+       forkIO $ pump gl_out $ [("",e_in)] ++ (if should_echo_protocol then [("gl <<< engine *** ",stdout)] else [])+       forkIO $ pump e_err  $ [("roguestar-engine *** ",stderr)]+       forkIO $ pump gl_err $ [("roguestar-gl     *** ",stderr)]+       forkIO $+           do roguestar_engine_exit <- waitForProcess roguestar_engine+              case roguestar_engine_exit of+                  ExitFailure x -> putStrLn $ "roguestar-engine terminated unexpectedly (" ++ show x ++  ")"+                  _ -> return ()+	      return ()+       roguestar_gl_exit <- waitForProcess roguestar_gl+       case roguestar_gl_exit of+           ExitFailure x -> putStrLn $ "roguestar-gl terminated unexpectedly (" ++ show x ++ ")"+           _ -> return ()        +pump :: Handle -> [(String,Handle)] -> IO ()+pump from tos =+    do mapM_ (flip hSetBuffering NoBuffering . snd) tos+       hSetBuffering from NoBuffering+       forever $+           do l <- hGetLine from+	      flip mapM_ tos $ \(name,to) -> +	          do hPutStrLn to $ name ++ l+	             hFlush to++getNumberOfCPUCores :: IO Int+getNumberOfCPUCores =+    do m_nop <- readNumberOfProcessors+       m_cpuinfo <- scanCPUInfo+       case (m_nop,m_cpuinfo) of+           (Just n,_) -> do hPutStrLn stderr $ "roguestar: " ++ show n ++ +	                        " CPU core(s) based on windows environment variable NUMBER_OF_PROCESSORS. "+			    return n+           (_,Just n) -> do hPutStrLn stderr $ "roguestar: " ++ show n ++ " CPU core(s) based on /proc/cpuinfo. " +	                    return n+	   _ ->          do hPutStrLn stderr "roguestar: couldn't find number of CPU cores, assuming 1 core"+	                    return 1++readNumberOfProcessors :: IO (Maybe Int)+readNumberOfProcessors = flip catch (const $ return Nothing) $ liftM Just $+    do n <- getEnv "NUMBER_OF_PROCESSORS"+       return $! read n++scanCPUInfo :: IO (Maybe Int)+scanCPUInfo = catch (liftM (Just . length . filter isProcessorLine . map words . lines) $ readFile "/proc/cpuinfo")+                    (const $ return Nothing)+    where isProcessorLine ["processor",":",_] = True+          isProcessorLine _ = False
roguestar-gl.cabal view
@@ -1,8 +1,8 @@ name:                roguestar-gl-version:             0.2.1+version:             0.2.2 license:             OtherLicense license-file:        LICENSE-author:              Christopher Lane Hinson+author:              Christopher Lane Hinson <lane@downstairspeople.org> maintainer:          Christopher Lane Hinson <lane@downstairspeople.org>  category:            Game@@ -10,16 +10,16 @@ description:         Roguestar is a science fiction themed roguelike (turn-based,                      chessboard-tiled, role playing) game written in Haskell.  Roguestar uses                      OpenGL for graphics.  This is still a very early release and several-                     important things don't work. Note that there is a runtime dependency on 'netpipes'.+                     important things don't work.                      .                      This initial release allows you to play one of six alien races.  You begin                      the game stranded on an alien planet, fighting off an endless hoard of                      hostile robots.                      .-                     The Darcs repository is available at <http://www.downstairspeople.org/darcs/roguestar-gl>.+                     The git repository is available at <http://www.downstairspeople.org/git/roguestar-gl.git>. homepage:            http://roguestar.downstairspeople.org/ -build-depends:       base>3, containers, arrows, mtl, MonadRandom, GLUT, rsagl>=0.2.1+build-depends:       base>3, containers, arrows, mtl, MonadRandom, GLUT, rsagl >=0.2.2 && <0.3, filepath >1.1 --roguestar-engine==0.3 build-type:          Simple tested-with:         GHC==6.8.2@@ -30,14 +30,17 @@ other-modules:       Quality, ProtocolTypes, VisibleObject,                      Strings, WordGenerator, Driver,                      PrintTextData, Animation,-                     Actions, Limbs, Tables, PrintText,+                     Actions, Limbs, Tables, PrintText, CommandLine,                      Models.Androsynth, Models.QuestionMark, Models.Terrain, Models.RecreantFactory,                      Models.Recreant, Models.Ascendant, Models.Materials, Models.Reptilian,                      Models.Library, Models.MachineParts, Models.LibraryData, Models.Caduceator,-                     Models.Tree, Models.Encephalon, Models.PhaseWeapons, RenderingControl+                     Models.Tree, Models.Encephalon, Models.PhaseWeapons, RenderingControl,+                     Keymaps.BuiltinKeymaps, Keymaps.CommonKeymap, Keymaps.NumpadKeymap,+                     Keymaps.Keymaps, Keymaps.VIKeymap ghc-options:         -Wall -threaded -fno-warn-type-defaults -fexcess-precision ghc-prof-options:    -prof -auto-all  executable:          roguestar main-is:             Main.hs build-depends:       process+ghc-options:         -Wall -threaded
src/Actions.lhs view
@@ -12,10 +12,8 @@     where  import System.Exit-import Control.Monad import Control.Monad.Error import Driver-import Data.IORef import Data.List import PrintText import Tables
+ src/CommandLine.lhs view
@@ -0,0 +1,14 @@+\begin{code}+module CommandLine(CommandLineOptions, keymap_name, parseCommandLine) where++import Keymaps.Keymaps++data CommandLineOptions = CommandLineOptions {+	keymap_name :: Maybe KeymapName+}++-- Extremely minimal implementation for now: switch to System.Console.GetOpt or just use a config. file?+parseCommandLine :: [String] -> CommandLineOptions+parseCommandLine [the_keymap_name] = CommandLineOptions $ Just the_keymap_name+parseCommandLine _ = CommandLineOptions Nothing+\end{code}
src/Driver.lhs view
@@ -18,7 +18,6 @@ import System.IO import Tables import RSAGL.Time-import Control.Concurrent  data RoguestarEngineState = RoguestarEngineState {      restate_tables :: [RoguestarTable],
+ src/Keymaps/BuiltinKeymaps.hs view
@@ -0,0 +1,27 @@+module Keymaps.BuiltinKeymaps+    (findKeymapOrDefault,+     builtin_keymap_names,+     builtin_keymaps)+    where++import Data.Char+import Data.List++import Keymaps.Keymaps+import Keymaps.NumpadKeymap+import Keymaps.VIKeymap++findKeymapOrDefault :: Maybe KeymapName -> Keymap+findKeymapOrDefault m_keymap_name = fixKeymap $ maybe vi_numpad_keymap id (m_keymap_name >>= (flip lookup builtin_keymaps . (map toLower)))++builtin_keymap_names :: [KeymapName]+builtin_keymap_names = map fst builtin_keymaps++builtin_keymaps :: [(KeymapName, Keymap)]+builtin_keymaps = [+ ("vi", vi_keymap),+ ("numpad", numpad_keymap),+ ("vi+numpad", vi_numpad_keymap)]++vi_numpad_keymap :: Keymap+vi_numpad_keymap = union vi_keymap numpad_keymap
+ src/Keymaps/CommonKeymap.hs view
@@ -0,0 +1,122 @@+module Keymaps.CommonKeymap+    (commonMovementKeymap,MovementKeymap(..),common_keymap)+    where++import Data.Char++import Keymaps.Keymaps++data MovementKeymap = MovementKeymap {+    mk_n, mk_s, mk_e, mk_w, mk_nw, mk_ne, mk_sw, mk_se :: String }++commonMovementKeymap :: MovementKeymap -> Keymap+commonMovementKeymap mk = [+ (mk_n mk,"move-n"),+ (mk_s mk,"move-s"),+ (mk_e mk,"move-e"),+ (mk_w mk,"move-w"),+ (mk_nw mk,"move-nw"),+ (mk_ne mk,"move-ne"),+ (mk_sw mk,"move-sw"),+ (mk_se mk,"move-se"),+ (">t" ++ mk_n mk,"turn-n"),+ (">t" ++ mk_s mk,"turn-s"),+ (">t" ++ mk_e mk,"turn-e"),+ (">t" ++ mk_w mk,"turn-w"),+ (">t" ++ mk_nw mk,"turn-nw"),+ (">t" ++ mk_ne mk,"turn-ne"),+ (">t" ++ mk_sw mk,"turn-sw"),+ (">t" ++ mk_se mk,"turn-se"),+ (">f" ++ mk_n mk,"fire-n"),+ (">f" ++ mk_s mk,"fire-s"),+ (">f" ++ mk_e mk,"fire-e"),+ (">f" ++ mk_w mk,"fire-w"),+ (">f" ++ mk_nw mk,"fire-nw"),+ (">f" ++ mk_ne mk,"fire-ne"),+ (">f" ++ mk_sw mk,"fire-sw"),+ (">f" ++ mk_se mk,"fire-se")]++common_keymap :: Keymap+common_keymap = [+ (":move-n","move-n"),+ (":move-s","move-s"),+ (":move-w","move-w"),+ (":move-e","move-e"),+ (":move-nw","move-nw"),+ (":move-ne","move-ne"),+ (":move-sw","move-sw"),+ (":move-se","move-se"),+ (":turn-n","turn-n"),+ (":turn-s","turn-s"),+ (":turn-w","turn-w"),+ (":turn-e","turn-e"),+ (":turn-nw","turn-nw"),+ (":turn-ne","turn-ne"),+ (":turn-sw","turn-sw"),+ (":turn-se","turn-se"),+ ("x","anachronid"),+ (":anachronid","anachronid"),+ ("a","androsynth"),+ (":androsynth","androsynth"),+ ("A","ascendant"),+ (":ascendant","ascendant"),+ ("c","caduceator"),+ (":caduceator","caduceator"),+ ("e","encephalon"),+ (":encephalon","encephalon"),+ ("g","goliath"),+ (":goliath","goliath"),+ ("h","hellion"),+ (":hellion","hellion"),+ ("k","kraken"),+ (":kraken","kraken"),+ ("m","myrmidon"),+ (":myrmidon","myrmidon"),+ ("p","perennial"),+ (":perennial","perennial"),+ ("r","reptilian"),+ (":reptilian","reptilian"),+ ("R","recreant"),+ (":recreant","recreant"),+ (".","reroll"),+ (":reroll","reroll"),+ ("b","barbarian"),+ (":barbarian","barbarian"),+ ("c","consular"),+ (":consular","consular"),+ ("e","engineer"),+ (":engineer","engineer"),+ ("a","forceadept"),+ (":force-adept","forceadept"),+ ("m","marine"),+ (":marine","marine"),+ ("n","ninja"),+ (":ninja","ninja"),+ ("p","pirate"),+ (":pirate","pirate"),+ ("s","scout"),+ (":scout","scout"),+ ("S","shepherd"),+ (":shepherd","shepherd"),+ ("t","thief"),+ (":thief","thief"),+ ("w","warrior"),+ (":warrior","warrior"),+ ("#quit","quit"),+ (",","pickup"),+ (":pickup","pickup"),+ ("d","drop"),+ (":drop","drop"),+ ("w","wield"),+ (":wield","wield"),+ ("-","unwield"),+ (":unwield","unwield"),+ (":fire-n","fire-n"),+ (":fire-s","fire-s"),+ (":fire-w","fire-w"),+ (":fire-e","fire-e"),+ (":fire-new","fire-nw"),+ (":fire-ne","fire-ne"),+ (":fire-sw","fire-sw"),+ (":fire-se","fire-sw"),+ (":continue","continue")]
+ src/Keymaps/Keymaps.lhs view
@@ -0,0 +1,77 @@+\section{Keymaps}++\texttt{Keymap}s are simple mappings from a sequence of keystrokes to the names of various commands.++\begin{code}+module Keymaps.Keymaps+    (Keymap,+     KeymapName,+     fixKeymap,+     filterKeySequence,+     keysToActionNames,+     actionNameToKeys)+    where++import Actions+import Data.List+import Control.Monad++type Keymap = [(String,String)]+type KeymapName = String+\end{code}++\texttt{fixKeymap} processes a keymap to make it usable.  If you type in a multi-character command and it executes before you press enter,+you forgot to use \texttt{fixKeymap}.++\begin{code}+fixKeymap :: Keymap -> Keymap+fixKeymap = concatMap $ \(x,y) -> +    case x of+        [c] -> [([c],y)]+	('>':keystrokes) | (not $ null keystrokes) -> [(keystrokes,y)]+	command -> let keystrokes = concat $ intersperse "-" $ words command in [(keystrokes ++ "\r",y),(keystrokes ++ "\n",y)]+\end{code}++\texttt{validKeyMap} reduces a \texttt{Keymap} to one that contains only those actions that are valid at this instant.++\begin{code}+validKeyMap :: ActionInput -> Keymap -> IO [(String,String)]+validKeyMap action_input raw_keymap =+    do valid_actions <- getValidActions action_input Nothing+       return $ filter (\x -> snd x `elem` valid_actions) raw_keymap+\end{code}++\texttt{filterKeySequence} transforms a key sequence into either the empty string, if it isn't the prefix of any valid action,+or completes the key sequence if it is the prefix of exactly one valid action.++\begin{code}+filterKeySequence :: ActionInput -> Keymap -> String -> IO String+filterKeySequence _ _ key_sequence | (length $ words key_sequence) == 0 = return ""+filterKeySequence action_input keymap key_sequence =+    do valid_key_map <- validKeyMap action_input keymap+       let possible_completions = filter (\x -> elem key_sequence $ inits x) $ map fst $ valid_key_map+       return $ case length possible_completions of+		 0 -> ""+		 1 -> if key_sequence /= head possible_completions+		      then init $ head possible_completions+		      else key_sequence+		 _ -> maximumBy (\x -> \y -> compare (length x) (length y)) $ foldr1 intersect $ map inits possible_completions+\end{code}++\texttt{keysToActionNames} gets a list of the names of all action that could be exected by the given key sequence at this instant.+A result of zero indicates that the key sequence isn't a valid command.  A result with more than one element indicates+a collision in the key map, which is an error.++\begin{code}+keysToActionNames :: ActionInput -> Keymap -> String -> IO [String]+keysToActionNames action_input keymap key_sequence = +    liftM (map snd . filter (\x -> fst x == key_sequence)) $ validKeyMap action_input keymap +\end{code}++\texttt{actionNameToKeys} provides reverse lookup versus keysToActionNames.++\begin{code}+actionNameToKeys :: ActionInput -> Keymap -> String -> IO [String]+actionNameToKeys action_input keymap action_name = +    liftM (map fst . filter (\x -> snd x == action_name)) $  validKeyMap action_input keymap+\end{code}
+ src/Keymaps/NumpadKeymap.hs view
@@ -0,0 +1,21 @@+module Keymaps.NumpadKeymap+    (numpad_movement_keymap,numpad_keymap)+    where++import Keymaps.CommonKeymap+import Keymaps.Keymaps++numpad_movement_keymap :: MovementKeymap+numpad_movement_keymap = MovementKeymap {+    mk_n = "8",+    mk_s = "2",+    mk_w = "4",+    mk_e = "6",+    mk_nw = "7",+    mk_ne = "9",+    mk_sw = "1",+    mk_se = "3" }++numpad_keymap :: Keymap+numpad_keymap =+   commonMovementKeymap numpad_movement_keymap ++ common_keymap
+ src/Keymaps/VIKeymap.hs view
@@ -0,0 +1,21 @@+module Keymaps.VIKeymap+    (vi_movement_keymap,vi_keymap)+    where++import Keymaps.Keymaps+import Keymaps.CommonKeymap++vi_movement_keymap :: MovementKeymap+vi_movement_keymap = MovementKeymap {+    mk_n = "k",+    mk_s = "j",+    mk_w = "h",+    mk_e = "l",+    mk_nw = "y",+    mk_ne = "u",+    mk_sw = "b",+    mk_se = "n" }++vi_keymap :: Keymap+vi_keymap =+   commonMovementKeymap vi_movement_keymap ++ common_keymap
src/Limbs.lhs view
@@ -11,10 +11,8 @@     where import VisibleObject import Animation-import RSAGL.Animation import RSAGL.Joint import RSAGL.Affine-import Models.Library import Models.LibraryData import Control.Arrow import RSAGL.Vector
src/Main.lhs view
@@ -10,7 +10,6 @@ import System.IO import PrintText --import Quality-import Data.IORef import Data.Maybe import Data.List import Graphics.UI.GLUT@@ -26,15 +25,12 @@ --import Camera import Animation import RSAGL.Scene-import RSAGL.Vector-import RSAGL.Angle-import Control.Arrow import Models.Library import System.Timeout import System.Exit  roguestar_client_version :: String-roguestar_client_version = "0.2.1"+roguestar_client_version = "0.2.2"  default_window_size :: Size default_window_size = Size 800 600
src/Models/MachineParts.hs view
@@ -6,7 +6,6 @@      import Quality import RSAGL.Model-import RSAGL.ModelingExtras import RSAGL.CurveExtras import RSAGL.Affine import RSAGL.Vector
src/Models/PhaseWeapons.hs view
@@ -6,7 +6,6 @@ import Models.Materials import RSAGL.Vector import RSAGL.Model-import RSAGL.ModelingExtras import RSAGL.Affine import RSAGL.CurveExtras import RSAGL.Angle
src/Models/QuestionMark.hs view
@@ -2,7 +2,6 @@     (question_mark)     where     -import Quality import RSAGL.Model import RSAGL.ModelingExtras import RSAGL.Affine
src/Models/Recreant.hs view
@@ -5,8 +5,6 @@ import Quality import RSAGL.Model import RSAGL.CurveExtras-import RSAGL.Material-import RSAGL.ModelingExtras import RSAGL.Vector import RSAGL.Affine import Models.Materials
src/Models/RecreantFactory.hs view
@@ -4,11 +4,7 @@      import Quality import RSAGL.Model-import RSAGL.CurveExtras-import RSAGL.Material-import RSAGL.ModelingExtras import RSAGL.Vector-import RSAGL.Affine import Models.Materials  recreant_factory :: Quality -> Modeling ()
src/Models/Terrain.lhs view
@@ -12,7 +12,6 @@ import RSAGL.ModelingExtras import Models.Tree import RSAGL.Vector-import RSAGL.Curve import RSAGL.Interpolation import RSAGL.Affine import RSAGL.Angle
src/Models/Tree.hs view
@@ -6,9 +6,7 @@ import RSAGL.ModelingExtras import RSAGL.Vector import Control.Monad.Random-import Control.Monad.Trans import Quality-import Control.Monad import RSAGL.Affine import RSAGL.AbstractVector import RSAGL.Interpolation
src/RenderingControl.lhs view
@@ -27,14 +27,12 @@ import RSAGL.Time import RSAGL.AbstractVector import VisibleObject-import Data.Fixed import RSAGL.InverseKinematics import RSAGL.AnimationExtras import Actions import Strings import Control.Applicative import qualified Data.Map as Map-import Data.Monoid import Limbs import RSAGL.Joint import RSAGL.AbstractVector
src/Tables.lhs view
@@ -14,7 +14,6 @@ import Data.Maybe import RSAGL.Time import Control.Monad-import RSAGL.AbstractVector \end{code}  \texttt{RoguestarTable} is a crude implementation of a relational data table that is used to represent information that has been sent to us from roguestar-engine.
src/VisibleObject.lhs view
@@ -35,7 +35,6 @@ import RSAGL.Angle import RSAGL.Affine import RSAGL.CoordinateSystems-import Control.Applicative import qualified Data.Set as Set import qualified Data.Map as Map import Control.Monad