you wrote 21 lines
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:
----------
"Adas Methode war, wie sich zeigen wird, Tagträume in offenbar korrekte Berechnungen einzuweben."
Doris Langley Moore: Ada, Countess of Lovelace (London 1977).
----------
