-- | Chu Shogi pieces -- Copyright 2009 Colin Adams -- -- This file is part of chu-shogi. -- -- Chu-shogi is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- Chu-shogi is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- You should have received a copy of the GNU General Public License -- along with chu-shogi. If not, see . module Piece ( -- * Types Direction (..), Piece (..), Promotion_status (..), Piece_type (..), Piece_colour (..), -- * Creation piece_from_abbreviation, -- * Access opposite_colour, abbreviation, range, jump, promotion, promoted_piece, piece_value, positional_piece_value, -- * Status report is_northerly, is_lion, is_king, has_promotion, is_compulsory_promotion, -- * Output svg_for_pieces ) where import Control.Exception (assert) import Graphics.Rendering.Cairo.SVG import Data.Map import Coordinate -- | Directions of movement data Direction = North | East | South | West | North_east | South_east | South_west | North_west deriving (Eq, Enum) -- | Eligibility for promotion data Promotion_status = Not_yet_promoted -- ^ Piece still has option to promote | No_promotion -- ^ Piece can never promote | Declined_to_promote -- ^ Piece has declined to promote - may not promote for now, unless capturing (and is not a Pawn) | May_promote -- ^ Piece has declined to promote, but may again promote deriving (Eq, Show) -- | A Chu Shogi piece data Piece = Piece {piece_type :: Piece_type, -- ^ e.g. King, Pawn, etc. piece_colour :: Piece_colour -- ^ Which player does it belong to? } deriving (Eq, Ord, Show) -- | Designation of a player and owner of pieces data Piece_colour = Black -- ^ First player in even games | White -- ^ Second player in even games (and technically in handicap games too - Black's first move is to take the handicap) deriving (Eq, Ord, Show) -- | Classification of piece data Piece_type = Lance | Reverse_chariot | Side_mover | Vertical_mover | White_horse | Rook | Gold_general | Copper_general | Silver_general | Bishop | King | Drunk_elephant | Crown_prince | Promoted_rook | Promoted_gold_general | Promoted_silver_general | Promoted_copper_general | Promoted_bishop | Ferocious_leopard | Phoenix | Kylin | Lion | Free_king | Promoted_phoenix | Promoted_kylin | Blind_tiger | Flying_stag | Flying_ox | Whale | Promoted_ferocious_leopard | Free_boar | Dragon_horse | Dragon_king | Horned_falcon | Soaring_eagle | Pawn | Go_between | Promoted_pawn | Promoted_go_between deriving (Eq, Ord, Show) -- | Creates a piece given it's standard TSA abbreviation piece_from_abbreviation :: String -> Maybe Piece_type piece_from_abbreviation abbrev = Data.Map.lookup abbrev abbreviation_map opposite_colour :: Piece_colour -> Piece_colour opposite_colour colour = case colour of Black -> White White -> Black {-# contract abbreviation :: Ok -> NonNull #-} -- | Standard TSA abbreviation abbreviation :: Piece_type -> String abbreviation piece = case piece of Lance -> "L" Reverse_chariot -> "RC" Side_mover -> "SM" Vertical_mover -> "VM" White_horse -> "+L" Rook -> "R" Gold_general -> "G" Copper_general -> "C" Silver_general -> "S" Bishop -> "B" King -> "K" Drunk_elephant -> "DE" Crown_prince -> "+DE" Promoted_rook -> "+R" Promoted_gold_general -> "+G" Promoted_silver_general -> "+S" Promoted_copper_general -> "+C" Promoted_bishop -> "+B" Ferocious_leopard -> "FL" Phoenix -> "Ph" Kylin -> "Ky" Lion -> "Ln" Free_king -> "FK" Promoted_phoenix -> "+Ph" Promoted_kylin -> "+Ky" Blind_tiger -> "BT" Flying_stag -> "+BT" Flying_ox -> "+VM" Whale -> "+RC" Promoted_ferocious_leopard -> "+FL" Free_boar -> "+SM" Dragon_horse -> "DH" Dragon_king -> "DK" Horned_falcon -> "+DH" Soaring_eagle -> "+DK" Pawn -> "P" Go_between -> "GB" Promoted_pawn -> "+P" Promoted_go_between -> "+GB" {-# contract range :: Ok -> Ok -> {r | r >= 0 && r <= 11 } #-} -- | Number of squares piece is capable of miving on an empty board in direction range :: Piece_type -> Direction -> Int range piece direction = case direction of South -> southern_range piece North -> northern_range piece East -> lateral_range piece West -> lateral_range piece North_east -> northern_diagonal_range piece North_west -> northern_diagonal_range piece South_east -> southern_diagonal_range piece South_west -> southern_diagonal_range piece -- | Does piece have a two-space jumping capability towards direction? jump :: Piece_type -> Direction -> Bool jump piece direction = case direction of South -> cardinal_jump piece North -> cardinal_jump piece East -> cardinal_jump piece West -> cardinal_jump piece North_east -> diagonal_jump piece North_west -> diagonal_jump piece South_east -> diagonal_jump piece South_west -> diagonal_jump piece {-# contract promotion :: {p | has_promotion (piece_type p)} -> {r | (piece_type r /= piece_type p) && (not has_promotion (piece_type r))} #-} -- | Promoted version of piece promotion :: Piece -> Piece promotion piece = case piece_type piece of Lance -> piece {piece_type = White_horse} Reverse_chariot -> piece {piece_type = Whale} Side_mover -> piece {piece_type = Free_boar} Vertical_mover -> piece {piece_type = Flying_ox} Rook -> piece {piece_type = Promoted_rook} Gold_general -> piece {piece_type = Promoted_gold_general} Silver_general -> piece {piece_type = Promoted_silver_general} Copper_general -> piece {piece_type = Promoted_copper_general} Bishop -> piece {piece_type = Promoted_bishop} Drunk_elephant -> piece {piece_type = Crown_prince} Ferocious_leopard -> piece {piece_type = Promoted_ferocious_leopard} Phoenix -> piece {piece_type = Promoted_phoenix} Kylin -> piece {piece_type = Promoted_kylin} Blind_tiger -> piece {piece_type = Flying_stag} Dragon_horse -> piece {piece_type = Horned_falcon} Dragon_king -> piece {piece_type = Soaring_eagle} Pawn -> piece {piece_type = Promoted_pawn} Go_between -> piece {piece_type = Promoted_go_between} {-# contract promoted_piece :: {piece | True} -> {status -> True} -> {eligible | not eligible || has_promotion (piece_type piece)} -> {promoting | not promoting || (eligible && (status == Not_yet_promoted || status == May_promote))} -> {source_rank | source_rank >= 0 && source_rank <= 11} -> {source_file | source_file >= 0 && source_file <= 11} -> {target_rank | target_rank >= 0 && target_rank <= 11} -> {target_file | target_file >= 0 && target_file <= 11 && (promoting || not (is_compulsory_promotion piece new_coordinate (target_rank target_file)))} -> {result@(p', s')} | p' == piece || s' == No_promotion} #-} -- | (Possibly promoted) piece with updated promotion status after single move -- -- This is called even when the piece is not eligible to promote, -- as the promotion status may change. -- -- N.B. All pieces that can make a double move never promote, so don't use this routine. -- TODO: make a function for this to include in contract. promoted_piece :: Piece -- ^ Initial piece -> Promotion_status -- ^ Initial status -> Bool -- ^ Do the rules say the piece may promote? -> Bool -- ^ Has the player chosen (or been forced) to promote? -> (Piece, Promotion_status) promoted_piece piece status eligible promoting = case promoting of True -> assert (has_promotion . piece_type $ piece) (promotion piece, No_promotion) False -> let st' = case status of May_promote -> status Declined_to_promote -> case piece_type piece of Pawn -> status -- Only a compulsory promotion can change the state _ -> May_promote No_promotion -> status Not_yet_promoted -> case eligible of True -> Declined_to_promote False -> status in (piece, st') {-# contract positional_piece_value :: {rank' | rank' >= 0 && rank' <= 11} -> {file' | file' >= 0 && file' <= 11} -> Ok -> Ok #-} -- | Value of piece adjusted for location on board positional_piece_value :: Int -> Int -> Piece -> Int positional_piece_value rank' file' piece = let v = case piece_type piece of Pawn -> positional_pawn_value rank' file' Side_mover -> positional_side_mover_value rank' Silver_general -> positional_silver_general_value rank' file' Gold_general -> positional_gold_general_value rank' file' Copper_general -> positional_copper_general_value rank' file' Blind_tiger -> positional_blind_tiger_value rank' file' Dragon_horse -> positional_dragon_horse_value rank' file' Dragon_king -> positional_dragon_king_value rank' file' Drunk_elephant -> positional_drunk_elephant_value rank' file' Ferocious_leopard -> positional_ferocious_leopard_value rank' file' Kylin -> positional_kylin_value rank' file' Phoenix -> positional_phoenix_value rank' file' Lion -> positional_lion_value rank' file' Promoted_kylin -> positional_lion_value rank' file' Free_king -> positional_free_king_value rank' _ -> 0 in piece_value piece + case piece_colour piece of Black -> v White -> - v -- | Nominal value of piece piece_value :: Piece -> Int piece_value piece = let v = case piece_type piece of Pawn -> 1000 Go_between -> 800 King -> 6500 Promoted_pawn -> 2700 Crown_prince -> 6500 Lance -> 7200 Reverse_chariot -> 7500 Side_mover -> 8500 Vertical_mover -> 10500 Silver_general -> 3500 Gold_general -> 6000 Copper_general -> 2600 Bishop -> 10800 Rook -> 12000 Blind_tiger -> 3800 Dragon_horse -> 15000 Dragon_king -> 15500 Drunk_elephant -> 5800 Ferocious_leopard -> 4000 Free_king -> 17000 Kylin -> 8600 Phoenix -> 11800 Lion -> 40000 Flying_stag -> 8500 Flying_ox -> 14000 Free_boar -> 13500 Horned_falcon -> 16000 Soaring_eagle -> 16500 Whale -> 8000 White_horse -> 8200 Promoted_bishop -> 11500 Promoted_copper_general -> 5000 Promoted_ferocious_leopard -> 5600 Promoted_go_between -> 2800 Promoted_gold_general -> 9500 Promoted_kylin -> 40000 Promoted_phoenix -> 17000 Promoted_rook -> 12600 Promoted_silver_general -> 5400 in case piece_colour piece of Black -> v White -> - v -- | Is piece subject to the special rules for Lions? is_lion :: Piece_type -> Bool is_lion piece = case piece of Lion -> True Promoted_kylin -> True _ -> False -- | Is dir vaguely North-heading? is_northerly :: Direction -> Bool is_northerly dir = case dir of North -> True North_east -> True North_west -> True _ -> False -- | Is piece a monarch? I.e. does it affect victory conditions? is_king :: Piece -> Bool is_king piece = case piece_type piece of King -> True Crown_prince -> True _ -> False -- | If piece is moved to target, is it forced to promote? is_compulsory_promotion :: Piece -> Coordinate -> Bool is_compulsory_promotion piece target = let r = case piece_colour piece of White -> rank target Black -> 11 - (rank target) in case piece_type piece of p | p == Lance || p == Pawn -> r == 11 | otherwise -> False -- | Is piece a type that promotes? has_promotion :: Piece_type -> Bool has_promotion piece = piece `elem` promotable_types -- | Map of pieces to their SVG images svg_for_pieces :: IO (Map Piece SVG) svg_for_pieces = do svg_list <- mapM read_svg_from_file svg_file_mappings return (fromList svg_list) -- Implementation follows: {-# contract promotable_types :: NonNull #-} promotable_types :: [Piece_type] promotable_types = [Lance, Reverse_chariot, Side_mover, Vertical_mover, Rook, Gold_general, Copper_general, Silver_general, Bishop, Drunk_elephant, Ferocious_leopard, Phoenix, Kylin, Blind_tiger, Dragon_horse, Dragon_king, Pawn, Go_between] {-# contract northern_range :: Ok -> {r | r >= 0 || r <= 11} #-} northern_range :: Piece_type -> Int northern_range piece | piece `elem` [Lance, Reverse_chariot, Vertical_mover, White_horse, Rook, Promoted_rook, Promoted_gold_general, Promoted_silver_general, Free_king, Promoted_phoenix, Flying_stag, Flying_ox, Whale, Dragon_king, Soaring_eagle] = 11 | piece `elem` [Bishop, Kylin, Lion, Promoted_kylin, Blind_tiger, Promoted_ferocious_leopard, Free_boar, Horned_falcon] = 0 | otherwise = 1 {-# contract southern_range :: Ok -> {r | r >= 0 || r <= 11} #-} southern_range :: Piece_type -> Int southern_range piece | piece `elem` [Reverse_chariot, Vertical_mover, White_horse, Rook, Promoted_rook, Promoted_gold_general, Promoted_silver_general, Free_king, Promoted_phoenix, Flying_stag, Flying_ox, Whale, Dragon_king, Horned_falcon, Soaring_eagle] = 11 | piece `elem` [Lance, Silver_general, Bishop, Drunk_elephant, Kylin, Lion, Promoted_kylin, Promoted_ferocious_leopard, Pawn, Promoted_go_between] = 0 | otherwise = 1 {-# contract lateral_range :: Ok -> {r | r >= 0 || r <= 11} #-} lateral_range :: Piece_type -> Int lateral_range piece | piece `elem` [Side_mover, Rook, Promoted_rook, Promoted_gold_general, Promoted_copper_general, Free_king, Promoted_phoenix, Free_boar, Dragon_king, Horned_falcon, Soaring_eagle] = 11 | piece `elem` [Gold_general, King, Drunk_elephant, Crown_prince, Vertical_mover, Promoted_silver_general, Promoted_bishop, Phoenix, Blind_tiger, Flying_stag, Dragon_horse, Promoted_pawn, Promoted_go_between] = 1 | otherwise = 0 {-# contract northern_diagonal_range :: Ok -> {r | r >= 0 || r <= 11} #-} northern_diagonal_range :: Piece_type -> Int northern_diagonal_range piece | piece `elem` [White_horse, Bishop, Promoted_bishop, Free_king, Promoted_phoenix, Flying_ox, Promoted_ferocious_leopard, Free_boar, Dragon_horse, Horned_falcon] = 11 | piece `elem` [Gold_general, Copper_general, Silver_general, King, Drunk_elephant, Crown_prince, Promoted_rook, Ferocious_leopard, Kylin, Blind_tiger, Flying_stag, Dragon_king, Promoted_pawn, Promoted_go_between] = 1 | otherwise = 0 {-# contract southern_diagonal_range :: Ok -> {r | r >= 0 || r <= 11} #-} southern_diagonal_range :: Piece_type -> Int southern_diagonal_range piece | piece `elem` [Bishop, Promoted_bishop, Free_king, Promoted_phoenix, Flying_ox, Whale, Promoted_ferocious_leopard, Free_boar, Dragon_horse, Horned_falcon, Soaring_eagle] = 11 | piece `elem` [Silver_general, King, Drunk_elephant, Crown_prince, Promoted_rook, Ferocious_leopard, Kylin, Blind_tiger, Flying_stag, Dragon_king, Promoted_go_between] = 1 | otherwise = 0 cardinal_jump :: Piece_type -> Bool cardinal_jump piece = case piece of Kylin -> True _ -> False diagonal_jump :: Piece_type -> Bool diagonal_jump piece = case piece of Phoenix -> True _ -> False read_svg_from_file :: (Piece, FilePath) -> IO (Piece, SVG) read_svg_from_file (piece, file_path) = do svg <- svgNewFromFile file_path return (piece, svg) svg_file_mappings :: [(Piece, FilePath)] svg_file_mappings = [(Piece Rook Black, "images/rook.svg"), (Piece Lance Black, "images/lance.svg"), (Piece Reverse_chariot Black, "images/reverse_chariot.svg" ), (Piece Side_mover Black, "images/side_mover.svg"), (Piece Vertical_mover Black, "images/vertical_mover.svg"), (Piece White_horse Black, "images/white_horse.svg"), (Piece Gold_general Black, "images/gold_general.svg"), (Piece Copper_general Black, "images/copper_general.svg"), (Piece Silver_general Black, "images/silver_general.svg"), (Piece Bishop Black, "images/bishop.svg"), (Piece King Black, "images/king.svg"), (Piece Drunk_elephant Black, "images/drunk_elephant.svg"), (Piece Crown_prince Black, "images/crown_prince.svg"), (Piece Promoted_rook Black, "images/promoted_rook.svg"), (Piece Promoted_gold_general Black, "images/promoted_gold_general.svg"), (Piece Promoted_silver_general Black, "images/promoted_silver_general.svg"), (Piece Promoted_copper_general Black, "images/promoted_copper_general.svg"), (Piece Promoted_bishop Black, "images/promoted_bishop.svg"), (Piece Ferocious_leopard Black, "images/ferocious_leopard.svg"), (Piece Phoenix Black, "images/phoenix.svg"), (Piece Kylin Black, "images/kylin.svg"), (Piece Lion Black, "images/lion.svg"), (Piece Free_king Black, "images/free_king.svg"), (Piece Promoted_phoenix Black, "images/promoted_phoenix.svg"), (Piece Promoted_kylin Black, "images/promoted_kylin.svg"), (Piece Blind_tiger Black, "images/blind_tiger.svg"), (Piece Flying_stag Black, "images/flying_stag.svg"), (Piece Flying_ox Black, "images/flying_ox.svg"), (Piece Whale Black, "images/whale.svg"), (Piece Promoted_ferocious_leopard Black, "images/promoted_ferocious_leopard.svg"), (Piece Free_boar Black, "images/free_boar.svg"), (Piece Dragon_horse Black, "images/dragon_horse.svg"), (Piece Dragon_king Black, "images/dragon_king.svg"), (Piece Horned_falcon Black, "images/horned_falcon.svg"), (Piece Soaring_eagle Black, "images/soaring_eagle.svg"), (Piece Pawn Black, "images/pawn.svg"), (Piece Go_between Black, "images/go_between.svg"), (Piece Promoted_pawn Black, "images/promoted_pawn.svg"), (Piece Promoted_go_between Black, "images/promoted_go_between.svg"), (Piece Rook White, "images/w_rook.svg"), (Piece Lance White, "images/w_lance.svg"), (Piece Reverse_chariot White, "images/w_reverse_chariot.svg" ), (Piece Side_mover White, "images/w_side_mover.svg"), (Piece Vertical_mover White, "images/w_vertical_mover.svg"), (Piece White_horse White, "images/w_white_horse.svg"), (Piece Gold_general White, "images/w_gold_general.svg"), (Piece Copper_general White, "images/w_copper_general.svg"), (Piece Silver_general White, "images/w_silver_general.svg"), (Piece Bishop White, "images/w_bishop.svg"), (Piece King White, "images/w_king.svg"), (Piece Drunk_elephant White, "images/w_drunk_elephant.svg"), (Piece Crown_prince White, "images/w_crown_prince.svg"), (Piece Promoted_rook White, "images/w_promoted_rook.svg"), (Piece Promoted_gold_general White, "images/w_promoted_gold_general.svg"), (Piece Promoted_silver_general White, "images/w_promoted_silver_general.svg"), (Piece Promoted_copper_general White, "images/w_promoted_copper_general.svg"), (Piece Promoted_bishop White, "images/w_promoted_bishop.svg"), (Piece Ferocious_leopard White, "images/w_ferocious_leopard.svg"), (Piece Phoenix White, "images/w_phoenix.svg"), (Piece Kylin White, "images/w_kylin.svg"), (Piece Lion White, "images/w_lion.svg"), (Piece Free_king White, "images/w_free_king.svg"), (Piece Promoted_phoenix White, "images/w_promoted_phoenix.svg"), (Piece Promoted_kylin White, "images/w_promoted_kylin.svg"), (Piece Blind_tiger White, "images/w_blind_tiger.svg"), (Piece Flying_stag White, "images/w_flying_stag.svg"), (Piece Flying_ox White, "images/w_flying_ox.svg"), (Piece Whale White, "images/w_whale.svg"), (Piece Promoted_ferocious_leopard White, "images/w_promoted_ferocious_leopard.svg"), (Piece Free_boar White, "images/w_free_boar.svg"), (Piece Dragon_horse White, "images/w_dragon_horse.svg"), (Piece Dragon_king White, "images/w_dragon_king.svg"), (Piece Horned_falcon White, "images/w_horned_falcon.svg"), (Piece Soaring_eagle White, "images/w_soaring_eagle.svg"), (Piece Pawn White, "images/w_pawn.svg"), (Piece Go_between White, "images/w_go_between.svg"), (Piece Promoted_pawn White, "images/w_promoted_pawn.svg"), (Piece Promoted_go_between White, "images/w_promoted_go_between.svg")] abbreviation_map :: Map String Piece_type abbreviation_map = fromList [("Ln", Lion), ("L", Lance), ("RC", Reverse_chariot), ("SM", Side_mover), ("VM", Vertical_mover), ("+L", White_horse), ("R", Rook), ("G", Gold_general), ("C", Copper_general), ("S", Silver_general), ("B", Bishop), ("K", King), ("DE", Drunk_elephant), ("+DE", Crown_prince), ("+R", Promoted_rook), ("+G", Promoted_gold_general), ("+S", Promoted_silver_general), ("+C", Promoted_copper_general), ("+B", Promoted_bishop), ("FL", Ferocious_leopard), ("Ph", Phoenix), ("Ky", Kylin), ("FK", Free_king), ("+Ph", Promoted_phoenix), ("+Ky", Promoted_kylin), ("BT", Blind_tiger), ("+BT", Flying_stag), ("+VM", Flying_ox), ("+RC", Whale), ("+FL", Promoted_ferocious_leopard), ("+SM", Free_boar), ("DH", Dragon_horse ), ("DK", Dragon_king), ("+DH", Horned_falcon), ("+DK", Soaring_eagle), ("P", Pawn), ("GB", Go_between), ("+P", Promoted_pawn), ("+GB", Promoted_go_between) ] {-# contract positional_pawn_value :: {rank' | rank' >= 3 && rank' < 11} -> {file' | file' >= 0 && file' <= 11} -> Ok #-} -- | Value adjustment for a pawn based solely on its abolute location -- -- Note that pawn's can never exist on ranks 0-2 or 11 positional_pawn_value :: Int -> Int -> Int positional_pawn_value rank' file' = case rank' of 3 -> rank_3_value file' 4 -> 100 5 -> rank_5_value file' 6 -> rank_6_value file' 7 -> 900 8 -> 1000 9 -> 1010 10 -> 1210 where rank_3_value f = case f of 0 -> -90 1 -> -80 2 -> -500 3 -> -500 4 -> -550 5 -> -350 6 -> -300 7 -> -540 8 -> -500 9 -> -500 10 -> -80 11 -> -90 rank_5_value f = case f of 0 -> 90 1 -> 110 2 -> 110 3 -> 110 4 -> 120 5 -> 120 6 -> 120 7 -> 120 8 -> 110 9 -> 110 10 -> 110 11 -> 90 rank_6_value f = case f of 0 -> 100 1 -> 120 2 -> 120 3 -> 120 4 -> 130 5 -> 130 6 -> 130 7 -> 130 8 -> 120 9 -> 120 10 -> 120 11 -> 100 {-# contract positional_kylin_value :: {rank' | rank' >= 0 && rank' <= 11} -> {file' | file' >= 0 && file' <= 11} -> Ok #-} -- | Value adjustment for a kylin based solely on its abolute location positional_kylin_value :: Int -> Int -> Int positional_kylin_value rank' file' = case rank' of 0 -> case file' of 4 -> 200 _ -> 0 1 -> case file' of 3 -> 10 7 -> 100 9 -> 20 _ -> 0 2 -> case file' of 2 -> 20 8 -> 40 _ -> 0 3 -> case file' of 1 -> 190 5 -> 200 7 -> 190 9 -> 190 11 -> 190 _ -> 0 4 -> 210 5 -> case file' of -- only odd files are possible on odd ranks 1 -> 230 3 -> 220 5 -> 220 7 -> 220 9 -> 230 11 -> 220 6 -> 3500 7 -> 8000 _ -> 0 {-# contract positional_side_mover_value :: {rank' | rank' >= 0 && rank' <= 11} -> Ok #-} -- | Value adjustment for a side-mover based solely on its abolute location positional_side_mover_value :: Int -> Int positional_side_mover_value rank' = case rank' of 3 -> 120 -- this should have greater weight if the other side mover is on rank 4 4 -> 250 _ -> 0 {-# contract positional_drunk_elephant_value :: {rank' | rank' >= 0 && rank' <= 11} -> {file' | file' >= 0 && file' <= 11} -> Ok #-} -- | Value adjustment for a drunk-elephant based solely on its abolute location positional_drunk_elephant_value :: Int -> Int -> Int positional_drunk_elephant_value rank' file' = case (rank', file') of (1, 5) -> 140 -- Head of King - but this assumes static King _ -> 0 {-# contract positional_phoenix_value :: {rank' | rank' >= 0 && rank' <= 11} -> {file' | file' >= 0 && file' <= 11} -> Ok #-} -- | Value adjustment for a phoenix based solely on its abolute location positional_phoenix_value :: Int -> Int -> Int positional_phoenix_value rank' file' = case rank' of 3 -> case file' of 4 -> 740 5 -> 700 _ -> 0 4 -> case file' of 4 -> 730 _ -> 0 5 -> case file' of 2 -> 740 3 -> 730 6 -> 740 7 -> 730 _ -> 0 6 -> case file' of 2 -> 860 3 -> 870 6 -> 880 7 -> 920 _ -> 0 7 -> 2000 8 -> 2200 _ -> 0 {-# contract positional_dragon_king_value :: {rank' | rank' >= 0 && rank' <= 11} -> {file' | file' >= 0 && file' <= 11} -> Ok #-} -- | Value adjustment for a dragon_king based solely on its abolute location positional_dragon_king_value :: Int -> Int -> Int positional_dragon_king_value rank' file' = case rank' of 0 -> case file' of 3 -> 150 5 -> 150 6 -> 150 8 -> 150 _ -> 0 1 -> case file' of 0 -> 300 1 -> 300 2 -> 200 9 -> 200 10 -> 300 11 -> 500 _ -> 0 _ -> 0 {-# contract positional_free_king_value :: {rank' | rank' >= 0 && rank' <= 11} -> Ok #-} -- | Value adjustment for a free-king based solely on its abolute location positional_free_king_value :: Int -> Int positional_free_king_value rank' = case rank' of 0 -> 400 _ -> 0 {-# contract positional_dragon_horse_value :: {rank' | rank' >= 0 && rank' <= 11} -> {file' | file' >= 0 && file' <= 11} -> Ok #-} -- | Value adjustment for a dragon-horse based solely on its abolute location positional_dragon_horse_value :: Int -> Int -> Int positional_dragon_horse_value rank' file' = case rank' of 4 -> case file' of 0 -> 560 1 -> 580 2 -> 570 3 -> 580 4 -> 490 5 -> 490 6 -> 490 7 -> 490 8 -> 580 9 -> 570 10 -> 580 11 -> 560 5 -> case file' of 0 -> 570 1 -> 590 2 -> 580 3 -> 580 4 -> 570 5 -> 570 6 -> 570 7 -> 570 8 -> 580 9 -> 580 10 -> 590 11 -> 570 6 -> case file' of 0 -> 570 1 -> 580 2 -> 580 3 -> 580 4 -> 570 5 -> 570 6 -> 570 7 -> 570 8 -> 580 9 -> 580 10 -> 580 11 -> 570 7 -> 580 8 -> 580 _ -> 0 {-# contract positional_lion_value :: {rank' | rank' >= 0 && rank' <= 11} -> {file' | file' >= 0 && file' <= 11} -> Ok #-} -- | Value adjustment for a lion based solely on its abolute location -- -- This is only got start of game. But for now it is used throughout. positional_lion_value :: Int -> Int -> Int positional_lion_value rank' file' = case rank' of 0 -> rank_0_value file' 1 -> rank_1_value file' 2 -> rank_2_value file' 3 -> rank_3_value file' 4 -> rank_4_value file' 5 -> rank_5_value file' 6 -> rank_6_value file' 7 -> rank_7_value file' 8 -> rank_8_value file' 9 -> rank_9_value file' 10 -> rank_10_value file' 11 -> rank_11_value file' where rank_0_value f = case f of 0 -> -5000 1 -> -4500 2 -> -4000 3 -> -3500 4 -> -3000 5 -> -3000 6 -> -3000 7 -> -3050 8 -> -3550 9 -> -4050 10 -> -4550 11 -> -5050 rank_1_value f = case f of 0 -> -4000 1 -> -3500 2 -> -3000 3 -> -2500 4 -> -2000 5 -> -1500 6 -> -1550 7 -> -2050 8 -> -2550 9 -> -3050 10 -> -3550 11 -> -4050 rank_2_value f = case f of 0 -> -3000 1 -> -2500 2 -> -1500 3 -> -1000 4 -> -100 5 -> 0 6 -> 0 7 -> -50 8 -> -950 9 -> -1450 10 -> -2350 11 -> -2750 rank_3_value f = case f of 0 -> -1000 1 -> -800 2 -> -500 3 -> 120 4 -> 50 5 -> -2100 6 -> 200 7 -> 120 8 -> 50 9 -> -400 10 -> -650 11 -> -850 rank_4_value f = case f of 0 -> 200 1 -> 350 2 -> 450 3 -> 550 4 -> 350 5 -> 700 6 -> 750 7 -> 700 8 -> 600 9 -> 500 10 -> 400 11 -> 250 rank_5_value f = case f of 0 -> 350 1 -> 450 2 -> 550 3 -> 700 4 -> 750 5 -> 1500 6 -> 1501 7 -> 850 8 -> 750 9 -> 650 10 -> 550 11 -> 400 rank_6_value f = case f of 0 -> 500 1 -> 600 2 -> 500 3 -> 760 4 -> 800 5 -> 900 6 -> 1000 7 -> 950 8 -> 860 9 -> 800 10 -> 700 11 -> 550 rank_7_value f = case f of 0 -> 700 1 -> 860 2 -> 1000 3 -> 1100 4 -> 1200 5 -> 1520 6 -> 1600 7 -> 1550 8 -> 1520 9 -> 1510 10 -> 900 11 -> 750 rank_8_value f = case f of 0 -> 850 1 -> 900 2 -> 1500 3 -> 2000 4 -> 2100 5 -> 2300 6 -> 2400 7 -> 2450 8 -> 2350 9 -> 2300 10 -> 1800 11 -> 880 rank_9_value f = case f of 0 -> 880 1 -> 1350 2 -> 1850 3 -> 2200 4 -> 3500 5 -> 3900 6 -> 3800 7 -> 3650 8 -> 3400 9 -> 2400 10 -> 2300 11 -> 1750 rank_10_value f = case f of 0 -> 870 1 -> 900 2 -> 1450 3 -> 1900 4 -> 2500 5 -> 3500 6 -> 3500 7 -> 3450 8 -> 3300 9 -> 2350 10 -> 2000 11 -> 1700 rank_11_value f = case f of 0 -> 700 1 -> 800 2 -> 1350 3 -> 1800 4 -> 2150 5 -> 3000 6 -> 3000 7 -> 2500 8 -> 2400 9 -> 2300 10 -> 1750 11 -> 1600 {-# contract positional_copper_general_value :: {rank' | rank' >= 0 && rank' <= 11} -> {file' | file' >= 0 && file' <= 11} -> Ok #-} -- | Value adjustment for a copper-general based solely on its abolute location -- -- This is only got start of game. But for now it is used throughout. positional_copper_general_value :: Int -> Int -> Int positional_copper_general_value rank' file' = case rank' of 0 -> rank_0_value file' 1 -> rank_1_value file' 2 -> rank_2_value file' 3 -> rank_3_value file' 4 -> rank_4_value file' 5 -> rank_5_value file' 6 -> rank_6_value file' 7 -> 2000 8 -> rank_8_value file' 9 -> rank_9_value file' 10 -> rank_10_value file' 11 -> rank_11_value file' where rank_0_value f = case f of 0 -> -200 1 -> -100 10 -> -100 11 -> -200 _ -> 0 rank_2_value f = case f of 0 -> 100 1 -> 200 2 -> 300 5 -> 600 6 -> 600 9 -> 200 10 -> 200 11 -> 100 _ -> 500 rank_1_value f = case f of 0 -> 0 3 -> 290 5 -> 400 6 -> 400 8 -> 290 11 -> 0 _ -> 200 rank_3_value f = case f of 0 -> 250 3 -> 600 4 -> 750 5 -> 800 6 -> 800 7 -> 750 8 -> 600 11 -> 250 _ -> 350 rank_4_value f = case f of 0 -> 340 1 -> 580 2 -> 560 3 -> 700 4 -> 810 5 -> 850 6 -> 850 7 -> 810 8 -> 720 9 -> 580 10 -> 600 11 -> 340 rank_5_value f = case f of 0 -> 400 1 -> 600 2 -> 600 3 -> 800 4 -> 900 5 -> 950 6 -> 950 7 -> 910 8 -> 800 9 -> 620 10 -> 620 11 -> 400 rank_6_value f = case f of 0 -> 1600 1 -> 1650 2 -> 1700 3 -> 1750 4 -> 1800 5 -> 1810 6 -> 1810 7 -> 1800 8 -> 1760 9 -> 1710 10 -> 1660 11 -> 1600 rank_8_value f = case f of 0 -> 2010 1 -> 2030 2 -> 2050 3 -> 2080 4 -> 2100 5 -> 2200 6 -> 2200 7 -> 2100 8 -> 2090 9 -> 2070 10 -> 2040 11 -> 2010 rank_9_value f = case f of 0 -> 2030 1 -> 2050 2 -> 2100 3 -> 2200 4 -> 2250 5 -> 2250 6 -> 2300 7 -> 2250 8 -> 2200 9 -> 2100 10 -> 2050 11 -> 2030 rank_10_value f = case f of 0 -> 2060 1 -> 2080 2 -> 2150 3 -> 2300 4 -> 2350 5 -> 2350 6 -> 2300 7 -> 2250 8 -> 3300 9 -> 2150 10 -> 2000 11 -> 2060 rank_11_value f = case f of 0 -> 2000 1 -> 2040 2 -> 2050 3 -> 2100 4 -> 2200 5 -> 2250 6 -> 2250 7 -> 2200 8 -> 2100 9 -> 2050 10 -> 2040 11 -> 2000 {-# contract positional_silver_general_value :: {rank' | rank' >= 0 && rank' <= 11} -> {file' | file' >= 0 && file' <= 11} -> Ok #-} -- | Value adjustment for a silver-general based solely on its abolute location -- -- This is only got start of game. But for now it is used throughout. positional_silver_general_value :: Int -> Int -> Int positional_silver_general_value rank' file' = case rank' of 0 -> rank_0_value file' 1 -> rank_1_value file' 2 -> rank_2_value file' 3 -> rank_3_value file' 4 -> rank_4_value file' 5 -> rank_5_value file' 6 -> rank_6_value file' 7 -> 2000 8 -> rank_8_value file' 9 -> rank_9_value file' 10 -> rank_10_value file' 11 -> rank_11_value file' where rank_0_value f = case f of 0 -> -200 1 -> -100 10 -> -100 11 -> -200 _ -> 0 rank_2_value f = case f of 0 -> 100 1 -> 200 2 -> 300 5 -> 600 6 -> 600 9 -> 200 10 -> 200 11 -> 100 _ -> 500 rank_1_value f = case f of 0 -> 0 3 -> 280 5 -> 400 6 -> 400 8 -> 280 11 -> 0 _ -> 200 rank_3_value f = case f of 0 -> 250 3 -> 600 4 -> 750 5 -> 800 6 -> 800 7 -> 750 8 -> 600 11 -> 250 _ -> 350 rank_4_value f = case f of 0 -> 340 1 -> 580 2 -> 560 3 -> 700 4 -> 850 5 -> 810 6 -> 810 7 -> 850 8 -> 720 9 -> 580 10 -> 600 11 -> 340 rank_5_value f = case f of 0 -> 400 1 -> 600 2 -> 600 3 -> 800 4 -> 950 5 -> 900 6 -> 900 7 -> 960 8 -> 800 9 -> 620 10 -> 620 11 -> 400 rank_6_value f = case f of 0 -> 1600 1 -> 1650 2 -> 1700 3 -> 1750 4 -> 1800 5 -> 1810 6 -> 1810 7 -> 1800 8 -> 1760 9 -> 1710 10 -> 1660 11 -> 1600 rank_8_value f = case f of 0 -> 2010 1 -> 2030 2 -> 2050 3 -> 2080 4 -> 2100 5 -> 2200 6 -> 2200 7 -> 2100 8 -> 2090 9 -> 2070 10 -> 2040 11 -> 2010 rank_9_value f = case f of 0 -> 2030 1 -> 2050 2 -> 2100 3 -> 2200 4 -> 2250 5 -> 2250 6 -> 2300 7 -> 2250 8 -> 2200 9 -> 2100 10 -> 2050 11 -> 2030 rank_10_value f = case f of 0 -> 2060 1 -> 2080 2 -> 2150 3 -> 2300 4 -> 2350 5 -> 2350 6 -> 2300 7 -> 2250 8 -> 3300 9 -> 2150 10 -> 2000 11 -> 2060 rank_11_value f = case f of 0 -> 2000 1 -> 2040 2 -> 2050 3 -> 2100 4 -> 2200 5 -> 2250 6 -> 2250 7 -> 2200 8 -> 2100 9 -> 2050 10 -> 2040 11 -> 2000 {-# contract positional_gold_general_value :: {rank' | rank' >= 0 && rank' <= 11} -> {file' | file' >= 0 && file' <= 11} -> Ok #-} -- | Value adjustment for a gold-general based solely on its abolute location -- -- This is only got start of game. But for now it is used throughout. positional_gold_general_value :: Int -> Int -> Int positional_gold_general_value rank' file' = case rank' of 1 -> case file' of 3 -> 50 4 -> 60 5 -> 30 6 -> 30 8 -> 50 _ -> 0 _ -> 0 {-# contract positional_blind_tiger_value :: {rank' | rank' >= 0 && rank' <= 11} -> {file' | file' >= 0 && file' <= 11} -> Ok #-} -- | Value adjustment for a blind-tiger based solely on its abolute location -- -- This is only got start of game. But for now it is used throughout. positional_blind_tiger_value :: Int -> Int -> Int positional_blind_tiger_value rank' file' = case rank' of 0 -> case file' of 4 -> 40 6 -> 40 _ -> 0 1 -> case file' of 6 -> 20 _ -> 0 _ -> 0 {-# contract positional_ferocious_leopard_value :: {rank' | rank' >= 0 && rank' <= 11} -> {file' | file' >= 0 && file' <= 11} -> Ok #-} -- | Value adjustment for a ferocious-leopard based solely on its abolute location -- -- This is only got start of game. But for now it is used throughout. positional_ferocious_leopard_value :: Int -> Int -> Int positional_ferocious_leopard_value rank' file' = case rank' of 0 -> rank_0_value file' 1 -> rank_1_value file' 2 -> rank_2_value file' 3 -> rank_3_value file' 4 -> rank_4_value file' 5 -> rank_5_value file' 6 -> rank_6_value file' 7 -> 2000 8 -> rank_8_value file' 9 -> rank_9_value file' 10 -> rank_10_value file' 11 -> rank_11_value file' where rank_0_value f = case f of 0 -> -200 11 -> -200 _ -> 0 rank_2_value f = case f of 0 -> 100 1 -> 200 2 -> 300 3 -> 310 5 -> 600 6 -> 600 8 -> 310 9 -> 300 10 -> 300 11 -> 100 _ -> 500 rank_1_value f = case f of 0 -> 0 3 -> 280 4 -> 200 5 -> 400 6 -> 400 7 -> 200 8 -> 280 11 -> 0 _ -> 80 rank_3_value f = case f of 0 -> 250 3 -> 600 4 -> 750 5 -> 800 6 -> 800 7 -> 750 8 -> 600 11 -> 250 _ -> 350 rank_4_value f = case f of 0 -> 340 1 -> 580 2 -> 560 3 -> 700 4 -> 850 5 -> 810 6 -> 810 7 -> 850 8 -> 720 9 -> 580 10 -> 600 11 -> 340 rank_5_value f = case f of 0 -> 400 1 -> 600 2 -> 600 3 -> 800 4 -> 950 5 -> 900 6 -> 900 7 -> 960 8 -> 800 9 -> 620 10 -> 620 11 -> 400 rank_6_value f = case f of 0 -> 1600 1 -> 1650 2 -> 1700 3 -> 1750 4 -> 1800 5 -> 1810 6 -> 1810 7 -> 1800 8 -> 1760 9 -> 1710 10 -> 1660 11 -> 1600 rank_8_value f = case f of 0 -> 2010 1 -> 2030 2 -> 2050 3 -> 2080 4 -> 2100 5 -> 2200 6 -> 2200 7 -> 2100 8 -> 2090 9 -> 2070 10 -> 2040 11 -> 2010 rank_9_value f = case f of 0 -> 2030 1 -> 2050 2 -> 2100 3 -> 2200 4 -> 2250 5 -> 2250 6 -> 2300 7 -> 2250 8 -> 2200 9 -> 2100 10 -> 2050 11 -> 2030 rank_10_value f = case f of 0 -> 2060 1 -> 2080 2 -> 2150 3 -> 2300 4 -> 2350 5 -> 2350 6 -> 2300 7 -> 2250 8 -> 3300 9 -> 2150 10 -> 2000 11 -> 2060 rank_11_value f = case f of 0 -> 2000 1 -> 2040 2 -> 2050 3 -> 2100 4 -> 2200 5 -> 2250 6 -> 2250 7 -> 2200 8 -> 2100 9 -> 2050 10 -> 2040 11 -> 2000