diff --git a/examples/Flatten.hs b/examples/Flatten.hs --- a/examples/Flatten.hs +++ b/examples/Flatten.hs @@ -11,7 +11,7 @@ Usage: - ./flatten [] + ./flatten [--debug] [] Convert all blocks within the given distance of the player, and at a height one below that of the player, to gold. @@ -29,19 +29,22 @@ 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 +-- Most users would import @runMCPI@ from +-- "Network.MineCraft.Pi.Client", but I want to allow +-- debug messages. +import Network.MineCraft.Pi.Client.Internal (MCPI, runMCPI') +import System.Environment (getArgs, getProgName) +import System.Exit (exitFailure) +import System.IO + +import Utils (checkForDebug, maybeRead, printVersion) + -- | 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. @@ -84,22 +87,21 @@ 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 ++ " []" + hPutStrLn stderr $ "Usage: " ++ progName ++ " [--debug] []" exitFailure main :: IO () main = do args <- getArgs - case args of - [] -> runMCPI (flattenArea goldOre 5) + let (dbg, args') = checkForDebug args + when dbg printVersion + case args' of + [] -> runMCPI' dbg (flattenArea goldOre 5) [rstr] -> case maybeRead rstr of - Just r -> runMCPI (flattenArea goldOre r) + Just r -> runMCPI' dbg (flattenArea goldOre r) _ -> usage _ -> usage diff --git a/examples/Freefall.hs b/examples/Freefall.hs --- a/examples/Freefall.hs +++ b/examples/Freefall.hs @@ -11,7 +11,7 @@ Usage: - ./freefall [] + ./freefall [--debug] [] Example program showing how to send commands to MineCraft on Raspberry Pi. @@ -26,19 +26,22 @@ 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 +-- Most users would import @runMCPI@ from +-- "Network.MineCraft.Pi.Client", but I want to allow +-- debug messages. +import Network.MineCraft.Pi.Client.Internal (MCPI, runMCPI') +import System.Environment (getArgs, getProgName) +import System.Exit (exitFailure) +import System.IO + +import Utils (checkForDebug, maybeRead, printVersion) + moveUser :: Int -> MCPI () moveUser j = do liftIO $ putStrLn "Connected to MineCraft" @@ -57,23 +60,22 @@ 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 ++ " []" + hPutStrLn stderr $ "usage: " ++ progName ++ " [--debug] []" hPutStrLn stderr "\n The default jump is 100 (blocks)." exitFailure main :: IO () main = do args <- getArgs - case args of - [] -> runMCPI (moveUser 100) + let (dbg, args') = checkForDebug args + when dbg printVersion + case args' of + [] -> runMCPI' dbg (moveUser 100) [jstr] -> case maybeRead jstr of - Just j -> runMCPI (moveUser j) + Just j -> runMCPI' dbg (moveUser j) _ -> usage _ -> usage diff --git a/examples/HMCPI.hs b/examples/HMCPI.hs --- a/examples/HMCPI.hs +++ b/examples/HMCPI.hs @@ -34,8 +34,6 @@ import Control.Monad (when) import Control.Proxy -import Data.Version (showVersion) - import Network (PortID (..), connectTo) import System.Environment (getArgs, getProgName) @@ -45,7 +43,7 @@ , hPutStrLn, hSetBuffering , stderr, stdin, stdout ) -import Paths_mcpi (version) +import Utils (printVersion) -- | Link together the two handles, so that content -- moves from the first to the second. @@ -111,6 +109,6 @@ main = do args <- getArgs if null args - then putStrLn ("HMCPI - version " ++ showVersion version) >> mcpi + then printVersion >> mcpi else usage diff --git a/examples/IsOnGold.hs b/examples/IsOnGold.hs --- a/examples/IsOnGold.hs +++ b/examples/IsOnGold.hs @@ -1,23 +1,53 @@ {-# LANGUAGE RecordWildCards #-} +{- + +Usage: + + ./isongold [--debug] + +-} + module Main where -import Control.Monad (when) +import Control.Monad (unless, when) import Data.MineCraft.Pi.Block import Data.MineCraft.Pi.Player import Data.MineCraft.Pi.Types -import Network.MineCraft.Pi.Client +-- Most users would import @runMCPI@ from +-- "Network.MineCraft.Pi.Client", but I want to allow +-- debug messages. +import Network.MineCraft.Pi.Client.Internal (runMCPI') +import System.Environment (getArgs, getProgName) +import System.Exit (exitFailure) +import System.IO + +import Utils (printVersion, checkForDebug) + -- | Returns @True@ if the player is standing on gold ore. -isOnGold :: IO Bool -isOnGold = runMCPI $ do +-- +-- The input flag controls whether debug messages are +-- displayed. +isOnGold :: Bool -> IO Bool +isOnGold flag = runMCPI' flag $ do Pos {..} <- getPlayerTile bType <- getBlock $ Pos _x _y (_z-1) return (bType == goldOre) +usage :: IO () +usage = do + pName <- getProgName + hPutStrLn stderr $ "Usage: " ++ pName ++ " [--debug]" + exitFailure + main :: IO () main = do - flag <- isOnGold + args <- getArgs + let (dbg, args') = checkForDebug args + unless (null args') usage + when dbg printVersion + flag <- isOnGold dbg when flag $ putStrLn "Look down!" diff --git a/examples/README.md b/examples/README.md --- a/examples/README.md +++ b/examples/README.md @@ -1,15 +1,23 @@ +Example programs +================ There are several programs, illustrating some very *basic* interactions with MineCraft-PI. -*) freefall +When called with the `--debug` argument the programs will print, +to `stderr`, the messages they send to, and receive from, the +MineCraft program. This is true for all the examples except for +`hmcpi`. -Source code: Freefall.hs +freefall +-------- +Source code: [Freefall.hs](https://github.com/DougBurke/hmcpi/blob/master/examples/Freefall.hs) + Usage: - freefall - freefall jump + freefall [--debug] [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 @@ -19,14 +27,15 @@ great that it exceeds the limits of the world), but this could be added quite easily. -*) flatten +flatten +------- -Source code: Flatten.hs +Source code: [Flatten.hs](https://github.com/DougBurke/hmcpi/blob/master/examples/Flatten.hs) Usage: - flatten - flatten radius + flatten [--debug] [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 @@ -36,30 +45,46 @@ There is no check that the blocks that are added are actually supported, although this could be added by an enterprising programmer. -*) hmcpi +hmcpi +----- -Source code: HMCPI.hs +Source code: [HMCPI.hs](https://github.com/DougBurke/hmcpi/blob/master/examples/HMCPI.hs) Usage: - hmcpi - hmcpi < filename + 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. +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. +Note that this program does not take use the `mcpi` library, since it +is provides a direct connection to the MineCraft-Pi program. -*) xjump +isongold +-------- -Source code: XJump.hs +Source code: [IsOnGold.hs](https://github.com/DougBurke/hmcpi/blob/master/examples/IsOnGold.hs) Usage: - xjump + + isongold [--debug] + +Tells the user to look down if they are standing on a gold ore block. + +xjump +----- + +Source code: [XJump.hs](https://github.com/DougBurke/hmcpi/blob/master/examples/XJump.hs) + +Usage: + + xjump [--debug] Move the player by 10 tiles in the X direction if the tile is not filled. diff --git a/examples/Utils.hs b/examples/Utils.hs new file mode 100644 --- /dev/null +++ b/examples/Utils.hs @@ -0,0 +1,49 @@ +{- +License: + +This code is placed in the Public Domain. + +Author: + +Douglas Burke (dburke.gw@gmail.com) + +Aim: + +Utility routines for the examples. + +-} + +module Utils + ( checkForDebug + , maybeRead + , printVersion + ) where + +import Data.List (foldl') +import Data.Maybe (listToMaybe) +import Data.Version (showVersion) + +import System.Environment (getProgName) + +import Paths_mcpi (version) + +-- | Print, to @stdout@, the program name and version. +printVersion :: IO () +printVersion = do + pName <- getProgName + putStrLn (pName ++ " - version " ++ showVersion version) + +-- | Does the argument list contain the option @--debug@? +-- If so, remove it. +-- +checkForDebug :: [String] -> (Bool, [String]) +checkForDebug inArgs = + let f (flag,args) arg + | arg == "--debug" = (True, args) + | otherwise = (flag, arg:args) + in foldl' f (False, []) (reverse inArgs) + +-- | Convert a string, with the option of failure. +maybeRead :: Read a => String -> Maybe a +maybeRead = fmap fst . listToMaybe . reads + diff --git a/examples/XJump.hs b/examples/XJump.hs --- a/examples/XJump.hs +++ b/examples/XJump.hs @@ -1,26 +1,54 @@ {-# LANGUAGE RecordWildCards #-} +{- + +Usage: + + ./xjump [--debug] + +-} + module Main where -import Control.Monad (when) +import Control.Monad (when, unless) import Data.MineCraft.Pi.Block import Data.MineCraft.Pi.Player import Data.MineCraft.Pi.Other import Data.MineCraft.Pi.Types -import Network.MineCraft.Pi.Client +-- Most users would import @runMCPI@ from +-- "Network.MineCraft.Pi.Client", but I want to allow +-- debug messages. +import Network.MineCraft.Pi.Client.Internal (MCPI, runMCPI') +import System.Environment (getArgs, getProgName) +import System.Exit (exitFailure) +import System.IO + +import Utils (printVersion, checkForDebug) + -- | Move the player by 10 tiles in the X direction, -- if it is not filled. movePlayer :: MCPI () movePlayer = do - Pos {..} <- getPlayerTile - let newPos = Pos (_x+10) _y _z - bType <- getBlock newPos - when (bType == air) $ do - setPlayerTile newPos - chatPost "*jump*" + Pos {..} <- getPlayerTile + let newPos = Pos (_x+10) _y _z + bType <- getBlock newPos + when (bType == air) $ do + setPlayerTile newPos + chatPost "*jump*" +usage :: IO () +usage = do + pName <- getProgName + hPutStrLn stderr $ "Usage: " ++ pName ++ " [--debug]" + exitFailure + main :: IO () -main = runMCPI movePlayer +main = do + args <- getArgs + let (dbg, args') = checkForDebug args + unless (null args') usage + when dbg printVersion + runMCPI' dbg movePlayer diff --git a/mcpi.cabal b/mcpi.cabal --- a/mcpi.cabal +++ b/mcpi.cabal @@ -1,5 +1,5 @@ Name: mcpi -Version: 0.0.0.2 +Version: 0.0.0.3 Homepage: https://github.com/DougBurke/hmcpi Bug-Reports: https://github.com/DougBurke/hmcpi/issues Stability: experimental @@ -66,6 +66,9 @@ Main-Is: Flatten.hs Hs-Source-Dirs: examples/ + Other-Modules: Paths_mcpi + Utils + ghc-options: -Wall @@ -81,6 +84,9 @@ Main-Is: Freefall.hs Hs-Source-Dirs: examples/ + Other-Modules: Paths_mcpi + Utils + ghc-options: -Wall @@ -95,7 +101,9 @@ Main-Is: HMCPI.hs Hs-Source-Dirs: examples/ + Other-Modules: Paths_mcpi + Utils ghc-options: -Wall @@ -112,6 +120,9 @@ Main-Is: IsOnGold.hs Hs-Source-Dirs: examples/ + Other-Modules: Paths_mcpi + Utils + ghc-options: -Wall @@ -125,6 +136,9 @@ Main-Is: XJump.hs Hs-Source-Dirs: examples/ + + Other-Modules: Paths_mcpi + Utils ghc-options: -Wall diff --git a/src/Data/MineCraft/Pi/Other.hs b/src/Data/MineCraft/Pi/Other.hs --- a/src/Data/MineCraft/Pi/Other.hs +++ b/src/Data/MineCraft/Pi/Other.hs @@ -46,3 +46,20 @@ getHeight :: IPos -> MCPI Int getHeight Pos {..} = fromMC `liftM` query "world.getHeight" [toMC _x, toMC _y] +{- + +TODO: + +world.checkpoint.save() +world.checkpoint.restore() + +world.setting(KEY,0/1) + +world.getPlayerIds() + +events.clear() +events.block.hits() --> pos,surface,entityId|pos,surface,entityId|... + (pos is x,y,z surface is x,y,z, entityId is int) + +-} + diff --git a/src/Network/MineCraft/Pi/Client/Internal.hs b/src/Network/MineCraft/Pi/Client/Internal.hs --- a/src/Network/MineCraft/Pi/Client/Internal.hs +++ b/src/Network/MineCraft/Pi/Client/Internal.hs @@ -42,6 +42,9 @@ -- | Represent a program that communicates with a MineCraft PI -- server. -- +-- /TODO:/ run a computation without automatically opening +-- and closing the handle. +-- type MCPI = ReaderT ConnInfo IO -- | Connection information. @@ -63,13 +66,16 @@ -- | Open a connection to the Minecraft server or call -- exitFailure, after displaying an error message to @stderr@. -- +-- /TODO:/ Change the retun value to @Maybe ConnInfo@ and +-- make this public. 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 + 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 @@ -82,14 +88,18 @@ return $ ConnInfo h flag -- | Close the connection. +-- +-- /TODO:/ Make this public. closeMCPI :: ConnInfo -> IO () closeMCPI = hClose . _ciHandle logMsg :: ConnInfo -> String -> String -> MCPI () logMsg ConnInfo {..} hdr msg = - when _ciDebug $ liftIO $ hPutStrLn stderr $ "*DBG*" ++ hdr ++ "*" ++ msg + when _ciDebug $ liftIO $ hPutStrLn stderr + $ "[" ++ hdr ++ replicate (8 - length hdr) ' ' ++ + "] " ++ msg --- It would be nice to do the argument marshalling here, i.e. have +-- It might 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. @@ -97,6 +107,28 @@ -- addArgs :: String -> [Argument] -> String addArgs a bs = a ++ "(" ++ intercalate "," bs ++ ")" + +{- +-- | Remove any output from the handle. A debug message is written +-- to let the user know this has happened, presumably because of +-- a previous invalid call. The previous call could be stored in +-- ConnInfo to make the message more useful, but leave that for now. +-- +flushChannel :: ConnInfo -> IO () +flushChannel ConnInfo {..} = do + +Hmm, do I need the socket as well as the handle? + + while True: + readable, _, _ = select.select([self.socket], [], [], 0.0) + if not readable: + break + data = self.socket.recv(1500) + e = "Drained Data: <%s>\n"%data.strip() + e += "Last Message: <%s>\n"%self.lastSent.strip() + sys.stderr.write(e) + +-} -- | Run a MineCraft command. command :: Command -> [Argument] -> MCPI ()