Peter Hancock wrote/a ecrit/skrev:
> I don't think its crazy.  I thought that one could start with
> something simple, like a "before" list and an "after list".

Indeed.  When I was getting into Haskell, I hacked the ansi.hs example
from the Hugs distribution to add editing.  Parts of the function
actually became simpler this way.

Regards,

  Tommy


readAt            :: Pos                  ->  -- Start coordinates
                     Int                  ->  -- Maximum input length
                     (String -> Interact) ->  -- How to use entered string
                     Interact

readAt (x,y) l use = writeAt (x,y) (copy l '_') (moveTo  (x,y) (loop "" ""))
 where loop rh t   -- Inv: s == (reverse rh)++t
                   = readChar (return rh t) (\c ->
                     case c of '\BS'         -> delete1 rh t
                               '\DEL'        -> delete1 rh t
                               '\n'          -> return rh t
                               '\002'        -> backwards rh t
                               '\006'        -> forwards rh t
                               c | (length (rh++t)) < l && ' ' <= c
                                             -> writeChar c (writeLoop (c:rh) t)
                                 | otherwise -> ringBell (loop rh t))
       backwards []     t = loop [] t
       backwards (c:rh) t = writeChar '\b' (loop rh (c:t))
       forwards rh    []  = loop rh []
       forwards rh (c:t)  = writeChar c (loop (c:rh) t)
       delete1 [] t       = ringBell (loop [] t)
       delete1 (c:rh) t   = writeChar '\b' (writeLoop rh t)
       writeLoop rh t     = writeString (t++"_"++(copy ((length t)+1) '\b'))
                                        (loop rh t)
       return rh t   = use ((reverse rh)++t)



Reply via email to