{-# LANGUAGE PatternSynonyms, Safe #-}

{-|
Module      : Data.Char.Chess
Description : Support for chess characters in unicode.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

One can make use of a <https://www.unicode.org/charts/PDF/U2600.pdf block 2600> and <https://www.unicode.org/charts/PDF/U1FA00.pdf block 1fa00> of Unicode characters to render chess characters. One can render chess characters as /netral/, /white/, or /black/
pieces, for such pieces one can render these rotated by 0, 90, 180 and 270 degrees. Knights can be rendered on 45, 135, 225 and 315 degrees as well. Furthermore unicode allows to render an /equihopper/, and special variants like a /knight-queen/, /knight-rook/, and /knight-bishop/.

The module contains pattern synonyms for names that are often given to the pieces.
-}

module Data.Char.Chess (
    -- * Data structures to represent the possible chess pieces.
    ChessColor(White, Black, Neutral)
  , ChessColorBinary(BWhite, BBlack)
  , ChessPieceType(King, Queen, Rook, Bishop, Knight, Pawn, Equihopper)
  , ChessHybridType(KnightQueen, KnightRook, KnightBishop)
  , ChessPiece(Chess90, Chess45Knight, ChessHybrid)
  , Rotate45(R45, R135, R225, R315)
    -- * Convert the chess piece to its unicode equivalent.
  , chessPiece
    -- * Pattern synonyms of special pieces
  , pattern Grasshopper, pattern Nightrider, pattern Amazon, pattern Terror, pattern OmnipotentQueen
  , pattern Superqueen, pattern Chancellor, pattern Marshall, pattern Empress, pattern Cardinal
  , pattern Princess
  ) where

import Data.Bits((.|.))
import Data.Char(chr)
import Data.Char.Core(
    Rotate90(R0, R180)
  )

import Test.QuickCheck.Arbitrary(Arbitrary(arbitrary), arbitraryBoundedEnum)
import Test.QuickCheck.Gen(oneof)

-- | A data type that defined binary colors ('BWhite', and 'BBlack'), this is
-- used for special chess pieces like a /knight queen/, /knight rook/, and
-- /knight bishop/ that only have no neutral color in unicode.
data ChessColorBinary
  = BWhite  -- ^ /White/ color.
  | BBlack  -- ^ /Black/ color.
  deriving (ChessColorBinary
ChessColorBinary -> ChessColorBinary -> Bounded ChessColorBinary
forall a. a -> a -> Bounded a
maxBound :: ChessColorBinary
$cmaxBound :: ChessColorBinary
minBound :: ChessColorBinary
$cminBound :: ChessColorBinary
Bounded, Int -> ChessColorBinary
ChessColorBinary -> Int
ChessColorBinary -> [ChessColorBinary]
ChessColorBinary -> ChessColorBinary
ChessColorBinary -> ChessColorBinary -> [ChessColorBinary]
ChessColorBinary
-> ChessColorBinary -> ChessColorBinary -> [ChessColorBinary]
(ChessColorBinary -> ChessColorBinary)
-> (ChessColorBinary -> ChessColorBinary)
-> (Int -> ChessColorBinary)
-> (ChessColorBinary -> Int)
-> (ChessColorBinary -> [ChessColorBinary])
-> (ChessColorBinary -> ChessColorBinary -> [ChessColorBinary])
-> (ChessColorBinary -> ChessColorBinary -> [ChessColorBinary])
-> (ChessColorBinary
    -> ChessColorBinary -> ChessColorBinary -> [ChessColorBinary])
-> Enum ChessColorBinary
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 :: ChessColorBinary
-> ChessColorBinary -> ChessColorBinary -> [ChessColorBinary]
$cenumFromThenTo :: ChessColorBinary
-> ChessColorBinary -> ChessColorBinary -> [ChessColorBinary]
enumFromTo :: ChessColorBinary -> ChessColorBinary -> [ChessColorBinary]
$cenumFromTo :: ChessColorBinary -> ChessColorBinary -> [ChessColorBinary]
enumFromThen :: ChessColorBinary -> ChessColorBinary -> [ChessColorBinary]
$cenumFromThen :: ChessColorBinary -> ChessColorBinary -> [ChessColorBinary]
enumFrom :: ChessColorBinary -> [ChessColorBinary]
$cenumFrom :: ChessColorBinary -> [ChessColorBinary]
fromEnum :: ChessColorBinary -> Int
$cfromEnum :: ChessColorBinary -> Int
toEnum :: Int -> ChessColorBinary
$ctoEnum :: Int -> ChessColorBinary
pred :: ChessColorBinary -> ChessColorBinary
$cpred :: ChessColorBinary -> ChessColorBinary
succ :: ChessColorBinary -> ChessColorBinary
$csucc :: ChessColorBinary -> ChessColorBinary
Enum, ChessColorBinary -> ChessColorBinary -> Bool
(ChessColorBinary -> ChessColorBinary -> Bool)
-> (ChessColorBinary -> ChessColorBinary -> Bool)
-> Eq ChessColorBinary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChessColorBinary -> ChessColorBinary -> Bool
$c/= :: ChessColorBinary -> ChessColorBinary -> Bool
== :: ChessColorBinary -> ChessColorBinary -> Bool
$c== :: ChessColorBinary -> ChessColorBinary -> Bool
Eq, Eq ChessColorBinary
Eq ChessColorBinary
-> (ChessColorBinary -> ChessColorBinary -> Ordering)
-> (ChessColorBinary -> ChessColorBinary -> Bool)
-> (ChessColorBinary -> ChessColorBinary -> Bool)
-> (ChessColorBinary -> ChessColorBinary -> Bool)
-> (ChessColorBinary -> ChessColorBinary -> Bool)
-> (ChessColorBinary -> ChessColorBinary -> ChessColorBinary)
-> (ChessColorBinary -> ChessColorBinary -> ChessColorBinary)
-> Ord ChessColorBinary
ChessColorBinary -> ChessColorBinary -> Bool
ChessColorBinary -> ChessColorBinary -> Ordering
ChessColorBinary -> ChessColorBinary -> ChessColorBinary
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 :: ChessColorBinary -> ChessColorBinary -> ChessColorBinary
$cmin :: ChessColorBinary -> ChessColorBinary -> ChessColorBinary
max :: ChessColorBinary -> ChessColorBinary -> ChessColorBinary
$cmax :: ChessColorBinary -> ChessColorBinary -> ChessColorBinary
>= :: ChessColorBinary -> ChessColorBinary -> Bool
$c>= :: ChessColorBinary -> ChessColorBinary -> Bool
> :: ChessColorBinary -> ChessColorBinary -> Bool
$c> :: ChessColorBinary -> ChessColorBinary -> Bool
<= :: ChessColorBinary -> ChessColorBinary -> Bool
$c<= :: ChessColorBinary -> ChessColorBinary -> Bool
< :: ChessColorBinary -> ChessColorBinary -> Bool
$c< :: ChessColorBinary -> ChessColorBinary -> Bool
compare :: ChessColorBinary -> ChessColorBinary -> Ordering
$ccompare :: ChessColorBinary -> ChessColorBinary -> Ordering
$cp1Ord :: Eq ChessColorBinary
Ord, ReadPrec [ChessColorBinary]
ReadPrec ChessColorBinary
Int -> ReadS ChessColorBinary
ReadS [ChessColorBinary]
(Int -> ReadS ChessColorBinary)
-> ReadS [ChessColorBinary]
-> ReadPrec ChessColorBinary
-> ReadPrec [ChessColorBinary]
-> Read ChessColorBinary
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChessColorBinary]
$creadListPrec :: ReadPrec [ChessColorBinary]
readPrec :: ReadPrec ChessColorBinary
$creadPrec :: ReadPrec ChessColorBinary
readList :: ReadS [ChessColorBinary]
$creadList :: ReadS [ChessColorBinary]
readsPrec :: Int -> ReadS ChessColorBinary
$creadsPrec :: Int -> ReadS ChessColorBinary
Read, Int -> ChessColorBinary -> ShowS
[ChessColorBinary] -> ShowS
ChessColorBinary -> String
(Int -> ChessColorBinary -> ShowS)
-> (ChessColorBinary -> String)
-> ([ChessColorBinary] -> ShowS)
-> Show ChessColorBinary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChessColorBinary] -> ShowS
$cshowList :: [ChessColorBinary] -> ShowS
show :: ChessColorBinary -> String
$cshow :: ChessColorBinary -> String
showsPrec :: Int -> ChessColorBinary -> ShowS
$cshowsPrec :: Int -> ChessColorBinary -> ShowS
Show)

