Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 517 lines (438 sloc) 17.575 kb
b25bd7e @glguy move all proxy state into one value
authored
1 {-# LANGUAGE RecordWildCards #-}
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
2 {-# LANGUAGE PatternGuards #-}
369d1fa @glguy Split out the proxy code from protocol code
authored
3 module Main where
4
33d1b87 @glguy Checkpoint
authored
5 import Control.Applicative
369d1fa @glguy Split out the proxy code from protocol code
authored
6 import Control.Concurrent
7 import Control.Exception
8 import Control.Monad
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
9 import Data.Array.IO
369d1fa @glguy Split out the proxy code from protocol code
authored
10 import Data.Binary.Put (runPut)
f7b3fbb @glguy Add more protocol field documentation and refine protocol types
authored
11 import Data.Bits
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
12 import Data.ByteString.Lazy (ByteString)
369d1fa @glguy Split out the proxy code from protocol code
authored
13 import Data.Foldable
14 import Data.IORef
15 import Data.Int
e6e4d7e @glguy Clean up warnings, add \through command
authored
16 import Data.List (isPrefixOf)
369d1fa @glguy Split out the proxy code from protocol code
authored
17 import Data.Map (Map)
e6e4d7e @glguy Clean up warnings, add \through command
authored
18 import Data.Maybe (fromMaybe,mapMaybe)
01454c2 @glguy First draft of command to undo 'glass attack'
authored
19 import Data.Set (Set)
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
20 import Data.Traversable (for)
21 import Data.Word
369d1fa @glguy Split out the proxy code from protocol code
authored
22 import Network.Socket hiding (send)
23 import Network.Socket.ByteString.Lazy
24 import Prelude hiding (getContents)
e5d78b8 @glguy Add commandline flags to change proxy's listen host/port
authored
25 import System.Console.GetOpt
369d1fa @glguy Split out the proxy code from protocol code
authored
26 import System.Environment
27 import System.Exit
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
28 import qualified Data.ByteString.Lazy as L
369d1fa @glguy Split out the proxy code from protocol code
authored
29 import qualified Data.Map as Map
01454c2 @glguy First draft of command to undo 'glass attack'
authored
30 import qualified Data.Set as Set
fb7a64f @glguy Split out entity tracking
authored
31 import qualified Network
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
32
33d1b87 @glguy Checkpoint
authored
33 import GameState
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
34 import JavaBinary
35 import Protocol
369d1fa @glguy Split out the proxy code from protocol code
authored
36
b25bd7e @glguy move all proxy state into one value
authored
37 data ProxyState = PS
38 { gameState :: MVar GameState
39 , glassVar :: IORef Bool
e6e4d7e @glguy Clean up warnings, add \through command
authored
40 , digThrough :: IORef Int
9a10ea4 @glguy Add a \time command
authored
41 , timeVar :: IORef (Maybe Int64)
01454c2 @glguy First draft of command to undo 'glass attack'
authored
42 , restoreVar :: MVar (Map (Int32,Int32) (Set (Int8, Int8, Int8)))
b25bd7e @glguy move all proxy state into one value
authored
43 , lineVar :: IORef (Bool, [Message])
44 , digVar :: IORef Int
dc34098 @glguy Add \help and \status
authored
45 , followVar :: MVar (Maybe (String, EntityId))
b25bd7e @glguy move all proxy state into one value
authored
46 }
47
e6e4d7e @glguy Clean up warnings, add \through command
authored
48 newProxyState :: IO ProxyState
b25bd7e @glguy move all proxy state into one value
authored
49 newProxyState = do
01454c2 @glguy First draft of command to undo 'glass attack'
authored
50 gameState <- newMVar newGameState
51 glassVar <- newIORef False
e6e4d7e @glguy Clean up warnings, add \through command
authored
52 digThrough <- newIORef 0
9a10ea4 @glguy Add a \time command
authored
53 timeVar <- newIORef Nothing
01454c2 @glguy First draft of command to undo 'glass attack'
authored
54 restoreVar <- newMVar Map.empty
55 lineVar <- newIORef (False, [])
56 digVar <- newIORef 1
57 followVar <- newMVar Nothing
b25bd7e @glguy move all proxy state into one value
authored
58 return PS {..}
59
e5d78b8 @glguy Add commandline flags to change proxy's listen host/port
authored
60 data Configuration = Config
61 { listenHost :: HostName
62 , listenPort :: ServiceName
63 , configHelp :: Bool }
64
65 defaultConfig = Config
66 { listenHost = "localhost"
67 , listenPort = "25565"
68 , configHelp = False
69 }
70
71 options :: [OptDescr (Configuration -> Configuration)]
72 options =
73 [ Option ['l'] ["listen-host"]
74 (ReqArg (\ str c -> c { listenHost = str }) "HOSTNAME")
75 "Hostname to bind to"
76 , Option ['p'] ["listen-port"]
77 (ReqArg (\ str c -> c { listenPort = str }) "SERVICENAME")
78 "Port to bind to"
79 , Option ['h'] ["help"]
80 (NoArg (\ c -> c { configHelp = True }))
81 "Print this list"
82 ]
83
84 getOptions = do
85 (fs, args, errs) <- getOpt Permute options <$> getArgs
86 let config = foldl' (\ c f -> f c) defaultConfig fs
87 unless (null errs) $ do
88 traverse_ putStrLn errs
89 exitFailure
90 let usageText = "minecraft-proxy <FLAGS> SERVER-HOSTNAME SERVER-PORT"
91 when (configHelp config) $ do
92 putStrLn $ usageInfo usageText options
93 exitSuccess
94 case args of
95 [host,port] -> return (host,port,config)
96 _ -> do putStrLn $ usageInfo usageText options
97 exitFailure
98
99 addrInfoHints = defaultHints { addrFamily = AF_INET
100 , addrSocketType = Stream
101 , addrFlags = [AI_PASSIVE] }
102
369d1fa @glguy Split out the proxy code from protocol code
authored
103 main :: IO ()
104 main = do
e5d78b8 @glguy Add commandline flags to change proxy's listen host/port
authored
105 (host,port,config) <- getOptions
106
107 ais <- getAddrInfo (Just addrInfoHints)
108 (Just (listenHost config))
109 (Just (listenPort config))
110 addr <- case ais of
111 (ai : _ ) -> return $ addrAddress ai
112 [] -> fail "Unable to resolve bind address"
113
114 l <- socket AF_INET Stream defaultProtocol
115 setSocketOption l ReuseAddr 1
116 bindSocket l addr
117 listen l 5
118
119 putStrLn "Ready to accept connections"
120
96fd216 @glguy Revert compass to spawn point when possible
authored
121 forever $ do res <- accept l
122 _ <- forkIO (handleClient host port res)
123 return ()
e5d78b8 @glguy Add commandline flags to change proxy's listen host/port
authored
124
e6e4d7e @glguy Clean up warnings, add \through command
authored
125 handleClient :: HostName -> ServiceName -> (Socket, SockAddr) -> IO ()
96fd216 @glguy Revert compass to spawn point when possible
authored
126 handleClient host port (c,csa) = do
369d1fa @glguy Split out the proxy code from protocol code
authored
127 putStr "Got connection from "
128 print csa
129
e5d78b8 @glguy Add commandline flags to change proxy's listen host/port
authored
130 ais <- getAddrInfo (Just addrInfoHints) (Just host) (Just port)
131 addr <- case ais of
132 (ai : _ ) -> return $ addrAddress ai
96fd216 @glguy Revert compass to spawn point when possible
authored
133 _ -> fail "Unable to resolve server address"
e5d78b8 @glguy Add commandline flags to change proxy's listen host/port
authored
134
135 s <- socket AF_INET Stream defaultProtocol
136 connect s addr
137 proxy c s
138
96fd216 @glguy Revert compass to spawn point when possible
authored
139 `Control.Exception.catch` \ (SomeException e) -> do
b25bd7e @glguy move all proxy state into one value
authored
140 sendAll c $ encode $ Disconnect (show e)
141 fail (show e)
369d1fa @glguy Split out the proxy code from protocol code
authored
142
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
143 -- | 'proxy' creates the threads necessary to proxy a Minecraft
144 -- connection between a client and a server socket.
145 proxy ::
146 Socket {- ^ client socket -} ->
147 Socket {- ^ server socket -} ->
148 IO ()
369d1fa @glguy Split out the proxy code from protocol code
authored
149 proxy c s = do
e5d78b8 @glguy Add commandline flags to change proxy's listen host/port
authored
150 sbs <- toMessages <$> getContents s
151 cbs <- toMessages <$> getContents c
152
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
153 var <- newChan
b25bd7e @glguy move all proxy state into one value
authored
154 state <- newProxyState
155 clientChan <- newChan
156 serverChan <- newChan
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
157 serverToProxy <- forkIO $ do
e5d78b8 @glguy Add commandline flags to change proxy's listen host/port
authored
158 traverse_ (inboundLogic clientChan state) sbs
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
159 `bad` writeChan var "inbound"
160 proxyToClient <- forkIO $ forever (sendAll c =<< readChan clientChan)
161 `bad` writeChan var "inbound network"
162 proxyToServer <- forkIO $ forever (sendAll s =<< readChan serverChan)
163 `bad` writeChan var "outbound network"
164 clientToProxy <- forkIO $ do
e5d78b8 @glguy Add commandline flags to change proxy's listen host/port
authored
165 traverse_ (outboundLogic clientChan serverChan state) cbs
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
166 `bad` writeChan var "outbound"
167 who <- readChan var
369d1fa @glguy Split out the proxy code from protocol code
authored
168 putStr who
169 putStrLn " died"
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
170 traverse_ killThread [serverToProxy, proxyToClient, proxyToServer, clientToProxy]
24010c6 @glguy Add dig speed command
authored
171 where
172 bad m n = m `Control.Exception.catch` \ (SomeException e) -> print e >> n
369d1fa @glguy Split out the proxy code from protocol code
authored
173
e6e4d7e @glguy Clean up warnings, add \through command
authored
174 makeGlass :: BlockId -> BlockId
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
175 makeGlass Dirt = Glass
b25bd7e @glguy move all proxy state into one value
authored
176 makeGlass Stone = Glass
177 makeGlass Grass = Glass
e6e4d7e @glguy Clean up warnings, add \through command
authored
178 makeGlass other = other
b25bd7e @glguy move all proxy state into one value
authored
179
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
180 inboundLogic ::
181 Chan ByteString {- ^ client channel -} ->
182 ProxyState ->
183 Message ->
184 IO ()
185 inboundLogic clientChan state msg = do
fb7a64f @glguy Split out entity tracking
authored
186
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
187 -- Track entities
b25bd7e @glguy move all proxy state into one value
authored
188 changedEid <- modifyMVar (gameState state) $ \ gs -> do
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
189 (change, gs') <- updateGameState msg gs
190 gs' `seq` return (gs', change)
fb7a64f @glguy Split out entity tracking
authored
191
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
192 -- Global glass modifications
b25bd7e @glguy move all proxy state into one value
authored
193 glass <- readIORef (glassVar state)
9a10ea4 @glguy Add a \time command
authored
194 time <- readIORef (timeVar state)
f7b3fbb @glguy Add more protocol field documentation and refine protocol types
authored
195 let msg' = case msg of
e05639d @glguy Glass attack checkpoint
authored
196 Mapchunk x y z sx sy sz bs a b c
197 | glass -> Mapchunk x y z sx sy sz (map makeGlass bs) a b c
9a10ea4 @glguy Add a \time command
authored
198 TimeUpdate t -> case time of
199 Nothing -> msg
200 Just t' -> TimeUpdate t'
f7b3fbb @glguy Add more protocol field documentation and refine protocol types
authored
201 _ -> msg
202
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
203 -- Update compass
204 followMsgs <- withMVar (followVar state) $ \ interested ->
96fd216 @glguy Revert compass to spawn point when possible
authored
205 case interested of
dc34098 @glguy Add \help and \status
authored
206 Just (_,ieid) | fmap snd interested == changedEid -> do
96fd216 @glguy Revert compass to spawn point when possible
authored
207 e <- entityMap <$> readMVar (gameState state)
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
208 return $ case Map.lookup ieid e of
96fd216 @glguy Revert compass to spawn point when possible
authored
209 Just (_ty, x, y, z) ->
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
210 [SpawnPosition (x `div` 32) (y `div` 32) (z `div` 32)]
211 _ -> []
212 _ -> return []
213
214 sendMessages clientChan (msg' : followMsgs)
33d1b87 @glguy Checkpoint
authored
215
216
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
217 processCommand ::
218 Chan ByteString {- ^ client channel -} ->
219 ProxyState ->
220 String {- ^ chat command -} ->
221 IO ()
33d1b87 @glguy Checkpoint
authored
222
dc34098 @glguy Add \help and \status
authored
223 processCommand clientChan _ "help"
224 = traverse_ (tellPlayer clientChan) helpMessage
225
226 processCommand clientChan state "status"
227 = traverse_ (tellPlayer clientChan) =<< statusMessages state
5b04420 @glguy Update Harp ID to be 0
authored
228
9a10ea4 @glguy Add a \time command
authored
229 processCommand clientChan state "time off"
230 = writeIORef (timeVar state) Nothing
231 *> tellPlayer clientChan "Time passing"
232
233 processCommand clientChan state text
234 | "time " `isPrefixOf` text
235 = case reads (drop 5 text) of
236 [(n,_)] | 0 <= n && n <= 24000 -> writeIORef (timeVar state) (Just n)
237 *> tellPlayer clientChan "Time fixed"
238 _ -> tellPlayer clientChan "Unable to parse time"
239
5b04420 @glguy Update Harp ID to be 0
authored
240 processCommand clientChan state text
241 | "echo " `isPrefixOf` text
242 = case reads (drop 5 text) of
243 [(msg,_)] -> sendMessages clientChan [msg]
244 _ -> tellPlayer clientChan "Unable to parse message"
245
b25bd7e @glguy move all proxy state into one value
authored
246 processCommand clientChan state "glass on"
247 = writeIORef (glassVar state) True
248 *> tellPlayer clientChan "Glass On"
24010c6 @glguy Add dig speed command
authored
249
b25bd7e @glguy move all proxy state into one value
authored
250 processCommand clientChan state "glass off"
251 = writeIORef (glassVar state) False
252 *> tellPlayer clientChan "Glass Off"
24010c6 @glguy Add dig speed command
authored
253
e6e4d7e @glguy Clean up warnings, add \through command
authored
254 processCommand clientChan state text | "through " `isPrefixOf` text
255 = case reads $ drop 8 text of
256 [(n,_)] -> writeIORef (digThrough state) n
257 *> tellPlayer clientChan "Through Set"
258 _ -> tellPlayer clientChan "Bad through value"
259
b25bd7e @glguy move all proxy state into one value
authored
260 processCommand clientChan state text | "dig " `isPrefixOf` text
261 = case reads $ drop 4 text of
262 [(n,_)] -> writeIORef (digVar state) n
263 *> tellPlayer clientChan "Dig Set"
264
265 _ -> tellPlayer clientChan "Bad dig number"
266
96fd216 @glguy Revert compass to spawn point when possible
authored
267 processCommand clientChan state "follow off" = do
268 modifyMVar_ (followVar state) $ \ _ -> do
269 mb <- spawnLocation <$> readMVar (gameState state)
270 case mb of
271 Nothing -> tellPlayer clientChan "Follow disabled - spawn point unknown"
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
272 Just (x,y,z) -> do sendMessages clientChan [SpawnPosition x y z]
96fd216 @glguy Revert compass to spawn point when possible
authored
273 tellPlayer clientChan "Follow disabled - compass restored"
274 return Nothing
275
b25bd7e @glguy move all proxy state into one value
authored
276 processCommand clientChan state text | "follow " `isPrefixOf` text
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
277 = do e <- entityMap <$> readMVar (gameState state)
278 case find (\ (_,(x,_,_,_)) -> x == Left key) (Map.assocs e) of
dc34098 @glguy Add \help and \status
authored
279 Just (k,_) -> swapMVar (followVar state) (Just (key,k))
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
280 *> tellPlayer clientChan "Follow registered"
281 Nothing -> tellPlayer clientChan "Player not found"
33d1b87 @glguy Checkpoint
authored
282 where key = drop 7 text
283
b25bd7e @glguy move all proxy state into one value
authored
284 processCommand clientChan state "lines on"
285 = writeIORef (lineVar state) (True, [])
286 *> tellPlayer clientChan "Lines On"
0c225ca @glguy Move to mutable arrays and include a line drawing command
authored
287
b25bd7e @glguy move all proxy state into one value
authored
288 processCommand clientChan state "lines off"
289 = modifyIORef (lineVar state) (\ (_ , xs) -> (False, xs))
290 *> tellPlayer clientChan "Lines Off"
0c225ca @glguy Move to mutable arrays and include a line drawing command
authored
291
b25bd7e @glguy move all proxy state into one value
authored
292 processCommand clientChan _ _
293 = tellPlayer clientChan "Command not understood"
33d1b87 @glguy Checkpoint
authored
294
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
295
296 sendMessages :: Chan L.ByteString -> [Message] -> IO ()
297 sendMessages _ [] = return ()
298 sendMessages chan xs = writeChan chan . runPut . traverse_ putJ $ xs
299
300 tellPlayer :: Chan L.ByteString -> String -> IO ()
301 tellPlayer chan text = sendMessages chan [proxyChat text]
369d1fa @glguy Split out the proxy code from protocol code
authored
302
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
303 outboundLogic :: Chan ByteString {- ^ client channel -} ->
304 Chan ByteString {- ^ server channel -} ->
305 ProxyState ->
306 Message ->
307 IO ()
308 outboundLogic clientChan serverChan state msg = do
0c225ca @glguy Move to mutable arrays and include a line drawing command
authored
309
b25bd7e @glguy move all proxy state into one value
authored
310 (recording, macros) <- readIORef $ lineVar state
e6e4d7e @glguy Clean up warnings, add \through command
authored
311 shiftCount <- readIORef (digThrough state)
0c225ca @glguy Move to mutable arrays and include a line drawing command
authored
312
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
313 msgs <- case msg of
369d1fa @glguy Split out the proxy code from protocol code
authored
314 PlayerPosition {} -> return [msg]
315 PlayerPositionLook {} -> return [msg]
316 PlayerLook {} -> return [msg]
317 Player {} -> return [msg]
318 KeepAliv -> return [msg]
e6e4d7e @glguy Clean up warnings, add \through command
authored
319
24010c6 @glguy Add dig speed command
authored
320 PlayerDigging Digging x y z face -> do
e6e4d7e @glguy Clean up warnings, add \through command
authored
321 let (x',y',z') = digShift x y z face shiftCount
b25bd7e @glguy move all proxy state into one value
authored
322 n <- readIORef $ digVar state
e6e4d7e @glguy Clean up warnings, add \through command
authored
323 return $ replicate n $ PlayerDigging Digging x' y' z' face
324
325 PlayerDigging action x y z face -> do
326 let (x',y',z') = digShift x y z face shiftCount
327 return [PlayerDigging action x' y' z' face]
328
e05639d @glguy Glass attack checkpoint
authored
329 PlayerBlockPlacement x y z _ (Just (IID 0x15B, _, _)) -> do
e6e4d7e @glguy Clean up warnings, add \through command
authored
330 attacked <- glassAttack clientChan state x y z
331 return $ if attacked then [] else [msg]
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
332
f08cc7f @glguy Move glass undoing to compass action
authored
333 PlayerBlockPlacement x y z None (Just (IID 0x159, _, _)) -> do
334 restoreMap <- swapMVar (restoreVar state) Map.empty
335 bm <- blockMap <$> readMVar (gameState state)
336 msgs <- makeRestore bm restoreMap
337 if null msgs
338 then tellPlayer clientChan "Nothing to restore"
339 else tellPlayer clientChan "Restoring!"
340 *> sendMessages clientChan msgs
341 return []
342
343
0c225ca @glguy Move to mutable arrays and include a line drawing command
authored
344 PlayerBlockPlacement x1 y1 z1 f o | recording -> case macros of
e6e4d7e @glguy Clean up warnings, add \through command
authored
345 [PlayerBlockPlacement x y z _ _] ->
346 do writeIORef (lineVar state) (recording, [msg])
347 return $ drawLine msg x y z x1 y1 z1 f o
348
349 _ -> [msg] <$ writeIORef (lineVar state) (recording, [msg])
350
351 Chat ('\\':xs) -> [] <$ processCommand clientChan state xs
369d1fa @glguy Split out the proxy code from protocol code
authored
352
e6e4d7e @glguy Clean up warnings, add \through command
authored
353 _ -> [msg] <$ putStrLn ("outbound: " ++ show msg)
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
354 sendMessages serverChan msgs
355
356 glassAttack ::
357 Chan ByteString {- ^ client channel -} ->
358 ProxyState ->
359 Int32 {- ^ X block coordinate -} ->
360 Int8 {- ^ Y block coordinate -} ->
361 Int32 {- ^ Z block coordinate -} ->
362 IO Bool
e6e4d7e @glguy Clean up warnings, add \through command
authored
363 glassAttack clientChan state x y z = do
364 bm <- blockMap <$> readMVar (gameState state)
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
365 let (chunkC,blockC) = decomposeCoords x y z
e6e4d7e @glguy Clean up warnings, add \through command
authored
366 case Map.lookup chunkC bm of
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
367 Just (arr,_) -> do
368 blockId <- readArray arr blockC
369 if (blockId /= Air) then do
370 tellPlayer clientChan "Glass attack!"
371
62d7d39 @glguy Add documentation
authored
372 let coords = chunkedCoords $ nearby x y z
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
373 coords' <- mapM (filterGlassUpdate bm blockId) coords
374 let glassMsgs = makeGlassUpdate =<< coords'
375 sendMessages clientChan glassMsgs
376
377 modifyMVar_ (restoreVar state) $ \ m ->
378 return $! mergeCoords m coords'
379
380 return True
381 else return False
382 _ -> return False
383
384 mergeCoords :: Map ChunkLoc (Set BlockLoc) ->
385 [(ChunkLoc, [BlockLoc])] ->
386 Map ChunkLoc (Set BlockLoc)
387 mergeCoords = foldl' $ \ m (chunk,blocks) ->
388 let aux = Just
389 . Set.union (Set.fromList blocks)
390 . fromMaybe Set.empty
391 in if null blocks then m else Map.alter aux chunk m
392
e6e4d7e @glguy Clean up warnings, add \through command
authored
393 drawLine :: Message ->
394 Int32 {- ^ First X -} ->
62d7d39 @glguy Add documentation
authored
395 Int8 {- ^ First Y -} ->
e6e4d7e @glguy Clean up warnings, add \through command
authored
396 Int32 {- ^ First Z -} ->
397 Int32 {- ^ Second X -} ->
62d7d39 @glguy Add documentation
authored
398 Int8 {- ^ Second Y -} ->
e6e4d7e @glguy Clean up warnings, add \through command
authored
399 Int32 {- ^ Second Z -} ->
400 Face ->
401 Maybe (ItemId, Int8, Int16) {- ^ Hand contents -} ->
402 [Message]
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
403 drawLine msg x y z x1 y1 z1 f o
404 | x == x1 && y == y1 = [PlayerBlockPlacement x y z2 f o | z2 <- [min z z1 .. max z z1]]
405 | x == x1 && z == z1 = [PlayerBlockPlacement x y2 z f o | y2 <- [min y y1 .. max y y1]]
406 | z == z1 && y == y1 = [PlayerBlockPlacement x2 y z f o | x2 <- [min x x1 .. max x x1]]
407 | otherwise = [msg]
369d1fa @glguy Split out the proxy code from protocol code
authored
408
62d7d39 @glguy Add documentation
authored
409 lookupBlock :: BlockMap -> ChunkLoc -> BlockLoc -> IO (Maybe BlockId)
0c225ca @glguy Move to mutable arrays and include a line drawing command
authored
410 lookupBlock bm chunkC blockC = do
e6e4d7e @glguy Clean up warnings, add \through command
authored
411 for (Map.lookup chunkC bm) $ \ (blockArray, _) ->
412 readArray blockArray blockC
e05639d @glguy Glass attack checkpoint
authored
413
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
414 filterGlassUpdate :: BlockMap -> BlockId -> (ChunkLoc, [BlockLoc]) -> IO (ChunkLoc, [BlockLoc])
4171c8c @glguy Move multiblock coordinate parsing into Protocol
authored
415 filterGlassUpdate bm victim (chunk, blocks) = do
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
416 let isVictim x = x == Just victim
4171c8c @glguy Move multiblock coordinate parsing into Protocol
authored
417 xs <- filterM (\ c -> isVictim <$> lookupBlock bm chunk c) blocks
418 return (chunk,xs)
01454c2 @glguy First draft of command to undo 'glass attack'
authored
419
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
420 makeGlassUpdate :: (ChunkLoc,[BlockLoc]) -> [Message]
421 makeGlassUpdate (_, []) = []
4171c8c @glguy Move multiblock coordinate parsing into Protocol
authored
422 makeGlassUpdate (chunk, coords)
423 = [MultiblockChange chunk [(c, Glass, 0) | c <- coords]]
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
424
425 makeRestore :: BlockMap -> Map ChunkLoc (Set BlockLoc) -> IO [Message]
426 makeRestore bm = sequence . mapMaybe toMessage . Map.toList
427 where
428 toMessage :: (ChunkLoc, Set BlockLoc) -> Maybe (IO Message)
4171c8c @glguy Move multiblock coordinate parsing into Protocol
authored
429 toMessage (chunk, blocks)
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
430 = do guard (not (Set.null blocks))
431 (blockArray, metaArray) <- Map.lookup chunk bm
4171c8c @glguy Move multiblock coordinate parsing into Protocol
authored
432 return $ fmap (MultiblockChange chunk)
e6e4d7e @glguy Clean up warnings, add \through command
authored
433 $ for (Set.toList blocks) $ \ b ->
434 do blockType <- readArray blockArray b
435 blockMeta <- readArray metaArray b
4171c8c @glguy Move multiblock coordinate parsing into Protocol
authored
436 return (b, blockType, fromIntegral blockMeta)
01454c2 @glguy First draft of command to undo 'glass attack'
authored
437
438
24010c6 @glguy Add dig speed command
authored
439
e05639d @glguy Glass attack checkpoint
authored
440
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
441 chunkedCoords :: [(Int32,Int8,Int32)] -> [(ChunkLoc, [BlockLoc])]
442 chunkedCoords = collect . map categorize
443 where categorize (x,y,z) = decomposeCoords x y z
444
445 collect :: Ord a => [(a,b)] -> [(a, [b])]
446 collect = Map.toList . Map.fromListWith (++) . map (\ (a,b) -> (a,[b]))
e05639d @glguy Glass attack checkpoint
authored
447
62d7d39 @glguy Add documentation
authored
448 -- | 'nearby' computes the coordinates of blocks that are within 10
449 -- blocks of the given coordinate.
450 nearby ::
451 Int32 {- ^ X coordinate -} ->
452 Int8 {- ^ Y coordinate -} ->
453 Int32 {- ^ Z coordinate -} ->
454 [(Int32,Int8,Int32)]
455 nearby x y z = filter inSphere box
20fa545 @glguy Add a bunch of comments, types, error handlers
authored
456 where radius :: Num a => a
457 radius = 10
e6e4d7e @glguy Clean up warnings, add \through command
authored
458 inSphere (x1,y1,z1) = squared radius > (squared (x1-x) + fromIntegral (squared (y1-y)) + squared (z1-z))
459 squared i = i * i
e05639d @glguy Glass attack checkpoint
authored
460 box = (,,) <$> [x-radius .. x+radius] <*> [y-radius .. y+radius] <*> [z-radius .. z+radius]
e6e4d7e @glguy Clean up warnings, add \through command
authored
461
462 digShift :: Int32 -> Int8 -> Int32 -> Face -> Int -> (Int32, Int8, Int32)
463 digShift x y z face i = case face of
464 X1 -> (x+i',y,z)
465 X2 -> (x-i',y,z)
466 Y1 -> (x,y+i',z)
467 Y2 -> (x,y-i',z)
468 Z1 -> (x,y,z+i')
469 Z2 -> (x,y,z-i')
470 None -> (x,y,z)
471
472 where i' :: Num a => a
473 i' = fromIntegral i
dc34098 @glguy Add \help and \status
authored
474
475 helpMessage :: [String]
476 helpMessage =
477 ["Commands:"
478 ,"\\status - List proxy status"
479 ,"\\follow <player name> - Compass points to player"
480 ,"\\follow off - Compass points to spawnpoint"
481 ,"\\dig <n> - Multiplies dig speed by 'n'"
482 ,"\\glass {on,off} - Glassify new chunks"
483 ,"\\through <n> - Dig 'n' blocks behind"
484 ,"\\lines {on,off} - Place blocks in lines on an axis"
9a10ea4 @glguy Add a \time command
authored
485 ,"\\time <n> - Set time to value 0--24000"
486 ,"\\time off - Allow time to pass"
dc34098 @glguy Add \help and \status
authored
487 ,"Right-click with clock - Glassify local sphere"
488 ,"Right-click with compass - Revert glass spheres"
489 ]
490
491 statusMessages :: ProxyState -> IO [String]
492 statusMessages state = sequence
493 [ return "Proxy Status ------------------------"
494 , followStatus <$> readMVar (followVar state)
495 , digStatus <$> readIORef (digVar state)
496 , glassStatus <$> readIORef (glassVar state)
497 , throughStatus <$> readIORef (digThrough state)
498 , lineStatus <$> readIORef (lineVar state)
9a10ea4 @glguy Add a \time command
authored
499 , timeStatus <$> readIORef (timeVar state)
dc34098 @glguy Add \help and \status
authored
500 , restoreStatus <$> readMVar (restoreVar state)
501 ]
502 where
503 onOff True = highlight "on"
504 onOff False = highlight "off"
505 followStatus x = "Following " ++
506 case x of
507 Nothing -> "spawn point"
508 (Just (name,_)) -> " player: " ++ highlight name
509 digStatus x = "Dig speed: " ++ highlight (show x)
510 glassStatus b = "Glass chunks: "++ onOff b
511 throughStatus n = "Dig through: " ++ highlight (show n)
512 lineStatus (b,_) = "Line mode: " ++ onOff b
9a10ea4 @glguy Add a \time command
authored
513 timeStatus Nothing = "Time mode normal"
514 timeStatus (Just x) = "Time fixed at: " ++ highlight (show x)
dc34098 @glguy Add \help and \status
authored
515 restoreStatus m = "Blocks to restore: " ++
516 highlight (show (Data.Foldable.sum (fmap Set.size (Map.elems m))))
Something went wrong with that request. Please try again.