module Swarm.TUI.Model.Name where

data FocusablePanel
  = -- | The panel containing the REPL.
    REPLPanel
  | -- | The panel containing the world view.
    WorldPanel
  | -- | The panel showing robot info and inventory on the top left.
    RobotPanel
  | -- | The info panel on the bottom left.
    InfoPanel
  deriving (FocusablePanel -> FocusablePanel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FocusablePanel -> FocusablePanel -> Bool
$c/= :: FocusablePanel -> FocusablePanel -> Bool
== :: FocusablePanel -> FocusablePanel -> Bool
$c== :: FocusablePanel -> FocusablePanel -> Bool
Eq, Eq FocusablePanel
FocusablePanel -> FocusablePanel -> Bool
FocusablePanel -> FocusablePanel -> Ordering
FocusablePanel -> FocusablePanel -> FocusablePanel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FocusablePanel -> FocusablePanel -> FocusablePanel
$cmin :: FocusablePanel -> FocusablePanel -> FocusablePanel
max :: FocusablePanel -> FocusablePanel -> FocusablePanel
$cmax :: FocusablePanel -> FocusablePanel -> FocusablePanel
>= :: FocusablePanel -> FocusablePanel -> Bool
$c>= :: FocusablePanel -> FocusablePanel -> Bool
> :: FocusablePanel -> FocusablePanel -> Bool
$c> :: FocusablePanel -> FocusablePanel -> Bool
<= :: FocusablePanel -> FocusablePanel -> Bool
$c<= :: FocusablePanel -> FocusablePanel -> Bool
< :: FocusablePanel -> FocusablePanel -> Bool
$c< :: FocusablePanel -> FocusablePanel -> Bool
compare :: FocusablePanel -> FocusablePanel -> Ordering
$ccompare :: FocusablePanel -> FocusablePanel -> Ordering
Ord, Int -> FocusablePanel -> ShowS
[FocusablePanel] -> ShowS
FocusablePanel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FocusablePanel] -> ShowS
$cshowList :: [FocusablePanel] -> ShowS
show :: FocusablePanel -> String
$cshow :: FocusablePanel -> String
showsPrec :: Int -> FocusablePanel -> ShowS
$cshowsPrec :: Int -> FocusablePanel -> ShowS
Show, ReadPrec [FocusablePanel]
ReadPrec FocusablePanel
Int -> ReadS FocusablePanel
ReadS [FocusablePanel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FocusablePanel]
$creadListPrec :: ReadPrec [FocusablePanel]
readPrec :: ReadPrec FocusablePanel
$creadPrec :: ReadPrec FocusablePanel
readList :: ReadS [FocusablePanel]
$creadList :: ReadS [FocusablePanel]
readsPrec :: Int -> ReadS FocusablePanel
$creadsPrec :: Int -> ReadS FocusablePanel
Read, FocusablePanel
forall a. a -> a -> Bounded a
maxBound :: FocusablePanel
$cmaxBound :: FocusablePanel
minBound :: FocusablePanel
$cminBound :: FocusablePanel
Bounded, Int -> FocusablePanel
FocusablePanel -> Int
FocusablePanel -> [FocusablePanel]
FocusablePanel -> FocusablePanel
FocusablePanel -> FocusablePanel -> [FocusablePanel]
FocusablePanel
-> FocusablePanel -> FocusablePanel -> [FocusablePanel]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FocusablePanel
-> FocusablePanel -> FocusablePanel -> [FocusablePanel]
$cenumFromThenTo :: FocusablePanel
-> FocusablePanel -> FocusablePanel -> [FocusablePanel]
enumFromTo :: FocusablePanel -> FocusablePanel -> [FocusablePanel]
$cenumFromTo :: FocusablePanel -> FocusablePanel -> [FocusablePanel]
enumFromThen :: FocusablePanel -> FocusablePanel -> [FocusablePanel]
$cenumFromThen :: FocusablePanel -> FocusablePanel -> [FocusablePanel]
enumFrom :: FocusablePanel -> [FocusablePanel]
$cenumFrom :: FocusablePanel -> [FocusablePanel]
fromEnum :: FocusablePanel -> Int
$cfromEnum :: FocusablePanel -> Int
toEnum :: Int -> FocusablePanel
$ctoEnum :: Int -> FocusablePanel
pred :: FocusablePanel -> FocusablePanel
$cpred :: FocusablePanel -> FocusablePanel
succ :: FocusablePanel -> FocusablePanel
$csucc :: FocusablePanel -> FocusablePanel
Enum)