-- | The color of a chess piece, this can for most pieces be 'Black', 'White',
-- or 'Neutral'.
data ChessColor
  = White  -- ^ /White/ color.
  | Black  -- ^ /Black/ color.
  | Neutral  -- ^ Neutral chess pieces, sometimes depicted half /white/ and half /black/.
  deriving (ChessColor
ChessColor -> ChessColor -> Bounded ChessColor
forall a. a -> a -> Bounded a
maxBound :: ChessColor
$cmaxBound :: ChessColor
minBound :: ChessColor
$cminBound :: ChessColor
Bounded, Int -> ChessColor
ChessColor -> Int
ChessColor -> [ChessColor]
ChessColor -> ChessColor
ChessColor -> ChessColor -> [ChessColor]
ChessColor -> ChessColor -> ChessColor -> [ChessColor]
(ChessColor -> ChessColor)
-> (ChessColor -> ChessColor)
-> (Int -> ChessColor)
-> (ChessColor -> Int)
-> (ChessColor -> [ChessColor])
-> (ChessColor -> ChessColor -> [ChessColor])
-> (ChessColor -> ChessColor -> [ChessColor])
-> (ChessColor -> ChessColor -> ChessColor -> [ChessColor])
-> Enum ChessColor
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 :: ChessColor -> ChessColor -> ChessColor -> [ChessColor]
$cenumFromThenTo :: ChessColor -> ChessColor -> ChessColor -> [ChessColor]
enumFromTo :: ChessColor -> ChessColor -> [ChessColor]
$cenumFromTo :: ChessColor -> ChessColor -> [ChessColor]
enumFromThen :: ChessColor -> ChessColor -> [ChessColor]
$cenumFromThen :: ChessColor -> ChessColor -> [ChessColor]
enumFrom :: ChessColor -> [ChessColor]
$cenumFrom :: ChessColor -> [ChessColor]
fromEnum :: ChessColor -> Int
$cfromEnum :: ChessColor -> Int
toEnum :: Int -> ChessColor
$ctoEnum :: Int -> ChessColor
pred :: ChessColor -> ChessColor
$cpred :: ChessColor -> ChessColor
succ :: ChessColor -> ChessColor
$csucc :: ChessColor -> ChessColor
Enum, ChessColor -> ChessColor -> Bool
(ChessColor -> ChessColor -> Bool)
-> (ChessColor -> ChessColor -> Bool) -> Eq ChessColor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChessColor -> ChessColor -> Bool
$c/= :: ChessColor -> ChessColor -> Bool
== :: ChessColor -> ChessColor -> Bool
$c== :: ChessColor -> ChessColor -> Bool
Eq, Eq ChessColor
Eq ChessColor
-> (ChessColor -> ChessColor -> Ordering)
-> (ChessColor -> ChessColor -> Bool)
-> (ChessColor -> ChessColor -> Bool)
-> (ChessColor -> ChessColor -> Bool)
-> (ChessColor -> ChessColor -> Bool)
-> (ChessColor -> ChessColor -> ChessColor)
-> (ChessColor -> ChessColor -> ChessColor)
-> Ord ChessColor
ChessColor -> ChessColor -> Bool
ChessColor -> ChessColor -> Ordering
ChessColor -> ChessColor -> ChessColor
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 :: ChessColor -> ChessColor -> ChessColor
$cmin :: ChessColor -> ChessColor -> ChessColor
max :: ChessColor -> ChessColor -> ChessColor
$cmax :: ChessColor -> ChessColor -> ChessColor
>= :: ChessColor -> ChessColor -> Bool
$c>= :: ChessColor -> ChessColor -> Bool
> :: ChessColor -> ChessColor -> Bool
$c> :: ChessColor -> ChessColor -> Bool
<= :: ChessColor -> ChessColor -> Bool
$c<= :: ChessColor -> ChessColor -> Bool
< :: ChessColor -> ChessColor -> Bool
$c< :: ChessColor -> ChessColor -> Bool
compare :: ChessColor -> ChessColor -> Ordering
$ccompare :: ChessColor -> ChessColor -> Ordering
$cp1Ord :: Eq ChessColor
Ord, ReadPrec [ChessColor]
ReadPrec ChessColor
Int -> ReadS ChessColor
ReadS [ChessColor]
(Int -> ReadS ChessColor)
-> ReadS [ChessColor]
-> ReadPrec ChessColor
-> ReadPrec [ChessColor]
-> Read ChessColor
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChessColor]
$creadListPrec :: ReadPrec [ChessColor]
readPrec :: ReadPrec ChessColor
$creadPrec :: ReadPrec ChessColor
readList :: ReadS [ChessColor]
$creadList :: ReadS [ChessColor]
readsPrec :: Int -> ReadS ChessColor
$creadsPrec :: Int -> ReadS ChessColor
Read, Int -> ChessColor -> ShowS
[ChessColor] -> ShowS
ChessColor -> String
(Int -> ChessColor -> ShowS)
-> (ChessColor -> String)
-> ([ChessColor] -> ShowS)
-> Show ChessColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChessColor] -> ShowS
$cshowList :: [ChessColor] -> ShowS
show :: ChessColor -> String
$cshow :: ChessColor -> String
showsPrec :: Int -> ChessColor -> ShowS
$cshowsPrec :: Int -> ChessColor -> ShowS
Show)

