Biotope.curry 5.7 KB
Newer Older
bbr's avatar
bbr committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
import GUI
import IO
import ReadAnswer
import IOExts
import Dequeue
import Read

hello= listToDeq 
       " ____    ____    _____   \n\
      \(  _ \\  (_  _)  (  _  )   Believe\n\
       \ ) _ <   _)(_    )(_)(    in\n\
       \(____/()(____)()(_____)() Oracles\n\
       \---------------------------------\n\n\n"

bbr's avatar
bbr committed
15
16
17
18
19
20
21
22
widget st lref ref cb fb act = Col [LeftAlign] [
  row [PlainButton [Text "Console",WRef cb,Active (act==Console),
                    Handler DefaultEvent (showConsole st)],
       PlainButton [Text "Files",Active (act==Files),WRef fb,
                       Handler DefaultEvent (showFile True st 0)]],
  row [ListBox [FillY,Width 0,WRef lref,
       Handler DefaultEvent (selectFile st)], 
       TextEditScroll [Text $ deqToList hello,WRef ref]]
bbr's avatar
bbr committed
23
24
25
26
  ]


main = do
bbr's avatar
bbr committed
27
  let cref,fb,lref,cb free
bbr's avatar
bbr committed
28
  stdinUnbuffered
bbr's avatar
bbr committed
29
  state <- newIORef (emptyState cref fb lref cb)
bbr's avatar
bbr committed
30
  runInitHandlesControlledGUI "B.I.O.tope -- the debugging environment"  
bbr's avatar
bbr committed
31
     (widget state lref cref cb fb Console,[readMessages state]) 
bbr's avatar
bbr committed
32
33
34
35
36
37
38
     (readMessages state stdin) [stdin]
    

---------------------------------------------------------------------------
-- the state and how to reset it
---------------------------------------------------------------------------

bbr's avatar
bbr committed
39
data ActiveWidget = Console | Files 
bbr's avatar
bbr committed
40
41

type Files = [(String,String)]
bbr's avatar
bbr committed
42
type State = {files :: Files, 
bbr's avatar
bbr committed
43
44
              console :: Queue Char,active :: ActiveWidget,
              listWidget,textWidget,
bbr's avatar
bbr committed
45
              consoleButton,fileButton :: WidgetRef}
bbr's avatar
bbr committed
46

bbr's avatar
bbr committed
47
48
49
50
emptyState r1 r2 r3 r4 = 
  {files=[],console=hello, active=Console,
   textWidget=r1,fileButton=r2,
   listWidget=r3,consoleButton=r4}
bbr's avatar
bbr committed
51
52
53
54
55


reset :: GuiPort -> IORef State -> IO [ReconfigureItem]
reset gp ref = do
  st <- readIORef ref
bbr's avatar
bbr committed
56
  writeIORef ref {files:=[],console:=hello,active:=Console|st}
bbr's avatar
bbr committed
57
58
  setValue (st->textWidget) (deqToList hello) gp
  return [WidgetConf (st->listWidget) (List []),
bbr's avatar
bbr committed
59
          acti False (st->fileButton),
bbr's avatar
bbr committed
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
          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 [])]
               

bbr's avatar
bbr committed
80
81
addFile :: Bool -> GuiPort -> IORef State -> (String,String) -> IO [ReconfigureItem]
addFile append gp ref f@(fn,cont) = do
bbr's avatar
bbr committed
82
  st <- readIORef ref
bbr's avatar
bbr committed
83
84
85
86
87
  let fs = st->files
  case break ((==tail fn) . tail . fst) fs of
    (_,[])    -> do
                   writeIORef ref {files:=st->files++[f] | st}
                   showFile True ref (length (st->files)) gp
bbr's avatar
bbr committed
88
    (xs,(_,yc):ys) -> if append 
bbr's avatar
bbr committed
89
90
91
92
93
94
                 then do
                   writeIORef ref {files:=xs++ys++[(fn,yc++cont)] | st}
                   showFile True ref (length (st->files) - 1) gp
                 else do 
                   writeIORef ref {files:=xs++ys++[f] | st}
                   showFile True ref (length (st->files) - 1) gp
bbr's avatar
bbr committed
95
96
97
98
99
100
101
102
103

---------------------------------------------------------------------------
-- showing content in text/list widget
---------------------------------------------------------------------------

selectFile :: IORef State -> GuiPort -> IO [ReconfigureItem]
selectFile ref gp = do
  st <- readIORef ref
  i  <- getValue (st->listWidget) gp
bbr's avatar
bbr committed
104
  showFile    False ref (readInt i) gp
bbr's avatar
bbr committed
105

bbr's avatar
bbr committed
106
107
showFile :: Bool -> IORef State -> Int -> GuiPort -> IO [ReconfigureItem]
showFile listchanged ref i gp = do
bbr's avatar
bbr committed
108
  st <- readIORef ref
bbr's avatar
bbr committed
109
110
111
112
113
114
115
  setValue (st->textWidget) (snd (st->files !! i)) gp
  writeIORef ref {active:=Files|st} 
  return (activate st:acti False (st->fileButton):
          if listchanged 
          then map (WidgetConf (st->listWidget)) 
               [List (map fst (st->files)),Text (show i)]
          else [])
bbr's avatar
bbr committed
116
117
118
119
120
121
122
123
124
125
126

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
bbr's avatar
bbr committed
127
128
  Files   -> (st->fileButton)
  Console -> (st->consoleButton))
bbr's avatar
bbr committed
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146


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 
bbr's avatar
bbr committed
147
       addFile False gp ref ("R: "++l,cont)
bbr's avatar
bbr committed
148
149
150
    'w' -> do
       l <- hGetLine h
       cont <- getFileCont h 
bbr's avatar
bbr committed
151
152
153
154
155
       addFile False gp ref ("W: "++l,cont)
    'a' -> do
       l <- hGetLine h
       cont <- getFileCont h 
       addFile True gp ref ("W: "++l,cont)
bbr's avatar
bbr committed
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
    '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)