-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Sum types representing the Brick names
-- for every referenceable widget.
--
-- Nesting of name types is utilized often to simplify
-- case matching.
module Swarm.TUI.Model.Name where

import Data.Text (Text)

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

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

data ScenarioConfigPanel
  = ScenarioConfigFileSelector
  | ScenarioConfigPanelControl ScenarioConfigPanelFocusable
  deriving (ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
(ScenarioConfigPanel -> ScenarioConfigPanel -> Bool)
-> (ScenarioConfigPanel -> ScenarioConfigPanel -> Bool)
-> Eq ScenarioConfigPanel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
== :: ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
$c/= :: ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
/= :: ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
Eq, Eq ScenarioConfigPanel
Eq ScenarioConfigPanel =>
(ScenarioConfigPanel -> ScenarioConfigPanel -> Ordering)
-> (ScenarioConfigPanel -> ScenarioConfigPanel -> Bool)
-> (ScenarioConfigPanel -> ScenarioConfigPanel -> Bool)
-> (ScenarioConfigPanel -> ScenarioConfigPanel -> Bool)
-> (ScenarioConfigPanel -> ScenarioConfigPanel -> Bool)
-> (ScenarioConfigPanel
    -> ScenarioConfigPanel -> ScenarioConfigPanel)
-> (ScenarioConfigPanel
    -> ScenarioConfigPanel -> ScenarioConfigPanel)
-> Ord ScenarioConfigPanel
ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
ScenarioConfigPanel -> ScenarioConfigPanel -> Ordering
ScenarioConfigPanel -> ScenarioConfigPanel -> ScenarioConfigPanel
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
$ccompare :: ScenarioConfigPanel -> ScenarioConfigPanel -> Ordering
compare :: ScenarioConfigPanel -> ScenarioConfigPanel -> Ordering
$c< :: ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
< :: ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
$c<= :: ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
<= :: ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
$c> :: ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
> :: ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
$c>= :: ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
>= :: ScenarioConfigPanel -> ScenarioConfigPanel -> Bool
$cmax :: ScenarioConfigPanel -> ScenarioConfigPanel -> ScenarioConfigPanel
max :: ScenarioConfigPanel -> ScenarioConfigPanel -> ScenarioConfigPanel
$cmin :: ScenarioConfigPanel -> ScenarioConfigPanel -> ScenarioConfigPanel
min :: ScenarioConfigPanel -> ScenarioConfigPanel -> ScenarioConfigPanel
Ord, Int -> ScenarioConfigPanel -> ShowS
[ScenarioConfigPanel] -> ShowS
ScenarioConfigPanel -> String
(Int -> ScenarioConfigPanel -> ShowS)
-> (ScenarioConfigPanel -> String)
-> ([ScenarioConfigPanel] -> ShowS)
-> Show ScenarioConfigPanel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScenarioConfigPanel -> ShowS
showsPrec :: Int -> ScenarioConfigPanel -> ShowS
$cshow :: ScenarioConfigPanel -> String
show :: ScenarioConfigPanel -> String
$cshowList :: [ScenarioConfigPanel] -> ShowS
showList :: [ScenarioConfigPanel] -> ShowS
Show, ReadPrec [ScenarioConfigPanel]
ReadPrec ScenarioConfigPanel
Int -> ReadS ScenarioConfigPanel
ReadS [ScenarioConfigPanel]
(Int -> ReadS ScenarioConfigPanel)
-> ReadS [ScenarioConfigPanel]
-> ReadPrec ScenarioConfigPanel
-> ReadPrec [ScenarioConfigPanel]
-> Read ScenarioConfigPanel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ScenarioConfigPanel
readsPrec :: Int -> ReadS ScenarioConfigPanel
$creadList :: ReadS [ScenarioConfigPanel]
readList :: ReadS [ScenarioConfigPanel]
$creadPrec :: ReadPrec ScenarioConfigPanel
readPrec :: ReadPrec ScenarioConfigPanel
$creadListPrec :: ReadPrec [ScenarioConfigPanel]
readListPrec :: ReadPrec [ScenarioConfigPanel]
Read)

