minecraft-data (empty) → 0.1.0.0
raw patch · 10 files changed
+1676/−0 lines, 10 filesdep +arraydep +basedep +bytestringsetup-changed
Dependencies added: array, base, bytestring, cereal, containers, lens, mtl, nbt, pipes, pipes-bytestring, pipes-cereal, pipes-parse, pipes-zlib, text, text-show, time, vector, zlib
Files
- LICENSE +30/−0
- Minecraft/Anvil.hs +276/−0
- Minecraft/Block.hs +333/−0
- Minecraft/Chunk.hs +134/−0
- Minecraft/Command.hs +40/−0
- Minecraft/Core.hs +428/−0
- Minecraft/Level.hs +219/−0
- Minecraft/Player.hs +168/−0
- Setup.hs +2/−0
- minecraft-data.cabal +46/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, jeremy@n-heptane.com++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of jeremy@n-heptane.com nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Minecraft/Anvil.hs view
@@ -0,0 +1,276 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Minecraft.Anvil where++import Control.Monad (when, replicateM)+import Control.Monad.State.Strict (execStateT, modify')+import Codec.Compression.Zlib (decompress, compress)+import Data.Bits (shiftR, shiftL, (.&.), (.|.))+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB+import Data.Data (Data, Typeable)+import Data.List (mapAccumL)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.NBT (NBT)+import Data.Serialize (Serialize(..), Get, Put, decodeLazy, encodeLazy, getLazyByteString, getWord8, getWord32be, putLazyByteString, putWord8, putWord32be)+import Data.Time.Clock.POSIX (POSIXTime)+import Data.Vector (Vector)+import qualified Data.Vector as Vector+import Data.Word (Word8, Word32)+import GHC.Generics+import Pipes.ByteString (fromHandle, toHandle)+import Pipes.Cereal (decodeGet, encodePut)+import Pipes.Parse (runStateT)+import Pipes (Pipe, runEffect, (>->), await, each, yield)+import System.IO (Handle, hSeek, SeekMode(AbsoluteSeek))++{-+regionX :: Double -- ^ chunkX+ -> Int+regionX x = floor (x / 32.0)++regionY :: Double -- ^ chunkY+ -> Int+regionY y = foor (y / 32.0)+-}++type ChunkX = Int+type ChunkZ = Int+type RegionX = Int+type RegionZ = Int++type ChunkMap = Map (ChunkX, ChunkZ) (ChunkData, POSIXTime)++regionX :: ChunkX+ -> RegionX+regionX x = x `shiftR` 5++regionZ :: ChunkZ+ -> RegionZ+regionZ z = z `shiftR` 5++chunkIndex :: (ChunkX, ChunkZ)+ -> Int+chunkIndex (x, z) = (x `pmod` 32) + ((z `pmod` 32) * 32)+ where+ pmod n m =+ let n' = n `mod` m+ in if (n' >= 0)+ then n'+ else n' + m++type Word24 = Word32++-- | ChunkLocation+--+-- ChunkLocation 0 0 means chunk is not present in the file+data ChunkLocation = ChunkLocation+ { chunkOffset :: Word24 -- ^ number of 4KiB sectors from start of file+ , chunkLength :: Word8 -- ^ length of chunk -- units are 4KiB sectors, rounded up+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++-- | ChunkLocation 0 0 means chunk is not present in the file+emptyChunkLocation :: ChunkLocation+emptyChunkLocation = ChunkLocation 0 0++putChunkLocation :: ChunkLocation -> Put+putChunkLocation (ChunkLocation offset len) =+ do putWord8 (fromIntegral ((offset `shiftR` 16) .&. 0xFF))+ putWord8 (fromIntegral ((offset `shiftR` 8) .&. 0xFF))+ putWord8 (fromIntegral (offset .&. 0xFF))+ putWord8 len++getChunkLocation :: Get ChunkLocation+getChunkLocation =+ do b2 <- fromIntegral <$> getWord8+ b1 <- fromIntegral <$> getWord8+ b0 <- fromIntegral <$> getWord8+ len <- fromIntegral <$> getWord8+ pure (ChunkLocation ((b2 `shiftL` 16) .|. (b1 `shiftL` 8) .|. b0) len)++instance Serialize ChunkLocation where+ put = putChunkLocation+ get = getChunkLocation++data AnvilHeader = AnvilHeader+ { locations :: Vector ChunkLocation+ , timestamps :: Vector POSIXTime+ }+ deriving (Eq, Ord, Show, Data, Typeable, Generic)++showAnvilHeader :: AnvilHeader -> String+showAnvilHeader ah = show $ AnvilHeader { locations = Vector.filter (/= emptyChunkLocation) (locations ah)+ , timestamps = Vector.filter (/= 0) (timestamps ah)+ }++-- guessing on the timestamp format a bit+putTimestamp :: POSIXTime -> Put+putTimestamp t = putWord32be (round t)++getTimestamp :: Get POSIXTime+getTimestamp =+ do l <- getWord32be+ pure $ (realToFrac l)++putAnvilHeader :: AnvilHeader -> Put+putAnvilHeader (AnvilHeader locations timestamps)+ | (Vector.length locations /= 1024) || (Vector.length timestamps /= 1024) =+ error "putAnvilHeader: locations and timestamps fields must be exactly 1024 entries long."+ | otherwise =+ do mapM_ putChunkLocation (Vector.toList locations)+ mapM_ putTimestamp (Vector.toList timestamps)++getAnvilHeader :: Get AnvilHeader+getAnvilHeader =+ do locations <- replicateM 1024 getChunkLocation+ timestamps <- replicateM 1024 getTimestamp+ pure $ AnvilHeader (Vector.fromList locations) (Vector.fromList timestamps)++instance Serialize AnvilHeader where+ put = putAnvilHeader+ get = getAnvilHeader++emptyAnvilHeader :: AnvilHeader+emptyAnvilHeader =+ AnvilHeader { locations = Vector.replicate 1024 emptyChunkLocation+ , timestamps = Vector.replicate 1024 0+ }++-- | make an 'AnvilHeader'+--+-- assumes the chunks will be written in the same order as they appear in the list+mkAnvilHeader :: [((ChunkX, ChunkZ), (ChunkData, POSIXTime))]+ -> AnvilHeader+mkAnvilHeader chunks =+ let timestamps' = map (\(i, (_, t)) -> (chunkIndex i, t)) chunks+ locations' = snd $ mapAccumL mkLocation 0x2 chunks -- ^ first chunk is at sector 0x2, after the AnvilHeader+ in AnvilHeader { locations = (locations emptyAnvilHeader) Vector.// locations'+ , timestamps = (timestamps emptyAnvilHeader) Vector.// timestamps'+ }+ where+ mkLocation :: Word24 -> ((ChunkX, ChunkZ), (ChunkData, POSIXTime)) -> (Word24, (Int, ChunkLocation))+ mkLocation offset (chunkPos, (chunkData, _)) =+ let paddedSectorLength = ((chunkDataLength chunkData) + 4 + 4095) `div` 4096+ offset' = offset + paddedSectorLength+ in (offset', (chunkIndex chunkPos, ChunkLocation offset (fromIntegral paddedSectorLength)))++data CompressionType+ = GZip -- ^ unused in practice+ | Zlib+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++-- | ChunkData+--+-- Compressed chunk data+data ChunkData = ChunkData+ { chunkDataLength :: Word32 -- ^ length of chunkData + 1+ , chunkDataCompression :: CompressionType -- ^ compression type+ , chunkData :: ByteString -- ^ compressed data (length - 1)+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++putChunkData :: ChunkData -> Put+putChunkData cd =+ do putWord32be (chunkDataLength cd)+ case chunkDataCompression cd of+ GZip -> putWord8 1+ Zlib -> putWord8 2+ putLazyByteString (chunkData cd)++getChunkData :: Get ChunkData+getChunkData =+ do len <- getWord32be+ comp <- do w <- getWord8+ case w of+ 1 -> pure GZip+ 2 -> pure Zlib+ _ -> error $ "Unknown compression code in getChunkData: " ++ show (len, w)+ bs <- getLazyByteString (fromIntegral (len - 1))+ pure $ ChunkData len comp bs++instance Serialize ChunkData where+ put = putChunkData+ get = getChunkData++-- | read 'ChunkData' from a Seekable 'Handle'+readChunkData :: Handle -> ChunkLocation -> IO (Maybe ChunkData)+readChunkData h chunkLocation+ | chunkLocation == emptyChunkLocation = pure Nothing+ | otherwise =+ do hSeek h AbsoluteSeek (fromIntegral $ ((chunkOffset chunkLocation) * 4096))+ (r, _) <- runStateT (decodeGet getChunkData) (fromHandle h)+ case r of+ (Left err) -> error err+ (Right cd) -> pure (Just cd)++-- | write 'ChunkData' to a Seekable 'Handle'+--+-- FIXME: chunks are supposed to be guaranteed less than 1MB+{-+writeChunkData :: Handle -> ChunkData -> IO ()+writeChunkData h chunkData =+ do runEffect $ (encodePut (putChunkData chunkData)) >-> (toHandle h)+ let padding = 4096 - ((chunkDataLength chunkData + 4) `mod` 4096)+ when (padding > 0) (B.hPutStr h (B.replicate (fromIntegral padding) 0))+-}++writeChunkData :: (Monad m) => Pipe ChunkData B.ByteString m ()+writeChunkData = do+ chunkData <- await+ encodePut (putChunkData chunkData)+ let padding = 4096 - ((chunkDataLength chunkData + 4) `mod` 4096)+ when (padding > 0) (yield (B.replicate (fromIntegral padding) 0))++{-++ do bytes <- execStateT (runEffect $ (encodePut (putChunkData chunkData)) >-> counter >-> (toHandle h)) 0+ pure bytes+ where+ counter =+ do bs <- await+ modify' $ \i -> i + B.length bs+ yield bs+-}+{-+readChunkData :: Handle -> ChunkLocation -> IO (Maybe ChunkData)+readChunkData h chunkLocation+ | chunkLocation == emptyChunkLocation = pure Nothing+ | otherwise =+ do hSeek h AbsoluteSeek (fromIntegral $ ((chunkOffset chunkLocation) * 4096))+ (r, _) <- runStateT (decodeGet getChunkData) (fromHandle h)+ case r of+ (Left err) -> error err+ (Right cd) -> pure (Just cd)+-}+decompressChunkData :: ChunkData -> Either String NBT+decompressChunkData cd+ | chunkDataCompression cd == Zlib =+ decodeLazy (decompress (chunkData cd))+ | otherwise = error $ "decompressChunkData not implemented for " ++ show (chunkDataCompression cd)++-- | NBT needs to be a Chunk+compressChunkData :: NBT -> ChunkData+compressChunkData nbt =+ let d = compress (encodeLazy nbt)+ in ChunkData { chunkDataLength = 1 + fromIntegral (LB.length d)+ , chunkDataCompression = Zlib+ , chunkData = d+ }++writeChunkMap :: Handle -> ChunkMap -> IO ()+writeChunkMap h chunkMap =+ do hSeek h AbsoluteSeek 0+ let chunks = Map.toAscList chunkMap+ runEffect $ (encodePut (putAnvilHeader (mkAnvilHeader chunks))) >-> (toHandle h)+ runEffect $ (each $ map (fst . snd) chunks) >-> writeChunkData >-> (toHandle h)+-- runEffect $ (encodePut (putAnvilHeader emptyAnvilHeader)) >-> (toHandle h)+ -- [(ChunkPos, ChunkData)] -> [(ChunkPos, Length)]+ -- chunks' <- mapM (\(chunkPos, (cd, modTime)) -> do i <- writeChunkData h cd ; pure (chunkPos, (i, modTime))) chunks+ pure ()
+ Minecraft/Block.hs view
@@ -0,0 +1,333 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+module Minecraft.Block where++import Data.Data+import GHC.Generics++data Wood+ = OakWood+ | SpruceWood+ | BirchWood+ | JungleWood+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic, Enum)++data WoodDirection+ = FacingUpDown+ | FacingEastWest+ | FacingNorthSouth+ | OnlyBark+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic, Enum)++data Wood2+ = AcaciaWood+ | DarkOakWood+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic, Enum)++data Leaves+ = OakLeaves+ | SpruceLeaves+ | BirchLeaves+ | JungleLeaves+ | OakLeavesNoDecay+ | SpruceLeavesNoDecay+ | BirchLeavesNoDecay+ | JungleLeavesNoDecay+ | OakLeavesCheckDecay+ | SpruceLeavesCheckDecay+ | BirchLeavesCheckDecay+ | JungleLeavesCheckDecay+ | OakLeavesNoDecayCheckDecay+ | SpruceLeavesNoDecayCheckDecay+ | BirchLeavesNoDecayCheckDecay+ | JungleLeavesNoDecayCheckDecay+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic, Enum)++data Leaves2+ = AcaciaLeaves+ | DarkOakLeaves+ | AcaciaLeavesNoDecay+ | DarkOakLeavesNoDecay+ | AcaciaLeavesCheckDecay+ | DarkOakLeavesCheckDecay+ | AcaciaLeavesNoDecayCheckDecay+ | DarkOakLeavesNoDecayCheckDecay+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic, Enum)++data Stone+ = Stone+ | Granite+ | PolishedGranite+ | Diorite+ | PolishedDiorite+ | Andesite+ | PolishedAndesite+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic, Enum)++data Dirt+ = Dirt+ | CoarseDirt+ | Podzol+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic, Enum)++data Block+ = Air+ | StoneBlock Stone+ | GrassBlock+ | DirtBlock Dirt+ | Cobblestone+ | WoodPlanks+ | Sapling+ | Bedrock+ | Water+ | StationaryWater+ | Lava+ | StationaryLava+ | Sand+ | Gravel+ | GoldOre+ | IronOre+ | CoalOre+ | Wood+ | Leaves+ | Sponge+ | Glass+ | LapisLazuliOre+ | LapisLazuliBlock+ | Dispenser+ | Sandstone+ | NoteBlock+ | Bed+ | PoweredRail+ | DetectorRail+ | StickyPiston+ | Cobweb+ | Grass+ | DeadBush+ | Piston+ | PistonHead+ | Wool+ | PistonExtension+ | Dandelion+ | Poppy+ | BrownMushroom+ | RedMushroom+ | BlockOfGold+ | BlockOfIron+ | DoubleStoneSlab+ | StoneSlab+ | Bricks+ | TNT+ | Bookshelf+ | MossStone+ | Obsidian+ | Torch+ | Fire+ | MonsterSpawner+ | OakWoodStairs+ | Chest+ | RedstoneWire+ | DiamondOre+ | BlockOfDiamond+ | CraftingTable+ | Wheat+ | Farmland+ | Furnace+ | BurningFurnace+ | StandingSign+ | OakDoor+ | Ladder+ | Rail+ | CobblestoneStairs+ | WallSign+ | Level+ | StonePresurePlate+ | IronDoor+ | WoodenPressurePlate+ | RedstoneOre+ | GlowingRedstoneOre+ | RedstoneTorchUnlit+ | RedstoneTorch+ | StoneButton+ | SnowLayer+ | Ice+ | Snow+ | Cactus+ | Clay+ | SugarCane+ | JukeBox+ | Fence+ | Pumpkin+ | Netherrack+ | SoulSand+ | Glowstone+ | NetherPortal+ | JackOLantern+ | Cake+ | RedstoneRepeaterUnpowered+ | RedstoneRepeaterPowered+ | StainedGlass+ | Trapdoor+ | MonsterEgg+ | StoneBricks+ | BrownMushroomBlock+ | RedMushroomBlock+ | IronBars+ | GlassPane+ | Melon+ | PumpkinStem+ | MelonStem+ | Vines+ | FenceGate+ | BrickStairs+ | StoneBrickStairs+ | Mycelium+ | LilyPad+ | NetherBrick+ | NetherBrickFence+ | NetherBrickStairs+ | NetherWart+ | EnchantmentTable+ | BrewingStand+ | Cauldron+ | EndPortal+ | EndPortalFrame+ | EndStone+ | DragonEgg+ | RedstoneLampUnlit+ | RedstoneLampLit+ | DoubleWoodenSlab+ | WoodenSlab+ | Cocoa+ | SandstoneStairs+ | EmeraldOre+ | EnderChest+ | TripwireHook+ | Tripwire+ | BlockOfEmerald+ | SpruceWoodStairs+ | BirchWoodStairs+ | JungleWoodStairs+ | CommandBlock+ | Beacon+ | CobblestoneWall+ | FlowerPot+ | Carrot+ | Potato+ | WoodenButton+ | ModHead+ | Anvil+ | TrappedChest+ | WeightedPressurePlateLight+ | WeightedPressurePlateHeavy+ | RedstoneComparator+ | RedstoneComparatorDeprecated+ | DaylightSensor+ | BlockOfRedstone+ | NetherQuartzOre+ | Hopper+ | BlockOfQuartz+ | QuartzStairs+ | ActivatorRails+ | Dropper+ | StainedClay+ | StainedGlassPane+ | Leaves2+ | Wood2+ | AcaciaWoodStairs+ | DarkOakWoodStairs+ | SlimeBlock+ | Barrier+ | IronTrapdoor+ | Prismarine+ | SeaLantern+ | HayBale+ | Carpet+ | HardenedClay+ | BlockOfCoal+ | PackedIce+ | LargeFlowers+ | StandingBarrier+ | WallBanner+ | InvertedDaylightSensor+ | RedSandstone+ | RedSandstoneStairs+ | DoubleRedSandstoneStairs+ | RedSandstoneSlab+ | SpruceFenceGate+ | BirchFenceGate+ | JungleFenceGate+ | DarkOakFenceGate+ | AcaciaFenceGate+ | SpruceFence+ | BirchFence+ | JungleFence+ | DarkOakFence+ | AcaciaFence+ | SpruceDoor+ | BirchDoor+ | JungleDoor+ | AcaciaDoor+ | DarkOakDoor+ | EndRod+ | ChorusPlant+ | ChorusFlower+ | PurpurBlock+ | PurpurPillar+ | PurpurStairs+ | PurpurDoubleSlab+ | PurpurSlab+ | EndStoneBricks+ | BeetrootSeeds+ | GrassPath+ | EndGateway+ | RepeatingCommandBlock+ | ChainCommandBlock+ | FrostedIce+ | Undefined213+ | Undefined214+ | Undefined215+ | Undefined216+ | Undefined217+ | Undefined218+ | Undefined219+ | Undefined220+ | Undefined221+ | Undefined222+ | Undefined223+ | Undefined224+ | Undefined225+ | Undefined226+ | Undefined227+ | Undefined228+ | Undefined229+ | Undefined230+ | Undefined231+ | Undefined232+ | Undefined233+ | Undefined234+ | Undefined235+ | Undefined236+ | Undefined237+ | Undefined238+ | Undefined239+ | Undefined240+ | Undefined241+ | Undefined242+ | Undefined243+ | Undefined244+ | Undefined245+ | Undefined246+ | Undefined247+ | Undefined248+ | Undefined249+ | Undefined250+ | Undefined251+ | Undefined252+ | Undefined253+ | Undefined254+ | StructureBlock+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)+++
+ Minecraft/Chunk.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Minecraft.Chunk where++import Control.Lens.TH (makeLenses)+import Data.Array.Unboxed (IArray, UArray, listArray, elems)+import Data.Data (Data)+import Data.Time.Clock.POSIX (POSIXTime)+import Data.Typeable (Typeable)+import Data.NBT+import Data.Int (Int8, Int32, Int64)+import Data.Text (Text)+import Data.Vector (Vector)+import qualified Data.Vector as Vector+import GHC.Generics (Generic)+import Minecraft.Core (BlockId(..), Difficulty(..), GameMode(..), ToNBT(..), ToNBTContents(..), XYZ(..), sunrise)++vectorArray :: (IArray UArray e) => Vector e -> UArray Int32 e+vectorArray v = listArray (0, fromIntegral ((Vector.length v) - 1)) (Vector.toList v)++data Section = Section+ { _Y :: Int8 -- ^ Y index (not coordinate) of this section. Range 0 - 15.+ , _Blocks :: Vector BlockId -- ^ 4096+ , _Add :: Maybe (Vector Int8) -- ^ 2048+ , _BlockData :: Vector Int8 -- ^ 2048+ , _BlockLight :: Vector Int8 -- ^ 2048+ , _SkyLight :: Vector Int8 -- ^ 2048+ }+ deriving (Eq, Ord, Show, Typeable, Generic)+makeLenses ''Section++-- FIXME: add range checks+-- FIMXE: add 'Add' support+instance ToNBTContents Section where+ toNBTContents section =+ (CompoundTag+ [ NBT "Y" (ByteTag (_Y section))+ , NBT "Blocks" (ByteArrayTag (vectorArray (Vector.map _unBlockId (_Blocks section))))+ , NBT "Data" (ByteArrayTag (vectorArray (_BlockData section)))+-- , NBT "Add"+ , NBT "BlockLight" (ByteArrayTag (vectorArray (_BlockLight section)))+ , NBT "SkyLight" (ByteArrayTag (vectorArray (_SkyLight section)))+ ])++emptySection :: Section+emptySection = Section+ { _Y = 0+ , _Blocks = Vector.replicate 4096 (BlockId 0)+ , _Add = Nothing+ , _BlockData = Vector.replicate 2048 0+ , _BlockLight = Vector.replicate 2048 0+ , _SkyLight = Vector.replicate 2048 0+ }++-- FIXME+data EntityData = EntityData+ {+ }+ deriving (Eq, Ord, Show, Typeable, Generic)+makeLenses ''EntityData++-- FIXME+data BlockEntity = BlockEntity+ {+ }+ deriving (Eq, Ord, Show, Typeable, Generic)+makeLenses ''BlockEntity++-- FIXME+data TileTick = TileTick+ {+ }+ deriving (Eq, Ord, Show, Typeable, Generic)+makeLenses ''TileTick++data Chunk = Chunk+ { _xPos :: Int32+ , _zPos :: Int32+ , _LastUpdate :: POSIXTime+ , _LightPopulated :: Bool+ , _TerrainPopulated :: Bool+ , _V :: Int8+ , _InhabitedTime :: Int64+ , _Biomes :: Vector Int8 -- UArray Int32 Int8+ , _HeightMap :: Vector Int32 -- UArray Int32 Int32+ , _Sections :: [Section]+ , _Entities :: [EntityData]+ , _TileEntities :: [BlockEntity]+ , _TileTicks :: [TileTick]+ }+ deriving (Eq, Ord, Show, Typeable, Generic)+makeLenses ''Chunk++emptyChunk :: Chunk+emptyChunk = Chunk+ { _xPos = 0+ , _zPos = 0+ , _LastUpdate = 0+ , _LightPopulated = False+ , _TerrainPopulated = True+ , _V = 1+ , _InhabitedTime = 0+ , _Biomes = Vector.replicate 256 (-1)+ , _HeightMap = Vector.replicate 1024 0+ , _Sections = []+ , _Entities = []+ , _TileEntities = []+ , _TileTicks = []+ }++instance ToNBTContents Chunk where+ toNBTContents chunk =+ (CompoundTag+ [ NBT "xPos" (IntTag (_xPos chunk))+ , NBT "zPos" (IntTag (_zPos chunk))+ , NBT "LastUpdate" (toNBTContents (_LastUpdate chunk))+ , NBT "LightPopulated" (toNBTContents (_LightPopulated chunk))+ , NBT "TerrainPopulated" (toNBTContents (_TerrainPopulated chunk)) -- ^ FIXME: should be not-present for False+ , NBT "V" (ByteTag (_V chunk))+ , NBT "InhabitedTime" (LongTag (_InhabitedTime chunk))+ , NBT "Biomes" (ByteArrayTag (vectorArray (_Biomes chunk)))+ , NBT "HeightMap" (IntArrayTag (vectorArray (_HeightMap chunk)))+ , NBT "Sections" (ListTag (listArray (0, fromIntegral (length (_Sections chunk) - 1)) (map toNBTContents (_Sections chunk))))+ ])++instance ToNBT Chunk where+ toNBT chunk =+ (NBT "" (CompoundTag [ NBT "Level" (toNBTContents chunk) ]))+
+ Minecraft/Command.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+module Minecraft.Command where++import Data.Data (Data)+import Data.Typeable (Typeable)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Monoid ((<>), mconcat, mempty)+import Data.NBT+import Data.Word (Word, Word8)+import Data.Text (Text)+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as B+import GHC.Generics+import Minecraft.Core+import TextShow (showb)++data Command+ = Give Target Item (Maybe Int6) (Maybe Int64) (Maybe NBT)+ deriving (Eq, Show)++(<+>) :: Builder -> Builder -> Builder+a <+> b = a <> B.singleton ' ' <> b++(<?>) :: (Render b) => Builder -> Maybe b -> Builder+a <?> Nothing = a+a <?> (Just b) = a <+> (render b)++instance Render NBT where+ render nbt = error "Render NBT not implemented."++instance Render Command where+ render command =+ case command of+ (Give target item Nothing Nothing Nothing) ->+ "give" <+> render target <+> showb item+ (Give target item mAmount mData mDataTag) ->+ "give" <+> render target <+> showb item <+> (maybe "1" render mAmount) <+> (maybe "0" render mData) <?> mDataTag+
+ Minecraft/Core.hs view
@@ -0,0 +1,428 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Minecraft.Core where++import Control.Lens.TH (makeLenses)+import qualified Data.Array as Array+import Data.Data+import Data.List (intersperse)+import Data.Maybe (maybe, fromMaybe)+import Data.Monoid ((<>), mconcat, mempty)+import Data.NBT+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Time.Clock.POSIX (POSIXTime)+import Data.Word (Word, Word8)+import Data.Text (Text)+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as B+import GHC.Generics+import TextShow++type Int6 = Int8++class Render a where+ render :: a -> Builder++instance Render a => Render (Maybe a) where+ render Nothing = mempty+ render (Just a) = render a++instance Render Int6 where+ render i = B.fromString (show i)++instance Render Int64 where+ render i = B.fromString (show i)++class ToNBT a where+ toNBT :: a -> NBT++class ToNBTContents a where+ toNBTContents :: a -> NbtContents++instance ToNBTContents Bool where+ toNBTContents False = ByteTag 0+ toNBTContents True = ByteTag 1++instance ToNBTContents Int8 where+ toNBTContents i = ByteTag i++instance ToNBTContents Int16 where+ toNBTContents i = ShortTag i++instance ToNBTContents Int32 where+ toNBTContents i = IntTag i++instance ToNBTContents Int64 where+ toNBTContents i = LongTag i++instance ToNBTContents Float where+ toNBTContents f = FloatTag f++instance ToNBTContents Double where+ toNBTContents d = DoubleTag d++instance ToNBTContents Text where+ toNBTContents t = StringTag t++instance ToNBTContents POSIXTime where+ toNBTContents t = LongTag (round (t * 1000))++instance ToNBTContents a => ToNBTContents [a] where+ toNBTContents l = ListTag (Array.listArray (0, (fromIntegral $ length l) - 1) (map toNBTContents l))++instance ToNBTContents [NbtContents] where+ toNBTContents l = ListTag (Array.listArray (0, (fromIntegral $ length l) - 1) l)++data Coordinate+ = Absolute Int+ | Relative Int+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++instance Render Coordinate where+ render (Absolute i) = B.fromString (show i)+ render (Relative 0) = B.singleton '~'+ render (Relative i) = B.singleton '~' <> B.fromString (show i)++data TargetVariable+ = NearestPlayer+ | RandomPlayer+ | AllPlayers+ | AllEntities+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++instance Render TargetVariable where+ render t =+ case t of+ NearestPlayer -> "@p"+ RandomPlayer -> "@r"+ AllPlayers -> "@a"+ AllEntities -> "@e"++type Name = Text++instance Render Text where+ render t = B.fromText t++data GameMode+ = AllModes+ | SurvivalMode+ | CreativeMode+ | AdventureMode+ | SpectatorMode+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++instance Render GameMode where+ render m =+ case m of+ AllModes -> "-1"+ SurvivalMode -> "0"+ CreativeMode -> "1"+ AdventureMode -> "2"+ SpectatorMode -> "3"++instance ToNBTContents GameMode where+ toNBTContents gm =+ IntTag $ case gm of+ AllModes -> (-1)+ SurvivalMode -> 0+ CreativeMode -> 1+ AdventureMode -> 2+ SpectatorMode -> 3+++newtype BlockId = BlockId { _unBlockId:: Int8 }+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)+makeLenses ''BlockId++newtype EntityId = EntityId { unEntityId:: Int8 }+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++data Entity+ -- Drops+ = Item+ | XPOrb+ -- Immobile+ | LeashKnot+ | Painting+ | ItemFrame+ | ArmorStand+ | EnderCrystal+ -- Projectiles+ | ThrownEgg+ | Arrow+ | Snowball+ | Fireball+ | SmallFireball+ | ThrownEnderpearl+ | EyeOfEnderSignal+ | ThrownPotion+ | ThrownExpBottle+ | WitherSkull+ | FireworksRocketEntity+ -- Blocks+ | PrimedTnt+ | FailingSand+ -- Vehicles+ | MinecartCommandBlock+ | Boat+ | MinecartRideable+ | MinecartChest+ | MinecartFurnace+ | MinecartTNT+ | MinecartHopper+ | MinecartSpawner+ -- Generic+ | Mob+ | Monster+ -- Hostile Mobs+ | Creeper+ | Skeleton+ | Spider+ | Giant+ | Zombie+ | Slime+ | Ghast+ | PigZombie+ | Enderman+ | CaveSpider+ | Silverfish+ | Blaze+ | LavaSlime+ | EnderDragon+ | WitherBoss+ | Witch+ | Endermite+ | Guardian+ | Shulker+-- | KillerRabbit -- ?+ -- Passive Mobs+ | Bat+ | Pig+ | Sheep+ | Cow+ | Chicken+ | Squid+ | Wolf+ | MooshroomCow+ | SnowMan+ | Ozelot+ | VillagerGolem+ | EntityHorse+ | Rabbit+ -- NPCs+ | Villager+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++toEntityId :: Entity -> EntityId+toEntityId entity =+ case entity of+ Item -> EntityId 1+ Creeper -> EntityId 50++instance Render EntityId where+ render (EntityId n) = B.fromString (show n)++instance Render Entity where+ render e =+ case e of+ Item -> "Item"+ XPOrb -> "XPOrb"+ LeashKnot -> "LeashKnot"+ Painting -> "Painting"+ ItemFrame -> "ItemFrame"+ ArmorStand -> "ArmorStand"+ EnderCrystal -> "EnderCrystal"+ -- Projectiles+ ThrownEgg -> "ThrownEgg"+ Arrow -> "Arrow"+ Snowball -> "Snowball"+ Fireball -> "Fireball"+ SmallFireball -> "SmallFireball"+ ThrownEnderpearl -> "ThrownEnderpearl"+ EyeOfEnderSignal -> "EyeOfEnderSignal"+ ThrownPotion -> "ThrownPotion"+ ThrownExpBottle -> "ThrownExpBottle"+ WitherSkull -> "WitherSkull"+ FireworksRocketEntity -> "FireworksRocketEntity"+ -- Blocks+ PrimedTnt -> "PrimedTnt"+ FailingSand -> "FailingSand"+ -- Vehicles+ MinecartCommandBlock -> "MinecartCommandBlock"+ Boat -> "Boat"+ MinecartRideable -> "MinecartRideable"+ MinecartChest -> "MinecartChest"+ MinecartFurnace -> "MinecartFurnace"+ MinecartTNT -> "MinecartTNT"+ MinecartHopper -> "MinecartHopper"+ MinecartSpawner -> "MinecartSpawner"+ -- Generic+ Mob -> "Mob"+ Monster -> "Monster"+ -- Hostile Mobs+ Creeper -> "Creeper"+ Skeleton -> "Skeleton"+ Spider -> "Spider"+ Giant -> "Giant"+ Zombie -> "Zombie"+ Slime -> "Slime"+ Ghast -> "Ghast"+ PigZombie -> "PigZombie"+ Enderman -> "Enderman"+ CaveSpider -> "CaveSpider"+ Silverfish -> "Silverfish"+ Blaze -> "Blaze"+ LavaSlime -> "LavaSlime"+ EnderDragon -> "EnderDragon"+ WitherBoss -> "WitherBoss"+ Witch -> "Witch"+ Endermite -> "Endermite"+ Guardian -> "Guardian"+ Shulker -> "Shulker"+-- Rabbit -> "Rabbit"+ -- Passive Mobs+ Bat -> "Bat"+ Pig -> "Pig"+ Sheep -> "Sheep"+ Cow -> "Cow"+ Chicken -> "Chicken"+ Squid -> "Squid"+ Wolf -> "Wolf"+ MooshroomCow -> "MooshroomCow"+ SnowMan -> "SnowMan"+ Ozelot -> "Ozelot"+ VillagerGolem -> "VillagerGolem"+ EntityHorse -> "EntityHorse"+ Rabbit -> "Rabbit"+ -- NPCs+ Villager -> "Villager"++data Op+ = Equal+ | NotEqual+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++instance Render Op where+ render op =+ case op of+ Equal -> "="+ NotEqual -> "=!"++data TargetArgument+ = TargetX Coordinate+ | TargetY Coordinate+ | TargetZ Coordinate+ | RadiusMax Coordinate+ | RadiusMin Coordinate+ | GameMode GameMode+ | Count Int+ | XpLevelMax Word+ | XpLevelMin Word+ | ScoreMax Name Word+ | ScoreMin Name Word+ | Team Op Name+ | Name Op Name+ | Dx Coordinate+ | Dy Coordinate+ | Dz Coordinate+ | RxMax Double+ | RxMin Double+ | RyMax Double+ | RyMin Double+ | Type Op Entity+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++instance Render TargetArgument where+ render arg =+ case arg of+ (Count n) -> "count="<>B.fromString (show n)+ (Type op entity) -> "type" <> render op <> render entity++data TargetSelector = TargetSelector TargetVariable [TargetArgument]+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++instance Render TargetSelector where+ render (TargetSelector var []) =+ render var+ render (TargetSelector var args) =+ render var <> B.singleton '[' <> mconcat (intersperse (B.singleton ',') $ map render args) <> B.singleton ']'++data Target+ = Player Name+ | TS TargetSelector+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++instance Render Target where+ render (Player name) = render name+ render (TS ts) = render ts++data Item+ = IronShovel+ | IronPickaxe+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)+{-+instance Render Item where+ render item =+ case item of+ IronShovel -> "minecraft:iron_shovel"+ IronPickaxe -> "minecraft:iron_pickaxe"+-}+instance TextShow Item where+ showb item =+ case item of+ IronShovel -> "minecraft:iron_shovel"+ IronPickaxe -> "minecraft:iron_pickaxe"++data Difficulty+ = Peaceful+ | Easy+ | Normal+ | Hard+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++instance ToNBTContents Difficulty where+ toNBTContents difficulty =+ ByteTag $ case difficulty of+ Peaceful -> 0+ Easy -> 1+ Normal -> 2+ Hard -> 3++-- | time of day values+sunrise, midday, sunset, midnight, nextday :: Int64+sunrise = 0+midday = 6000+sunset = 12000+midnight = 18000+nextday = 24000++data Dimension+ = Nether+ | Overworld+ | End+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++instance ToNBTContents Dimension where+ toNBTContents dimension =+ IntTag $ case dimension of+ Nether -> (-1)+ Overworld -> 0+ End -> 1++data XYZ = XYZ+ { _x :: Int32+ , _y :: Int32+ , _z :: Int32+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)+makeLenses ''XYZ++data Attribute = Attribute+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++instance ToNBTContents Attribute where+ toNBTContents = error "ToNBTContent Attribute not implemented."
+ Minecraft/Level.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+module Minecraft.Level where++import Control.Lens.TH (makeLenses)+import Data.Data (Data)+import Data.Time.Clock.POSIX (POSIXTime)+import Data.Typeable (Typeable)+import Data.NBT+import Data.Int (Int32, Int64)+import Data.Text (Text)+import GHC.Generics (Generic)+import Minecraft.Core (Difficulty(..), GameMode(..), ToNBT(..), ToNBTContents(..), XYZ(..), sunrise)+import Minecraft.Player (Player(..), defaultPlayer)++data GeneratorName+ = Default+ | Flat+ | LargeBiomes+ | Amplified+ | Customized+ | DebugAllBlockStates+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++instance ToNBTContents GeneratorName where+ toNBTContents generatorName =+ StringTag $ case generatorName of+ Default -> "default"+ Flat -> "flat"+ LargeBiomes -> "largeBiomes"+ Amplified -> "amplified"+ Customized -> "customized"+ DebugAllBlockStates -> "debug_all_block_states"++data GameRules = GameRules+ { _commandBlockOutput :: Bool -- ^ True+ , _doDaylightCycle :: Bool -- ^ True+ , _doFireTick :: Bool -- ^ True+ , _doMobLoot :: Bool -- ^ True+ , _doMobSpawning :: Bool -- ^ True+ , _doTileDrops :: Bool -- ^ True+ , _keepInventory :: Bool -- ^ False+ , _logAdminCommands :: Bool -- ^ True+ , _mobGriefing :: Bool -- ^ True+ , _naturalRegeneration :: Bool -- ^ True+ , _randomTickSpeed :: Int32 -- ^ 3+ , _sendCommandFeedback :: Bool -- ^ True+ , _showDeathMessages :: Bool -- ^ True+ , _reducedDebugInfo :: Bool -- ^ False+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++defaultGameRules :: GameRules+defaultGameRules = GameRules+ { _commandBlockOutput = True+ , _doDaylightCycle = True+ , _doFireTick = True+ , _doMobLoot = True+ , _doMobSpawning = True+ , _doTileDrops = True+ , _keepInventory = False+ , _logAdminCommands = True+ , _mobGriefing = True+ , _naturalRegeneration = True+ , _randomTickSpeed = 3+ , _sendCommandFeedback = True+ , _showDeathMessages = True+ , _reducedDebugInfo = False+ }++instance ToNBTContents GameRules where+ toNBTContents gameRules =+ CompoundTag+ [ NBT "commandBlockOutput" (boolString $ _commandBlockOutput gameRules)+ , NBT "doDaylightCycle" (boolString $ _doDaylightCycle gameRules)+ , NBT "doFireTick" (boolString $ _doFireTick gameRules)+ , NBT "doMobLoot" (boolString $ _doMobLoot gameRules)+ , NBT "doMobSpawning" (boolString $ _doMobSpawning gameRules)+ , NBT "doTileDrops" (boolString $ _doTileDrops gameRules)+ , NBT "keepInventory" (boolString $ _keepInventory gameRules)+ , NBT "logAdminCommands" (boolString $ _logAdminCommands gameRules)+ , NBT "mobGriefing" (boolString $ _mobGriefing gameRules)+ , NBT "naturalRegeneration" (boolString $ _naturalRegeneration gameRules)+ , NBT "randomTickSpeed" (toNBTContents $ _randomTickSpeed gameRules)+ , NBT "sendCommandFeedback" (boolString $ _sendCommandFeedback gameRules)+ , NBT "showDeathMessages" (boolString $ _showDeathMessages gameRules)+ , NBT "reducedDebugInfo" (boolString $ _reducedDebugInfo gameRules)+ ]+ where+ boolString False = StringTag "false"+ boolString True = StringTag "true"++instance ToNBT GameRules where+ toNBT gameRules = NBT "GameRules" (toNBTContents gameRules)++data Version = Version+ { _versionId :: Text+ , _versionName :: Text+ , _versionSnapshot :: Bool+ }++data Level = Level+ { _version :: Int32+ , _initialized :: Bool+ , _levelName :: Text+ , _generatorName :: GeneratorName+ , _generatorVersion :: Int32 -- ^ usually 0+ , _generatorOptions :: Text+ , _randomSeed :: Int64+ , _mapFeatures :: Bool+ , _lastPlayed :: POSIXTime+ , _sizeOnDisk :: Int64 -- ^ currently unused+ , _allowCommands :: Bool+ , _hardcore :: Bool+ , _gameType :: GameMode+ , _difficulty :: Difficulty -- ^ default Normal+ , _difficultyLocked :: Bool+ , _time :: Int64+ , _dayTime :: Int64+ , _spawn :: XYZ+ , _borderCenterX :: Double+ , _borderCenterZ :: Double+ , _borderSize :: Double -- ^ default 6.0e7+ , _borderSafeZone :: Double -- ^ default 5+ , _borderWarningBlocks :: Double -- ^ default 5+ , _borderWarningTime :: Double -- ^ default 15+ , _borderSizeLerpTarget :: Double -- ^ 6.0e7+ , _borderSizeLerpTime :: Int64 -- ^ default 0+ , _borderDamagePerBlock :: Double -- ^ default 0.2+ , _raining :: Bool+ , _rainTime :: Int32+ , _thundering :: Bool+ , _thunderTime :: Int32+ , _clearWeatherTime :: Int32+ , _player :: Player+ }++instance ToNBTContents Level where+ toNBTContents level = CompoundTag+ [ NBT "version" (toNBTContents (_version level))+ , NBT "initialized" (toNBTContents (_initialized level))+ , NBT "generatorName" (toNBTContents (_generatorName level))+ , NBT "generatorVersion" (toNBTContents (_generatorVersion level))+ , NBT "generatorOptions" (toNBTContents (_generatorOptions level))+ , NBT "RandomSeed" (toNBTContents (_randomSeed level))+ , NBT "MapFeatures" (toNBTContents (_mapFeatures level))+ , NBT "LastPlayed" (toNBTContents (_lastPlayed level))+ , NBT "SizeOnDisk" (toNBTContents (_sizeOnDisk level))+ , NBT "allowCommands" (toNBTContents (_allowCommands level))+ , NBT "hardcore" (toNBTContents (_hardcore level))+ , NBT "GameType" (toNBTContents (_gameType level))+ , NBT "Difficulty" (toNBTContents (_difficulty level))+ , NBT "DifficultyLocked" (toNBTContents (_difficultyLocked level))+ , NBT "Time" (toNBTContents (_time level))+ , NBT "DayTime" (toNBTContents (_dayTime level))+ , NBT "SpawnX" (toNBTContents (_x (_spawn level)))+ , NBT "SpawnY" (toNBTContents (_y (_spawn level)))+ , NBT "SpawnZ" (toNBTContents (_z (_spawn level)))+ , NBT "BorderCenterX" (toNBTContents (_borderCenterX level))+ , NBT "BorderCenterZ" (toNBTContents (_borderCenterZ level))+ , NBT "BorderSize" (toNBTContents (_borderSize level))+ , NBT "BorderSafeZone" (toNBTContents (_borderSafeZone level))+ , NBT "BorderWarningBlocks" (toNBTContents (_borderWarningBlocks level))+ , NBT "BorderSizeLerpTarget" (toNBTContents (_borderSizeLerpTarget level))+ , NBT "BorderSizeLerpTime" (toNBTContents (_borderSizeLerpTime level))+ , NBT "BorderDamagePerBlock" (toNBTContents (_borderDamagePerBlock level))+ , NBT "raining" (toNBTContents (_raining level))+ , NBT "rainTime" (toNBTContents (_rainTime level))+ , NBT "thundering" (toNBTContents (_thundering level))+ , NBT "thunderTime" (toNBTContents (_thunderTime level))+ , NBT "clearWeatherTime" (toNBTContents (_clearWeatherTime level))+ , NBT "Player" (toNBTContents (_player level))+ ]++instance ToNBT Level where+ toNBT level =+ NBT "" (CompoundTag [NBT "Data" (toNBTContents level)])+defaultLevel :: Text -- ^ level name+ -> Int64 -- ^ random seed+ -> Int32 -- ^ XpSeed+ -> Level+defaultLevel lvlName rSeed xpSeed = Level+ { _version = 19133+ , _initialized = True+ , _levelName = lvlName+ , _generatorName = Default+ , _generatorVersion = 0+ , _generatorOptions = ""+ , _randomSeed = rSeed+ , _mapFeatures = True+ , _lastPlayed = 0+ , _sizeOnDisk = 0+ , _allowCommands = False+ , _hardcore = False+ , _gameType = SurvivalMode+ , _difficulty = Normal+ , _difficultyLocked = True+ , _time = 0+ , _dayTime = sunrise+ , _spawn = XYZ 0 0 0+ , _borderCenterX = 0.0+ , _borderCenterZ = 0.0+ , _borderSize = 6.0e7+ , _borderSafeZone = 5.0+ , _borderWarningBlocks = 5.0+ , _borderWarningTime = 15.0+ , _borderSizeLerpTarget = 6.0e7+ , _borderSizeLerpTime = 0+ , _borderDamagePerBlock = 0.2+ , _raining = False+ , _rainTime = 0+ , _thundering = False+ , _thunderTime = 0+ , _clearWeatherTime = 0+ , _player = defaultPlayer xpSeed+ }
+ Minecraft/Player.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+module Minecraft.Player where++import Control.Lens.TH (makeLenses)+import Data.Data (Data)+import Data.Typeable (Typeable)+import Data.NBT+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Text (Text)+import GHC.Generics (Generic)+import Minecraft.Core (Attribute(..), Dimension(..), Int6, Item(..), GameMode(..), ToNBT(..), ToNBTContents(..), XYZ(..))+import TextShow (showt)++data Abilities = Abilities+ { _walkSpeed :: Float -- ^ 0.1+ , _flySpeed :: Float -- ^ 0.05+ , _mayFly :: Bool -- ^ true+ , _flying :: Bool -- ^ false+ , _invulnerable :: Bool -- ^ false+ , _mayBuild :: Bool -- ^ true+ , _instabuild :: Bool -- ^ false+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)+makeLenses ''Abilities++instance ToNBT Abilities where+ toNBT abilities =+ NBT "abilities" (toNBTContents abilities)++instance ToNBTContents Abilities where+ toNBTContents abilities =+ (CompoundTag+ [ NBT "walkSpeed" (FloatTag (_walkSpeed abilities))+ , NBT "flySpeed" (FloatTag (_flySpeed abilities))+ , NBT "mayfly" (toNBTContents (_mayFly abilities))+ , NBT "flying" (toNBTContents (_flying abilities))+ , NBT "invulnerable" (toNBTContents (_invulnerable abilities))+ , NBT "mayBuild" (toNBTContents (_mayBuild abilities))+ , NBT "instabuild" (toNBTContents (_instabuild abilities))+ ])++defaultAbilities :: Abilities+defaultAbilities = Abilities+ { _walkSpeed = 0.1+ , _flySpeed = 0.05+ , _mayFly = True+ , _flying = False+ , _invulnerable = False+ , _mayBuild = True+ , _instabuild = False+ }++data InventoryItem = InventoryItem+ { _slot :: Int6+ , _item :: Item+ , _count :: Int6+ , _damage :: Int16+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)+makeLenses ''InventoryItem++instance ToNBTContents InventoryItem where+ toNBTContents ii =+ CompoundTag [ NBT "Slot" (ByteTag (_slot ii))+ , NBT "id" (StringTag (showt (_item ii)))+ , NBT "Count" (ByteTag (_count ii))+ , NBT "Damage" (ShortTag (_damage ii))+ ]++data EnderItem = EnderItem+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)++instance ToNBTContents EnderItem where+ toNBTContents EnderItem = error "ToNBTContents EnterItem not implemented."++data Player = Player+ { _dimension :: Dimension+ , _playerGameType :: GameMode+ , _score :: Int32+ , _selectedItemSlot :: Int32+ , _playerSpawn :: Maybe XYZ+-- , _spawnForced :: Bool+ , _sleeping :: Bool+ , _sleepTimer :: Int16 -- ^ 0, no effect+ , _fire :: Int16 -- ^ -20+ , _foodLevel :: Int32 -- ^ 20 is full+ , _foodExhaustionLevel :: Float -- ^ 0+ , _foodSaturationLevel :: Float -- ^ 5+ , _foodTickTimer :: Int32 -- ^ 0+ , _xpLevel :: Int32 -- ^ 0+ , _xpP :: Float -- ^ 0+ , _xpTotal :: Int32 -- ^ 0+ , _xpSeed :: Int32+ , _inventory :: [InventoryItem]+ , _enderItems :: [EnderItem]+ , _abilities :: Abilities+ , _hurtByTimestamp :: Int32 -- ^ 0+ , _hurtTime :: Int16 -- ^ 0+ , _attributes :: [Attribute]+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)+makeLenses ''Player++instance ToNBT Player where+ toNBT player =+ NBT "Player" (toNBTContents player)++instance ToNBTContents Player where+ toNBTContents player = (CompoundTag+ ((case _playerSpawn player of+ Nothing -> []+ (Just (XYZ x y z)) ->+ [ NBT "SpawnX" (toNBTContents x)+ , NBT "SpawnY" (toNBTContents y)+ , NBT "SpawnZ" (toNBTContents z)+ ]) +++ [ NBT "Dimension" (toNBTContents (_dimension player))+ , NBT "GameType" (toNBTContents (_playerGameType player))+ , NBT "Score" (toNBTContents (_score player))+ , NBT "SelectedItemSlot" (toNBTContents (_selectedItemSlot player))+ , NBT "Sleeping" (toNBTContents (_sleeping player))+ , NBT "SleepTimer" (toNBTContents (_sleepTimer player))+ , NBT "Fire" (toNBTContents (_fire player))+ , NBT "foodLevel" (toNBTContents (_foodLevel player))+ , NBT "foodExhaustionLevel" (toNBTContents (_foodExhaustionLevel player))+ , NBT "foodSaturationLevel" (toNBTContents (_foodSaturationLevel player))+ , NBT "foodTickTimer" (toNBTContents (_foodTickTimer player))+ , NBT "XpLevel" (toNBTContents (_xpLevel player))+ , NBT "XpP" (toNBTContents (_xpP player))+ , NBT "XpTotal" (toNBTContents (_xpTotal player))+ , NBT "Inventory" (toNBTContents (_inventory player))+ , NBT "EnderItems" (toNBTContents (_enderItems player))+ , toNBT (_abilities player)+ , NBT "HurtByTimestamp" (toNBTContents (_hurtByTimestamp player))+ , NBT "HurtTime" (toNBTContents (_hurtTime player))+ , NBT "Attributes" (toNBTContents (_attributes player))+ ]))++defaultPlayer :: Int32 -- ^ XpSeed+ -> Player+defaultPlayer seed = Player+ { _dimension = Overworld+ , _playerGameType = SurvivalMode+ , _score = 0+ , _selectedItemSlot = 0+ , _playerSpawn = Nothing+ , _sleeping = False+ , _sleepTimer = 0+ , _fire = (-20)+ , _foodLevel = 20+ , _foodExhaustionLevel = 0+ , _foodSaturationLevel = 5+ , _foodTickTimer = 0+ , _xpLevel = 0+ , _xpP = 0+ , _xpTotal = 0+ , _xpSeed = seed+ , _inventory = []+ , _enderItems = []+ , _abilities = defaultAbilities+ , _hurtByTimestamp = 0+ , _hurtTime = 0+ , _attributes = []+ }
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ minecraft-data.cabal view
@@ -0,0 +1,46 @@+name: minecraft-data+version: 0.1.0.0+synopsis: a DSL for generating minecraft commands and levels+description: a DSL for generating minecraft commands and levels+homepage: https://github.com/stepcut/minecraft-data+license: BSD3+license-file: LICENSE+author: jeremy@n-heptane.com+maintainer: jeremy@n-heptane.com+category: Game, Minecraft+build-type: Simple+cabal-version: >=1.10+tested-with: GHC == 7.10.2, GHC==8.0.1++source-repository head+ type: git+ location: https://github.com/stepcut/minecraft-data.git++library+ exposed-modules: Minecraft.Anvil+ Minecraft.Block+ Minecraft.Chunk+ Minecraft.Core+ Minecraft.Command+ Minecraft.Player+ Minecraft.Level+ other-extensions: DeriveDataTypeable, DeriveGeneric, OverloadedStrings+ build-depends: array,+ base >=4.8 && <4.10,+ bytestring,+ containers,+ cereal,+ pipes-bytestring,+ pipes-cereal,+ pipes-parse,+ pipes-zlib,+ pipes,+ lens,+ mtl,+ nbt >= 0.6 && < 0.7,+ text >=1.2 && <1.3,+ text-show,+ time,+ vector,+ zlib+ default-language: Haskell2010