data GoalWidget
  = ObjectivesList
  | GoalSummary
  deriving (GoalWidget -> GoalWidget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GoalWidget -> GoalWidget -> Bool
$c/= :: GoalWidget -> GoalWidget -> Bool
== :: GoalWidget -> GoalWidget -> Bool
$c== :: GoalWidget -> GoalWidget -> Bool
Eq, Eq GoalWidget
GoalWidget -> GoalWidget -> Bool
GoalWidget -> GoalWidget -> Ordering
GoalWidget -> GoalWidget -> GoalWidget
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GoalWidget -> GoalWidget -> GoalWidget
$cmin :: GoalWidget -> GoalWidget -> GoalWidget
max :: GoalWidget -> GoalWidget -> GoalWidget
$cmax :: GoalWidget -> GoalWidget -> GoalWidget
>= :: GoalWidget -> GoalWidget -> Bool
$c>= :: GoalWidget -> GoalWidget -> Bool
> :: GoalWidget -> GoalWidget -> Bool
$c> :: GoalWidget -> GoalWidget -> Bool
<= :: GoalWidget -> GoalWidget -> Bool
$c<= :: GoalWidget -> GoalWidget -> Bool
< :: GoalWidget -> GoalWidget -> Bool
$c< :: GoalWidget -> GoalWidget -> Bool
compare :: GoalWidget -> GoalWidget -> Ordering
$ccompare :: GoalWidget -> GoalWidget -> Ordering
Ord, Int -> GoalWidget -> ShowS
[GoalWidget] -> ShowS
GoalWidget -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GoalWidget] -> ShowS
$cshowList :: [GoalWidget] -> ShowS
show :: GoalWidget -> String
$cshow :: GoalWidget -> String
showsPrec :: Int -> GoalWidget -> ShowS
$cshowsPrec :: Int -> GoalWidget -> ShowS
Show, ReadPrec [GoalWidget]
ReadPrec GoalWidget
Int -> ReadS GoalWidget
ReadS [GoalWidget]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GoalWidget]
$creadListPrec :: ReadPrec [GoalWidget]
readPrec :: ReadPrec GoalWidget
$creadPrec :: ReadPrec GoalWidget
readList :: ReadS [GoalWidget]
$creadList :: ReadS [GoalWidget]
readsPrec :: Int -> ReadS GoalWidget
$creadsPrec :: Int -> ReadS GoalWidget
Read, GoalWidget
forall a. a -> a -> Bounded a
maxBound :: GoalWidget
$cmaxBound :: GoalWidget
minBound :: GoalWidget
$cminBound :: GoalWidget
Bounded, Int -> GoalWidget
GoalWidget -> Int
GoalWidget -> [GoalWidget]
GoalWidget -> GoalWidget
GoalWidget -> GoalWidget -> [GoalWidget]
GoalWidget -> GoalWidget -> GoalWidget -> [GoalWidget]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GoalWidget -> GoalWidget -> GoalWidget -> [GoalWidget]
$cenumFromThenTo :: GoalWidget -> GoalWidget -> GoalWidget -> [GoalWidget]
enumFromTo :: GoalWidget -> GoalWidget -> [GoalWidget]
$cenumFromTo :: GoalWidget -> GoalWidget -> [GoalWidget]
enumFromThen :: GoalWidget -> GoalWidget -> [GoalWidget]
$cenumFromThen :: GoalWidget -> GoalWidget -> [GoalWidget]
enumFrom :: GoalWidget -> [GoalWidget]
$cenumFrom :: GoalWidget -> [GoalWidget]
fromEnum :: GoalWidget -> Int
$cfromEnum :: GoalWidget -> Int
toEnum :: Int -> GoalWidget
$ctoEnum :: Int -> GoalWidget
pred :: GoalWidget -> GoalWidget
$cpred :: GoalWidget -> GoalWidget
succ :: GoalWidget -> GoalWidget
$csucc :: GoalWidget -> GoalWidget
Enum)