-- | The type of chess pieces. Unicode includes an 'Equihopper' as piece as
-- well.
data ChessPieceType
  = King  -- ^ The /king/ chess piece.
  | Queen  -- ^ The /queen/ chess piece.
  | Rook  -- ^ The /rook/ chess piece.
  | Bishop  -- ^ The /bishop/ chess piece.
  | Knight  -- ^ The /knight/ chess piece.
  | Pawn  -- ^ The /pawn/ chess piece.
  | Equihopper  -- ^ The /equihopper/ chess piece.
  deriving (ChessPieceType
ChessPieceType -> ChessPieceType -> Bounded ChessPieceType
forall a. a -> a -> Bounded a
maxBound :: ChessPieceType
$cmaxBound :: ChessPieceType
minBound :: ChessPieceType
$cminBound :: ChessPieceType
Bounded, Int -> ChessPieceType
ChessPieceType -> Int
ChessPieceType -> [ChessPieceType]
ChessPieceType -> ChessPieceType
ChessPieceType -> ChessPieceType -> [ChessPieceType]
ChessPieceType
-> ChessPieceType -> ChessPieceType -> [ChessPieceType]
(ChessPieceType -> ChessPieceType)
-> (ChessPieceType -> ChessPieceType)
-> (Int -> ChessPieceType)
-> (ChessPieceType -> Int)
-> (ChessPieceType -> [ChessPieceType])
-> (ChessPieceType -> ChessPieceType -> [ChessPieceType])
-> (ChessPieceType -> ChessPieceType -> [ChessPieceType])
-> (ChessPieceType
    -> ChessPieceType -> ChessPieceType -> [ChessPieceType])
-> Enum ChessPieceType
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 :: ChessPieceType
-> ChessPieceType -> ChessPieceType -> [ChessPieceType]
$cenumFromThenTo :: ChessPieceType
-> ChessPieceType -> ChessPieceType -> [ChessPieceType]
enumFromTo :: ChessPieceType -> ChessPieceType -> [ChessPieceType]
$cenumFromTo :: ChessPieceType -> ChessPieceType -> [ChessPieceType]
enumFromThen :: ChessPieceType -> ChessPieceType -> [ChessPieceType]
$cenumFromThen :: ChessPieceType -> ChessPieceType -> [ChessPieceType]
enumFrom :: ChessPieceType -> [ChessPieceType]
$cenumFrom :: ChessPieceType -> [ChessPieceType]
fromEnum :: ChessPieceType -> Int
$cfromEnum :: ChessPieceType -> Int
toEnum :: Int -> ChessPieceType
$ctoEnum :: Int -> ChessPieceType
pred :: ChessPieceType -> ChessPieceType
$cpred :: ChessPieceType -> ChessPieceType
succ :: ChessPieceType -> ChessPieceType
$csucc :: ChessPieceType -> ChessPieceType
Enum, ChessPieceType -> ChessPieceType -> Bool
(ChessPieceType -> ChessPieceType -> Bool)
-> (ChessPieceType -> ChessPieceType -> Bool) -> Eq ChessPieceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChessPieceType -> ChessPieceType -> Bool
$c/= :: ChessPieceType -> ChessPieceType -> Bool
== :: ChessPieceType -> ChessPieceType -> Bool
$c== :: ChessPieceType -> ChessPieceType -> Bool
Eq, Eq ChessPieceType
Eq ChessPieceType
-> (ChessPieceType -> ChessPieceType -> Ordering)
-> (ChessPieceType -> ChessPieceType -> Bool)
-> (ChessPieceType -> ChessPieceType -> Bool)
-> (ChessPieceType -> ChessPieceType -> Bool)
-> (ChessPieceType -> ChessPieceType -> Bool)
-> (ChessPieceType -> ChessPieceType -> ChessPieceType)
-> (ChessPieceType -> ChessPieceType -> ChessPieceType)
-> Ord ChessPieceType
ChessPieceType -> ChessPieceType -> Bool
ChessPieceType -> ChessPieceType -> Ordering
ChessPieceType -> ChessPieceType -> ChessPieceType
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 :: ChessPieceType -> ChessPieceType -> ChessPieceType
$cmin :: ChessPieceType -> ChessPieceType -> ChessPieceType
max :: ChessPieceType -> ChessPieceType -> ChessPieceType
$cmax :: ChessPieceType -> ChessPieceType -> ChessPieceType
>= :: ChessPieceType -> ChessPieceType -> Bool
$c>= :: ChessPieceType -> ChessPieceType -> Bool
> :: ChessPieceType -> ChessPieceType -> Bool
$c> :: ChessPieceType -> ChessPieceType -> Bool
<= :: ChessPieceType -> ChessPieceType -> Bool
$c<= :: ChessPieceType -> ChessPieceType -> Bool
< :: ChessPieceType -> ChessPieceType -> Bool
$c< :: ChessPieceType -> ChessPieceType -> Bool
compare :: ChessPieceType -> ChessPieceType -> Ordering
$ccompare :: ChessPieceType -> ChessPieceType -> Ordering
$cp1Ord :: Eq ChessPieceType
Ord, ReadPrec [ChessPieceType]
ReadPrec ChessPieceType
Int -> ReadS ChessPieceType
ReadS [ChessPieceType]
(Int -> ReadS ChessPieceType)
-> ReadS [ChessPieceType]
-> ReadPrec ChessPieceType
-> ReadPrec [ChessPieceType]
-> Read ChessPieceType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChessPieceType]
$creadListPrec :: ReadPrec [ChessPieceType]
readPrec :: ReadPrec ChessPieceType
$creadPrec :: ReadPrec ChessPieceType
readList :: ReadS [ChessPieceType]
$creadList :: ReadS [ChessPieceType]
readsPrec :: Int -> ReadS ChessPieceType
$creadsPrec :: Int -> ReadS ChessPieceType
Read, Int -> ChessPieceType -> ShowS
[ChessPieceType] -> ShowS
ChessPieceType -> String
(Int -> ChessPieceType -> ShowS)
-> (ChessPieceType -> String)
-> ([ChessPieceType] -> ShowS)
-> Show ChessPieceType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChessPieceType] -> ShowS
$cshowList :: [ChessPieceType] -> ShowS
show :: ChessPieceType -> String
$cshow :: ChessPieceType -> String
showsPrec :: Int -> ChessPieceType -> ShowS
$cshowsPrec :: Int -> ChessPieceType -> ShowS
Show)

