Metagame.hs

   1 -- This file is part of Intricacy
   2 -- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 {-# LANGUAGE TupleSections #-}
  12
  13 module Metagame where
  14
  15 import           Control.Applicative
  16 import           Control.Monad
  17 import           Data.Array
  18 import           Data.Binary
  19 import           Data.Char
  20 import           Data.List           (delete)
  21 import           Data.Maybe
  22
  23 import           GameStateTypes
  24 import           Lock
  25
  26 notesNeeded = 3
  27 maxLocks = 3
  28
  29 type Codename = String
  30
  31 validCodeName name = length name == 3 && all validChar name
  32     where validChar c = isAscii c && isPrint c && not (isLower c) && c /= ' '
  33
  34 data UserInfo = UserInfo {codename::Codename, userLocks::Array LockIndex (Maybe LockInfo), notesRead::[NoteInfo]}
  35     deriving (Eq, Ord, Show, Read)
  36
  37 _emptylocks = array (0,maxLocks-1) $ map (,Nothing) [0..maxLocks-1]
  38
  39 initUserInfo name = UserInfo name _emptylocks []
  40
  41 data LockInfo = LockInfo {lockSpec::LockSpec, public::Bool, notesSecured::[NoteInfo], lockSolutions::[NoteInfo], accessedBy::[Codename]}
  42     deriving (Eq, Ord, Show, Read)
  43
  44 initLockInfo ls = LockInfo ls False [] [] []
  45
  46 data AccessedReason = AccessedPrivy | AccessedEmpty | AccessedPub
  47     deriving (Eq, Ord, Show, Read)
  48
  49 getAccessInfo :: UserInfo -> Codename -> [Maybe AccessedReason]
  50 getAccessInfo ui name =
  51     let mlinfos = elems $ userLocks ui
  52         accessedSlot = maybe accessedAllExisting accessedLock
  53         accessedAllExisting = all (maybe True accessedLock) mlinfos
  54         accessedLock linfo = public linfo || name `elem` accessedBy linfo
  55     in map (maybe
  56             (if accessedAllExisting then Just AccessedEmpty else Nothing)
  57             (\linfo -> if public linfo then Just AccessedPub
  58                 else if accessedLock linfo then Just AccessedPrivy else Nothing))
  59         mlinfos
  60
  61 data UserInfoDelta
  62     = AddRead NoteInfo
  63     | DelRead NoteInfo
  64     | PutLock LockSpec LockIndex
  65     | LockDelta LockIndex LockDelta
  66     deriving (Eq, Ord, Show, Read)
  67 data LockDelta
  68     = SetPubNote NoteInfo
  69     | AddSecured NoteInfo
  70     | DelSecured NoteInfo
  71     | AddSolution NoteInfo
  72     | AddAccessed Codename
  73     | SetPublic
  74     deriving (Eq, Ord, Show, Read)
  75
  76 data NoteInfo = NoteInfo {noteAuthor::Codename, noteBehind::Maybe ActiveLock, noteOn::ActiveLock}
  77     deriving (Eq, Ord, Show, Read)
  78
  79 data ActiveLock = ActiveLock {lockOwner::Codename, lockIndex :: LockIndex}
  80     deriving (Eq, Ord, Show, Read)
  81
  82 data Undeclared = Undeclared Solution LockSpec ActiveLock
  83     deriving (Eq, Ord, Show, Read)
  84
  85 -- | permanent serial number of a lock
  86 type LockSpec = Int
  87
  88 -- | which of a user's three locks (0,1, or 2)
  89 type LockIndex = Int
  90
  91 -- | solved state
  92 type Hint = GameState
  93
  94 lockIndexChar :: LockIndex -> Char
  95 lockIndexChar i = toEnum $ i + fromEnum 'A'
  96
  97 charLockIndex c = fromEnum (toUpper c) - fromEnum 'A'
  98
  99 alockStr :: ActiveLock -> String
 100 alockStr (ActiveLock name idx) = name ++ [':',lockIndexChar idx]
 101
 102 applyDeltas :: UserInfo -> [UserInfoDelta] -> UserInfo
 103 applyDeltas = foldr applyDelta
 104
 105 applyDelta :: UserInfoDelta -> UserInfo -> UserInfo
 106 applyDelta (AddRead n) info = info { notesRead = n:notesRead info }
 107 applyDelta (DelRead n) info = info { notesRead = delete n (notesRead info) }
 108 applyDelta (PutLock ls li) info = info { userLocks = userLocks info // [(li, Just $ initLockInfo ls)] }
 109 applyDelta (LockDelta li ld) info =
 110     info { userLocks = userLocks info // [(li, fmap (applyLockDelta ld) (userLocks info ! li))] }
 111 applyLockDelta (SetPubNote n) lockinfo = lockinfo { lockSolutions = map
 112     (\n' -> if n' == n then n {noteBehind=Nothing} else n') (lockSolutions lockinfo) }
 113 applyLockDelta (AddSecured n) lockinfo = lockinfo { notesSecured = n:notesSecured lockinfo }
 114 applyLockDelta (DelSecured n) lockinfo = lockinfo { notesSecured = delete n $ notesSecured lockinfo }
 115 applyLockDelta (AddSolution n) lockinfo = lockinfo { lockSolutions = n:lockSolutions lockinfo }
 116 applyLockDelta (AddAccessed name) lockinfo = lockinfo { accessedBy = name:delete name (accessedBy lockinfo) }
 117 applyLockDelta SetPublic lockinfo = lockinfo { public = True, lockSolutions = [], accessedBy = [], notesSecured = []}
 118
 119 instance Binary UserInfo where
 120     put (UserInfo name locks notes) = put name >> put locks >> put notes
 121     get = liftM3 UserInfo get get get
 122
 123 instance Binary UserInfoDelta where
 124     put (AddRead note)    = put (0::Word8) >> put note
 125     put (DelRead note)    = put (1::Word8) >> put note
 126     put (PutLock ls li)   = put (2::Word8) >> put ls >> put li
 127     put (LockDelta li ld) = put (3::Word8) >> put li >> put ld
 128     get = do
 129         tag <- get :: Get Word8
 130         case tag of
 131             0 -> AddRead <$> get
 132             1 -> DelRead <$> get
 133             2 -> PutLock <$> get <*> get
 134             3 -> LockDelta <$> get <*> get
 135
 136 instance Binary LockDelta where
 137     put (SetPubNote note)  = put (0::Word8) >> put note
 138     put (AddSecured note)  = put (1::Word8) >> put note
 139     put (DelSecured note)  = put (2::Word8) >> put note
 140     put (AddSolution note) = put (3::Word8) >> put note
 141     put (AddAccessed name) = put (4::Word8) >> put name
 142     put SetPublic          = put (5::Word8)
 143     get = do
 144         tag <- get :: Get Word8
 145         case tag of
 146             0 -> SetPubNote <$> get
 147             1 -> AddSecured <$> get
 148             2 -> DelSecured <$> get
 149             3 -> AddSolution <$> get
 150             4 -> AddAccessed <$> get
 151             5 -> return SetPublic
 152
 153 instance Binary LockInfo where
 154     put (LockInfo spec pk notes solved accessed) = put spec >> put pk >> put notes >> put solved >> put accessed
 155     get = liftM5 LockInfo get get get get get
 156
 157 instance Binary NoteInfo where
 158     put (NoteInfo author behind on) = put author >> put behind >> put on
 159     get = liftM3 NoteInfo get get get
 160
 161 instance Binary ActiveLock where
 162     put (ActiveLock owner idx) = put owner >> put idx
 163     get = liftM2 ActiveLock get get