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 }