module MoreF(
moreF,moreF',
pickListF,pickListF',PickListRequest(..)
) where
import Fudget
import ResourceIds()
import Spops
import Geometry
import ScrollF(oldVscrollF,grabScrollKeys)
import TextF
import Spacer(marginF)
import SerCompF(absF)
import Loops(loopThroughRightF)
import CompOps((>=^<))
import StringUtils(rmBS,expandTabs)
import Defaults(labelFont,paperColor)
import GCAttrs()
import FDefaults
import InputMsg(InputMsg,mapInp)
import ListRequest(ListRequest(..),replaceAll,replaceItems,applyListRequest)
txtF' :: Customiser TextF -> F TextRequest (InputMsg (Int, String))
txtF' Customiser TextF
pmod = forall {a} {b}. Int -> F a b -> F a b
marginF Int
5 forall a b. (a -> b) -> a -> b
$
Customiser TextF -> F TextRequest (InputMsg (Int, String))
textF' Customiser TextF
pmod
stringListF' :: Point -> Customiser TextF -> F TextRequest (InputMsg (Int, String))
stringListF' Point
size Customiser TextF
pmod = forall {b} {d}. Bool -> (Point, Point) -> F b d -> F b d
oldVscrollF Bool
grabScrollKeys (Point
size,Point
size) (Customiser TextF -> F TextRequest (InputMsg (Int, String))
txtF' Customiser TextF
pmod)
moreF :: F [String] (InputMsg (Int, String))
moreF = Customiser TextF -> F [String] (InputMsg (Int, String))
moreF' forall a. Customiser a
standard
moreF' :: Customiser TextF -> F [String] (InputMsg (Int,String))
moreF' :: Customiser TextF -> F [String] (InputMsg (Int, String))
moreF' Customiser TextF
pmod =
Point -> Customiser TextF -> F TextRequest (InputMsg (Int, String))
stringListF' (Int -> Int -> Point
pP Int
480 Int
260) Customiser TextF
pmod' forall c d e. F c d -> (e -> c) -> F e d
>=^<(forall {a}. [a] -> ListRequest a
replaceAllforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a -> b) -> [a] -> [b]
map (String -> String
rmBSforall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> String -> String
expandTabs Int
8))
where
pmod' :: Customiser TextF
pmod' = Customiser TextF
pmodforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall {xxx} {p}.
(HasBgColorSpec xxx, Show p, ColorGen p) =>
p -> Customiser xxx
setBgColor String
paperColor
type PickListRequest a = ListRequest a
pickListF :: (a -> String) -> F (PickListRequest a) (InputMsg (Int, a))
pickListF = forall a.
Customiser TextF
-> (a -> String) -> F (PickListRequest a) (InputMsg (Int, a))
pickListF' forall a. Customiser a
standard
pickListF' :: Customiser TextF -> (a->String) -> F (PickListRequest a) (InputMsg (Int,a))
pickListF' :: forall a.
Customiser TextF
-> (a -> String) -> F (PickListRequest a) (InputMsg (Int, a))
pickListF' Customiser TextF
pmod a -> String
show =
forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF (forall a b. SP a b -> F a b
absF (forall {b}.
[a]
-> SP
(Either (InputMsg (Int, b)) (ListRequest a))
(Either TextRequest (InputMsg (Int, a)))
pickSP [])) F TextRequest (InputMsg (Int, String))
altListF
where
pmod' :: Customiser TextF
pmod' = Customiser TextF
pmodforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall {xxx} {a}.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont String
labelFont
altListF :: F TextRequest (InputMsg (Int, String))
altListF = forall {b} {d}. Bool -> (Point, Point) -> F b d -> F b d
oldVscrollF Bool
grabScrollKeys (Int -> Int -> Point
Point Int
240 Int
260,Int -> Int -> Point
Point Int
480 Int
390) (Customiser TextF -> F TextRequest (InputMsg (Int, String))
txtF' Customiser TextF
pmod')
pickSP :: [a]
-> SP
(Either (InputMsg (Int, b)) (ListRequest a))
(Either TextRequest (InputMsg (Int, a)))
pickSP [a]
alts =
forall a b. Cont (SP a b) a
getSP forall a b. (a -> b) -> a -> b
$ \Either (InputMsg (Int, b)) (ListRequest a)
msg ->
case Either (InputMsg (Int, b)) (ListRequest a)
msg of
Right plreq :: ListRequest a
plreq@(ReplaceItems Int
from Int
cnt [a]
newalts') ->
let alts' :: [a]
alts' = forall {a}. ListRequest a -> [a] -> [a]
applyListRequest ListRequest a
plreq [a]
alts
newalts :: [String]
newalts = forall a b. (a -> b) -> [a] -> [b]
map a -> String
show [a]
newalts'
in forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Either a b
Left (forall {a}. Int -> Int -> [a] -> ListRequest a
replaceItems Int
from Int
cnt [String]
newalts)) forall a b. (a -> b) -> a -> b
$
forall {a} {a}. [a] -> a -> a
evalSpine [a]
alts' forall a b. (a -> b) -> a -> b
$
[a]
-> SP
(Either (InputMsg (Int, b)) (ListRequest a))
(Either TextRequest (InputMsg (Int, a)))
pickSP [a]
alts'
Right (HighlightItems [Int]
ns) -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Either a b
Left (forall a. [Int] -> ListRequest a
HighlightItems [Int]
ns)) forall a b. (a -> b) -> a -> b
$ [a]
-> SP
(Either (InputMsg (Int, b)) (ListRequest a))
(Either TextRequest (InputMsg (Int, a)))
pickSP [a]
alts
Right (PickItem Int
n) -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Either a b
Left (forall a. Int -> ListRequest a
PickItem Int
n)) forall a b. (a -> b) -> a -> b
$ [a]
-> SP
(Either (InputMsg (Int, b)) (ListRequest a))
(Either TextRequest (InputMsg (Int, a)))
pickSP [a]
alts
Left InputMsg (Int, b)
msg -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. b -> Either a b
Right (forall {t} {a}. (t -> a) -> InputMsg t -> InputMsg a
mapInp (\(Int
n,b
_)->(Int
n,[a]
altsforall a. [a] -> Int -> a
!!Int
n)) InputMsg (Int, b)
msg)) ([a]
-> SP
(Either (InputMsg (Int, b)) (ListRequest a))
(Either TextRequest (InputMsg (Int, a)))
pickSP [a]
alts)
evalSpine :: [a] -> a -> a
evalSpine [] = forall a. Customiser a
id
evalSpine (a
x:[a]
xs) = [a] -> a -> a
evalSpine [a]
xs