data ScenarioConfigPanelFocusable
  = -- | The file selector for launching a scenario with a script
    ScriptSelector
  | SeedSelector
  | StartGameButton
  deriving (ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
(ScenarioConfigPanelFocusable
 -> ScenarioConfigPanelFocusable -> Bool)
-> (ScenarioConfigPanelFocusable
    -> ScenarioConfigPanelFocusable -> Bool)
-> Eq ScenarioConfigPanelFocusable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
== :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
$c/= :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
/= :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
Eq, Eq ScenarioConfigPanelFocusable
Eq ScenarioConfigPanelFocusable =>
(ScenarioConfigPanelFocusable
 -> ScenarioConfigPanelFocusable -> Ordering)
-> (ScenarioConfigPanelFocusable
    -> ScenarioConfigPanelFocusable -> Bool)
-> (ScenarioConfigPanelFocusable
    -> ScenarioConfigPanelFocusable -> Bool)
-> (ScenarioConfigPanelFocusable
    -> ScenarioConfigPanelFocusable -> Bool)
-> (ScenarioConfigPanelFocusable
    -> ScenarioConfigPanelFocusable -> Bool)
-> (ScenarioConfigPanelFocusable
    -> ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable)
-> (ScenarioConfigPanelFocusable
    -> ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable)
-> Ord ScenarioConfigPanelFocusable
ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Ordering
ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable
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
$ccompare :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Ordering
compare :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Ordering
$c< :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
< :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
$c<= :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
<= :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
$c> :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
> :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
$c>= :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
>= :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> Bool
$cmax :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable
max :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable
$cmin :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable
min :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable
Ord, Int -> ScenarioConfigPanelFocusable -> ShowS
[ScenarioConfigPanelFocusable] -> ShowS
ScenarioConfigPanelFocusable -> String
(Int -> ScenarioConfigPanelFocusable -> ShowS)
-> (ScenarioConfigPanelFocusable -> String)
-> ([ScenarioConfigPanelFocusable] -> ShowS)
-> Show ScenarioConfigPanelFocusable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScenarioConfigPanelFocusable -> ShowS
showsPrec :: Int -> ScenarioConfigPanelFocusable -> ShowS
$cshow :: ScenarioConfigPanelFocusable -> String
show :: ScenarioConfigPanelFocusable -> String
$cshowList :: [ScenarioConfigPanelFocusable] -> ShowS
showList :: [ScenarioConfigPanelFocusable] -> ShowS
Show, ReadPrec [ScenarioConfigPanelFocusable]
ReadPrec ScenarioConfigPanelFocusable
Int -> ReadS ScenarioConfigPanelFocusable
ReadS [ScenarioConfigPanelFocusable]
(Int -> ReadS ScenarioConfigPanelFocusable)
-> ReadS [ScenarioConfigPanelFocusable]
-> ReadPrec ScenarioConfigPanelFocusable
-> ReadPrec [ScenarioConfigPanelFocusable]
-> Read ScenarioConfigPanelFocusable
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ScenarioConfigPanelFocusable
readsPrec :: Int -> ReadS ScenarioConfigPanelFocusable
$creadList :: ReadS [ScenarioConfigPanelFocusable]
readList :: ReadS [ScenarioConfigPanelFocusable]
$creadPrec :: ReadPrec ScenarioConfigPanelFocusable
readPrec :: ReadPrec ScenarioConfigPanelFocusable
$creadListPrec :: ReadPrec [ScenarioConfigPanelFocusable]
readListPrec :: ReadPrec [ScenarioConfigPanelFocusable]
Read, ScenarioConfigPanelFocusable
ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable
-> Bounded ScenarioConfigPanelFocusable
forall a. a -> a -> Bounded a
$cminBound :: ScenarioConfigPanelFocusable
minBound :: ScenarioConfigPanelFocusable
$cmaxBound :: ScenarioConfigPanelFocusable
maxBound :: ScenarioConfigPanelFocusable
Bounded, Int -> ScenarioConfigPanelFocusable
ScenarioConfigPanelFocusable -> Int
ScenarioConfigPanelFocusable -> [ScenarioConfigPanelFocusable]
ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable
ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> [ScenarioConfigPanelFocusable]
ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable
-> [ScenarioConfigPanelFocusable]
(ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable)
-> (ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable)
-> (Int -> ScenarioConfigPanelFocusable)
-> (ScenarioConfigPanelFocusable -> Int)
-> (ScenarioConfigPanelFocusable -> [ScenarioConfigPanelFocusable])
-> (ScenarioConfigPanelFocusable
    -> ScenarioConfigPanelFocusable -> [ScenarioConfigPanelFocusable])
-> (ScenarioConfigPanelFocusable
    -> ScenarioConfigPanelFocusable -> [ScenarioConfigPanelFocusable])
-> (ScenarioConfigPanelFocusable
    -> ScenarioConfigPanelFocusable
    -> ScenarioConfigPanelFocusable
    -> [ScenarioConfigPanelFocusable])
-> Enum ScenarioConfigPanelFocusable
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable
succ :: ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable
$cpred :: ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable
pred :: ScenarioConfigPanelFocusable -> ScenarioConfigPanelFocusable
$ctoEnum :: Int -> ScenarioConfigPanelFocusable
toEnum :: Int -> ScenarioConfigPanelFocusable
$cfromEnum :: ScenarioConfigPanelFocusable -> Int
fromEnum :: ScenarioConfigPanelFocusable -> Int
$cenumFrom :: ScenarioConfigPanelFocusable -> [ScenarioConfigPanelFocusable]
enumFrom :: ScenarioConfigPanelFocusable -> [ScenarioConfigPanelFocusable]
$cenumFromThen :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> [ScenarioConfigPanelFocusable]
enumFromThen :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> [ScenarioConfigPanelFocusable]
$cenumFromTo :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> [ScenarioConfigPanelFocusable]
enumFromTo :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable -> [ScenarioConfigPanelFocusable]
$cenumFromThenTo :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable
-> [ScenarioConfigPanelFocusable]
enumFromThenTo :: ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable
-> ScenarioConfigPanelFocusable
-> [ScenarioConfigPanelFocusable]
Enum)

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

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

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

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

