Commit 5e665e1a authored by bbr's avatar bbr
Browse files

the biotope gui

forgotten to check in last time
parent 8455ad40
import GUI
import IO
import ReadAnswer
import IOExts
import Dequeue
import Read
hello= listToDeq
" ____ ____ _____ \n\
\( _ \\ (_ _) ( _ ) Believe\n\
\ ) _ < _)(_ )(_)( in\n\
\(____/()(____)()(_____)() Oracles\n\
\---------------------------------\n\n\n"
widget st lref ref cb rb wb act = Col [LeftAlign] [
Row [] [PlainButton [Text "Console",WRef cb,Active (act==Console),
Handler DefaultEvent (showConsole st)],
PlainButton [Text "Files read",Active (act==ReadFiles),WRef rb,
Handler DefaultEvent (showReadFile st 0)],
PlainButton [Text "Files written",Active (act==WrittenFiles),WRef wb,
Handler DefaultEvent (showWrittenFile st 0)]],
Row [] [ListBox [FillY,Width 0,WRef lref,
Handler DefaultEvent (selectFile st)],
TextEditScroll [Text $ deqToList hello,WRef ref,TclOption ""]]
]
main = do
let cref,rb,wb,lref,cb free
stdinUnbuffered
state <- newIORef (emptyState cref rb wb lref cb)
runInitHandlesControlledGUI "B.I.O.tope -- the debugging environment"
(widget state lref cref cb rb wb Console,[readMessages state])
(readMessages state stdin) [stdin]
---------------------------------------------------------------------------
-- the state and how to reset it
---------------------------------------------------------------------------
data ActiveWidget = Console | ReadFiles | WrittenFiles
type Files = [(String,String)]
type State = {readFiles, writtenFiles :: Files,
console :: Queue Char,active :: ActiveWidget,
listWidget,textWidget,
consoleButton,readButton,writtenButton :: WidgetRef}
emptyState r1 r2 r3 r4 r5 =
{readFiles=[],writtenFiles=[],console=hello, active=Console,
textWidget=r1,readButton=r2,writtenButton=r3,
listWidget=r4,consoleButton=r5}
reset :: GuiPort -> IORef State -> IO [ReconfigureItem]
reset gp ref = do
st <- readIORef ref
writeIORef ref {readFiles:=[],writtenFiles:=[],console:=hello,
active:=Console|st}
setValue (st->textWidget) (deqToList hello) gp
return [WidgetConf (st->listWidget) (List []),
acti False (st->readButton),
acti False (st->writtenButton),
acti False (st->consoleButton)]
---------------------------------------------------------------------------
-- dynamically adding things to the state
---------------------------------------------------------------------------
addConsole :: GuiPort -> IORef State -> Char -> IO [ReconfigureItem]
addConsole gp ref c = do
st <- readIORef ref
let newConsole = snoc c (st->console)
writeIORef ref {console:=newConsole,active:=Console|st}
case st->active of
Console -> appendValue (st->textWidget) [c] gp >>
return []
_ -> setValue (st->textWidget) (deqToList newConsole) gp >>
return [activate st,acti False (st->consoleButton),
WidgetConf (st->listWidget) (List [])]
addReadFile :: GuiPort -> IORef State -> (String,String) -> IO [ReconfigureItem]
addReadFile gp ref f = do
st <- readIORef ref
writeIORef ref {readFiles:=st->readFiles++[f] | st}
showReadFile ref (length (st->readFiles)) gp
addWrittenFile :: GuiPort -> IORef State -> (String,String) -> IO [ReconfigureItem]
addWrittenFile gp ref f = do
st <- readIORef ref
writeIORef ref {writtenFiles:=st->writtenFiles ++ [f] | st}
showWrittenFile ref (length (st->writtenFiles)) gp
---------------------------------------------------------------------------
-- showing content in text/list widget
---------------------------------------------------------------------------
selectFile :: IORef State -> GuiPort -> IO [ReconfigureItem]
selectFile ref gp = do
st <- readIORef ref
i <- getValue (st->listWidget) gp
case st->active of
ReadFiles -> showReadFile ref (readInt i) gp
WrittenFiles -> showWrittenFile ref (readInt i) gp
showReadFile :: IORef State -> Int -> GuiPort -> IO [ReconfigureItem]
showReadFile ref i gp = do
st <- readIORef ref
setValue (st->textWidget) (snd (st->readFiles !! i)) gp
writeIORef ref {active:=ReadFiles|st}
return [activate st,acti False (st->readButton),
WidgetConf (st->listWidget) (List (map fst (st->readFiles)))]
showWrittenFile :: IORef State -> Int -> GuiPort -> IO [ReconfigureItem]
showWrittenFile ref i gp = do
st <- readIORef ref
setValue (st->textWidget) (snd (st->writtenFiles !! i)) gp
writeIORef ref {active:=WrittenFiles|st}
return [activate st,acti False (st->writtenButton),
WidgetConf (st->listWidget) (List (map fst (st->writtenFiles)))]
showConsole :: IORef State -> GuiPort -> IO [ReconfigureItem]
showConsole ref gp = do
st <- readIORef ref
setValue (st->textWidget) (deqToList (st->console)) gp
writeIORef ref {active:=Console|st}
return [activate st,acti False (st->consoleButton),
WidgetConf (st->listWidget) (List [])]
activate :: State -> ReconfigureItem
activate st = acti True (case st -> active of
ReadFiles -> (st->readButton)
WrittenFiles -> (st->writtenButton)
Console -> (st->consoleButton))
acti b ref = WidgetConf ref (Active b)
---------------------------------------------------------------------------
-- handling the messages from stdin
---------------------------------------------------------------------------
readMessages :: IORef State -> Handle -> GuiPort -> IO [ReconfigureItem]
readMessages ref h gp = do
cmd <- hGetChar h
case cmd of
'c' -> do
c <- hGetChar h
addConsole gp ref c
'r' -> do
l <- hGetLine h
cont <- getFileCont h
addReadFile gp ref (l,cont)
'w' -> do
l <- hGetLine h
cont <- getFileCont h
addWrittenFile gp ref (l,cont)
'q' -> exitGUI gp >> return []
'!' -> reset gp ref
_ -> return []
getFileCont :: Handle -> IO String
getFileCont h = do
n <- hGetLine h
hGetNO h (readInt n)
hGetNO :: Handle -> Int -> IO String
hGetNO h i | i==0 = return []
| otherwise = do
c <- hGetChar h
s <- hGetNO h (i-1)
return (c:s)
\ No newline at end of file
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment