home *** CD-ROM | disk | FTP | other *** search
- --
- -- Interactive utility functions
- -- Mark P. Jones November 1990, modified for Gofer 20th July 1991
- --
- -- uses Gofer version 2.20
- --
-
- -- The functions defined in this module provide basic facilities for
- -- writing line-oriented interactive programs (i.e. a function mapping
- -- an input string to an appropriate output string). These definitions
- -- are an enhancement of thos in B+W 7.8
- --
- -- skip p is an interactive program which consumes no input, produces
- -- no output and then behaves like the interactive program p.
- -- end is an interactive program which ignores the input and
- -- produces no output.
- -- writeln txt p is an interactive program which outputs the message txt
- -- and then behaves like the interactive program p
- -- readch act def is an interactive program which reads the first character c
- -- from the input stream and behaves like the interactive
- -- program act c. If the input character stream is empty,
- -- readch act def prints the default string def and terminates.
- --
- -- readln p g is an interactive program which prints the prompt p and
- -- reads a line (upto the first carriage return, or end of
- -- input) from the input stream. It then behaves like g line.
- -- Backspace characters included in the input stream are
- -- interpretted in the usual way.
-
- type Interactive = String -> String
-
- --- Interactive program combining forms:
-
- skip :: Interactive -> Interactive
- skip p is = p is -- a dressed up identity function
-
- end :: Interactive
- end is = ""
-
- writeln :: String -> Interactive -> Interactive
- writeln txt p is = txt ++ p is
-
- readch :: (Char -> Interactive) -> String -> Interactive
- readch act def "" = def
- readch act def (c:cs) = act c cs
-
- readln :: String -> (String -> Interactive) -> Interactive
- readln prompt g is = prompt ++ lineOut 0 line ++ "\n"
- ++ g (noBackSpaces line) input'
- where line = before '\n' is
- input' = after '\n' is
- after x = tail . dropWhile (x/=)
- before x = takeWhile (x/=)
-
- --- Filter out backspaces etc:
-
- rubout :: Char -> Bool
- rubout c = (c=='\DEL' || c=='\BS')
-
- lineOut :: Int -> String -> String
- lineOut n "" = ""
- lineOut n (c:cs)
- | n>0 && rubout c = "\BS \BS" ++ lineOut (n-1) cs
- | n==0 && rubout c = lineOut 0 cs
- | otherwise = c:lineOut (n+1) cs
-
- noBackSpaces :: String -> String
- noBackSpaces = reverse . delete 0 . reverse
- where delete n "" = ""
- delete n (c:cs)
- | rubout c = delete (n+1) cs
- | n>0 = delete (n-1) cs
- | otherwise = c:delete 0 cs
-
- --- End of Interact.hs
-