1 
    2 
    3 
    4 
    5 
    6 
    7 
    8 
    9 
   10 
   11 
   12 module ChessSetArray(Tile,
   13                    ChessSet,
   14                    createBoard,
   15                    sizeBoard,
   16                    addPiece,
   17                    deleteFirst,
   18                    noPieces,
   19                    positionPiece,
   20                    lastPiece,
   21                    firstPiece,
   22                    pieceAtTile,
   23                    isSquareFree
   24 ) where
   25 
   26 
   27 
   28 
   29 
   30 
   31 
   32 
   33 
   34 
   35 
   36 
   37 
   38 
   39 
   40 
   41 
   42 
   43 
   44 
   45 
   46 
   47 
   48 
   49 
   50 
   51 import Array
   52 import Sort(quickSort)
   53 
   54 type Tile     = (Int,Int)
   55 data ChessSet = Board Int Int Tile Tile (Array Int Int)
   56 
   57 
   58 
   59 
   60 
   61 
   62 
   63 
   64 
   65 
   66 
   67 instance Eq ChessSet where
   68     _ == _ = True
   69 
   70 instance Ord ChessSet where
   71     _ <= _ = True                  
   72 
   73 instance Show ChessSet where
   74    showsPrec p board@(Board s n l f ts) 
   75       = showString "Move number " . (showsPrec p n).
   76         showString "\n" . showString (printBoard s (elems ts) 1)
   77 
   78 
   79 
   80 
   81 
   82 createBoard::Int -> Tile -> ChessSet
   83 createBoard x t = Board x 1 t t onlyFirst
   84                   where
   85                      onlyFirst = empty // [(tileIndex x t, 1)]
   86                      empty     = array (1,x*x) [ (i,0) | i<-[1..x*x]]
   87 
   88 sizeBoard::ChessSet -> Int
   89 sizeBoard (Board s _ _ _ _) = s
   90 
   91 noPieces::ChessSet -> Int 
   92 noPieces (Board _ n _ _ _) = n
   93 
   94 addPiece::Tile -> ChessSet -> ChessSet
   95 addPiece t (Board s n l f ts) =Board s (n+1) t f 
   96                                     (ts // [(tileIndex s t, n+1)])
   97 
   98 
   99 
  100 
  101 
  102 
  103 
  104 
  105 deleteFirst::ChessSet -> ChessSet
  106 deleteFirst (Board s n l f ts) = Board s n l l 
  107                                        (ts // [(tileIndex s f, 0)])
  108 
  109 
  110 
  111 
  112 
  113 positionPiece::Int -> ChessSet -> Tile
  114 positionPiece x (Board s _ _ _ ts) 
  115    = findPiece x ts [ i | i<-[1..s*s] ]
  116      where
  117         findPiece x ts []     = error "Piece not found"
  118         findPiece x ts (y:ys) = if ((ts ! y)==x) then (indexTile s y)
  119                                 else
  120                                    findPiece x ts ys
  121         
  122 lastPiece::ChessSet -> Tile
  123 lastPiece (Board _ _ l _ _) = l
  124 
  125 firstPiece::ChessSet -> Tile
  126 firstPiece (Board _ _ _ f _) = f
  127 
  128 pieceAtTile::Tile -> ChessSet -> Int
  129 pieceAtTile x (Board s _ _ _ ts)
  130    = ts ! (tileIndex s x)
  131 
  132 isSquareFree::Tile -> ChessSet -> Bool
  133 isSquareFree x (Board s _ _ _ ts) = (ts ! (tileIndex s x)) == 0
  134 
  135 
  136 
  137 
  138 
  139 
  140 
  141 
  142 
  143 
  144 tileIndex:: Int -> Tile -> Int
  145 tileIndex size (x,y) = ((x-1)*size) + y
  146 
  147 indexTile::Int -> Int -> Tile
  148 indexTile size x     = ((x `div` size)+1 , x `mod` size)
  149 
  150 printBoard s [] i    = []
  151 printBoard s (x:xs) i 
  152    | (i/=s) && (x==0) ="*"     ++(spaces (s*s) 1)++(printBoard s xs (i+1))
  153    | (i==s) && (x==0) ="*\n"                     ++(printBoard s xs 1)
  154    | (i/=s)           =(show x)++(spaces (s*s) x)++(printBoard s xs (i+1))
  155    | (i==s)           =(show x)++ "\n"           ++(printBoard s xs 1)
  156 
  157 spaces s y = take ((logTen s) - (logTen y) + 1) [' ',' '..]
  158              where
  159                 logTen 1 = 0
  160                 logTen x = 1+ logTen (x `div` 10)
  161 
  162