packages feed

mcpi (empty) → 0.0.0.1

raw patch · 14 files changed

+1326/−0 lines, 14 filesdep +basedep +mcpidep +networksetup-changed

Dependencies added: base, mcpi, network, pipes, split, transformers

Files

+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/Flatten.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE RecordWildCards #-}++{-+License:++This code is placed in the Public Domain.++Author:++Douglas Burke (dburke.gw@gmail.com)++Usage:++  ./flatten [<radius>]++Convert all blocks within the given distance of the player,+and at a height one below that of the player, to gold.+Any blocks above this are removed.++If radius is not given then it defaults to 5. There is no+sanity check to ensure that radius is positive.++It could check that we are not about to place blocks onto+air/water.+-}++module Main where++import Control.Monad (forM_, when)+import Control.Monad.IO.Class++import Data.Maybe (listToMaybe)++import System.Environment+import System.Exit+import System.IO++import Data.MineCraft.Pi.Block+import Data.MineCraft.Pi.Other+import Data.MineCraft.Pi.Player+import Data.MineCraft.Pi.Types++import Network.MineCraft.Pi.Client++-- | Given x0,y0 and a radius, return all the block positions within+--   the circle. We use the coordinate of each block to determine+--   whether it is in or out.+--+--   Could be much-more efficient.+circleCoords :: Int -> Int -> Int -> [(Int, Int)]+circleCoords x0 y0 r = +   let r2 = r * r+       isIn (a,b) = (a-x0)*(a-x0) + (b-y0)*(b-y0) <= r2+   in filter isIn [(i,j) | i <- [x0-r .. x0+r], j <- [y0-r .. y0+r]]+ +-- | Flatten the area surrounding the user to a distance+--   of r (radius) blocks. The ground is set to the given+--   block type.+--+--   TODO: shoud check that the blocks are not going onto+--   water/over air/replacing ice so that they do not sink,+--   but it may not be worth the effort.+--+flattenArea :: BlockType -> Int -> MCPI ()+flattenArea bType r = do+    liftIO $ putStrLn "Connected to MineCraft"+    Pos {..} <- getPlayerTile+    liftIO $ putStrLn $ "User is at x,y=" ++ show _x ++ "," ++ show _y +++                        " and a height of " ++ show _z++    forM_ (circleCoords _x _y r) $ \(i,j) -> do+        -- clear everything above this point+        -- it depends on whether height means max z containing a+        -- block, or the max connected z (probably the latter)+        --+        let p0 = Pos i j $ _z - 1+        h <- getHeight p0+        when (h >= _z) $ setBlocks +                          (Pos i j _z)+                          (Pos i j h)+                          air++        setBlock p0 bType++    liftIO $ putStrLn "Exiting from MineCraft"++maybeRead :: Read a => String -> Maybe a+maybeRead = fmap fst . listToMaybe . reads++usage :: IO ()+usage = do+    progName <- getProgName+    hPutStrLn stderr $ "usage: " ++ progName ++ " [<radius>]"+    exitFailure++main :: IO ()+main = do+  args <- getArgs+  case args of+    [] -> runMCPI (flattenArea goldOre 5)+    [rstr] -> case maybeRead rstr of+                  Just r -> runMCPI (flattenArea goldOre r)+                  _ -> usage+    _ -> usage+
+ examples/Freefall.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE RecordWildCards #-}++{-+License:++This code is placed in the Public Domain.++Author:++Douglas Burke (dburke.gw@gmail.com)++Usage:++  ./freefall [<height>]++Example program showing how to send commands to MineCraft on+Raspberry Pi.++The program increases the user's current height by the+given argument, which defaults to 100. There is no sanity+check to ensure that the height is positive.+-}++module Main where++import Control.Monad (when)+import Control.Monad.IO.Class++import Data.Maybe (listToMaybe)++import System.Environment+import System.Exit+import System.IO++import Data.MineCraft.Pi.Block+import Data.MineCraft.Pi.Other+import Data.MineCraft.Pi.Player+import Data.MineCraft.Pi.Types++import Network.MineCraft.Pi.Client++moveUser :: Int -> MCPI ()+moveUser j = do+    liftIO $ putStrLn "Connected to MineCraft"+    Pos {..} <- getPlayerTile+    chatPost $ "Jumping from " ++ show _z ++ " to " ++ show (_z + j)+    let newPos = Pos _x _y (_z + j)+    bType <- getBlock newPos+    if bType == air+      then do+        setPlayerTile newPos+        bType_ <- getBlock $ Pos _x _y (_z + j - 1)+        when (bType_ == air) (chatPost "Weeeeeeeeee!!!!!!")++      else liftIO $ putStrLn ("Awwwww: jump would end in " ++ +                              showBlock bType) ++    liftIO $ putStrLn "Exiting from MineCraft"++maybeRead :: Read a => String -> Maybe a+maybeRead = fmap fst . listToMaybe . reads++usage :: IO ()+usage = do+    progName <- getProgName+    hPutStrLn stderr $ "usage: " ++ progName ++ " [<jump>]"+    hPutStrLn stderr   "\n       The default jump is 100 (blocks)."+    exitFailure++main :: IO ()+main = do+  args <- getArgs+  case args of+    [] -> runMCPI (moveUser 100)+    [jstr] -> case maybeRead jstr of+                  Just j -> runMCPI (moveUser j)+                  _ -> usage+    _ -> usage+
+ examples/HMCPI.hs view
@@ -0,0 +1,110 @@+{-+License:++This code is placed in the Public Domain.++Author:++Douglas Burke (dburke.gw@gmail.com)++Usage:++  ./hmcpi++Connects to MineCraft-PI and allows you to enter commands (it can be+thought of as telnet specialized to connect to just MineCraft).++At present there is no attempt to provide an improved interface, such+as help messages, auto-completion of commands, ignoring blank or+comment lines. These could be added, but at least the current+implementation does let you see exactly what is sent to and from+MineCraft-PI.++One useful change would be for control-D - or some other terminal+character or string - to exit the program. At the moment the only+way to exit is to kill the program (e.g. with control-C).++-}++module Main where++import qualified Control.Exception as CE++import Control.Concurrent (forkIO)+import Control.Monad (when)+import Control.Proxy++import Network (PortID (..), connectTo)++import System.Environment (getArgs, getProgName)+import System.Exit (exitFailure)+import System.IO ( BufferMode(LineBuffering), Handle+                 , hClose, hIsTerminalDevice+                 , hPutStrLn, hSetBuffering+                 , stderr, stdin, stdout )++-- | Link together the two handles, so that content+--   moves from the first to the second.+--+--   It might be nice to clean out user input - e.g. skip blank+--   or empty lines - as well as provide support (e.g. help), but+--   for now just pass through everything. This at least means+--   that we can see what the server is actually doing, and+--   means we can use the same code for connecting user input+--   to the server as well as displaying the user output.+--+pipeTo :: Handle -> Handle -> IO ()+pipeTo inHdl outHdl =+    runProxy $ hGetLineS inHdl >-> hPutStrLnD 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++-}++pipeToWithExit :: Handle -> Handle -> IO ()+pipeToWithExit = pipeTo+++-- | Only display the message if @stdin@ is connected to+--   a terminal device (i.e. the input is not being piped+--   from a file).+--+logMsg :: String -> IO ()+logMsg msg = hIsTerminalDevice stdin >>= \flag -> when flag (putStrLn msg)++mcpi :: IO ()+mcpi = +    let errorHandler :: CE.IOException -> IO ()+        errorHandler _ = do+          hPutStrLn stderr "ERROR: Unable to connect MineCraft. Is it running?"+          exitFailure++    in CE.bracket+           (connectTo "127.0.0.1" (PortNumber 4711))+           hClose+           (\server -> do+              logMsg "*** Connected to MineCraft"+              mapM_ (`hSetBuffering` LineBuffering) [stdin, stdout, server]+              _ <- forkIO $ stdin `pipeToWithExit` server+              server `pipeTo` stdout+           )+           `CE.catch` errorHandler+               +usage :: IO ()+usage = do+    progName <- getProgName+    hPutStrLn stderr $ "Usage: " ++ progName+    exitFailure++main :: IO ()+main = do+  args <- getArgs+  if null args then mcpi else usage+
+ examples/IsOnGold.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE RecordWildCards #-}++module Main where++import Control.Monad (when)++import Data.MineCraft.Pi.Block +import Data.MineCraft.Pi.Player+import Data.MineCraft.Pi.Types++import Network.MineCraft.Pi.Client++-- | Returns @True@ if the player is standing on gold ore.+isOnGold :: IO Bool+isOnGold = runMCPI $ do+    Pos {..} <- getPlayerTile+    bType <- getBlock $ Pos _x _y (_z-1)+    return (bType == goldOre)++main :: IO ()+main = do+    flag <- isOnGold+    when flag $ putStrLn "Look down!"
+ examples/README view
@@ -0,0 +1,56 @@++There are several programs, illustrating some very *basic*+interactions with MineCraft-PI.++*) freefall++Source code: Freefall.hs ++Usage:+  freefall+  freefall jump++Increase the height of the player by jump blocks. If not specified the+jump is 100 blocks. A check is made to ensure that the jump does not+place the player into a block. Messages are sent to MineCraft to+inform the player what is happening.++There is no check that jump is valid (e.g. is positive, or not so+great that it exceeds the limits of the world), but this could be+added quite easily.+ +*) flatten++Source code: Flatten.hs ++Usage:+  flatten+  flatten radius++Flatten the area surrounding the user, converting the floor into gold+and removing any blocks above it. The area converted is a circle of+the given radius (this defaults to 5 if not given). The central tile+is not counted, so that a radius of 1 will change the blocks in front+of, behind, and to the side of the player.++There is no check that the blocks that are added are actually+supported, although this could be added by an enterprising programmer.++*) hmcpi++Source code: HMCPI.hs++Usage:+  hmcpi+  hmcpi < filename++This provides a direct interface to MineCraft-PI. You enter the full+commands, such as chat.post(Hello World!) or world.getBlock(0,0,0),+and see the response from the game. The program is essentially telnet+but specialized to only talk to MineCraft. There is currently no+attempt at providing a nicer interface, such as help, automatic+completion of commands, or cleaning user input.++Note that this program does not take use the hmcpi library, since it+is a low-level interface.+
+ mcpi.cabal view
@@ -0,0 +1,116 @@+name:           mcpi+Version:        0.0.0.1+Stability:      experimental+License:        PublicDomain+Author:         Douglas Burke (dburke.gw@gmail.com)+Maintainer:     dburke.gw@gmail.com+Category:       network, raspberrypi, minecraft+Synopsis:       Connect to MineCraft running on a Raspberry PI.+Description:+  The MineCraft edition for Raspberry PI comes with a Java and+  Python API.+  .+  This is a *very* basic, and *incomplete* Haskell version. I+  fully expect everything to change in later versions.+  .+  Two very simple examples are included in the examples/ directory,+  as well as a way to interact with MineCraft directly.+  .+  Please see the TODO file in the source code for an incomplete+  list of possible changes.++Tested-With:    GHC==7.4.1+Cabal-Version:  >= 1.8+Build-Type:     Simple++-- #Source-repository head+-- #  type:      mercurial+-- #  location:  https://bitbucket.org/doug_burke/grabtweets++Data-Files:     examples/README+                examples/*.hs++Flag build-examples+  Description: Build the example programs (defaults to True)+  Default:     True++Library+   Build-Depends:+      base >=3 && < 5,+      network == 2.3.*,+      split == 0.2.*,+      transformers == 0.3.*++   Hs-Source-Dirs: src/++   Exposed-Modules:+      Network.MineCraft.Pi.Client+      Network.MineCraft.Pi.Client.Internal+      Data.MineCraft.Pi.Block+      Data.MineCraft.Pi.Camera+      Data.MineCraft.Pi.Other+      Data.MineCraft.Pi.Player+      Data.MineCraft.Pi.Types++   ghc-options:+      -Wall++Executable         flatten+   if !flag(build-examples)+     Buildable: False++   Main-Is:        Flatten.hs+   Hs-Source-Dirs: examples/ ++   ghc-options:+      -Wall++   Build-Depends:+      base,+      mcpi,+      transformers++Executable         freefall+   if !flag(build-examples)+     Buildable: False++   Main-Is:        Freefall.hs+   Hs-Source-Dirs: examples/ ++   ghc-options:+      -Wall++   Build-Depends:+      base,+      mcpi,+      transformers++Executable         hmcpi+   if !flag(build-examples)+     Buildable: False++   Main-Is:        HMCPI.hs+   Hs-Source-Dirs: examples/ ++   ghc-options:+      -Wall++   Build-Depends:+      base,+      network,+      pipes == 3.1.*++Executable         isongold+   if !flag(build-examples)+     Buildable: False++   Main-Is:        IsOnGold.hs+   Hs-Source-Dirs: examples/ ++   ghc-options:+      -Wall++   Build-Depends:+      base,+      mcpi,+      transformers
+ src/Data/MineCraft/Pi/Block.hs view
@@ -0,0 +1,372 @@+--------------------------------------------------------------------------------+-- |+--  Module      :  Block+--  License     :  Public Domain+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  Haskell 98+--+-- Block handling.+--+-- It probably makes sense for the block types in+-- @Data.MineCraftg.Pi.Types@ - namely @BlockType@ and @BlockData@+-- to be moved into this module.+--+-- See <http://www.minecraftwiki.net/wiki/Data_values_(Pocket_Edition)> and+-- <http://www.minecraftwiki.net/wiki/Pi_Edition_version_history>, although I+-- have not cross-matched and verified all this information.+--+--------------------------------------------------------------------------------++module Data.MineCraft.Pi.Block+    (+      -- * Queries+      getBlock+    , getBlockData+    , getBlocks++      -- * Commands+    , setBlock+    , setBlockData+    , setBlocks+    , setBlocksData++      -- * Blocks+    , showBlock+    , air+    , stone+    , grass+    , dirt+    , cobblestone+    , woodPlanks+    , sapling+    , bedrock+    , water+    , waterStationary+    , lava+    , lavaStationary+    , sand+    , gravel+    , goldOre+    , ironOre+    , coalOre+    , wood+    , leaves+    , glass+    , lapisLazuliOre+    , lapisLazuliBlock+    , sandstone+    , bed+    , cobweb+    , grassTall+    , wool+    , flowerYellow+    , flowerCyan+    , mushroomBrown+    , mushroomRed+    , goldBlock+    , ironBlock+    , stoneSlabDouble+    , stoneSlab+    , brickBlock+    , tnt+    , bookshelf+    , mossStone+    , obsidian+    , torch+    , fire+    , stairsWood+    , chest+    , diamondOre+    , diamondBlock+    , craftingTable+    , farmland+    , furnaceInactive+    , furnaceActive+    , doorWood+    , ladder+    , stairsCobblestone+    , doorIron+    , redstoneOre+    , snow+    , ice+    , snowBlock+    , cactus+    , clay+    , sugarCane+    , fence+    , glowstoneBlock+    , bedrockInvisible+    , stoneBrick+    , glassPane+    , melon+    , fenceGate+    , glowingObsidian+    , netherReactorCore+    ) where++import Control.Monad (liftM)++import Data.Maybe (fromMaybe)+import Data.Word (Word16)++import Data.MineCraft.Pi.Types+import Network.MineCraft.Pi.Client+import Network.MineCraft.Pi.Client.Internal++-- | Block types.+air, stone, grass, dirt, cobblestone,+  woodPlanks, sapling, bedrock, water,+  waterStationary, lava, lavaStationary, sand,+  gravel, goldOre, ironOre, coalOre,+  wood, leaves, glass,+  lapisLazuliOre, lapisLazuliBlock,+  sandstone, bed, cobweb, grassTall, wool,+  flowerYellow, flowerCyan,+  mushroomBrown, mushroomRed,+  goldBlock, ironBlock, stoneSlabDouble, stoneSlab,+  brickBlock, tnt, bookshelf, mossStone, obsidian,+  torch, fire, stairsWood, chest, diamondOre,+  diamondBlock, craftingTable, farmland,+  furnaceInactive, furnaceActive, doorWood, ladder,+  stairsCobblestone, doorIron, redstoneOre,+  snow, ice, snowBlock, cactus, clay, sugarCane,+  fence, glowstoneBlock, bedrockInvisible,+  stoneBrick, glassPane, melon, fenceGate,+  glowingObsidian, netherReactorCore+  :: BlockType++air = BlockType 0+stone = BlockType 1+grass = BlockType 2+dirt = BlockType 3+cobblestone = BlockType 4+woodPlanks = BlockType 5+sapling = BlockType 6+bedrock = BlockType 7+water = BlockType 8+waterStationary = BlockType 9+lava = BlockType 10+lavaStationary = BlockType 11+sand = BlockType 12+gravel = BlockType 13+goldOre = BlockType 14+ironOre = BlockType 15+coalOre = BlockType 16+wood = BlockType 17+leaves = BlockType 18++glass = BlockType 20++lapisLazuliOre = BlockType 21+lapisLazuliBlock = BlockType 22++sandstone = BlockType 24++bed = BlockType 26++cobweb = BlockType 30+grassTall = BlockType 31++wool = BlockType 35++flowerYellow = BlockType 37+flowerCyan = BlockType 38+mushroomBrown = BlockType 39+mushroomRed = BlockType 40+goldBlock = BlockType 41+ironBlock = BlockType 42+stoneSlabDouble = BlockType 43+stoneSlab = BlockType 44+brickBlock = BlockType 45+tnt = BlockType 46+bookshelf = BlockType 47+mossStone = BlockType 48+obsidian = BlockType 49+torch = BlockType 50+fire = BlockType 51++stairsWood = BlockType 53+chest = BlockType 54++diamondOre = BlockType 56+diamondBlock = BlockType 57+craftingTable = BlockType 58 ++farmland = BlockType 60+furnaceInactive = BlockType 61+furnaceActive = BlockType 62++doorWood = BlockType 64+ladder = BlockType 65++stairsCobblestone = BlockType 67++doorIron = BlockType 71++redstoneOre = BlockType 73++snow = BlockType 78+ice = BlockType 79+snowBlock = BlockType 80+cactus = BlockType 81+clay = BlockType 82+sugarCane = BlockType 83++fence = BlockType 85++glowstoneBlock = BlockType 89++bedrockInvisible = BlockType 95++stoneBrick = BlockType 98++glassPane = BlockType 102+melon = BlockType 103++fenceGate = BlockType 107++glowingObsidian = BlockType 246+netherReactorCore = BlockType 247++-- For now assume the table is small enough it is not+-- worth using a map.+blockNames :: [(Word16, String)]+blockNames = +    [ (0, "Air")+    , (1, "Stone")+    , (2, "Grass")+    , (3, "Dirt")+    , (4, "Cobblestone")+    , (5, "Wooden Plank")+    , (6, "Sapling")+    , (7, "BedRock")+    , (8, "Water")+    , (9, "Stationary water")+    , (10, "Lava")+    , (11, "Stationary lava")+    , (12, "Sand")+    , (13, "Gravel")+    , (14, "Gold Ore")+    , (15, "Iron Ore")+    , (16, "Coal Ore")+    , (17, "Wood")+    , (18, "Leaves")+    , (20, "Glass")+    , (21, "Lapis Lazuli Ore")+    , (22, "Lapis Lazuli Block")+    , (24, "Sandstone")+    , (26, "Bed")+    , (30, "Cobweb")+    , (31, "Tall Grass")+    , (35, "Wool")+    , (37, "Yellow Flower")+    , (38, "Cyan Flower")+    , (39, "Brown Mushroom")+    , (40, "Brown Mushroom")+    , (41, "Gold Block")+    , (42, "Iron Block")+    , (43, "Double Stone Slab")+    , (44, "Stone Slab")+    , (45, "Brick Block")+    , (46, "TNT")+    , (47, "Bookshelf")+    , (48, "Moss Stone")+    , (49, "Obsidian")+    , (50, "Torch")+    , (51, "Fire")+    , (53, "Wooden Stairs")+    , (54, "Chest")+    , (56, "Diamond Ore")+    , (57, "Diamond Block")+    , (58, "Crafting Table")+    , (59, "Wheat Seeds") -- valid?+    , (60, "Farmland")+    , (61, "Furnace")+    , (62, "Burning Furnace")+    , (63, "Sign Post")+    , (64, "Wooden Door")+    , (65, "Ladder")+    , (67, "Cobblestone Stairs")+    , (68, "Wall Sign") -- valid?+    , (71, "Iron Door")+    , (73, "Redstone Ore")+    , (74, "Glowing Redstone Ore") -- valid?+    , (78, "Snow")+    , (79, "Ice")+    , (80, "Snow Block")+    , (81, "Cactus")+    , (82, "Clay")+    , (83, "Sugar Cane")+    , (85, "Fence")+    , (87, "Netherrack") -- valid?+    , (89, "Glowstone Block")+    , (95, "Invisible Bedrock")+    , (98, "Stone Brick")+    , (102, "Glass Pane")+    , (103, "Melon")+    , (105, "Melon Stem") -- valid?+    , (107, "Fence Gate")+    , (108, "Brick Stairs") -- valid?+    , (109, "Stone Brick Stairs") -- valid?+    , (112, "Nether Brick") -- valid?+    , (114, "Nether Brick Stairs") -- valid?+    , (128, "Sandstone Stairs") -- valid?+    , (155, "Block of Quartz") -- valid?+    , (156, "Quartz Stairs") -- valid?+    , (245, "Stone Cutter") -- valid?+    , (246, "Glowing Obsidian")+    , (247, "Nether Reactor Core")+    , (249, "Update Game Block") -- valid?+    , (253, "Grass Block (mimic)") -- valid?+    , (254, "Leaves (mysterious)") -- valid?+    , (255, ".name") -- valid?+    ]++-- | Return a name for the block type, or "Unknown block <number>"+--   if unknown.+showBlock :: BlockType -> String+showBlock (BlockType n) =+    fromMaybe ("Unknown block <" ++ show n ++ ">")+              $ lookup n blockNames++-- | What is the block at this position? See also `getBlockData`.+getBlock :: IPos -> MCPI BlockType+getBlock pos = fromMC `liftM` query "world.getBlock" [toMC pos]++-- | What is the block at this position? See also `getBlock`.+getBlockData :: IPos -> MCPI (BlockType, BlockData)+getBlockData pos = fromMC `liftM` query "world.getBlockWithData" [toMC pos]++-- | Get the blocks in the cuboid defined by the start and end positions.+--+getBlocks :: +    IPos      -- ^ One corner of the cuboid. +    -> IPos   -- ^ Opposite corner.+    -> MCPI [BlockType] -- ^ The order has not been specified.+getBlocks spos epos = fromMC `liftM`+                      query "world.getBlocks" [toMC spos, toMC epos]++-- | Change the block at the position. See also `setBlockData`.+setBlock :: IPos -> BlockType -> MCPI ()+setBlock pos bt = command "world.setBlock" [toMC pos, toMC bt]++-- | Change the block at the position. See also `setBlock`.+setBlockData :: IPos -> (BlockType, BlockData) -> MCPI ()+setBlockData pos (bt, bd) =+  command "world.setBlock" [toMC pos, toMC bt, toMC bd]++-- | Set all the blocks in the cuboid to the same type. See also+--   `setBlocksData`.+setBlocks :: IPos -> IPos -> BlockType -> MCPI ()+setBlocks spos epos bt =+  command "world.setBlocks" [toMC spos, toMC epos, toMC bt]++-- | Set all the blocks in the cuboid to the same type. See also+--   `setBlocks`.+setBlocksData :: IPos -> IPos -> (BlockType, BlockData) -> MCPI ()+setBlocksData spos epos (bt, bd) =+  command "world.setBlocks" [toMC spos, toMC epos, toMC bt, toMC bd]++
+ src/Data/MineCraft/Pi/Camera.hs view
@@ -0,0 +1,45 @@+--------------------------------------------------------------------------------+-- |+--  Module      :  Camera+--  License     :  Public Domain+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  Haskell 98+--+-- Handle the camera position.+--+-- *Note* At present this module does not handle multiple users.+--+--------------------------------------------------------------------------------++module Data.MineCraft.Pi.Camera+    (+      -- * Commands+      setCameraNormal+    , setCameraThirdPerson+    , setCameraFixed+    , setCameraPos+    ) where++import Data.MineCraft.Pi.Types++import Network.MineCraft.Pi.Client+import Network.MineCraft.Pi.Client.Internal++setCameraFixed :: MCPI ()+setCameraFixed = command "camera.mode.setFixed" []++setCameraNormal :: MCPI ()+setCameraNormal = command "camera.mode.setNormal" []++setCameraThirdPerson :: MCPI ()+setCameraThirdPerson = command "camera.mode.setThirdPerson" []++-- | Change the position of the camera.+setCameraPos :: IPos -> MCPI ()+setCameraPos pos = command "camera.mode.setPos" [toMC pos]++-- TODO: the Python API does not have the ThirdPerson variant+--       but it does have setFollow, to follow a user.+
+ src/Data/MineCraft/Pi/Other.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE RecordWildCards #-}++--------------------------------------------------------------------------------+-- |+--  Module      :  Other+--  License     :  Public Domain+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  RecordWildCards+--+-- A mixture of routines.+--+--------------------------------------------------------------------------------++module Data.MineCraft.Pi.Other+    (+      -- * Queries+      getHeight++      -- * Commands+    , chatPost+    ) where++import Control.Monad (liftM)++import Data.MineCraft.Pi.Types++import Network.MineCraft.Pi.Client+import Network.MineCraft.Pi.Client.Internal++-- | Send a message to the server.+--+--   Until I find out otherwise, I am going to assume that+--   any conversion done by @show msg@ - such as protecting+--   any double quotes - is sufficient. The spec does not+--   mention what is required.+--+--   There is no attempt to remove or replace invalid characters. The+--   MineCraft server API uses ASCII and it is likely that new lines+--   are not allowed in the message, although this is not specified.+--+chatPost :: String -> MCPI ()+chatPost msg = command "chat.post" [msg]++-- | Return the height of the world at this position. The spec says+--   that the input uses the (x,z) coordinates, but I am assuming this+--   is a typo and am using (x,y) instead.+--+--   It would be easy to test.+getHeight :: IPos -> MCPI Int+getHeight Pos {..} = fromMC `liftM` query "world.getHeight" [toMC _x, toMC _y]+
+ src/Data/MineCraft/Pi/Player.hs view
@@ -0,0 +1,49 @@+--------------------------------------------------------------------------------+-- |+--  Module      :  Player+--  License     :  Public Domain+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  Haskell 98+--+-- Players in MineCraft.+--+-- *Note* this module currently does not support multiple players.+--+--------------------------------------------------------------------------------++module Data.MineCraft.Pi.Player+    (+      -- * Queries+      getPlayerTile+    , getPlayerPos++      -- * Commands+    , setPlayerTile+    , setPlayerPos+    ) where++import Control.Monad (liftM)++import Data.MineCraft.Pi.Types++import Network.MineCraft.Pi.Client+import Network.MineCraft.Pi.Client.Internal++-- | Where is the user. See also `getPlayerPos`.+getPlayerTile :: MCPI IPos +getPlayerTile = fromMC `liftM` query "player.getTile" []++-- | Move the user. See also `setPlayerPos`.+setPlayerTile :: IPos -> MCPI ()+setPlayerTile pos = command "player.setTile" [toMC pos]++-- | Where is the user. See also `getPlayerPos`.+getPlayerPos :: MCPI FPos+getPlayerPos = fromMC `liftM` query "player.getPos" []++-- | Move the user. See also `setPlayerPos`.+setPlayerPos :: FPos -> MCPI ()+setPlayerPos pos = command "player.setPos" [toMC pos]+
+ src/Data/MineCraft/Pi/Types.hs view
@@ -0,0 +1,91 @@+--------------------------------------------------------------------------------+-- |+--  Module      :  Types+--  License     :  Public Domain+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  Haskell 98+--+-- Useful data types. The block types should probably move to+-- "Data.MineCraft.Pi.Block".+--+--------------------------------------------------------------------------------++module Data.MineCraft.Pi.Types +   (+     Pos(..)+   , IPos+   , FPos++   , BlockType(..)+   , BlockData(..)++   ) where++import Data.List (intercalate)+import Data.List.Split (splitOn)+import Data.Word (Word16)++import Network.MineCraft.Pi.Client++-- | Represent the position of an entity. Note that we use+--   @(X,Y,Z)@ order rather than @(X,Z,Y)@ used by the MineCraft API.+--+--   This *should* be replaced by one of the \"standard\" Haskell+--   3D vector types.+--+data Pos a = Pos { _x :: a, _y :: a, _z :: a }+   deriving (Eq, Show)++type IPos = Pos Int+type FPos = Pos Float++instance FromMineCraft a => FromMineCraft (Pos a) where+  fromMC s = let toks = map fromMC $ splitOn "," s+             in case toks of+                    (x:z:y:[]) -> Pos x y z+                    _ -> error $ "*Expected 3 values* " ++ s++instance ToMineCraft a => ToMineCraft (Pos a) where+  toMC (Pos x y z) = intercalate "," $ map toMC [x,z,y]++-- | Represent a block.+--+--   We should probably combine `BlockType` and `BlockData`.+--   I have not looked to see whether it is worth using+--   an integer (as I currently do) or just an enumerated+--   type (e.g. if there are large ranges of the range 0 to 1023+--   that do not represent a valid block).+--+--   Use `Data.MineCraft.Pi.Block.showBlock` for a more readable+--   way to convert to a @String@.+newtype BlockType = BlockType Word16 +  deriving (Eq, Ord, Show)++-- | Data on a block.+newtype BlockData = BlockData Int+  deriving (Eq, Ord, Show)++{- Looks like this range includes entities and other items than just+blocks.+instance Bounded BlockType where+  minBound = BlockType 0+  maxBound = BlockType 1023+-}++instance ToMineCraft BlockType where+  toMC (BlockType bt) = show bt++instance FromMineCraft BlockType where+  fromMC val = let i = eRead val+               in if i >= 0 && i < 1024+                  then BlockType i+                  else error $ "*invalid block type: " ++ val++instance ToMineCraft BlockData where+  toMC (BlockData bd) = show bd++instance FromMineCraft BlockData where+  fromMC = BlockData . eRead+
+ src/Network/MineCraft/Pi/Client.hs view
@@ -0,0 +1,86 @@+--------------------------------------------------------------------------------+-- |+--  Module      :  Client+--  License     :  Public Domain+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  Haskell 98+--+-- The main interface for connecting to the Raspberry-PI version+-- of MineCraft. The 'Network.MineCraft.Pi.Client.Internal' module+-- provides lower-level access in case this module in insufficient.+--+-- There are two types of calls to MineCraft: "command" and "query".+-- Commands change the state of the server and do not return anything,+-- queries return information from the server, and presumably does not+-- change the server state. This terminology may change.+--+-- I am not sure the use of the @FromMineCraft@ and @ToMineCraft@+-- type classes is justified, given that the API has a very limited+-- set of types.+--+--------------------------------------------------------------------------------++module Network.MineCraft.Pi.Client+    ( MCPI+    , runMCPI++    -- * Conversion routines+    , FromMineCraft(..)+    , ToMineCraft(..)++    -- * Utility routine+    , eRead+    ) where++import Data.List (intercalate)+import Data.List.Split (splitOn)+import Data.Maybe (fromMaybe, listToMaybe)++import Network.MineCraft.Pi.Client.Internal++-- | Convert the return value from MineCraft into+--   a Haskell type.+class FromMineCraft a where+  fromMC :: String -> a++-- | Send a value to MineCraft.+class ToMineCraft a where+  toMC :: a -> String++-- Isn't this in base somewhere by now?+maybeRead :: Read a => String -> Maybe a+maybeRead = fmap fst . listToMaybe . reads++-- | Convert a value, but error out if it can not be+--   converted.+eRead :: (Read a) => String -> a+eRead s = fromMaybe (error ("*Conversion error* " ++ s)) $ maybeRead s++instance FromMineCraft Int where+  fromMC = eRead ++instance ToMineCraft Int where+  toMC = show++instance FromMineCraft Float where+  fromMC = eRead++instance ToMineCraft Float where+  toMC = show++instance FromMineCraft a => FromMineCraft [a] where+  fromMC = map fromMC . splitOn ","++instance ToMineCraft a => ToMineCraft [a] where+  toMC = intercalate "," . map toMC++instance (FromMineCraft a, FromMineCraft b) => FromMineCraft (a, b) where+  fromMC s = case splitOn "," s of+                 (a:b:[]) -> (fromMC a, fromMC b)+                 _ -> error $ "*Expected 2 values* " ++ s++instance (ToMineCraft a, ToMineCraft b) => ToMineCraft (a, b) where+  toMC (a,b) = toMC a ++ "," ++ toMC b+
+ src/Network/MineCraft/Pi/Client/Internal.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE RecordWildCards #-}++--------------------------------------------------------------------------------+-- |+--  Module      :  Internal+--  License     :  Public Domain+--+--  Maintainer  :  Douglas Burke+--  Stability   :  experimental+--  Portability :  RecordWildCards+--+-- Internal types for connecting to the Raspberry-PI version+-- of MineCraft. Most users are expected to use 'Network.MineCraft.Pi.Client'+-- rather than this module, but it is provided in case the former+-- is not sufficient.+--+--------------------------------------------------------------------------------++module Network.MineCraft.Pi.Client.Internal+    ( MCPI+    , runMCPI+    , runMCPI'+    , query+    , command+    ) where++import qualified Control.Exception as CE++import Control.Exception (bracket)+import Control.Monad (when)+import Control.Monad.IO.Class+import Control.Monad.Trans.Reader++import Data.List (intercalate)++import Network.BSD+import Network.Socket++import System.Exit+import System.IO++-- | Represent a program that communicates with a MineCraft PI+--   server.+--+type MCPI = ReaderT ConnInfo IO++-- | Connection information.+data ConnInfo = ConnInfo {+      _ciHandle :: Handle  -- ^ Connection to the MineCraft program+    , _ciDebug :: Bool     -- ^ Should messages to and from MineCraft+                           --   be printed to @stderr@.+    }++-- | Commands do not return anything, queries do.+type Command = String+type Query = String+type Argument = String++-- | The port used by MineCraft is fixed.+mcPort :: String+mcPort = "4711"++-- | Open a connection to the Minecraft server or call+--   exitFailure, after displaying an error message to @stderr@.+--+openMCPI ::+    Bool  -- ^ Set to @True@ to get debugging messages printed to @stderr@.+    -> IO ConnInfo+openMCPI flag = do+    let ehdl :: CE.IOException -> IO ()+        ehdl _ = hPutStrLn stderr "ERROR: Unable to connect to MineCraft-PI. Is it running?" >>+                 exitFailure+       +    as <- getAddrInfo Nothing Nothing (Just mcPort)+    let a = head as -- note: getAddrInfo never returns an empty list+    sock <- socket (addrFamily a) Stream defaultProtocol+    setSocketOption sock KeepAlive 1+    connect sock (addrAddress a) `CE.catch` ehdl+    h <- socketToHandle sock ReadWriteMode+    hSetBuffering h LineBuffering++    return $ ConnInfo h flag++-- | Close the connection.+closeMCPI :: ConnInfo -> IO ()+closeMCPI = hClose . _ciHandle++logMsg :: ConnInfo -> String -> String -> MCPI ()+logMsg ConnInfo {..} hdr msg = +  when _ciDebug $ liftIO $ hPutStrLn stderr $ "*DBG*" ++ hdr ++ "*" ++ msg++-- It would be nice to do the argument marshalling here, i.e. have+-- something like @command :: Command -> [Argument] -> MCPI ()@+-- which would be run like @command "player.setTile" [Pos 0 0 0]@,+-- but I do not want to deal with heterogeneous lists at this time.+-- Instead, we force the caller to do the conversion.+--+addArgs :: String -> [Argument] -> String+addArgs a bs = a ++ "(" ++ intercalate "," bs ++ ")"++-- | Run a MineCraft command. +command :: Command -> [Argument] -> MCPI ()+command comm args = do+  ci <- ask+  let commstr = addArgs comm args+  logMsg ci "COMMAND" commstr+  liftIO $ hPutStrLn (_ciHandle ci) commstr++-- | Run a MineCraft query, returning the response.+query :: Query -> [Argument] -> MCPI String+query qry args = do+  ci <- ask+  let qrystr = addArgs qry args+  logMsg ci "QUERY" qrystr+  liftIO $ hPutStrLn (_ciHandle ci) qrystr+  ans <- liftIO $ hGetLine (_ciHandle ci)+  logMsg ci "RESPONSE" ans+  return ans++-- | Run a Raspberry-PI program. The flag determines whether the+--   messages sent to, and received from, the server, are+--   printed to @stderr@.+--+--   An exception is raised if the server is not running, or+--   can not be contacted.+runMCPI' :: Bool -> MCPI a -> IO a+runMCPI' flag p = +  bracket+    (openMCPI flag)+    closeMCPI+    (runReaderT p)++-- | Run a Raspberry-PI program.+--+--   An exception is raised if the server is not running, or+--   can not be contacted.+runMCPI :: MCPI a -> IO a+runMCPI = runMCPI' False+