[fpc-pascal]Trivial Graphics on Linux?

Anton Tichawa anton.tichawa at chello.at
Tue Oct 21 22:04:48 CEST 2003


On Tuesday 21 October 2003 11:57, you wrote:
> Hello!
>
> I am interested in a demo which does really trivial graphics on LINUX,
> compiles fine with FPC 1.0.4, and does basically that what a normal
> TurboPascal for DOS can do with its graph unit.
>
> Because Linux uses X11, it would be perfect when everything would work in
> X11, with a subset of X11 (open application in a window, allocate the whole
> window as one graphics area, and then set/reset pixels as the DOS
> counterpart does.
>
> Does somebody have code for that? It is definitely not my target to start
> with a complete GTK environment. This is bady supported in procedural
> programming mode and causes an extreme overhead. Having a simple
> pixel-array which can be accessed by using the ordinary fpc graph unit
> would be perfect.
>
>
> mfg
>
>   Ing. Rainer Hantsch

hello!

I already posted this some time ago ..

<snip>

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.

</snip>

hth

Anton Tichawa.

----------

Ing. Anton Tichawa
Volkertstrasse 19 / 20
A-1020 Wien
phone: +43 1 218 97 59
email: anton.tichawa at chello.at

----------

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

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

----------




More information about the fpc-pascal mailing list