Command.hs

   1 -- This file is part of Intricacy
   2 -- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 module Command where
  12 import           GameStateTypes
  13 import           Hex
  14 import           Metagame
  15
  16 data Command
  17     = CmdDir WrHoSel HexDir | CmdRotate WrHoSel TorqueDir | CmdWait
  18     | CmdMoveTo HexPos | CmdManipulateToolAt HexPos
  19     | CmdDrag HexPos HexDir
  20     | CmdToggle
  21     | CmdOpen
  22     | CmdTile Tile | CmdPaint (Maybe Tile)
  23     | CmdPaintFromTo (Maybe Tile) HexPos HexPos
  24     | CmdSelect | CmdUnselect
  25     | CmdDelete | CmdMerge
  26     | CmdMark | CmdJumpMark | CmdReset
  27     | CmdPlay | CmdTest
  28     | CmdUndo | CmdRedo
  29     | CmdReplayForward Int | CmdReplayBack Int
  30     | CmdInputChar Char
  31     | CmdInputSelLock LockIndex
  32     | CmdInputCodename Codename
  33     | CmdInputSelUndecl Undeclared
  34     | CmdWriteState
  35     | CmdInitiation
  36     | CmdShowRetired | CmdPlayLockSpec (Maybe LockSpec)
  37     | CmdSetServer | CmdToggleCacheOnly
  38     | CmdSelCodename (Maybe Codename) | CmdBackCodename | CmdHome
  39     | CmdSolveInit (Maybe HexVec)
  40     | CmdSolve (Maybe LockIndex) | CmdDeclare (Maybe Undeclared)
  41     | CmdViewSolution (Maybe NoteInfo)
  42     | CmdSelectLock | CmdNextLock | CmdPrevLock
  43     | CmdEdit | CmdPlaceLock (Maybe LockIndex)
  44     | CmdRegister Bool | CmdAuth
  45     | CmdNextPage | CmdPrevPage
  46     | CmdToggleColourMode
  47     | CmdRedraw | CmdRefresh | CmdSuspend | CmdClear
  48     | CmdQuit | CmdForceQuit
  49     | CmdHelp | CmdBind (Maybe Command)
  50     | CmdNone
  51     deriving (Eq, Ord, Show, Read)
  52 data WrHoSel = WHSWrench | WHSHook | WHSSelected
  53     deriving (Eq, Ord, Show, Read)
  54
  55 describeCommand :: Command -> String
  56 describeCommand (CmdDir whs dir) = "move " ++ whsStr whs ++ " " ++ dirStr dir
  57 describeCommand (CmdRotate whs dir) = "rotate " ++ whsStr whs
  58         ++ " " ++ (if dir == 1 then "counter" else "") ++ "clockwise"
  59 describeCommand CmdWait = "nothing"
  60 describeCommand CmdToggle = "toggle tool"
  61 describeCommand CmdOpen = "open lock"
  62 describeCommand (CmdTile tile) = tileStr tile
  63 describeCommand CmdMerge = "merge with adjacent piece"
  64 describeCommand CmdMark = "mark state"
  65 describeCommand CmdJumpMark = "jump to marked state"
  66 describeCommand CmdReset = "jump to initial state"
  67 describeCommand CmdSelect = "select piece"
  68 describeCommand CmdUnselect = "unselect piece"
  69 describeCommand CmdDelete = "delete piece"
  70 describeCommand CmdPlay = "play lock"
  71 describeCommand CmdTest = "test lock"
  72 describeCommand CmdUndo = "undo"
  73 describeCommand CmdRedo = "redo"
  74 describeCommand (CmdReplayForward _) = "advance replay"
  75 describeCommand (CmdReplayBack _) = "rewind replay"
  76 describeCommand CmdWriteState = "write lock"
  77 describeCommand CmdInitiation = "revisit initiation"
  78 describeCommand CmdShowRetired = "toggle showing retired locks"
  79 describeCommand CmdSetServer = "set server"
  80 describeCommand CmdToggleCacheOnly = "toggle offline mode"
  81 describeCommand (CmdSelCodename mname) = "select player"
  82         ++ maybe "" (' ':) mname
  83 describeCommand CmdBackCodename = "select last player"
  84 describeCommand CmdHome = "select self"
  85 describeCommand (CmdSolveInit _) = "solve lock"
  86 describeCommand (CmdSolve mli) = "solve lock"
  87         ++ maybe "" ((' ':).(:"").lockIndexChar) mli
  88 describeCommand (CmdPlayLockSpec mls) = "find lock by number"
  89         ++ maybe "" ((' ':).show) mls
  90 describeCommand (CmdDeclare mundecl) = "declare solution"
  91         ++ maybe "" (const " [specified solution]") mundecl
  92 describeCommand (CmdViewSolution mnote) = "view lock solution"
  93         ++ maybe "" (const " [specified solution]") mnote
  94 describeCommand CmdSelectLock = "choose lock by name"
  95 describeCommand CmdNextLock = "next lock"
  96 describeCommand CmdPrevLock = "previous lock"
  97 describeCommand CmdNextPage = "page forward through lists"
  98 describeCommand CmdPrevPage = "page back through lists"
  99 describeCommand CmdEdit = "edit lock"
 100 describeCommand (CmdPlaceLock mli) = "place lock"
 101         ++ maybe "" ((' ':).(:"").lockIndexChar) mli
 102 describeCommand (CmdRegister False) = "register codename"
 103 describeCommand (CmdRegister True) = "adjust registration details"
 104 describeCommand CmdAuth = "authenticate"
 105 describeCommand (CmdBind _) = "bind key"
 106 describeCommand CmdToggleColourMode = "toggle lock colour mode"
 107 describeCommand CmdQuit = "quit"
 108 describeCommand CmdHelp = "help"
 109 describeCommand _ = ""
 110
 111 tileStr HookTile         = "hook"
 112 tileStr (WrenchTile _)   = "wrench"
 113 tileStr (ArmTile _ _)    = "arm"
 114 tileStr (PivotTile _)    = "pivot"
 115 tileStr (SpringTile _ _) = "spring"
 116 tileStr (BlockTile _)    = "block"
 117 tileStr BallTile         = "ball"
 118 whsStr WHSWrench   = "wrench"
 119 whsStr WHSHook     = "hook"
 120 whsStr WHSSelected = "tool"
 121 dirStr v
 122     | v == hu = "right"
 123     | v == neg hu = "left"
 124     | v == hv = "up-left"
 125     | v == neg hv = "down-right"
 126     | v == hw = "down-left"
 127     | v == neg hw = "up-right"
 128 dirStr _ = ""