From fbaf4d9da45f714c32f410d3b5785fd06504325a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sat, 4 Jun 2016 18:06:36 +0200
Subject: archetypes & cleanup

---
 src/Main.hs | 20 ++++++++++++++++++--
 1 file changed, 18 insertions(+), 2 deletions(-)

(limited to 'src/Main.hs')

diff --git a/src/Main.hs b/src/Main.hs
index 8f955bb..9ea7a49 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -32,11 +32,14 @@ import Data.Function
 import Control.Monad.State.Strict
 
 import Sequence.Types
+import Sequence.Contact.Archetypes
 import Sequence.Utils
 import Sequence.Formula
 
 import Text.Layout.Table
 
+import Text.Read (readMaybe)
+
 main :: IO ()
 main = do
   historyFile <- getUserCacheFile "sequence" "history"
@@ -44,7 +47,7 @@ main = do
   let
     description = initialShellDescription
                   { historyFile = Just historyFile
-                  , prompt = \st -> return $ maybe "" (++ " ") ((evalState ?? st) . toName <$> view tip st) ++ "→ "
+                  , prompt = \st -> return $ maybe "" (++ " ") ((evalState ?? st) . toName <$> view gFocus st) ++ "→ "
                   , beforePrompt = gets stateOutline >>= (\str -> if null str then return () else shellPutStrLn str)
                   , commandStyle = OnlyCommands
                   , shellCommands = [ exitCommand "exit"
@@ -57,6 +60,8 @@ main = do
                                     , cmd "factions" listFactions "List all inhabited factions"
                                     , cmd "members" listFaction "List all members of a faction"
                                     , cmd "align" alignEntity "Align the focused entity to a faction – creating it, if necessary"
+                                    , cmd "name" nameEntity "Name the current entity overriding previous name assignments"
+                                    , cmd "spawn" spawnEntity "Create a new entity from an archetype focusing on it"
                                     ]
                   }
   void $ runShell description haskelineBackend (def :: GameState)
@@ -95,7 +100,7 @@ blur     = gFocus .= Nothing
 
 -- Manual focus
 setFocus :: Completable EntityIdentifier -> Sh GameState ()
-setFocus = withArg $ \ident -> gFocus .= Just ident
+setFocus = withArg $ \ident -> gFocus ?= ident
 
 -- Drop information
 remove :: Sh GameState ()
@@ -106,3 +111,14 @@ remove = withFocus $ \ident -> do
     gEntities %= Map.delete ident
     gEntityNames %= Bimap.delete ident
     blur
+
+-- Manage Entity
+spawnEntity :: Completable Entity -> Sh GameState ()
+spawnEntity = withArg $ \entity -> do
+  identifier <- use gNextId'
+  modify $ insertEntity entity
+  gFocus ?= identifier
+
+nameEntity :: String -> Sh GameState ()
+nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)"
+nameEntity name = withFocus $ \ident -> modifying gEntityNames $ Bimap.insert ident (name ^. entityName)
-- 
cgit v1.2.3