home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.uni-stuttgart.de/pub/systems/acorn/
/
Acorn.tar
/
Acorn
/
acornet
/
dev
/
hugs1.0.spk
/
hs
/
ansi
next >
Wrap
Text File
|
1995-02-14
|
4KB
|
119 lines
-- This is a simple program using ANSI escape sequences to create a program
-- which uses direct cursor addressing and input/output.
--
-- People are often quite surprised the first time they see a program like
-- this written in a functional language.
-- Basic screen control codes:
-- Choose whichever of the following lines is suitable for your system:
cls = "\ESC[2J" -- for PC with ANSI.SYS
cls = "\^L" -- for Sun window
goto x y = '\ESC':'[':(show y ++(';':show x ++ "H"))
at (x,y) s = goto x y ++ s
home = goto 1 1
highlight s = "\ESC[7m"++s++"\ESC[0m"
-- Some general purpose functions for interactive programs:
type Interact = String -> String
end :: Interact
end cs = ""
readChar, peekChar :: Interact -> (Char -> Interact) -> Interact
readChar eof use [] = eof []
readChar eof use (c:cs) = use c cs
peekChar eof use [] = eof [] -- like readChar, but character is
peekChar eof use cs@(c:_) = use c cs -- not removed from input stream
pressAnyKey :: Interact -> Interact
pressAnyKey prog = readChar prog (\c -> prog)
unreadChar :: Char -> Interact -> Interact
unreadChar c prog cs = prog (c:cs)
writeChar :: Char -> Interact -> Interact
writeChar c prog cs = c : prog cs
writeString :: String -> Interact -> Interact
writeString s prog cs = s ++ prog cs
writes :: [String] -> Interact -> Interact
writes ss = writeString (concat ss)
ringBell :: Interact -> Interact
ringBell = writeChar '\BEL'
-- Screen oriented input/output functions:
type Pos = (Int,Int)
clearScreen = writeString cls
writeAt (x,y) s = writeString (goto x y ++ s)
moveTo (x,y) = writeString (goto x y)
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 0 ""))
where loop n s = readChar (return s) (\c ->
case c of '\BS' -> delete n s
'\DEL' -> delete n s
'\n' -> return s
c | n < l -> writeChar c (loop (n+1) (c:s))
| otherwise -> ringBell (loop n s))
delete n s = if n>0 then writeString "\BS_\BS" (loop (n-1) (tail s))
else ringBell (loop 0 "")
return s = use (reverse s)
defReadAt :: Pos -> -- Start coordinates
Int -> -- Maximum input length
String -> -- Default string value
(String -> Interact) -> -- How to use entered string
Interact
defReadAt (x,y) l def use
= writeAt (x,y) (take l (def++repeat '_')) (
readChar (use def) (\c ->
if c=='\n' then use def
else unreadChar c (readAt (x,y) l use)))
promptReadAt (x,y) l prompt use
= writeAt (x,y) prompt (readAt (x+length prompt,y) l use)
defPromptReadAt (x,y) l prompt def use
= writeAt (x,y) prompt (
defReadAt (x+length prompt,y) l def use)
-- A sample program:
-- Enter the expression `run program' in Hugs to try this program out
program = writes [ cls,
at (17,5) (highlight "Demonstration program"),
at (48,5) "Version 1.0",
at (17,7) "This program illustrates a simple approach",
at (17,8) "to screen-based interactive programs using",
at (17,9) "the Hugs functional programming system.",
at (17,11) "Please press any key to continue ..."
]
(pressAnyKey
(promptReadAt (17,15) 18 "Please enter your name: " (\name ->
(let reply = "Hello " ++ name ++ "!" in
writeAt (40-(length reply`div` 2),18) reply
(moveTo (1,23)
(writeString "I'm waiting...\n"
(pressAnyKey
end)))))))
-- End of file