disable a false assertion, with a comment to explain why
[ghc-hetmet.git] / utils / heap-view / HaskXLib.c
1 /*----------------------------------------------------------------------*
2  *  X from Haskell (PicoX)
3  *
4  * (c) 1993 Andy Gill
5  *
6  *----------------------------------------------------------------------*/
7
8 #include <X11/Xlib.h>
9 #include <X11/Xutil.h>
10 #include <X11/Xatom.h>
11 #include <stdio.h>
12 #include <strings.h>
13
14 /*----------------------------------------------------------------------*/
15
16 /* First the X Globals */
17
18 Display *MyDisplay;
19 int      MyScreen;
20 Window   MyWindow;
21 XEvent   MyWinEvent;
22 GC       DrawGC;
23 GC       UnDrawGC;
24
25 /* and the Haskell globals */
26
27 typedef struct {
28   int HaskButtons[5];
29   int HaskPointerX,HaskPointerY;
30   int PointMoved;
31 } HaskGlobType;
32
33 HaskGlobType HaskGlob;
34
35 /*----------------------------------------------------------------------*/
36
37 /*
38  * Now the access functions into the haskell globals
39  */
40
41 int haskGetButtons(int n)
42 {
43   return(HaskGlob.HaskButtons[n]);
44 }
45
46 int haskGetPointerX(void)
47 {
48   return(HaskGlob.HaskPointerX);
49 }
50
51 int haskGetPointerY(void)
52 {
53   return(HaskGlob.HaskPointerY);
54 }
55
56 /*----------------------------------------------------------------------*/
57
58 /*
59  *The (rather messy) initiualisation
60  */
61
62 haskXBegin(int x,int y,int sty)
63 {
64  /*
65   *  later include these via interface hacks
66   */
67
68  /* (int argc, char **argv) */
69   int argc = 0;
70   char **argv = 0;
71
72   XSizeHints XHints;
73   int MyWinFG, MyWinBG,tmp;
74  
75   if ((MyDisplay = XOpenDisplay("")) == NULL) {
76       fprintf(stderr, "Cannot connect to X server '%s'\n", XDisplayName(""));
77       exit(1);
78   }
79
80   MyScreen = DefaultScreen(MyDisplay);
81
82   MyWinBG = WhitePixel(MyDisplay, MyScreen);
83   MyWinFG = BlackPixel(MyDisplay, MyScreen);
84  
85   XHints.x      = x;
86   XHints.y      = y;
87   XHints.width  = x;
88   XHints.height = y;
89   XHints.flags  = PPosition | PSize;
90  
91   MyWindow =
92       XCreateSimpleWindow(
93                           MyDisplay,
94                           DefaultRootWindow(MyDisplay),
95                           x,y, x, y,
96                           5,
97                           MyWinFG,
98                           MyWinBG
99                           );
100  
101   XSetStandardProperties(
102                          MyDisplay,
103                          MyWindow,
104                          "XLib for Glasgow Haskell",
105                          "XLib for Glasgow Haskell",
106                          None,
107                          argv,
108                          argc,
109                          &XHints
110                          );
111  
112   /* Create drawing and erasing GC */
113  
114   DrawGC = XCreateGC(MyDisplay,MyWindow,0, 0);
115   XSetBackground(MyDisplay,DrawGC,MyWinBG);
116   XSetForeground(MyDisplay,DrawGC,MyWinFG);
117
118   UnDrawGC = XCreateGC(MyDisplay,MyWindow,0, 0);
119   XSetBackground(MyDisplay,UnDrawGC,MyWinFG);
120   XSetForeground(MyDisplay,UnDrawGC,MyWinBG);
121
122   XSetGraphicsExposures(MyDisplay,DrawGC,False);
123   XSetGraphicsExposures(MyDisplay,UnDrawGC,False);
124   XMapRaised(MyDisplay,MyWindow);
125  
126   /* the user should be able to choose which are tested for
127    */
128
129   XSelectInput(
130                MyDisplay,
131                MyWindow,
132                    ButtonPressMask | ButtonReleaseMask | PointerMotionMask 
133                );
134
135   /*  later have more drawing styles
136    */
137
138   switch (sty)
139     {
140     case 0:   
141       /* Andy, this used to be GXor not much use for Undrawing so I
142          changed it. (Not much use for colour either - see next
143          comment */
144       XSetFunction(MyDisplay,DrawGC,GXcopy);
145       XSetFunction(MyDisplay,UnDrawGC,GXcopy);
146       break;
147     case 1:   
148       /* Andy, this can have totally bogus results on a colour screen */
149       XSetFunction(MyDisplay,DrawGC,GXxor);
150       XSetFunction(MyDisplay,UnDrawGC,GXxor);
151       break;
152     default:
153       /* Andy, is this really a good error message? */
154       printf(stderr,"Wrong Argument to XSet function\n");
155     }
156  /*
157   *  reset the (Haskell) globals
158   */
159
160  for(tmp=0;tmp<5;tmp++)
161    {
162      HaskGlob.HaskButtons[tmp] = 0;
163    }
164   HaskGlob.HaskPointerX = 0;
165   HaskGlob.HaskPointerY = 0;
166   HaskGlob.PointMoved = 0;
167
168   XFlush(MyDisplay);
169
170
171
172 /*----------------------------------------------------------------------*/
173
174 /* Boring X ``Do Something'' functions
175  */
176
177 haskXClose(void)
178 {
179   XFreeGC( MyDisplay, DrawGC);
180   XFreeGC( MyDisplay, UnDrawGC);
181   XDestroyWindow( MyDisplay, MyWindow);
182   XCloseDisplay( MyDisplay);
183   return(0);
184 }
185
186 haskXDraw(x,y,x1,y1)
187 int x,y,x1,y1;
188 {
189   XDrawLine(MyDisplay,
190             MyWindow,
191             DrawGC,
192             x,y,x1,y1);
193   return(0);
194 }
195
196
197 haskXPlot(c,x,y)
198 int c;
199 int x,y;
200 {
201   XDrawPoint(MyDisplay,
202             MyWindow,
203             (c?DrawGC:UnDrawGC), 
204             x,y);
205   return(0);
206 }
207
208 haskXFill(c,x,y,w,h)
209 int c;
210 int x, y;
211 int w, h;
212 {
213   XFillRectangle(MyDisplay,
214             MyWindow,
215             (c?DrawGC:UnDrawGC),
216             x, y, w, h);
217   return(0);
218 }
219
220 /*----------------------------------------------------------------------*/
221  
222  /* This has to be called every time round the loop,
223   * it flushed the buffer and handles input from the user
224   */
225
226 haskHandleEvent()
227 {
228   XFlush( MyDisplay);
229   while (XEventsQueued( MyDisplay, QueuedAfterReading) != 0) {
230     XNextEvent( MyDisplay, &MyWinEvent);
231     switch (MyWinEvent.type) {
232     case ButtonPress:
233       switch (MyWinEvent.xbutton.button) 
234         {
235         case Button1: HaskGlob.HaskButtons[0] = 1; break;
236         case Button2: HaskGlob.HaskButtons[1] = 1; break;
237         case Button3: HaskGlob.HaskButtons[2] = 1; break;
238         case Button4: HaskGlob.HaskButtons[3] = 1; break;
239         case Button5: HaskGlob.HaskButtons[4] = 1; break;
240         }
241       break;
242     case ButtonRelease:
243       switch (MyWinEvent.xbutton.button) 
244         {
245         case Button1: HaskGlob.HaskButtons[0] = 0; break;
246         case Button2: HaskGlob.HaskButtons[1] = 0; break;
247         case Button3: HaskGlob.HaskButtons[2] = 0; break;
248         case Button4: HaskGlob.HaskButtons[3] = 0; break;
249         case Button5: HaskGlob.HaskButtons[4] = 0; break;
250         }
251       break;
252     case MotionNotify: 
253         HaskGlob.HaskPointerX = MyWinEvent.xmotion.x;
254         HaskGlob.HaskPointerY = MyWinEvent.xmotion.y;
255         HaskGlob.PointMoved = 1;
256       break;
257     default:
258     printf("UNKNOWN INTERUPT ???? (%d) \n",MyWinEvent.type); 
259       break;
260     } /*switch*/
261   } /*if*/
262   return(0);
263
264
265
266 /*----------------------------------------------------------------------*/
267
268  /* A function to clear the screen 
269   */
270
271 haskXCls(void)
272 {
273   XClearWindow(MyDisplay,MyWindow);
274 }
275
276 /*----------------------------------------------------------------------*/
277
278  /* A function to write a string
279   */
280
281 haskXDrawString(int x,int y,char *str)
282 {
283   return(0);
284 /*  printf("GOT HERE %s %d %d",str,x,y); 
285   XDrawString(MyDisplay,MyWindow,DrawGC,x,y,str,strlen(str));
286 */
287 }
288
289 /*----------------------------------------------------------------------*/
290
291 extern int prog_argc;
292 extern char **prog_argv;
293
294 haskArgs()
295 {
296   return(prog_argc > 1 ? atoi(prog_argv[1]) : 0);
297 }