59 lines
2.0 KiB
Haskell
59 lines
2.0 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module OneCommand.Generator (commandBlockType, command, pos, generateCommandChainGroup, CommandBlockType(..), CommandBlock(..), defaultCommandBlock) where
|
|
|
|
import OneCommand.PosUtil
|
|
import OneCommand.Command (ChainType (..), CommandChain(..))
|
|
import Control.Lens
|
|
|
|
data CommandBlockType = Impulse | Chain | Repeating | Redstone deriving (Eq)
|
|
|
|
instance Show CommandBlockType where
|
|
show t = case t of
|
|
Impulse -> "command_block"
|
|
Chain -> "chain_command_block"
|
|
Repeating -> "repeating_command_block"
|
|
Redstone -> "redstone_block" -- quick-dirty
|
|
|
|
data CommandBlock = CommandBlock
|
|
{ _commandBlockType :: CommandBlockType
|
|
, _command :: String
|
|
, _pos :: Pos
|
|
} deriving (Show)
|
|
|
|
makeLenses ''CommandBlock
|
|
|
|
defaultCommandBlock :: CommandBlock
|
|
defaultCommandBlock = CommandBlock Impulse "" defaultPos
|
|
|
|
|
|
generateCommandChain :: ChainType -> [String] -> [CommandBlock]
|
|
generateCommandChain ct = zipWith genCommand [0..]
|
|
where
|
|
cmdChain = case ct of
|
|
ImpulseChain -> Impulse
|
|
RepeatingChain -> Repeating
|
|
cmdType i = if i == 0 then cmdChain else Chain
|
|
genCommand i c = defaultCommandBlock
|
|
& commandBlockType .~ cmdType i
|
|
& command .~ c
|
|
& pos . vec .~ Vec3i 0 0 (-i)
|
|
& pos . scope .~ CommandChainScope
|
|
|
|
redstoneBlock :: Vec3i -> CommandBlock
|
|
redstoneBlock p = defaultCommandBlock
|
|
& commandBlockType .~ Redstone
|
|
& command .~ ""
|
|
& pos . vec .~ p
|
|
& pos . scope .~ CommandChainScope
|
|
|
|
generateCommandChainGroup :: [CommandChain] -> [CommandBlock]
|
|
generateCommandChainGroup ccs = concat $ zipWith genGroup [0..] ccs
|
|
where
|
|
genCommands cc = generateCommandChain (chainType cc) (commands cc)
|
|
posMap i c = c & pos . scope .~ WholeStructureScope
|
|
& pos . vec %~ (\v -> v .+ Vec3i (2 + i * 2) (-2) 0)
|
|
red = redstoneBlock $ Vec3i 0 0 1
|
|
genGroup i cc = map (posMap i) $ red:genCommands cc
|