home *** CD-ROM | disk | FTP | other *** search
/ PSION CD 2 / PsionCDVol2.iso / Programs / 876 / hugs.sis / Interact.hs < prev    next >
Encoding:
Text File  |  2000-09-21  |  2.4 KB  |  73 lines
  1. -----------------------------------------------------------------------------
  2. -- Library for simple interactive programs:
  3. --
  4. -- Suitable for use with Hugs 98
  5. -----------------------------------------------------------------------------
  6.  
  7. module Interact(
  8.     Interact(..),
  9.     end,
  10.     readChar, peekChar, unreadChar, pressAnyKey,
  11.     writeChar, writeStr,
  12.     readLine,
  13.     ringBell
  14.     ) where
  15.  
  16. --- Interactive program combining forms:
  17.  
  18. type Interact = String -> String
  19.  
  20. end                      :: Interact
  21. readChar, peekChar       :: Interact -> (Char -> Interact) -> Interact
  22. pressAnyKey              :: Interact -> Interact
  23. unreadChar               :: Char -> Interact -> Interact
  24. writeChar                :: Char -> Interact -> Interact
  25. writeStr                 :: String -> Interact -> Interact
  26. ringBell                 :: Interact -> Interact
  27. readLine                 :: String -> (String -> Interact) -> Interact
  28.  
  29. end cs                    = ""
  30.  
  31. readChar eof use []       = eof []
  32. readChar eof use (c:cs)   = use c cs
  33.  
  34. peekChar eof use []       = eof []     -- like readChar, but character is
  35. peekChar eof use cs@(c:_) = use c cs   -- not removed from input stream
  36.  
  37. pressAnyKey prog          = readChar prog (\c -> prog)
  38.  
  39. unreadChar c prog cs      = prog (c:cs)
  40.  
  41. writeChar c prog cs       = c : prog cs
  42.  
  43. writeStr s prog cs        = s ++ prog cs
  44.  
  45. ringBell                  = writeChar '\BEL'
  46.  
  47. readLine prompt g is  = prompt ++ lineOut 0 line ++ "\n"
  48.                                ++ g (noBackSpaces line) input'
  49.  where line     = before '\n' is
  50.        input'   = after  '\n' is
  51.        after x  = tail . dropWhile (x/=)
  52.        before x = takeWhile (x/=)
  53.  
  54.        rubout  :: Char -> Bool
  55.        rubout c = (c=='\DEL' || c=='\BS')
  56.  
  57.        lineOut                      :: Int -> String -> String
  58.        lineOut n ""                  = ""
  59.        lineOut n (c:cs)
  60.                  | n>0  && rubout c  = "\BS \BS" ++ lineOut (n-1) cs
  61.                  | n==0 && rubout c  = lineOut 0 cs
  62.                  | otherwise         = c:lineOut (n+1) cs
  63.  
  64.        noBackSpaces :: String -> String
  65.        noBackSpaces  = reverse . delete 0 . reverse
  66.                        where delete n ""          = ""
  67.                              delete n (c:cs)
  68.                                       | rubout c  = delete (n+1) cs
  69.                                       | n>0       = delete (n-1) cs
  70.                                       | otherwise = c:delete 0 cs
  71.  
  72. -----------------------------------------------------------------------------
  73.