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 = Int
-> F TextRequest (InputMsg (Int, String))
-> F TextRequest (InputMsg (Int, String))
forall a b. Int -> F a b -> F a b
marginF Int
5 (F TextRequest (InputMsg (Int, String))
 -> F TextRequest (InputMsg (Int, String)))
-> F TextRequest (InputMsg (Int, String))
-> F TextRequest (InputMsg (Int, String))
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 = Bool
-> (Point, Point)
-> F TextRequest (InputMsg (Int, String))
-> F TextRequest (InputMsg (Int, String))
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' Customiser TextF
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' F TextRequest (InputMsg (Int, String))
-> ([String] -> TextRequest) -> F [String] (InputMsg (Int, String))
forall c d e. F c d -> (e -> c) -> F e d
>=^<([String] -> TextRequest
forall a. [a] -> ListRequest a
replaceAll([String] -> TextRequest)
-> ([String] -> [String]) -> [String] -> TextRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
rmBS(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> String -> String
expandTabs Int
8))
  where
    pmod' :: Customiser TextF
pmod' = Customiser TextF
pmodCustomiser TextF -> Customiser TextF -> Customiser TextF
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Customiser TextF
forall xxx a.
(HasBgColorSpec xxx, Show a, ColorGen a) =>
a -> Customiser xxx
setBgColor String
paperColor

type PickListRequest a = ListRequest a

pickListF :: (a -> String) -> F (PickListRequest a) (InputMsg (Int, a))
pickListF = Customiser TextF
-> (a -> String) -> F (PickListRequest a) (InputMsg (Int, a))
forall a.
Customiser TextF
-> (a -> String) -> F (PickListRequest a) (InputMsg (Int, a))
pickListF' Customiser TextF
forall a. Customiser a
standard

pickListF' :: Customiser TextF -> (a->String) -> F (PickListRequest a) (InputMsg (Int,a))
pickListF' :: Customiser TextF
-> (a -> String) -> F (PickListRequest a) (InputMsg (Int, a))
pickListF' Customiser TextF
pmod a -> String
show =
    F (Either (InputMsg (Int, String)) (PickListRequest a))
  (Either TextRequest (InputMsg (Int, a)))
-> F TextRequest (InputMsg (Int, String))
-> F (PickListRequest a) (InputMsg (Int, a))
forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF (SP
  (Either (InputMsg (Int, String)) (PickListRequest a))
  (Either TextRequest (InputMsg (Int, a)))
-> F (Either (InputMsg (Int, String)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
forall a b. SP a b -> F a b
absF ([a]
-> SP
     (Either (InputMsg (Int, String)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
forall b.
[a]
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
pickSP [])) F TextRequest (InputMsg (Int, String))
altListF
  where
    pmod' :: Customiser TextF
pmod' = Customiser TextF
pmodCustomiser TextF -> Customiser TextF -> Customiser TextF
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Customiser TextF
forall xxx a.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont String
labelFont
    altListF :: F TextRequest (InputMsg (Int, String))
altListF = Bool
-> (Point, Point)
-> F TextRequest (InputMsg (Int, String))
-> F TextRequest (InputMsg (Int, String))
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)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
pickSP [a]
alts =
      Cont
  (SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a))))
  (Either (InputMsg (Int, b)) (PickListRequest a))
forall a b. Cont (SP a b) a
getSP Cont
  (SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a))))
  (Either (InputMsg (Int, b)) (PickListRequest a))
-> Cont
     (SP
        (Either (InputMsg (Int, b)) (PickListRequest a))
        (Either TextRequest (InputMsg (Int, a))))
     (Either (InputMsg (Int, b)) (PickListRequest a))
forall a b. (a -> b) -> a -> b
$ \Either (InputMsg (Int, b)) (PickListRequest a)
msg ->
      case Either (InputMsg (Int, b)) (PickListRequest a)
msg of
        Right plreq :: PickListRequest a
