Task: Window creation_X11

C: '--- added a flush to exit cleanly   
PRAGMA LDFLAGS `pkg-config --cflags --libs x11`
PRAGMA INCLUDE <X11/Xlib.h>
PRAGMA INCLUDE <X11/Xutil.h>

OPTION PARSE FALSE
 
'---XLIB is so ugly
ALIAS XNextEvent TO EVENT
ALIAS XOpenDisplay TO DISPLAY
ALIAS DefaultScreen TO SCREEN
ALIAS XCreateSimpleWindow TO CREATE
ALIAS XCloseDisplay TO CLOSE_DISPLAY
ALIAS XSelectInput TO EVENT_TYPE
ALIAS XMapWindow TO MAP_EVENT
ALIAS XFillRectangle TO FILL_RECTANGLE
ALIAS XDrawString TO DRAW_STRING
ALIAS XFlush TO FLUSH

 
'---pointer to X Display structure
DECLARE d TYPE  Display*
 
'---pointer to the newly created window		
'DECLARE w TYPE WINDOW
 
'---pointer to the XEvent
DECLARE e TYPE XEvent
 
DECLARE msg TYPE char*
 
'--- number of screen to place the window on
DECLARE s TYPE int
 
 
 
  msg = "Hello, World!"
 
 
   d = DISPLAY(NULL)
   IF d == NULL THEN
	 EPRINT "Cannot open display" FORMAT "%s%s\n"
	 END
   END IF
 
   s = SCREEN(d)
   w = CREATE(d, RootWindow(d, s), 10, 10, 100, 100, 1,BlackPixel(d, s), WhitePixel(d, s))
 
   EVENT_TYPE(d, w, ExposureMask | KeyPressMask)
   MAP_EVENT(d, w)
 
   WHILE  (1) 
	 EVENT(d, &e)
	 IF e.type == Expose THEN
	    FILL_RECTANGLE(d, w, DefaultGC(d, s), 20, 20, 10, 10)
	    DRAW_STRING(d, w, DefaultGC(d, s), 10, 50, msg, strlen(msg))
	 END IF
	 IF e.type == KeyPress THEN
	    BREAK
	 END IF   
   WEND
   FLUSH(d)
   CLOSE_DISPLAY(d)









