├── .gitignore
├── Api.hs
├── Botland
├── Control.hs
├── GameState.hs
├── Helpers.hs
├── Middleware.hs
├── Tick.hs
└── Types.hs
├── README.md
├── Test.hs
├── ai
├── app.coffee
└── lib.coffee
├── bin
├── install
└── setup
├── botland.cabal
├── ggg.js
├── package.json
├── public
├── assets
│ ├── angbandtk
│ │ ├── bgtile.png
│ │ ├── dg_armor32.gif
│ │ ├── dg_classm32.gif
│ │ ├── dg_dragon32.gif
│ │ ├── dg_dungeon32.gif
│ │ ├── dg_edging132.gif
│ │ ├── dg_edging232.gif
│ │ ├── dg_edging332.gif
│ │ ├── dg_effects32.gif
│ │ ├── dg_extra132.gif
│ │ ├── dg_features32.gif
│ │ ├── dg_food32.gif
│ │ ├── dg_grounds32.gif
│ │ ├── dg_humans32.gif
│ │ ├── dg_iso32.gif
│ │ ├── dg_jewls32.gif
│ │ ├── dg_magic32.gif
│ │ ├── dg_misc32.gif
│ │ ├── dg_monster132.gif
│ │ ├── dg_monster232.gif
│ │ ├── dg_monster332.gif
│ │ ├── dg_monster432.gif
│ │ ├── dg_monster532.gif
│ │ ├── dg_monster632.gif
│ │ ├── dg_monster732.gif
│ │ ├── dg_people32.gif
│ │ ├── dg_potions32.gif
│ │ ├── dg_town032.gif
│ │ ├── dg_town132.gif
│ │ ├── dg_town232.gif
│ │ ├── dg_town332.gif
│ │ ├── dg_town432.gif
│ │ ├── dg_town532.gif
│ │ ├── dg_town632.gif
│ │ ├── dg_town732.gif
│ │ ├── dg_town832.gif
│ │ ├── dg_town932.gif
│ │ ├── dg_undead32.gif
│ │ ├── dg_uniques32.gif
│ │ ├── dg_wands32.gif
│ │ ├── dg_weapons32.gif
│ │ └── townactions.gif
│ ├── css
│ │ ├── lib.css
│ │ ├── sprites.css
│ │ └── style.css
│ ├── headerbg.png
│ ├── headerbg2.png
│ ├── js
│ │ ├── async.min.js
│ │ ├── jquery.min.js
│ │ └── moment.min.js
│ ├── knightsquest.ttf
│ ├── logo.png
│ ├── logo2.png
│ ├── robot.ttf
│ └── robothead.ttf
├── demo
│ ├── api.js
│ ├── chaosbot.html
│ └── cleanupbot.js
├── screen.png
└── viewer
│ ├── viewer.css
│ ├── viewer.html
│ └── viewer.js
└── test
└── test.js
/.gitignore:
--------------------------------------------------------------------------------
1 | .DS_Store
2 | log
3 | sandbox
4 | *.hi
5 | *.o
6 | dist/*
7 | *.sublime*
8 | Api
9 | node_modules
10 | *.log
11 | public/assets/cute
12 | .ggg/_main.js
13 | cabal-dev
14 | log.txt
15 |
--------------------------------------------------------------------------------
/Api.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
2 |
3 | module Main where
4 |
5 | import Botland.Helpers
6 | import Botland.Types
7 | import Botland.Control
8 | import Botland.Middleware
9 | import Botland.Tick
10 |
11 | import Database.MongoDB (runIOE, connect, access, master, host, Pipe, Action)
12 |
13 | import Control.Concurrent (forkIO, threadDelay)
14 | import Control.Monad.IO.Class (liftIO)
15 |
16 | import Data.Text.Lazy (Text, pack)
17 |
18 | import Network.Wai.Middleware.Headers (cors)
19 | import Network.Wai.Middleware.Static (staticRoot)
20 | import Web.Scotty
21 |
22 | import System.IO
23 |
24 |
25 | main :: IO ()
26 | main = do
27 |
28 | -- without this you don't see any log output
29 | hSetBuffering stdout LineBuffering
30 | putStrLn "Starting BOTLAND"
31 |
32 | pipe <- connectMongo
33 | let db action = liftIO $ access pipe master "botland" action
34 | let auth = runAuth pipe "botland"
35 |
36 | -- recurring tasks
37 | forkIO $ cleanup db
38 | forkIO $ runTick gameInfo db
39 |
40 | scotty 3026 $ do
41 |
42 | middleware $ staticRoot "public"
43 | middleware cors
44 |
45 | get "/" $ do
46 | redirect "/viewer/"
47 |
48 | get "/viewer" $ do
49 | cache minute
50 | header "Content-Type" "text/html"
51 | file "public/viewer/viewer.html"
52 |
53 | get "/docs" $ do
54 | cache minute
55 | header "Content-Type" "text/html"
56 | file "public/docs/docs.html"
57 |
58 | get "/version" $ text "Botland 0.3.0"
59 |
60 | get "/game/info" $ do
61 | cache minute
62 | json gameInfo
63 |
64 | -- returns all the bots, obstacles and whathaveyounots
65 | -- everything except playerId
66 | get "/game/objects" $ do
67 | {- cache second-}
68 | res <- db $ objects
69 | sendAction "" res
70 |
71 | -- really, just gives you a session id, but pretend that it matters :)
72 | -- works because it's a secret number, never sent to anyone
73 | post "/players" $ decodeBody $ \p -> do
74 | id <- db $ createPlayer p
75 | sendActionFault "" id
76 |
77 | get "/players/:name" $ do
78 | cache minute
79 | n <- param "name"
80 | p <- db $ getPlayerByName n
81 | sendActionMaybe "Could not find player" p
82 |
83 | -- spawn them immediately, don't wait for the tick
84 | post "/players/:playerId/minions" $ decodeBody $ \b -> do
85 | pid <- param "playerId"
86 | id <- db $ createBot gameInfo pid b
87 | sendActionFault "Invalid Starting Location" id
88 |
89 | get "/minions/:minionId" $ do
90 | cache second
91 | id <- param "minionId"
92 | bot <- db $ botDetails id
93 | sendActionFault "" bot
94 |
95 | -- LEADERBOARDS (undocumented, the viewer can just use the normal objects call)
96 | get "/top/killers" $ do
97 | cache second
98 | bots <- db $ topKillers
99 | sendAction "" bots
100 |
101 | get "/top/survivors" $ do
102 | cache second
103 | bots <- db $ topSurvivors
104 | sendAction "" bots
105 |
106 |
107 | -- sets the bot's action
108 | post "/players/:playerId/minions/:minionId/commands" $ auth $ decodeBody $ \c -> do
109 | mid <- param "minionId"
110 | pid <- param "playerId"
111 | res <- db $ setCommand c gameInfo pid mid
112 | sendAction "" res
113 |
114 | -- delete all bots associated with the player
115 | delete "/players/:playerId" $ do
116 | pid <- param "playerId"
117 | ok <- db $ cleanupPlayer pid
118 | sendAction "Could not delete player" ok
119 |
120 | delete "/players/:playerId/minions/:minionId" $ auth $ do
121 | mid <- param "minionId"
122 | ok <- db $ cleanupBot mid
123 | sendAction "Could not delete minion" ok
124 |
125 |
126 |
127 |
128 |
129 |
130 |
131 |
--------------------------------------------------------------------------------
/Botland/Control.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings, ExtendedDefaultRules, DoAndIfThenElse #-}
2 |
3 | module Botland.Control where
4 |
5 | import Botland.Types
6 | import Botland.GameState
7 |
8 | import Control.Monad.IO.Class (liftIO)
9 | import Control.Monad (forM_)
10 |
11 | import Data.Map (assocs)
12 | import Data.Maybe (isNothing, fromJust, isJust)
13 | import Data.DateTime (DateTime, addSeconds, getCurrentTime)
14 |
15 | import Database.MongoDB hiding (Field)
16 |
17 | import Web.Scotty (ActionM(..))
18 |
19 | -- randomId stuff
20 | import System.Random (randomIO)
21 | import Numeric (showIntAtBase)
22 | import Data.Char (intToDigit)
23 |
24 |
25 | -- SETUP ----------------------------------------------------------
26 | connectMongo :: IO (Pipe)
27 | connectMongo = runIOE $ connect (host "127.0.0.1")
28 |
29 | ensureIndexes :: Action IO ()
30 | ensureIndexes = do
31 |
32 | -- I query by location when someone spawns
33 | ensureIndex (Index "bots" ["x" =: 1, "y" =: 1] "xy" False False)
34 |
35 | -- for leaderboards
36 | ensureIndex (Index "bots" ["kills" =: -1] "kills" False False)
37 | ensureIndex (Index "bots" ["created" =: 1] "created" False False)
38 |
39 | -- for ownership
40 | ensureIndex (Index "bots" ["playerId" =: 1] "bot_player_id" False False)
41 |
42 | -- for commands
43 | ensureIndex (Index "bots" ["speed" =: -1] "bot_speed" False False)
44 |
45 | -- to look up a player. Unique index. Can't have two players with the same name
46 | ensureIndex (Index "players" ["name" =: 1] "player_name" True True)
47 |
48 | -- for cleanup
49 | ensureIndex (Index "players" ["heartbeat" =: 1] "player_heartbeat" False False)
50 |
51 | botOwner :: String -> String -> Action IO Bool
52 | botOwner pid botId = do
53 | m <- findOne (select ["_id" =: botId, "playerId" =: pid] "bots") {project = ["_id" =: 1]}
54 | return $ isJust m
55 |
56 |
57 | -- DETAILS --------------------------------------------------------
58 |
59 | botDetails :: String -> Action IO (Either Fault Bot)
60 | botDetails id = do
61 | d <- findOne (select ["_id" =: id] "bots")
62 |
63 | if (isNothing d) then
64 | return $ Left NotFound
65 | else do
66 |
67 | return $ Right $ fromDoc (fromJust d)
68 |
69 | topKillers :: Action IO [Bot]
70 | topKillers = do
71 | c <- find (select ["kills" =: ["$gt" =: 0]] "bots") {sort = ["kills" =: -1], limit = 10}
72 | ds <- rest c
73 | return $ map fromDoc ds
74 |
75 | topSurvivors :: Action IO [Bot]
76 | topSurvivors = do
77 | c <- find (select [] "bots") {sort = ["created" =: 1], limit = 10}
78 | ds <- rest c
79 | return $ map fromDoc ds
80 |
81 |
82 |
83 | -- PLAYER ---------------------------------------------------------
84 |
85 | getPlayerByName :: String -> Action IO (Maybe Player)
86 | getPlayerByName n = getPlayer ["name" =: n]
87 |
88 | getPlayerById :: String -> Action IO (Maybe Player)
89 | getPlayerById id = getPlayer ["_id" =: id]
90 |
91 | {-getPlayer :: Field -> Action IO (Maybe Player)-}
92 | getPlayer s = do
93 | md <- findOne (select s "players") {project = ["_id" =: 0]}
94 | case md of
95 | Nothing -> return Nothing
96 | Just d -> return $ Just $ fromDoc d
97 |
98 | -- we provide a random id. It is your secret id from now on, and you use it to control your bots
99 | createPlayer :: Player -> Action IO (Either Fault Id)
100 | createPlayer p = do
101 |
102 | let name = (playerName p)
103 |
104 | active <- isPlayerNameActive name
105 |
106 | if (active) then
107 | return $ Left $ Fault "Player name already exists and is still active"
108 | else do
109 |
110 | -- remove any player of that name (if they're still there, they are inactive)
111 | deletePlayerByName name
112 |
113 | -- now, register the new player with a brand new id
114 | id <- randomId
115 | let p' = p { playerId = id }
116 | save "players" (toDoc p')
117 | updateHeartbeat id
118 | return $ Right $ Id id
119 |
120 | isPlayerNameActive :: String -> Action IO Bool
121 | isPlayerNameActive name = do
122 | c <- count (select ["name" =: name, "active" =: True] "players")
123 | return (c > 0)
124 |
125 | -- CREATION -------------------------------------------------------
126 |
127 | createBot :: GameInfo -> String -> Bot -> Action IO (Either Fault Id)
128 | createBot g pid b = do
129 | id <- randomId
130 | time <- now
131 |
132 | -- get player information
133 | mp <- getPlayerById pid
134 | if (isNothing mp) then
135 | return $ Left $ Fault "Player Not Found"
136 | else do
137 |
138 | let p = fromJust mp
139 | pn = playerName p
140 |
141 | let ub = b { botId = id, botPlayerId = pid, player = pn, created = time }
142 |
143 | -- check is valid position
144 | let v = validPosition g (point b)
145 | if (not v) then
146 | return $ Left InvalidPosition
147 | else do
148 |
149 | -- check is occupied
150 | occupied <- locationOccupied (point ub)
151 | if (occupied) then
152 | return $ Left InvalidPosition
153 | else do
154 |
155 | insert_ "bots" (toDoc ub)
156 |
157 | return $ Right $ Id id
158 |
159 | locationOccupied :: Point -> Action IO Bool
160 | locationOccupied p = do
161 | c <- count (select ["x" =: (x p), "y" =: (y p), "state" =: Active] "bots")
162 | return (c > 0)
163 |
164 |
165 | -- GAME STATE -----------------------------------------------------
166 |
167 | botsBySpeed :: Action IO [Bot]
168 | botsBySpeed = do
169 | c <- find (select [] "bots") {sort = ["speed" =: -1]}
170 | docs <- rest c
171 | return $ map fromDoc docs
172 |
173 | updateBot :: Bot -> Action IO ()
174 | updateBot b = do
175 | let p = point b
176 | modify (select ["_id" =: botId b] "bots") ["$set" =: ["x" =: x p, "y" =: y p, "state" =: botState b, "kills" =: kills b]]
177 |
178 | clearCommands :: Action IO ()
179 | clearCommands = do
180 | modify (select [] "bots") ["$unset" =: ["command" =: 1]]
181 |
182 | removeDeadBots :: Action IO ()
183 | removeDeadBots = do
184 | delete (select ["state" =: Dead] "bots")
185 |
186 | -- ACTIONS --------------------------------------------------------
187 |
188 | setCommand :: BotCommand -> GameInfo -> String -> String -> Action IO ()
189 | setCommand c g pid id = do
190 | updateHeartbeat pid
191 |
192 | -- later, speed will be set via items. For now, let's set it randomly so bots
193 | -- at the top don't have an advantage
194 | s <- randomSpeed
195 |
196 | modify (select ["_id" =: id] "bots") ["$set" =: ["command" =: c, "speed" =: s]]
197 |
198 |
199 | -- CLEANUP ---------------------------------------------------------
200 |
201 | -- save when the player last completed an action
202 | -- mark them as active
203 | updateHeartbeat :: String -> Action IO ()
204 | updateHeartbeat pid = do
205 | time <- now
206 | modify (select ["_id" =: pid] "players") ["$set" =: ["heartbeat" =: time, "active" =: True]]
207 |
208 | cleanupPlayer :: String -> Action IO Ok
209 | cleanupPlayer id = do
210 | liftIO $ putStrLn ("Cleaning Up " ++ id)
211 | delete (select ["playerId" =: id] "bots")
212 |
213 | -- Marks the player as inactive, so someone can create over it if they want
214 | modify (select ["_id" =: id] "players") ["$set" =: ["active" =: False]]
215 |
216 | return Ok
217 |
218 | -- deletes a player by name so you can re-register the name
219 | deletePlayerByName :: String -> Action IO ()
220 | deletePlayerByName name = do
221 | delete (select ["name" =: name] "players")
222 |
223 | cleanupBot :: String -> Action IO Ok
224 | cleanupBot botId = do
225 | delete (select ["_id" =: botId] "bots")
226 | return Ok
227 |
228 | cleanupInactives :: Integer -> Action IO Ok
229 | cleanupInactives delay = do
230 |
231 | time <- now
232 | let cutoffTime = addSeconds (-delay) time
233 |
234 | -- query for inactive players
235 | c <- find (select ["heartbeat" =: ["$lt" =: cutoffTime], "active" =: True] "players")
236 | docs <- rest c
237 |
238 | let ids = map playerId $ map fromDoc docs
239 |
240 | mapM_ cleanupPlayer ids
241 | return Ok
242 |
243 |
244 |
245 |
246 |
247 | -- THE WORLD -------------------------------------------------------
248 |
249 | objects :: Action IO [Bot]
250 | objects = do
251 | c <- find (select [] "bots") {project = ["id" =: 1, "x" =: 1, "y" =: 1, "name" =: 1, "sprite" =: 1, "player" =: 1, "state" =: 1, "kills" =: 1, "created" =: 1]}
252 | bs <- rest c
253 | return $ map fromDoc bs
254 |
255 |
256 |
257 |
258 | -- HELPERS ----------------------------------------------------------
259 |
260 | now :: Action IO DateTime
261 | now = liftIO $ getCurrentTime
262 |
263 | randomId :: Action IO String
264 | randomId = do
265 | i <- liftIO $ randomIO
266 | return $ intToHex i
267 |
268 | randomSpeed :: Action IO Int
269 | randomSpeed = do
270 | i <- liftIO $ randomIO
271 | return i
272 |
273 | intToHex :: Int -> String
274 | intToHex i = showIntAtBase 16 intToDigit (abs i) ""
275 |
--------------------------------------------------------------------------------
/Botland/GameState.hs:
--------------------------------------------------------------------------------
1 | module Botland.GameState where
2 |
3 | import Botland.Types
4 |
5 | import Control.Monad.State
6 | import Control.Monad (when, unless)
7 |
8 | import Data.Map (Map, insert, delete, lookup, elems, empty)
9 | import Data.Maybe (isJust)
10 |
11 | import Prelude hiding (lookup)
12 |
13 |
14 | -- GAME STATE ------------------------------------------------
15 |
16 | type GameState a = State Game a
17 |
18 | data Game = Game { info :: GameInfo, bots :: Map String Bot, points :: Map Point String } deriving (Show)
19 |
20 | emptyGame :: GameInfo -> Game
21 | emptyGame i = Game i empty empty
22 |
23 | addBots :: [Bot] -> GameState ()
24 | addBots bs = mapM_ update bs
25 |
26 | toBots :: Game -> [Bot]
27 | toBots gs = elems (bots gs)
28 |
29 | insertBot :: Bot -> Game -> Game
30 | insertBot b (Game i bs ps) =
31 | let id = botId b
32 | bs' = insert id b bs
33 | ps' = insert (point b) id ps
34 | in Game i bs' ps'
35 |
36 | update :: Bot -> GameState ()
37 | update b = do
38 | g <- get
39 | put $ insertBot b g
40 |
41 | isOccupied :: Point -> Game -> Bool
42 | isOccupied p g = isJust $ lookup p (points g)
43 |
44 | atPoint :: Point -> GameState (Maybe Bot)
45 | atPoint p = do
46 | s <- get
47 | return $ atPoint' p s
48 |
49 | atPoint' :: Point -> Game -> Maybe Bot
50 | atPoint' p s = do
51 | let bs = bots s
52 | ps = points s
53 |
54 | id <- lookup p ps
55 | b <- lookup id bs
56 | return b
57 |
58 | onMap :: Point -> Game -> Bool
59 | onMap p (Game info _ _) = validPosition info p
60 |
61 | clear :: Point -> GameState ()
62 | clear p = do
63 | s <- get
64 | let ps = delete p (points s)
65 | put $ s { points = ps }
66 |
67 | validPosition :: GameInfo -> Point -> Bool
68 | validPosition g (Point x y) = 0 <= x && x < (width g) && 0 <= y && y < (height g)
69 |
70 | skipIf :: (Game -> Bool) -> GameState () -> GameState ()
71 | skipIf p k = do
72 | g <- get
73 | unless (p g) k
74 |
75 |
76 |
--------------------------------------------------------------------------------
/Botland/Helpers.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings, FlexibleInstances, UndecidableInstances #-}
2 |
3 | module Botland.Helpers where
4 |
5 | import Botland.Types hiding (Direction(..))
6 |
7 | import Control.Monad.Trans.Resource (runResourceT)
8 | import Control.Monad.IO.Class (liftIO)
9 |
10 | import Database.MongoDB (Failure(..))
11 |
12 | import Data.Aeson (decode, ToJSON, FromJSON, encode)
13 | import qualified Data.Aeson as A
14 | import qualified Data.ByteString.Lazy.Char8 as L
15 | import qualified Data.ByteString as B
16 | import Data.ByteString.Char8 (ByteString, pack, unpack)
17 | import Data.Conduit.Lazy (lazyConsume)
18 | import qualified Data.Text.Lazy as T
19 | import Data.Text.Lazy (append)
20 |
21 | import Network.HTTP.Types (status404, status500, status400, status401, status200, status403, status501)
22 |
23 | import Web.Scotty (ActionM, request, raise, status, text, redirect, rescue, header, json, param)
24 | import qualified Web.Scotty
25 |
26 | -- converts a lazy bytestring to strict bytestring
27 | l2b :: L.ByteString -> B.ByteString
28 | l2b = B.concat . L.toChunks
29 |
30 | b2l :: B.ByteString -> L.ByteString
31 | b2l l = L.fromChunks [l]
32 |
33 | b2t :: B.ByteString -> T.Text
34 | b2t = T.pack . unpack
35 |
36 |
37 | -- cache things
38 | cache :: Integer -> ActionM ()
39 | cache seconds = header "Cache-Control" ("max-age=" `append` (T.pack $ show seconds) `append` ", must-revalidate")
40 |
41 | second :: Integer
42 | second = 1
43 |
44 | minute :: Integer
45 | minute = 60
46 |
47 | hour :: Integer
48 | hour = 3600
49 |
50 | day :: Integer
51 | day = 84600
52 |
53 |
54 | --class Sendable a where
55 | -- send :: a -> ActionM ()
56 |
57 | --class Woot where
58 | -- woot :: String
59 |
60 | --instance (ToJSON a) Response a where
61 | --instance Response Fault where
62 |
63 | -- handles the fault checking, sending proper stuff
64 |
65 | --instance (Sendable a) => Sendable (Either Failure a) where
66 | -- send m ea
67 |
68 | --instance (ToJSON a) => Sendable a where
69 | -- send a = do
70 | -- status status200
71 | -- json a
72 |
73 |
74 | -- I want the method to work on all sorts of different stuff
75 | -- bah, lame-pants
76 | -- well, wait, all I have to do is CONVERT the different types of things to other things
77 | -- I could write a bunch of functions to do that
78 | -- unique functions, with unique names.
79 |
80 | -- just make different functions for the different things, and don't call them "send"
81 |
82 |
83 | sendAction :: (ToJSON a) => String -> Either Failure a -> ActionM ()
84 | sendAction _ (Left (DocNotFound _)) = do
85 | status status404
86 | sendAction m (Left (QueryFailure _ _)) = do
87 | status status400
88 | json $ Fault m
89 | sendAction m (Left (WriteFailure _ _)) = do
90 | status status400
91 | json $ Fault m
92 | sendAction _ (Left _) = do
93 | status status500
94 | json $ Fault "Database Error"
95 | sendAction _ (Right a) = json a
96 |
97 | sendActionFault :: (ToJSON a) => String -> Either Failure (Either Fault a) -> ActionM()
98 | sendActionFault m (Right efa) = case efa of
99 | Left f -> fault f
100 | Right a -> json a
101 | sendActionFault m f = sendAction m f
102 |
103 |
104 | sendActionMaybe :: (ToJSON a) => String -> Either Failure (Maybe a) -> ActionM()
105 | sendActionMaybe m (Right ma) = case ma of
106 | Nothing -> fault $ NotFound
107 | Just a -> json a
108 | sendActionMaybe m failure = sendAction "" failure
109 |
110 |
111 | -- send a non-mongo fault
112 | fault :: Fault -> ActionM ()
113 | fault f = do
114 | case f of
115 | NotAuthorized -> status status403
116 | NotFound -> status status400
117 | InvalidPosition -> status status400
118 | NotImplemented -> status status501
119 | _ -> status status500
120 | json f
121 |
122 |
123 |
124 |
125 |
126 |
127 |
128 |
--------------------------------------------------------------------------------
/Botland/Middleware.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Botland.Middleware where
4 |
5 | import Botland.Types hiding (Direction(..))
6 | import Botland.Control
7 | import Botland.Helpers
8 |
9 | import Control.Monad.IO.Class (liftIO)
10 |
11 | import Data.Aeson (FromJSON, decode)
12 | import Data.ByteString.Lazy.Char8 (ByteString, unpack)
13 |
14 | import Database.MongoDB (Action, Pipe, access, master, Database)
15 |
16 | import Network.HTTP.Types (status400)
17 |
18 | import Web.Scotty
19 |
20 | -- lets you make sure they have control over a bot before letting them play with it
21 | runAuth :: Pipe -> Database -> ActionM () -> ActionM ()
22 | runAuth pipe d k = do
23 | let mongo action = liftIO $ access pipe master d action
24 |
25 | mid <- param "minionId"
26 | pid <- param "playerId"
27 | ok <- mongo $ botOwner pid mid
28 | case ok of
29 | Right True -> k
30 | _ -> fault NotAuthorized
31 |
32 |
33 | -- parse the body as something, and call "k" with the result
34 | decodeBody :: (FromJSON a) => (a -> ActionM ()) -> ActionM ()
35 | decodeBody k = do
36 | b <- body
37 | let mo = decode b
38 | case mo of
39 | Just o -> k o
40 | Nothing -> do
41 | status status400
42 | json $ Fault ("Invalid Body JSON: " ++ (unpack b))
43 |
--------------------------------------------------------------------------------
/Botland/Tick.hs:
--------------------------------------------------------------------------------
1 | module Botland.Tick where
2 |
3 | {-
4 | Botland Game Timer: gameTick runs once per game tick, updating the world and saving it out
5 | -}
6 |
7 | import Botland.Control
8 | import Botland.GameState
9 | import Botland.Types
10 |
11 | import Control.Concurrent (forkIO, threadDelay)
12 | import Control.Monad.IO.Class (liftIO)
13 | import Control.Monad.State (execState)
14 | import Control.Monad (when, unless)
15 |
16 | import qualified Data.Map as M
17 | import Data.Map (Map, insert, delete, lookup, empty)
18 | import Data.Maybe (fromMaybe, fromJust, isJust)
19 |
20 | import Database.MongoDB (Action, Failure)
21 |
22 | import Prelude hiding (lookup)
23 |
24 | import System.CPUTime (getCPUTime)
25 |
26 | type IdMap = Map String Bot
27 |
28 | gameInfo :: GameInfo
29 | gameInfo = GameInfo 25 20 1000
30 |
31 | -- long enough that it doesn't happen by accident
32 | cleanupDelay :: Integer
33 | cleanupDelay = 5
34 |
35 | cleanup :: (Action IO Botland.Types.Ok -> IO a) -> IO b
36 | cleanup db = do
37 | db $ cleanupInactives cleanupDelay
38 | threadDelay ((fromIntegral cleanupDelay)*1000000)
39 | cleanup db
40 |
41 | runTick :: GameInfo -> (Action IO () -> IO (Either Failure ())) -> IO ()
42 | runTick g db = do
43 |
44 | let delayms = tick g
45 |
46 | startTime <- getCPUTime -- picoseconds
47 |
48 | db $ gameTick g
49 |
50 | -- we need to wait 1s minus the time taken (setInterval, where are you!)
51 | endTime <- getCPUTime
52 | let elapsedps = endTime - startTime :: Integer
53 | durationµs = round $ ((fromInteger elapsedps) / 1000000) :: Integer
54 | waitµs = (delayms * 1000) - durationµs
55 |
56 | -- If you get worried that the game tick is going slow, uncomment this
57 | -- liftIO $ putStrLn ("GameTick: " ++ (show durationµs) ++ "µs")
58 |
59 | threadDelay $ fromIntegral waitµs
60 |
61 | runTick g db
62 |
63 |
64 | gameTick :: GameInfo -> Action IO ()
65 | gameTick info = do
66 | removeDeadBots
67 | bots <- botsBySpeed
68 | let state = emptyGame info
69 | let newState = execState (processActions bots) state
70 | {- liftIO $ print newState-}
71 | mapM_ updateBot $ toBots newState
72 | clearCommands
73 |
74 | processActions :: [Bot] -> GameState ()
75 | processActions bots = do
76 | addBots bots
77 | mapM_ runBotCommand bots
78 |
79 | runBotCommand :: Bot -> GameState ()
80 | runBotCommand b = case (command b) of
81 | Nothing -> return ()
82 | Just c -> runAction b (point b) c
83 |
84 | -- route the different action functions
85 | runAction :: Bot -> Point -> BotCommand -> GameState ()
86 | runAction b p (BotCommand Move d) = moveAction b p d
87 | runAction b p (BotCommand Attack d) = attackAction b p d
88 | runAction _ _ _ = return ()
89 |
90 | -- get moving working without a monad, then switch
91 | moveAction :: Bot -> Point -> Direction -> GameState ()
92 | moveAction b start d = do
93 |
94 | let dest = destination d start
95 |
96 | skipIf (not.(onMap dest)) $ do
97 | skipIf (isOccupied dest) $ do
98 |
99 | clear start
100 | update $ b { point = dest }
101 |
102 | attackAction :: Bot -> Point -> Direction -> GameState ()
103 | attackAction b p d = do
104 |
105 | let dest = destination d p
106 |
107 | mv <- atPoint dest
108 | case mv of
109 | Nothing -> return ()
110 | Just victim -> do
111 | let k = (kills b) + 1
112 | update $ victim { botState = Dead }
113 | update $ b { kills = k }
114 |
115 | -- converts a command document into a (Bot, BotCommand)
116 | botById :: IdMap -> String -> Maybe Bot
117 | botById m id = lookup id m
118 |
119 | -- creates a map of bot id to bot, for use in the other functions
120 | idMap :: [Bot] -> IdMap
121 | idMap bs = foldr a empty bs
122 | where a b m = insert (botId b) b m
123 |
124 | {-toField :: [Bot] -> Field-}
125 | {-toField bs = foldr a empty bs -}
126 | {-where a b f = insert (Point (x b) (y b)) b f-}
127 |
128 | -- Gives you the point in a given direction
129 | destination :: Direction -> Point -> Point
130 | destination d (Point x y) = case d of
131 | DLeft -> Point (x-1) y
132 | DRight -> Point (x+1) y
133 | DUp -> Point x (y-1)
134 | DDown -> Point x (y+1)
135 |
136 |
--------------------------------------------------------------------------------
/Botland/Types.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings, DeriveGeneric, DeriveDataTypeable #-}
2 |
3 | module Botland.Types where
4 |
5 | import qualified Data.Aeson as A
6 | import Data.Aeson (FromJSON(..), ToJSON(..), object, (.=), (.:), Value(..))
7 | import qualified Data.Aeson.Types as AT
8 | import Data.Aeson.Types (Parser)
9 | import Data.Bson (Val(..), Value(..))
10 | import qualified Data.Bson as B
11 | import qualified Data.CompactString.UTF8 as C
12 | import Data.Maybe (fromMaybe, isJust, fromJust)
13 | import qualified Data.Text as T
14 | import Data.DateTime (DateTime, fromSeconds)
15 | import Data.Map (Map)
16 | import Data.Typeable (Typeable)
17 |
18 | import Database.MongoDB (val, Document, Field(..), at, lookup)
19 |
20 | import Control.Applicative ((<$>), (<*>))
21 | import Control.Monad (mzero, guard)
22 |
23 | import GHC.Generics (Generic)
24 |
25 | import Prelude hiding (lookup)
26 |
27 | import Safe (readMay)
28 |
29 |
30 | type Field = Map Point Bot
31 |
32 |
33 |
34 | -- DATA TYPES ---------------------------------------------------------------
35 |
36 | -- heartbeat doesn't need to be a part of the client-side logic, just in the db
37 | data Player = Player { playerId :: String, playerName :: String, source :: String } deriving (Show)
38 |
39 | -- this is roughly what it looks like in the database
40 | -- {x, y, _id, color, playerId, name, source}
41 | data Bot = Bot { point :: Point
42 | , name :: String
43 | , player :: String
44 | , sprite :: String
45 | , botId :: String
46 | , botPlayerId :: String
47 | , kills :: Int
48 | , created :: DateTime
49 | , botState :: BotState
50 | , command :: Maybe BotCommand
51 | } deriving (Show)
52 |
53 | -- sometimes you just need to talk about a point
54 | data Point = Point { x :: Int, y :: Int }
55 | | InvalidPoint
56 | deriving (Show, Ord, Eq)
57 |
58 | -- gives the field and interval
59 | data GameInfo = GameInfo { width :: Int
60 | , height :: Int
61 | , tick :: Integer
62 | } deriving (Show, Generic)
63 |
64 | -- available actions
65 | data BotCommand = BotCommand { action :: BotAction, direction :: Direction } deriving (Show, Eq, Typeable, Generic)
66 | data Direction = DLeft | DRight | DUp | DDown deriving (Show, Read, Eq, Typeable)
67 | data BotAction = Stop | Move | Attack deriving (Show, Read, Eq, Typeable)
68 | data BotState = Active | Dead deriving (Show, Read, Eq, Typeable)
69 |
70 | -- things that can go wrong
71 | data Fault = Fault String
72 | | NotFound
73 | | NotAuthorized
74 | | NotImplemented
75 | | InvalidPosition
76 | deriving (Generic, Show)
77 |
78 | -- when I just want to send back an id
79 | data Id = Id { id :: String } deriving (Show, Generic)
80 |
81 | -- just means the server was successful
82 | data Ok = Ok deriving (Show)
83 |
84 |
85 |
86 |
87 | -- JSON SUPPORT --------------------------------------------------------------
88 |
89 | instance ToJSON GameInfo
90 | instance FromJSON GameInfo
91 |
92 | instance ToJSON Id where
93 | toJSON (Id id) = A.String $ T.pack id
94 |
95 | instance ToJSON Ok where
96 | toJSON _ = object ["ok" .= True]
97 |
98 | instance FromJSON BotCommand
99 |
100 | -- Actions --
101 | instance ToJSON BotAction where
102 | toJSON = typeToJSON show
103 |
104 | instance FromJSON BotAction where
105 | parseJSON = typeParseJSON readMay
106 |
107 |
108 | -- Direction
109 | removeFirstLetter = tail
110 | addD cs = 'D':cs
111 |
112 | instance ToJSON Direction where
113 | toJSON = typeToJSON (removeFirstLetter.show)
114 |
115 | instance FromJSON Direction where
116 | parseJSON = typeParseJSON (readMay.addD)
117 |
118 | -- State
119 | instance ToJSON BotState where
120 | toJSON = typeToJSON show
121 |
122 | instance FromJSON BotState where
123 | parseJSON = typeParseJSON readMay
124 |
125 | -- Bot
126 | -- sometimes kills exists, sometimes it doesn't
127 | -- 0 means it doesn't matter
128 | instance ToJSON Bot where
129 | toJSON b = object fs
130 | where p = point b
131 | id = botId b
132 | fs = [ "id" .= id
133 | , "x" .= x p
134 | , "y" .= y p
135 | , "name" .= name b
136 | , "player" .= player b
137 | , "sprite" .= sprite b
138 | , "state" .= botState b
139 | , "kills" .= kills b
140 | , "created" .= created b
141 | ]
142 |
143 | -- you don't need the other fields from the client. So just make them up with defaults
144 | instance FromJSON Bot where
145 | parseJSON (Object v) = do
146 | x <- v .: "x"
147 | y <- v .: "y"
148 | name <- v .: "name"
149 | sprite <- v .: "sprite"
150 | return $ Bot (Point x y) name "" sprite "" "" 0 (fromSeconds 0) Active Nothing
151 |
152 | parseJSON _ = mzero
153 |
154 |
155 | -- Player: json only has a name (not the id) --
156 | instance FromJSON Player where
157 | parseJSON (Object v) = do
158 | name <- v .: "name"
159 | source <- v .: "source"
160 | return $ Player "" name source
161 | parseJSON _ = mzero
162 |
163 | instance ToJSON Player where
164 | toJSON (Player id name source) = object ["name" .= name, "source" .= source]
165 |
166 |
167 | -- SERVER MESSAGES ----------------------------------------------------------
168 |
169 | instance FromJSON Fault where
170 | parseJSON (Object v) = Fault <$> v .: "message"
171 |
172 | instance ToJSON Fault where
173 | toJSON f = object ["message" .= message f]
174 |
175 | message :: Fault -> String
176 | message NotFound = "Not Found"
177 | message NotAuthorized = "Not Authorized"
178 | message NotImplemented = "Not Implemented"
179 | message InvalidPosition = "Invalid Position"
180 | message (Fault m) = m
181 |
182 |
183 |
184 |
185 | -- MONGODB -----------------------------------------------------------------
186 |
187 | class ToDoc a where
188 | toDoc :: a -> Document
189 |
190 | class FromDoc a where
191 | fromDoc :: Document -> a
192 |
193 | instance ToDoc Bot where
194 | toDoc b =
195 | let p = point b in
196 |
197 | [ "x" := val (x p)
198 | , "y" := val (y p)
199 | , "name" := val (name b)
200 | , "player" := val (player b)
201 | , "sprite" := val (sprite b)
202 | , "_id" := val (botId b)
203 | , "playerId" := val (botPlayerId b)
204 | , "created" := val (created b)
205 | , "state" := val (botState b)
206 | , "command" := val (command b)
207 | ]
208 |
209 | instance FromDoc Bot where
210 | fromDoc d = Bot (Point (at "x" d) (at "y" d))
211 | (at "name" d)
212 | (at "player" d)
213 | (at "sprite" d)
214 | (fromMaybe "" (lookup "_id" d))
215 | (fromMaybe "" (lookup "playerId" d))
216 | (fromMaybe 0 (lookup "kills" d))
217 | (fromMaybe (fromSeconds 0) (lookup "created" d))
218 | (at "state" d)
219 | (lookup "command" d)
220 |
221 | instance FromDoc Point where
222 | fromDoc p = Point (at "x" p) (at "y" p)
223 |
224 | instance FromDoc Player where
225 | fromDoc p = Player (fromMaybe "" (lookup "_id" p)) (at "name" p) (at "source" p)
226 |
227 | instance ToDoc Player where
228 | toDoc p = [ "_id" := val (playerId p)
229 | , "name" := val (playerName p)
230 | , "source" := val (source p)
231 | ]
232 |
233 | instance Val BotCommand where
234 | val (BotCommand a d) = val ["action" := val a, "direction" := val d]
235 | cast' (Doc d) = Just $ BotCommand (at "action" d) (at "direction" d)
236 | cast' _ = Nothing
237 |
238 | instance Val BotAction where
239 | val = typeToBSON show
240 | cast' = typeFromBSON readMay
241 |
242 | instance Val Direction where
243 | val = typeToBSON (removeFirstLetter.show)
244 | cast' = typeFromBSON (readMay.addD)
245 |
246 | instance Val BotState where
247 | val = typeToBSON show
248 | cast' = typeFromBSON readMay
249 |
250 |
251 |
252 | -- BSON HELPERS ---------------------------------------------------------------
253 |
254 | typeToBSON :: (a -> String) -> a -> B.Value
255 | typeToBSON show = val . show
256 |
257 | typeFromBSON :: (String -> Maybe a) -> B.Value -> Maybe a
258 | typeFromBSON read (B.String bs) = do
259 | m <- read $ T.unpack bs
260 | return m
261 |
262 |
263 | -- JSON HELPERS ---------------------------------------------------------------
264 |
265 | typeToJSON :: (a -> String) -> a -> A.Value
266 | typeToJSON show = A.String . T.pack . show
267 |
268 | typeParseJSON :: (String -> Maybe a) -> A.Value -> AT.Parser a
269 | typeParseJSON read (A.String t) = do
270 | let ma = read $ T.unpack t
271 | case ma of
272 | Nothing -> mzero
273 | Just a -> return a
274 | typeParseJSON _ _ = mzero
275 |
276 | --typeParseJSON (A.String t) = do
277 | -- let mt = readMay $ T.unpack t
278 | -- guard (isJust mt)
279 | -- return $ fromJust mt
280 | --typeParseJSON _ = mzero
281 |
282 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | [viewer]: http://github.com/seanhess/robotquest "RobotQuest Viewer"
2 | [source]: http://github.com/seanhess/robotquest "RobotQuest Source"
3 |
4 | RobotQuest
5 | ==========
6 |
7 |
8 |
9 | RobotQuest is a MMO, programming game. Instead of playing RobotQuest directly, you write a program that plays it for you. Your program communicates with the [game server API](#api) over HTTP by sending and receiving JSON messages.
10 |
11 | All players share a single world
12 |
13 | ~~[The Viewer][viewer] lets you watch the game being played live.~~
14 |
15 | [The Documentation](#documentation) will teach you how to connect to the game and control your minions.
16 |
17 | [The Source](http://github.com/seanhess/robotquest) is here on github
18 |
19 | Also see [Status](#status). I don't have plans to continue development. Fork and reuse at will.
20 |
21 | What can I do?
22 | --------------
23 |
24 | You can create minions (heroes or monsters), move them, and attack things near you. There is an AI player that spawns minions of increasing degrees of danger to give you trouble.
25 |
26 | What's the goal?
27 | ----------------
28 |
29 | You can see who has the most kills and has survived the longest on the [Viewer][viewer]. Other than that it's up to the players. The game will change signifiantly depending on the programs written for it and as new features are added.
30 |
31 | Rules
32 | -----
33 |
34 | Please respect the following rules. The server will eventually enforce them.
35 |
36 | 1. **Spawn with purpose** - The API allows you to spawn multiple minions per player. Explore getting minions to work together, but don't spawn one on every square or anything. Consider having internal rules, like you can only spawn a minion when you kill one.
37 |
38 | 2. **Single player per program**- You can try many different approaches to the game, but idea is that you write a program, which is a player. If you want to try a different approach, feel free to turn your old program off and use the same player name, or use a different player name, but don't spam player accounts
39 |
40 | Feature Ideas
41 | -------------
42 |
43 | * Blocks - Place walls down on the map that block movement
44 | * Gold - Collect gold
45 | * Store - Spend gold to buy items (upgrades)
46 | * Trading - Swap gold or items with other minions
47 | * Big World - Infinite or much larger world. Safe zones?
48 | * Limit Player Creation - right now it's completely open
49 | * Limit Spawning - make it a resource of some kind
50 |
51 | Technical Details
52 | -----------------
53 |
54 | The application was written in Haskell (ghc 7.2+), with the [Scotty Web Framework](http://hackage.haskell.org/package/scotty-0.0.1), [mongodb](http://www.mongodb.org/), some HTML and of course, JSON.
55 |
56 | When players issue a command, it saves those on their minion object. A game timer fires once a second, grabbing all the commands and resolving them in haskell before saving out all the changes at once.
57 |
58 | I'll write more detailed articles soon on http://seanhess.github.com. Specifically, I'd like to address the difficulties of developing a web app in haskell.
59 |
60 | To run locally
61 |
62 | 1. install haskell platform 2012
63 | 2. `cabal install cabal-dev`
64 | 3. `cabal-dev install` within the directory
65 |
66 | Status
67 | ------
68 |
69 | I don't know if I'll continue work on this. See [Feature Ideas](#feature-ideas) for where I was planning on going next.
70 |
71 | The server is not really production ready. Too many bots will make it drag down. It keeps breaking.
72 |
73 | Please fork and do whatever you want with it.
74 |
75 |
76 |
77 |
78 |
79 | Documentation
80 | =============
81 |
82 | Examples
83 |
84 | Types
85 |
86 |
95 |
96 | Routes
97 |
98 |
109 |
110 | Sprites
111 |
112 | Notes
113 | -----
114 |
115 | All routes are relative to the root domain: http://robotquest.tk
116 |
117 | curl -X GET http://robotquest.tk/game/info
118 |
119 | All types sent and received from the server are in JSON. Don't forget to set "Content-Type: application/json" and Content-Length (good libraries will do this for you)
120 |
121 | This includes the [Id](#id) type, which is just a JSON string. Run everything through your JSON parser and all will be well
122 |
123 | Supports CORS: Cross-Origin Resource Sharing. You should be able to hit the API from another domain even from a browser.
124 |
125 | Examples
126 | --------
127 |
128 | Here are three complete examples:
129 |
130 | * [AI (CoffeeScript)](https://github.com/seanhess/robotquest/blob/master/ai/app.coffee)
131 | * [Scarab (JS)](https://github.com/Rob-ot/Rob-bot)
132 | * [Zombies (PHP)](https://github.com/FrizbeeFanatic14/RoroUiraArii)
133 |
134 | The following examples are in psuedocode
135 |
136 | ### Control a minion
137 |
138 | # register our player
139 | player = {name:"example", source: "http://github.com/seanhess/robotquest"}
140 | player.id = POST "/players" player
141 |
142 | # spawn a minion
143 | minion = {x: 0, y: 5, name:"example1", sprite: "dragon-1-3"}
144 | minion.id = POST "/players/$player.id/minions" minion
145 |
146 | # move our minion
147 | POST "/minions/$player.id/minions/$minion.id" {action: "Move", direction: "Right"}
148 |
149 | # remove our minion
150 | DELETE "/minions/$player.id/minions/$minion.id"
151 |
152 | ### See what is going on
153 |
154 | game = GET "/game/info"
155 | repeatEvery game.tick
156 | objects = GET "/game/objects"
157 | for minion in objects
158 | print minion
159 |
160 |
161 | Types
162 | -----
163 |
164 | ### Fault
165 |
166 | { message: "Space occupied" }
167 |
168 | Any method can return a Fault
instead of its regular response.
169 |
170 | ### Ok
171 |
172 | "Ok"
173 |
174 | ### Id
175 |
176 | "6dc21b03a79fa15d"
177 |
178 | Note that this will include quotes when it comes down. This is valid JSON. Just run it through your normal JSON decoder and it will come out a string
179 |
180 | ### GameInfo
181 |
182 | {
183 | width: 25,
184 | height: 20,
185 | tick: 1000
186 | }
187 |
188 | `tick` - Game tick in ms. How often you can send commands and poll for information
189 |
190 | width, height
- World dimensions in squares
191 |
192 | ### Player
193 |
194 | {
195 | name: "sean",
196 | source: "http://github.com/seanhess/robotquest"
197 | }
198 |
199 | name
- A unique player name for your program.
200 | source
- Bot homepage. Source code preferred.
201 |
202 | ### Minion
203 |
204 | // To Server
205 | {
206 | name: "rat",
207 | sprite: "monster1-1-4",
208 | x: 10,
209 | y: 10
210 | }
211 |
212 | // From Server
213 | {
214 | name: "rat",
215 | sprite: "monster1-1-4",
216 | x: 10
217 | y: 10,
218 |
219 | // generated fields
220 | state: "Active",
221 | kills: 0,
222 | created: "2012-05-03T12:06:48.666Z",
223 | player: "AI",
224 | id: "6dc21b03a79fa15d",
225 | }
226 |
227 | name
- The name chosen for the minion by its player.
228 | sprite
- Player-chosen sprite
229 | x, y
- Position in squares
230 | state
- Active or Dead. If a minion dies, the server will send down Dead once, then the minion will no longer appear in the result of /game/objects
231 | player
- Name of the controlling Player
232 |
233 | ### Command
234 | Careful, I'm case sensitive!
235 |
236 | {
237 | action: "Move",
238 | direction: "Left"
239 | }
240 | action
- "Move", "Attack"
241 | direction
- "Left", "Right", "Up", or "Down"
242 |
243 |
244 | Routes
245 | ------
246 |
247 | Each route lists the url, the body it expects (if any), and what it returns. All types are JSON
248 |
249 | GET /game/info
250 | Always call this when you start. Respect the tick and size
251 | returns GameInfo
252 |
253 | GET /game/objects
254 | Call this every tick
to know where things are in the game. If a minion dies, it will come back one last time with state: "Dead"
, after which it will stop appearing in this call.
255 |
258 |
259 |
260 | POST /players
261 |
262 | Register your player. Note that the id returned from this is secret . You use it to spawn and command your minions.
263 |
264 |
267 |
268 |
271 |
272 | GET /players/:name
273 |
274 | Info about another player
275 |
276 |
279 |
280 |
281 |
282 | POST /players/:playerId/minions
283 |
284 | Spawn a minion on the map
285 |
286 |
287 |
body Minion - only send {name, sprite, x, y}
288 |
289 |
290 |
293 |
294 |
295 |
296 | GET /minions/:minionId
297 |
298 | All available details for a minion.
299 |
300 |
303 |
304 |
305 | POST /players/:playerId/minions/:minionId/commands
306 |
307 | Issue a command to one of your minions. The command will be executed at the next game tick. If you issue more than one command per tick it will replace your previous command.
308 |
309 |
312 |
313 |
316 |
317 |
318 | DELETE /players/:playerId
319 |
320 | Remove your player
321 |
322 |
325 |
326 | DELETE /players/:playerId/minions/:minionId
327 |
328 | Remove one of your minions
329 |
330 |
333 |
334 |
335 |
336 |
337 | Sprites
338 |
339 | I am using the extraordinarily complete, free, angbandtk dungeon tileset . When creating a minion, you can choose the sprite that represents it. The format is:
340 |
341 | sheet-x-y
342 |
343 | where sheet
is the name of one of the following sheets, and x
and y
are the 0-indexed offset from the top left. For example, the dark blue ghost is undead-0-0
, while the phoenix is uniques-8-5
344 |
345 | classm
346 |
347 |
348 | humans
349 |
350 |
351 | undead
352 |
353 |
354 | uniques
355 |
356 |
357 | monster5
358 |
359 |
360 | monster1
361 |
362 |
363 | monster2
364 |
365 |
366 | monster3
367 |
368 |
369 | monster4
370 |
371 |
372 | monster6
373 |
374 |
375 | monster7
376 |
377 |
378 | people
379 |
380 |
381 |
382 |
--------------------------------------------------------------------------------
/Test.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | main :: IO ()
4 | main = do
5 | putStrLn "HI"
6 | print mbe
7 |
8 |
9 | -- This example will escape!
10 | -- because of the definition of >>?
11 | mbe :: Maybe String
12 | mbe = do
13 | one <- Nothing
14 | two <- Just "two"
15 | three <- Just "three"
16 | return two
17 |
18 |
19 | either :: Either Bool String
20 | either = do
21 | one <- Right "one"
22 | two <- Right "two"
23 | three <- Right "three"
24 | return two
25 |
26 | --test :: Either Bool String
27 | --test = do
28 |
29 | class Response where
30 | response :: (ToJSON b) => a -> (Status, b)
31 |
32 | instance (ToJSON a) => Response a where
33 | response a = (status200, a)
34 |
35 | instance (Response a, Response b) => (Either a b) where
36 | response (Left a) = response a
37 | response (Right b) = response b
--------------------------------------------------------------------------------
/ai/app.coffee:
--------------------------------------------------------------------------------
1 | ###
2 | RobotQUEST AI
3 | ###
4 |
5 | # On any error: I want to log the error, then exit and reconnect. (Throw the error)
6 |
7 | {map, find, extend, filter, intersect, sortBy, last, id} = require 'underscore'
8 |
9 | lib = require './lib'
10 | {robotQuestApi, adjacent, dir, navigate, random, randomElement, id} = lib
11 | {UP, DOWN, LEFT, RIGHT, STOP, ATTACK, MOVE} = lib
12 | {directions, pointKey, distance, isHit, attack, move, stop} = lib
13 |
14 |
15 | HOST = process.env.HOST || "http://localhost:3026"
16 | AINAME = "AI"
17 | REPO = "http://github.com/seanhess/robotquest"
18 |
19 | MONSTERS = process.env.MONSTERS || 10
20 |
21 | start = (host) ->
22 |
23 | console.log "AI starting MONSTERS=#{MONSTERS} HOST=#{HOST}"
24 |
25 | player =
26 | name: AINAME
27 | source: REPO
28 |
29 | bots = []
30 |
31 | # standard error handling
32 | # should cause everything to exit
33 | # OS will respawn it
34 | onError = (err) -> console.log "ERROR", err.message
35 |
36 | api = robotQuestApi host, onError
37 |
38 | ## START
39 | api.gameInfo (info) ->
40 |
41 | api.createPlayer player, (id) ->
42 | player.id = id
43 |
44 | poll = ->
45 | api.objects (objects) ->
46 | tick objects
47 |
48 | setInterval poll, info.tick
49 |
50 | ## MONSTER ACTONS
51 | # api: the api
52 | # objects: the world
53 | # player: the player
54 | # bot: the bot
55 | # info: the game info
56 | act = (objects, bot) ->
57 | ai = find ais, (a) -> a.name() is bot.name
58 | ai.act api, info, player, objects, bot
59 |
60 | ## MAIN GAME
61 | # objects: the world
62 | tick = (objects) ->
63 |
64 | # update all our bots with info from the server
65 | bots = objects.filter(isAi).map (newBot) ->
66 | bot = find bots, (b) -> b.id is newBot.id
67 | extend bot ? {}, newBot
68 |
69 | # if there are fewer than MONSTERS objects, then make some AI!
70 | if bots.length < MONSTERS
71 | x = random info.width
72 | y = random info.height
73 | type = randomElement ais
74 | spawn(x, y, type.sprite(), type.name())
75 |
76 | bots.forEach (bot) ->
77 | act objects, bot
78 |
79 | # SPAWN
80 | spawn = (x, y, sprite, name) ->
81 | bot = {x, y, sprite, name}
82 | api.createMinion player, bot, ->
83 |
84 |
85 | ## HELPERS
86 | isAi = (bot) -> bot.player == AINAME
87 |
88 | wander = ->
89 | direction = randomElement directions
90 | action = randomElement ["Stop", "Stop", "Move"]
91 | # action = randomElement ["Move"]
92 | {action, direction}
93 |
94 | ## AI!
95 |
96 | # RAT (boring little guys, they never attack, they don't move that much!)
97 | rat =
98 | name: -> "rat"
99 | sprite: -> randomElement ["monster1-0-4", "monster1-1-4", "monster1-2-4", "monster1-3-4"]
100 | act: (api, info, player, objects, bot) ->
101 | api.command player, bot, wander(), ->
102 |
103 |
104 | # ORC: will sometimes attack you if you are next to it for 2 turns
105 | # they are slow, they take an extra turn to hit you, only if you are still next to them
106 | orc =
107 | name: -> "orc"
108 | sprite: -> randomElement ["monster1-0-2", "monster1-1-2", "monster1-5-1"]
109 | act: (api, info, player, objects, bot) ->
110 | targets = filter objects, adjacent(bot)
111 |
112 | targetIds = map targets, id
113 | slowTargetIds = intersect bot.oldTargetIds, targetIds
114 |
115 | command = if slowTargetIds.length
116 | # attack them!!!
117 | slowTarget = find targets, (b) -> b.id is slowTargetIds[0]
118 | attack(navigate(bot, slowTarget))
119 | else
120 | wander()
121 |
122 | bot.oldTargetIds = targetIds
123 |
124 | api.command player, bot, command, ->
125 |
126 |
127 | # BLARG: Wanders, but attacks perfectly if something comes near
128 | blarg =
129 | name: -> "blarg"
130 | sprite: -> randomElement [
131 | "monster2-2-6", "monster2-3-6", "monster2-4-6", "monster2-5-6"
132 | "monster2-0-7", "monster2-1-7", "monster2-2-7", "monster2-3-7", "monster2-4-7", "monster2-5-7",
133 | "monster2-0-8", "monster2-1-8", "monster2-2-8", "monster2-3-8", "monster2-4-8", "monster2-5-8"
134 | ]
135 | act: (api, info, player, objects, bot) ->
136 | targets = filter objects, adjacent(bot)
137 |
138 | command = if targets.length > 0
139 | attack(navigate(bot, targets[0]))
140 | else wander()
141 |
142 | api.command player, bot, command, ->
143 |
144 |
145 | # GOOBER: Picks the nearest target within 3 spaces or so, then attacks
146 | # TODO fix oscillation by allowing a NONE direction, in addition to a stop action
147 | demon =
148 | name: -> "demon"
149 | sprite: -> randomElement ["monster1-0-5", "monster1-1-5", "monster1-2-5", "monster1-3-5", "monster1-4-5", "monster1-5-5"]
150 | act: (api, info, player, objects, bot) ->
151 |
152 | ds = map objects, (b) ->
153 | bot: b
154 | distance: distance(bot, b)
155 |
156 | # this will also prevent you from picking yourself
157 | ds = ds.filter (obj) -> 0 < obj.distance < 3
158 |
159 | ds = sortBy ds, (obj) -> obj.distance
160 |
161 | target = ds[0]
162 |
163 | command = if target?
164 | dir = navigate bot, target.bot
165 | if target.distance is 1 then attack dir
166 | else move dir
167 | else wander()
168 |
169 | api.command player, bot, command, ->
170 |
171 | sorcerer =
172 | name: -> "sorcerer"
173 | sprite: -> "monster1-4-1"
174 | act: (api, info, player, objects, bot) ->
175 |
176 | leaders = sortBy objects, (b) -> b.kills
177 | target = last leaders
178 |
179 | command = if target? and target.id != bot.id
180 | dir = navigate bot, target
181 | if adjacent bot, target then attack dir
182 | else move dir
183 | else wander()
184 |
185 | api.command player, bot, command, ->
186 |
187 | # SLUDGE: umm...
188 |
189 | # MAGE: will hunt down the person with the most kills. At the top of the leaderboard :) Booyah!
190 | # once it acquires a target it will NEVER give up!
191 | # you must destroy it!
192 |
193 | # DRAGON: never moves. Attacks anything near it immediately.
194 |
195 | ais = [rat, rat, rat, rat, orc, orc, blarg, blarg, demon, sorcerer]
196 | #ais = [orc, demon, sorcerer]
197 | #ais = [sorcerer]
198 |
199 | if module == require.main
200 | start HOST
201 | console.log "STARTED AI. HOST=#{HOST}"
202 |
203 | ## When you command something that doesn't exist any more you get a not authorized
204 |
205 |
--------------------------------------------------------------------------------
/ai/lib.coffee:
--------------------------------------------------------------------------------
1 |
2 | request = require 'request'
3 | {map, filter} = require 'underscore'
4 | {curry} = require 'fjs'
5 |
6 | ## API
7 | robotQuestApi = (host, onError) ->
8 |
9 | respond = (cb, checkStatus = true) ->
10 | (err, rs, body) ->
11 | if err? then return onError err
12 | if checkStatus and rs.statusCode != 200
13 | return onError new Error body.message
14 | cb body
15 |
16 | gameInfo: (cb) ->
17 | request.get {url: host + "/game/info", json: true}, respond cb
18 |
19 | objects: (cb) ->
20 | request.get {url: host + "/game/objects", json: true}, respond cb
21 |
22 | createPlayer: (player, cb) ->
23 | request.post {url: host + "/players", json: player}, respond cb
24 |
25 | createMinion: (player, minion, cb) ->
26 | request.post {url: host + "/players/" + player.id + "/minions", json: minion}, respond(cb, false)
27 |
28 | command: (player, minion, command, cb) ->
29 | #console.log "COMMAND", minion.id, command
30 | request.post {url: host + "/players/" + player.id + "/minions/" + minion.id + "/commands", json: command}, respond cb
31 |
32 | # if two objects are adjacent
33 | # functional programming example! This works against ANY object that has x and y coordinates!
34 | # I don't have to be over-specific
35 | adjacent = curry (a, b) ->
36 | dirs = directions.map (d) -> dir(b, d)
37 | hits = dirs.filter isHit(a)
38 | hits.length
39 |
40 | # move point in direction
41 | dir = (point, d) ->
42 | switch d
43 | when UP then {x: point.x, y: point.y-1}
44 | when DOWN then {x: point.x, y: point.y+1}
45 | when LEFT then {x: point.x-1, y: point.y}
46 | when RIGHT then {x: point.x+1, y: point.y}
47 | else point
48 |
49 | # gives you a direction from a to b
50 | # assumes they are adjacent
51 | navigate = (a, b) ->
52 | if a.x is b.x
53 | if a.y < b.y then DOWN
54 | else UP
55 | else
56 | if a.x < b.x then RIGHT
57 | else LEFT
58 |
59 | ## HELPERS
60 |
61 | random = (n) -> Math.floor(Math.random() * n)
62 | randomElement = (vs) -> vs[random(vs.length)]
63 |
64 | UP = "Up"
65 | DOWN = "Down"
66 | LEFT = "Left"
67 | RIGHT = "Right"
68 |
69 | STOP = "Stop"
70 | ATTACK = "Attack"
71 | MOVE = "Move"
72 |
73 | directions = [UP, DOWN, LEFT, RIGHT]
74 |
75 |
76 | pointKey = (p) -> p.x + "," + p.y
77 |
78 | distance = curry (a, b) -> Math.abs(b.x - a.x) + Math.abs(b.y - a.y)
79 |
80 | isHit = curry (a, b) -> a.x is b.x and a.y is b.y
81 |
82 | attack = (direction) -> {action: ATTACK, direction}
83 |
84 | move = (direction) -> {action: MOVE, direction}
85 |
86 | stop = (d) -> {action: STOP, direction: UP}
87 |
88 | id = (a) -> a.id
89 |
90 |
91 | module.exports = {robotQuestApi, adjacent, dir, navigate, random, randomElement, UP, DOWN, LEFT, RIGHT, STOP, ATTACK, MOVE, directions, pointKey, distance, isHit, attack, move, stop, id}
92 |
93 |
--------------------------------------------------------------------------------
/bin/install:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 |
3 |
4 | echo "CABAL UPDATE"
5 | # cabal-dev update
6 |
7 | echo "CABAL INSTALL"
8 | cabal-dev install
9 |
10 | echo "Should be installed to cabal-dev/bin/botland"
11 | ls cabal-dev/bin/botland
12 |
--------------------------------------------------------------------------------
/bin/setup:
--------------------------------------------------------------------------------
1 | ## UBUNTU 11
2 |
3 | # dependencies
4 | apt-get update
5 | apt-get -y install git make wget
6 |
7 | # TODO mongodb!
8 |
9 | # install old versions to get cabal & deps
10 | apt-get -y install ghc cabal-install
11 |
12 | # install from source
13 | # https://gist.github.com/1578981
14 | # https://bbs.archlinux.org/viewtopic.php?id=94146
15 | wget http://www.haskell.org/ghc/dist/7.2.2/ghc-7.2.2-x86_64-unknown-linux.tar.bz2
16 | tar -xjvf ghc-7.2.2-x86_64-unknown-linux.tar.bz2
17 |
18 | cd ghc-7.2.2
19 |
20 | # missing library that's actually there
21 | ln -s /usr/lib/libgmp.so.10.0.1 /usr/lib/libgmp.so.3
22 |
23 | ./configure
24 | make install
25 |
26 |
27 | # install cabal-dev
28 | cabal install cabal-dev --prefix=/usr
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 | ## UBUNTU 12
38 | apt-get update
39 | apt-get -y install git make wget
40 | apt-get -y install haskell-platform # (you don't need this on the server, this is just to compile the binary)
41 |
42 | # nodejs for gogogo
43 | apt-get -y install python-software-properties
44 | add-apt-repository ppa:chris-lea/node.js
45 | apt-get update
46 | apt-get -y install nodejs npm
47 |
48 | # mongodb
49 | # locale-gen en_US # wtf?
50 | apt-get -y install mongodb
51 | start mongodb
52 |
--------------------------------------------------------------------------------
/botland.cabal:
--------------------------------------------------------------------------------
1 | Name: botland
2 | Version: 0.1
3 | Synopsis: REST-based MMO AI Programming Game
4 | Description: REST-based MMO AI Programming Game
5 | Homepage: http://seanhess.github.com
6 | Author: Sean Hess
7 | Maintainer: seanhess@gmail.com
8 |
9 | Category: Application
10 | Build-type: Simple
11 |
12 | Cabal-version: >=1.2
13 |
14 | Executable botland
15 | Main-is: Api.hs
16 | Build-depends: base >= 4 && < 5
17 | , scotty >= 0.4 && < 0.5
18 | , mongoDB >= 1.2
19 |
20 | , text
21 | , aeson
22 | , mtl
23 | , bytestring
24 | , wai-middleware-static
25 | , wai-middleware-headers
26 | , safe
27 | , datetime
28 | , either-unwrap
29 | , transformers, containers, ghc-prim, compact-string-fix, bson, random, http-types, conduit, resourcet
30 |
31 |
32 |
33 |
--------------------------------------------------------------------------------
/ggg.js:
--------------------------------------------------------------------------------
1 | // example ggg.js. Delete what you don't need
2 | module.exports = {
3 |
4 | install: "echo 'nothing'",
5 |
6 | // servers to deploy to
7 | servers: {
8 | api: {
9 | hosts: "root@robotquest.tk",
10 | start: "bin/Api",
11 | install: ""
12 | },
13 | ai: {
14 | hosts: "root@robotquest.tk",
15 | start: "node_modules/.bin/coffee ai/app.coffee",
16 | install: "npm install"
17 | }
18 | }
19 | }
20 |
--------------------------------------------------------------------------------
/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "author": "Sean Hess (http://seanhess.github.com)",
3 | "name": "botland",
4 | "description": "botland AI and tests",
5 | "version": "0.0.0",
6 | "repository": {
7 | "type": "git",
8 | "url": "git://github.com/seanhess/robotquest.git"
9 | },
10 | "scripts": {
11 | "test": "node_modules/.bin/mocha test/*.js -R spec -b"
12 | },
13 | "engines": {
14 | "node": "0.6.x"
15 | },
16 | "dependencies": {
17 | "request":"2.9.153",
18 | "fjs":"0.2.2",
19 | "underscore": "1.3.1",
20 | "coffee-script": "1.3.1"
21 | },
22 | "devDependencies": {
23 | "mongodb-wrapper":"0.2.7",
24 | "mocha":"0.12.1"
25 | },
26 | "optionalDependencies": {}
27 | }
28 |
29 |
--------------------------------------------------------------------------------
/public/assets/angbandtk/bgtile.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/bgtile.png
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_armor32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_armor32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_classm32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_classm32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_dragon32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_dragon32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_dungeon32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_dungeon32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_edging132.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_edging132.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_edging232.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_edging232.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_edging332.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_edging332.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_effects32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_effects32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_extra132.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_extra132.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_features32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_features32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_food32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_food32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_grounds32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_grounds32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_humans32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_humans32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_iso32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_iso32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_jewls32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_jewls32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_magic32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_magic32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_misc32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_misc32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_monster132.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_monster132.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_monster232.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_monster232.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_monster332.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_monster332.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_monster432.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_monster432.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_monster532.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_monster532.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_monster632.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_monster632.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_monster732.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_monster732.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_people32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_people32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_potions32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_potions32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_town032.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_town032.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_town132.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_town132.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_town232.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_town232.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_town332.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_town332.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_town432.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_town432.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_town532.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_town532.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_town632.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_town632.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_town732.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_town732.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_town832.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_town832.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_town932.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_town932.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_undead32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_undead32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_uniques32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_uniques32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_wands32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_wands32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/dg_weapons32.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/dg_weapons32.gif
--------------------------------------------------------------------------------
/public/assets/angbandtk/townactions.gif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/angbandtk/townactions.gif
--------------------------------------------------------------------------------
/public/assets/css/lib.css:
--------------------------------------------------------------------------------
1 | * {
2 | box-sizing: border-box;
3 | padding: 0px;
4 | margin: 0px;
5 | }
6 |
7 | body {
8 | }
9 |
10 | @font-face {
11 | font-family: robot;
12 | src: url('/assets/robot.ttf') format('truetype');
13 | }
14 |
15 | @font-face {
16 | font-family: robothead;
17 | src: url(/assets/robothead.ttf) format('truetype');
18 | }
19 |
20 | @font-face {
21 | font-family: knightsquest;
22 | src: url(/assets/knightsquest.ttf) format('truetype');
23 | }
24 |
25 |
26 | header {
27 | background: url(/assets/headerbg2.png);
28 | color: white;
29 | padding: 5px;
30 | }
31 |
32 | header a.logo {
33 | color: white;
34 | text-decoration: none;
35 | }
36 |
37 | header #logo {
38 | display: block;
39 | float: left;
40 | width: 64px;
41 | height: 64px;
42 |
43 | }
44 |
45 | header .title {
46 | font-size: 32px;
47 | text-transform: uppercase;
48 | margin-top: -3px;
49 | margin-left: 69px;
50 | }
51 |
52 | .robot {
53 | font-family: robothead;
54 | }
55 |
56 | .quest {
57 | font-family: knightsquest;
58 | font-size: 26px;
59 | }
60 |
61 |
--------------------------------------------------------------------------------
/public/assets/css/sprites.css:
--------------------------------------------------------------------------------
1 | /* set background-position with javascript */
2 |
3 | .sprite {
4 | width: 32px;
5 | height: 32px;
6 | }
7 |
8 | .sprite.classm {
9 | background: url(/assets/angbandtk/dg_classm32.gif);
10 | }
11 |
12 | .sprite.dragon {
13 | background: url(/assets/angbandtk/dg_dragon32.gif);
14 | }
15 |
16 | .sprite.humans {
17 | background: url(/assets/angbandtk/dg_humans32.gif);
18 | }
19 |
20 | .sprite.misc {
21 | background: url(/assets/angbandtk/dg_misc32.gif);
22 | }
23 |
24 | .sprite.people {
25 | background: url(/assets/angbandtk/dg_people32.gif);
26 | }
27 |
28 | .sprite.undead {
29 | background: url(/assets/angbandtk/dg_undead32.gif);
30 | }
31 |
32 | .sprite.uniques {
33 | background: url(/assets/angbandtk/dg_uniques32.gif);
34 | }
35 |
36 | .sprite.monster1 {
37 | background: url(/assets/angbandtk/dg_monster132.gif);
38 | }
39 |
40 | .sprite.monster2 {
41 | background: url(/assets/angbandtk/dg_monster232.gif);
42 | }
43 |
44 | .sprite.monster3 {
45 | background: url(/assets/angbandtk/dg_monster332.gif);
46 | }
47 |
48 | .sprite.monster4 {
49 | background: url(/assets/angbandtk/dg_monster432.gif);
50 | }
51 |
52 | .sprite.monster5 {
53 | background: url(/assets/angbandtk/dg_monster532.gif);
54 | }
55 |
56 | .sprite.monster6 {
57 | background: url(/assets/angbandtk/dg_monster632.gif);
58 | }
59 |
60 | .sprite.monster7 {
61 | background: url(/assets/angbandtk/dg_monster732.gif);
62 | }
63 |
64 |
65 | .sprite.effects {
66 | background: url(/assets/angbandtk/dg_effects32.gif);
67 | }
68 |
69 |
--------------------------------------------------------------------------------
/public/assets/css/style.css:
--------------------------------------------------------------------------------
1 | @font-face {
2 | font-family: robot;
3 | src: url('/assets/robot.ttf') format('truetype');
4 | }
5 |
6 |
7 | body {}
8 |
9 | .container.main {
10 | position: relative;
11 | }
12 |
13 | #logo {
14 | margin-bottom: 30px;
15 | display: block;
16 | color: #000;
17 | height: 10px;
18 | }
19 |
20 | #logo img {
21 | position: absolute;
22 | height: 80px;
23 | }
24 |
25 | #logo .main.name {
26 | font-family: robot;
27 | font-size: 50px;
28 | margin-top: 40px;
29 | margin-left: 100px;
30 | position: relative;
31 | }
32 |
33 | pre {
34 | color: #D14;
35 | }
36 |
37 |
38 | #frameViewer {
39 | margin-top: 20px;
40 | clear: both;
41 | }
42 |
43 |
44 | .documentation h2 {
45 | }
46 |
47 | .documentation .methods {
48 | margin-bottom: 20px;
49 | }
50 |
51 | .documentation .methods th {
52 | text-align: left;
53 | padding: 8px;
54 | font-size: 16px;
55 | }
56 |
57 | .documentation table td {
58 | padding: 8px;
59 | border: solid 1px #DDD;
60 | }
--------------------------------------------------------------------------------
/public/assets/headerbg.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/headerbg.png
--------------------------------------------------------------------------------
/public/assets/headerbg2.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/assets/headerbg2.png
--------------------------------------------------------------------------------
/public/assets/js/async.min.js:
--------------------------------------------------------------------------------
1 | /*global setTimeout: false, console: false */(function(){var a={},b=this,c=b.async;typeof module!="undefined"&&module.exports?module.exports=a:b.async=a,a.noConflict=function(){return b.async=c,a};var d=function(a,b){if(a.forEach)return a.forEach(b);for(var c=0;cd?1:0};d(null,e(b.sort(c),function(a){return a.value}))})},a.auto=function(a,b){b=b||function(){};var c=g(a);if(!c.length)return b(null);var e={},h=[],i=function(a){h.unshift(a)},j=function(a){for(var b=0;b").appendTo(b),e=d.css("display");d.remove();if(e==="none"||e===""){cl||(cl=c.createElement("iframe"),cl.frameBorder=cl.width=cl.height=0),b.appendChild(cl);if(!cm||!cl.createElement)cm=(cl.contentWindow||cl.contentDocument).document,cm.write((c.compatMode==="CSS1Compat"?"":"")+""),cm.close();d=cm.createElement(a),cm.body.appendChild(d),e=f.css(d,"display"),b.removeChild(cl)}ck[a]=e}return ck[a]}function cu(a,b){var c={};f.each(cq.concat.apply([],cq.slice(0,b)),function(){c[this]=a});return c}function ct(){cr=b}function cs(){setTimeout(ct,0);return cr=f.now()}function cj(){try{return new a.ActiveXObject("Microsoft.XMLHTTP")}catch(b){}}function ci(){try{return new a.XMLHttpRequest}catch(b){}}function cc(a,c){a.dataFilter&&(c=a.dataFilter(c,a.dataType));var d=a.dataTypes,e={},g,h,i=d.length,j,k=d[0],l,m,n,o,p;for(g=1;g0){if(c!=="border")for(;g=0===c})}function S(a){return!a||!a.parentNode||a.parentNode.nodeType===11}function K(){return!0}function J(){return!1}function n(a,b,c){var d=b+"defer",e=b+"queue",g=b+"mark",h=f._data(a,d);h&&(c==="queue"||!f._data(a,e))&&(c==="mark"||!f._data(a,g))&&setTimeout(function(){!f._data(a,e)&&!f._data(a,g)&&(f.removeData(a,d,!0),h.fire())},0)}function m(a){for(var b in a){if(b==="data"&&f.isEmptyObject(a[b]))continue;if(b!=="toJSON")return!1}return!0}function l(a,c,d){if(d===b&&a.nodeType===1){var e="data-"+c.replace(k,"-$1").toLowerCase();d=a.getAttribute(e);if(typeof d=="string"){try{d=d==="true"?!0:d==="false"?!1:d==="null"?null:f.isNumeric(d)?parseFloat(d):j.test(d)?f.parseJSON(d):d}catch(g){}f.data(a,c,d)}else d=b}return d}function h(a){var b=g[a]={},c,d;a=a.split(/\s+/);for(c=0,d=a.length;c)[^>]*$|#([\w\-]*)$)/,j=/\S/,k=/^\s+/,l=/\s+$/,m=/^<(\w+)\s*\/?>(?:<\/\1>)?$/,n=/^[\],:{}\s]*$/,o=/\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g,p=/"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g,q=/(?:^|:|,)(?:\s*\[)+/g,r=/(webkit)[ \/]([\w.]+)/,s=/(opera)(?:.*version)?[ \/]([\w.]+)/,t=/(msie) ([\w.]+)/,u=/(mozilla)(?:.*? rv:([\w.]+))?/,v=/-([a-z]|[0-9])/ig,w=/^-ms-/,x=function(a,b){return(b+"").toUpperCase()},y=d.userAgent,z,A,B,C=Object.prototype.toString,D=Object.prototype.hasOwnProperty,E=Array.prototype.push,F=Array.prototype.slice,G=String.prototype.trim,H=Array.prototype.indexOf,I={};e.fn=e.prototype={constructor:e,init:function(a,d,f){var g,h,j,k;if(!a)return this;if(a.nodeType){this.context=this[0]=a,this.length=1;return this}if(a==="body"&&!d&&c.body){this.context=c,this[0]=c.body,this.selector=a,this.length=1;return this}if(typeof a=="string"){a.charAt(0)!=="<"||a.charAt(a.length-1)!==">"||a.length<3?g=i.exec(a):g=[null,a,null];if(g&&(g[1]||!d)){if(g[1]){d=d instanceof e?d[0]:d,k=d?d.ownerDocument||d:c,j=m.exec(a),j?e.isPlainObject(d)?(a=[c.createElement(j[1])],e.fn.attr.call(a,d,!0)):a=[k.createElement(j[1])]:(j=e.buildFragment([g[1]],[k]),a=(j.cacheable?e.clone(j.fragment):j.fragment).childNodes);return e.merge(this,a)}h=c.getElementById(g[2]);if(h&&h.parentNode){if(h.id!==g[2])return f.find(a);this.length=1,this[0]=h}this.context=c,this.selector=a;return this}return!d||d.jquery?(d||f).find(a):this.constructor(d).find(a)}if(e.isFunction(a))return f.ready(a);a.selector!==b&&(this.selector=a.selector,this.context=a.context);return e.makeArray(a,this)},selector:"",jquery:"1.7.1",length:0,size:function(){return this.length},toArray:function(){return F.call(this,0)},get:function(a){return a==null?this.toArray():a<0?this[this.length+a]:this[a]},pushStack:function(a,b,c){var d=this.constructor();e.isArray(a)?E.apply(d,a):e.merge(d,a),d.prevObject=this,d.context=this.context,b==="find"?d.selector=this.selector+(this.selector?" ":"")+c:b&&(d.selector=this.selector+"."+b+"("+c+")");return d},each:function(a,b){return e.each(this,a,b)},ready:function(a){e.bindReady(),A.add(a);return this},eq:function(a){a=+a;return a===-1?this.slice(a):this.slice(a,a+1)},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},slice:function(){return this.pushStack(F.apply(this,arguments),"slice",F.call(arguments).join(","))},map:function(a){return this.pushStack(e.map(this,function(b,c){return a.call(b,c,b)}))},end:function(){return this.prevObject||this.constructor(null)},push:E,sort:[].sort,splice:[].splice},e.fn.init.prototype=e.fn,e.extend=e.fn.extend=function(){var a,c,d,f,g,h,i=arguments[0]||{},j=1,k=arguments.length,l=!1;typeof i=="boolean"&&(l=i,i=arguments[1]||{},j=2),typeof i!="object"&&!e.isFunction(i)&&(i={}),k===j&&(i=this,--j);for(;j0)return;A.fireWith(c,[e]),e.fn.trigger&&e(c).trigger("ready").off("ready")}},bindReady:function(){if(!A){A=e.Callbacks("once memory");if(c.readyState==="complete")return setTimeout(e.ready,1);if(c.addEventListener)c.addEventListener("DOMContentLoaded",B,!1),a.addEventListener("load",e.ready,!1);else if(c.attachEvent){c.attachEvent("onreadystatechange",B),a.attachEvent("onload",e.ready);var b=!1;try{b=a.frameElement==null}catch(d){}c.documentElement.doScroll&&b&&J()}}},isFunction:function(a){return e.type(a)==="function"},isArray:Array.isArray||function(a){return e.type(a)==="array"},isWindow:function(a){return a&&typeof a=="object"&&"setInterval"in a},isNumeric:function(a){return!isNaN(parseFloat(a))&&isFinite(a)},type:function(a){return a==null?String(a):I[C.call(a)]||"object"},isPlainObject:function(a){if(!a||e.type(a)!=="object"||a.nodeType||e.isWindow(a))return!1;try{if(a.constructor&&!D.call(a,"constructor")&&!D.call(a.constructor.prototype,"isPrototypeOf"))return!1}catch(c){return!1}var d;for(d in a);return d===b||D.call(a,d)},isEmptyObject:function(a){for(var b in a)return!1;return!0},error:function(a){throw new Error(a)},parseJSON:function(b){if(typeof b!="string"||!b)return null;b=e.trim(b);if(a.JSON&&a.JSON.parse)return a.JSON.parse(b);if(n.test(b.replace(o,"@").replace(p,"]").replace(q,"")))return(new Function("return "+b))();e.error("Invalid JSON: "+b)},parseXML:function(c){var d,f;try{a.DOMParser?(f=new DOMParser,d=f.parseFromString(c,"text/xml")):(d=new ActiveXObject("Microsoft.XMLDOM"),d.async="false",d.loadXML(c))}catch(g){d=b}(!d||!d.documentElement||d.getElementsByTagName("parsererror").length)&&e.error("Invalid XML: "+c);return d},noop:function(){},globalEval:function(b){b&&j.test(b)&&(a.execScript||function(b){a.eval.call(a,b)})(b)},camelCase:function(a){return a.replace(w,"ms-").replace(v,x)},nodeName:function(a,b){return a.nodeName&&a.nodeName.toUpperCase()===b.toUpperCase()},each:function(a,c,d){var f,g=0,h=a.length,i=h===b||e.isFunction(a);if(d){if(i){for(f in a)if(c.apply(a[f],d)===!1)break}else for(;g0&&a[0]&&a[j-1]||j===0||e.isArray(a));if(k)for(;i1?i.call(arguments,0):b,j.notifyWith(k,e)}}function l(a){return function(c){b[a]=arguments.length>1?i.call(arguments,0):c,--g||j.resolveWith(j,b)}}var b=i.call(arguments,0),c=0,d=b.length,e=Array(d),g=d,h=d,j=d<=1&&a&&f.isFunction(a.promise)?a:f.Deferred(),k=j.promise();if(d>1){for(;ca ",d=q.getElementsByTagName("*"),e=q.getElementsByTagName("a")[0];if(!d||!d.length||!e)return{};g=c.createElement("select"),h=g.appendChild(c.createElement("option")),i=q.getElementsByTagName("input")[0],b={leadingWhitespace:q.firstChild.nodeType===3,tbody:!q.getElementsByTagName("tbody").length,htmlSerialize:!!q.getElementsByTagName("link").length,style:/top/.test(e.getAttribute("style")),hrefNormalized:e.getAttribute("href")==="/a",opacity:/^0.55/.test(e.style.opacity),cssFloat:!!e.style.cssFloat,checkOn:i.value==="on",optSelected:h.selected,getSetAttribute:q.className!=="t",enctype:!!c.createElement("form").enctype,html5Clone:c.createElement("nav").cloneNode(!0).outerHTML!=="<:nav>",submitBubbles:!0,changeBubbles:!0,focusinBubbles:!1,deleteExpando:!0,noCloneEvent:!0,inlineBlockNeedsLayout:!1,shrinkWrapBlocks:!1,reliableMarginRight:!0},i.checked=!0,b.noCloneChecked=i.cloneNode(!0).checked,g.disabled=!0,b.optDisabled=!h.disabled;try{delete q.test}catch(s){b.deleteExpando=!1}!q.addEventListener&&q.attachEvent&&q.fireEvent&&(q.attachEvent("onclick",function(){b.noCloneEvent=!1}),q.cloneNode(!0).fireEvent("onclick")),i=c.createElement("input"),i.value="t",i.setAttribute("type","radio"),b.radioValue=i.value==="t",i.setAttribute("checked","checked"),q.appendChild(i),k=c.createDocumentFragment(),k.appendChild(q.lastChild),b.checkClone=k.cloneNode(!0).cloneNode(!0).lastChild.checked,b.appendChecked=i.checked,k.removeChild(i),k.appendChild(q),q.innerHTML="",a.getComputedStyle&&(j=c.createElement("div"),j.style.width="0",j.style.marginRight="0",q.style.width="2px",q.appendChild(j),b.reliableMarginRight=(parseInt((a.getComputedStyle(j,null)||{marginRight:0}).marginRight,10)||0)===0);if(q.attachEvent)for(o in{submit:1,change:1,focusin:1})n="on"+o,p=n in q,p||(q.setAttribute(n,"return;"),p=typeof q[n]=="function"),b[o+"Bubbles"]=p;k.removeChild(q),k=g=h=j=q=i=null,f(function(){var a,d,e,g,h,i,j,k,m,n,o,r=c.getElementsByTagName("body")[0];!r||(j=1,k="position:absolute;top:0;left:0;width:1px;height:1px;margin:0;",m="visibility:hidden;border:0;",n="style='"+k+"border:5px solid #000;padding:0;'",o=""+"",a=c.createElement("div"),a.style.cssText=m+"width:0;height:0;position:static;top:0;margin-top:"+j+"px",r.insertBefore(a,r.firstChild),q=c.createElement("div"),a.appendChild(q),q.innerHTML="",l=q.getElementsByTagName("td"),p=l[0].offsetHeight===0,l[0].style.display="",l[1].style.display="none",b.reliableHiddenOffsets=p&&l[0].offsetHeight===0,q.innerHTML="",q.style.width=q.style.paddingLeft="1px",f.boxModel=b.boxModel=q.offsetWidth===2,typeof q.style.zoom!="undefined"&&(q.style.display="inline",q.style.zoom=1,b.inlineBlockNeedsLayout=q.offsetWidth===2,q.style.display="",q.innerHTML="
",b.shrinkWrapBlocks=q.offsetWidth!==2),q.style.cssText=k+m,q.innerHTML=o,d=q.firstChild,e=d.firstChild,h=d.nextSibling.firstChild.firstChild,i={doesNotAddBorder:e.offsetTop!==5,doesAddBorderForTableAndCells:h.offsetTop===5},e.style.position="fixed",e.style.top="20px",i.fixedPosition=e.offsetTop===20||e.offsetTop===15,e.style.position=e.style.top="",d.style.overflow="hidden",d.style.position="relative",i.subtractsBorderForOverflowNotVisible=e.offsetTop===-5,i.doesNotIncludeMarginInBodyOffset=r.offsetTop!==j,r.removeChild(a),q=a=null,f.extend(b,i))});return b}();var j=/^(?:\{.*\}|\[.*\])$/,k=/([A-Z])/g;f.extend({cache:{},uuid:0,expando:"jQuery"+(f.fn.jquery+Math.random()).replace(/\D/g,""),noData:{embed:!0,object:"clsid:D27CDB6E-AE6D-11cf-96B8-444553540000",applet:!0},hasData:function(a){a=a.nodeType?f.cache[a[f.expando]]:a[f.expando];return!!a&&!m(a)},data:function(a,c,d,e){if(!!f.acceptData(a)){var g,h,i,j=f.expando,k=typeof c=="string",l=a.nodeType,m=l?f.cache:a,n=l?a[j]:a[j]&&j,o=c==="events";if((!n||!m[n]||!o&&!e&&!m[n].data)&&k&&d===b)return;n||(l?a[j]=n=++f.uuid:n=j),m[n]||(m[n]={},l||(m[n].toJSON=f.noop));if(typeof c=="object"||typeof c=="function")e?m[n]=f.extend(m[n],c):m[n].data=f.extend(m[n].data,c);g=h=m[n],e||(h.data||(h.data={}),h=h.data),d!==b&&(h[f.camelCase(c)]=d);if(o&&!h[c])return g.events;k?(i=h[c],i==null&&(i=h[f.camelCase(c)])):i=h;return i}},removeData:function(a,b,c){if(!!f.acceptData(a)){var d,e,g,h=f.expando,i=a.nodeType,j=i?f.cache:a,k=i?a[h]:h;if(!j[k])return;if(b){d=c?j[k]:j[k].data;if(d){f.isArray(b)||(b in d?b=[b]:(b=f.camelCase(b),b in d?b=[b]:b=b.split(" ")));for(e=0,g=b.length;e-1)return!0;return!1},val:function(a){var c,d,e,g=this[0];{if(!!arguments.length){e=f.isFunction(a);return this.each(function(d){var g=f(this),h;if(this.nodeType===1){e?h=a.call(this,d,g.val()):h=a,h==null?h="":typeof h=="number"?h+="":f.isArray(h)&&(h=f.map(h,function(a){return a==null?"":a+""})),c=f.valHooks[this.nodeName.toLowerCase()]||f.valHooks[this.type];if(!c||!("set"in c)||c.set(this,h,"value")===b)this.value=h}})}if(g){c=f.valHooks[g.nodeName.toLowerCase()]||f.valHooks[g.type];if(c&&"get"in c&&(d=c.get(g,"value"))!==b)return d;d=g.value;return typeof d=="string"?d.replace(q,""):d==null?"":d}}}}),f.extend({valHooks:{option:{get:function(a){var b=a.attributes.value;return!b||b.specified?a.value:a.text}},select:{get:function(a){var b,c,d,e,g=a.selectedIndex,h=[],i=a.options,j=a.type==="select-one";if(g<0)return null;c=j?g:0,d=j?g+1:i.length;for(;c=0}),c.length||(a.selectedIndex=-1);return c}}},attrFn:{val:!0,css:!0,html:!0,text:!0,data:!0,width:!0,height:!0,offset:!0},attr:function(a,c,d,e){var g,h,i,j=a.nodeType;if(!!a&&j!==3&&j!==8&&j!==2){if(e&&c in f.attrFn)return f(a)[c](d);if(typeof a.getAttribute=="undefined")return f.prop(a,c,d);i=j!==1||!f.isXMLDoc(a),i&&(c=c.toLowerCase(),h=f.attrHooks[c]||(u.test(c)?x:w));if(d!==b){if(d===null){f.removeAttr(a,c);return}if(h&&"set"in h&&i&&(g=h.set(a,d,c))!==b)return g;a.setAttribute(c,""+d);return d}if(h&&"get"in h&&i&&(g=h.get(a,c))!==null)return g;g=a.getAttribute(c);return g===null?b:g}},removeAttr:function(a,b){var c,d,e,g,h=0;if(b&&a.nodeType===1){d=b.toLowerCase().split(p),g=d.length;for(;h=0}})});var z=/^(?:textarea|input|select)$/i,A=/^([^\.]*)?(?:\.(.+))?$/,B=/\bhover(\.\S+)?\b/,C=/^key/,D=/^(?:mouse|contextmenu)|click/,E=/^(?:focusinfocus|focusoutblur)$/,F=/^(\w*)(?:#([\w\-]+))?(?:\.([\w\-]+))?$/,G=function(a){var b=F.exec(a);b&&(b[1]=(b[1]||"").toLowerCase(),b[3]=b[3]&&new RegExp("(?:^|\\s)"+b[3]+"(?:\\s|$)"));return b},H=function(a,b){var c=a.attributes||{};return(!b[1]||a.nodeName.toLowerCase()===b[1])&&(!b[2]||(c.id||{}).value===b[2])&&(!b[3]||b[3].test((c["class"]||{}).value))},I=function(a){return f.event.special.hover?a:a.replace(B,"mouseenter$1 mouseleave$1")};
3 | f.event={add:function(a,c,d,e,g){var h,i,j,k,l,m,n,o,p,q,r,s;if(!(a.nodeType===3||a.nodeType===8||!c||!d||!(h=f._data(a)))){d.handler&&(p=d,d=p.handler),d.guid||(d.guid=f.guid++),j=h.events,j||(h.events=j={}),i=h.handle,i||(h.handle=i=function(a){return typeof f!="undefined"&&(!a||f.event.triggered!==a.type)?f.event.dispatch.apply(i.elem,arguments):b},i.elem=a),c=f.trim(I(c)).split(" ");for(k=0;k=0&&(h=h.slice(0,-1),k=!0),h.indexOf(".")>=0&&(i=h.split("."),h=i.shift(),i.sort());if((!e||f.event.customEvent[h])&&!f.event.global[h])return;c=typeof c=="object"?c[f.expando]?c:new f.Event(h,c):new f.Event(h),c.type=h,c.isTrigger=!0,c.exclusive=k,c.namespace=i.join("."),c.namespace_re=c.namespace?new RegExp("(^|\\.)"+i.join("\\.(?:.*\\.)?")+"(\\.|$)"):null,o=h.indexOf(":")<0?"on"+h:"";if(!e){j=f.cache;for(l in j)j[l].events&&j[l].events[h]&&f.event.trigger(c,d,j[l].handle.elem,!0);return}c.result=b,c.target||(c.target=e),d=d!=null?f.makeArray(d):[],d.unshift(c),p=f.event.special[h]||{};if(p.trigger&&p.trigger.apply(e,d)===!1)return;r=[[e,p.bindType||h]];if(!g&&!p.noBubble&&!f.isWindow(e)){s=p.delegateType||h,m=E.test(s+h)?e:e.parentNode,n=null;for(;m;m=m.parentNode)r.push([m,s]),n=m;n&&n===e.ownerDocument&&r.push([n.defaultView||n.parentWindow||a,s])}for(l=0;le&&i.push({elem:this,matches:d.slice(e)});for(j=0;j0?this.on(b,null,a,c):this.trigger(b)},f.attrFn&&(f.attrFn[b]=!0),C.test(b)&&(f.event.fixHooks[b]=f.event.keyHooks),D.test(b)&&(f.event.fixHooks[b]=f.event.mouseHooks)}),function(){function x(a,b,c,e,f,g){for(var h=0,i=e.length;h0){k=j;break}}j=j[a]}e[h]=k}}}function w(a,b,c,e,f,g){for(var h=0,i=e.length;h+~,(\[\\]+)+|[>+~])(\s*,\s*)?((?:.|\r|\n)*)/g,d="sizcache"+(Math.random()+"").replace(".",""),e=0,g=Object.prototype.toString,h=!1,i=!0,j=/\\/g,k=/\r\n/g,l=/\W/;[0,0].sort(function(){i=!1;return 0});var m=function(b,d,e,f){e=e||[],d=d||c;var h=d;if(d.nodeType!==1&&d.nodeType!==9)return[];if(!b||typeof b!="string")return e;var i,j,k,l,n,q,r,t,u=!0,v=m.isXML(d),w=[],x=b;do{a.exec(""),i=a.exec(x);if(i){x=i[3],w.push(i[1]);if(i[2]){l=i[3];break}}}while(i);if(w.length>1&&p.exec(b))if(w.length===2&&o.relative[w[0]])j=y(w[0]+w[1],d,f);else{j=o.relative[w[0]]?[d]:m(w.shift(),d);while(w.length)b=w.shift(),o.relative[b]&&(b+=w.shift()),j=y(b,j,f)}else{!f&&w.length>1&&d.nodeType===9&&!v&&o.match.ID.test(w[0])&&!o.match.ID.test(w[w.length-1])&&(n=m.find(w.shift(),d,v),d=n.expr?m.filter(n.expr,n.set)[0]:n.set[0]);if(d){n=f?{expr:w.pop(),set:s(f)}:m.find(w.pop(),w.length===1&&(w[0]==="~"||w[0]==="+")&&d.parentNode?d.parentNode:d,v),j=n.expr?m.filter(n.expr,n.set):n.set,w.length>0?k=s(j):u=!1;while(w.length)q=w.pop(),r=q,o.relative[q]?r=w.pop():q="",r==null&&(r=d),o.relative[q](k,r,v)}else k=w=[]}k||(k=j),k||m.error(q||b);if(g.call(k)==="[object Array]")if(!u)e.push.apply(e,k);else if(d&&d.nodeType===1)for(t=0;k[t]!=null;t++)k[t]&&(k[t]===!0||k[t].nodeType===1&&m.contains(d,k[t]))&&e.push(j[t]);else for(t=0;k[t]!=null;t++)k[t]&&k[t].nodeType===1&&e.push(j[t]);else s(k,e);l&&(m(l,h,e,f),m.uniqueSort(e));return e};m.uniqueSort=function(a){if(u){h=i,a.sort(u);if(h)for(var b=1;b0},m.find=function(a,b,c){var d,e,f,g,h,i;if(!a)return[];for(e=0,f=o.order.length;e":function(a,b){var c,d=typeof b=="string",e=0,f=a.length;if(d&&!l.test(b)){b=b.toLowerCase();for(;e=0)?c||d.push(h):c&&(b[g]=!1));return!1},ID:function(a){return a[1].replace(j,"")},TAG:function(a,b){return a[1].replace(j,"").toLowerCase()},CHILD:function(a){if(a[1]==="nth"){a[2]||m.error(a[0]),a[2]=a[2].replace(/^\+|\s*/g,"");var b=/(-?)(\d*)(?:n([+\-]?\d*))?/.exec(a[2]==="even"&&"2n"||a[2]==="odd"&&"2n+1"||!/\D/.test(a[2])&&"0n+"+a[2]||a[2]);a[2]=b[1]+(b[2]||1)-0,a[3]=b[3]-0}else a[2]&&m.error(a[0]);a[0]=e++;return a},ATTR:function(a,b,c,d,e,f){var g=a[1]=a[1].replace(j,"");!f&&o.attrMap[g]&&(a[1]=o.attrMap[g]),a[4]=(a[4]||a[5]||"").replace(j,""),a[2]==="~="&&(a[4]=" "+a[4]+" ");return a},PSEUDO:function(b,c,d,e,f){if(b[1]==="not")if((a.exec(b[3])||"").length>1||/^\w/.test(b[3]))b[3]=m(b[3],null,null,c);else{var g=m.filter(b[3],c,d,!0^f);d||e.push.apply(e,g);return!1}else if(o.match.POS.test(b[0])||o.match.CHILD.test(b[0]))return!0;return b},POS:function(a){a.unshift(!0);return a}},filters:{enabled:function(a){return a.disabled===!1&&a.type!=="hidden"},disabled:function(a){return a.disabled===!0},checked:function(a){return a.checked===!0},selected:function(a){a.parentNode&&a.parentNode.selectedIndex;return a.selected===!0},parent:function(a){return!!a.firstChild},empty:function(a){return!a.firstChild},has:function(a,b,c){return!!m(c[3],a).length},header:function(a){return/h\d/i.test(a.nodeName)},text:function(a){var b=a.getAttribute("type"),c=a.type;return a.nodeName.toLowerCase()==="input"&&"text"===c&&(b===c||b===null)},radio:function(a){return a.nodeName.toLowerCase()==="input"&&"radio"===a.type},checkbox:function(a){return a.nodeName.toLowerCase()==="input"&&"checkbox"===a.type},file:function(a){return a.nodeName.toLowerCase()==="input"&&"file"===a.type},password:function(a){return a.nodeName.toLowerCase()==="input"&&"password"===a.type},submit:function(a){var b=a.nodeName.toLowerCase();return(b==="input"||b==="button")&&"submit"===a.type},image:function(a){return a.nodeName.toLowerCase()==="input"&&"image"===a.type},reset:function(a){var b=a.nodeName.toLowerCase();return(b==="input"||b==="button")&&"reset"===a.type},button:function(a){var b=a.nodeName.toLowerCase();return b==="input"&&"button"===a.type||b==="button"},input:function(a){return/input|select|textarea|button/i.test(a.nodeName)},focus:function(a){return a===a.ownerDocument.activeElement}},setFilters:{first:function(a,b){return b===0},last:function(a,b,c,d){return b===d.length-1},even:function(a,b){return b%2===0},odd:function(a,b){return b%2===1},lt:function(a,b,c){return bc[3]-0},nth:function(a,b,c){return c[3]-0===b},eq:function(a,b,c){return c[3]-0===b}},filter:{PSEUDO:function(a,b,c,d){var e=b[1],f=o.filters[e];if(f)return f(a,c,b,d);if(e==="contains")return(a.textContent||a.innerText||n([a])||"").indexOf(b[3])>=0;if(e==="not"){var g=b[3];for(var h=0,i=g.length;h=0}},ID:function(a,b){return a.nodeType===1&&a.getAttribute("id")===b},TAG:function(a,b){return b==="*"&&a.nodeType===1||!!a.nodeName&&a.nodeName.toLowerCase()===b},CLASS:function(a,b){return(" "+(a.className||a.getAttribute("class"))+" ").indexOf(b)>-1},ATTR:function(a,b){var c=b[1],d=m.attr?m.attr(a,c):o.attrHandle[c]?o.attrHandle[c](a):a[c]!=null?a[c]:a.getAttribute(c),e=d+"",f=b[2],g=b[4];return d==null?f==="!=":!f&&m.attr?d!=null:f==="="?e===g:f==="*="?e.indexOf(g)>=0:f==="~="?(" "+e+" ").indexOf(g)>=0:g?f==="!="?e!==g:f==="^="?e.indexOf(g)===0:f==="$="?e.substr(e.length-g.length)===g:f==="|="?e===g||e.substr(0,g.length+1)===g+"-":!1:e&&d!==!1},POS:function(a,b,c,d){var e=b[2],f=o.setFilters[e];if(f)return f(a,c,b,d)}}},p=o.match.POS,q=function(a,b){return"\\"+(b-0+1)};for(var r in o.match)o.match[r]=new RegExp(o.match[r].source+/(?![^\[]*\])(?![^\(]*\))/.source),o.leftMatch[r]=new RegExp(/(^(?:.|\r|\n)*?)/.source+o.match[r].source.replace(/\\(\d+)/g,q));var s=function(a,b){a=Array.prototype.slice.call(a,0);if(b){b.push.apply(b,a);return b}return a};try{Array.prototype.slice.call(c.documentElement.childNodes,0)[0].nodeType}catch(t){s=function(a,b){var c=0,d=b||[];if(g.call(a)==="[object Array]")Array.prototype.push.apply(d,a);else if(typeof a.length=="number")for(var e=a.length;c ",e.insertBefore(a,e.firstChild),c.getElementById(d)&&(o.find.ID=function(a,c,d){if(typeof c.getElementById!="undefined"&&!d){var e=c.getElementById(a[1]);return e?e.id===a[1]||typeof e.getAttributeNode!="undefined"&&e.getAttributeNode("id").nodeValue===a[1]?[e]:b:[]}},o.filter.ID=function(a,b){var c=typeof a.getAttributeNode!="undefined"&&a.getAttributeNode("id");return a.nodeType===1&&c&&c.nodeValue===b}),e.removeChild(a),e=a=null}(),function(){var a=c.createElement("div");a.appendChild(c.createComment("")),a.getElementsByTagName("*").length>0&&(o.find.TAG=function(a,b){var c=b.getElementsByTagName(a[1]);if(a[1]==="*"){var d=[];for(var e=0;c[e];e++)c[e].nodeType===1&&d.push(c[e]);c=d}return c}),a.innerHTML=" ",a.firstChild&&typeof a.firstChild.getAttribute!="undefined"&&a.firstChild.getAttribute("href")!=="#"&&(o.attrHandle.href=function(a){return a.getAttribute("href",2)}),a=null}(),c.querySelectorAll&&function(){var a=m,b=c.createElement("div"),d="__sizzle__";b.innerHTML="
";if(!b.querySelectorAll||b.querySelectorAll(".TEST").length!==0){m=function(b,e,f,g){e=e||c;if(!g&&!m.isXML(e)){var h=/^(\w+$)|^\.([\w\-]+$)|^#([\w\-]+$)/.exec(b);if(h&&(e.nodeType===1||e.nodeType===9)){if(h[1])return s(e.getElementsByTagName(b),f);if(h[2]&&o.find.CLASS&&e.getElementsByClassName)return s(e.getElementsByClassName(h[2]),f)}if(e.nodeType===9){if(b==="body"&&e.body)return s([e.body],f);if(h&&h[3]){var i=e.getElementById(h[3]);if(!i||!i.parentNode)return s([],f);if(i.id===h[3])return s([i],f)}try{return s(e.querySelectorAll(b),f)}catch(j){}}else if(e.nodeType===1&&e.nodeName.toLowerCase()!=="object"){var k=e,l=e.getAttribute("id"),n=l||d,p=e.parentNode,q=/^\s*[+~]/.test(b);l?n=n.replace(/'/g,"\\$&"):e.setAttribute("id",n),q&&p&&(e=e.parentNode);try{if(!q||p)return s(e.querySelectorAll("[id='"+n+"'] "+b),f)}catch(r){}finally{l||k.removeAttribute("id")}}}return a(b,e,f,g)};for(var e in a)m[e]=a[e];b=null}}(),function(){var a=c.documentElement,b=a.matchesSelector||a.mozMatchesSelector||a.webkitMatchesSelector||a.msMatchesSelector;if(b){var d=!b.call(c.createElement("div"),"div"),e=!1;try{b.call(c.documentElement,"[test!='']:sizzle")}catch(f){e=!0}m.matchesSelector=function(a,c){c=c.replace(/\=\s*([^'"\]]*)\s*\]/g,"='$1']");if(!m.isXML(a))try{if(e||!o.match.PSEUDO.test(c)&&!/!=/.test(c)){var f=b.call(a,c);if(f||!d||a.document&&a.document.nodeType!==11)return f}}catch(g){}return m(c,null,null,[a]).length>0}}}(),function(){var a=c.createElement("div");a.innerHTML="
";if(!!a.getElementsByClassName&&a.getElementsByClassName("e").length!==0){a.lastChild.className="e";if(a.getElementsByClassName("e").length===1)return;o.order.splice(1,0,"CLASS"),o.find.CLASS=function(a,b,c){if(typeof b.getElementsByClassName!="undefined"&&!c)return b.getElementsByClassName(a[1])},a=null}}(),c.documentElement.contains?m.contains=function(a,b){return a!==b&&(a.contains?a.contains(b):!0)}:c.documentElement.compareDocumentPosition?m.contains=function(a,b){return!!(a.compareDocumentPosition(b)&16)}:m.contains=function(){return!1},m.isXML=function(a){var b=(a?a.ownerDocument||a:0).documentElement;return b?b.nodeName!=="HTML":!1};var y=function(a,b,c){var d,e=[],f="",g=b.nodeType?[b]:b;while(d=o.match.PSEUDO.exec(a))f+=d[0],a=a.replace(o.match.PSEUDO,"");a=o.relative[a]?a+"*":a;for(var h=0,i=g.length;h0)for(h=g;h=0:f.filter(a,this).length>0:this.filter(a).length>0)},closest:function(a,b){var c=[],d,e,g=this[0];if(f.isArray(a)){var h=1;while(g&&g.ownerDocument&&g!==b){for(d=0;d-1:f.find.matchesSelector(g,a)){c.push(g);break}g=g.parentNode;if(!g||!g.ownerDocument||g===b||g.nodeType===11)break}}c=c.length>1?f.unique(c):c;return this.pushStack(c,"closest",a)},index:function(a){if(!a)return this[0]&&this[0].parentNode?this.prevAll().length:-1;if(typeof a=="string")return f.inArray(this[0],f(a));return f.inArray(a.jquery?a[0]:a,this)},add:function(a,b){var c=typeof a=="string"?f(a,b):f.makeArray(a&&a.nodeType?[a]:a),d=f.merge(this.get(),c);return this.pushStack(S(c[0])||S(d[0])?d:f.unique(d))},andSelf:function(){return this.add(this.prevObject)}}),f.each({parent:function(a){var b=a.parentNode;return b&&b.nodeType!==11?b:null},parents:function(a){return f.dir(a,"parentNode")},parentsUntil:function(a,b,c){return f.dir(a,"parentNode",c)},next:function(a){return f.nth(a,2,"nextSibling")},prev:function(a){return f.nth(a,2,"previousSibling")},nextAll:function(a){return f.dir(a,"nextSibling")},prevAll:function(a){return f.dir(a,"previousSibling")},nextUntil:function(a,b,c){return f.dir(a,"nextSibling",c)},prevUntil:function(a,b,c){return f.dir(a,"previousSibling",c)},siblings:function(a){return f.sibling(a.parentNode.firstChild,a)},children:function(a){return f.sibling(a.firstChild)},contents:function(a){return f.nodeName(a,"iframe")?a.contentDocument||a.contentWindow.document:f.makeArray(a.childNodes)}},function(a,b){f.fn[a]=function(c,d){var e=f.map(this,b,c);L.test(a)||(d=c),d&&typeof d=="string"&&(e=f.filter(d,e)),e=this.length>1&&!R[a]?f.unique(e):e,(this.length>1||N.test(d))&&M.test(a)&&(e=e.reverse());return this.pushStack(e,a,P.call(arguments).join(","))}}),f.extend({filter:function(a,b,c){c&&(a=":not("+a+")");return b.length===1?f.find.matchesSelector(b[0],a)?[b[0]]:[]:f.find.matches(a,b)},dir:function(a,c,d){var e=[],g=a[c];while(g&&g.nodeType!==9&&(d===b||g.nodeType!==1||!f(g).is(d)))g.nodeType===1&&e.push(g),g=g[c];return e},nth:function(a,b,c,d){b=b||1;var e=0;for(;a;a=a[c])if(a.nodeType===1&&++e===b)break;return a},sibling:function(a,b){var c=[];for(;a;a=a.nextSibling)a.nodeType===1&&a!==b&&c.push(a);return c}});var V="abbr|article|aside|audio|canvas|datalist|details|figcaption|figure|footer|header|hgroup|mark|meter|nav|output|progress|section|summary|time|video",W=/ jQuery\d+="(?:\d+|null)"/g,X=/^\s+/,Y=/<(?!area|br|col|embed|hr|img|input|link|meta|param)(([\w:]+)[^>]*)\/>/ig,Z=/<([\w:]+)/,$=/",""],legend:[1,""," "],thead:[1,""],tr:[2,""],td:[3,""],col:[2,""],area:[1,""," "],_default:[0,"",""]},bh=U(c);bg.optgroup=bg.option,bg.tbody=bg.tfoot=bg.colgroup=bg.caption=bg.thead,bg.th=bg.td,f.support.htmlSerialize||(bg._default=[1,"div","
"]),f.fn.extend({text:function(a){if(f.isFunction(a))return this.each(function(b){var c=f(this);c.text(a.call(this,b,c.text()))});if(typeof a!="object"&&a!==b)return this.empty().append((this[0]&&this[0].ownerDocument||c).createTextNode(a));return f.text(this)},wrapAll:function(a){if(f.isFunction(a))return this.each(function(b){f(this).wrapAll(a.call(this,b))});if(this[0]){var b=f(a,this[0].ownerDocument).eq(0).clone(!0);this[0].parentNode&&b.insertBefore(this[0]),b.map(function(){var a=this;while(a.firstChild&&a.firstChild.nodeType===1)a=a.firstChild;return a}).append(this)}return this},wrapInner:function(a){if(f.isFunction(a))return this.each(function(b){f(this).wrapInner(a.call(this,b))});return this.each(function(){var b=f(this),c=b.contents();c.length?c.wrapAll(a):b.append(a)})},wrap:function(a){var b=f.isFunction(a);return this.each(function(c){f(this).wrapAll(b?a.call(this,c):a)})},unwrap:function(){return this.parent().each(function(){f.nodeName(this,"body")||f(this).replaceWith(this.childNodes)}).end()},append:function(){return this.domManip(arguments,!0,function(a){this.nodeType===1&&this.appendChild(a)})},prepend:function(){return this.domManip(arguments,!0,function(a){this.nodeType===1&&this.insertBefore(a,this.firstChild)})},before:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,!1,function(a){this.parentNode.insertBefore(a,this)});if(arguments.length){var a=f.clean(arguments);a.push.apply(a,this.toArray());return this.pushStack(a,"before",arguments)}},after:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,!1,function(a){this.parentNode.insertBefore(a,this.nextSibling)});if(arguments.length){var a=this.pushStack(this,"after",arguments);a.push.apply(a,f.clean(arguments));return a}},remove:function(a,b){for(var c=0,d;(d=this[c])!=null;c++)if(!a||f.filter(a,[d]).length)!b&&d.nodeType===1&&(f.cleanData(d.getElementsByTagName("*")),f.cleanData([d])),d.parentNode&&d.parentNode.removeChild(d);return this},empty:function()
4 | {for(var a=0,b;(b=this[a])!=null;a++){b.nodeType===1&&f.cleanData(b.getElementsByTagName("*"));while(b.firstChild)b.removeChild(b.firstChild)}return this},clone:function(a,b){a=a==null?!1:a,b=b==null?a:b;return this.map(function(){return f.clone(this,a,b)})},html:function(a){if(a===b)return this[0]&&this[0].nodeType===1?this[0].innerHTML.replace(W,""):null;if(typeof a=="string"&&!ba.test(a)&&(f.support.leadingWhitespace||!X.test(a))&&!bg[(Z.exec(a)||["",""])[1].toLowerCase()]){a=a.replace(Y,"<$1>$2>");try{for(var c=0,d=this.length;c1&&l0?this.clone(!0):this).get();f(e[h])[b](j),d=d.concat(j)}return this.pushStack(d,a,e.selector)}}),f.extend({clone:function(a,b,c){var d,e,g,h=f.support.html5Clone||!bc.test("<"+a.nodeName)?a.cloneNode(!0):bo(a);if((!f.support.noCloneEvent||!f.support.noCloneChecked)&&(a.nodeType===1||a.nodeType===11)&&!f.isXMLDoc(a)){bk(a,h),d=bl(a),e=bl(h);for(g=0;d[g];++g)e[g]&&bk(d[g],e[g])}if(b){bj(a,h);if(c){d=bl(a),e=bl(h);for(g=0;d[g];++g)bj(d[g],e[g])}}d=e=null;return h},clean:function(a,b,d,e){var g;b=b||c,typeof b.createElement=="undefined"&&(b=b.ownerDocument||b[0]&&b[0].ownerDocument||c);var h=[],i;for(var j=0,k;(k=a[j])!=null;j++){typeof k=="number"&&(k+="");if(!k)continue;if(typeof k=="string")if(!_.test(k))k=b.createTextNode(k);else{k=k.replace(Y,"<$1>$2>");var l=(Z.exec(k)||["",""])[1].toLowerCase(),m=bg[l]||bg._default,n=m[0],o=b.createElement("div");b===c?bh.appendChild(o):U(b).appendChild(o),o.innerHTML=m[1]+k+m[2];while(n--)o=o.lastChild;if(!f.support.tbody){var p=$.test(k),q=l==="table"&&!p?o.firstChild&&o.firstChild.childNodes:m[1]===""&&!p?o.childNodes:[];for(i=q.length-1;i>=0;--i)f.nodeName(q[i],"tbody")&&!q[i].childNodes.length&&q[i].parentNode.removeChild(q[i])}!f.support.leadingWhitespace&&X.test(k)&&o.insertBefore(b.createTextNode(X.exec(k)[0]),o.firstChild),k=o.childNodes}var r;if(!f.support.appendChecked)if(k[0]&&typeof (r=k.length)=="number")for(i=0;i=0)return b+"px"}}}),f.support.opacity||(f.cssHooks.opacity={get:function(a,b){return br.test((b&&a.currentStyle?a.currentStyle.filter:a.style.filter)||"")?parseFloat(RegExp.$1)/100+"":b?"1":""},set:function(a,b){var c=a.style,d=a.currentStyle,e=f.isNumeric(b)?"alpha(opacity="+b*100+")":"",g=d&&d.filter||c.filter||"";c.zoom=1;if(b>=1&&f.trim(g.replace(bq,""))===""){c.removeAttribute("filter");if(d&&!d.filter)return}c.filter=bq.test(g)?g.replace(bq,e):g+" "+e}}),f(function(){f.support.reliableMarginRight||(f.cssHooks.marginRight={get:function(a,b){var c;f.swap(a,{display:"inline-block"},function(){b?c=bz(a,"margin-right","marginRight"):c=a.style.marginRight});return c}})}),c.defaultView&&c.defaultView.getComputedStyle&&(bA=function(a,b){var c,d,e;b=b.replace(bs,"-$1").toLowerCase(),(d=a.ownerDocument.defaultView)&&(e=d.getComputedStyle(a,null))&&(c=e.getPropertyValue(b),c===""&&!f.contains(a.ownerDocument.documentElement,a)&&(c=f.style(a,b)));return c}),c.documentElement.currentStyle&&(bB=function(a,b){var c,d,e,f=a.currentStyle&&a.currentStyle[b],g=a.style;f===null&&g&&(e=g[b])&&(f=e),!bt.test(f)&&bu.test(f)&&(c=g.left,d=a.runtimeStyle&&a.runtimeStyle.left,d&&(a.runtimeStyle.left=a.currentStyle.left),g.left=b==="fontSize"?"1em":f||0,f=g.pixelLeft+"px",g.left=c,d&&(a.runtimeStyle.left=d));return f===""?"auto":f}),bz=bA||bB,f.expr&&f.expr.filters&&(f.expr.filters.hidden=function(a){var b=a.offsetWidth,c=a.offsetHeight;return b===0&&c===0||!f.support.reliableHiddenOffsets&&(a.style&&a.style.display||f.css(a,"display"))==="none"},f.expr.filters.visible=function(a){return!f.expr.filters.hidden(a)});var bD=/%20/g,bE=/\[\]$/,bF=/\r?\n/g,bG=/#.*$/,bH=/^(.*?):[ \t]*([^\r\n]*)\r?$/mg,bI=/^(?:color|date|datetime|datetime-local|email|hidden|month|number|password|range|search|tel|text|time|url|week)$/i,bJ=/^(?:about|app|app\-storage|.+\-extension|file|res|widget):$/,bK=/^(?:GET|HEAD)$/,bL=/^\/\//,bM=/\?/,bN=/
6 |
7 |
8 |
9 |
143 |
144 |
145 |
146 | Launch Chaosbot
147 | Stop
148 |
149 |
150 |
151 |
--------------------------------------------------------------------------------
/public/demo/cleanupbot.js:
--------------------------------------------------------------------------------
1 |
2 | // deps on api.js for "call"
3 |
4 | // Bots create
5 | function CleanupBot(worldInfo) {
6 |
7 | // ooh! I could have a sigla field
8 | // it can't change, must be transparent Black, or something like that.
9 |
10 | var color = "#888" // ignore the color you pick. Helps identify these guys
11 |
12 | var unitId, unitToken, point, oldMap = {}
13 |
14 | this.tick = tick
15 | this.start = start
16 |
17 | var description = {kind: "CleanupBot", name: "CleanupBotN", source: "http://github.com/seanhess/robotquest", notes:"moves towards inactive units and destroys them", color: color }
18 |
19 | function tick(locations, units) {
20 |
21 | var map = makeMap(locations)
22 |
23 | if (map[pointId(point)] != unitId) {
24 | throw new Error("Incorrect position")
25 | }
26 |
27 | // scan for inactive things
28 | var inactive = []
29 | for (var x = 0; x < worldInfo.fieldSize.width; x++) {
30 | for (var y = 0; y < worldInfo.fieldSize.height; y++) {
31 | var p = {x:x, y:y}
32 | var pid = pointId(p)
33 |
34 | if (map[pid] && map[pid] == oldMap[pid] && !(p.x == point.x && p.y == point.y)) {
35 | inactive.push(p)
36 | // var d = distance(point, p)
37 | // if (!closest || d < closest.d) {
38 | // // console.log("OLD CLOSE", JSON.stringify(closest))
39 | // closest = {point: p, distance: d}
40 | // console.log("NEW CLOSE", JSON.stringify(p), d)
41 | // }
42 | }
43 | }
44 | }
45 |
46 | oldMap = map
47 |
48 | inactive = inactive.map(function(p) {
49 | return {point: p, distance: distance(point, p)}
50 | })
51 |
52 | inactive = inactive.sort(function(a, b) {
53 | return a.distance - b.distance
54 | })
55 |
56 | function distance(a, b) {
57 | return Math.abs(a.x - b.x) + Math.abs(a.y - b.y)
58 | }
59 |
60 | var target = inactive[0]
61 | // console.log("CHOSE TARGET", JSON.stringify(target))
62 | // console.log("ALL INACTIVES", JSON.stringify(inactive))
63 |
64 | // now, move towards inactive!
65 |
66 | // try to kill
67 |
68 | if (!target) return // wait around for an inactive to show up
69 |
70 | if (target) {
71 | // console.log("TARGET", JSON.stringify(point), JSON.stringify(target))
72 |
73 | if (target.distance < 2) {
74 | // console.log("ATTACK!")
75 | request("POST", "/units/" + unitId + "/attack", target.point, unitToken, function(err) {
76 | if (err) throw err
77 | // console.log("ATTACK SUCCESSFUL")
78 | })
79 | }
80 |
81 | else if (target.distance == 0) {
82 | // console.log("SKIP SELF")
83 | }
84 |
85 | // move closer
86 | else {
87 | var dx = point.x - target.point.x
88 | var dy = point.y - target.point.y
89 |
90 | var newPoint;
91 |
92 | if (point.x < target.point.x)
93 | newPoint = {x: point.x + 1, y: point.y}
94 |
95 | else if (point.x > target.point.x)
96 | newPoint = {x: point.x - 1, y: point.y}
97 |
98 | else if (point.y < target.point.y)
99 | newPoint = {x: point.x, y: point.y + 1}
100 |
101 | else
102 | newPoint = {x: point.x, y: point.y - 1}
103 |
104 | request("POST", "/units/" + unitId + "/move", newPoint, unitToken, function(err) {
105 |
106 | // we probably hit something. Just wait for the next tick
107 | if (err) return
108 | else point = newPoint // update our location
109 | })
110 |
111 | }
112 | }
113 |
114 | }
115 |
116 | // point -> unitId
117 | function makeMap(locations) {
118 | var map = {}
119 | locations.forEach(function(l) {
120 | map[pointId(l.point)] = l.unitId
121 | })
122 | return map
123 | }
124 |
125 | function pointId(p) {
126 | return p.x + "," + p.y
127 | }
128 |
129 | function isInactive(unitId, world, oldWorld) {
130 |
131 | }
132 |
133 | function start() {
134 | request("POST", "/units", {requestedPoint: randomPoint(worldInfo.fieldSize), unitDescription: description}, "", function(err, spawn) {
135 |
136 | if (err) throw err
137 |
138 | unitId = spawn.unitId
139 | unitToken = spawn.unitToken
140 | point = spawn.spawnPoint
141 | })
142 | }
143 | }
144 |
--------------------------------------------------------------------------------
/public/screen.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/seanhess/robotquest/98328579d6bbfad2cd678811a9759c907cf6b268/public/screen.png
--------------------------------------------------------------------------------
/public/viewer/viewer.css:
--------------------------------------------------------------------------------
1 |
2 | header.sidebar {
3 | font-family: knightsquest;
4 | color: #FFF;
5 | position: fixed;
6 | top: 0px;
7 | left: 0px;
8 | width: 160px;
9 | background: url(/assets/headerbg2.png);
10 | height: 100%;
11 | padding: 5px;
12 | }
13 |
14 | header.sidebar h2, header.sidebar th {
15 | font-weight: normal;
16 | }
17 |
18 | header .links {
19 | clear:both;
20 | margin-top: 10px;
21 | }
22 |
23 | header .links a {
24 | font-family: knightsquest;
25 | color: #FFF;
26 | font-size: 26px;
27 | padding: 5px;
28 | }
29 |
30 |
31 |
32 | #botInfo {
33 | position: fixed;
34 | bottom: 0px;
35 | left: 0px;
36 |
37 | transition: bottom linear 300ms;
38 | -webkit-transition: bottom linear 300ms;
39 | -moz-transition: bottom linear 300ms;
40 | }
41 |
42 | #botInfo.hidden {
43 | bottom: -200px;
44 | }
45 |
46 | #botInfo .inside {
47 | background-color: #FFF;
48 | width: 200px;
49 | padding: 10px;
50 | }
51 |
52 | #botInfo .sprite {
53 | display: block;
54 | float: right;
55 | }
56 |
57 | body {
58 | background: url(/assets/headerbg.png);
59 | }
60 |
61 | #container {
62 | background-color: #F00;
63 | background: url(/assets/headerbg.png);
64 | padding: 32px;
65 | margin-left: 160px;
66 | }
67 |
68 | #viewer {
69 | background: url(/assets/angbandtk/bgtile.png) #5c5;
70 | box-shadow: inset 0px 0px 50px 0px rgba(0, 0, 0, 0.8);
71 | position: relative;
72 | }
73 |
74 | .bot {
75 | /*background-color: #000;*/
76 | width: 32px;
77 | height: 32px;
78 | position: absolute;
79 |
80 | /*background: url(/assets/angbandtk/dg_classm32.gif);*/
81 |
82 | transition: all linear 300ms;
83 | -webkit-transition: all linear 300ms;
84 | -moz-transition: all linear 300ms;
85 |
86 | border-radius: 40px;
87 |
88 | /* The green halo of good! */
89 | box-shadow: inset 0px 0px 10px 10px rgba(0, 255, 0, 0.10);
90 | }
91 |
92 | .bot.AI {
93 | /* The black halo of evil */
94 | box-shadow: inset 0px 0px 10px 10px rgba(0, 0, 0, 0.15);
95 | }
96 |
97 | .bot:hover, .bot.selected {
98 | box-shadow: inset 0px 0px 5px 5px #FCF766;
99 | }
100 |
101 | .info {
102 | float: right;
103 | margin: 15px;
104 | }
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 |
113 |
114 |
115 |
116 |
117 |
118 |
119 |
120 |
121 |
122 |
123 | h2.leaderboard {
124 | margin-top: 20px;
125 | /*border-bottom: solid 1px #FFF;*/
126 | background-color: #FFF;
127 | color: #000;
128 | }
129 |
130 |
131 | table.leaderboard td {
132 | font-size: 14px;
133 | }
134 |
135 | table.leaderboard td a.name {
136 | max-width: 90px;
137 | overflow: hidden;
138 | max-height: 14px;
139 | display: block;
140 | color: #FFF;
141 | }
142 |
143 |
--------------------------------------------------------------------------------
/public/viewer/viewer.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | RobotQuest: Viewer
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
24 |
25 |
26 |
51 |
52 |
53 |
54 |
55 |
56 |
57 |
58 | Player
59 | Kills
60 | Age
61 | Source
62 |
63 |
64 |
65 |
--------------------------------------------------------------------------------
/public/viewer/viewer.js:
--------------------------------------------------------------------------------
1 |
2 | $(function() {
3 | var bots = []
4 |
5 | var MINUTE = 60
6 | var HOUR = 60*MINUTE
7 | var DAY = 24*HOUR
8 | var MONTH = 30*DAY
9 | var YEAR = 365*DAY
10 |
11 | var $window = $(window)
12 | var $viewer = $("#viewer")
13 | var $container = $("#container")
14 |
15 | var PX = 32
16 | var PY = 32
17 |
18 | var padding = 0
19 |
20 | $window.on('resize', function() {
21 | console.log("RESIZE")
22 | })
23 |
24 | // first, get the world
25 | $.get("/game/info", function(gameInfo) {
26 |
27 | var w = gameInfo.width
28 | var h = gameInfo.height
29 | var ms = gameInfo.tick
30 |
31 | // this will make it scroll
32 | $viewer.css({width: w * PX, height: h * PY})
33 | $container.css({width: (w+2)*PX, height: (h+2)*PY})
34 |
35 | console.log("GAME INFO", w, h, ms)
36 |
37 | function poll() {
38 | $.get("/game/objects", function(bots) {
39 | tick(bots)
40 | })
41 | }
42 |
43 | function tick(bots) {
44 |
45 | $(".bot").addClass("inactive")
46 |
47 | bots.forEach(function(bot) {
48 | var $bot = $("#" + bot.id)
49 | $bot.data(bot)
50 |
51 | if (!$bot.length) {
52 | console.log("NEW BOT", bot.id, bot.name, bot.x, bot.y, bot.sprite)
53 | $bot = botView(bot)
54 | $viewer.append($bot)
55 | }
56 |
57 | $bot.css({left: (bot.x) * PX + padding, top: (bot.y) * PY + padding})
58 | // $bot.css({width: PX, height: PY})
59 |
60 | if (bot.state === "Dead") {
61 | sprite($bot, "effects-6-8")
62 | }
63 |
64 | $bot.removeClass("inactive")
65 | })
66 |
67 | $(".bot.inactive").remove()
68 | }
69 |
70 | function botView(bot) {
71 | var $bot = $(" ")
72 | $bot.data(bot)
73 | sprite($bot, bot.sprite)
74 | return $bot
75 | }
76 |
77 | poll()
78 | setInterval(poll, ms)
79 | })
80 |
81 | function sprite($el, s) {
82 |
83 | // compute offset mathematically
84 | // dragon-3-4
85 |
86 | var parts = s.split('-')
87 |
88 | var sheet = parts[0]
89 | var xi = parseInt(parts[1], 10)
90 | var yi = parseInt(parts[2], 10)
91 |
92 | // need to remove the OLD class as well!
93 | $el.addClass(sheet)
94 | $el.css({'background-position': '-' + xi*32 + 'px -' + yi*32 + 'px'})
95 | }
96 |
97 | function age(created) {
98 | var date = new Date(created)
99 | var ds = Math.floor((Date.now() - date.getTime())/1000)
100 |
101 | if (ds < MINUTE) return ds + "s"
102 | if (ds < HOUR) return Math.floor(ds/MINUTE) + "m"
103 | if (ds < DAY) return Math.floor(ds/HOUR) + "h"
104 | return Math.floor(ds/DAY) + "d"
105 | }
106 |
107 |
108 | // ROUTING //////////////////////////////////////////////
109 | $(window).bind('hashchange', function() {
110 |
111 | var hash = window.location.hash
112 |
113 | if (!hash) return hideBot()
114 |
115 | var matchBot = hash.match(/#\/bots\/(\w+)/)
116 | if (matchBot) {
117 | var botId = matchBot[1]
118 | var $bot = $("#" + botId)
119 | var bot = $bot.data()
120 | showBot(bot, $bot)
121 | }
122 | })
123 |
124 | // BOT INFORMATION /////////////////////////////////////
125 | var $botInfo = $("#botInfo")
126 | var $selectedBot = null
127 |
128 | function showBot(bot, $bot) {
129 |
130 | $botInfo.removeClass("hidden")
131 | $botInfo.find(".name").text(bot.name)
132 | $botInfo.find(".age").text(age(bot.created))
133 | $botInfo.find(".kills").text(bot.kills)
134 | $botInfo.find(".player").text(bot.player)
135 |
136 | var $sprite = $botInfo.find(".sprite")
137 | $sprite.attr("class", "sprite")
138 |
139 | sprite($botInfo.find(".sprite"), bot.sprite)
140 |
141 | // get player information
142 | $.get('/players/' + bot.player, function(player) {
143 | $botInfo.find(".source").attr('href', player.source)
144 | })
145 |
146 | if ($selectedBot) $selectedBot.removeClass('selected')
147 | $selectedBot = $bot
148 | $selectedBot.addClass('selected')
149 | }
150 |
151 | function hideBot() {
152 | $botInfo.addClass('hidden')
153 | $selectedBot.removeClass('selected')
154 | $selectedBot = null
155 | }
156 |
157 | $viewer.on("click", ".bot", function(event) {
158 | var bot = $(this).data()
159 | //showBot($(this).data())
160 | window.location.hash = "/bots/" + bot.id
161 | return false
162 | })
163 |
164 | $window.on("click", function(event) {
165 | window.location.hash = ""
166 | })
167 |
168 | // only outside clicks
169 | $botInfo.on("click", function(e) {
170 | window.location.hash = ""
171 | })
172 |
173 |
174 |
175 | // LEADERBOARDS
176 | var $killers = $("#killers")
177 | var $survivors = $("#survivors")
178 | var $rowTemplate = $survivors.find(".row.template").remove().clone()
179 | var $headerTemplate = $survivors.find(".header.template").remove().clone()
180 |
181 | function loadLeaderboards() {
182 | $.get('/top/killers', function(bots) {
183 | $killers.html($headerTemplate.clone())
184 | bots.forEach(function(b) {
185 | var $view = leaderboardRow(b)
186 | $killers.append($view)
187 | })
188 | })
189 |
190 | $.get('/top/survivors', function(bots) {
191 | $survivors.html($headerTemplate.clone())
192 | bots.forEach(function(b) {
193 | var $view = leaderboardRow(b)
194 | $survivors.append($view)
195 | })
196 | })
197 | }
198 |
199 | function leaderboardRow(b) {
200 | var $view = $rowTemplate.clone()
201 | $view.find(".kills").text(b.kills)
202 | $view.find(".age").text(age(b.created))
203 | $view.find(".name").text(b.name).attr('href', "#/bots/" + b.id)
204 | return $view
205 | }
206 |
207 | loadLeaderboards()
208 | var slowInterval = setInterval(loadLeaderboards, 3*1000)
209 | })
210 |
--------------------------------------------------------------------------------
/test/test.js:
--------------------------------------------------------------------------------
1 | // API tests, written in node.js, since I'm still bad at Haskell, I'm on a plane and ghc can't find Network.HTTP for some reason.
2 |
3 | // npm install
4 | // start the server
5 | // npm test
6 |
7 | var assert = require('assert')
8 | var request = require('request')
9 | var Port = 3026
10 | var Server = "http://localhost:" + Port
11 |
12 | var mongo = require('mongodb-wrapper')
13 |
14 | describe('botland api', function() {
15 |
16 | var db = mongo.db('localhost', 27017, 'botland')
17 | db.collection('bots')
18 |
19 | it('should be on', function(done) {
20 | request.get(Server + "/version", function(err, request, body) {
21 | assert.ifError(err)
22 | assert.ok(body)
23 | assert.ok(body.length > 0, "Should have gotten back a version from the api")
24 | done()
25 | })
26 | })
27 |
28 | // how? I could connect to mongo myself and do it, that's a little
29 | it('should reset the database', function(done) {
30 | db.bots.remove(done)
31 | })
32 |
33 |
34 | var game = null
35 |
36 | describe('game', function() {
37 |
38 | it('should give game stats', function(done) {
39 | request.get({url:Server + "/game/info", json:true}, function(err, rs, g) {
40 | assert.ifError(err)
41 | assert.ok(g)
42 | assert.ok(g.width)
43 | assert.ok(g.height)
44 | assert.ok(g.tick)
45 | game = g
46 | done()
47 | })
48 | })
49 |
50 | it('should return an empty world', function(done) {
51 | request.get({url:Server + "/game/objects", json:true}, function(err, rs, locations) {
52 | assert.ifError(err)
53 | assert.ok(locations)
54 | assert.equal(locations.length, 0)
55 | done()
56 | })
57 | })
58 | })
59 |
60 | // save our playerId, so we can use it in later tests
61 | var playerId = null
62 |
63 | describe("player", function() {
64 | it("should give me an id", function(done) {
65 | var player = {name:"test", source:'fake'}
66 | request.post({url:Server + "/players", json:player}, function(err, rs, data) {
67 | assert.ifError(err)
68 | assert.equal(rs.statusCode, 200, data.message)
69 | playerId = data
70 | assert.ok(playerId, 'should have returned an id')
71 | assert.ok(typeof playerId == "string", 'id was not a string')
72 | done()
73 | })
74 | })
75 | })
76 |
77 | // keep track of our minionId for later tests
78 | var minionId = null
79 | var bot = {x:0, y:0, name:'bot1', sprite:'test'}
80 |
81 | describe('spawn', function() {
82 |
83 | it('should not allow me to spawn off field', function(done) {
84 | var bot = {x:-1, y:0, name:'offfield', sprite:'test'}
85 | request.post({url: Server + "/players/" + playerId + "/minions", json: bot}, function(err, rs, id) {
86 | assert.ifError(err)
87 | assert.equal(rs.statusCode, 400, 'missing 400 status code')
88 | assert.ok(id.message, 'missing error message')
89 | done()
90 | })
91 | })
92 |
93 | it('should allow me to spawn a bot', function(done) {
94 | request.post({url: Server + "/players/" + playerId + "/minions", json: bot}, function(err, rs, body) {
95 | assert.ifError(err)
96 | assert.equal(rs.statusCode, 200, body.message)
97 | minionId = body
98 | assert.ok(minionId, 'minionId was undefined')
99 | done()
100 | })
101 | })
102 |
103 | it('should error if I try to spawn in the same place twice', function(done) {
104 | request.post({url: Server + "/players/" + playerId + "/minions", json: bot}, function(err, rs, body) {
105 | assert.ifError(err)
106 | assert.equal(rs.statusCode, 400)
107 | assert.ok(body.message)
108 | done()
109 | })
110 | })
111 |
112 | it('should show me in the game', function(done) {
113 | request.get({url:Server + "/game/objects", json:true}, function(err, rs, locations) {
114 | assert.ifError(err)
115 | assert.ok(locations)
116 | assert.equal(locations.length, 1, "not showing bot on the map")
117 | var me = locations[0]
118 | assert.equal(me.id, minionId)
119 | assert.equal(me.x, bot.x)
120 | assert.equal(me.y, bot.y)
121 | done()
122 | })
123 | })
124 | })
125 |
126 | describe('movement', function() {
127 |
128 | it('should let me move', function(done) {
129 | var url = Server + "/players/" + playerId + "/minions/" + minionId + "/commands"
130 | request.post({url: url, json:{action:"Move", direction:"Right"}}, function(err, rs, data) {
131 | assert.ifError(err)
132 | assert.equal(rs.statusCode, 200, data)
133 | done()
134 | })
135 | })
136 |
137 | it('should update the game', function(done) {
138 | setTimeout(function() {
139 | request.get({url:Server + "/game/objects", json:true}, function(err, rs, locations) {
140 | assert.ifError(err)
141 | assert.ok(locations)
142 | assert.equal(locations.length, 1)
143 | var me = locations[0]
144 | assert.equal(me.id, minionId)
145 | assert.equal(me.x, 1, "did not move right")
146 | assert.equal(me.y, 0)
147 | done()
148 | })
149 | }, game.tick)
150 | })
151 |
152 | it("should not let me move out-of-bounds", function(done) {
153 | request.post({url: Server + "/players/" + playerId + "/minions/" + minionId + "/commands", json:{action:"Move", direction:"Up"}}, function(err, rs, data) {
154 | assert.ifError(err)
155 | assert.equal(rs.statusCode, 200, 'should give 200 status code even though the command is invalid')
156 |
157 | setTimeout(function() {
158 | request.get({url:Server + "/game/objects", json:true}, function(err, rs, locations) {
159 | assert.ifError(err)
160 | assert.ok(locations)
161 | assert.equal(locations.length, 1)
162 | var me = locations[0]
163 | assert.equal(me.id, minionId)
164 | assert.equal(me.x, 1, "did not move right")
165 | assert.notEqual(me.y, -1, "moved off the board!")
166 | assert.equal(me.y, 0, "not in the same y")
167 | done()
168 | })
169 | }, game.tick)
170 | })
171 | })
172 | })
173 |
174 | describe('attack', function() {
175 | var bot2Id = null
176 | it('should spawn a second bot', function(done) {
177 | var bot = {x: 0, y: 0, name: 'bot2', sprite: 'test'}
178 | request.post({url: Server + "/players/" + playerId + "/minions", json: bot}, function(err, rs, body) {
179 | assert.ifError(err)
180 | assert.equal(rs.statusCode, 200, body.message)
181 | bot2Id = body
182 | assert.ok(bot2Id, 'minionId was undefined')
183 | done()
184 | })
185 | })
186 |
187 | it('should both appear in the world', function(done) {
188 | request.get({url:Server + "/game/objects", json:true}, function(err, rs, locations) {
189 | assert.ifError(err)
190 | assert.ok(locations)
191 | assert.equal(locations.length, 2)
192 | var b2 = locations[1]
193 | assert.equal(b2.id, bot2Id)
194 | done()
195 | })
196 | })
197 |
198 | it('should attack bot1', function(done) {
199 | request.post({url: Server + "/players/" + playerId + "/minions/" + bot2Id + "/commands", json:{action:"Attack", direction:"Right"}}, function(err, rs, data) {
200 | assert.ifError(err)
201 | assert.equal(rs.statusCode, 200)
202 | done()
203 | })
204 | })
205 |
206 | it('bot1 should be dead', function(done) {
207 | setTimeout(function() {
208 | request.get({url:Server + "/game/objects", json:true}, function(err, rs, locations) {
209 | assert.ifError(err)
210 | assert.ok(locations)
211 | assert.equal(locations.length, 2)
212 | var b1 = locations.filter(function(b) { return b.name == 'bot1' })[0]
213 | assert.ok(b1)
214 | assert.equal(b1.state, "Dead")
215 | done()
216 | })
217 | }, game.tick)
218 | })
219 |
220 | it('should give kill to bot2', function(done) {
221 | request.get({url:Server + "/minions/" + bot2Id, json:true}, function(err, rs, bot) {
222 | assert.ifError(err)
223 | assert.ok(bot)
224 | assert.equal(bot.kills, 1)
225 | done()
226 | })
227 | })
228 |
229 | it('should remove bot1 after another tick', function(done) {
230 | setTimeout(function() {
231 | request.get({url:Server + "/game/objects", json:true}, function(err, rs, locations) {
232 | assert.ifError(err)
233 | assert.ok(locations)
234 | assert.equal(locations.length, 1, "did not remove dead unit")
235 | done()
236 | })
237 | }, game.tick)
238 | })
239 | })
240 |
241 | describe('leaderboard', function() {
242 | // requires the kill stuff right before this
243 | it('should have kill registered from last attack', function(done) {
244 | request.get({url:Server + "/top/killers", json:true}, function(err, rs, bots) {
245 | assert.ifError(err)
246 | assert.ok(bots)
247 | assert.equal(bots.length, 1)
248 | assert.equal(bots[0].kills, 1)
249 | done()
250 | })
251 | })
252 |
253 | it('should track connection times', function(done) {
254 | request.get({url:Server + "/top/survivors", json:true}, function(err, rs, bots) {
255 | assert.ifError(err)
256 | assert.ok(bots)
257 | assert.ok(bots.length)
258 | assert.ok(bots[0].created)
259 | assert.ok(bots[0].id, minionId) // is the oldest
260 | done()
261 | })
262 | })
263 | })
264 |
265 | describe('cleanup', function() {
266 | var minionId = null
267 |
268 | it('should start with only bot2', function(done) {
269 | request.get({url: Server + "/game/objects", json:true}, function(err, rs, locations) {
270 | assert.ifError(err)
271 | assert.equal(locations.length, 1, "Should only have 1 bot to start")
272 | done()
273 | })
274 | })
275 |
276 | it('should spawn another bot', function(done) {
277 | var bot = {x:1, y:1, name:'cleanup', sprite:'test'}
278 | request.post({url: Server + "/players/" + playerId + "/minions", json: bot}, function(err, rs, body) {
279 | assert.ifError(err)
280 | assert.equal(rs.statusCode, 200, body.message)
281 | minionId = body
282 | assert.ok(minionId, 'minionId was undefined')
283 | done()
284 | })
285 | })
286 |
287 | it('should delete minionId', function(done) {
288 | request.del({url: Server + "/players/" + playerId + "/minions/" + minionId, json: true}, function(err, rs, body) {
289 | assert.ifError(err)
290 | assert.equal(rs.statusCode, 200, body.message)
291 | done()
292 | })
293 | })
294 |
295 | it('should be gone', function(done) {
296 | request.get({url:Server + "/game/objects", json:true}, function(err, rs, locations) {
297 | assert.ifError(err)
298 | assert.ok(locations)
299 | assert.equal(locations.length, 1)
300 | var b2 = locations[0]
301 | assert.notEqual(b2.id, minionId)
302 | done()
303 | })
304 | })
305 |
306 | it('should delete mcp', function(done) {
307 | request.del({url: Server + "/players/" + playerId, json: true}, function(err, rs, body) {
308 | assert.ifError(err)
309 | assert.equal(rs.statusCode, 200, body.message)
310 | done()
311 | })
312 | })
313 |
314 | it('should be empty', function(done) {
315 | request.get({url:Server + "/game/objects", json:true}, function(err, rs, locations) {
316 | assert.ifError(err)
317 | assert.ok(locations)
318 | assert.equal(locations.length, 0)
319 | done()
320 | })
321 | })
322 | })
323 | })
324 |
325 |
326 |
327 |
328 |
329 |
330 |
331 |
332 |
333 |
334 |
335 |
336 |
337 |
--------------------------------------------------------------------------------