{-# LANGUAGE CPP #-}
module TextF(textF,textF',textF'',TextF,
	     TextRequest(..)) where
import Fudget
import FudgetIO
import FRequest
import NullF
import Utils
import Geometry
import Xtypes
import Event
import Command
import XDraw
import Dlayout
import DoubleClickF
import BgF
--import Color
--import EitherUtils(mapfilter)
import Data.Maybe(mapMaybe)
import Message(message) --Message(..),
import Font
--import LoadFont
import Gc
import InputMsg
import LayoutRequest
import Alignment(aLeft) --Alignment(..),
import Defaults(defaultFont,bgColor,fgColor)
import Sizing
import FDefaults
import GCAttrs --(ColorSpec,convColorK,colorSpec)
import ListRequest(ListRequest(..),listEnd)
#include "../defaults/defaults.h"

default(Int) -- mostly for Hugs


#ifndef __HBC__
#define fromInt fromIntegral
#endif

type TextRequest = ListRequest String

newtype TextF = Pars [Pars]

data Pars
  = BorderWidth Int
  | FgColorSpec ColorSpec
  | BgColorSpec ColorSpec
  | FontSpec FontSpec
  | Align Alignment
  | Margin Int
  | InitText [String]
--  | InitSize String
  | Stretchable (Bool,Bool)
  | Sizing Sizing

parameter_instance(BorderWidth,TextF)
parameter_instance(FgColorSpec,TextF)
parameter_instance(BgColorSpec,TextF)
parameter_instance(FontSpec,TextF)
parameter_instance(Align,TextF)
parameter_instance(Margin,TextF)
parameter_instance(InitText,TextF)
--parameter_instance(InitSize,TextF)
parameter_instance(Sizing,TextF)
parameter_instance(Stretchable,TextF)

textF :: F TextRequest (InputMsg (Int, String))
textF = Customiser TextF -> F TextRequest (InputMsg (Int, String))
textF' Customiser TextF
forall a. Customiser a
standard
textF' :: Customiser TextF -> F TextRequest (InputMsg (Int, String))
textF' Customiser TextF
pm = PF TextF TextRequest (InputMsg (Int, String))
-> F TextRequest (InputMsg (Int, String))
forall p a b. PF p a b -> F a b
noPF (PF TextF TextRequest (InputMsg (Int, String))
 -> F TextRequest (InputMsg (Int, String)))
-> PF TextF TextRequest (InputMsg (Int, String))
-> F TextRequest (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$ Customiser TextF -> PF TextF TextRequest (InputMsg (Int, String))
textF'' Customiser TextF
pm

textF'' :: Customiser TextF ->
           PF TextF TextRequest (InputMsg (Int, String))
textF'' :: Customiser TextF -> PF TextF TextRequest (InputMsg (Int, String))
textF'' Customiser TextF
pmod =
  let ps :: TextF
      ps :: TextF
ps = Customiser TextF
pmod ([Pars] -> TextF
Pars [Int -> Pars
BorderWidth Int
0,
                       ColorSpec -> Pars
FgColorSpec ColorSpec
textfg,
		       ColorSpec -> Pars
BgColorSpec ColorSpec
textbg,
		       Int -> Pars
Margin Int
2,
		       Alignment -> Pars
Align Alignment
aLeft,
		       [String] -> Pars
InitText [],--InitSize "",
		       (Bool, Bool) -> Pars
Stretchable (Bool
False,Bool
False),
		       Sizing -> Pars
Sizing Sizing
Dynamic,
		       FontSpec -> Pars
FontSpec (String -> FontSpec
forall a. (Show a, FontGen a) => a -> FontSpec
fontSpec String
defaultFont)])
      bw :: Int
bw = TextF -> Int
forall xxx. HasBorderWidth xxx => xxx -> Int
getBorderWidth TextF
ps
      fg :: ColorSpec
fg = TextF -> ColorSpec
forall xxx. HasFgColorSpec xxx => xxx -> ColorSpec
getFgColorSpec TextF
ps
      bg :: ColorSpec
bg = TextF -> ColorSpec
forall xxx. HasBgColorSpec xxx => xxx -> ColorSpec
getBgColorSpec TextF
ps
      font :: FontSpec
font = TextF -> FontSpec
forall xxx. HasFontSpec xxx => xxx -> FontSpec
getFontSpec TextF
ps
      init :: [String]
init = TextF -> [String]
forall xxx. HasInitText xxx => xxx -> [String]
getInitText TextF
ps
      minstr :: String
minstr = String
"" --getInitSize ps
      margin :: Int
margin = TextF -> Int
forall xxx. HasMargin xxx => xxx -> Int
getMargin TextF
ps
      align :: Alignment
align = TextF -> Alignment
forall xxx. HasAlign xxx => xxx -> Alignment
getAlign TextF
ps
      sizing :: Sizing
sizing = TextF -> Sizing
forall xxx. HasSizing xxx => xxx -> Sizing
getSizing TextF
ps
      stretch :: (Bool, Bool)
stretch = TextF -> (Bool, Bool)
forall xxx. HasStretchable xxx => xxx -> (Bool, Bool)
getStretchable TextF
ps

      eventmask :: [EventMask]
eventmask = [EventMask
ExposureMask, EventMask
ButtonPressMask]
      startcmds :: [FRequest]
startcmds = (XCommand -> FRequest) -> [XCommand] -> [FRequest]
forall a b. (a -> b) -> [a] -> [b]
map XCommand -> FRequest
XCmd 
                  [[WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
bw],
  		   [WindowAttributes] -> XCommand
ChangeWindowAttributes
		     [[EventMask] -> WindowAttributes
CWEventMask [EventMask]
eventmask
		      ,Gravity -> WindowAttributes
CWBitGravity (Alignment -> Gravity
horizAlignGravity Alignment
align)
		      ,PixmapId -> WindowAttributes
CWBackPixmap PixmapId
none -- elim flicker caused by XClearArea
		      ]]
  in Int
-> PF TextF TextRequest (InputMsg (Int, String))
-> PF TextF TextRequest (InputMsg (Int, String))
forall a b. Int -> F a b -> F a b
doubleClickF Int
doubleClickTime (PF TextF TextRequest (InputMsg (Int, String))
 -> PF TextF TextRequest (InputMsg (Int, String)))
-> PF TextF TextRequest (InputMsg (Int, String))
-> PF TextF TextRequest (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$
     [FRequest]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> PF TextF TextRequest (InputMsg (Int, String))
forall a b. [FRequest] -> K a b -> F a b
windowF [FRequest]
startcmds (K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
 -> PF TextF TextRequest (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> PF TextF TextRequest (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$ ColorSpec
-> ColorSpec
-> FontSpec
-> (Bool, Bool)
-> Alignment
-> Sizing
-> Int
-> String
-> [String]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a a a a.
(ColorGen a, ColorGen a, FontGen a, Show a, Show a, Show a,
 RealFrac a) =>
a
-> a
-> a
-> (Bool, Bool)
-> a
-> Sizing
-> Int
-> String
-> [String]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
textK0 ColorSpec
bg ColorSpec
fg FontSpec
font (Bool, Bool)
stretch Alignment
align Sizing
sizing Int
margin String
minstr [String]
init


textK0 :: a
-> a
-> a
-> (Bool, Bool)
-> a
-> Sizing
-> Int
-> String
-> [String]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
textK0 a
bg a
fg a
font (Bool
flexh,Bool
flexv) a
align Sizing
sizing Int
margin String
minstr [String]
init =
    a
-> (Pixel
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a i o.
(Show a, ColorGen a) =>
a -> (Pixel -> K i o) -> K i o
changeGetBackPixel a
bg ((Pixel
  -> K (Either (Customiser TextF) TextRequest)
       (InputMsg (Int, String)))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> (Pixel
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$ \ Pixel
bgcol ->
    a
-> (Pixel
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a (f :: * -> * -> *) i o.
(ColorGen a, FudgetIO f, Show a) =>
a -> (Pixel -> f i o) -> f i o
convColorK a
fg ((Pixel
  -> K (Either (Customiser TextF) TextRequest)
       (InputMsg (Int, String)))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> (Pixel
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$ \ Pixel
fgcol ->
    --allocNamedColorPixel defaultColormap fg $ \ fgcol ->
    a
-> (FontData
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a (f :: * -> * -> *) i o.
(FontGen a, FudgetIO f, Show a) =>
a -> (FontData -> f i o) -> f i o
convFontK a
font ((FontData
  -> K (Either (Customiser TextF) TextRequest)
       (InputMsg (Int, String)))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> (FontData
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$ \ FontData
fd ->
    FontData
-> (FontStruct
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall p. FontData -> (FontStruct -> p) -> p
fontdata2struct FontData
fd ((FontStruct
  -> K (Either (Customiser TextF) TextRequest)
       (InputMsg (Int, String)))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> (FontStruct
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$ \ FontStruct
fs ->
    GCId
-> [GCAttributes Pixel FontId]
-> (GCId
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
rootGC [FontId -> GCAttributes Pixel FontId
forall a b. b -> GCAttributes a b
GCFont (FontStruct -> FontId
forall per_char. FontStructF per_char -> FontId
font_id FontStruct
fs),
  		      Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
fgcol,
		      Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCBackground Pixel
bgcol] ((GCId
  -> K (Either (Customiser TextF) TextRequest)
       (InputMsg (Int, String)))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> (GCId
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$ \GCId
gc ->
    GCId
-> [GCAttributes Pixel FontId]
-> (GCId
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
gc     [Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
bgcol,
		      Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCBackground Pixel
fgcol] ((GCId
  -> K (Either (Customiser TextF) TextRequest)
       (InputMsg (Int, String)))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> (GCId
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$ \GCId
gcinv ->
    let minw :: Int
minw = FontStruct -> String -> Int
next_pos FontStruct
fs String
minstr
    in Pixel
-> GCId
-> GCId
-> FontStruct
-> Bool
-> Bool
-> a
-> Sizing
-> Int
-> Int
-> [String]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a.
RealFrac a =>
Pixel
-> GCId
-> GCId
-> FontStruct
-> Bool
-> Bool
-> a
-> Sizing
-> Int
-> Int
-> [String]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
textK1 Pixel
bgcol GCId
gc GCId
gcinv FontStruct
fs (Bool -> Bool
not Bool
flexh) (Bool -> Bool
not Bool
flexv) a
align Sizing
sizing Int
margin Int
minw [String]
init

textK1 :: Pixel
-> GCId
-> GCId
-> FontStruct
-> Bool
-> Bool
-> a
-> Sizing
-> Int
-> Int
-> [String]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
textK1 Pixel
bgcol GCId
gc GCId
gcinv FontStruct
fs Bool
fh Bool
fv a
align Sizing
sizing Int
margin Int
minw =
    Point
-> Point
-> [Int]
-> [(String, Int)]
-> Int
-> Int
-> [String]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall p.
Point
-> p
-> [Int]
-> [(String, Int)]
-> Int
-> Int
-> [String]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
replaceTextK Point
origin Point
origin [] [] Int
0 Int
listEnd
  where
    ll :: Point -> Message FRequest b
ll Point
size = FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (LayoutRequest -> FRequest
layoutRequestCmd (Point -> Bool -> Bool -> LayoutRequest
plainLayout Point
size Bool
fh Bool
fv))
    ls :: Int
ls = FontStruct -> Int
forall per_char. FontStructF per_char -> Int
linespace FontStruct
fs
    base :: Int
base = FontStruct -> Int
forall per_char. FontStructF per_char -> Int
font_ascent FontStruct
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
margin
    margsize :: Point
margsize = Int -> Point
diag (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
margin)

    measure :: [String] -> [(String, Int)]
measure = (String -> (String, Int)) -> [String] -> [(String, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Int) -> String -> (String, Int)
forall t b. (t -> b) -> t -> (t, b)
pairwith (FontStruct -> String -> Int
next_pos FontStruct
fs))
    txtwidth :: [(a, Int)] -> Int
txtwidth [(a, Int)]
mtxt = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
1Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
minwInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:((a, Int) -> Int) -> [(a, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (a, Int) -> Int
forall a b. (a, b) -> b
snd [(a, Int)]
mtxt)
                         -- 0 width not allowed for windows

    drimstr :: Point -> String -> DrawCommand
drimstr = if (Char, Char) -> Char
forall a b. (a, b) -> b
snd (FontStruct -> (Char, Char)
forall per_char. FontStructF per_char -> (Char, Char)
font_range FontStruct
fs) Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\xff'
              then Point -> String -> DrawCommand
DrawImageString16
	      else Point -> String -> DrawCommand
DrawImageString

    txtsize :: [(a, Int)] -> Point
txtsize [(a, Int)]
mtxt =
      let width :: Int
width = [(a, Int)] -> Int
forall a. [(a, Int)] -> Int
txtwidth [(a, Int)]
mtxt
	  height :: Int
height = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
*[(a, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, Int)]
mtxt)  -- 0 height not allowed for windows
      in Int -> Int -> Point
Point Int
width Int
height

    replaceTextK :: Point
-> p
-> [Int]
-> [(String, Int)]
-> Int
-> Int
-> [String]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
replaceTextK winsize :: Point
winsize@(Point Int
winwidth Int
winheight) p
size [Int]
sel [(String, Int)]
mtxt Int
dfrom Int
dcnt [String]
newtxt=
      let lines :: Int
lines     = [(String, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Int)]
mtxt
	  from :: Int
from      = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
lines (if Int
dfromInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
listEnd then Int
lines else Int
dfrom)
	  after :: Int
after     = Int
linesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
from
	  cnt :: Int
cnt       = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
after (if Int
dcntInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
listEnd then Int
after else Int
dcnt)
	  newcnt :: Int
newcnt    = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
newtxt
	  diff :: Int
diff      = Int
newcntInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
cnt
	  scrollsize :: Int
scrollsize= Int
afterInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
cnt
	  newlines :: Int
newlines  = Int
linesInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
diff
	  sel' :: [Int]
sel'      = (Int -> Maybe Int) -> [Int] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Int -> Maybe Int
reloc [Int]
sel
	  reloc :: Int -> Maybe Int
reloc Int
n   = if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
from then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
		      else if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
fromInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
cnt then Maybe Int
forall a. Maybe a
Nothing
		      else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
diff)
	  mtxt' :: [(String, Int)]
mtxt'     = Int -> [(String, Int)] -> [(String, Int)]
forall a. Int -> [a] -> [a]
take Int
from [(String, Int)]
mtxt [(String, Int)] -> [(String, Int)] -> [(String, Int)]
forall a. [a] -> [a] -> [a]
++ [String] -> [(String, Int)]
measure [String]
newtxt [(String, Int)] -> [(String, Int)] -> [(String, Int)]
forall a. [a] -> [a] -> [a]
++ 
		      (if Int
scrollsizeInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 then Int -> [(String, Int)] -> [(String, Int)]
forall a. Int -> [a] -> [a]
drop (Int
fromInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
cnt) [(String, Int)]
mtxt else [])
	  newwidth :: Int
newwidth  = [(String, Int)] -> Int
forall a. [(a, Int)] -> Int
txtwidth [(String, Int)]
mtxt'
	  newsize :: Point
newsize   = Int -> Int -> Point
Point Int
newwidth (Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
newlines)
	  llcmd :: [Message FRequest b]
llcmd     = let realwinsize :: Point
realwinsize@(Point Int
w Int
h) = Point
winsizePoint -> Point -> Point
forall a. Num a => a -> a -> a
+Int -> Point
diag Int
margin
	                  winsize' :: Point
winsize'@(Point Int
w' Int
h') = Point
newsize Point -> Point -> Point
forall a. Num a => a -> a -> a
+Point
margsize
	                  change :: Bool
change =
			    Point
winsizePoint -> Point -> Bool
forall a. Eq a => a -> a -> Bool
==Point
origin Bool -> Bool -> Bool
||
			    Sizing -> Point -> Point -> Point
newSize Sizing
sizing Point
realwinsize Point
winsize'Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/=Point
realwinsize
	              in if Bool
change
		      then [Point -> Message FRequest b
forall b. Point -> Message FRequest b
ll (Point
newsize Point -> Point -> Point
forall a. Num a => a -> a -> a
+ Point
margsize)]
		      else []
	  --width     = xcoord size
	  drawwidth :: Int
drawwidth = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
newwidth (Int
winwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
margin)
		       -- !! always scrolls/clears the full width of the window
	  scrollrect :: Rect
scrollrect= Int -> Int -> Int -> Int -> Rect
rR Int
margin (Int
marginInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
fromInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
cnt))
	                 Int
drawwidth (Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
scrollsize)
	  scrolldest :: Point
scrolldest= Int -> Int -> Point
Point Int
margin (Int
marginInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
fromInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
newcnt))
	  scrollcmd :: [Message FRequest b]
scrollcmd = if Int
scrollsizeInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
&& Int
diffInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0
		      then [FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (GCId -> DrawCommand -> FRequest
wDraw GCId
gc (DrawCommand -> FRequest) -> DrawCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ Drawable -> Rect -> Point -> DrawCommand
CopyArea Drawable
MyWindow Rect
scrollrect Point
scrolldest)]
		      else []
	  drawrect :: Rect
drawrect  = Int -> Int -> Int -> Int -> Rect
rR Int
margin (Int
marginInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
from) (Int
drawwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
margin) (Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
newcnt)
	                 -- add margin to width to erase text in the margin
			 -- when the text is wider than the window.
	  belowrect :: Rect
belowrect = Int -> Int -> Int -> Int -> Rect
rR Int
margin (Int
marginInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
newlines) Int
drawwidth (-Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
diff)
	  clearcmd :: [Message FRequest b]
clearcmd  = (if Int
newcntInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0
		       then let vrect :: Rect
vrect = Rect -> Point -> Rect
growrect Rect
drawrect (Int -> Int -> Point
pP Int
5 Int
5) -- !! tmp fix
		           in Rect -> Bool -> [Message FRequest b]
forall b. Rect -> Bool -> [Message FRequest b]
clearArea Rect
drawrect Bool
True[Message FRequest b]
-> [Message FRequest b] -> [Message FRequest b]
forall a. [a] -> [a] -> [a]
++
		              [FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (LayoutMessage -> FRequest
LCmd (Rect -> LayoutMessage
layoutMakeVisible Rect
vrect))]
		       else [])[Message FRequest b]
-> [Message FRequest b] -> [Message FRequest b]
forall a. [a] -> [a] -> [a]
++
		       (if Int
diffInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0
		        then [FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (FRequest -> Message FRequest b) -> FRequest -> Message FRequest b
forall a b. (a -> b) -> a -> b
$ XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ Rect -> Bool -> XCommand
ClearArea Rect
belowrect Bool
False]
			     -- Needed because of margin and other things
			     -- that cause the window to be taller than the
			     -- text.
			     -- clearcmd must be done after scrollcmd !!
			else [])
	  clearArea :: Rect -> Bool -> [Message FRequest b]
clearArea Rect
r Bool
e = (XCommand -> Message FRequest b)
-> [XCommand] -> [Message FRequest b]
forall a b. (a -> b) -> [a] -> [b]
map (FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (FRequest -> Message FRequest b)
-> (XCommand -> FRequest) -> XCommand -> Message FRequest b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XCommand -> FRequest
XCmd) 
	                  [[WindowAttributes] -> XCommand
ChangeWindowAttributes [PixmapId -> WindowAttributes
CWBackPixmap PixmapId
none],
	                   Rect -> Bool -> XCommand
ClearArea Rect
r Bool
e,
			   [WindowAttributes] -> XCommand
ChangeWindowAttributes [Pixel -> WindowAttributes
CWBackPixel Pixel
bgcol]]
			-- Some backround may be lost if the windows becomes
			-- obscured while the BackPixmap is none !!!
      in if Int
diffInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0
	 then [KCommand (InputMsg (Int, String))]
-> (Point
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall b a. [KCommand b] -> (Point -> K a b) -> K a b
resizeK [KCommand (InputMsg (Int, String))]
forall b. [Message FRequest b]
llcmd ((Point
  -> K (Either (Customiser TextF) TextRequest)
       (InputMsg (Int, String)))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> (Point
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$ \ Point
newwinsize ->
	      [KCommand (InputMsg (Int, String))]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall b a. [KCommand b] -> K a b -> K a b
putsK ([KCommand (InputMsg (Int, String))]
forall b. [Message FRequest b]
scrollcmd[KCommand (InputMsg (Int, String))]
-> [KCommand (InputMsg (Int, String))]
-> [KCommand (InputMsg (Int, String))]
forall a. [a] -> [a] -> [a]
++[KCommand (InputMsg (Int, String))]
forall b. [Message FRequest b]
clearcmd) (K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$
	      Point
-> Point
-> [Int]
-> [(String, Int)]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
textK (Point
newwinsize Point -> Point -> Point
forall a. Num a => a -> a -> a
- Int -> Point
diag Int
margin) Point
newsize [Int]
sel' [(String, Int)]
mtxt'
	 else [KCommand (InputMsg (Int, String))]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall b a. [KCommand b] -> K a b -> K a b
putsK ([KCommand (InputMsg (Int, String))]
forall b. [Message FRequest b]
scrollcmd[KCommand (InputMsg (Int, String))]
-> [KCommand (InputMsg (Int, String))]
-> [KCommand (InputMsg (Int, String))]
forall a. [a] -> [a] -> [a]
++[KCommand (InputMsg (Int, String))]
forall b. [Message FRequest b]
clearcmd[KCommand (InputMsg (Int, String))]
-> [KCommand (InputMsg (Int, String))]
-> [KCommand (InputMsg (Int, String))]
forall a. [a] -> [a] -> [a]
++[KCommand (InputMsg (Int, String))]
forall b. [Message FRequest b]
llcmd) (K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$
	      Point
-> Point
-> [Int]
-> [(String, Int)]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
textK Point
winsize Point
newsize [Int]
sel' [(String, Int)]
mtxt'

    textK :: Size -> Size -> [Int] -> [(String,Int)] ->
             PK TextF TextRequest (InputMsg (Int,String))
    textK :: Point
-> Point
-> [Int]
-> [(String, Int)]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
textK winsize :: Point
winsize@(Point Int
winwidth Int
_) Point
size [Int]
sel [(String, Int)]
mtxt =
       -- winsize is the size of the window excluding the right & bottom margins
	Cont
  (K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String)))
  (KEvent (Either (Customiser TextF) TextRequest))
forall hi ho. Cont (K hi ho) (KEvent hi)
getK Cont
  (K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String)))
  (KEvent (Either (Customiser TextF) TextRequest))
-> Cont
     (K (Either (Customiser TextF) TextRequest)
        (InputMsg (Int, String)))
     (KEvent (Either (Customiser TextF) TextRequest))
forall a b. (a -> b) -> a -> b
$ (FResponse
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> (Either (Customiser TextF) TextRequest
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> KEvent (Either (Customiser TextF) TextRequest)
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall t1 p t2. (t1 -> p) -> (t2 -> p) -> Message t1 t2 -> p
message FResponse
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
lowK ((Customiser TextF
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> (TextRequest
    -> K (Either (Customiser TextF) TextRequest)
         (InputMsg (Int, String)))
-> Either (Customiser TextF) TextRequest
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Customiser TextF
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall p.
p
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
paramChangeK TextRequest
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
textRequestK)
      where
        same :: K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
same = Point
-> Point
-> [Int]
-> [(String, Int)]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
textK Point
winsize Point
size [Int]
sel [(String, Int)]
mtxt
	textRequestK :: TextRequest
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
textRequestK TextRequest
msg =
	    case TextRequest
msg of
	      ReplaceItems Int
dfrom Int
dcnt [String]
newtxt ->
		Point
-> Point
-> [Int]
-> [(String, Int)]
-> Int
-> Int
-> [String]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall p.
Point
-> p
-> [Int]
-> [(String, Int)]
-> Int
-> Int
-> [String]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
replaceTextK Point
winsize Point
size [Int]
sel [(String, Int)]
mtxt Int
dfrom Int
dcnt [String]
newtxt
	      HighlightItems [Int]
sel' ->
		[Int]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall (t :: * -> *) a b. Foldable t => t Int -> K a b -> K a b
changeHighlightK [Int]
sel' (K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$
		Point
-> Point
-> [Int]
-> [(String, Int)]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
textK Point
winsize Point
size [Int]
sel' [(String, Int)]
mtxt
	      PickItem Int
n -> ((Int, String) -> InputMsg (Int, String))
-> Int
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
output (Int, String) -> InputMsg (Int, String)
forall a. a -> InputMsg a
inputMsg Int
n
	      TextRequest
_ -> K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
same
	lowK :: FResponse
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
lowK FResponse
event =
	    case FResponse
event of
	      XEvt (ButtonEvent {button :: XEvent -> Button
button=Button Int
1,pos :: XEvent -> Point
pos=Point Int
_ Int
y, type' :: XEvent -> Pressed
type'=Pressed
press}) ->
		let l :: Int
l=Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
ls
		    pressmsg :: a -> InputMsg a
pressmsg = case Pressed
press of
				 MultiClick Int
2 -> a -> InputMsg a
forall a. a -> InputMsg a
inputMsg
				 Pressed
_ -> a -> InputMsg a
forall a. a -> InputMsg a
InputChange
		in ((Int, String) -> InputMsg (Int, String))
-> Int
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
output (Int, String) -> InputMsg (Int, String)
forall a. a -> InputMsg a
pressmsg Int
l
	      XEvt (Expose {rect :: XEvent -> Rect
rect=Rect
r}) ->
		Rect
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. Rect -> K a b -> K a b
redrawTextK Rect
r (K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$
		K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
same
	      XEvt (GraphicsExpose {rect :: XEvent -> Rect
rect=Rect
r}) ->
		Rect
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. Rect -> K a b -> K a b
redrawTextK Rect
r (K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$
		K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
same
	      LEvt (LayoutSize Point
newwinsize) ->
	        Point
-> Point
-> [Int]
-> [(String, Int)]
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
textK (Point
newwinsize Point -> Point -> Point
forall a. Num a => a -> a -> a
- Int -> Point
diag Int
margin) Point
size [Int]
sel [(String, Int)]
mtxt
	      FResponse
_ -> K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
same
	paramChangeK :: p
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
paramChangeK p
_ = K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
same -- !!! Dynamic customisation not implemented yet
        output :: ((Int, String) -> InputMsg (Int, String))
-> Int
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
output (Int, String) -> InputMsg (Int, String)
pressmsg Int
l = (if Int
lInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& Int
lInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<[(String, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Int)]
mtxt
	                     then KCommand (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (InputMsg (Int, String) -> KCommand (InputMsg (Int, String))
forall a b. b -> Message a b
High ((Int, String) -> InputMsg (Int, String)
pressmsg (Int
l,(String, Int) -> String
forall a b. (a, b) -> a
fst([(String, Int)]
mtxt[(String, Int)] -> Int -> (String, Int)
forall a. [a] -> Int -> a
!!Int
l))))
			     else K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a. Customiser a
id) (K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
 -> K (Either (Customiser TextF) TextRequest)
      (InputMsg (Int, String)))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
-> K (Either (Customiser TextF) TextRequest)
     (InputMsg (Int, String))
forall a b. (a -> b) -> a -> b
$ K (Either (Customiser TextF) TextRequest) (InputMsg (Int, String))
same

	changeHighlightK :: t Int -> K a b -> K a b
changeHighlightK t Int
sel' =
	    [KCommand b] -> K a b -> K a b
forall b a. [KCommand b] -> K a b -> K a b
putsK ([KCommand b]
forall b. [Message FRequest b]
mkvis[KCommand b] -> [KCommand b] -> [KCommand b]
forall a. [a] -> [a] -> [a]
++[FRequest -> KCommand b
forall a b. a -> Message a b
Low (FRequest -> KCommand b) -> FRequest -> KCommand b
forall a b. (a -> b) -> a -> b
$ [(GCId, [DrawCommand])] -> FRequest
wDrawMany (((Int, (String, Int)) -> (GCId, [DrawCommand]))
-> [(Int, (String, Int))] -> [(GCId, [DrawCommand])]
forall a b. (a -> b) -> [a] -> [b]
map (Int, (String, Int)) -> (GCId, [DrawCommand])
draw [(Int, (String, Int))]
changes)])
	  where
	    changed :: Int -> Bool
changed Int
n = (Int
n Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
sel) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
n Int -> t Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Int
sel')
	    nmtxt :: [(Int, (String, Int))]
nmtxt = Int -> [(String, Int)] -> [(Int, (String, Int))]
forall a. Int -> [a] -> [(Int, a)]
number Int
0 [(String, Int)]
mtxt
	    changes :: [(Int, (String, Int))]
changes = [(Int, (String, Int))
l | l :: (Int, (String, Int))
l@(Int
n,(String, Int)
_)<-[(Int, (String, Int))]
nmtxt, Int -> Bool
changed Int
n]
	    selected :: [(Int, (String, Int))]
selected = [(Int, (String, Int))
l | l :: (Int, (String, Int))
l@(Int
n,(String, Int)
_)<-[(Int, (String, Int))]
nmtxt, Int
n Int -> t Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Int
sel']
	    draw :: (Int, (String, Int)) -> (GCId, [DrawCommand])
draw (Int
n,(String
s,Int
w)) = (t Int -> Int -> GCId
forall (t :: * -> *) a. (Foldable t, Eq a) => t a -> a -> GCId
dgc t Int
sel' Int
n,[Point -> String -> DrawCommand
drimstr (Int -> Int -> Point
Point (Int -> Int
x0 Int
w) (Int
baseInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ls)) String
s])
	    mkvis :: [Message FRequest b]
mkvis =
	      case ([(Int, (String, Int))]
selected,[(Int, (String, Int))] -> (Int, (String, Int))
forall a. [a] -> a
last [(Int, (String, Int))]
selected) of -- needs lazy evalution!
		([],(Int, (String, Int))
_) -> []
		((Int
n1,(String
_,Int
w1)):[(Int, (String, Int))]
_,(Int
n2,(String
_,Int
w2))) ->
		    [FRequest -> Message FRequest b
forall a b. a -> Message a b
Low (LayoutMessage -> FRequest
LCmd (Rect -> LayoutMessage
layoutMakeVisible Rect
vrect))]
		  where vrect :: Rect
vrect = Int -> Int -> Int -> Int -> Rect
rR Int
x1 Int
y1 (Int
x2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
5) (Int
y2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
y1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
5)
                        x1 :: Int
x1 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int
x0 Int
w1) (Int -> Int
x0 Int
w2) -- !!! Should use min/max
			x2 :: Int
x2 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int
x0 Int
w1) (Int -> Int
x0 Int
w2) -- !!! of all changes.
			y1 :: Int
y1 = Int
n1Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ls
			y2 :: Int
y2 = (Int
n2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ls

	redrawTextK :: Rect -> K a b -> K a b
redrawTextK r :: Rect
r@(Rect (Point Int
x Int
y) (Point Int
w Int
h)) =
	  let first :: Int
first = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
margin)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
ls
	      last :: Int
last = (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
ls
	      lines :: [(Int, (String, Int))]
lines = Int -> [(String, Int)] -> [(Int, (String, Int))]
forall a. Int -> [a] -> [(Int, a)]
number Int
first (Int -> [(String, Int)] -> [(String, Int)]
forall a. Int -> [a] -> [a]
take (Int
lastInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
firstInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> [(String, Int)] -> [(String, Int)]
forall a. Int -> [a] -> [a]
drop Int
first [(String, Int)]
mtxt))
	      firsty :: Int
firsty = Int
baseInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
first
	      ys :: [Int]
ys = [Int
firsty,Int
firstyInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ls..]
	  in [KCommand b] -> K a b -> K a b
forall b a. [KCommand b] -> K a b -> K a b
putsK [FRequest -> KCommand b
forall a b. a -> Message a b
Low (FRequest -> KCommand b) -> FRequest -> KCommand b
forall a b. (a -> b) -> a -> b
$ XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ Rect -> Bool -> XCommand
ClearArea Rect
r Bool
False,
		    FRequest -> KCommand b
forall a b. a -> Message a b
Low (FRequest -> KCommand b) -> FRequest -> KCommand b
forall a b. (a -> b) -> a -> b
$ [(GCId, [DrawCommand])] -> FRequest
wDrawMany
	             [([Int] -> Int -> GCId
forall (t :: * -> *) a. (Foldable t, Eq a) => t a -> a -> GCId
dgc [Int]
sel Int
n,[Point -> String -> DrawCommand
drimstr (Int -> Int -> Point
Point Int
x1 Int
ly) String
s]) | 
		     ((Int
n,String
s,Int
x1,Int
x2),Int
ly)<-[(Int, String, Int, Int)]
-> [Int] -> [((Int, String, Int, Int), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Int, (String, Int)) -> (Int, String, Int, Int))
-> [(Int, (String, Int))] -> [(Int, String, Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, (String, Int)) -> (Int, String, Int, Int)
forall a b. (a, (b, Int)) -> (a, b, Int, Int)
xi [(Int, (String, Int))]
lines) [Int]
ys,Int
xInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
x2 Bool -> Bool -> Bool
&& (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w)Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
x1]]
		     -- !! The x coordnates should probably be stored
		     -- rather than recomputed every time the text is
		     -- redrawn...

        xi :: (a, (b, Int)) -> (a, b, Int, Int)
xi (a
n,(b
s,Int
w)) = (a
n,b
s,Int
x1,Int
x2) where x1 :: Int
x1=Int -> Int
x0 Int
w; x2 :: Int
x2=Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w
        x0 :: Int -> Int
x0 Int
w = Int
marginInt -> Int -> Int
forall a. Num a => a -> a -> a
+a -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (a
aligna -> a -> a
forall a. Num a => a -> a -> a
*fromInt (winwidth-margin-w))
	       -- !!! Problem: can't be sure that bitgravity moves stuff
	       -- to the same pixel coordinates that are computed here...

    dgc :: t a -> a -> GCId
dgc t a
sel a
n = if a
n a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
sel -- inefficient !!
                then GCId
gcinv
		else GCId
gc

resizeK :: [KCommand b] -> (Point -> K a b) -> K a b
resizeK [KCommand b]
cmd Point -> K a b
cont = [KCommand b] -> K a b -> K a b
forall b a. [KCommand b] -> K a b -> K a b
putsK [KCommand b]
cmd (K a b -> K a b) -> K a b -> K a b
forall a b. (a -> b) -> a -> b
$ (KEvent a -> Maybe Point) -> (Point -> K a b) -> K a b
forall (f :: * -> * -> *) hi ans ho.
FudgetIO f =>
(KEvent hi -> Maybe ans) -> Cont (f hi ho) ans
waitForMsg KEvent a -> Maybe Point
forall b. Message FResponse b -> Maybe Point
ans ((Point -> K a b) -> K a b) -> (Point -> K a b) -> K a b
forall a b. (a -> b) -> a -> b
$ Point -> K a b
cont
  where ans :: Message FResponse b -> Maybe Point
ans (Low (LEvt (LayoutSize Point
newsize))) = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
newsize
        ans Message FResponse b
_ = Maybe Point
forall a. Maybe a
Nothing

doubleClickTime :: Int
doubleClickTime = Int
400 -- The double click timeout should not be hard wired like this...
textbg :: ColorSpec
textbg = [String] -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec [String
bgColor,String
"white"]
textfg :: ColorSpec
textfg = [String] -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec [String
fgColor,String
"black"]

horizAlignGravity :: Alignment -> Gravity
horizAlignGravity Alignment
align =
    case (Alignment
align::Alignment) of
      Alignment
0 -> Gravity
NorthWestGravity
      Alignment
0.5 -> Gravity
NorthGravity
      Alignment
1 -> Gravity
NorthEastGravity
      Alignment
_ -> Gravity
ForgetGravity

--take' n | n>=0 = take n