module HTk.Kernel.EventInfo(
EventParameter(..),
epToChar,
epFromChar,
EventInfoSet,
emptyEventInfoSet,
mkEventInfoSet,
listEventInfoSet,
addEventInfoSet,
delEventInfoSet,
EventInfo(..),
mkEventInfo,
defaultEventInfoSet
) where
import qualified Data.Set as Set
import HTk.Kernel.Geometry(Distance)
newtype EventInfoSet = EventInfoSet (Set.Set EventParameter)
data EventInfo = EventInfo { x :: Distance,
y :: Distance,
xRoot :: Distance,
yRoot :: Distance,
button :: Int
}
defaultEventInfoSet :: EventInfoSet
defaultEventInfoSet = mkEventInfoSet [Px, Py, PX, PY, Pb]
data EventParameter =
HASH | Pa | Pb | Pc | Pd | Pf | Ph | Pk | Pm | Po | Pp |
Ps | Pt | Pv | Pw | Px | Py | PA | PB | PE | PK | PN |
PR | PS | PT | PW | PX | PY deriving (Eq,Ord,Show,Read)
epToChar :: EventParameter -> Char
epToChar ep =
case show ep of
['P',c] -> c
"HASH" -> '#'
epFromChar :: Char -> EventParameter
epFromChar ch =
case ch of
'#' -> HASH
other -> read ['P',other]
listEventInfoSet :: EventInfoSet -> [EventParameter]
listEventInfoSet (EventInfoSet set) = Set.toList set
mkEventInfoSet :: [EventParameter] -> EventInfoSet
mkEventInfoSet eventPars = EventInfoSet (Set.fromList eventPars)
emptyEventInfoSet :: EventInfoSet
emptyEventInfoSet = mkEventInfoSet []
addEventInfoSet :: EventInfoSet -> [EventParameter] -> EventInfoSet
addEventInfoSet (EventInfoSet set) eventPars =
EventInfoSet(Set.union set (Set.fromList eventPars))
delEventInfoSet :: EventInfoSet -> [EventParameter] -> EventInfoSet
delEventInfoSet (EventInfoSet set) eventPars =
EventInfoSet(Set.difference set (Set.fromList eventPars))
mkEventInfo :: [(EventParameter,String)] -> EventInfo
mkEventInfo settings =
foldl getEvPar (EventInfo 0 0 0 0 0) settings
where getEvPar i (Px, val) = i {x= read val}
getEvPar i (Py, val) = i {y= read val}
getEvPar i (Pb, val) = i {button= read val}
getEvPar i (PX, val) = i {xRoot = read val}
getEvPar i (PY, val) = i {yRoot = read val}