COBOL:        identification division.
       program-id. x11-hello.
       installation. cobc -x x11-hello.cob -lX11
       remarks. Use of private data is likely not cross platform.

       data division.
       working-storage section.
       01 msg.
          05 filler            value z"S'up, Earth?".
       01 msg-len              usage binary-long value 12.

       01 x-display            usage pointer.
       01 x-window             usage binary-c-long.

      
      
      
      
       01 x-display-private    based.
          05 x-ext-data        usage pointer sync.
          05 private1          usage pointer.
          05 x-fd              usage binary-long.
          05 private2          usage binary-long.
          05 proto-major-version   usage binary-long.
          05 proto-minor-version   usage binary-long.
          05 vendor            usage pointer sync.
          05 private3          usage pointer.
          05 private4          usage pointer.
          05 private5          usage pointer.
          05 private6          usage binary-long.
          05 allocator         usage program-pointer sync.
          05 byte-order        usage binary-long.
          05 bitmap-unit       usage binary-long.
          05 bitmap-pad        usage binary-long.
          05 bitmap-bit-order  usage binary-long.
          05 nformats          usage binary-long.
          05 screen-format     usage pointer sync.
          05 private8          usage binary-long.
          05 x-release         usage binary-long.
          05 private9          usage pointer sync.
          05 private10         usage pointer sync.
          05 qlen              usage binary-long.
          05 last-request-read usage binary-c-long unsigned sync.
          05 request           usage binary-c-long unsigned sync.
          05 private11         usage pointer sync.
          05 private12         usage pointer.
          05 private13         usage pointer.
          05 private14         usage pointer.
          05 max-request-size  usage binary-long unsigned.
          05 x-db              usage pointer sync.
          05 private15         usage program-pointer sync.
          05 display-name      usage pointer.
          05 default-screen    usage binary-long.
          05 nscreens          usage binary-long.
          05 screens           usage pointer sync.
          05 motion-buffer     usage binary-c-long unsigned.
          05 private16         usage binary-c-long unsigned.
          05 min-keycode       usage binary-long.
          05 max-keycode       usage binary-long.
          05 private17         usage pointer sync.
          05 private18         usage pointer.
          05 private19         usage binary-long.
          05 x-defaults        usage pointer sync.
          05 filler            pic x(256).

       01 x-screen-private     based.
          05 scr-ext-data      usage pointer sync.
          05 display-back      usage pointer.
          05 root              usage binary-c-long.
          05 x-width           usage binary-long.
          05 x-height          usage binary-long.
          05 m-width           usage binary-long.
          05 m-height          usage binary-long.
          05 x-ndepths         usage binary-long.
          05 depths            usage pointer sync.
          05 root-depth        usage binary-long.
          05 root-visual       usage pointer sync.
          05 default-gc        usage pointer.
          05 cmap              usage pointer.
          05 white-pixel       usage binary-c-long unsigned sync.
          05 black-pixel       usage binary-c-long unsigned.
          05 max-maps          usage binary-long.
          05 min-maps          usage binary-long.
          05 backing-store     usage binary-long.
          05 save_unders       usage binary-char.
          05 root-input-mask   usage binary-c-long sync.
          05 filler            pic x(256).

       01 event.
          05 e-type usage      binary-long.
          05 filler            pic x(188).
          05 filler            pic x(256).
       01 Expose               constant as 12.
       01 KeyPress             constant as 2.

      
       01 event-mask           usage binary-c-long value 32769.

      
       01 x-char-struct.
          05 lbearing          usage binary-short.
          05 rbearing          usage binary-short.
          05 string-width      usage binary-short.
          05 ascent            usage binary-short.
          05 descent           usage binary-short.
          05 attributes        usage binary-short unsigned.
       01 font-direction       usage binary-long.
       01 font-ascent          usage binary-long.
       01 font-descent         usage binary-long.

       01 XGContext            usage binary-c-long.
       01 box-width            usage binary-long.
       01 box-height           usage binary-long.

      
       procedure division.

       call "XOpenDisplay" using by reference null returning x-display
           on exception
               display function module-id " Error: "
                       "no XOpenDisplay linkage, requires libX11"
                  upon syserr
               stop run returning 1
       end-call
       if x-display equal null then
           display function module-id " Error: "
                   "XOpenDisplay returned null" upon syserr
           stop run returning 1
       end-if
       set address of x-display-private to x-display

       if screens equal null then
           display function module-id " Error: "
                   "XOpenDisplay associated screen null" upon syserr
           stop run returning 1
       end-if
       set address of x-screen-private to screens

       call "XCreateSimpleWindow" using
           by value x-display root 10 10 200 50 1
                    black-pixel white-pixel
           returning x-window
       call "XStoreName" using
           by value x-display x-window by reference msg

       call "XSelectInput" using by value x-display x-window event-mask

       call "XMapWindow" using by value x-display x-window

       call "XGContextFromGC" using by value default-gc
           returning XGContext
       call "XQueryTextExtents" using by value x-display XGContext
           by reference msg by value msg-len
           by reference font-direction font-ascent font-descent
           x-char-struct
       compute box-width = string-width + 8
       compute box-height = font-ascent + font-descent + 8

       perform forever
          call "XNextEvent" using by value x-display by reference event
          if e-type equal Expose then
              call "XDrawRectangle" using
                  by value x-display x-window default-gc 5 5
                           box-width box-height
              call "XDrawString" using
                  by value x-display x-window default-gc 10 20
                  by reference msg by value msg-len
          end-if
          if e-type equal KeyPress then exit perform end-if
       end-perform

       call "XCloseDisplay" using by value x-display

       goback.
       end program x11-hello.