curses set game

root / Find.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
module Find (
    hasSet,
    newSets,
    allSets
    ) where

import Set

type CardSet = [Int]
cardSet x y z = [z,y,x]

hasSet :: [Card] -> Bool
hasSet = has [] width where
  has s 0 _ = set s
  has _ _ [] = False
  has s n (x:l) = has (x:s) (pred n) l || has s n l

each :: ((Int, a) -> [a] -> b -> b) -> b -> Int -> [a] -> b
each f z = for where
  for _ [] = z
  for i (x:l) = f (i,x) l $ for (succ i) l

eachCard :: ((Int, Card) -> [Card] -> [CardSet] -> [CardSet]) -> Int -> [Card] -> [CardSet]
eachCard f = each card [] where
  card x l r
    | nullCard == snd x = r
    | otherwise = f x l r

findNew :: Int -> [Card] -> (Int, Card) -> [CardSet]
findNew i0 cl (ix, x) = eachCard goty i0 cl where
  goty (iy,y) l r = each gotz [] (succ iy) l ++ r where
    tz = complete [y,x]
    gotz (iz,z) _ r
      | tz == z = cardSet ix iy iz : r
      | otherwise = r

allSets :: [Card] -> [CardSet]
allSets cl = eachCard gotx 0 cl where
  gotx x@(ix,_) l r = findNew (succ ix) l x ++ r

newSets :: [Card] -> (Int, Card) -> [CardSet]
newSets = findNew 0