data RobotsDisplayMode
  = RobotList
  | SingleRobotDetails RobotDetailSubpane
  deriving (RobotsDisplayMode -> RobotsDisplayMode -> Bool
(RobotsDisplayMode -> RobotsDisplayMode -> Bool)
-> (RobotsDisplayMode -> RobotsDisplayMode -> Bool)
-> Eq RobotsDisplayMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RobotsDisplayMode -> RobotsDisplayMode -> Bool
== :: RobotsDisplayMode -> RobotsDisplayMode -> Bool
$c/= :: RobotsDisplayMode -> RobotsDisplayMode -> Bool
/= :: RobotsDisplayMode -> RobotsDisplayMode -> Bool
Eq, Eq RobotsDisplayMode
Eq RobotsDisplayMode =>
(RobotsDisplayMode -> RobotsDisplayMode -> Ordering)
-> (RobotsDisplayMode -> RobotsDisplayMode -> Bool)
-> (RobotsDisplayMode -> RobotsDisplayMode -> Bool)
-> (RobotsDisplayMode -> RobotsDisplayMode -> Bool)
-> (RobotsDisplayMode -> RobotsDisplayMode -> Bool)
-> (RobotsDisplayMode -> RobotsDisplayMode -> RobotsDisplayMode)
-> (RobotsDisplayMode -> RobotsDisplayMode -> RobotsDisplayMode)
-> Ord RobotsDisplayMode
RobotsDisplayMode -> RobotsDisplayMode -> Bool
RobotsDisplayMode -> RobotsDisplayMode -> Ordering
RobotsDisplayMode -> RobotsDisplayMode -> RobotsDisplayMode
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
$ccompare :: RobotsDisplayMode -> RobotsDisplayMode -> Ordering
compare :: RobotsDisplayMode -> RobotsDisplayMode -> Ordering
$c< :: RobotsDisplayMode -> RobotsDisplayMode -> Bool
< :: RobotsDisplayMode -> RobotsDisplayMode -> Bool
$c<= :: RobotsDisplayMode -> RobotsDisplayMode -> Bool
<= :: RobotsDisplayMode -> RobotsDisplayMode -> Bool
$c> :: RobotsDisplayMode -> RobotsDisplayMode -> Bool
> :: RobotsDisplayMode -> RobotsDisplayMode -> Bool
$c>= :: RobotsDisplayMode -> RobotsDisplayMode -> Bool
>= :: RobotsDisplayMode -> RobotsDisplayMode -> Bool
$cmax :: RobotsDisplayMode -> RobotsDisplayMode -> RobotsDisplayMode
max :: RobotsDisplayMode -> RobotsDisplayMode -> RobotsDisplayMode
$cmin :: RobotsDisplayMode -> RobotsDisplayMode -> RobotsDisplayMode
min :: RobotsDisplayMode -> RobotsDisplayMode -> RobotsDisplayMode
Ord, Int -> RobotsDisplayMode -> ShowS
[RobotsDisplayMode] -> ShowS
RobotsDisplayMode -> String
(Int -> RobotsDisplayMode -> ShowS)
-> (RobotsDisplayMode -> String)
-> ([RobotsDisplayMode] -> ShowS)
-> Show RobotsDisplayMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RobotsDisplayMode -> ShowS
showsPrec :: Int -> RobotsDisplayMode -> ShowS
$cshow :: RobotsDisplayMode -> String
show :: RobotsDisplayMode -> String
$cshowList :: [RobotsDisplayMode] -> ShowS
showList :: [RobotsDisplayMode] -> ShowS
Show, ReadPrec [RobotsDisplayMode]
ReadPrec RobotsDisplayMode
Int -> ReadS RobotsDisplayMode
ReadS [RobotsDisplayMode]
(Int -> ReadS RobotsDisplayMode)
-> ReadS [RobotsDisplayMode]
-> ReadPrec RobotsDisplayMode
-> ReadPrec [RobotsDisplayMode]
-> Read RobotsDisplayMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RobotsDisplayMode
readsPrec :: Int -> ReadS RobotsDisplayMode
$creadList :: ReadS [RobotsDisplayMode]
readList :: ReadS [RobotsDisplayMode]
$creadPrec :: ReadPrec RobotsDisplayMode
readPrec :: ReadPrec RobotsDisplayMode
$creadListPrec :: ReadPrec [RobotsDisplayMode]
readListPrec :: ReadPrec [RobotsDisplayMode]
Read)

