mcpi 0.0.0.4 → 0.0.1.0
raw patch · 3 files changed
+199/−7 lines, 3 filesdep ~basedep ~pipesdep ~transformersnew-component:exe:shapes
Dependency ranges changed: base, pipes, transformers
Files
- examples/HMCPI.hs +7/−5
- examples/Shapes.hs +175/−0
- mcpi.cabal +17/−2
examples/HMCPI.hs view
@@ -32,10 +32,12 @@ import Control.Concurrent (forkIO) import Control.Monad (when)-import Control.Proxy import Network (PortID (..), connectTo) +import Pipes+import qualified Pipes.Prelude as P+ import System.Environment (getArgs, getProgName) import System.Exit (exitFailure) import System.IO ( BufferMode(LineBuffering), Handle@@ -57,16 +59,16 @@ -- pipeTo :: Handle -> Handle -> IO () pipeTo inHdl outHdl =- runProxy $ hGetLineS inHdl >-> hPutStrLnD outHdl+ runEffect $ P.fromHandle inHdl >-> P.toHandle outHdl {- How best to handle a user exit? Need to signal to the main program that we have finished pipeToWithExit :: Handle -> Handle -> IO () pipeToWithExit inHdl outHdl =- runProxy $ hGetLineS inHdl >->- takeWhileD ('\EOT' `notElem`) >->- hPutStrLnD outHdl+ runEffect $ P.fromHandle inHdl >->+ P.takeWhile ('\EOT' `notElem`) >->+ P.toHandle outHdl -}
+ examples/Shapes.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE RecordWildCards #-}++module Main where++import Control.Concurrent (threadDelay)+import Control.Monad (forM_)+import Control.Monad.IO.Class (liftIO)++import Data.MineCraft.Pi.Block+import Data.MineCraft.Pi.Player+import Data.MineCraft.Pi.Types+import Data.MineCraft.Pi.Other++-- import Network.MineCraft.Pi.Client (MCPI, runMCPI)+import Network.MineCraft.Pi.Client.Internal (MCPI, runMCPI')++import System.Environment (getProgName)+import System.Exit (exitFailure)+import System.IO++-- | Could also store the bounding box for each option.+data Shape =+ BlockList BlockType [IPos]+ | BlockCuboid BlockType IPos IPos+ +type Shapes = [Shape] ++-- | Given a center and width, return the coordinates +-- of the first and last item.+limits :: Int -> Int -> (Int, Int)+limits c w = + let (hw, d) = w `divMod` 2+ in (c - hw, c + hw + d)++-- | If the width is even, the cube will extend from +-- @center - width/2@ to @center + width/2@.+makeRectangle :: + BlockType -- ^ block type+ -> IPos -- ^ center of rectangle+ -> Int -- ^ width in x+ -> Int -- ^ width in y+ -> Int -- ^ width in z+ -> Shape +makeRectangle bt Pos {..} wx wy wz =+ let (x1,x2) = limits _x wx+ (y1,y2) = limits _y wy+ (z1,z2) = limits _z wz+ p1 = Pos x1 y1 z1+ p2 = Pos x2 y2 z2+ + in BlockCuboid bt p1 p2++-- | If the width is even, the cube will extend from +-- @center - width/2@ to @center + width/2@.+makeCube :: + BlockType -- ^ block type+ -> IPos -- ^ center of cube+ -> Int -- ^ width of cube+ -> Shape +makeCube bt pos w = makeRectangle bt pos w w w++-- | Note that we convert all the other blocks in the+-- cube to air.+makePyramid ::+ BlockType -- ^ block type+ -> IPos -- ^ center of the base+ -> Int -- ^ width of base (also the height)+ -> Shapes+makePyramid bt Pos {..} w =+ let (hw,_) = w `divMod` 2+ pMid = Pos _x _y (_z + hw)+ toP l = makeRectangle bt (Pos _x _y (_z+l)) (w-2*l) (w-2*l) 0+ pyramid = map toP [0..hw]+ in makeCube air pMid w : pyramid++renderShape :: Shapes -> MCPI ()+renderShape = + let rs (BlockList bt pos) = mapM_ (\p -> setBlock p bt) pos+ rs (BlockCuboid bt p1 p2) = setBlocks p1 p2 bt+ in mapM_ rs++frob :: BlockType -> MCPI ()+frob bt = do+ pos@Pos {..} <- getPlayerTile+ let shape = makePyramid bt pos 12+ setPlayerTile $ Pos (_x+20) (_y+20) _z+ renderShape shape+ setPlayerTile $ Pos _x _y (_z+40)+ +usage :: IO ()+usage = do+ progName <- getProgName+ hPutStrLn stderr $ "Usage: " ++ progName+ exitFailure++-- | Move the player by the given coordinates, which+-- are relative to the current location. The return+-- value is the new coordinate of the player, if +-- that position contains air, otherwise the player+-- is not moved.+--+movePlayer ::+ Int -- ^ Change in X+ -> Int -- ^ Change in Y+ -> Int -- ^ Change in Z+ -> MCPI (Maybe (Pos Int))+movePlayer dx dy dz = do+ Pos {..} <- getPlayerTile+ let nPos = Pos (_x + dx) (_y + dy) (_z + dz)+ btype <- getBlock nPos+ if btype == air+ then setPlayerTile nPos >> return (Just nPos)+ else return Nothing+ +showBlocksAsWall :: MCPI ()+showBlocksAsWall = do+ Pos {..} <- getPlayerTile+ let x1 = _x - 128+ y1 = _y + 20 + setBlocks (Pos x1 y1 (_z-1)) (Pos (x1+255) (y1+4) (_z+1)) $ sandstone+ + forM_ [0..255] $ \ctr ->+ setBlocks + (Pos (x1+ctr) y1 _z)+ (Pos (x1+ctr) (y1+4) (_z+16))+ $ BlockType $ fromIntegral ctr++showBlocksAsFloor :: MCPI ()+showBlocksAsFloor = do+ Pos {..} <- getPlayerTile+ let w = 4+ hw = 8 * w+ x1 = _x - hw+ y1 = _y - hw + x2 = x1 + 2 * hw+ y2 = y1 + 2 * hw+ z = _z - 1+ setBlocks (Pos x1 y1 (z-1)) (Pos x2 y2 (z-1)) $ sandstone+ + forM_ [0..15] $ \j ->+ let ys = y1 + j * w+ ye = ys + w - 1+ ctrBase = j * 16+ in forM_ [0..15] $ \i ->+ let xs = x1 + i * w+ xe = xs + w - 1+ ctr = fromIntegral $ i + ctrBase+ in setBlocks+ (Pos xs ys z)+ (Pos xe ye z)+ $ BlockType ctr++-- TODO: report only when block data differs+reportBlock :: MCPI ()+reportBlock = + let go oPos = do+ liftIO $ threadDelay 1000000+ nPos <- getPlayerTile+ if nPos == oPos+ then go oPos+ else do+ let bPos = Pos { _x = _x nPos+ , _y = _y bPos+ , _z = _z nPos - 1+ }+ (bType, bData) <- getBlockData bPos+ chatPost $ "Block: " ++ showBlock bType+ chatPost $ " : " ++ show bData+ go nPos+ + in getPlayerTile >>= go+ +main :: IO ()+main = runMCPI' True reportBlock+
mcpi.cabal view
@@ -1,5 +1,5 @@ Name: mcpi-Version: 0.0.0.4+Version: 0.0.1.0 Homepage: https://github.com/DougBurke/hmcpi Bug-Reports: https://github.com/DougBurke/hmcpi/issues Stability: experimental@@ -134,6 +134,21 @@ base, mcpi +Executable shapes+ if !flag(build-examples)+ Buildable: False++ Main-Is: Shapes.hs+ Hs-Source-Dirs: examples/ ++ ghc-options:+ -Wall++ Build-Depends:+ base,+ mcpi,+ transformers+ -- Debug programs Executable hmcpi if !flag(build-debug)@@ -151,7 +166,7 @@ Build-Depends: base, network,- pipes >= 3.0 && < 3.2+ pipes >= 4.0 && < 4.1 Executable debugmcpi if !flag(build-debug)