[fpc-pascal]X11 Units

[Anton Tichawa]

Hello, Tim!

On Sunday 27 April 2003 14:34, you wrote:
> > > Can anyone point me in the direction of some documentation for the X11
> > > interface units?  I can't seem to find any documentation anywhere.
> >
> > The documentation is in the XFree86 package. Its a straight forward C
> > API. Further, converting all of them to pascal would be a huge
> > duplication of effort.
>
> Can you tell me then where I might get some examples of how to use the
> units in FPC?  I'm not a C programmer and therefore trying to understand
> what's going on in a C program is not so easy for me.
>
> Tim
>

Here is a program I downsized from a unit that interfaces to X. The program 
compiles on my system (debian linux) and runs. It draws 2 strings and a 
circle and waits for 3 keys, then exits. As you will see, the most simple X 
program already requires many lines of code and a certain understanding of 
the X concepts. You may use the program, if it compiles and runs, as a 
working base for further experience with X. I like X, because it gives me 
fast and reliable access to the video system. The program is free software, 
i. e. I don't want money for it, but I'm no advocate. Should it be called GNU?
Anyway, use it as you like. Mail me if there are problems when compiling or 
running it.

---

program xdemo;  // free pascal x / x11 demo, free software, by anton tichawa

uses
  x, xlib, linux;

var
  TheDisplay: PDisplay;
  TheScreen: Longint;
  TheDrawable: TDrawable;
  TheGC: PXGC;
  BlackColor: longint;
  WhiteColor: longint;
  GCValues: TXGCValues;
  bold_font: PXFontStruct;
  normal_font: PXFontStruct;

procedure DrawString(X, Y: Integer; const S: String);
begin
  XDrawImageString(TheDisplay, TheDrawable, TheGC, X, Y, @S[1], Length(S));
end;

procedure DrawCircle(X, Y, R: Integer);
begin
  XDrawArc(TheDisplay, TheDrawable, TheGC, X - R, Y - R, 2 * R, 2 * R, 0, 64 
* 360);
end;

procedure SetFont(A_Font: PXFontStruct);
begin
  if A_Font <> nil then begin
    XSetFont(TheDisplay, TheGC, A_Font^.FID);
  end;
end;

procedure InitStd;
var
  event: TXEvent;
begin
  TheDisplay := XOpenDisplay(nil);
  if TheDisplay = nil then begin
    Halt;
  end;
  TheScreen := XDefaultScreen(TheDisplay);
  BlackColor := XBlackPixel(TheDisplay, TheScreen);
  WhiteColor := XWhitePixel(TheDisplay, TheScreen);
  TheDrawable := XCreateSimpleWindow(TheDisplay, 
XDefaultRootWindow(TheDisplay),
    0, 0, 1024, 840, 0, BlackColor, BlackColor);
  XSelectInput(TheDisplay, TheDrawable, StructureNotifyMask + KeyPressMask + 
KeyReleaseMask);
  XMapWindow(TheDisplay, TheDrawable);
  GCValues.fill_style := FillOpaqueStippled;
  TheGC := XCreateGC(TheDisplay, TheDrawable, GCFillStyle, @GCValues);
  Normal_Font := XLoadQueryFont(TheDisplay, 
PChar('-*-courier-medium-r-normal--14-*-*-*-m-*-iso8859-1'));
  Bold_Font := XLoadQueryFont(TheDisplay, 
PChar('-*-courier-bold-r-normal--14-*-*-*-m-*-iso8859-1'));
  SetFont(Normal_Font);
  repeat
    XNextEvent(TheDisplay, @event);
    if event._type = MapNotify then Break;
  until false;
end;

procedure DoneStd;
begin
  XCloseDisplay(TheDisplay);
end;

procedure Sound(AFrequency, ADuration: Integer);
var
  Parameters: TXKeyboardControl;
begin
  Parameters.Bell_Pitch := AFrequency;
  Parameters.Bell_Duration := ADuration;
  XChangeKeyboardControl(TheDisplay, KBBellPitch + KBBellDuration, 
@Parameters);
  XBell(TheDisplay, 100);
end;

var
  myevent: txevent;
  newevent: boolean;
  keys: integer;

begin
  InitStd;
  Sound(2000, 50);
  XSetBackground(TheDisplay, TheGC, BlackColor);
  XSetForeground(TheDisplay, TheGC, WhiteColor);
  DrawCircle(200, 200, 50);
  SetFont(bold_font);
  DrawString(10, 10, 'xdemo: free pascal x / x11 demo, free software, by 
anton tichawa');
  SetFont(normal_font);
  DrawString(10, 40, 'press 3 keys to exit');
  keys := 0;
  repeat
    newevent := xpending(thedisplay) > 0;
    if newevent then begin
      xnextevent(thedisplay, @myevent);
      if myevent._type = keypress then begin
        writeln('key press: ', myevent.xkey.keycode);
        inc(keys);
        if keys >= 3 then break;
      end else if myevent._type = keyrelease then begin
        writeln('key release: ', myevent.xkey.keycode);
      end;
    end;
  until false;
  DoneStd;
end.

---

hth,

anton tichawa.

----------

"Adas Methode war, wie sich zeigen wird, Tagträume in offenbar korrekte 
Berechnungen einzuweben."

Doris Langley Moore: Ada, Countess of Lovelace (London 1977).

----------

Ing. Anton Tichawa
Volkertstrasse 19 / 20
A-1020 Wien
phone: +43 1 218 97 59
mobil: +43 664 52 07 907; currently n/a
email: anton.tichawa at chello.at

----------