module MoreF(
  moreF,moreF',
  pickListF,pickListF',PickListRequest(..)
) where

import Fudget
--import Xtypes
import ResourceIds() -- synonym ColorName, for hbc
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() -- instances

import FDefaults
--import Alignment
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
$
             --alignSepF 5 aLeft aTop $
	     Customiser TextF -> F TextRequest (InputMsg (Int, String))
textF' Customiser TextF
pmod

--stringListF :: Size -> FontName -> F TextRequest (InputMsg (Int,String))
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
$ -- prevents a space leak
	     [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