Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add dig speed command

  • Loading branch information...
commit 24010c606f539e8d1d3d7cda9f3eae248bfaeb59 1 parent 4aff3c3
@glguy authored
Showing with 44 additions and 19 deletions.
  1. +7 −4 GameState.hs
  2. +37 −15 Proxy.hs
View
11 GameState.hs
@@ -113,7 +113,7 @@ decomposeCoords x y z = ((x `shiftR` 4
)
packCoords :: (Int8,Int8,Int8) -> Int
-packCoords (x,y,z) = fromIntegral x `shiftL` 12 .|. fromIntegral z `shiftL` 8 .|. fromIntegral y
+packCoords (x,y,z) = fromIntegral x `shiftL` 11 .|. fromIntegral z `shiftL` 7 .|. fromIntegral y
setChunk x y z sx sy sz bs ms bm = Map.alter
(\x -> Just $! (fromMaybe newVec x) V.// (zip coords bs))
@@ -129,8 +129,11 @@ setChunk x y z sx sy sz bs ms bm = Map.alter
setBlocks x z changes = Map.alter (\ x -> Just $! (fromMaybe newVec x) V.// map aux changes) (x,z)
where
- splitCoord c = (fromIntegral $ c `shiftR` 12, fromIntegral $ c .&. 0x7f, fromIntegral $ (c `shiftR` 8) .&. 0xf)
- aux (coord, ty, meta) = (fromIntegral (fromIntegral coord :: Word16), ty)
+ aux (coord, ty, meta) = (compressCoord coord, ty)
+ compressCoord :: Int16 -> Int
+ compressCoord c = fromIntegral $ (c' .&. 0xff00) `shiftR` 1 .|. c' .&. 0x7f
+ where c' :: Word16
+ c' = fromIntegral c
setBlock :: Int32 -> Int8 -> Int32 -> BlockId -> Int8 -> BlockMap -> BlockMap
setBlock x y z blockid meta = Map.alter
@@ -139,4 +142,4 @@ setBlock x y z blockid meta = Map.alter
where
(chunk,block) = decomposeCoords x (fromIntegral y) z
-newVec = V.replicate (16*16*256) Air
+newVec = V.replicate (16*16*128) Air
View
52 Proxy.hs
@@ -14,6 +14,7 @@ import Data.Bits
import Data.Foldable
import Data.IORef
import Data.Int
+import Data.Word
import Data.Map (Map)
import Data.List (groupBy,sort,isPrefixOf)
import qualified Data.Vector
@@ -58,6 +59,7 @@ proxy c s = do
var <- newEmptyMVar
emap <- newIORef newGameState
glassvar <- newIORef False
+ digspeed <- newIORef False
follow <- newIORef Nothing
chan <- newChan
schan <- newChan
@@ -65,20 +67,22 @@ proxy c s = do
sbs <- getContents s
traverse_ (proxy1 chan (inboundLogic follow emap glassvar))
(toMessages sbs)
- `finally` putMVar var "inbound"
+ `bad` putMVar var "inbound"
_ <- forkIO $ forever (sendAll c =<< readChan chan )
- `finally` putMVar var "inbound network"
+ `bad` putMVar var "inbound network"
_ <- forkIO $ forever (sendAll s =<< readChan schan )
- `finally` putMVar var "outbound network"
+ `bad` putMVar var "outbound network"
_ <- forkIO $ do
cbs <- getContents c
- traverse_ (proxy1 schan (outboundLogic chan follow emap glassvar))
+ traverse_ (proxy1 schan (outboundLogic chan follow emap glassvar digspeed))
(toMessages cbs)
- `finally` putMVar var "outbound"
+ `bad` putMVar var "outbound"
who <- takeMVar var
putStr who
putStrLn " died"
exitFailure
+ where
+ bad m n = m `Control.Exception.catch` \ (SomeException e) -> print e >> n
inboundLogic :: IORef (Maybe EntityId) ->
IORef GameState ->
@@ -124,17 +128,27 @@ inboundLogic follow emap glassvar msg = do
_ -> return [msg']
_ -> return [msg']
-processCommand cchan follow emap glassvar "glass on"
+processCommand cchan follow emap glassvar digspeed "glass on"
= writeIORef glassvar True
*> tellPlayer cchan "Glass On"
*> return []
-processCommand cchan follow emap glassvar "glass off"
+processCommand cchan follow emap glassvar digspeed "glass off"
= writeIORef glassvar False
*> tellPlayer cchan "Glass Off"
*> return []
-processCommand cchan follow emap glassvar text
+processCommand cchan follow emap glassvar digspeed "dig on"
+ = writeIORef digspeed True
+ *> tellPlayer cchan "Dig On"
+ *> return []
+
+processCommand cchan follow emap glassvar digspeed "dig off"
+ = writeIORef digspeed False
+ *> tellPlayer cchan "Dig Off"
+ *> return []
+
+processCommand cchan follow emap glassvar digspeed text
| "follow " `isPrefixOf` text
= case reads key of
[(eid, _)] -> do writeIORef follow $ Just $ EID eid
@@ -147,7 +161,7 @@ processCommand cchan follow emap glassvar text
*> return []
where key = drop 7 text
-processCommand cchan follow emap glassvar _ = do
+processCommand cchan follow emap glassvar _ _ = do
tellPlayer cchan "Command not understood"
return []
@@ -157,28 +171,32 @@ outboundLogic :: Chan ByteString ->
IORef (Maybe EntityId) ->
IORef GameState ->
IORef Bool ->
+ IORef Bool ->
Message ->
IO [Message]
-outboundLogic cchan follow emap glassvar msg = do
+outboundLogic cchan follow emap glassvar digspeed msg = do
case msg of
PlayerPosition {} -> return [msg]
PlayerPositionLook {} -> return [msg]
PlayerLook {} -> return [msg]
Player {} -> return [msg]
KeepAliv -> return [msg]
+ PlayerDigging Digging x y z face -> do
+ active <- readIORef digspeed
+ if active then return [msg,msg,msg,msg] else return [msg]
PlayerBlockPlacement x y z _ (Just (IID 0x15B, _, _)) -> do
- tellPlayer cchan "Glass attack!"
bm <- blockMap <$> readIORef emap
let (chunkC,blockC) = decomposeCoords x (fromIntegral y) z
case fmap (Data.Vector.! packCoords blockC) (Map.lookup chunkC bm) of
- Nothing -> return [msg]
- Just blockId -> do
+ Just blockId | blockId /= Air -> do
+ tellPlayer cchan "Glass attack!"
print glassMsgs
writeChan cchan $ runPut $ traverse_ putJ $ Prelude.concat glassMsgs
return []
where
glassMsgs = map (makeGlassUpdate bm blockId) $ chunkedNearby (x, fromIntegral y, z)
- Chat ('\\':xs) -> processCommand cchan follow emap glassvar xs
+ _ -> return [msg]
+ Chat ('\\':xs) -> processCommand cchan follow emap glassvar digspeed xs
_ -> do putStrLn $ "outbound: " ++ show msg
return [msg]
@@ -188,9 +206,13 @@ lookupBlock bm chunkC blockC = fmap ((Data.Vector.! packCoords blockC)) (Map.loo
makeGlassUpdate :: BlockMap -> BlockId -> ((Int32,Int32),[(Int8, Int8,Int8)]) -> [Message]
makeGlassUpdate bm victim ((cx,cz), blocks)
| null coords = []
- | otherwise = [MultiblockChange cx cz [(fromIntegral $ packCoords c, Glass, 0) | c <- coords]]
+ | otherwise = [MultiblockChange cx cz [(packCoords' c, Glass, 0) | c <- coords]]
where
coords = filter ( \ c -> lookupBlock bm (cx,cz) c == Just victim ) blocks
+ packCoords' (x,y,z) = fromIntegral (fromIntegral x `shiftL` 12
+ .|. fromIntegral z `shiftL` 8
+ .|. fromIntegral y :: Word16)
+
chunkedNearby coord = Map.toList $ Map.fromListWith (++) $ map (\ (x,y) -> (x,[y])) $ map (\ (x,y,z) -> decomposeCoords x y z) $ nearby coord
Please sign in to comment.
Something went wrong with that request. Please try again.