initial commit

src/OneCommand/Generator.hs

@@ -0,0 +1,57 @@
+{-# 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)
+
+data CommandBlock = CommandBlock
+  { _commandBlockType :: CommandBlockType
+  , _command :: String
+  , _pos :: Pos
+  } deriving (Show)
+
+defaultCommandBlock :: CommandBlock
+defaultCommandBlock = CommandBlock Impulse "" defaultPos
+
+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
+
+makeLenses ''CommandBlock
+
+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