-- | Extra rotations that can be performed for knight chess pieces.
data Rotate45
  = R45  -- ^ Rotation over /45/ degrees.
  | R135  -- ^ Rotation over /135/ degrees.
  | R225  -- ^ Rotation over /225/ degrees.
  | R315  -- ^ Rotation over /315/ degrees.
  deriving (Rotate45
Rotate45 -> Rotate45 -> Bounded Rotate45
forall a. a -> a -> Bounded a
maxBound :: Rotate45
$cmaxBound :: Rotate45
minBound :: Rotate45
$cminBound :: Rotate45
Bounded, Int -> Rotate45
Rotate45 -> Int
Rotate45 -> [Rotate45]
Rotate45 -> Rotate45
Rotate45 -> Rotate45 -> [Rotate45]
Rotate45 -> Rotate45 -> Rotate45 -> [Rotate45]
(Rotate45 -> Rotate45)
-> (Rotate45 -> Rotate45)
-> (Int -> Rotate45)
-> (Rotate45 -> Int)
-> (Rotate45 -> [Rotate45])
-> (Rotate45 -> Rotate45 -> [Rotate45])
-> (Rotate45 -> Rotate45 -> [Rotate45])
-> (Rotate45 -> Rotate45 -> Rotate45 -> [Rotate45])
-> Enum Rotate45
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 :: Rotate45 -> Rotate45 -> Rotate45 -> [Rotate45]
$cenumFromThenTo :: Rotate45 -> Rotate45 -> Rotate45 -> [Rotate45]
enumFromTo :: Rotate45 -> Rotate45 -> [Rotate45]
$cenumFromTo :: Rotate45 -> Rotate45 -> [Rotate45]
enumFromThen :: Rotate45 -> Rotate45 -> [Rotate45]
$cenumFromThen :: Rotate45 -> Rotate45 -> [Rotate45]
enumFrom :: Rotate45 -> [Rotate45]
$cenumFrom :: Rotate45 -> [Rotate45]
fromEnum :: Rotate45 -> Int
$cfromEnum :: Rotate45 -> Int
toEnum :: Int -> Rotate45
$ctoEnum :: Int -> Rotate45
pred :: Rotate45 -> Rotate45
$cpred :: Rotate45 -> Rotate45
succ :: Rotate45 -> Rotate45
$csucc :: Rotate45 -> Rotate45
Enum, Rotate45 -> Rotate45 -> Bool
(Rotate45 -> Rotate45 -> Bool)
-> (Rotate45 -> Rotate45 -> Bool) -> Eq Rotate45
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rotate45 -> Rotate45 -> Bool
$c/= :: Rotate45 -> Rotate45 -> Bool
== :: Rotate45 -> Rotate45 -> Bool
$c== :: Rotate45 -> Rotate45 -> Bool
Eq, Eq Rotate45
Eq Rotate45
-> (Rotate45 -> Rotate45 -> Ordering)
-> (Rotate45 -> Rotate45 -> Bool)
-> (Rotate45 -> Rotate45 -> Bool)
-> (Rotate45 -> Rotate45 -> Bool)
-> (Rotate45 -> Rotate45 -> Bool)
-> (Rotate45 -> Rotate45 -> Rotate45)
-> (Rotate45 -> Rotate45 -> Rotate45)
-> Ord Rotate45
Rotate45 -> Rotate45 -> Bool
Rotate45 -> Rotate45 -> Ordering
Rotate45 -> Rotate45 -> Rotate45
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 :: Rotate45 -> Rotate45 -> Rotate45
$cmin :: Rotate45 -> Rotate45 -> Rotate45
max :: Rotate45 -> Rotate45 -> Rotate45
$cmax :: Rotate45 -> Rotate45 -> Rotate45
>= :: Rotate45 -> Rotate45 -> Bool
$c>= :: Rotate45 -> Rotate45 -> Bool
> :: Rotate45 -> Rotate45 -> Bool
$c> :: Rotate45 -> Rotate45 -> Bool
<= :: Rotate45 -> Rotate45 -> Bool
$c<= :: Rotate45 -> Rotate45 -> Bool
< :: Rotate45 -> Rotate45 -> Bool
$c< :: Rotate45 -> Rotate45 -> Bool
compare :: Rotate45 -> Rotate45 -> Ordering
$ccompare :: Rotate45 -> Rotate45 -> Ordering
$cp1Ord :: Eq Rotate45
Ord, ReadPrec [Rotate45]
ReadPrec Rotate45
Int -> ReadS Rotate45
ReadS [Rotate45]
(Int -> ReadS Rotate45)
-> ReadS [Rotate45]
-> ReadPrec Rotate45
-> ReadPrec [Rotate45]
-> Read Rotate45
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rotate45]
$creadListPrec :: ReadPrec [Rotate45]
readPrec :: ReadPrec Rotate45
$creadPrec :: ReadPrec Rotate45
readList :: ReadS [Rotate45]
$creadList :: ReadS [Rotate45]
readsPrec :: Int -> ReadS Rotate45
$creadsPrec :: Int -> ReadS Rotate45
Read, Int -> Rotate45 -> ShowS
[Rotate45] -> ShowS
Rotate45 -> String
(Int -> Rotate45 -> ShowS)
-> (Rotate45 -> String) -> ([Rotate45] -> ShowS) -> Show Rotate45
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rotate45] -> ShowS
$cshowList :: [Rotate45] -> ShowS
show :: Rotate45 -> String
$cshow :: Rotate45 -> String
showsPrec :: Int -> Rotate45 -> ShowS
$cshowsPrec :: Int -> Rotate45 -> ShowS
Show)

