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 b ho -> F b ho
grmarginF Distance
m F b ho
f = [WindowAttributes] -> F b ho -> F b ho
forall b ho. [WindowAttributes] -> F b ho -> F b ho
simpleGroupF [] (Distance -> F b ho -> F b ho
forall a b. Distance -> F a b -> F a b
marginF Distance
m F b 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 :: FontName -> Distance -> Distance -> F FontName a
terminalF FontName
fname Distance
nrows Distance
ncols = FontName -> Distance -> Distance -> F TerminalCmd a
forall a. FontName -> Distance -> Distance -> F TerminalCmd a
cmdTerminalF FontName
fname Distance
nrows Distance
ncols F TerminalCmd a -> (FontName -> TerminalCmd) -> F FontName a
forall c d e. F c d -> (e -> c) -> F e d
>=^< FontName -> TerminalCmd
TermText

cmdTerminalF :: FontName -> Int -> Int -> F TerminalCmd a
cmdTerminalF :: 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  Distance -> F TerminalCmd a -> F TerminalCmd a
forall a b. Distance -> F a b -> F a b
grmarginF Distance
2
                ([FRequest] -> K TerminalCmd a -> F TerminalCmd a
forall a b. [FRequest] -> K a b -> F a b
windowF [XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs,
			  XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ [WindowChanges] -> XCommand
ConfigureWindow [Distance -> WindowChanges
CWBorderWidth Distance
1]]
                         (FontName -> Distance -> Distance -> K TerminalCmd a
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 =
    FontName
-> (FontStructF (Array Char CharStruct) -> K TerminalCmd ho)
-> K TerminalCmd ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
FontName
-> (FontStructF (Array Char CharStruct) -> f b ho) -> f b ho
safeLoadQueryFont FontName
fname ((FontStructF (Array Char CharStruct) -> K TerminalCmd ho)
 -> K TerminalCmd ho)
-> (FontStructF (Array Char CharStruct) -> K TerminalCmd ho)
-> K TerminalCmd ho
forall a b. (a -> b) -> a -> b
$ \FontStructF (Array Char CharStruct)
fs ->
    ColormapId -> FontName -> Cont (K TerminalCmd ho) Pixel
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
ColormapId -> FontName -> Cont (f b ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap FontName
fgColor Cont (K TerminalCmd ho) Pixel -> Cont (K TerminalCmd ho) Pixel
forall a b. (a -> b) -> a -> b
$ \Pixel
fg ->
    FontName -> Cont (K TerminalCmd ho) Pixel
forall a i o.
(Show a, ColorGen a) =>
a -> (Pixel -> K i o) -> K i o
changeGetBackPixel FontName
paperColor Cont (K TerminalCmd ho) Pixel -> Cont (K TerminalCmd ho) Pixel
forall a b. (a -> b) -> a -> b
$ \Pixel
bg ->
    GCId
-> [GCAttributes Pixel FontId]
-> (GCId -> K TerminalCmd ho)
-> K TerminalCmd ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
rootGC [GCFunction -> GCAttributes Pixel FontId
forall a b. GCFunction -> GCAttributes a b
GCFunction GCFunction
GXcopy, FontId -> GCAttributes Pixel FontId
forall a b. b -> GCAttributes a b
GCFont (FontStructF (Array Char CharStruct) -> FontId
forall per_char. FontStructF per_char -> FontId
font_id FontStructF (Array Char CharStruct)
fs), Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCForeground Pixel
fg, Pixel -> GCAttributes Pixel FontId
forall a b. a -> GCAttributes a b
GCBackground Pixel
bg]
				 (FontStructF (Array Char CharStruct)
-> Distance -> Distance -> GCId -> K TerminalCmd ho
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
m1m a -> m b -> m b
forall (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 m a -> (a -> m b) -> m b
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 :: Point
charsize@(Point Distance
charw Distance
charh) = FontStructF (Array Char CharStruct) -> FontName -> Point
string_box_size FontStructF (Array Char CharStruct)
fs FontName
"M"
        startsize :: Point
startsize = Distance -> Distance -> Point
curpos Distance
nrows Distance
ncols
        size :: Point
size = Point
startsize
        curpos :: Distance -> Distance -> Point
curpos Distance
row Distance
col = Distance -> Distance -> Point
pP (Distance
charw Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
* Distance
col) (Distance
charh Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
* Distance
row)
        drawpos :: Distance -> Distance -> Point
drawpos Distance
row Distance
col = Point -> Point -> Point
padd (Distance -> Distance -> Point
curpos Distance
row Distance
col) (Distance -> Distance -> Point
pP Distance
0 (FontStructF (Array Char CharStruct) -> Distance
forall per_char. FontStructF per_char -> Distance
font_ascent FontStructF (Array Char CharStruct)
fs))
	drimstr :: GCId -> Point -> FontName -> FRequest
drimstr = if (Char, Char) -> Char
forall a b. (a, b) -> b
snd (FontStructF (Array Char CharStruct) -> (Char, Char)
forall per_char. FontStructF per_char -> (Char, Char)
font_range FontStructF (Array Char CharStruct)
fs) Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\xff'
		  then GCId -> Point -> FontName -> FRequest
wDrawImageString16
		  else GCId -> Point -> FontName -> FRequest
wDrawImageString
        k :: Mk
  (([FontName], Distance, Distance, Distance, Distance)
   -> K TerminalCmd ho)
  b
k =
            Ms
  (K TerminalCmd ho)
  ([FontName], Distance, Distance, Distance, Distance)
  (KEvent TerminalCmd)
forall hi ho s. Ms (K hi ho) s (KEvent hi)
getKs Ms
  (K TerminalCmd ho)
  ([FontName], Distance, Distance, Distance, Distance)
  (KEvent TerminalCmd)
-> (KEvent TerminalCmd
    -> Mk
         (([FontName], Distance, Distance, Distance, Distance)
          -> K TerminalCmd ho)
         b)
-> Mk
     (([FontName], Distance, Distance, Distance, Distance)
      -> K TerminalCmd ho)
     b
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)) -> Mk
  (([FontName], Distance, Distance, Distance, Distance)
   -> K TerminalCmd ho)
  ()
forall b c d e hi ho. Mk (([FontName], b, c, d, e) -> K hi ho) ()
redraw
                Low (LEvt (LayoutSize Point
newsize)) -> Point
-> Mk
     (([FontName], Distance, Distance, Distance, Distance)
      -> K TerminalCmd ho)
     ()
forall hi ho.
Point
-> Mk
     (([FontName], Distance, Distance, Distance, Distance) -> K hi ho)
     ()
setSize Point
newsize
                Low FResponse
_ -> Mk
  (([FontName], Distance, Distance, Distance, Distance)
   -> K TerminalCmd ho)
  ()
forall k s. Msc k s
nopMs
                High TerminalCmd
cmd -> case TerminalCmd
cmd of
		  TermText FontName
line -> FontName
-> Mk
     (([FontName], Distance, Distance, Distance, Distance)
      -> K TerminalCmd ho)
     ()
forall (f :: * -> * -> *) c hi ho.
FudgetIO f =>
FontName
-> Mk (([FontName], Distance, c, Distance, Distance) -> f hi ho) ()
addDrawLine FontName
line
		  TermAppend FontName
s -> FontName
-> Mk
     (([FontName], Distance, Distance, Distance, Distance)
      -> K TerminalCmd ho)
     ()
forall (f :: * -> * -> *) c d e hi ho.
FudgetIO f =>
FontName -> Mk (([FontName], Distance, c, d, e) -> f hi ho) ()
appendDrawLine FontName
s
		  TerminalCmd
TermClear -> Mk
  (([FontName], Distance, Distance, Distance, Distance)
   -> K TerminalCmd ho)
  ()
forall d e hi ho.
Mk (([FontName], Distance, Distance, d, e) -> K hi ho) ()
clearit) Mk
  (([FontName], Distance, Distance, Distance, Distance)
   -> K TerminalCmd ho)
  ()
-> Mk
     (([FontName], Distance, Distance, Distance, Distance)
      -> K TerminalCmd ho)
     b
-> Mk
     (([FontName], Distance, Distance, Distance, Distance)
      -> K TerminalCmd ho)
     b
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) =
            Ms (f hi ho) (a, b, c, d, e) (a, b, c, d, e)
forall k s. Ms k s s
loadMs Ms (f hi ho) (a, b, c, d, e) (a, b, c, d, e)
-> ((a, b, c, d, e) -> Mk ((a, b, c, d, e) -> f hi ho) ())
-> Mk ((a, b, c, d, e) -> f hi ho) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
$>
            (\(a
lines', b
row, c
col, d
nrows', e
ncols') ->
             FRequest -> Mk ((a, b, c, d, e) -> f hi ho) ()
forall (f :: * -> * -> *) hi ho r.
FudgetIO f =>
FRequest -> Msc (f hi ho) r
putLowMs (GCId -> Point -> FontName -> FRequest
drimstr GCId
gc (Distance -> Distance -> Point
drawpos Distance
r Distance
0) FontName
l))
        redraw :: Mk (([FontName], b, c, d, e) -> K hi ho) ()
redraw =
            Ms (K hi ho) ([FontName], b, c, d, e) ([FontName], b, c, d, e)
forall k s. Ms k s s
loadMs Ms (K hi ho) ([FontName], b, c, d, e) ([FontName], b, c, d, e)
-> (([FontName], b, c, d, e)
    -> Mk (([FontName], b, c, d, e) -> K hi ho) ())
-> Mk (([FontName], b, c, d, e) -> K hi ho) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
$>
            (\([FontName]
lines', b
row, c
col, d
nrows', e
ncols') ->
             FRequest -> Mk (([FontName], b, c, d, e) -> K hi ho) ()
forall (f :: * -> * -> *) hi ho r.
FudgetIO f =>
FRequest -> Msc (f hi ho) r
putLowMs FRequest
clearWindow Mk (([FontName], b, c, d, e) -> K hi ho) ()
-> Mk (([FontName], b, c, d, e) -> K hi ho) ()
-> Mk (([FontName], b, c, d, e) -> K hi ho) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
$$$
             ((Distance, FontName)
 -> Mk (([FontName], b, c, d, e) -> K hi ho) ()
 -> Mk (([FontName], b, c, d, e) -> K hi ho) ())
-> Mk (([FontName], b, c, d, e) -> K hi ho) ()
-> [(Distance, FontName)]
-> Mk (([FontName], b, c, d, e) -> K hi ho) ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Distance, FontName)
l -> ((Distance, FontName) -> Mk (([FontName], b, c, d, e) -> K hi ho) ()
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 Mk (([FontName], b, c, d, e) -> K hi ho) ()
-> Mk (([FontName], b, c, d, e) -> K hi ho) ()
-> Mk (([FontName], b, c, d, e) -> K hi ho) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
$$$)) Mk (([FontName], b, c, d, e) -> K hi ho) ()
forall k s. Msc k s
nopMs ([Distance] -> [FontName] -> [(Distance, FontName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Distance
0 ..] ([FontName] -> [FontName]
forall a. [a] -> [a]
reverse [FontName]
lines')))
        setSize :: Point
-> Mk
     (([FontName], Distance, Distance, Distance, Distance) -> K hi ho)
     ()
setSize (Point Distance
x Distance
y) =
            Ms
  (K hi ho)
  ([FontName], Distance, Distance, Distance, Distance)
  ([FontName], Distance, Distance, Distance, Distance)
forall k s. Ms k s s
loadMs Ms
  (K hi ho)
  ([FontName], Distance, Distance, Distance, Distance)
  ([FontName], Distance, Distance, Distance, Distance)
-> (([FontName], Distance, Distance, Distance, Distance)
    -> Mk
         (([FontName], Distance, Distance, Distance, Distance) -> K hi ho)
         ())
-> Mk
     (([FontName], Distance, Distance, Distance, Distance) -> K hi ho)
     ()
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 Distance -> Distance -> Distance
forall a. Integral a => a -> a -> a
`quot` Distance
charw
                 nrows'' :: Distance
nrows'' = Distance
y Distance -> Distance -> Distance
forall a. Integral a => a -> a -> a
`quot` Distance
charh
                 row' :: Distance
row' = Distance
row Distance -> Distance -> Distance
forall a. Ord a => a -> a -> a
`min` Distance
nrows''
                 col' :: Distance
col' = Distance
col Distance -> Distance -> Distance
forall a. Ord a => a -> a -> a
`min` Distance
ncols''
                 lines'' :: [FontName]
lines'' = Distance -> [FontName] -> [FontName]
forall a. Distance -> [a] -> [a]
take Distance
nrows'' [FontName]
lines'
             in  ([FontName], Distance, Distance, Distance, Distance)
-> Mk
     (([FontName], Distance, Distance, Distance, Distance) -> K hi ho)
     ()
forall s k. s -> Msc k s
storeMs ([FontName]
lines'', Distance
row', Distance
col', Distance
nrows'', Distance
ncols'') Mk
  (([FontName], Distance, Distance, Distance, Distance) -> K hi ho)
  ()
-> Mk
     (([FontName], Distance, Distance, Distance, Distance) -> K hi ho)
     ()
-> Mk
     (([FontName], Distance, Distance, Distance, Distance) -> K hi ho)
     ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
$$$ Mk
  (([FontName], Distance, Distance, Distance, Distance) -> K hi ho)
  ()
forall b c d e hi ho. Mk (([FontName], b, c, d, e) -> K hi ho) ()
redraw)
        addLine :: a -> Mk (([a], Distance, c, Distance, Distance) -> f hi ho) ()
addLine a
line =
            Ms
  (f hi ho)
  ([a], Distance, c, Distance, Distance)
  ([a], Distance, c, Distance, Distance)
forall k s. Ms k s s
loadMs Ms
  (f hi ho)
  ([a], Distance, c, Distance, Distance)
  ([a], Distance, c, Distance, Distance)
-> (([a], Distance, c, Distance, Distance)
    -> Mk (([a], Distance, c, Distance, Distance) -> f hi ho) ())
-> Mk (([a], Distance, c, Distance, Distance) -> f hi ho) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
$>
            (\([a]
lines', Distance
row, c
col, Distance
nrows', Distance
ncols') ->
             if Distance
row Distance -> Distance -> Bool
forall a. Ord a => a -> a -> Bool
< Distance
nrows' Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
1 then
                 let lines'' :: [a]
lines'' = a
line a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
lines'
                     row' :: Distance
row' = Distance
row Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
+ Distance
1
                 in  ([a], Distance, c, Distance, Distance)
-> Mk (([a], Distance, c, Distance, Distance) -> f hi ho) ()
forall s k. s -> Msc k s
storeMs ([a]
lines'', Distance
row', c
col, Distance
nrows', Distance
ncols')
             else
                 let lines'' :: [a]
lines'' = Distance -> [a] -> [a]
forall a. Distance -> [a] -> [a]
take Distance
nrows' (a
line a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
lines')
                 in  ([a], Distance, c, Distance, Distance)
-> Mk (([a], Distance, c, Distance, Distance) -> f hi ho) ()
forall s k. s -> Msc k s
storeMs ([a]
lines'', Distance
row, c
col, Distance
nrows', Distance
ncols') Mk (([a], Distance, c, Distance, Distance) -> f hi ho) ()
-> Mk (([a], Distance, c, Distance, Distance) -> f hi ho) ()
-> Mk (([a], Distance, c, Distance, Distance) -> f hi ho) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
$$$
                     [FRequest]
-> Mk (([a], Distance, c, Distance, Distance) -> f hi ho) ()
forall (t :: * -> *) (f :: * -> * -> *) hi ho r.
(Foldable t, FudgetIO f) =>
t FRequest -> Msc (f hi ho) r
putLowsMs [GCId -> Drawable -> Rect -> Point -> FRequest
wCopyArea GCId
gc
                                           Drawable
MyWindow
                                           (Point -> Point -> Rect
Rect (Distance -> Distance -> Point
pP Distance
0 Distance
charh)
                                                 (Distance -> Distance -> Point
curpos (Distance
nrows' Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
1) Distance
ncols'))
                                           Point
origin,
                                Rect -> Bool -> FRequest
clearArea  (Point -> Point -> Rect
Rect (Distance -> Distance -> Point
curpos Distance
row Distance
0)
                                                 (Distance -> Distance -> Point
curpos Distance
1 Distance
ncols'))
                                           Bool
False])
        appendLine :: [a] -> Mk (([[a]], b, c, d, e) -> k) ()
appendLine [a]
s =
            Ms k ([[a]], b, c, d, e) ([[a]], b, c, d, e)
forall k s. Ms k s s
loadMs Ms k ([[a]], b, c, d, e) ([[a]], b, c, d, e)
-> (([[a]], b, c, d, e) -> Mk (([[a]], b, c, d, e) -> k) ())
-> Mk (([[a]], b, c, d, e) -> k) ()
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
	      []   -> ([[a]], b, c, d, e) -> Mk (([[a]], b, c, d, e) -> k) ()
forall s k. s -> Msc k s
storeMs ([[a]
s],b
rowb -> b -> b
forall a. Num a => a -> a -> a
+b
1,c
col,d
nrows',e
ncols')
	      [a]
l:[[a]]
ls -> ([[a]], b, c, d, e) -> Mk (([[a]], b, c, d, e) -> k) ()
forall s k. s -> Msc k s
storeMs (([a]
l[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
s)[a] -> [[a]] -> [[a]]
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 = Ms
  (K hi ho)
  ([FontName], Distance, Distance, d, e)
  ([FontName], Distance, Distance, d, e)
forall k s. Ms k s s
loadMs Ms
  (K hi ho)
  ([FontName], Distance, Distance, d, e)
  ([FontName], Distance, Distance, d, e)
-> (([FontName], Distance, Distance, d, e)
    -> Mk (([FontName], Distance, Distance, d, e) -> K hi ho) ())
-> Mk (([FontName], Distance, Distance, d, e) -> K hi ho) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
$> \([FontName]
lines, Distance
row, Distance
col, d
nrows, e
ncols) ->
		  ([FontName], Distance, Distance, d, e)
-> Mk (([FontName], Distance, Distance, d, e) -> K hi ho) ()
forall s k. s -> Msc k s
storeMs ([],-Distance
1,Distance
0,d
nrows,e
ncols) Mk (([FontName], Distance, Distance, d, e) -> K hi ho) ()
-> Mk (([FontName], Distance, Distance, d, e) -> K hi ho) ()
-> Mk (([FontName], Distance, Distance, d, e) -> K hi ho) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
$$$ Mk (([FontName], Distance, Distance, d, e) -> K hi ho) ()
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 =
            (FontName
-> Mk (([FontName], Distance, c, Distance, Distance) -> f hi ho) ()
forall (f :: * -> * -> *) a c hi ho.
FudgetIO f =>
a -> Mk (([a], Distance, c, Distance, Distance) -> f hi ho) ()
addLine FontName
line Mk (([FontName], Distance, c, Distance, Distance) -> f hi ho) ()
-> Mk
     (([FontName], Distance, c, Distance, Distance) -> f hi ho)
     ([FontName], Distance, c, Distance, Distance)
-> Mk
     (([FontName], Distance, c, Distance, Distance) -> f hi ho)
     ([FontName], Distance, c, Distance, Distance)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
$$$ Mk
  (([FontName], Distance, c, Distance, Distance) -> f hi ho)
  ([FontName], Distance, c, Distance, Distance)
forall k s. Ms k s s
loadMs) Mk
  (([FontName], Distance, c, Distance, Distance) -> f hi ho)
  ([FontName], Distance, c, Distance, Distance)
-> (([FontName], Distance, c, Distance, Distance)
    -> Mk
         (([FontName], Distance, c, Distance, Distance) -> f hi ho) ())
-> Mk (([FontName], Distance, c, Distance, Distance) -> f hi ho) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
$> 
            (\([FontName]
lines', Distance
row, c
col, Distance
nrows', Distance
ncols') -> (Distance, FontName)
-> Mk (([FontName], Distance, c, Distance, Distance) -> f hi ho) ()
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 =
	    (FontName -> Mk (([FontName], Distance, c, d, e) -> f hi ho) ()
forall b a c d e k.
Num b =>
[a] -> Mk (([[a]], b, c, d, e) -> k) ()
appendLine FontName
s Mk (([FontName], Distance, c, d, e) -> f hi ho) ()
-> Mk
     (([FontName], Distance, c, d, e) -> f hi ho)
     ([FontName], Distance, c, d, e)
-> Mk
     (([FontName], Distance, c, d, e) -> f hi ho)
     ([FontName], Distance, c, d, e)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
$$$ Mk
  (([FontName], Distance, c, d, e) -> f hi ho)
  ([FontName], Distance, c, d, e)
forall k s. Ms k s s
loadMs) Mk
  (([FontName], Distance, c, d, e) -> f hi ho)
  ([FontName], Distance, c, d, e)
-> (([FontName], Distance, c, d, e)
    -> Mk (([FontName], Distance, c, d, e) -> f hi ho) ())
-> Mk (([FontName], Distance, c, d, e) -> f hi ho) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
$>
            (\(FontName
line:[FontName]
_, Distance
row, c
col, d
nrows', e
ncols') -> (Distance, FontName)
-> Mk (([FontName], Distance, c, d, e) -> f hi ho) ()
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  KCommand ho -> K TerminalCmd ho -> K TerminalCmd ho
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK (FRequest -> KCommand ho
forall a b. a -> Message a b
Low (LayoutRequest -> FRequest
layoutRequestCmd (Point -> Bool -> Bool -> LayoutRequest
plainLayout Point
size Bool
False Bool
False))) (K TerminalCmd ho -> K TerminalCmd ho)
-> K TerminalCmd ho -> K TerminalCmd ho
forall a b. (a -> b) -> a -> b
$
        ([FontName], Distance, Distance, Distance, Distance)
-> Mk
     (([FontName], Distance, Distance, Distance, Distance)
      -> K TerminalCmd ho)
     Any
-> K TerminalCmd ho
-> K TerminalCmd ho
forall b1 a b2. b1 -> Mk (b1 -> a) b2 -> a -> a
stateK ([], -Distance
1, Distance
0, Distance
nrows, Distance
ncols) Mk
  (([FontName], Distance, Distance, Distance, Distance)
   -> K TerminalCmd ho)
  Any
forall ho b.
Mk
  (([FontName], Distance, Distance, Distance, Distance)
   -> K TerminalCmd ho)
  b
k K TerminalCmd ho
forall hi ho. K hi ho
nullK