Anonymous user
Window creation/X11: Difference between revisions
Added COBOL
(Adding example for Mathematica) |
(Added COBOL) |
||
Line 153:
return 0;
}</lang>
=={{header|COBOL}}==
Tested with GnuCOBOL, and only on 64bit architecture, GNU/Linux. Nods to the C XLib version.
<lang 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.
*> GnuCOBOL does not evaluate C macros, need to peek at opaque
*> data from Xlib.h
*> some padding is added, due to this comment in the header
*> "there is more to this structure, but it is private to Xlib"
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.
*> ExposureMask or-ed with KeyPressMask, from X.h
01 event-mask usage binary-c-long value 32769.
*> make the box around the message wide enough for the font
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.</lang>
=={{header|Common Lisp}}==
| |||