home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / hugs101.zip / hugs101sc.zip / hugsdist / demos / Prolog / Interact < prev    next >
Text File  |  1995-02-14  |  3KB  |  76 lines
  1. --
  2. -- Interactive utility functions
  3. -- Mark P. Jones November 1990, modified for Gofer 20th July 1991
  4. --
  5. -- uses Gofer version 2.28
  6. --
  7.  
  8. -- The functions defined in this module provide basic facilities for
  9. -- writing line-oriented interactive programs (i.e. a function mapping
  10. -- an input string to an appropriate output string).  These definitions
  11. -- are an enhancement of thos in B+W 7.8
  12. --
  13. -- skip p         is an interactive program which consumes no input, produces
  14. --                no output and then behaves like the interactive program p.
  15. -- end            is an interactive program which ignores the input and
  16. --                produces no output.
  17. -- writeln txt p  is an interactive program which outputs the message txt
  18. --                and then behaves like the interactive program p
  19. -- readch act def is an interactive program which reads the first character c
  20. --                from the input stream and behaves like the interactive
  21. --                program act c.  If the input character stream is empty,
  22. --                readch act def prints the default string def and terminates.
  23. -- 
  24. -- readln p g     is an interactive program which prints the prompt p and
  25. --                reads a line (upto the first carriage return, or end of
  26. --                input) from the input stream.  It then behaves like g line.
  27. --                Backspace characters included in the input stream are
  28. --                interpretted in the usual way.
  29.  
  30. type Interactive = String -> String
  31.  
  32. --- Interactive program combining forms:
  33.  
  34. skip                 :: Interactive -> Interactive
  35. skip p is             = p is    -- a dressed up identity function
  36.  
  37. end                  :: Interactive
  38. end is                = ""
  39.  
  40. writeln              :: String -> Interactive -> Interactive
  41. writeln txt p is      = txt ++ p is
  42.  
  43. readch               :: (Char -> Interactive) -> String -> Interactive
  44. readch act def ""     = def
  45. readch act def (c:cs) = act c cs
  46.  
  47. readln               :: String -> (String -> Interactive) -> Interactive
  48. readln prompt g is    = prompt ++ lineOut 0 line ++ "\n"
  49.                                ++ g (noBackSpaces line) input'
  50.                         where line     = before '\n' is
  51.                               input'   = after  '\n' is
  52.                               after x  = tail . dropWhile (x/=)
  53.                               before x = takeWhile (x/=)
  54.  
  55. --- Filter out backspaces etc:
  56.  
  57. rubout  :: Char -> Bool
  58. rubout c = (c=='\DEL' || c=='\BS')
  59.  
  60. lineOut                      :: Int -> String -> String
  61. lineOut n ""                  = ""
  62. lineOut n (c:cs)
  63.           | n>0  && rubout c  = "\BS \BS" ++ lineOut (n-1) cs
  64.           | n==0 && rubout c  = lineOut 0 cs
  65.           | otherwise         = c:lineOut (n+1) cs
  66.  
  67. noBackSpaces :: String -> String
  68. noBackSpaces  = reverse . delete 0 . reverse
  69.                 where delete n ""          = ""
  70.                       delete n (c:cs)
  71.                                | rubout c  = delete (n+1) cs
  72.                                | n>0       = delete (n-1) cs
  73.                                | otherwise = c:delete 0 cs
  74.  
  75. --- End of Interact.hs
  76.