module TerminalF(terminalF,cmdTerminalF,TerminalCmd(..)) where
import Spacer(marginF)
--import Alignment(Alignment(..))
import BgF
import Color
import Command
import FRequest
import DrawInWindow(wDrawImageString,wDrawImageString16,wCopyArea)
import XDraw
import Defaults(paperColor, fgColor)
import Dlayout(simpleGroupF, windowF)
import Event
import Font
import Fudget
--import FudgetIO
import Gc
import Geometry(Point(..), Rect(..), origin, pP, padd,)-- rectsize
import LayoutRequest
--import Placer(spacerF)
--import Spacers
import LoadFont
--import Message(Message(..))
import NullF
import StateMonads
--import EitherUtils(mapMaybe, stripMaybeDef)
import Xtypes
import CompOps
import GCAttrs() -- instances

grmarginF :: Distance -> F hi ho -> F hi ho
grmarginF Distance
m F hi ho
f = forall {hi} {ho}. [WindowAttributes] -> F hi ho -> F hi ho
simpleGroupF [] (forall {a} {b}. Distance -> F a b -> F a b
marginF Distance
m F hi ho
f)

data TerminalCmd
  = TermText String -- add string on a new line
  | TermAppend String -- append string to last line
  | TermClear

terminalF :: FontName -> Int -> Int -> F String a
terminalF :: forall a. FontName -> Distance -> Distance -> F FontName a
terminalF FontName
fname Distance
nrows Distance
ncols = forall a. FontName -> Distance -> Distance -> F TerminalCmd a
cmdTerminalF FontName
fname Distance
nrows Distance
ncols forall c d e. F c d -> (e -> c) -> F e d
>=^< FontName -> TerminalCmd
TermText

cmdTerminalF :: FontName -> Int -> Int -> F TerminalCmd a
cmdTerminalF :: forall a. FontName -> Distance -> Distance -> F TerminalCmd a
cmdTerminalF FontName
fname Distance
nrows Distance
ncols =
    let wattrs :: [WindowAttributes]
wattrs = [BackingStore -> WindowAttributes
CWBackingStore BackingStore
WhenMapped, [EventMask] -> WindowAttributes
CWEventMask [EventMask
ExposureMask]]
    in  forall {a} {b}. Distance -> F a b -> F a b
grmarginF Distance
2
                (forall a b. [FRequest] -> K a b -> F a b
windowF [XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs,
			  XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowChanges] -> XCommand
ConfigureWindow [Distance -> WindowChanges
CWBorderWidth Distance
1]]
                         (forall {ho}. FontName -> Distance -> Distance -> K TerminalCmd ho
terminalK FontName
fname Distance
nrows Distance
ncols))