-- | 'Name' represents names to uniquely identify various components
--   of the UI, such as forms, panels, caches, extents, lists, and buttons.
data Name
  = FocusablePanel FocusablePanel
  | -- | An individual control within the world editor panel.
    WorldEditorPanelControl WorldEditorFocusable
  | -- | The REPL input form.
    REPLInput
  | -- | The REPL history cache.
    REPLHistoryCache
  | -- | The render cache for the world view.
    WorldCache
  | -- | The cached extent for the world view.
    WorldExtent
  | -- | The cursor/viewCenter display in the bottom left of the World view
    WorldPositionIndicator
  | -- | The list of possible entities to paint a map with.
    EntityPaintList
  | -- | The entity paint item position in the EntityPaintList.
    EntityPaintListItem Int
  | -- | The list of possible terrain materials.
    TerrainList
  | -- | The terrain item position in the TerrainList.
    TerrainListItem Int
  | -- | The list of inventory items for the currently
    --   focused robot.
    InventoryList
  | -- | The inventory item position in the InventoryList.
    InventoryListItem Int
  | -- | Cacheable scenario preview
    ScenarioPreview FilePath
  | -- | The list of main menu choices.
    MenuList
  | -- | The list of achievements.
    AchievementList
  | -- | An individual control within the scenario launch config panel
    ScenarioConfigControl ScenarioConfigPanel
  | -- | The list of goals/objectives.
    GoalWidgets GoalWidget
  | -- | The list of goals/objectives.
    StructureWidgets StructureWidget
  | -- | The list of scenario choices.
    ScenarioList
  | -- | The robots list
    RobotsListDialog RobotsDisplayMode
  | -- | The scrollable viewport for the info panel.
    InfoViewport
  | -- | The scrollable viewport for any modal dialog.
    ModalViewport
  | -- | The scrollable viewport for the REPL.
    REPLViewport
  | -- | A clickable button in a modal dialog.
    Button Button
  | -- | A clickable shortcut in the TUI.
    UIShortcut Text
  | -- | A custom widget name, for use in applications built on top of the Swarm library.
    CustomName Text
  deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Eq Name
Eq Name =>
(Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord 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
$ccompare :: Name -> Name -> Ordering
compare :: Name -> Name -> Ordering
$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
>= :: Name -> Name -> Bool
$cmax :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
min :: Name -> Name -> Name
Ord, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
Show, ReadPrec [Name]
ReadPrec Name
Int -> ReadS Name
ReadS [Name]
(Int -> ReadS Name)
-> ReadS [Name] -> ReadPrec Name -> ReadPrec [Name] -> Read Name
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Name
readsPrec :: Int -> ReadS Name
$creadList :: ReadS [Name]
readList :: ReadS [Name]
$creadPrec :: ReadPrec Name
readPrec :: ReadPrec Name
$creadListPrec :: ReadPrec [Name]
readListPrec :: ReadPrec [Name]
Read)