{-# 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 Data.Maybe(mapMaybe)
import Message(message)
import Font
import Gc
import InputMsg
import LayoutRequest
import Alignment(aLeft)
import Defaults(defaultFont,bgColor,fgColor)
import Sizing
import FDefaults
import GCAttrs
import ListRequest(ListRequest(..),listEnd)
#include "../defaults/defaults.h"
default(Int)
#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]
| 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(Sizing,TextF)
parameter_instance(Stretchable,TextF)
textF :: F TextRequest (InputMsg (Int, FontName))
textF = Customiser TextF -> F TextRequest (InputMsg (Int, FontName))
textF' forall a. Customiser a
standard
textF' :: Customiser TextF -> F TextRequest (InputMsg (Int, FontName))
textF' Customiser TextF
pm = forall p a b. PF p a b -> F a b
noPF forall a b. (a -> b) -> a -> b
$ Customiser TextF -> PF TextF TextRequest (InputMsg (Int, FontName))
textF'' Customiser TextF
pm
textF'' :: Customiser TextF ->
PF TextF TextRequest (InputMsg (Int, String))
textF'' :: Customiser TextF -> PF TextF TextRequest (InputMsg (Int, FontName))
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,
[FontName] -> Pars
InitText [],
(Bool, Bool) -> Pars
Stretchable (Bool
False,Bool
False),
Sizing -> Pars
Sizing Sizing
Dynamic,
FontSpec -> Pars
FontSpec (forall {a}. (Show a, FontGen a) => a -> FontSpec
fontSpec FontName
defaultFont)])
bw :: Int
bw = forall xxx. HasBorderWidth xxx => xxx -> Int
getBorderWidth TextF
ps
fg :: ColorSpec
fg = forall xxx. HasFgColorSpec xxx => xxx -> ColorSpec
getFgColorSpec TextF
ps
bg :: ColorSpec
bg = forall xxx. HasBgColorSpec xxx => xxx -> ColorSpec
getBgColorSpec TextF
ps
font :: FontSpec
font = forall xxx. HasFontSpec xxx => xxx -> FontSpec
getFontSpec TextF
ps
init :: [FontName]
init = forall xxx. HasInitText xxx => xxx -> [FontName]
getInitText TextF
ps
minstr :: FontName
minstr = FontName
""
margin :: Int
margin = forall xxx. HasMargin xxx => xxx -> Int
getMargin TextF
ps
align :: Alignment
align = forall xxx. HasAlign xxx => xxx -> Alignment
getAlign TextF
ps
sizing :: Sizing
sizing = forall xxx. HasSizing xxx => xxx -> Sizing
getSizing TextF
ps
stretch :: (Bool, Bool)
stretch = forall xxx. HasStretchable xxx => xxx -> (Bool, Bool)
getStretchable TextF
ps
eventmask :: [EventMask]
eventmask = [EventMask
ExposureMask, EventMask
ButtonPressMask]
startcmds :: [FRequest]
startcmds = 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
]]
in forall a b. Int -> F a b -> F a b
doubleClickF Int
doubleClickTime forall a b. (a -> b) -> a -> b
$
forall a b. [FRequest] -> K a b -> F a b
windowF [FRequest]
startcmds forall a b. (a -> b) -> a -> b
$ forall {a} {a} {a} {p}.
(ColorGen a, ColorGen a, FontGen a, Show a, Show a, Show a,
RealFrac p) =>
a
-> a
-> a
-> (Bool, Bool)
-> p
-> Sizing
-> Int
-> FontName
-> [FontName]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
textK0 ColorSpec
bg ColorSpec
fg FontSpec
font (Bool, Bool)
stretch Alignment
align Sizing
sizing Int
margin FontName
minstr [FontName]
init
textK0 :: a
-> a
-> a
-> (Bool, Bool)
-> p
-> Sizing
-> Int
-> FontName
-> [FontName]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
textK0 a
bg a
fg a
font (Bool
flexh,Bool
flexv) p
align Sizing
sizing Int
margin FontName
minstr [FontName]
init =
forall {a} {i} {o}.
(Show a, ColorGen a) =>
a -> (Pixel -> K i o) -> K i o
changeGetBackPixel a
bg forall a b. (a -> b) -> a -> b
$ \ Pixel
bgcol ->
forall {a} {f :: * -> * -> *} {i} {o}.
(ColorGen a, FudgetIO f, Show a) =>
a -> (Pixel -> f i o) -> f i o
convColorK a
fg forall a b. (a -> b) -> a -> b
$ \ Pixel
fgcol ->
forall {a} {f :: * -> * -> *} {i} {o}.
(FontGen a, FudgetIO f, Show a) =>
a -> (FontData -> f i o) -> f i o
convFontK a
font forall a b. (a -> b) -> a -> b
$ \ FontData
fd ->
forall {t}. FontData -> (FontStruct -> t) -> t
fontdata2struct FontData
fd forall a b. (a -> b) -> a -> b
$ \ FontStruct
fs ->
forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
rootGC [forall a b. b -> GCAttributes a b
GCFont (forall per_char. FontStructF per_char -> FontId
font_id FontStruct
fs),
forall a b. a -> GCAttributes a b
GCForeground Pixel
fgcol,
forall a b. a -> GCAttributes a b
GCBackground Pixel
bgcol] forall a b. (a -> b) -> a -> b
$ \GCId
gc ->
forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
gc [forall a b. a -> GCAttributes a b
GCForeground Pixel
bgcol,
forall a b. a -> GCAttributes a b
GCBackground Pixel
fgcol] forall a b. (a -> b) -> a -> b
$ \GCId
gcinv ->
let minw :: Int
minw = FontStruct -> FontName -> Int
next_pos FontStruct
fs FontName
minstr
in forall {p}.
RealFrac p =>
Pixel
-> GCId
-> GCId
-> FontStruct
-> Bool
-> Bool
-> p
-> Sizing
-> Int
-> Int
-> [FontName]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
textK1 Pixel
bgcol GCId
gc GCId
gcinv FontStruct
fs (Bool -> Bool
not Bool
flexh) (Bool -> Bool
not Bool
flexv) p
align Sizing
sizing Int
margin Int
minw [FontName]
init
textK1 :: Pixel
-> GCId
-> GCId
-> FontStruct
-> Bool
-> Bool
-> p
-> Sizing
-> Int
-> Int
-> [FontName]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
textK1 Pixel
bgcol GCId
gc GCId
gcinv FontStruct
fs Bool
fh Bool
fv p
align Sizing
sizing Int
margin Int
minw =
forall {p}.
Point
-> p
-> [Int]
-> [(FontName, Int)]
-> Int
-> Int
-> [FontName]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
replaceTextK Point
origin Point
origin [] [] Int
0 Int
listEnd
where
ll :: Point -> Message FRequest b
ll Point
size = 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 = forall {per_char}. FontStructF per_char -> Int
linespace FontStruct
fs
base :: Int
base = forall {per_char}. FontStructF per_char -> Int
font_ascent FontStruct
fs forall a. Num a => a -> a -> a
+ Int
margin
margsize :: Point
margsize = Int -> Point
diag (Int
2forall a. Num a => a -> a -> a
*Int
margin)
measure :: [FontName] -> [(FontName, Int)]
measure = forall a b. (a -> b) -> [a] -> [b]
map (forall {t} {b}. (t -> b) -> t -> (t, b)
pairwith (FontStruct -> FontName -> Int
next_pos FontStruct
fs))
txtwidth :: [(a, Int)] -> Int
txtwidth [(a, Int)]
mtxt = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
1forall a. a -> [a] -> [a]
:Int
minwforall a. a -> [a] -> [a]
:forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, Int)]
mtxt)
drimstr :: Point -> FontName -> DrawCommand
drimstr = if forall a b. (a, b) -> b
snd (forall {per_char}. FontStructF per_char -> (Char, Char)
font_range FontStruct
fs) forall a. Ord a => a -> a -> Bool
> Char
'\xff'
then Point -> FontName -> DrawCommand
DrawImageString16
else Point -> FontName -> DrawCommand
DrawImageString
txtsize :: [(a, Int)] -> Point
txtsize [(a, Int)]
mtxt =
let width :: Int
width = forall {a}. [(a, Int)] -> Int
txtwidth [(a, Int)]
mtxt
height :: Int
height = forall a. Ord a => a -> a -> a
max Int
1 (Int
lsforall a. Num a => a -> a -> a
*forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, Int)]
mtxt)
in Int -> Int -> Point
Point Int
width Int
height
replaceTextK :: Point
-> p
-> [Int]
-> [(FontName, Int)]
-> Int
-> Int
-> [FontName]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
replaceTextK winsize :: Point
winsize@(Point Int
winwidth Int
winheight) p
size [Int]
sel [(FontName, Int)]
mtxt Int
dfrom Int
dcnt [FontName]
newtxt=
let lines :: Int
lines = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FontName, Int)]
mtxt
from :: Int
from = forall a. Ord a => a -> a -> a
min Int
lines (if Int
dfromforall a. Eq a => a -> a -> Bool
==Int
listEnd then Int
lines else Int
dfrom)
after :: Int
after = Int
linesforall a. Num a => a -> a -> a
-Int
from
cnt :: Int
cnt = forall a. Ord a => a -> a -> a
min Int
after (if Int
dcntforall a. Eq a => a -> a -> Bool
==Int
listEnd then Int
after else Int
dcnt)
newcnt :: Int
newcnt = forall (t :: * -> *) a. Foldable t => t a -> Int
length [FontName]
newtxt
diff :: Int
diff = Int
newcntforall a. Num a => a -> a -> a
-Int
cnt
scrollsize :: Int
scrollsize= Int
afterforall a. Num a => a -> a -> a
-Int
cnt
newlines :: Int
newlines = Int
linesforall a. Num a => a -> a -> a
+Int
diff
sel' :: [Int]
sel' = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Int -> Maybe Int
reloc [Int]
sel
reloc :: Int -> Maybe Int
reloc Int
n = if Int
nforall a. Ord a => a -> a -> Bool
<Int
from then forall a. a -> Maybe a
Just Int
n
else if Int
nforall a. Ord a => a -> a -> Bool
<Int
fromforall a. Num a => a -> a -> a
+Int
cnt then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (Int
nforall a. Num a => a -> a -> a
+Int
diff)
mtxt' :: [(FontName, Int)]
mtxt' = forall a. Int -> [a] -> [a]
take Int
from [(FontName, Int)]
mtxt forall a. [a] -> [a] -> [a]
++ [FontName] -> [(FontName, Int)]
measure [FontName]
newtxt forall a. [a] -> [a] -> [a]
++
(if Int
scrollsizeforall a. Ord a => a -> a -> Bool
>Int
0 then forall a. Int -> [a] -> [a]
drop (Int
fromforall a. Num a => a -> a -> a
+Int
cnt) [(FontName, Int)]
mtxt else [])
newwidth :: Int
newwidth = forall {a}. [(a, Int)] -> Int
txtwidth [(FontName, Int)]
mtxt'
newsize :: Point
newsize = Int -> Int -> Point
Point Int
newwidth (Int
lsforall a. Num a => a -> a -> a
*Int
newlines)
llcmd :: [Message FRequest b]
llcmd = let realwinsize :: Point
realwinsize@(Point Int
w Int
h) = Point
winsizeforall a. Num a => a -> a -> a
+Int -> Point
diag Int
margin
winsize' :: Point
winsize'@(Point Int
w' Int
h') = Point
newsize forall a. Num a => a -> a -> a
+Point
margsize
change :: Bool
change =
Point
winsizeforall a. Eq a => a -> a -> Bool
==Point
origin Bool -> Bool -> Bool
||
Sizing -> Point -> Point -> Point
newSize Sizing
sizing Point
realwinsize Point
winsize'forall a. Eq a => a -> a -> Bool
/=Point
realwinsize
in if Bool
change
then [forall {b}. Point -> Message FRequest b
ll (Point
newsize forall a. Num a => a -> a -> a
+ Point
margsize)]
else []
drawwidth :: Int
drawwidth = forall a. Ord a => a -> a -> a
max Int
newwidth (Int
winwidthforall a. Num a => a -> a -> a
-Int
margin)
scrollrect :: Rect
scrollrect= Int -> Int -> Int -> Int -> Rect
rR Int
margin (Int
marginforall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
*(Int
fromforall a. Num a => a -> a -> a
+Int
cnt))
Int
drawwidth (Int
lsforall a. Num a => a -> a -> a
*Int
scrollsize)
scrolldest :: Point
scrolldest= Int -> Int -> Point
Point Int
margin (Int
marginforall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
*(Int
fromforall a. Num a => a -> a -> a
+Int
newcnt))
scrollcmd :: [Message FRequest b]
scrollcmd = if Int
scrollsizeforall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
&& Int
diffforall a. Eq a => a -> a -> Bool
/=Int
0
then [forall a b. a -> Message a b
Low (GCId -> DrawCommand -> FRequest
wDraw GCId
gc 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
marginforall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
*Int
from) (Int
drawwidthforall a. Num a => a -> a -> a
+Int
margin) (Int
lsforall a. Num a => a -> a -> a
*Int
newcnt)
belowrect :: Rect
belowrect = Int -> Int -> Int -> Int -> Rect
rR Int
margin (Int
marginforall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
*Int
newlines) Int
drawwidth (-Int
lsforall a. Num a => a -> a -> a
*Int
diff)
clearcmd :: [Message FRequest b]
clearcmd = (if Int
newcntforall 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)
in forall {b}. Rect -> Bool -> [Message FRequest b]
clearArea Rect
drawrect Bool
Trueforall a. [a] -> [a] -> [a]
++
[forall a b. a -> Message a b
Low (LayoutMessage -> FRequest
LCmd (Rect -> LayoutMessage
layoutMakeVisible Rect
vrect))]
else [])forall a. [a] -> [a] -> [a]
++
(if Int
diffforall a. Ord a => a -> a -> Bool
<Int
0
then [forall a b. a -> Message a b
Low forall a b. (a -> b) -> a -> b
$ XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ Rect -> Bool -> XCommand
ClearArea Rect
belowrect Bool
False]
else [])
clearArea :: Rect -> Bool -> [Message FRequest b]
clearArea Rect
r Bool
e = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> Message a b
Low 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]]
in if Int
diffforall a. Ord a => a -> a -> Bool
>Int
0
then forall {b} {a}. [KCommand b] -> (Point -> K a b) -> K a b
resizeK forall {b}. [Message FRequest b]
llcmd forall a b. (a -> b) -> a -> b
$ \ Point
newwinsize ->
forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK (forall {b}. [Message FRequest b]
scrollcmdforall a. [a] -> [a] -> [a]
++forall {b}. [Message FRequest b]
clearcmd) forall a b. (a -> b) -> a -> b
$
Point
-> Point
-> [Int]
-> [(FontName, Int)]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
textK (Point
newwinsize forall a. Num a => a -> a -> a
- Int -> Point
diag Int
margin) Point
newsize [Int]
sel' [(FontName, Int)]
mtxt'
else forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK (forall {b}. [Message FRequest b]
scrollcmdforall a. [a] -> [a] -> [a]
++forall {b}. [Message FRequest b]
clearcmdforall a. [a] -> [a] -> [a]
++forall {b}. [Message FRequest b]
llcmd) forall a b. (a -> b) -> a -> b
$
Point
-> Point
-> [Int]
-> [(FontName, Int)]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
textK Point
winsize Point
newsize [Int]
sel' [(FontName, Int)]
mtxt'
textK :: Size -> Size -> [Int] -> [(String,Int)] ->
PK TextF TextRequest (InputMsg (Int,String))
textK :: Point
-> Point
-> [Int]
-> [(FontName, Int)]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
textK winsize :: Point
winsize@(Point Int
winwidth Int
_) Point
size [Int]
sel [(FontName, Int)]
mtxt =
forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ forall {t1} {t2} {t3}.
(t1 -> t2) -> (t3 -> t2) -> Message t1 t3 -> t2
message FResponse
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
lowK (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {p}.
p
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
paramChangeK TextRequest
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
textRequestK)
where
same :: K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
same = Point
-> Point
-> [Int]
-> [(FontName, Int)]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
textK Point
winsize Point
size [Int]
sel [(FontName, Int)]
mtxt
textRequestK :: TextRequest
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
textRequestK TextRequest
msg =
case TextRequest
msg of
ReplaceItems Int
dfrom Int
dcnt [FontName]
newtxt ->
forall {p}.
Point
-> p
-> [Int]
-> [(FontName, Int)]
-> Int
-> Int
-> [FontName]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
replaceTextK Point
winsize Point
size [Int]
sel [(FontName, Int)]
mtxt Int
dfrom Int
dcnt [FontName]
newtxt
HighlightItems [Int]
sel' ->
forall {t :: * -> *} {a} {b}. Foldable t => t Int -> K a b -> K a b
changeHighlightK [Int]
sel' forall a b. (a -> b) -> a -> b
$
Point
-> Point
-> [Int]
-> [(FontName, Int)]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
textK Point
winsize Point
size [Int]
sel' [(FontName, Int)]
mtxt
PickItem Int
n -> ((Int, FontName) -> InputMsg (Int, FontName))
-> Int
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
output forall {a}. a -> InputMsg a
inputMsg Int
n
TextRequest
_ -> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
same
lowK :: FResponse
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
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 forall a. Integral a => a -> a -> a
`quot` Int
ls
pressmsg :: a -> InputMsg a
pressmsg = case Pressed
press of
MultiClick Int
2 -> forall {a}. a -> InputMsg a
inputMsg
Pressed
_ -> forall {a}. a -> InputMsg a
InputChange
in ((Int, FontName) -> InputMsg (Int, FontName))
-> Int
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
output forall {a}. a -> InputMsg a
pressmsg Int
l
XEvt (Expose {rect :: XEvent -> Rect
rect=Rect
r}) ->
forall {a} {b}. Rect -> K a b -> K a b
redrawTextK Rect
r forall a b. (a -> b) -> a -> b
$
K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
same
XEvt (GraphicsExpose {rect :: XEvent -> Rect
rect=Rect
r}) ->
forall {a} {b}. Rect -> K a b -> K a b
redrawTextK Rect
r forall a b. (a -> b) -> a -> b
$
K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
same
LEvt (LayoutSize Point
newwinsize) ->
Point
-> Point
-> [Int]
-> [(FontName, Int)]
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
textK (Point
newwinsize forall a. Num a => a -> a -> a
- Int -> Point
diag Int
margin) Point
size [Int]
sel [(FontName, Int)]
mtxt
FResponse
_ -> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
same
paramChangeK :: p
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
paramChangeK p
_ = K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
same
output :: ((Int, FontName) -> InputMsg (Int, FontName))
-> Int
-> K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
output (Int, FontName) -> InputMsg (Int, FontName)
pressmsg Int
l = (if Int
lforall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& Int
lforall a. Ord a => a -> a -> Bool
<forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FontName, Int)]
mtxt
then forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall a b. b -> Message a b
High ((Int, FontName) -> InputMsg (Int, FontName)
pressmsg (Int
l,forall a b. (a, b) -> a
fst([(FontName, Int)]
mtxtforall a. [a] -> Int -> a
!!Int
l))))
else forall a. Customiser a
id) forall a b. (a -> b) -> a -> b
$ K (Either (Customiser TextF) TextRequest)
(InputMsg (Int, FontName))
same
changeHighlightK :: t Int -> K a b -> K a b
changeHighlightK t Int
sel' =
forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK (forall {b}. [Message FRequest b]
mkvisforall a. [a] -> [a] -> [a]
++[forall a b. a -> Message a b
Low forall a b. (a -> b) -> a -> b
$ [(GCId, [DrawCommand])] -> FRequest
wDrawMany (forall a b. (a -> b) -> [a] -> [b]
map (Int, (FontName, Int)) -> (GCId, [DrawCommand])
draw [(Int, (FontName, Int))]
changes)])
where
changed :: Int -> Bool
changed Int
n = (Int
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
sel) forall a. Eq a => a -> a -> Bool
/= (Int
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Int
sel')
nmtxt :: [(Int, (FontName, Int))]
nmtxt = forall a. Int -> [a] -> [(Int, a)]
number Int
0 [(FontName, Int)]
mtxt
changes :: [(Int, (FontName, Int))]
changes = [(Int, (FontName, Int))
l | l :: (Int, (FontName, Int))
l@(Int
n,(FontName, Int)
_)<-[(Int, (FontName, Int))]
nmtxt, Int -> Bool
changed Int
n]
selected :: [(Int, (FontName, Int))]
selected = [(Int, (FontName, Int))
l | l :: (Int, (FontName, Int))
l@(Int
n,(FontName, Int)
_)<-[(Int, (FontName, Int))]
nmtxt, Int
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Int
sel']
draw :: (Int, (FontName, Int)) -> (GCId, [DrawCommand])
draw (Int
n,(FontName
s,Int
w)) = (forall {t :: * -> *} {a}. (Foldable t, Eq a) => t a -> a -> GCId
dgc t Int
sel' Int
n,[Point -> FontName -> DrawCommand
drimstr (Int -> Int -> Point
Point (Int -> Int
x0 Int
w) (Int
baseforall a. Num a => a -> a -> a
+Int
nforall a. Num a => a -> a -> a
*Int
ls)) FontName
s])
mkvis :: [Message FRequest b]
mkvis =
case ([(Int, (FontName, Int))]
selected,forall a. [a] -> a
last [(Int, (FontName, Int))]
selected) of
([],(Int, (FontName, Int))
_) -> []
((Int
n1,(FontName
_,Int
w1)):[(Int, (FontName, Int))]
_,(Int
n2,(FontName
_,Int
w2))) ->
[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
x2forall a. Num a => a -> a -> a
-Int
x1forall a. Num a => a -> a -> a
+Int
5) (Int
y2forall a. Num a => a -> a -> a
-Int
y1forall a. Num a => a -> a -> a
+Int
5)
x1 :: Int
x1 = forall a. Ord a => a -> a -> a
min (Int -> Int
x0 Int
w1) (Int -> Int
x0 Int
w2)
x2 :: Int
x2 = forall a. Ord a => a -> a -> a
max (Int -> Int
x0 Int
w1) (Int -> Int
x0 Int
w2)
y1 :: Int
y1 = Int
n1forall a. Num a => a -> a -> a
*Int
ls
y2 :: Int
y2 = (Int
n2forall a. Num a => a -> a -> a
+Int
1)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 = (forall a. Ord a => a -> a -> a
max Int
0 (Int
yforall a. Num a => a -> a -> a
-Int
margin)) forall a. Integral a => a -> a -> a
`quot` Int
ls
last :: Int
last = (Int
yforall a. Num a => a -> a -> a
+Int
hforall a. Num a => a -> a -> a
-Int
1) forall a. Integral a => a -> a -> a
`quot` Int
ls
lines :: [(Int, (FontName, Int))]
lines = forall a. Int -> [a] -> [(Int, a)]
number Int
first (forall a. Int -> [a] -> [a]
take (Int
lastforall a. Num a => a -> a -> a
-Int
firstforall a. Num a => a -> a -> a
+Int
1) (forall a. Int -> [a] -> [a]
drop Int
first [(FontName, Int)]
mtxt))
firsty :: Int
firsty = Int
baseforall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
*Int
first
ys :: [Int]
ys = [Int
firsty,Int
firstyforall a. Num a => a -> a -> a
+Int
ls..]
in forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK [forall a b. a -> Message a b
Low forall a b. (a -> b) -> a -> b
$ XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ Rect -> Bool -> XCommand
ClearArea Rect
r Bool
False,
forall a b. a -> Message a b
Low forall a b. (a -> b) -> a -> b
$ [(GCId, [DrawCommand])] -> FRequest
wDrawMany
[(forall {t :: * -> *} {a}. (Foldable t, Eq a) => t a -> a -> GCId
dgc [Int]
sel Int
n,[Point -> FontName -> DrawCommand
drimstr (Int -> Int -> Point
Point Int
x1 Int
ly) FontName
s]) |
((Int
n,FontName
s,Int
x1,Int
x2),Int
ly)<-forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. (a, (b, Int)) -> (a, b, Int, Int)
xi [(Int, (FontName, Int))]
lines) [Int]
ys,Int
xforall a. Ord a => a -> a -> Bool
<Int
x2 Bool -> Bool -> Bool
&& (Int
xforall a. Num a => a -> a -> a
+Int
w)forall a. Ord a => a -> a -> Bool
>=Int
x1]]
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
x1forall a. Num a => a -> a -> a
+Int
w
x0 :: Int -> Int
x0 Int
w = Int
marginforall a. Num a => a -> a -> a
+forall a b. (RealFrac a, Integral b) => a -> b
floor (p
alignforall a. Num a => a -> a -> a
*fromInt (winwidth-margin-w))
dgc :: t a -> a -> GCId
dgc t a
sel a
n = if a
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
sel
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 = forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK [KCommand b]
cmd forall a b. (a -> b) -> a -> b
$ forall (f :: * -> * -> *) hi ans ho.
FudgetIO f =>
(KEvent hi -> Maybe ans) -> Cont (f hi ho) ans
waitForMsg forall {b}. Message FResponse b -> Maybe Point
ans 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))) = forall a. a -> Maybe a
Just Point
newsize
ans Message FResponse b
_ = forall a. Maybe a
Nothing
doubleClickTime :: Int
doubleClickTime = Int
400
textbg :: ColorSpec
textbg = forall {a}. (Show a, ColorGen a) => a -> ColorSpec
colorSpec [FontName
bgColor,FontName
"white"]
textfg :: ColorSpec
textfg = forall {a}. (Show a, ColorGen a) => a -> ColorSpec
colorSpec [FontName
fgColor,FontName
"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