curses set game

root / Set.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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Set (
    width, dimen,
    Card, Attr,
    card, nullCard,
    cardAttr, cardAttrs,
    set, complete,
    setLevel,
    allCards
    ) where

import Data.Bits
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Ix as Ix

import Util

width = 3
dimen = 4

type Attr = Int

type CardBit = Int
newtype Card = Card CardBit deriving (Eq, Ord, Num, Bits)

attr_mask :: CardBit
attr_mask = pred $ bit width
nullCard :: Card
nullCard = 0

infixl 5 .<<., .>>.
(.>>.), (.<<.) :: Bits a => a -> Int -> a
(.>>.) = shiftR
(.<<.) = shiftL

firstBit :: Bits a => a -> Int
firstBit x = test 0 where
  test n
    | testBit x n = n
    | otherwise = test (succ n)

cardAttr :: Card -> Int -> Attr
cardAttr c i = firstBit (c .>>. width*i)

attrCard :: Int -> Attr -> CardBit
attrCard i a = bit (width*i + a)

card :: [Attr] -> Card
card = Card . make 0 where
  make _ [] = 0
  make i (a:l) = attrCard i a .|. make (succ i) l

cardN :: Int -> Card
cardN = Card . make 0 where
  make i n
    | i == dimen && n == 0 = 0
    | i == dimen = error "cardN: N too large"
    | otherwise = attrCard i m .|. make (succ i) d
    where
      (d,m) = n `divMod` width

cardAttrs :: Card -> [Attr]
cardAttrs c = map (cardAttr c) [0..pred dimen]

cardI :: Card -> Int
cardI 0 = 0
cardI n = firstBit n + width * cardI (n .>>. width)

instance Enum Card where
  toEnum (-1) = 0
  toEnum n = cardN n
  fromEnum 0 = -1
  fromEnum c = cardI c

instance Show Card where
  show c = map show_attr $ cardAttrs c where
    show_attr a = Char.chr (Char.ord 'A' + a)

instance Bounded Card where
  minBound = toEnum (pred 0)
  maxBound = toEnum (pred (width^dimen))

instance Rangeable Card
instance Ix.Ix Card where { range = _range; inRange = _inRange; index = _index }

fold_coal :: a -> (CardBit -> CardBit -> CardBit -> a -> a) -> [Card] -> a
fold_coal i f cl = go attr_mask where
  Card one = head cl
  Card all = List.foldl' (.|.) 0 cl
  go m
    | a == 0 = i
    | otherwise = f m (one .&. m) a r
    where
      a = all .&. m
      r = go (m .<<. width)

set :: [Card] -> Bool
set | width == 3 = \[a, b, c] ->
      (complement (a `xor` b `xor` c) .&. (a .|. b .|. c)) == 0
    | otherwise = fold_coal True ok where
	ok m o a = (&&) (a == o || a == m)

complete :: [Card] -> Card
complete = Card . fold_coal 0 mk where
      mk m o a = (.|.) (if o == a then a else m `xor` a)

setLevel :: [Card] -> Int
setLevel = fold_coal 0 lev where
  lev m _ a = if a == m then succ else id

allCards :: [Card]
allCards = tail allOf