module HTk.Toolkit.InputForm (
InputForm(..),
newInputForm,
InputField(..),
FormState(fFormValue),
EntryField,
newEntryField,
NumEntryField,
newNumEntryField,
CheckboxField,
newCheckboxField,
EnumField,
newEnumField,
TextField,
newTextField,
getFormValue,
setFormValue,
RecordField,
newRecordField,
undefinedFormValue
)
where
import Control.Exception
import Util.Messages
import HTk.Kernel.Core
import qualified HTk.Toplevel.HTk as HTk (font)
import HTk.Toplevel.HTk hiding (font)
import HTk.Toolkit.SpinButton
import HTk.Toolkit.ScrollBox
import Reactor.ReferenceVariables
class InputField f where
selector :: GUIValue b => (a -> b) -> Config (f a b)
modifier :: GUIValue b => (a -> b -> a) -> Config (f a b)
class Variable a b where
setVar :: a -> b -> IO ()
getVar :: a -> IO b
data InputForm a = InputForm Box (Ref (FormState a))
data FormState a = FormState {
fFormValue :: Maybe a,
fFormBg :: Maybe Colour,
fFormFg :: Maybe Colour,
fFormFont :: Maybe Font,
fFormCursor :: Maybe Cursor,
fFormState :: Maybe State,
fRecordFields :: [FieldInf a]
}
data FieldInf a = FieldInf {
fSetField :: a -> IO (),
fUpdField :: a -> IO a,
fSetBgColour :: Colour -> IO (),
fSetFgColour :: Colour -> IO (),
fSetFont :: Font -> IO (),
fSetCursor :: Cursor -> IO (),
fSetState :: State -> IO ()
}
newInputForm :: Box
-> Maybe a
-> [Config (InputForm a)]
-> IO (InputForm a)
newInputForm par val ol = do {
em <- newRef (FormState val Nothing Nothing Nothing Nothing Nothing []);
configure (InputForm par em) ol
}
instance Eq (InputForm a) where
w1 == w2 = (toGUIObject w1) == (toGUIObject w2)
instance GUIObject (InputForm a) where
toGUIObject (InputForm b e) = toGUIObject b
cname _ = "InputForm"
instance HasColour (InputForm a) where
legalColourID _ "foreground" = True
legalColourID _ "background" = True
legalColourID _ _ = False
setColour form@(InputForm b e) "background" c = synchronize form (do
{
configure b [bg c];
setFormConfig (\fst -> fst{fFormBg = Just c}) form
})
setColour form@(InputForm b e) "foreground" c = synchronize form (do {
configure b [fg c];
setFormConfig (\fst -> fst{fFormFg = Just c}) form
})
setColour form _ _ = return form
getColour form "background" = getFormConfig form fFormBg
getColour form "foreground" = getFormConfig form fFormFg
getColour _ _ = return cdefault
instance HasFont (InputForm a) where
font f form@(InputForm b e) = synchronize form (
setFormConfig (\fst -> fst{fFormFont = Just (toFont f)}) form
)
getFont form = getFormConfig form fFormFont
instance HasEnable (InputForm a) where
state s form@(InputForm b e) = synchronize form (
setFormConfig (\fst -> fst{fFormState = Just s}) form
)
getState form = getFormConfig form fFormState
instance Widget (InputForm a) where
cursor c form@(InputForm b e) = synchronize form ( do {
configure b [cursor c];
setFormConfig (\fst -> fst{fFormCursor = Just (toCursor c)}) form
})
getCursor form = getFormConfig form fFormCursor
instance Container (InputForm a)
instance HasSize (InputForm a)
instance HasBorder (InputForm a)
instance Synchronized (InputForm a) where
synchronize w = synchronize (toGUIObject w)
instance Variable (InputForm a) a where
setVar form val = setFormValue form val
getVar form = getFormValue form
getFormValue :: InputForm a -> IO a
getFormValue form@(InputForm b e) = synchronize form (do {
fst <- getRef e;
case fFormValue fst of
Nothing -> raise undefinedFormValue
(Just val) -> updValue (fRecordFields fst) val
})
where updValue [] val = return val
updValue (fei:fel) val = do {
val' <- (fei # fUpdField) val;
updValue fel val'
}
setFormValue :: InputForm a -> a -> IO ()
setFormValue form @ (InputForm b e) val = synchronize form (do {
fst <- getRef e;
setRef e (fst{fFormValue = Just val});
foreach (fRecordFields fst) (\fei -> (fSetField fei) val)
})
setFormConfig :: (FormState a -> FormState a) -> Config (InputForm a)
setFormConfig trans form@(InputForm b e) = do {
changeRef e trans;
fst <- getRef e;
foreach (fRecordFields fst) (setDefaultAttrs fst);
return form
}
getFormConfig :: GUIValue b => InputForm a -> (FormState a -> Maybe b) -> IO b
getFormConfig form@(InputForm b e) fetch = do {
mv <- withRef e fetch;
case mv of
Nothing -> return cdefault
(Just c) -> return c
}
undefinedFormValue :: IOError
undefinedFormValue = userError "form value is not defined"
data EntryField a b = EntryField (Entry b) Label (Ref (FieldInf a))
newEntryField :: GUIValue b => InputForm a
-> [Config (EntryField a b)]
-> IO (EntryField a b)
newEntryField form@(InputForm box field) confs = do {
b <- newHBox box [];
pack b [Expand On, Fill X];
lbl <- newLabel b [];
pack lbl [Expand Off, Fill X];
pr <- newEntry b [];
pack pr [Fill X, Expand On];
pv <- newFieldInf
(\c -> do {bg (toColour c) pr; done})
(\c -> do {fg (toColour c) pr; done})
(\f -> do {HTk.font (toFont f) pr; done})
(\c -> do {cursor (toCursor c) pr; done})
(\s -> do {state s pr; done});
configure (EntryField pr lbl pv) confs;
addNewField form pr pv;
return (EntryField pr lbl pv)
}
instance Eq (EntryField a b) where
w1 == w2 = (toGUIObject w1) == (toGUIObject w2)
instance GUIObject (EntryField a b) where
toGUIObject (EntryField pr _ _) = toGUIObject pr
cname _ = "EntryField"
instance Widget (EntryField a b) where
cursor c fe@(EntryField pr _ _) = do {cursor c pr; return fe}
getCursor (EntryField pr _ _) = getCursor pr
instance HasColour (EntryField a b) where
legalColourID _ _ = True
setColour fe@(EntryField pr lbl _) cid c = do {
setColour pr cid c; setColour lbl cid c; return fe}
getColour (EntryField pr _ _) cid = getColour pr cid
instance HasBorder (EntryField a b)
instance HasSize (EntryField a b) where
width w fe @ (EntryField pr _ _) = do {width w pr; return fe}
getWidth (EntryField pr _ _) = getWidth pr
height h fe @ (EntryField pr _ _) = do {height h pr; return fe}
getHeight fe @ (EntryField pr _ _)= getHeight pr
instance HasFont (EntryField a b)
instance HasEnable (EntryField a b) where
state v f@(EntryField pr _ _) = do {state v pr; return f}
getState (EntryField pr _ _) = getState pr
instance (GUIValue b,GUIValue c) => HasText (EntryField a b) c where
text v f@(EntryField pr lbl _) = do {text v lbl; return f}
getText (EntryField pr lbl _) = getText lbl
instance Synchronized (EntryField a b) where
synchronize fe = synchronize (toGUIObject fe)
instance GUIValue b => Variable (EntryField a b) b where
setVar f@(EntryField pr _ _) val = do {value val pr; done}
getVar (EntryField pr _ _) = getValue pr
instance InputField EntryField where
selector f fe@(EntryField pr lbl pv) = synchronize fe (do {
setSelectorCmd pv cmd;
return fe
}) where cmd r = do {value (f r) pr; done}
modifier f fe@(EntryField pr lbl pv) = synchronize fe (do {
setReplacorCmd pv cmd;
return fe
}) where cmd r = do
ans <- try (getVar fe)
case ans of
Left (e :: SomeException) -> do
txt <- getText lbl
errorMess (txt++" legal field value")
raise illegalGUIValue
Right val -> return (f r val)
data NumEntryField a b = NumEntryField (Entry b) Label SpinButton
(Ref (FieldInf a))
newNumEntryField :: (Ord b, Num b, GUIValue b) => InputForm a
-> (b, b)
-> b
-> [Config (NumEntryField a b)]
-> IO (NumEntryField a b)
newNumEntryField form@(InputForm box field) (min, max) delta confs =
do let spin Up v = if v+ delta <= max then v+delta else v
spin Down v = if v delta >= min then vdelta else v
b <- newHBox box []
pack b [Expand On, Fill X]
lbl <- newLabel b []
pack lbl [Expand Off, Fill X]
pr <- newEntry b []
pack pr [Fill X, Expand Off]
sp <- newSpinButton b
(\sp-> do
tv <- try (getValue pr);
case tv of
Right v -> pr # value (spin sp v)
Left (_ :: SomeException) -> return pr) []
pack sp [Expand Off]
pv <- newFieldInf
(\c -> do {bg (toColour c) pr; done})
(\c -> do {fg (toColour c) pr; done})
(\f -> do {HTk.font (toFont f) pr; done})
(\c -> do {cursor (toCursor c) pr; done})
(\s -> do {state s pr; done})
configure (NumEntryField pr lbl sp pv) confs
addNewField form pr pv
return (NumEntryField pr lbl sp pv)
instance Eq (NumEntryField a b) where
w1 == w2 = (toGUIObject w1) == (toGUIObject w2)
instance GUIObject (NumEntryField a b) where
toGUIObject (NumEntryField pr _ _ _) = toGUIObject pr
cname _ = "NumEntryField"
instance Widget (NumEntryField a b) where
cursor c fe@(NumEntryField pr _ _ _) = do {cursor c pr; return fe}
getCursor (NumEntryField pr _ _ _) = getCursor pr
instance HasColour (NumEntryField a b) where
legalColourID _ _ = True
setColour fe@(NumEntryField pr lbl sp _) cid c = do {
setColour pr cid c; setColour lbl cid c; setColour sp cid c;
return fe}
getColour (NumEntryField pr _ _ _) cid = getColour pr cid
instance HasBorder (NumEntryField a b)
instance HasSize (NumEntryField a b) where
width w fe @ (NumEntryField pr _ _ _) = do {width w pr; return fe}
getWidth (NumEntryField pr _ _ _) = getWidth pr
height h fe @ (NumEntryField pr _ _ _) = do {height h pr; return fe}
getHeight fe @ (NumEntryField pr _ _ _)= getHeight pr
instance HasFont (NumEntryField a b)
instance HasEnable (NumEntryField a b) where
state v f@(NumEntryField pr _ sp _) = do {state v pr; state v sp; return f}
getState (NumEntryField pr _ _ _) = getState pr
instance (GUIValue b,GUIValue c) => HasText (NumEntryField a b) c where
text v f@(NumEntryField pr lbl _ _) = do {text v lbl; return f}
getText (NumEntryField pr lbl _ _) = getText lbl
instance Synchronized (NumEntryField a b) where
synchronize fe = synchronize (toGUIObject fe)
instance GUIValue b => Variable (NumEntryField a b) b where
setVar f@(NumEntryField pr _ _ _) val = do {value val pr; done}
getVar (NumEntryField pr _ _ _) = getValue pr
instance InputField NumEntryField where
selector f fe@(NumEntryField pr lbl _ pv) = synchronize fe (do {
setSelectorCmd pv cmd;
return fe
}) where cmd r = do {value (f r) pr; done}
modifier f fe@(NumEntryField pr lbl _ pv) =
synchronize fe $ do {
setReplacorCmd pv cmd;
return fe
} where cmd r = do
ans <- try (getVar fe)
case ans of
Left (e :: SomeException) -> do
txt <- getText lbl
errorMess ("Illegal field value for "++ txt)
raise illegalGUIValue
Right val -> return (f r val)
data CheckboxField a b = CheckboxField (CheckButton b) Label (TkVariable b) (Ref (FieldInf a))
newCheckboxField :: GUIValue b=> InputForm a
-> b
-> [Config (CheckboxField a b)]
-> IO (CheckboxField a b)
newCheckboxField form@(InputForm box field) init confs = do {
b <- newHBox box [];
pack b [Expand On, Fill X];
lbl <- newLabel b [];
pack lbl [Expand Off, Fill X];
cbvar <- createTkVariable init;
pr <- newCheckButton b [variable cbvar];
pack pr [Expand Off];
pv <- newFieldInf
(\c -> do {bg (toColour c) pr; done})
(\c -> do {fg (toColour c) pr; done})
(\f -> do {HTk.font (toFont f) pr; done})
(\c -> do {cursor (toCursor c) pr; done})
(\s -> do {state s pr; done});
configure (CheckboxField pr lbl cbvar pv) confs;
addNewField form pr pv;
return (CheckboxField pr lbl cbvar pv)
}
instance Eq (CheckboxField a b) where
w1 == w2 = (toGUIObject w1) == (toGUIObject w2)
instance GUIObject (CheckboxField a b) where
toGUIObject (CheckboxField pr _ _ _) = toGUIObject pr
cname _ = "CheckboxField"
instance Widget (CheckboxField a b) where
cursor c fe@(CheckboxField pr _ _ _) = do {cursor c pr; return fe}
getCursor (CheckboxField pr _ _ _) = getCursor pr
instance HasColour (CheckboxField a b) where
legalColourID _ _ = True
setColour fe@(CheckboxField pr lbl _ _) cid c = do {
setColour pr cid c; setColour lbl cid c; return fe}
getColour (CheckboxField pr _ _ _) cid = getColour pr cid
instance HasBorder (CheckboxField a b)
instance HasSize (CheckboxField a b) where
width w fe @ (CheckboxField pr _ _ _) = do {width w pr; return fe}
getWidth (CheckboxField pr _ _ _) = getWidth pr
height h fe @ (CheckboxField pr _ _ _) = do {height h pr; return fe}
getHeight fe @ (CheckboxField pr _ _ _)= getHeight pr
instance HasFont (CheckboxField a b)
instance HasEnable (CheckboxField a b) where
state v f@(CheckboxField pr _ _ _) = do {state v pr; return f}
getState (CheckboxField pr _ _ _) = getState pr
instance (GUIValue b, GUIValue c) => HasText (CheckboxField a b) c where
text v f@(CheckboxField pr lbl _ _) = do {text v lbl; return f}
getText (CheckboxField pr lbl _ _) = getText lbl
instance Synchronized (CheckboxField a b) where
synchronize fe = synchronize (toGUIObject fe)
instance GUIValue b=> Variable (CheckboxField a b) b where
setVar f@(CheckboxField pr _ cbv _) val = setTkVariable cbv val
getVar (CheckboxField pr _ cbv _) = readTkVariable cbv
instance InputField CheckboxField where
selector f fe@(CheckboxField pr lbl cbv pv) = synchronize fe (do {
setSelectorCmd pv cmd;
return fe
}) where cmd r = do {setTkVariable cbv (f r)}
modifier f fe@(CheckboxField pr lbl cbv pv) = synchronize fe (do {
setReplacorCmd pv cmd;
return fe
}) where cmd r = do
ans <- try (getVar fe)
case ans of
Left (e :: SomeException) -> do
txt <- getText lbl
errorMess (txt++" legal field value")
raise illegalGUIValue
Right val -> return (f r val)
data TextField a b = TextField Editor Label (Ref (FieldInf a))
newTextField :: GUIValue b => InputForm a
-> [Config (TextField a b)]
-> IO (TextField a b)
newTextField form@(InputForm box field) confs =
do
b <- newVBox box []
pack b [Expand On, Fill Both, PadX (cm 0.1), PadY (cm 0.1)]
lbl <- newLabel b [anchor West]
pack lbl [Expand Off, Fill Both]
let edit p = newEditor p []
(sb, tp) <- newScrollBox b edit []
pack sb [Expand On, Fill Both]
pv <- newFieldInf
(\c -> do {done})
(\c -> do {done})
(\f -> do {done})
(\c -> do {done})
(\s -> do {state s tp; done})
configure (TextField tp lbl pv) confs
addNewField form tp pv
return (TextField tp lbl pv)
instance Eq (TextField a b) where
w1 == w2 = (toGUIObject w1) == (toGUIObject w2)
instance GUIObject (TextField a b) where
toGUIObject (TextField tp _ _) = toGUIObject tp
cname _ = "TextField"
instance Synchronized (TextField a b) where
synchronize fe = synchronize (toGUIObject fe)
instance HasColour (TextField a b) where
legalColourID _ _ = True
setColour fe@(TextField ed lbl _) cid c = do {setColour ed cid c; setColour ed cid c; return fe}
getColour (TextField ed _ _) cid = getColour ed cid
instance HasBorder (TextField a b)
instance HasSize (TextField a b) where
width w fe @ (TextField ed _ _) = do {width w ed; return fe}
getWidth (TextField ed _ _) = getWidth ed
height h fe @ (TextField ed _ _) = do {height h ed; return fe}
getHeight fe @ (TextField ed _ _)= getHeight ed
instance HasFont (TextField a b) where
font f fe@(TextField ed _ _) = do {HTk.font f ed; return fe}
getFont (TextField ed _ _) = getFont ed
instance HasEnable (TextField a b) where
state v f@(TextField ed _ _) = do {state v ed; return f}
getState (TextField ed _ _) = getState ed
instance (GUIValue b,GUIValue c) => HasText (TextField a b) c where
text v f@(TextField pr lbl _) = do {text v lbl; return f}
getText (TextField pr lbl _) = getText lbl
instance GUIValue b => Variable (TextField a b) b where
setVar fe @ (TextField tp _ _) t = do {value t tp; done}
getVar (TextField tp _ _) = getValue tp
instance InputField TextField where
selector f fe@(TextField tp lbl pv) = synchronize fe (do {
setSelectorCmd pv cmd;
return fe
}) where cmd r = do {value (f r) tp; done}
modifier f fe@(TextField tp lbl pv) = synchronize fe (do {
setReplacorCmd pv cmd;
return fe
}) where cmd r = do
ans <- try (getVar fe)
case ans of
Left (err :: SomeException) -> do
txt <- getText lbl
errorMess (txt++" legal field value")
raise illegalGUIValue
Right val -> return (f r val)
data EnumField a b = EnumField (OptionMenu b) Label (Ref (FieldInf a))
newEnumField :: GUIValue b => InputForm a
-> [b]
-> [Config (EnumField a b)]
-> IO (EnumField a b)
newEnumField form@(InputForm box field) choices confs =
do
b <- newHBox box []
pack b [Expand On, Fill X, PadX (cm 0.1), PadY (cm 0.1)]
lbl <- newLabel b []
pack lbl [Expand Off, Fill Both]
mn <- newOptionMenu b choices []
pack mn [Expand Off, Fill Both]
pv <- newFieldInf
(\c -> do {bg (toColour c) mn; done})
(\c -> do {fg (toColour c) mn; done})
(\f -> do {HTk.font (toFont f) mn; done})
(\c -> do {cursor (toCursor c) mn; done})
(\s -> do {state s mn; done})
configure (EnumField mn lbl pv) confs
addNewField form mn pv
return (EnumField mn lbl pv)
instance Eq (EnumField a b) where
w1 == w2 = (toGUIObject w1) == (toGUIObject w2)
instance GUIObject (EnumField a b) where
toGUIObject (EnumField mn lbl pv) = toGUIObject mn
cname _ = "EnumField"
instance Widget (EnumField a b) where
cursor c fe@(EnumField mn _ _) = do {cursor c mn; return fe}
getCursor (EnumField mn _ _) = getCursor mn
instance HasColour (EnumField a b) where
legalColourID _ _ = True
setColour fe@(EnumField mn lbl _) cid c = do {setColour mn cid c; setColour lbl cid c; return fe}
getColour (EnumField mn lbl _) cid = getColour mn cid
instance HasBorder (EnumField a b)
instance HasSize (EnumField a b)
instance HasFont (EnumField a b) where
font f fe@(EnumField mn _ _) = do {HTk.font f mn; return fe}
getFont (EnumField mn _ _) = getFont mn
instance HasEnable (EnumField a b) where
state v f@(EnumField mn _ _) = do {state v mn; return f}
getState (EnumField mn _ _) = getState mn
instance GUIValue c => HasText (EnumField a b) c where
text v fe @ (EnumField mn lbl pv) = do {text v lbl; return fe}
getText fe@(EnumField mn lbl pv) = getText lbl
instance Synchronized (EnumField a b) where
synchronize fe = synchronize (toGUIObject fe)
instance GUIValue b => Variable (EnumField a b) b where
setVar fe@(EnumField mn lbl pv) v = do {value v mn; done}
getVar fe@(EnumField mn lbl pv) = getValue mn
instance InputField EnumField where
selector f fe@(EnumField mn lbl pv) = synchronize fe (do {
setSelectorCmd pv cmd;
return fe
}) where cmd r = do {value (f r) mn; done}
modifier f fe@(EnumField mn lbl pv) = synchronize fe (do {
setReplacorCmd pv cmd;
return fe
}) where cmd r = do {val <- getValue mn;return (f r val)}
data RecordField a b =
RecordField (InputForm b) Label (Ref (FieldInf a))
newRecordField :: InputForm a -> (Box -> IO (InputForm b)) -> [Config (RecordField a b)] -> IO (RecordField a b, InputForm b)
newRecordField form@(InputForm box e) newform confs =
do
b <- newVBox box []
pack b [Expand On, Fill Both, PadX (cm 0.1), PadY (cm 0.1)]
lbl <- newLabel b []
pack lbl [Expand Off, Fill X]
cf <- newform b
pv <- newFieldInf
(\c -> do {bg (toColour c) cf; bg (toColour c) lbl; done})
(\c -> do {fg (toColour c) cf; fg (toColour c) lbl; done})
(\f -> do {HTk.font (toFont f) cf; HTk.font (toFont f) lbl; done})
(\c -> do {cursor (toCursor c) cf; cursor (toCursor c) lbl; done})
(\s -> do {state s cf; done})
configure (RecordField cf lbl pv) confs
addNewField form cf pv
return (RecordField cf lbl pv, cf)
instance Eq (RecordField a b) where
w1 == w2 = (toGUIObject w1) == (toGUIObject w2)
instance GUIObject (RecordField a b) where
toGUIObject (RecordField form lb pv) = toGUIObject lb
cname _ = "RecordField"
instance Widget (RecordField a b) where
cursor c fe@(RecordField cf lb _) = synchronize fe (do {
cursor c lb;
cursor c cf;
return fe
})
getCursor (RecordField mn lb _) = getCursor lb
instance HasColour (RecordField a b) where
legalColourID _ _ = True
setColour fe@(RecordField cf lb _) cid c = synchronize fe (do {
setColour cf cid c;
setColour lb cid c;
return fe
})
getColour (RecordField cf _ _) cid = getColour cf cid
instance HasBorder (RecordField a b)
instance HasSize (RecordField a b)
instance HasFont (RecordField a b) where
font f fe@(RecordField cf lb _) = synchronize fe (do {
HTk.font f cf;
HTk.font f lb;
return fe
})
getFont (RecordField cf _ _) = getFont cf
instance HasEnable (RecordField a b) where
state v fe@(RecordField cf _ _) = do {state v cf; return fe}
getState (RecordField cf _ _) = getState cf
instance GUIValue c => HasText (RecordField a b) c where
text v fe @ (RecordField cf lb pv) = do {text v lb; return fe}
getText fe@(RecordField cf lb pv) = getText lb
instance Synchronized (RecordField a b) where
synchronize fe = synchronize (toGUIObject fe)
instance GUIValue b => Variable (RecordField a b) b where
setVar fe@(RecordField cf lb pv) v = setVar cf v
getVar fe@(RecordField cf lb pv) = getVar cf
instance InputField RecordField where
selector f fe@(RecordField cf lb pv) = synchronize fe (do {
setSelectorCmd pv cmd;
return fe
}) where cmd r = do {setFormValue cf (f r); done}
modifier f fe@(RecordField cf lb pv) = synchronize fe (do {
setReplacorCmd pv cmd;
return fe
}) where cmd r = do {val <- getFormValue cf;return (f r val)}
type Field a = (Ref (FieldInf a))
newFieldInf :: (Colour -> IO ())
-> (Colour -> IO ())
-> (Font -> IO ())
-> (Cursor -> IO ())
-> (State -> IO ())
-> IO (Field a)
newFieldInf setBg setFg setFont setCursor setState = newRef inf
where inf = FieldInf (const done) return setBg setFg setFont setCursor setState
addNewField :: InputForm a -> w -> Field a -> IO ()
addNewField form@(InputForm b em) w pv = do {
fei <- getRef pv;
fst <- getRef em;
setDefaultAttrs fst fei;
configure w [];
changeRef em (\fst -> fst {fRecordFields = (fRecordFields fst) ++ [fei]})
}
setDefaultAttrs :: FormState a -> FieldInf a -> IO ()
setDefaultAttrs fst fei = do {
incase (fFormBg fst) (fSetBgColour fei);
incase (fFormFg fst) (fSetFgColour fei);
incase (fFormFont fst) (fSetFont fei);
incase (fFormCursor fst) (fSetCursor fei);
incase (fFormState fst) (fSetState fei);
done
}
setSelectorCmd :: Field a -> (a -> IO ()) -> IO ()
setSelectorCmd pv cmd = do
changeRef pv (\fei -> fei{fSetField = cmd})
setReplacorCmd :: Field a -> (a -> IO a) -> IO ()
setReplacorCmd pv cmd = do
changeRef pv (\fei -> fei{fUpdField = cmd})