-- | Hybrid chess pieces like the /knight-queen/, /knight-rook/ and
-- /knight-bishop/.
data ChessHybridType
  = KnightQueen  -- ^ The /knight-queen/ chess piece.
  | KnightRook  -- ^ The /knight-rook/ chess piece.
  | KnightBishop  -- ^ The /knight-bishop/ chess piece.
  deriving (ChessHybridType
ChessHybridType -> ChessHybridType -> Bounded ChessHybridType
forall a. a -> a -> Bounded a
maxBound :: ChessHybridType
$cmaxBound :: ChessHybridType
minBound :: ChessHybridType
$cminBound :: ChessHybridType
Bounded, Int -> ChessHybridType
ChessHybridType -> Int
ChessHybridType -> [ChessHybridType]
ChessHybridType -> ChessHybridType
ChessHybridType -> ChessHybridType -> [ChessHybridType]
ChessHybridType
-> ChessHybridType -> ChessHybridType -> [ChessHybridType]
(ChessHybridType -> ChessHybridType)
-> (ChessHybridType -> ChessHybridType)
-> (Int -> ChessHybridType)
-> (ChessHybridType -> Int)
-> (ChessHybridType -> [ChessHybridType])
-> (ChessHybridType -> ChessHybridType -> [ChessHybridType])
-> (ChessHybridType -> ChessHybridType -> [ChessHybridType])
-> (ChessHybridType
    -> ChessHybridType -> ChessHybridType -> [ChessHybridType])
-> Enum ChessHybridType
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 :: ChessHybridType
-> ChessHybridType -> ChessHybridType -> [ChessHybridType]
$cenumFromThenTo :: ChessHybridType
-> ChessHybridType -> ChessHybridType -> [ChessHybridType]
enumFromTo :: ChessHybridType -> ChessHybridType -> [ChessHybridType]
$cenumFromTo :: ChessHybridType -> ChessHybridType -> [ChessHybridType]
enumFromThen :: ChessHybridType -> ChessHybridType -> [ChessHybridType]
$cenumFromThen :: ChessHybridType -> ChessHybridType -> [ChessHybridType]
enumFrom :: ChessHybridType -> [ChessHybridType]
$cenumFrom :: ChessHybridType -> [ChessHybridType]
fromEnum :: ChessHybridType -> Int
$cfromEnum :: ChessHybridType -> Int
toEnum :: Int -> ChessHybridType
$ctoEnum :: Int -> ChessHybridType
pred :: ChessHybridType -> ChessHybridType
$cpred :: ChessHybridType -> ChessHybridType
succ :: ChessHybridType -> ChessHybridType
$csucc :: ChessHybridType -> ChessHybridType
Enum, ChessHybridType -> ChessHybridType -> Bool
(ChessHybridType -> ChessHybridType -> Bool)
-> (ChessHybridType -> ChessHybridType -> Bool)
-> Eq ChessHybridType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChessHybridType -> ChessHybridType -> Bool
$c/= :: ChessHybridType -> ChessHybridType -> Bool
== :: ChessHybridType -> ChessHybridType -> Bool
$c== :: ChessHybridType -> ChessHybridType -> Bool
Eq, Eq ChessHybridType
Eq ChessHybridType
-> (ChessHybridType -> ChessHybridType -> Ordering)
-> (ChessHybridType -> ChessHybridType -> Bool)
-> (ChessHybridType -> ChessHybridType -> Bool)
-> (ChessHybridType -> ChessHybridType -> Bool)
-> (ChessHybridType -> ChessHybridType -> Bool)
-> (ChessHybridType -> ChessHybridType -> ChessHybridType)
-> (ChessHybridType -> ChessHybridType -> ChessHybridType)
-> Ord ChessHybridType
ChessHybridType -> ChessHybridType -> Bool
ChessHybridType -> ChessHybridType -> Ordering
ChessHybridType -> ChessHybridType -> ChessHybridType
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 :: ChessHybridType -> ChessHybridType -> ChessHybridType
$cmin :: ChessHybridType -> ChessHybridType -> ChessHybridType
max :: ChessHybridType -> ChessHybridType -> ChessHybridType
$cmax :: ChessHybridType -> ChessHybridType -> ChessHybridType
>= :: ChessHybridType -> ChessHybridType -> Bool
$c>= :: ChessHybridType -> ChessHybridType -> Bool
> :: ChessHybridType -> ChessHybridType -> Bool
$c> :: ChessHybridType -> ChessHybridType -> Bool
<= :: ChessHybridType -> ChessHybridType -> Bool
$c<= :: ChessHybridType -> ChessHybridType -> Bool
< :: ChessHybridType -> ChessHybridType -> Bool
$c< :: ChessHybridType -> ChessHybridType -> Bool
compare :: ChessHybridType -> ChessHybridType -> Ordering
$ccompare :: ChessHybridType -> ChessHybridType -> Ordering
$cp1Ord :: Eq ChessHybridType
Ord, ReadPrec [ChessHybridType]
ReadPrec ChessHybridType
Int -> ReadS ChessHybridType
ReadS [ChessHybridType]
(Int -> ReadS ChessHybridType)
-> ReadS [ChessHybridType]
-> ReadPrec ChessHybridType
-> ReadPrec [ChessHybridType]
-> Read ChessHybridType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChessHybridType]
$creadListPrec :: ReadPrec [ChessHybridType]
readPrec :: ReadPrec ChessHybridType
$creadPrec :: ReadPrec ChessHybridType
readList :: ReadS [ChessHybridType]
$creadList :: ReadS [ChessHybridType]
readsPrec :: Int -> ReadS ChessHybridType
$creadsPrec :: Int -> ReadS ChessHybridType
Read, Int -> ChessHybridType -> ShowS
[ChessHybridType] -> ShowS
ChessHybridType -> String
(Int -> ChessHybridType -> ShowS)
-> (ChessHybridType -> String)
-> ([ChessHybridType] -> ShowS)
-> Show ChessHybridType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChessHybridType] -> ShowS
$cshowList :: [ChessHybridType] -> ShowS
show :: ChessHybridType -> String
$cshow :: ChessHybridType -> String
showsPrec :: Int -> ChessHybridType -> ShowS
$cshowsPrec :: Int -> ChessHybridType -> ShowS
Show)