plreq@(ReplaceItems Int
from Int
cnt [a]
newalts') ->
	  let alts' :: [a]
alts' = PickListRequest a -> [a] -> [a]
forall a. ListRequest a -> [a] -> [a]
applyListRequest PickListRequest a
plreq [a]
alts
	      newalts :: [String]
newalts = (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
show [a]
newalts'
	  in Either TextRequest (InputMsg (Int, a))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
forall b a. b -> SP a b -> SP a b
putSP (TextRequest -> Either TextRequest (InputMsg (Int, a))
forall a b. a -> Either a b
Left (Int -> Int -> [String] -> TextRequest
forall a. Int -> Int -> [a] -> ListRequest a
replaceItems Int
from Int
cnt [String]
newalts)) (SP
   (Either (InputMsg (Int, b)) (PickListRequest a))
   (Either TextRequest (InputMsg (Int, a)))
 -> SP
      (Either (InputMsg (Int, b)) (PickListRequest a))
      (Either TextRequest (InputMsg (Int, a))))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
forall a b. (a -> b) -> a -> b
$
	     [a]
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
forall a a. [a] -> a -> a
evalSpine [a]
alts' (SP
   (Either (InputMsg (Int, b)) (PickListRequest a))
   (Either TextRequest (InputMsg (Int, a)))
 -> SP
      (Either (InputMsg (Int, b)) (PickListRequest a))
      (Either TextRequest (InputMsg (Int, a))))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
forall a b. (a -> b) -> a -> b
$ -- prevents a space leak
	     [a]
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
pickSP [a]
alts'
        Right (HighlightItems [Int]
ns) -> Either TextRequest (InputMsg (Int, a))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
forall b a. b -> SP a b -> SP a b
putSP (TextRequest -> Either TextRequest (InputMsg (Int, a))
forall a b. a -> Either a b
Left ([Int] -> TextRequest
forall a. [Int] -> ListRequest a
HighlightItems [Int]
ns)) (SP
   (Either (InputMsg (Int, b)) (PickListRequest a))
   (Either TextRequest (InputMsg (Int, a)))
 -> SP
      (Either (InputMsg (Int, b)) (PickListRequest a))
      (Either TextRequest (InputMsg (Int, a))))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
forall a b. (a -> b) -> a -> b
$ [a]
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
pickSP [a]
alts
	Right (PickItem Int
n) ->  Either TextRequest (InputMsg (Int, a))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
forall b a. b -> SP a b -> SP a b
putSP (TextRequest -> Either TextRequest (InputMsg (Int, a))
forall a b. a -> Either a b
Left (Int -> TextRequest
forall a. Int -> ListRequest a
PickItem Int
n)) (SP
   (Either (InputMsg (Int, b)) (PickListRequest a))
   (Either TextRequest (InputMsg (Int, a)))
 -> SP
      (Either (InputMsg (Int, b)) (PickListRequest a))
      (Either TextRequest (InputMsg (Int, a))))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
forall a b. (a -> b) -> a -> b
$ [a]
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
pickSP [a]
alts
	Left InputMsg (Int, b)
msg -> Either TextRequest (InputMsg (Int, a))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
forall b a. b -> SP a b -> SP a b
putSP (InputMsg (Int, a) -> Either TextRequest (InputMsg (Int, a))
forall a b. b -> Either a b
Right (((Int, b) -> (Int, a)) -> InputMsg (Int, b) -> InputMsg (Int, a)
forall t a. (t -> a) -> InputMsg t -> InputMsg a
mapInp (\(Int
n,b
_)->(Int
n,[a]
alts[a] -> Int -> a
forall a. [a] -> Int -> a
!!Int
n)) InputMsg (Int, b)
msg)) ([a]
-> SP
     (Either (InputMsg (Int, b)) (PickListRequest a))
     (Either TextRequest (InputMsg (Int, a)))
pickSP [a]
alts)

evalSpine :: [a] -> a -> a
evalSpine [] = a -> a
forall a. Customiser a
id
evalSpine (a
x:[a]
xs) = [a] -> a -> a
evalSpine [a]
xs