1 
    2 
    3 
    4 
    5 
    6 
    7 
    8 
    9 
   10 
   11 
   12 module ChessSetList(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 import Sort(quickSort)
   46 
   47 type Tile     = (Int,Int)
   48 data ChessSet = Board Int Int Tile [Tile]
   49 
   50 
   51 
   52 
   53 
   54 
   55 
   56 
   57 
   58 
   59 
   60 instance Eq ChessSet where
   61     _ == _ = True
   62 
   63 instance Ord ChessSet where
   64     _ <= _ = True                  
   65 
   66 instance Show ChessSet where
   67    showsPrec p board@(Board sze n f ts) 
   68       = showString (printBoard sze sortedTrail 1)
   69         where
   70            sortedTrail = quickSort 
   71                             (assignMoveNo ts sze n)
   72 
   73 
   74 
   75 
   76 
   77 createBoard::Int -> Tile -> ChessSet
   78 createBoard x t= Board x 1 t [t]
   79 
   80 sizeBoard::ChessSet -> Int
   81 sizeBoard (Board s _ _ _) = s
   82 
   83 noPieces::ChessSet -> Int 
   84 noPieces (Board _ n _ _) = n
   85 
   86 addPiece::Tile -> ChessSet -> ChessSet
   87 addPiece t (Board s n f ts) = Board s (n+1) f (t:ts)
   88 
   89 
   90 
   91 
   92 
   93 
   94 
   95 
   96 deleteFirst::ChessSet -> ChessSet
   97 deleteFirst (Board s n f ts) = Board s (n-1) (last ts') ts'
   98                                where
   99                                    ts' = init ts
  100 
  101 
  102 positionPiece::Int -> ChessSet -> Tile
  103 positionPiece x (Board _ n _ ts) = ts !! (n - x)
  104 
  105 lastPiece::ChessSet -> Tile
  106 lastPiece (Board _ _ _ (t:ts)) = t
  107 
  108 firstPiece::ChessSet -> Tile
  109 firstPiece (Board _ _ f _) = f
  110 
  111 pieceAtTile::Tile -> ChessSet -> Int
  112 pieceAtTile x (Board _ _ _ ts)
  113    = find x ts
  114      where
  115         find x [] = error "Tile not used"
  116         find x (y:xs) 
  117            | x == y    = 1 + length xs
  118            | otherwise = find x xs
  119 
  120 isSquareFree::Tile -> ChessSet -> Bool
  121 isSquareFree x (Board _ _ _ ts) = x `notElem` ts
  122 
  123 
  124 
  125 
  126 
  127 
  128 
  129 
  130 assignMoveNo [] size x
  131    = []
  132 assignMoveNo ((x,y):t) size z
  133    =(((y-1)*size)+x,z):assignMoveNo t size (z-1)
  134 
  135 printBoard s [] n
  136    | (n  > (s*s))   = ""
  137    | (n `mod` s /=0)= "*"++(spaces (s*s) 1) ++(printBoard s [] (n+1))
  138    | (n `mod` s ==0)= "*\n"                 ++(printBoard s [] (n+1))
  139 printBoard s trail@((i,j):xs) n
  140    | (i==n) && 
  141      (n `mod` s ==0)= (show j)++"\n"++(printBoard s xs (n+1))
  142    | (i==n) && 
  143      (n `mod` s /=0)= (show j)++(spaces (s*s) j)++(printBoard s xs    (n+1))
  144    | (n `mod` s /=0)= "*"     ++(spaces (s*s) 1)++(printBoard s trail (n+1))
  145    | (n `mod` s ==0)= "*\n"                     ++(printBoard s trail (n+1))
  146 
  147 spaces s y = take ((logTen s) - (logTen y) + 1) [' ',' '..]
  148              where
  149                 logTen 0 = 0
  150                 logTen x = 1+ logTen (x `div` 10)
  151 
  152