-- | Chess pieces that can be represented in Unicode. These are the /king/,
-- /queen/, /rook/, /bishop/, /knight/, /pawn/, and /equihopper/ over 0, 90,
-- 180, and 270 degrees; and the /knight/ over /45/, /135/, /225/, and /315/
-- degrees in 'Black', 'White' and 'Neutral'.
-- Furthermore one can draw a /knight-queen/, /knight-rook/, and /knight-bishop/
-- pieces can be drawn without rotation and only in 'BBlack' or 'BWhite'.
data ChessPiece
  = Chess90 ChessColor ChessPieceType Rotate90  -- ^ Standard pieces drawn in /black/, /white/, or /neutral/ and with rotation.
  | Chess45Knight ChessColor Rotate45  -- ^ /Knights/ have unicode characters to render these rotated over /45/, /135/, /225/ and /315/ degrees.
  | ChessHybrid ChessHybridType ChessColorBinary  -- ^ Hybrid chess pieces can only be rendered in 'BBlack' and 'BWhite'.
  deriving (ChessPiece -> ChessPiece -> Bool
(ChessPiece -> ChessPiece -> Bool)
-> (ChessPiece -> ChessPiece -> Bool) -> Eq ChessPiece
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChessPiece -> ChessPiece -> Bool
$c/= :: ChessPiece -> ChessPiece -> Bool
== :: ChessPiece -> ChessPiece -> Bool
$c== :: ChessPiece -> ChessPiece -> Bool
Eq, Eq ChessPiece
Eq ChessPiece
-> (ChessPiece -> ChessPiece -> Ordering)
-> (ChessPiece -> ChessPiece -> Bool)
-> (ChessPiece -> ChessPiece -> Bool)
-> (ChessPiece -> ChessPiece -> Bool)
-> (ChessPiece -> ChessPiece -> Bool)
-> (ChessPiece -> ChessPiece -> ChessPiece)
-> (ChessPiece -> ChessPiece -> ChessPiece)
-> Ord ChessPiece
ChessPiece -> ChessPiece -> Bool
ChessPiece -> ChessPiece -> Ordering
ChessPiece -> ChessPiece -> ChessPiece
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 :: ChessPiece -> ChessPiece -> ChessPiece
$cmin :: ChessPiece -> ChessPiece -> ChessPiece
max :: ChessPiece -> ChessPiece -> ChessPiece
$cmax :: ChessPiece -> ChessPiece -> ChessPiece
>= :: ChessPiece -> ChessPiece -> Bool
$c>= :: ChessPiece -> ChessPiece -> Bool
> :: ChessPiece -> ChessPiece -> Bool
$c> :: ChessPiece -> ChessPiece -> Bool
<= :: ChessPiece -> ChessPiece -> Bool
$c<= :: ChessPiece -> ChessPiece -> Bool
< :: ChessPiece -> ChessPiece -> Bool
$c< :: ChessPiece -> ChessPiece -> Bool
compare :: ChessPiece -> ChessPiece -> Ordering
$ccompare :: ChessPiece -> ChessPiece -> Ordering
$cp1Ord :: Eq ChessPiece
Ord, ReadPrec [ChessPiece]
ReadPrec ChessPiece
Int -> ReadS ChessPiece
ReadS [ChessPiece]
(Int -> ReadS ChessPiece)
-> ReadS [ChessPiece]
-> ReadPrec ChessPiece
-> ReadPrec [ChessPiece]
-> Read ChessPiece
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChessPiece]
$creadListPrec :: ReadPrec [ChessPiece]
readPrec :: ReadPrec ChessPiece
$creadPrec :: ReadPrec ChessPiece
readList :: ReadS [ChessPiece]
$creadList :: ReadS [ChessPiece]
readsPrec :: Int -> ReadS ChessPiece
$creadsPrec :: Int -> ReadS ChessPiece
Read, Int -> ChessPiece -> ShowS
[ChessPiece] -> ShowS
ChessPiece -> String
(Int -> ChessPiece -> ShowS)
-> (ChessPiece -> String)
-> ([ChessPiece] -> ShowS)
-> Show ChessPiece
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChessPiece] -> ShowS
$cshowList :: [ChessPiece] -> ShowS
show :: ChessPiece -> String
$cshow :: ChessPiece -> String
showsPrec :: Int -> ChessPiece -> ShowS
$cshowsPrec :: Int -> ChessPiece -> ShowS
Show)