-- | Clickable buttons in modal dialogs.
data Button
  = CancelButton
  | KeepPlayingButton
  | StartOverButton
  | QuitButton
  | NextButton
  deriving (Button -> Button -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Button -> Button -> Bool
$c/= :: Button -> Button -> Bool
== :: Button -> Button -> Bool
$c== :: Button -> Button -> Bool
Eq, Eq Button
Button -> Button -> Bool
Button -> Button -> Ordering
Button -> Button -> Button
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Button -> Button -> Button
$cmin :: Button -> Button -> Button
max :: Button -> Button -> Button
$cmax :: Button -> Button -> Button
>= :: Button -> Button -> Bool
$c>= :: Button -> Button -> Bool
> :: Button -> Button -> Bool
$c> :: Button -> Button -> Bool
<= :: Button -> Button -> Bool
$c<= :: Button -> Button -> Bool
< :: Button -> Button -> Bool
$c< :: Button -> Button -> Bool
compare :: Button -> Button -> Ordering
$ccompare :: Button -> Button -> Ordering
Ord, Int -> Button -> ShowS
[Button] -> ShowS
Button -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Button] -> ShowS
$cshowList :: [Button] -> ShowS
show :: Button -> String
$cshow :: Button -> String
showsPrec :: Int -> Button -> ShowS
$cshowsPrec :: Int -> Button -> ShowS
Show, ReadPrec [Button]
ReadPrec Button
Int -> ReadS Button
ReadS [Button]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Button]
$creadListPrec :: ReadPrec [Button]
readPrec :: ReadPrec Button
$creadPrec :: ReadPrec Button
readList :: ReadS [Button]
$creadList :: ReadS [Button]
readsPrec :: Int -> ReadS Button
$creadsPrec :: Int -> ReadS Button
Read, Button
forall a. a -> a -> Bounded a
maxBound :: Button
$cmaxBound :: Button
minBound :: Button
$cminBound :: Button
Bounded, Int -> Button
Button -> Int
Button -> [Button]
Button -> Button
Button -> Button -> [Button]
Button -> Button -> Button -> [Button]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Button -> Button -> Button -> [Button]
$cenumFromThenTo :: Button -> Button -> Button -> [Button]
enumFromTo :: Button -> Button -> [Button]
$cenumFromTo :: Button -> Button -> [Button]
enumFromThen :: Button -> Button -> [Button]
$cenumFromThen :: Button -> Button -> [Button]
enumFrom :: Button -> [Button]
$cenumFrom :: Button -> [Button]
fromEnum :: Button -> Int
$cfromEnum :: Button -> Int
toEnum :: Int -> Button
$ctoEnum :: Int -> Button
pred :: Button -> Button
$cpred :: Button -> Button
succ :: Button -> Button
$csucc :: Button -> Button
Enum)

-- | 'Name' represents names to uniquely identify various components
--   of the UI, such as forms, panels, caches, extents, lists, and buttons.
data Name
  = FocusablePanel FocusablePanel
  | -- | The REPL input form.
    REPLInput
  | -- | The render cache for the world view.
    WorldCache
  | -- | The cached extent for the world view.
    WorldExtent
  | -- | The list of inventory items for the currently
    --   focused robot.
    InventoryList
  | -- | The inventory item position in the InventoryList.
    InventoryListItem Int
  | -- | The list of main menu choices.
    MenuList
  | -- | The list of achievements.
    AchievementList
  | -- | The list of goals/objectives.
    GoalWidgets GoalWidget
  | -- | The list of scenario choices.
    ScenarioList
  | -- | The scrollable viewport for the info panel.
    InfoViewport
  | -- | The scrollable viewport for any modal dialog.
    ModalViewport
  | -- | A clickable button in a modal dialog.
    Button Button
  deriving (Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Eq Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
Ord, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, ReadPrec [Name]
ReadPrec Name
Int -> ReadS Name
ReadS [Name]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Name]
$creadListPrec :: ReadPrec [Name]
readPrec :: ReadPrec Name
$creadPrec :: ReadPrec Name
readList :: ReadS [Name]
$creadList :: ReadS [Name]
readsPrec :: Int -> ReadS Name
$creadsPrec :: Int -> ReadS Name
Read)