terminalK :: FontName -> Distance -> Distance -> K TerminalCmd ho
terminalK FontName
fname Distance
nrows Distance
ncols =
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FontName
-> (FontStructF (Array Char CharStruct) -> f hi ho) -> f hi ho
safeLoadQueryFont FontName
fname forall a b. (a -> b) -> a -> b
$ \FontStructF (Array Char CharStruct)
fs ->
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> FontName -> Cont (f hi ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap FontName
fgColor forall a b. (a -> b) -> a -> b
$ \Pixel
fg ->
    forall {a} {i} {o}.
(Show a, ColorGen a) =>
a -> (Pixel -> K i o) -> K i o
changeGetBackPixel FontName
paperColor forall a b. (a -> b) -> a -> b
$ \Pixel
bg ->
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
rootGC [forall a b. GCFunction -> GCAttributes a b
GCFunction GCFunction
GXcopy, forall a b. b -> GCAttributes a b
GCFont (forall per_char. FontStructF per_char -> FontId
font_id FontStructF (Array Char CharStruct)
fs), forall a b. a -> GCAttributes a b
GCForeground Pixel
fg, forall a b. a -> GCAttributes a b
GCBackground Pixel
bg]
				 (forall {ho}.
FontStructF (Array Char CharStruct)
-> Distance -> Distance -> GCId -> K TerminalCmd ho
terminalK1 FontStructF (Array Char CharStruct)
fs Distance
nrows Distance
ncols)

m a
m1 $$$ :: m a -> m b -> m b
$$$ m b
m2 = m a
m1forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>m b
m2

m a
m1 $> :: m a -> (a -> m b) -> m b
$> a -> m b
xm2 = m a
m1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
xm2

terminalK1 :: FontStructF (Array Char CharStruct)
-> Distance -> Distance -> GCId -> K TerminalCmd ho
terminalK1 FontStructF (Array Char CharStruct)
fs Distance
nrows Distance
ncols GCId
gc =
    let charsize :: Size
charsize@(Point Distance
charw Distance
charh) = FontStructF (Array Char CharStruct) -> FontName -> Size
string_box_size FontStructF (Array Char CharStruct)
fs FontName
"M"
        startsize :: Size
startsize = Distance -> Distance -> Size
curpos Distance
nrows Distance
ncols
        size :: Size
size = Size
startsize
        curpos :: Distance -> Distance -> Size
curpos Distance
row Distance
col = Distance -> Distance -> Size
pP (Distance
charw forall a. Num a => a -> a -> a
* Distance
col) (Distance
charh forall a. Num a => a -> a -> a
* Distance
row)
        drawpos :: Distance -> Distance -> Size
drawpos Distance
row Distance
col = Size -> Size -> Size
padd (Distance -> Distance -> Size
curpos Distance
row Distance
col) (Distance -> Distance -> Size
pP Distance
0 (forall per_char. FontStructF per_char -> Distance
font_ascent FontStructF (Array Char CharStruct)
fs))
	drimstr :: GCId -> Size -> FontName -> FRequest
drimstr = if forall a b. (a, b) -> b
snd (forall {per_char}. FontStructF per_char -> (Char, Char)
font_range FontStructF (Array Char CharStruct)
fs) forall a. Ord a => a -> a -> Bool
> Char
'\xff'
		  then GCId -> Size -> FontName -> FRequest
wDrawImageString16
		  else GCId -> Size -> FontName -> FRequest
wDrawImageString
        k :: Mk
  (([FontName], Distance, Distance, Distance, Distance)
   -> K TerminalCmd ho)
  b
k =
            forall {hi} {ho} {s}. Ms (K hi ho) s (KEvent hi)
getKs forall {m :: * -> *} {a} {b}. Monad m => m a -> (a -> m b) -> m b
$>
            (\KEvent TerminalCmd
msg ->
             (case KEvent TerminalCmd
msg of
                Low (XEvt (Expose Rect
_ Distance
0)) -> forall {b} {c} {d} {e} {hi} {ho}.
Mk (([FontName], b, c, d, e) -> K hi ho) ()
redraw
                Low (LEvt (LayoutSize Size
newsize)) -> forall {hi} {ho}.
Size
-> Mk
     (([FontName], Distance, Distance, Distance, Distance) -> K hi ho)
     ()
setSize Size
newsize
                Low FResponse
_ -> forall k s. Msc k s
nopMs
                High TerminalCmd
cmd -> case TerminalCmd
cmd of
		  TermText FontName
line -> forall {f :: * -> * -> *} {c} {hi} {ho}.
FudgetIO f =>
FontName
-> Mk (([FontName], Distance, c, Distance, Distance) -> f hi ho) ()
addDrawLine FontName
line
		  TermAppend FontName
s -> forall {f :: * -> * -> *} {c} {d} {e} {hi} {ho}.
FudgetIO f =>
FontName -> Mk (([FontName], Distance, c, d, e) -> f hi ho) ()
appendDrawLine FontName
s
		  TerminalCmd
TermClear -> forall {d} {e} {hi} {ho}.
Mk (([FontName], Distance, Distance, d, e) -> K hi ho) ()
clearit) forall {m :: * -> *} {a} {b}. Monad m => m a -> m b -> m b
$$$
             Mk
  (([FontName], Distance, Distance, Distance, Distance)
   -> K TerminalCmd ho)
  b
k)
        drawline :: (Distance, FontName) -> Mk ((a, b, c, d, e) -> f hi ho) ()
drawline (Distance
r, FontName
l) =
            forall k s. Ms k s s
loadMs forall {m :: * -> *} {a} {b}. Monad m => m a -> (a -> m b) -> m b
$>
            (\(a
lines', b
row, c
col, d
nrows', e
ncols') ->
             forall {f :: * -> * -> *} {hi} {ho} {r}.
FudgetIO f =>
FRequest -> Msc (f hi ho) r
putLowMs (GCId -> Size -> FontName -> FRequest
drimstr GCId
gc (Distance -> Distance -> Size
drawpos Distance
r Distance
0) FontName
l))
        redraw :: Mk (([FontName], b, c, d, e) -> K hi ho) ()
redraw =
            forall k s. Ms k s s
loadMs forall {m :: * -> *} {a} {b}. Monad m => m a -> (a -> m b) -> m b
$>
            (\([FontName]
lines', b
row, c
col, d
nrows', e
ncols') ->
             forall {f :: * -> * -> *} {hi} {ho} {r}.
FudgetIO f =>
FRequest -> Msc (f hi ho) r
putLowMs FRequest
clearWindow forall {m :: * -> *} {a} {b}. Monad m => m a -> m b -> m b
$$$
             forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Distance, FontName)
l -> (forall {f :: * -> * -> *} {a} {b} {c} {d} {e} {hi} {ho}.
FudgetIO f =>
(Distance, FontName) -> Mk ((a, b, c, d, e) -> f hi ho) ()
drawline (Distance, FontName)
l forall {m :: * -> *} {a} {b}. Monad m => m a -> m b -> m b
$$$)) forall k s. Msc k s
nopMs (forall a b. [a] -> [b] -> [(a, b)]
zip [Distance
0 ..] (forall a. [a] -> [a]
reverse [FontName]
lines')))
        setSize :: Size
-> Mk
     (([FontName], Distance, Distance, Distance, Distance) -> K hi ho)
     ()
setSize (Point Distance
x Distance
y) =
            forall k s. Ms k s s
loadMs forall {m :: * -> *} {a} {b}. Monad m => m a -> (a -> m b) -> m b
$>
            (\([FontName]
lines', Distance
row, Distance
col, Distance
nrows', Distance
ncols') ->
             let ncols'' :: Distance
ncols'' = Distance
x forall a. Integral a => a -> a -> a
`quot` Distance
charw
                 nrows'' :: Distance
nrows'' = Distance
y forall a. Integral a => a -> a -> a
`quot` Distance
charh
                 row' :: Distance
row' = Distance
row forall a. Ord a => a -> a -> a
`min` Distance
nrows''
                 col' :: Distance
col' = Distance
col forall a. Ord a => a -> a -> a
`min` Distance
ncols''
                 lines'' :: [FontName]
lines'' = forall a. Distance -> [a] -> [a]
take Distance
nrows'' [FontName]
lines'
             in  forall s k. s -> Msc k s
storeMs ([FontName]
lines'', Distance
row', Distance
col', Distance
nrows'', Distance
ncols'') forall {m :: * -> *} {a} {b}. Monad m => m a -> m b -> m b
$$$ forall {b} {c} {d} {e} {hi} {ho}.
Mk (([FontName], b, c, d, e) -> K hi ho) ()
redraw)
        addLine :: p -> Mk (([p], Distance, c, Distance, Distance) -> f hi ho) ()
addLine p
line =
            forall k s. Ms k s s
loadMs forall {m :: * -> *} {a} {b}. Monad m => m a -> (a -> m b) -> m b
$>
            (\([p]
lines', Distance
row, c
col, Distance
nrows', Distance
ncols') ->
             if Distance
row forall a. Ord a => a -> a -> Bool
< Distance
nrows' forall a. Num a => a -> a -> a
- Distance
1 then
                 let lines'' :: [p]
lines'' = p
line forall a. a -> [a] -> [a]
: [p]
lines'
                     row' :: Distance
row' = Distance
row forall a. Num a => a -> a -> a
+ Distance
1
                 in  forall s k. s -> Msc k s
storeMs ([p]
lines'', Distance
row', c
col, Distance
nrows', Distance
ncols')
             else
                 let lines'' :: [p]
lines'' = forall a. Distance -> [a] -> [a]
take Distance
nrows' (p
line forall a. a -> [a] -> [a]
: [p]
lines')
                 in  forall s k. s -> Msc k s
storeMs ([p]
lines'', Distance
row, c
col, Distance
nrows', Distance
ncols') forall {m :: * -> *} {a} {b}. Monad m => m a -> m b -> m b
$$$
                     forall {t :: * -> *} {f :: * -> * -> *} {hi} {ho} {r}.
(Foldable t, FudgetIO f) =>
t FRequest -> Msc (f hi ho) r
putLowsMs [GCId -> Drawable -> Rect -> Size -> FRequest
wCopyArea GCId
gc
                                           Drawable
MyWindow
                                           (Size -> Size -> Rect
Rect (Distance -> Distance -> Size
pP Distance
0 Distance
charh)
                                                 (Distance -> Distance -> Size
curpos (Distance
nrows' forall a. Num a => a -> a -> a
- Distance
1) Distance
ncols'))
                                           Size
origin,
                                Rect -> Bool -> FRequest
clearArea  (Size -> Size -> Rect
Rect (Distance -> Distance -> Size
curpos Distance
row Distance
0)
                                                 (Distance -> Distance -> Size
curpos Distance
1 Distance
ncols'))
                                           Bool
False])
        appendLine :: [a] -> Mk (([[a]], b, c, d, e) -> k) ()
appendLine [a]
s =
            forall k s. Ms k s s
loadMs forall {m :: * -> *} {a} {b}. Monad m => m a -> (a -> m b) -> m b
$> \([[a]]
lines', b
row, c
col, d
nrows', e
ncols') ->
	    case [[a]]
lines' of
	      []   -> forall s k. s -> Msc k s
storeMs ([[a]
s],b
rowforall a. Num a => a -> a -> a
+b
1,c
col,d
nrows',e
ncols')
	      [a]
l:[[a]]
ls -> forall s k. s -> Msc k s
storeMs (([a]
lforall a. [a] -> [a] -> [a]
++[a]
s)forall a. a -> [a] -> [a]
:[[a]]
ls, b
row, c
col, d
nrows', e
ncols')
        clearit :: Mk (([FontName], Distance, Distance, d, e) -> K hi ho) ()
clearit = forall k s. Ms k s s
loadMs forall {m :: * -> *} {a} {b}. Monad m => m a -> (a -> m b) -> m b
$> \([FontName]
lines, Distance
row, Distance
col, d
nrows, e
ncols) ->
		  forall s k. s -> Msc k s
storeMs ([],-Distance
1,Distance
0,d
nrows,e
ncols) forall {m :: * -> *} {a} {b}. Monad m => m a -> m b -> m b
$$$ forall {b} {c} {d} {e} {hi} {ho}.
Mk (([FontName], b, c, d, e) -> K hi ho) ()
redraw
        addDrawLine :: FontName
-> Mk (([FontName], Distance, c, Distance, Distance) -> f hi ho) ()
addDrawLine FontName
line =
            (forall {f :: * -> * -> *} {p} {c} {hi} {ho}.
FudgetIO f =>
p -> Mk (([p], Distance, c, Distance, Distance) -> f hi ho) ()
addLine FontName
line forall {m :: * -> *} {a} {b}. Monad m => m a -> m b -> m b
$$$ forall k s. Ms k s s
loadMs) forall {m :: * -> *} {a} {b}. Monad m => m a -> (a -> m b) -> m b
$> 
            (\([FontName]
lines', Distance
row, c
col, Distance
nrows', Distance
ncols') -> forall {f :: * -> * -> *} {a} {b} {c} {d} {e} {hi} {ho}.
FudgetIO f =>
(Distance, FontName) -> Mk ((a, b, c, d, e) -> f hi ho) ()
drawline (Distance
row, FontName
line))
	appendDrawLine :: FontName -> Mk (([FontName], Distance, c, d, e) -> f hi ho) ()
appendDrawLine FontName
s =
	    (forall {b} {a} {c} {d} {e} {k}.
Num b =>
[a] -> Mk (([[a]], b, c, d, e) -> k) ()
appendLine FontName
s forall {m :: * -> *} {a} {b}. Monad m => m a -> m b -> m b
$$$ forall k s. Ms k s s
loadMs) forall {m :: * -> *} {a} {b}. Monad m => m a -> (a -> m b) -> m b
$>
            (\(FontName
line:[FontName]
_, Distance
row, c
col, d
nrows', e
ncols') -> forall {f :: * -> * -> *} {a} {b} {c} {d} {e} {hi} {ho}.
FudgetIO f =>
(Distance, FontName) -> Mk ((a, b, c, d, e) -> f hi ho) ()
drawline (Distance
row, FontName
line))
    in  forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall a b. a -> Message a b
Low (LayoutRequest -> FRequest
layoutRequestCmd (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
size Bool
False Bool
False))) forall a b. (a -> b) -> a -> b
$
        forall {t1} {t2} {r}. t1 -> Mk (t1 -> t2) r -> t2 -> t2
stateK ([], -Distance
1, Distance
0, Distance
nrows, Distance
ncols) forall {ho} {b}.
Mk
  (([FontName], Distance, Distance, Distance, Distance)
   -> K TerminalCmd ho)
  b
k forall {hi} {ho}. K hi ho
nullK