instance Arbitrary ChessColorBinary where
    arbitrary :: Gen ChessColorBinary
arbitrary = Gen ChessColorBinary
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary ChessColor where
    arbitrary :: Gen ChessColor
arbitrary = Gen ChessColor
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary ChessPieceType where
    arbitrary :: Gen ChessPieceType
arbitrary = Gen ChessPieceType
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary ChessHybridType where
    arbitrary :: Gen ChessHybridType
arbitrary = Gen ChessHybridType
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary Rotate45 where
    arbitrary :: Gen Rotate45
arbitrary = Gen Rotate45
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary ChessPiece where
    arbitrary :: Gen ChessPiece
arbitrary = [Gen ChessPiece] -> Gen ChessPiece
forall a. [Gen a] -> Gen a
oneof [ChessColor -> ChessPieceType -> Rotate90 -> ChessPiece
Chess90 (ChessColor -> ChessPieceType -> Rotate90 -> ChessPiece)
-> Gen ChessColor -> Gen (ChessPieceType -> Rotate90 -> ChessPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ChessColor
forall a. Arbitrary a => Gen a
arbitrary Gen (ChessPieceType -> Rotate90 -> ChessPiece)
-> Gen ChessPieceType -> Gen (Rotate90 -> ChessPiece)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ChessPieceType
forall a. Arbitrary a => Gen a
arbitrary Gen (Rotate90 -> ChessPiece) -> Gen Rotate90 -> Gen ChessPiece
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Rotate90
forall a. Arbitrary a => Gen a
arbitrary, ChessColor -> Rotate45 -> ChessPiece
Chess45Knight (ChessColor -> Rotate45 -> ChessPiece)
-> Gen ChessColor -> Gen (Rotate45 -> ChessPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ChessColor
forall a. Arbitrary a => Gen a
arbitrary Gen (Rotate45 -> ChessPiece) -> Gen Rotate45 -> Gen ChessPiece
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Rotate45
forall a. Arbitrary a => Gen a
arbitrary, ChessHybridType -> ChessColorBinary -> ChessPiece
ChessHybrid (ChessHybridType -> ChessColorBinary -> ChessPiece)
-> Gen ChessHybridType -> Gen (ChessColorBinary -> ChessPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ChessHybridType
forall a. Arbitrary a => Gen a
arbitrary Gen (ChessColorBinary -> ChessPiece)
-> Gen ChessColorBinary -> Gen ChessPiece
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ChessColorBinary
forall a. Arbitrary a => Gen a
arbitrary]

-- | A /grasshopper/ is a /queen/ rotated over 180 degrees.
pattern Grasshopper :: ChessColor -> ChessPiece
pattern $bGrasshopper :: ChessColor -> ChessPiece
$mGrasshopper :: forall r. ChessPiece -> (ChessColor -> r) -> (Void# -> r) -> r
Grasshopper c = Chess90 c Queen R180

-- | A /Nightrider/ is a /knight/ rotated over 180 degrees.
pattern Nightrider :: ChessColor -> ChessPiece
pattern $bNightrider :: ChessColor -> ChessPiece
$mNightrider :: forall r. ChessPiece -> (ChessColor -> r) -> (Void# -> r) -> r
Nightrider c = Chess90 c Knight R180

-- | An /amazon/ is alterative name for a /knight-queen/.
pattern Amazon :: ChessColorBinary -> ChessPiece
pattern $bAmazon :: ChessColorBinary -> ChessPiece
$mAmazon :: forall r.
ChessPiece -> (ChessColorBinary -> r) -> (Void# -> r) -> r
Amazon c = ChessHybrid KnightQueen c

-- | A /terror/ is alterative name for a /knight-queen/.
pattern Terror :: ChessColorBinary -> ChessPiece
pattern $bTerror :: ChessColorBinary -> ChessPiece
$mTerror :: forall r.
ChessPiece -> (ChessColorBinary -> r) -> (Void# -> r) -> r
Terror c = ChessHybrid KnightQueen c

-- | An /omnipotent queen/ is alterative name for a /knight-queen/.
pattern OmnipotentQueen :: ChessColorBinary -> ChessPiece
pattern $bOmnipotentQueen :: ChessColorBinary -> ChessPiece
$mOmnipotentQueen :: forall r.
ChessPiece -> (ChessColorBinary -> r) -> (Void# -> r) -> r
OmnipotentQueen c = ChessHybrid KnightQueen c

-- | A /superqueen/ is alterative name for a /knight-queen/.
pattern Superqueen :: ChessColorBinary -> ChessPiece
pattern $bSuperqueen :: ChessColorBinary -> ChessPiece
$mSuperqueen :: forall r.
ChessPiece -> (ChessColorBinary -> r) -> (Void# -> r) -> r
Superqueen c = ChessHybrid KnightQueen c

-- | A /chancellor/ is alterative name for a /knight-rook/.
pattern Chancellor :: ChessColorBinary -> ChessPiece
pattern $bChancellor :: ChessColorBinary -> ChessPiece
$mChancellor :: forall r.
ChessPiece -> (ChessColorBinary -> r) -> (Void# -> r) -> r
Chancellor c = ChessHybrid KnightRook c

-- | A /marshall/ is alterative name for a /knight-rook/.
pattern Marshall :: ChessColorBinary -> ChessPiece
pattern $bMarshall :: ChessColorBinary -> ChessPiece
$mMarshall :: forall r.
ChessPiece -> (ChessColorBinary -> r) -> (Void# -> r) -> r
Marshall c = ChessHybrid KnightRook c

-- | An /empress/ is alterative name for a /knight-rook/.
pattern Empress :: ChessColorBinary -> ChessPiece
pattern $bEmpress :: ChessColorBinary -> ChessPiece
$mEmpress :: forall r.
ChessPiece -> (ChessColorBinary -> r) -> (Void# -> r) -> r
Empress c = ChessHybrid KnightRook c

-- | A /cardinal/ is alterative name for a /knight-bishop/.
pattern Cardinal :: ChessColorBinary -> ChessPiece
pattern $bCardinal :: ChessColorBinary -> ChessPiece
$mCardinal :: forall r.
ChessPiece -> (ChessColorBinary -> r) -> (Void# -> r) -> r
Cardinal c = ChessHybrid KnightBishop c

-- | A /princess/ is alterative name for a /knight-bishop/.
pattern Princess :: ChessColorBinary -> ChessPiece
pattern $bPrincess :: ChessColorBinary -> ChessPiece
$mPrincess :: forall r.
ChessPiece -> (ChessColorBinary -> r) -> (Void# -> r) -> r
Princess c = ChessHybrid KnightBishop c

_chessValue :: ChessPieceType -> ChessColor -> Int
_chessValue :: ChessPieceType -> ChessColor -> Int
_chessValue ChessPieceType
t ChessColor
c = Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ChessColor -> Int
forall a. Enum a => a -> Int
fromEnum ChessColor
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ChessPieceType -> Int
forall a. Enum a => a -> Int
fromEnum ChessPieceType
t

-- | Convert the given 'ChessPiece' to the corresponding unicode character.
chessPiece
  :: ChessPiece  -- ^ The given 'ChessPiece' to convert.
  -> Char  -- ^ The unicode character that represents the given 'ChessPiece'.
chessPiece :: ChessPiece -> Char
chessPiece (Chess90 ChessColor
c ChessPieceType
Equihopper Rotate90
r) = Int -> Char
chr (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Rotate90 -> Int
forall a. Enum a => a -> Int
fromEnum Rotate90
r) Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ChessColor -> Int
forall a. Enum a => a -> Int
fromEnum ChessColor
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x1fa48)
chessPiece (Chess90 ChessColor
Neutral ChessPieceType
t Rotate90
R0) = Int -> Char
chr (Int
0x1fa00 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. ChessPieceType -> Int
forall a. Enum a => a -> Int
fromEnum ChessPieceType
t)
chessPiece (Chess90 ChessColor
c ChessPieceType
t Rotate90
R0) = Int -> Char
chr (ChessPieceType -> ChessColor -> Int
_chessValue ChessPieceType
t ChessColor
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x2654)
chessPiece (Chess90 ChessColor
c ChessPieceType
t Rotate90
r) = Int -> Char
chr (Int
0x15 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Rotate90 -> Int
forall a. Enum a => a -> Int
fromEnum Rotate90
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ChessPieceType -> ChessColor -> Int
_chessValue ChessPieceType
t ChessColor
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x1f9f4)
chessPiece (Chess45Knight ChessColor
c Rotate45
r) = Int -> Char
chr (Int
0x15 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Rotate45 -> Int
forall a. Enum a => a -> Int
fromEnum Rotate45
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ChessColor -> Int
forall a. Enum a => a -> Int
fromEnum ChessColor
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x1fa06)
chessPiece (ChessHybrid ChessHybridType
t ChessColorBinary
c) = Int -> Char
chr (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ChessColorBinary -> Int
forall a. Enum a => a -> Int
fromEnum ChessColorBinary
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ChessHybridType -> Int
forall a. Enum a => a -> Int
fromEnum ChessHybridType
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x1fa4e)