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