~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/aggpas/src/platform/linux/agg_platform_support.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
//----------------------------------------------------------------------------
2
 
// Anti-Grain Geometry - Version 2.4 (Public License)
3
 
// Copyright (C) 2002-2005 Maxim Shemanarev (http://www.antigrain.com)
4
 
//
5
 
// Anti-Grain Geometry - Version 2.4 Release Milano 3 (AggPas 2.4 RM3)
6
 
// Pascal Port By: Milan Marusinec alias Milano
7
 
//                 milan@marusinec.sk
8
 
//                 http://www.aggpas.org
9
 
// Copyright (c) 2005-2006
10
 
//
11
 
// Permission to copy, use, modify, sell and distribute this software
12
 
// is granted provided this copyright notice appears in all copies.
13
 
// This software is provided "as is" without express or implied
14
 
// warranty, and with no claim as to its suitability for any purpose.
15
 
//
16
 
//----------------------------------------------------------------------------
17
 
// Contact: mcseem@antigrain.com
18
 
//          mcseemagg@yahoo.com
19
 
//          http://www.antigrain.com
20
 
//
21
 
//----------------------------------------------------------------------------
22
 
//
23
 
// class platform_support
24
 
//
25
 
// It's not a part of the AGG library, it's just a helper class to create
26
 
// interactive demo examples. Since the examples should not be too complex
27
 
// this class is provided to support some very basic interactive graphical
28
 
// funtionality, such as putting the rendered image to the window, simple
29
 
// keyboard and mouse input, window resizing, setting the window title,
30
 
// and catching the "idle" events.
31
 
//
32
 
// The most popular platforms are:
33
 
//
34
 
// Windows-32 API
35
 
// X-Window API
36
 
// SDL library (see http://www.libsdl.org/)
37
 
// MacOS C/C++ API
38
 
//
39
 
// All the system dependent stuff sits in the platform_specific class.
40
 
// The platform_support class has just a pointer to it and it's
41
 
// the responsibility of the implementation to create/delete it.
42
 
// This class being defined in the implementation file can have
43
 
// any platform dependent stuff such as HWND, X11 Window and so on.
44
 
//
45
 
// [Pascal Port History] -----------------------------------------------------
46
 
//
47
 
// 23.06.2006-Milano: ptrcomp adjustments
48
 
// 29.03.2006-Milano: finished & tested OK
49
 
// 28.03.2006-Milano: platform_specific & platform_support
50
 
// 20.03.2006-Milano: Unit port establishment
51
 
//
52
 
{ agg_platform_support.pas }
53
 
unit
54
 
 agg_platform_support ;
55
 
 
56
 
INTERFACE
57
 
 
58
 
{$I agg_mode.inc }
59
 
{$I- }
60
 
uses
61
 
 X ,Xlib ,Xutil ,Xatom ,keysym ,CTypes ,SysUtils ,
62
 
 agg_linux_mini_libc ,
63
 
 agg_basics ,
64
 
 agg_ctrl ,
65
 
 agg_rendering_buffer ,
66
 
 agg_trans_affine ,
67
 
 agg_trans_viewport ,
68
 
 agg_color_conv ,
69
 
 file_utils_ ;
70
 
 
71
 
const
72
 
  {$IFDEF Ver2_2}
73
 
  xFalse = False;
74
 
  xTrue = True;
75
 
  {$ELSE}
76
 
  xFalse = 0;
77
 
  xTrue = 1;
78
 
  {$ENDIF}
79
 
 
80
 
{ TYPES DEFINITION }
81
 
const
82
 
//----------------------------------------------------------window_flag_e
83
 
// These are flags used in method init(). Not all of them are
84
 
// applicable on different platforms, for example the win32_api
85
 
// cannot use a hardware buffer (window_hw_buffer).
86
 
// The implementation should simply ignore unsupported flags.
87
 
 window_resize            = 1;
88
 
 window_hw_buffer         = 2;
89
 
 window_keep_aspect_ratio = 4;
90
 
 window_process_all_keys  = 8;
91
 
 
92
 
type
93
 
//-----------------------------------------------------------pix_format_e
94
 
// Possible formats of the rendering buffer. Initially I thought that it's
95
 
// reasonable to create the buffer and the rendering functions in
96
 
// accordance with the native pixel format of the system because it
97
 
// would have no overhead for pixel format conersion.
98
 
// But eventually I came to a conclusion that having a possibility to
99
 
// convert pixel formats on demand is a good idea. First, it was X11 where
100
 
// there lots of different formats and visuals and it would be great to
101
 
// render everything in, say, RGB-24 and display it automatically without
102
 
// any additional efforts. The second reason is to have a possibility to
103
 
// debug renderers for different pixel formats and colorspaces having only
104
 
// one computer and one system.
105
 
//
106
 
// This stuff is not included into the basic AGG functionality because the
107
 
// number of supported pixel formats (and/or colorspaces) can be great and
108
 
// if one needs to add new format it would be good only to add new
109
 
// rendering files without having to modify any existing ones (a general
110
 
// principle of incapsulation and isolation).
111
 
//
112
 
// Using a particular pixel format doesn't obligatory mean the necessity
113
 
// of software conversion. For example, win32 API can natively display
114
 
// gray8, 15-bit RGB, 24-bit BGR, and 32-bit BGRA formats.
115
 
// This list can be (and will be!) extended in future.
116
 
 pix_format_e = (
117
 
 
118
 
  pix_format_undefined ,     // By default. No conversions are applied
119
 
  pix_format_bw,             // 1 bit per color B/W
120
 
  pix_format_gray8,          // Simple 256 level grayscale
121
 
  pix_format_gray16,         // Simple 65535 level grayscale
122
 
  pix_format_rgb555,         // 15 bit rgb. Depends on the byte ordering!
123
 
  pix_format_rgb565,         // 16 bit rgb. Depends on the byte ordering!
124
 
  pix_format_rgbAAA,         // 30 bit rgb. Depends on the byte ordering!
125
 
  pix_format_rgbBBA,         // 32 bit rgb. Depends on the byte ordering!
126
 
  pix_format_bgrAAA,         // 30 bit bgr. Depends on the byte ordering!
127
 
  pix_format_bgrABB,         // 32 bit bgr. Depends on the byte ordering!
128
 
  pix_format_rgb24,          // R-G-B, one byte per color component
129
 
  pix_format_bgr24,          // B-G-R, native win32 BMP format.
130
 
  pix_format_rgba32,         // R-G-B-A, one byte per color component
131
 
  pix_format_argb32,         // A-R-G-B, native MAC format
132
 
  pix_format_abgr32,         // A-B-G-R, one byte per color component
133
 
  pix_format_bgra32,         // B-G-R-A, native win32 BMP format
134
 
  pix_format_rgb48,          // R-G-B, 16 bits per color component
135
 
  pix_format_bgr48,          // B-G-R, native win32 BMP format.
136
 
  pix_format_rgba64,         // R-G-B-A, 16 bits byte per color component
137
 
  pix_format_argb64,         // A-R-G-B, native MAC format
138
 
  pix_format_abgr64,         // A-B-G-R, one byte per color component
139
 
  pix_format_bgra64,         // B-G-R-A, native win32 BMP format
140
 
 
141
 
  end_of_pix_formats );
142
 
 
143
 
const
144
 
//-------------------------------------------------------------input_flag_e
145
 
// Mouse and keyboard flags. They can be different on different platforms
146
 
// and the ways they are obtained are also different. But in any case
147
 
// the system dependent flags should be mapped into these ones. The meaning
148
 
// of that is as follows. For example, if kbd_ctrl is set it means that the
149
 
// ctrl key is pressed and being held at the moment. They are also used in
150
 
// the overridden methods such as on_mouse_move(), on_mouse_button_down(),
151
 
// on_mouse_button_dbl_click(), on_mouse_button_up(), on_key().
152
 
// In the method on_mouse_button_up() the mouse flags have different
153
 
// meaning. They mean that the respective button is being released, but
154
 
// the meaning of the keyboard flags remains the same.
155
 
// There's absolut minimal set of flags is used because they'll be most
156
 
// probably supported on different platforms. Even the mouse_right flag
157
 
// is restricted because Mac's mice have only one button, but AFAIK
158
 
// it can be simulated with holding a special key on the keydoard.
159
 
 mouse_left  = 1;
160
 
 mouse_right = 2;
161
 
 kbd_shift   = 4;
162
 
 kbd_ctrl    = 8;
163
 
 
164
 
//--------------------------------------------------------------key_code_e
165
 
// Keyboard codes. There's also a restricted set of codes that are most
166
 
// probably supported on different platforms. Any platform dependent codes
167
 
// should be converted into these ones. There're only those codes are
168
 
// defined that cannot be represented as printable ASCII-characters.
169
 
// All printable ASCII-set can be used in a regilar C/C++ manner:
170
 
// ' ', 'A', '0' '+' and so on.
171
 
// Since the clasas is used for creating very simple demo-applications
172
 
// we don't need very rich possibilities here, just basic ones.
173
 
// Actually the numeric key codes are taken from the SDL library, so,
174
 
// the implementation of the SDL support does not require any mapping.
175
 
// ASCII set. Should be supported everywhere
176
 
 key_backspace      = 8;
177
 
 key_tab            = 9;
178
 
 key_clear          = 12;
179
 
 key_return         = 13;
180
 
 key_pause          = 19;
181
 
 key_escape         = 27;
182
 
 
183
 
// Keypad
184
 
 key_delete         = 127;
185
 
 key_kp0            = 256;
186
 
 key_kp1            = 257;
187
 
 key_kp2            = 258;
188
 
 key_kp3            = 259;
189
 
 key_kp4            = 260;
190
 
 key_kp5            = 261;
191
 
 key_kp6            = 262;
192
 
 key_kp7            = 263;
193
 
 key_kp8            = 264;
194
 
 key_kp9            = 265;
195
 
 key_kp_period      = 266;
196
 
 key_kp_divide      = 267;
197
 
 key_kp_multiply    = 268;
198
 
 key_kp_minus       = 269;
199
 
 key_kp_plus        = 270;
200
 
 key_kp_enter       = 271;
201
 
 key_kp_equals      = 272;
202
 
 
203
 
// Arrow-keys and stuff
204
 
 key_up             = 273;
205
 
 key_down           = 274;
206
 
 key_right          = 275;
207
 
 key_left           = 276;
208
 
 key_insert         = 277;
209
 
 key_home           = 278;
210
 
 key_end            = 279;
211
 
 key_page_up        = 280;
212
 
 key_page_down      = 281;
213
 
 
214
 
// Functional keys. You'd better avoid using
215
 
// f11...f15 in your applications if you want
216
 
// the applications to be portable
217
 
 key_f1             = 282;
218
 
 key_f2             = 283;
219
 
 key_f3             = 284;
220
 
 key_f4             = 285;
221
 
 key_f5             = 286;
222
 
 key_f6             = 287;
223
 
 key_f7             = 288;
224
 
 key_f8             = 289;
225
 
 key_f9             = 290;
226
 
 key_f10            = 291;
227
 
 key_f11            = 292;
228
 
 key_f12            = 293;
229
 
 key_f13            = 294;
230
 
 key_f14            = 295;
231
 
 key_f15            = 296;
232
 
 
233
 
// The possibility of using these keys is
234
 
// very restricted. Actually it's guaranteed
235
 
// only in win32_api and win32_sdl implementations
236
 
 key_numlock        = 300;
237
 
 key_capslock       = 301;
238
 
 key_scrollock      = 302;
239
 
 
240
 
 max_ctrl = 128;
241
 
 
242
 
type
243
 
//----------------------------------------------------------ctrl_container
244
 
// A helper class that contains pointers to a number of controls.
245
 
// This class is used to ease the event handling with controls.
246
 
// The implementation should simply call the appropriate methods
247
 
// of this class when appropriate events occure.
248
 
 crtl_container_ptr = ^ctrl_container;
249
 
 ctrl_container = object
250
 
   m_ctrl : array[0..max_ctrl - 1 ] of ctrl_ptr;
251
 
 
252
 
   m_num_ctrl : unsigned;
253
 
   m_cur_ctrl : int;
254
 
 
255
 
   constructor Construct;
256
 
   destructor  Destruct;
257
 
 
258
 
   procedure add(c : ctrl_ptr );
259
 
 
260
 
   function  in_rect(x ,y : double ) : boolean;
261
 
 
262
 
   function  on_mouse_button_down(x ,y : double ) : boolean;
263
 
   function  on_mouse_button_up  (x ,y : double ) : boolean;
264
 
 
265
 
   function  on_mouse_move(x ,y : double; button_flag : boolean ) : boolean;
266
 
   function  on_arrow_keys(left ,right ,down ,up : boolean ) : boolean;
267
 
 
268
 
   function  set_cur(x ,y : double ) : boolean;
269
 
 
270
 
  end;
271
 
 
272
 
//---------------------------------------------------------platform_support
273
 
// This class is a base one to the apllication classes. It can be used
274
 
// as follows:
275
 
//
276
 
//  the_application = object(platform_support )
277
 
//
278
 
//      constructor Construct(bpp : unsigned; flip_y : boolean );
279
 
//      . . .
280
 
//
281
 
//      //override stuff . . .
282
 
//      procedure on_init; virtual;
283
 
//      procedure on_draw; virtual;
284
 
//      procedure on_resize(sx ,sy : int ); virtual;
285
 
//      // . . . and so on, see virtual functions
286
 
//
287
 
//      //any your own stuff . . .
288
 
//  };
289
 
//
290
 
//  VAR
291
 
//   app : the_application;
292
 
//
293
 
//  BEGIN
294
 
//   app.Construct(pix_format_rgb24 ,true );
295
 
//   app.caption  ("AGG Example. Lion" );
296
 
//
297
 
//   if app.init(500 ,400 ,window_resize ) then
298
 
//    app.run;
299
 
//
300
 
//   app.Destruct;
301
 
//
302
 
//  END.
303
 
//
304
 
const
305
 
 max_images = 16;
306
 
 
307
 
type
308
 
 platform_specific_ptr = ^platform_specific;
309
 
 platform_specific = object
310
 
   m_format     ,
311
 
   m_sys_format : pix_format_e;
312
 
   m_byte_order : int;
313
 
 
314
 
   m_flip_y  : boolean;
315
 
   m_bpp     ,
316
 
   m_sys_bpp : unsigned;
317
 
   m_display : PDisplay;
318
 
   m_screen  ,
319
 
   m_depth   : int;
320
 
   m_visual  : PVisual;
321
 
   m_window  : TWindow;
322
 
   m_gc      : TGC;
323
 
 
324
 
   m_window_attributes : TXSetWindowAttributes;
325
 
 
326
 
   m_ximg_window : PXImage;
327
 
   m_close_atom  : TAtom;
328
 
   m_buf_window  : pointer;
329
 
   m_buf_alloc   : unsigned;
330
 
   m_buf_img     : array[0..max_images - 1 ] of pointer;
331
 
   m_img_alloc   : array[0..max_images - 1 ] of unsigned;
332
 
 
333
 
   m_keymap : array[0..255 ] of unsigned;
334
 
 
335
 
   m_update_flag ,
336
 
   m_resize_flag ,
337
 
   m_initialized : boolean;
338
 
 
339
 
   //m_wait_mode : boolean;
340
 
   m_sw_start  : clock_t;
341
 
 
342
 
   constructor Construct(format : pix_format_e; flip_y : boolean );
343
 
   destructor  Destruct;
344
 
 
345
 
   procedure caption_ (capt : PChar );
346
 
   procedure put_image(src : rendering_buffer_ptr );
347
 
 
348
 
  end;
349
 
 
350
 
 platform_support_ptr = ^platform_support;
351
 
 platform_support = object
352
 
   m_specific : platform_specific_ptr;
353
 
   m_ctrls    : ctrl_container;
354
 
 
355
 
   m_format : pix_format_e;
356
 
 
357
 
   m_bpp : unsigned;
358
 
 
359
 
   m_rbuf_window : rendering_buffer;
360
 
   m_rbuf_img    : array[0..max_images - 1 ] of rendering_buffer;
361
 
 
362
 
   m_window_flags : unsigned;
363
 
   m_wait_mode    ,
364
 
   m_flip_y       : boolean;        // flip_y - true if you want to have the Y-axis flipped vertically
365
 
   m_caption      : shortstring;
366
 
   m_resize_mtx   : trans_affine;
367
 
 
368
 
   m_initial_width  ,
369
 
   m_initial_height : int;
370
 
 
371
 
   m_quit : boolean;
372
 
 
373
 
   constructor Construct(format_ : pix_format_e; flip_y_ : boolean );
374
 
   destructor  Destruct;
375
 
 
376
 
  // Setting the windows caption (title). Should be able
377
 
  // to be called at least before calling init().
378
 
  // It's perfect if they can be called anytime.
379
 
   procedure caption_(cap : shortstring );
380
 
 
381
 
  // These 3 menthods handle working with images. The image
382
 
  // formats are the simplest ones, such as .BMP in Windows or
383
 
  // .ppm in Linux. In the applications the names of the files
384
 
  // should not have any file extensions. Method load_img() can
385
 
  // be called before init(), so, the application could be able
386
 
  // to determine the initial size of the window depending on
387
 
  // the size of the loaded image.
388
 
  // The argument "idx" is the number of the image 0...max_images-1
389
 
   function  load_img  (idx : unsigned; file_ : shortstring ) : boolean;
390
 
   function  save_img  (idx : unsigned; file_ : shortstring ) : boolean;
391
 
   function  create_img(idx : unsigned; width_ : unsigned = 0; height_ : unsigned = 0 ) : boolean;
392
 
 
393
 
  // init() and run(). See description before the class for details.
394
 
  // The necessity of calling init() after creation is that it's
395
 
  // impossible to call the overridden virtual function (on_init())
396
 
  // from the constructor. On the other hand it's very useful to have
397
 
  // some on_init() event handler when the window is created but
398
 
  // not yet displayed. The rbuf_window() method (see below) is
399
 
  // accessible from on_init().
400
 
   function  init(width_ ,height_ ,flags : unsigned ) : boolean;
401
 
   function  run : int;
402
 
   procedure quit;
403
 
 
404
 
  // The very same parameters that were used in the constructor
405
 
   function  _format : pix_format_e;
406
 
   function  _flip_y : boolean;
407
 
   function  _bpp : unsigned;
408
 
 
409
 
  // The following provides a very simple mechanism of doing someting
410
 
  // in background. It's not multitheading. When whait_mode is true
411
 
  // the class waits for the events and it does not ever call on_idle().
412
 
  // When it's false it calls on_idle() when the event queue is empty.
413
 
  // The mode can be changed anytime. This mechanism is satisfactory
414
 
  // for creation very simple animations.
415
 
   function  _wait_mode : boolean;
416
 
   procedure wait_mode_(wait_mode : boolean );
417
 
 
418
 
  // These two functions control updating of the window.
419
 
  // force_redraw() is an analog of the Win32 InvalidateRect() function.
420
 
  // Being called it sets a flag (or sends a message) which results
421
 
  // in calling on_draw() and updating the content of the window
422
 
  // when the next event cycle comes.
423
 
  // update_window() results in just putting immediately the content
424
 
  // of the currently rendered buffer to the window without calling
425
 
  // on_draw().
426
 
   procedure force_redraw;
427
 
   procedure update_window;
428
 
 
429
 
  // So, finally, how to draw anythig with AGG? Very simple.
430
 
  // rbuf_window() returns a reference to the main rendering
431
 
  // buffer which can be attached to any rendering class.
432
 
  // rbuf_img() returns a reference to the previously created
433
 
  // or loaded image buffer (see load_img()). The image buffers
434
 
  // are not displayed directly, they should be copied to or
435
 
  // combined somehow with the rbuf_window(). rbuf_window() is
436
 
  // the only buffer that can be actually displayed.
437
 
   function  rbuf_window : rendering_buffer_ptr;
438
 
   function  rbuf_img(idx : unsigned ) : rendering_buffer_ptr;
439
 
 
440
 
  // Returns file extension used in the implemenation for the particular
441
 
  // system.
442
 
   function  _img_ext : shortstring;
443
 
 
444
 
  //
445
 
   procedure copy_img_to_window(idx : unsigned );
446
 
   procedure copy_window_to_img(idx : unsigned );
447
 
   procedure copy_img_to_img   (idx_to ,idx_from : unsigned );
448
 
 
449
 
  // Event handlers. They are not pure functions, so you don't have
450
 
  // to override them all.
451
 
  // In my demo applications these functions are defined inside
452
 
  // the the_application class
453
 
   procedure on_init; virtual;
454
 
   procedure on_resize(sx ,sy : int ); virtual;
455
 
   procedure on_idle; virtual;
456
 
 
457
 
   procedure on_mouse_move(x ,y : int; flags : unsigned ); virtual;
458
 
 
459
 
   procedure on_mouse_button_down(x ,y : int; flags : unsigned ); virtual;
460
 
   procedure on_mouse_button_up  (x ,y : int; flags : unsigned ); virtual;
461
 
 
462
 
   procedure on_key(x ,y : int; key ,flags : unsigned ); virtual;
463
 
   procedure on_ctrl_change; virtual;
464
 
   procedure on_draw; virtual;
465
 
   procedure on_post_draw(raw_handler : pointer ); virtual;
466
 
 
467
 
  // Adding control elements. A control element once added will be
468
 
  // working and reacting to the mouse and keyboard events. Still, you
469
 
  // will have to render them in the on_draw() using function
470
 
  // render_ctrl() because platform_support doesn't know anything about
471
 
  // renderers you use. The controls will be also scaled automatically
472
 
  // if they provide a proper scaling mechanism (all the controls
473
 
  // included into the basic AGG package do).
474
 
  // If you don't need a particular control to be scaled automatically
475
 
  // call ctrl::no_transform() after adding.
476
 
   procedure add_ctrl(c : ctrl_ptr );
477
 
 
478
 
  // Auxiliary functions. trans_affine_resizing() modifier sets up the resizing
479
 
  // matrix on the basis of the given width and height and the initial
480
 
  // width and height of the window. The implementation should simply
481
 
  // call this function every time when it catches the resizing event
482
 
  // passing in the new values of width and height of the window.
483
 
  // Nothing prevents you from "cheating" the scaling matrix if you
484
 
  // call this function from somewhere with wrong arguments.
485
 
  // trans_affine_resizing() accessor simply returns current resizing matrix
486
 
  // which can be used to apply additional scaling of any of your
487
 
  // stuff when the window is being resized.
488
 
  // width(), height(), initial_width(), and initial_height() must be
489
 
  // clear to understand with no comments :-)
490
 
   procedure trans_affine_resizing_(width_ ,height_ : int );
491
 
   function  _trans_affine_resizing : trans_affine_ptr;
492
 
 
493
 
   function  _width : double;
494
 
   function  _height : double;
495
 
   function  _initial_width : double;
496
 
   function  _initial_height : double;
497
 
   function  _window_flags : unsigned;
498
 
 
499
 
  // Get raw display handler depending on the system.
500
 
  // For win32 its an HDC, for other systems it can be a pointer to some
501
 
  // structure. See the implementation files for detals.
502
 
  // It's provided "as is", so, first you should check if it's not null.
503
 
  // If it's null the raw_display_handler is not supported. Also, there's
504
 
  // no guarantee that this function is implemented, so, in some
505
 
  // implementations you may have simply an unresolved symbol when linking.
506
 
   function  _raw_display_handler : pointer;
507
 
 
508
 
  // display message box or print the message to the console
509
 
  // (depending on implementation)
510
 
   procedure message_(msg : PChar );
511
 
 
512
 
  // Stopwatch functions. Function elapsed_time() returns time elapsed
513
 
  // since the latest start_timer() invocation in millisecods.
514
 
  // The resolutoin depends on the implementation.
515
 
  // In Win32 it uses QueryPerformanceFrequency() / QueryPerformanceCounter().
516
 
   procedure start_timer;
517
 
   function  elapsed_time : double;
518
 
 
519
 
  // Get the full file name. In most cases it simply returns
520
 
  // file_name. As it's appropriate in many systems if you open
521
 
  // a file by its name without specifying the path, it tries to
522
 
  // open it in the current directory. The demos usually expect
523
 
  // all the supplementary files to be placed in the current
524
 
  // directory, that is usually coincides with the directory where
525
 
  // the the executable is. However, in some systems (BeOS) it's not so.
526
 
  // For those kinds of systems full_file_name() can help access files
527
 
  // preserving commonly used policy.
528
 
  // So, it's a good idea to use in the demos the following:
529
 
  // FILE* fd = fopen(full_file_name("some.file"), "r");
530
 
  // instead of
531
 
  // FILE* fd = fopen("some.file", "r");
532
 
   function  full_file_name(file_name : shortstring ) : shortstring;
533
 
   function  file_source   (path ,fname : shortstring ) : shortstring;
534
 
 
535
 
  end;
536
 
 
537
 
{ GLOBAL PROCEDURES }
538
 
 
539
 
 
540
 
IMPLEMENTATION
541
 
{ LOCAL VARIABLES & CONSTANTS }
542
 
{ UNIT IMPLEMENTATION }
543
 
{ CONSTRUCT }
544
 
constructor ctrl_container.Construct;
545
 
begin
546
 
 m_num_ctrl:=0;
547
 
 m_cur_ctrl:=-1;
548
 
 
549
 
end;
550
 
 
551
 
{ DESTRUCT }
552
 
destructor ctrl_container.Destruct;
553
 
begin
554
 
end;
555
 
 
556
 
{ ADD }
557
 
procedure ctrl_container.add;
558
 
begin
559
 
 if m_num_ctrl < max_ctrl then
560
 
  begin
561
 
   m_ctrl[m_num_ctrl ]:=c;
562
 
 
563
 
   inc(m_num_ctrl );
564
 
 
565
 
  end;
566
 
 
567
 
end;
568
 
 
569
 
{ IN_RECT }
570
 
function ctrl_container.in_rect;
571
 
var
572
 
 i : unsigned;
573
 
 
574
 
begin
575
 
 result:=false;
576
 
 
577
 
 if m_num_ctrl > 0 then
578
 
  for i:=0 to m_num_ctrl - 1 do
579
 
   if m_ctrl[i ].in_rect(x ,y ) then
580
 
    begin
581
 
     result:=true;
582
 
 
583
 
     exit;
584
 
 
585
 
    end;
586
 
 
587
 
end;
588
 
 
589
 
{ ON_MOUSE_BUTTON_DOWN }
590
 
function ctrl_container.on_mouse_button_down;
591
 
var
592
 
 i : unsigned;
593
 
 
594
 
begin
595
 
 result:=false;
596
 
 
597
 
 if m_num_ctrl > 0 then
598
 
  for i:=0 to m_num_ctrl - 1 do
599
 
   if m_ctrl[i ].on_mouse_button_down(x ,y ) then
600
 
    begin
601
 
     result:=true;
602
 
 
603
 
     exit;
604
 
 
605
 
    end;
606
 
 
607
 
end;
608
 
 
609
 
{ ON_MOUSE_BUTTON_UP }
610
 
function ctrl_container.on_mouse_button_up;
611
 
var
612
 
 i : unsigned;
613
 
 
614
 
begin
615
 
 result:=false;
616
 
 
617
 
 if m_num_ctrl > 0 then
618
 
  for i:=0 to m_num_ctrl - 1 do
619
 
   if m_ctrl[i ].on_mouse_button_up(x ,y ) then
620
 
    begin
621
 
     result:=true;
622
 
 
623
 
     exit;
624
 
 
625
 
    end;
626
 
 
627
 
end;
628
 
 
629
 
{ ON_MOUSE_MOVE }
630
 
function ctrl_container.on_mouse_move;
631
 
var
632
 
 i : unsigned;
633
 
 
634
 
begin
635
 
 result:=false;
636
 
 
637
 
 if m_num_ctrl > 0 then
638
 
  for i:=0 to m_num_ctrl - 1 do
639
 
   if m_ctrl[i ].on_mouse_move(x ,y ,button_flag ) then
640
 
    begin
641
 
     result:=true;
642
 
 
643
 
     exit;
644
 
 
645
 
    end;
646
 
 
647
 
end;
648
 
 
649
 
{ ON_ARROW_KEYS }
650
 
function ctrl_container.on_arrow_keys;
651
 
begin
652
 
 result:=false;
653
 
 
654
 
 if m_cur_ctrl >= 0 then
655
 
  result:=m_ctrl[m_cur_ctrl ].on_arrow_keys(left ,right ,down ,up );
656
 
 
657
 
end;
658
 
 
659
 
{ SET_CUR }
660
 
function ctrl_container.set_cur;
661
 
var
662
 
 i : unsigned;
663
 
 
664
 
begin
665
 
 result:=false;
666
 
 
667
 
 if m_num_ctrl > 0 then
668
 
  for i:=0 to m_num_ctrl - 1 do
669
 
   if m_ctrl[i ].in_rect(x ,y ) then
670
 
    begin
671
 
     if m_cur_ctrl <> i then
672
 
      begin
673
 
       m_cur_ctrl:=i;
674
 
 
675
 
       result:=true;
676
 
 
677
 
      end;
678
 
 
679
 
     exit;
680
 
 
681
 
    end;
682
 
 
683
 
 if m_cur_ctrl <> -1 then
684
 
  begin
685
 
   m_cur_ctrl:=-1;
686
 
 
687
 
   result:=true;
688
 
 
689
 
  end;
690
 
 
691
 
end;
692
 
 
693
 
{ CONSTRUCT }
694
 
constructor platform_specific.Construct;
695
 
var
696
 
 i : unsigned;
697
 
 
698
 
begin
699
 
 m_format    :=format;
700
 
 m_sys_format:=pix_format_undefined;
701
 
 m_byte_order:=LSBFirst;
702
 
 m_flip_y    :=flip_y;
703
 
 
704
 
 m_bpp    :=0;
705
 
 m_sys_bpp:=0;
706
 
 m_display:=NIL;
707
 
 m_screen :=0;
708
 
 m_depth  :=0;
709
 
 m_visual :=NIL;
710
 
 m_window :=0;
711
 
 m_gc     :=NIL;
712
 
 
713
 
 m_ximg_window:=NIL;
714
 
 m_close_atom :=0;
715
 
 m_buf_window :=NIL;
716
 
 m_buf_alloc  :=0;
717
 
 
718
 
 m_update_flag:=true;
719
 
 m_resize_flag:=true;
720
 
 m_initialized:=false;
721
 
 //m_wait_mode:=true;
722
 
 
723
 
 fillchar(m_buf_img[0 ] ,sizeof(m_buf_img ) ,0 );
724
 
 
725
 
 for i:=0 to 255 do
726
 
  m_keymap[i ]:=i;
727
 
 
728
 
 m_keymap[XK_Pause and $FF ]:=key_pause;
729
 
 m_keymap[XK_Clear and $FF ]:=key_clear;
730
 
 
731
 
 m_keymap[XK_KP_0 and $FF ]:=key_kp0;
732
 
 m_keymap[XK_KP_1 and $FF ]:=key_kp1;
733
 
 m_keymap[XK_KP_2 and $FF ]:=key_kp2;
734
 
 m_keymap[XK_KP_3 and $FF ]:=key_kp3;
735
 
 m_keymap[XK_KP_4 and $FF ]:=key_kp4;
736
 
 m_keymap[XK_KP_5 and $FF ]:=key_kp5;
737
 
 m_keymap[XK_KP_6 and $FF ]:=key_kp6;
738
 
 m_keymap[XK_KP_7 and $FF ]:=key_kp7;
739
 
 m_keymap[XK_KP_8 and $FF ]:=key_kp8;
740
 
 m_keymap[XK_KP_9 and $FF ]:=key_kp9;
741
 
 
742
 
 m_keymap[XK_KP_Insert and $FF ]   :=key_kp0;
743
 
 m_keymap[XK_KP_End and $FF ]      :=key_kp1;
744
 
 m_keymap[XK_KP_Down and $FF ]     :=key_kp2;
745
 
 m_keymap[XK_KP_Page_Down and $FF ]:=key_kp3;
746
 
 m_keymap[XK_KP_Left and $FF ]     :=key_kp4;
747
 
 m_keymap[XK_KP_Begin and $FF ]    :=key_kp5;
748
 
 m_keymap[XK_KP_Right and $FF ]    :=key_kp6;
749
 
 m_keymap[XK_KP_Home and $FF ]     :=key_kp7;
750
 
 m_keymap[XK_KP_Up and $FF ]       :=key_kp8;
751
 
 m_keymap[XK_KP_Page_Up and $FF ]  :=key_kp9;
752
 
 m_keymap[XK_KP_Delete and $FF ]   :=key_kp_period;
753
 
 m_keymap[XK_KP_Decimal and $FF ]  :=key_kp_period;
754
 
 m_keymap[XK_KP_Divide and $FF ]   :=key_kp_divide;
755
 
 m_keymap[XK_KP_Multiply and $FF ] :=key_kp_multiply;
756
 
 m_keymap[XK_KP_Subtract and $FF ] :=key_kp_minus;
757
 
 m_keymap[XK_KP_Add and $FF ]      :=key_kp_plus;
758
 
 m_keymap[XK_KP_Enter and $FF ]    :=key_kp_enter;
759
 
 m_keymap[XK_KP_Equal and $FF ]    :=key_kp_equals;
760
 
 
761
 
 m_keymap[XK_Up and $FF ]       :=key_up;
762
 
 m_keymap[XK_Down and $FF ]     :=key_down;
763
 
 m_keymap[XK_Right and $FF ]    :=key_right;
764
 
 m_keymap[XK_Left and $FF ]     :=key_left;
765
 
 m_keymap[XK_Insert and $FF ]   :=key_insert;
766
 
 m_keymap[XK_Home and $FF ]     :=key_delete;
767
 
 m_keymap[XK_End and $FF ]      :=key_end;
768
 
 m_keymap[XK_Page_Up and $FF ]  :=key_page_up;
769
 
 m_keymap[XK_Page_Down and $FF ]:=key_page_down;
770
 
 
771
 
 m_keymap[XK_F1 and $FF ] :=key_f1;
772
 
 m_keymap[XK_F2 and $FF ] :=key_f2;
773
 
 m_keymap[XK_F3 and $FF ] :=key_f3;
774
 
 m_keymap[XK_F4 and $FF ] :=key_f4;
775
 
 m_keymap[XK_F5 and $FF ] :=key_f5;
776
 
 m_keymap[XK_F6 and $FF ] :=key_f6;
777
 
 m_keymap[XK_F7 and $FF ] :=key_f7;
778
 
 m_keymap[XK_F8 and $FF ] :=key_f8;
779
 
 m_keymap[XK_F9 and $FF ] :=key_f9;
780
 
 m_keymap[XK_F10 and $FF ]:=key_f10;
781
 
 m_keymap[XK_F11 and $FF ]:=key_f11;
782
 
 m_keymap[XK_F12 and $FF ]:=key_f12;
783
 
 m_keymap[XK_F13 and $FF ]:=key_f13;
784
 
 m_keymap[XK_F14 and $FF ]:=key_f14;
785
 
 m_keymap[XK_F15 and $FF ]:=key_f15;
786
 
 
787
 
 m_keymap[XK_Num_Lock and $FF ]   :=key_numlock;
788
 
 m_keymap[XK_Caps_Lock and $FF ]  :=key_capslock;
789
 
 m_keymap[XK_Scroll_Lock and $FF ]:=key_scrollock;
790
 
 
791
 
 case m_format of
792
 
  pix_format_gray8 :
793
 
   m_bpp:=8;
794
 
 
795
 
  pix_format_rgb565 ,
796
 
  pix_format_rgb555 :
797
 
   m_bpp:=16;
798
 
 
799
 
  pix_format_rgb24 ,
800
 
  pix_format_bgr24 :
801
 
   m_bpp:=24;
802
 
 
803
 
  pix_format_bgra32 ,
804
 
  pix_format_abgr32 ,
805
 
  pix_format_argb32 ,
806
 
  pix_format_rgba32 :
807
 
   m_bpp:=32;
808
 
 
809
 
 end;
810
 
 
811
 
 m_sw_start:=clock;
812
 
 
813
 
end;
814
 
 
815
 
{ DESTRUCT }
816
 
destructor platform_specific.Destruct;
817
 
begin
818
 
end;
819
 
 
820
 
{ CAPTION_ }
821
 
procedure platform_specific.caption_;
822
 
var
823
 
 tp : TXTextProperty;
824
 
 
825
 
begin
826
 
 tp.value   :=PCUChar(@capt[1 ] );
827
 
 tp.encoding:=XA_WM_NAME;
828
 
 tp.format  :=8;
829
 
 tp.nitems  :=strlen(capt );
830
 
 
831
 
 XSetWMName    (m_display ,m_window ,@tp );
832
 
 XStoreName    (m_display ,m_window ,capt );
833
 
 XSetIconName  (m_display ,m_window ,capt );
834
 
 XSetWMIconName(m_display ,m_window ,@tp );
835
 
 
836
 
end;
837
 
 
838
 
{ PUT_IMAGE }
839
 
procedure platform_specific.put_image;
840
 
var
841
 
 row_len : int;
842
 
 buf_tmp : pointer;
843
 
 
844
 
 rbuf_tmp : rendering_buffer;
845
 
 
846
 
begin
847
 
 if m_ximg_window = NIL then
848
 
  exit;
849
 
 
850
 
 m_ximg_window.data:=m_buf_window;
851
 
 
852
 
 if m_format = m_sys_format then
853
 
  XPutImage(
854
 
   m_display ,
855
 
   m_window ,
856
 
   m_gc ,
857
 
   m_ximg_window ,
858
 
   0 ,0 ,0 ,0 ,
859
 
   src._width ,
860
 
   src._height )
861
 
 
862
 
 else
863
 
  begin
864
 
   row_len:=src._width * m_sys_bpp div 8;
865
 
 
866
 
   agg_getmem(buf_tmp ,row_len * src._height );
867
 
 
868
 
   rbuf_tmp.Construct;
869
 
 
870
 
   if m_flip_y then
871
 
    rbuf_tmp.attach(
872
 
     buf_tmp ,
873
 
     src._width,
874
 
     src._height ,
875
 
     -row_len )
876
 
   else
877
 
    rbuf_tmp.attach(
878
 
     buf_tmp ,
879
 
     src._width,
880
 
     src._height ,
881
 
     row_len );
882
 
 
883
 
   case m_sys_format of
884
 
    pix_format_rgb555 :
885
 
     case m_format of
886
 
      pix_format_rgb555 : color_conv(@rbuf_tmp ,src ,color_conv_rgb555_to_rgb555 );
887
 
      pix_format_rgb565 : color_conv(@rbuf_tmp ,src ,color_conv_rgb565_to_rgb555 );
888
 
      //pix_format_rgb24  : color_conv(@rbuf_tmp ,src ,color_conv_rgb24_to_rgb555 );
889
 
      pix_format_bgr24  : color_conv(@rbuf_tmp ,src ,color_conv_bgr24_to_rgb555 );
890
 
      //pix_format_rgba32 : color_conv(@rbuf_tmp ,src ,color_conv_rgba32_to_rgb555 );
891
 
      //pix_format_argb32 : color_conv(@rbuf_tmp ,src ,color_conv_argb32_to_rgb555 );
892
 
      pix_format_bgra32 : color_conv(@rbuf_tmp ,src ,color_conv_bgra32_to_rgb555 );
893
 
      //pix_format_abgr32 : color_conv(@rbuf_tmp ,src ,color_conv_abgr32_to_rgb555 );
894
 
 
895
 
     end;
896
 
 
897
 
    pix_format_rgb565 :
898
 
     case m_format of
899
 
      pix_format_rgb555 : color_conv(@rbuf_tmp ,src ,color_conv_rgb555_to_rgb565 );
900
 
      //pix_format_rgb565 : color_conv(@rbuf_tmp ,src ,color_conv_rgb565_to_rgb565 );
901
 
      //pix_format_rgb24  : color_conv(@rbuf_tmp ,src ,color_conv_rgb24_to_rgb565 );
902
 
      pix_format_bgr24  : color_conv(@rbuf_tmp ,src ,color_conv_bgr24_to_rgb565 );
903
 
      //pix_format_rgba32 : color_conv(@rbuf_tmp ,src ,color_conv_rgba32_to_rgb565 );
904
 
      //pix_format_argb32 : color_conv(@rbuf_tmp ,src ,color_conv_argb32_to_rgb565 );
905
 
      pix_format_bgra32 : color_conv(@rbuf_tmp ,src ,color_conv_bgra32_to_rgb565 );
906
 
      //pix_format_abgr32 : color_conv(@rbuf_tmp ,src ,color_conv_abgr32_to_rgb565 );
907
 
 
908
 
     end;
909
 
 
910
 
    pix_format_rgba32 :
911
 
     case m_format of
912
 
      pix_format_rgb555 : color_conv(@rbuf_tmp ,src ,color_conv_rgb555_to_rgba32 );
913
 
      //pix_format_rgb565 : color_conv(@rbuf_tmp ,src ,color_conv_rgb565_to_rgba32 );
914
 
      //pix_format_rgb24  : color_conv(@rbuf_tmp ,src ,color_conv_rgb24_to_rgba32 );
915
 
      pix_format_bgr24  : color_conv(@rbuf_tmp ,src ,color_conv_bgr24_to_rgba32 );
916
 
      //pix_format_rgba32 : color_conv(@rbuf_tmp ,src ,color_conv_rgba32_to_rgba32 );
917
 
      //pix_format_argb32 : color_conv(@rbuf_tmp ,src ,color_conv_argb32_to_rgba32 );
918
 
      pix_format_bgra32 : color_conv(@rbuf_tmp ,src ,color_conv_bgra32_to_rgba32 );
919
 
      //pix_format_abgr32 : color_conv(@rbuf_tmp ,src ,color_conv_abgr32_to_rgba32 );
920
 
 
921
 
     end;
922
 
 
923
 
    pix_format_abgr32 :
924
 
     case m_format of
925
 
      pix_format_rgb555 : color_conv(@rbuf_tmp ,src ,color_conv_rgb555_to_abgr32 );
926
 
      //pix_format_rgb565 : color_conv(@rbuf_tmp ,src ,color_conv_rgb565_to_abgr32 );
927
 
      //pix_format_rgb24  : color_conv(@rbuf_tmp ,src ,color_conv_rgb24_to_abgr32 );
928
 
      pix_format_bgr24  : color_conv(@rbuf_tmp ,src ,color_conv_bgr24_to_abgr32 );
929
 
      //pix_format_abgr32 : color_conv(@rbuf_tmp ,src ,color_conv_abgr32_to_abgr32 );
930
 
      //pix_format_rgba32 : color_conv(@rbuf_tmp ,src ,color_conv_rgba32_to_abgr32 );
931
 
      //pix_format_argb32 : color_conv(@rbuf_tmp ,src ,color_conv_argb32_to_abgr32 );
932
 
      pix_format_bgra32 : color_conv(@rbuf_tmp ,src ,color_conv_bgra32_to_abgr32 );
933
 
 
934
 
     end;
935
 
 
936
 
    pix_format_argb32 :
937
 
     case m_format of
938
 
      pix_format_rgb555 : color_conv(@rbuf_tmp ,src ,color_conv_rgb555_to_argb32 );
939
 
      //pix_format_rgb565 : color_conv(@rbuf_tmp ,src ,color_conv_rgb565_to_argb32 );
940
 
      //pix_format_rgb24  : color_conv(@rbuf_tmp ,src ,color_conv_rgb24_to_argb32 );
941
 
      pix_format_bgr24  : color_conv(@rbuf_tmp ,src ,color_conv_bgr24_to_argb32 );
942
 
      pix_format_rgba32 : color_conv(@rbuf_tmp ,src ,color_conv_rgba32_to_argb32 );
943
 
      //pix_format_argb32 : color_conv(@rbuf_tmp ,src ,color_conv_argb32_to_argb32 );
944
 
      pix_format_abgr32 : color_conv(@rbuf_tmp ,src ,color_conv_abgr32_to_argb32 );
945
 
      pix_format_bgra32 : color_conv(@rbuf_tmp ,src ,color_conv_bgra32_to_argb32 );
946
 
 
947
 
     end;
948
 
 
949
 
    pix_format_bgra32 :
950
 
     case m_format of
951
 
      pix_format_rgb555 : color_conv(@rbuf_tmp ,src ,color_conv_rgb555_to_bgra32 );
952
 
      //pix_format_rgb565 : color_conv(@rbuf_tmp ,src ,color_conv_rgb565_to_bgra32 );
953
 
      //pix_format_rgb24  : color_conv(@rbuf_tmp ,src ,color_conv_rgb24_to_bgra32 );
954
 
      pix_format_bgr24  : color_conv(@rbuf_tmp ,src ,color_conv_bgr24_to_bgra32 );
955
 
      pix_format_rgba32 : color_conv(@rbuf_tmp ,src ,color_conv_rgba32_to_bgra32 );
956
 
      pix_format_argb32 : color_conv(@rbuf_tmp ,src ,color_conv_argb32_to_bgra32 );
957
 
      pix_format_abgr32 : color_conv(@rbuf_tmp ,src ,color_conv_abgr32_to_bgra32 );
958
 
      pix_format_bgra32 : color_conv(@rbuf_tmp ,src ,color_conv_bgra32_to_bgra32 );
959
 
 
960
 
     end;
961
 
 
962
 
   end;
963
 
 
964
 
   m_ximg_window.data:=buf_tmp;
965
 
 
966
 
   XPutImage(
967
 
    m_display ,
968
 
    m_window ,
969
 
    m_gc ,
970
 
    m_ximg_window ,
971
 
    0 ,0 ,0 ,0 ,
972
 
    src._width ,
973
 
    src._height );
974
 
 
975
 
   agg_freemem(buf_tmp ,row_len * src._height );
976
 
 
977
 
   rbuf_tmp.Destruct;
978
 
 
979
 
  end;
980
 
 
981
 
end;
982
 
 
983
 
{ CONSTRUCT }
984
 
constructor platform_support.Construct;
985
 
var
986
 
 i : unsigned;
987
 
 
988
 
 p ,n ,x : shortstring;
989
 
 
990
 
begin
991
 
 new(m_specific ,Construct(format_ ,flip_y_ ) );
992
 
 
993
 
 m_ctrls.Construct;
994
 
 m_rbuf_window.Construct;
995
 
 
996
 
 for i:=0 to max_images - 1 do
997
 
  m_rbuf_img[i ].Construct;
998
 
 
999
 
 m_resize_mtx.Construct;
1000
 
 
1001
 
 m_format:=format_;
1002
 
 
1003
 
 m_bpp:=m_specific.m_bpp;
1004
 
 
1005
 
 m_window_flags:=0;
1006
 
 m_wait_mode   :=true;
1007
 
 m_flip_y      :=flip_y_;
1008
 
 
1009
 
 m_initial_width :=10;
1010
 
 m_initial_height:=10;
1011
 
 
1012
 
 m_caption:='Anti-Grain Geometry Application'#0;
1013
 
 
1014
 
// Change working dir to the application one
1015
 
 spread_name(ParamStr(0 ) ,p ,n ,x );
1016
 
 
1017
 
 p:=p + #0;
1018
 
 
1019
 
 SetCurrentDir(p);
1020
 
 // libc.__chdir(PChar(@p[1 ] ) );
1021
 
 
1022
 
end;
1023
 
 
1024
 
{ DESTRUCT }
1025
 
destructor platform_support.Destruct;
1026
 
var
1027
 
 i : unsigned;
1028
 
 
1029
 
begin
1030
 
 dispose(m_specific ,Destruct );
1031
 
 
1032
 
 m_ctrls.Destruct;
1033
 
 m_rbuf_window.Destruct;
1034
 
 
1035
 
 for i:=0 to max_images - 1 do
1036
 
  m_rbuf_img[i ].Destruct;
1037
 
 
1038
 
end;
1039
 
 
1040
 
{ CAPTION_ }
1041
 
procedure platform_support.caption_;
1042
 
begin
1043
 
 m_caption:=cap + #0;
1044
 
 
1045
 
 dec(byte(m_caption[0 ] ) );
1046
 
 
1047
 
 if m_specific.m_initialized then
1048
 
  m_specific.caption_(PChar(@m_caption[1 ] ) );
1049
 
 
1050
 
end;
1051
 
 
1052
 
{ isdigit }
1053
 
function isdigit(c : char ) : boolean;
1054
 
begin
1055
 
 case c of
1056
 
  '0'..'9' :
1057
 
   result:=true;
1058
 
 
1059
 
  else
1060
 
   result:=false;
1061
 
 
1062
 
 end;
1063
 
 
1064
 
end;
1065
 
 
1066
 
{ atoi }
1067
 
function atoi(c : char_ptr ) : int;
1068
 
var
1069
 
 s : shortstring;
1070
 
 e : int;
1071
 
 
1072
 
begin
1073
 
 s:='';
1074
 
 
1075
 
 repeat
1076
 
  case c^ of
1077
 
   '0'..'9' :
1078
 
    s:=s + c^;
1079
 
 
1080
 
   else
1081
 
    break;
1082
 
 
1083
 
  end;
1084
 
 
1085
 
  inc(ptrcomp(c ) );
1086
 
 
1087
 
 until false;
1088
 
 
1089
 
 val(s ,result ,e );
1090
 
 
1091
 
end;
1092
 
 
1093
 
{ LOAD_IMG }
1094
 
function platform_support.load_img;
1095
 
var
1096
 
 fd  : file;
1097
 
 buf : array[0..1023 ] of char;
1098
 
 len : int;
1099
 
 ptr : char_ptr;
1100
 
 ret : boolean;
1101
 
 
1102
 
 width ,height : unsigned;
1103
 
 
1104
 
 buf_img   : pointer;
1105
 
 rbuf_img_ : rendering_buffer;
1106
 
 
1107
 
begin
1108
 
 result:=false;
1109
 
 
1110
 
 if idx < max_images then
1111
 
  begin
1112
 
   file_:=file_ + _img_ext;
1113
 
 
1114
 
   if not file_exists(file_ ) then
1115
 
    file_:='ppm/' + file_;
1116
 
 
1117
 
   AssignFile(fd ,file_ );
1118
 
   reset     (fd ,1 );
1119
 
 
1120
 
   if IOResult <> 0 then
1121
 
    exit;
1122
 
 
1123
 
   blockread(fd ,buf ,1022 ,len );
1124
 
 
1125
 
   if len = 0 then
1126
 
    begin
1127
 
     close(fd );
1128
 
     exit;
1129
 
 
1130
 
    end;
1131
 
 
1132
 
   buf[len ]:=#0;
1133
 
 
1134
 
   if (buf[0 ] <> 'P' ) and
1135
 
      (buf[1 ] <> '6' ) then
1136
 
    begin
1137
 
     close(fd );
1138
 
     exit;
1139
 
 
1140
 
    end;
1141
 
 
1142
 
   ptr:=@buf[2 ];
1143
 
 
1144
 
   while (ptr^ <> #0 ) and
1145
 
         not isdigit(ptr^ ) do
1146
 
    inc(ptrcomp(ptr ) );
1147
 
 
1148
 
   if ptr^ = #0 then
1149
 
    begin
1150
 
     close(fd );
1151
 
     exit;
1152
 
 
1153
 
    end;
1154
 
 
1155
 
   width:=atoi(ptr );
1156
 
 
1157
 
   if (width = 0 ) or
1158
 
      (width > 4096 ) then
1159
 
    begin
1160
 
     close(fd );
1161
 
     exit;
1162
 
 
1163
 
    end;
1164
 
 
1165
 
   while (ptr^ <> #0 ) and
1166
 
         isdigit(ptr^ ) do
1167
 
    inc(ptrcomp(ptr ) );
1168
 
 
1169
 
   while (ptr^ <> #0 ) and
1170
 
         not isdigit(ptr^ ) do
1171
 
    inc(ptrcomp(ptr ) );
1172
 
 
1173
 
   if ptr^ = #0 then
1174
 
    begin
1175
 
     close(fd );
1176
 
     exit;
1177
 
 
1178
 
    end;
1179
 
 
1180
 
   height:=atoi(ptr );
1181
 
 
1182
 
   if (height = 0 ) or
1183
 
      (height > 4096 ) then
1184
 
    begin
1185
 
     close(fd );
1186
 
     exit;
1187
 
 
1188
 
    end;
1189
 
 
1190
 
   while (ptr^ <> #0 ) and
1191
 
         isdigit(ptr^ ) do
1192
 
    inc(ptrcomp(ptr ) );
1193
 
 
1194
 
   while (ptr^ <> #0 ) and
1195
 
         not isdigit(ptr^ ) do
1196
 
    inc(ptrcomp(ptr ) );
1197
 
 
1198
 
   if atoi(ptr ) <> 255 then
1199
 
    begin
1200
 
     close(fd );
1201
 
     exit;
1202
 
 
1203
 
    end;
1204
 
 
1205
 
   while (ptr^ <> #0 ) and
1206
 
         isdigit(ptr^ ) do
1207
 
    inc(ptrcomp(ptr ) );
1208
 
 
1209
 
   if ptr^ = #0 then
1210
 
    begin
1211
 
     close(fd );
1212
 
     exit;
1213
 
 
1214
 
    end;
1215
 
 
1216
 
   inc       (ptrcomp(ptr ) );
1217
 
   seek      (fd ,ptrcomp(ptr ) - ptrcomp(@buf ) );
1218
 
   create_img(idx ,width ,height );
1219
 
 
1220
 
   ret:=true;
1221
 
 
1222
 
   if m_format = pix_format_rgb24 then
1223
 
    blockread(fd ,m_specific.m_buf_img[idx ]^ ,width * height * 3 )
1224
 
   else
1225
 
    begin
1226
 
     agg_getmem(buf_img ,width * height * 3 );
1227
 
 
1228
 
     rbuf_img_.Construct;
1229
 
 
1230
 
     if m_flip_y then
1231
 
      rbuf_img_.attach(buf_img ,width ,height ,-width * 3 )
1232
 
     else
1233
 
      rbuf_img_.attach(buf_img ,width ,height ,width * 3 );
1234
 
 
1235
 
     blockread(fd ,buf_img^ ,width * height * 3 );
1236
 
 
1237
 
     case m_format of
1238
 
      //pix_format_rgb555 : color_conv(@m_rbuf_img[idx ] ,@rbuf_img_ ,color_conv_rgb24_to_rgb555 );
1239
 
      //pix_format_rgb565 : color_conv(@m_rbuf_img[idx ] ,@rbuf_img_ ,color_conv_rgb24_to_rgb565 );
1240
 
      pix_format_bgr24  : color_conv(@m_rbuf_img[idx ] ,@rbuf_img_ ,color_conv_rgb24_to_bgr24 );
1241
 
      //pix_format_rgba32 : color_conv(@m_rbuf_img[idx ] ,@rbuf_img_ ,color_conv_rgb24_to_rgba32 );
1242
 
      //pix_format_argb32 : color_conv(@m_rbuf_img[idx ] ,@rbuf_img_ ,color_conv_rgb24_to_argb32 );
1243
 
      pix_format_bgra32 : color_conv(@m_rbuf_img[idx ] ,@rbuf_img_ ,color_conv_rgb24_to_bgra32 );
1244
 
      //pix_format_abgr32 : color_conv(@m_rbuf_img[idx ] ,@rbuf_img_ ,color_conv_rgb24_to_abgr32 );
1245
 
      else
1246
 
       ret:=false;
1247
 
 
1248
 
     end;
1249
 
 
1250
 
     agg_freemem(buf_img ,width * height * 3 );
1251
 
 
1252
 
     rbuf_img_.Destruct;
1253
 
 
1254
 
    end;
1255
 
 
1256
 
   close(fd );
1257
 
 
1258
 
   result:=ret;
1259
 
 
1260
 
  end;
1261
 
 
1262
 
end;
1263
 
 
1264
 
{ SAVE_IMG }
1265
 
function platform_support.save_img;
1266
 
var
1267
 
 fd : file;
1268
 
 
1269
 
 s ,c : shortstring;
1270
 
 
1271
 
 w ,h ,y : unsigned;
1272
 
 
1273
 
 tmp_buf ,src : pointer;
1274
 
 
1275
 
begin
1276
 
 result:=false; 
1277
 
 
1278
 
 if (idx < max_images ) and
1279
 
    (rbuf_img(idx )._buf <> NIL ) then
1280
 
  begin
1281
 
   AssignFile(fd ,file_ );
1282
 
   rewrite   (fd ,1 );
1283
 
 
1284
 
   if IOResult <> 0 then
1285
 
    exit;
1286
 
 
1287
 
   w:=rbuf_img(idx )._width;
1288
 
   h:=rbuf_img(idx )._height;
1289
 
 
1290
 
   str(w ,c );
1291
 
 
1292
 
   s:='P6'#13 + c + ' ';
1293
 
 
1294
 
   str(h ,c );
1295
 
 
1296
 
   s:=s + c + #13'255'#13;
1297
 
 
1298
 
   blockwrite(fd ,s[1 ] ,length(s ) );
1299
 
 
1300
 
   agg_getmem(tmp_buf ,w * 3 );
1301
 
 
1302
 
   y:=0;
1303
 
 
1304
 
   while y < rbuf_img(idx )._height do
1305
 
    begin
1306
 
     if m_flip_y then
1307
 
      src:=rbuf_img(idx ).row(h - 1 - y )
1308
 
     else
1309
 
      src:=rbuf_img(idx ).row(y );
1310
 
 
1311
 
     case m_format of
1312
 
      pix_format_rgb555 : color_conv_rgb555_to_rgb24(tmp_buf ,src ,w );
1313
 
      //pix_format_rgb565 : color_conv_rgb565_to_rgb24(tmp_buf ,src ,w );
1314
 
      pix_format_bgr24  : color_conv_bgr24_to_rgb24 (tmp_buf ,src ,w );
1315
 
      //pix_format_rgb24  : color_conv_rgb24_to_rgb24 (tmp_buf ,src ,w );
1316
 
      //pix_format_rgba32 : color_conv_rgba32_to_rgb24(tmp_buf ,src ,w );
1317
 
      //pix_format_argb32 : color_conv_argb32_to_rgb24(tmp_buf ,src ,w );
1318
 
      pix_format_bgra32 : color_conv_bgra32_to_rgb24(tmp_buf ,src ,w );
1319
 
      //pix_format_abgr32 : color_conv_abgr32_to_rgb24(tmp_buf ,src ,w );
1320
 
 
1321
 
     end;
1322
 
 
1323
 
     blockwrite(fd ,tmp_buf^ ,w * 3 );
1324
 
     inc       (y );
1325
 
 
1326
 
    end;
1327
 
 
1328
 
   agg_getmem(tmp_buf ,w * 3 );
1329
 
   close     (fd );
1330
 
 
1331
 
   result:=true;
1332
 
 
1333
 
  end;
1334
 
 
1335
 
end;
1336
 
 
1337
 
{ CREATE_IMG }
1338
 
function platform_support.create_img;
1339
 
begin
1340
 
 result:=false;
1341
 
 
1342
 
 if idx < max_images then
1343
 
  begin
1344
 
   if width_ = 0 then
1345
 
    width_:=trunc(rbuf_window._width );
1346
 
 
1347
 
   if height_ = 0 then
1348
 
    height_:=trunc(rbuf_window._height );
1349
 
 
1350
 
   agg_freemem(m_specific.m_buf_img[idx ] ,m_specific.m_img_alloc[idx ] );
1351
 
 
1352
 
   m_specific.m_img_alloc[idx ]:=width_ * height_ * (m_bpp div 8 );
1353
 
 
1354
 
   agg_getmem(m_specific.m_buf_img[idx ] ,m_specific.m_img_alloc[idx ] );
1355
 
 
1356
 
   if m_flip_y then
1357
 
    m_rbuf_img[idx ].attach(
1358
 
     m_specific.m_buf_img[idx ] ,
1359
 
     width_ ,height_ ,
1360
 
     -width_ * (m_bpp div 8 ) )
1361
 
   else
1362
 
    m_rbuf_img[idx ].attach(
1363
 
     m_specific.m_buf_img[idx ] ,
1364
 
     width_ ,height_ ,
1365
 
     width_ * (m_bpp div 8 ) );
1366
 
 
1367
 
   result:=true;
1368
 
 
1369
 
  end;
1370
 
 
1371
 
end;
1372
 
 
1373
 
{ INIT }
1374
 
function platform_support.init;
1375
 
const
1376
 
 xevent_mask =
1377
 
  PointerMotionMask or
1378
 
  ButtonPressMask or
1379
 
  ButtonReleaseMask or
1380
 
  ExposureMask or
1381
 
  KeyPressMask or
1382
 
  StructureNotifyMask;
1383
 
 
1384
 
var
1385
 
 r_mask ,g_mask ,b_mask ,window_mask : unsigned;
1386
 
 
1387
 
 t ,hw_byte_order : int;
1388
 
 
1389
 
 hints : PXSizeHints;
1390
 
 
1391
 
begin
1392
 
 m_window_flags:=flags;
1393
 
 
1394
 
 m_specific.m_display:=XOpenDisplay(NIL );
1395
 
 
1396
 
 if m_specific.m_display = NIL then 
1397
 
  begin
1398
 
   writeln(stderr ,'Unable to open DISPLAY!' );
1399
 
 
1400
 
   result:=false;
1401
 
 
1402
 
   exit;
1403
 
 
1404
 
  end;
1405
 
 
1406
 
 m_specific.m_screen:=XDefaultScreen(m_specific.m_display );
1407
 
 m_specific.m_depth :=XDefaultDepth (m_specific.m_display ,m_specific.m_screen );
1408
 
 m_specific.m_visual:=XDefaultVisual(m_specific.m_display ,m_specific.m_screen );
1409
 
 
1410
 
 r_mask:=m_specific.m_visual.red_mask;
1411
 
 g_mask:=m_specific.m_visual.green_mask;
1412
 
 b_mask:=m_specific.m_visual.blue_mask;
1413
 
 
1414
 
 if (m_specific.m_depth < 15 ) or
1415
 
    (r_mask = 0 ) or
1416
 
    (g_mask = 0 ) or
1417
 
    (b_mask = 0 ) then
1418
 
  begin
1419
 
   writeln(stderr ,'There''s no Visual compatible with minimal AGG requirements:' );
1420
 
   writeln(stderr ,'At least 15-bit color depth and True- or DirectColor class.' );
1421
 
   writeln(stderr );
1422
 
 
1423
 
   XCloseDisplay(m_specific.m_display );
1424
 
 
1425
 
   result:=false;
1426
 
 
1427
 
   exit;
1428
 
 
1429
 
  end;
1430
 
 
1431
 
 t:=1;
1432
 
 
1433
 
 hw_byte_order:=LSBFirst;
1434
 
 
1435
 
 if byte(pointer(@t )^ ) = 0 then
1436
 
  hw_byte_order:=MSBFirst;
1437
 
 
1438
 
// Perceive SYS-format by mask
1439
 
 case m_specific.m_depth of
1440
 
  15 :
1441
 
   begin
1442
 
    m_specific.m_sys_bpp:=16;
1443
 
 
1444
 
    if (r_mask = $7C00 ) and
1445
 
       (g_mask = $3E0 ) and
1446
 
       (b_mask = $1F ) then
1447
 
     begin
1448
 
      m_specific.m_sys_format:=pix_format_rgb555;
1449
 
      m_specific.m_byte_order:=hw_byte_order;
1450
 
 
1451
 
     end;
1452
 
 
1453
 
   end;
1454
 
 
1455
 
  16 :
1456
 
   begin
1457
 
    m_specific.m_sys_bpp:=16;
1458
 
 
1459
 
    if (r_mask = $F800 ) and
1460
 
       (g_mask = $7E0 ) and
1461
 
       (b_mask = $1F ) then
1462
 
     begin
1463
 
      m_specific.m_sys_format:=pix_format_rgb565;
1464
 
      m_specific.m_byte_order:=hw_byte_order;
1465
 
 
1466
 
     end;
1467
 
 
1468
 
   end;
1469
 
 
1470
 
  24 ,32 :
1471
 
   begin
1472
 
    m_specific.m_sys_bpp:=32;
1473
 
 
1474
 
    if g_mask = $FF00 then
1475
 
     begin
1476
 
      if (r_mask = $FF ) and
1477
 
         (b_mask = $FF0000 ) then
1478
 
       case m_specific.m_format of
1479
 
        pix_format_rgba32 :
1480
 
         begin
1481
 
          m_specific.m_sys_format:=pix_format_rgba32;
1482
 
          m_specific.m_byte_order:=LSBFirst;
1483
 
 
1484
 
         end;
1485
 
 
1486
 
        pix_format_abgr32 :
1487
 
         begin
1488
 
          m_specific.m_sys_format:=pix_format_abgr32;
1489
 
          m_specific.m_byte_order:=MSBFirst;
1490
 
 
1491
 
         end;
1492
 
 
1493
 
        else
1494
 
         begin
1495
 
          m_specific.m_byte_order:=hw_byte_order;
1496
 
 
1497
 
          if hw_byte_order = LSBFirst then
1498
 
           m_specific.m_sys_format:=pix_format_rgba32
1499
 
          else
1500
 
           m_specific.m_sys_format:=pix_format_abgr32;
1501
 
 
1502
 
         end;
1503
 
 
1504
 
       end;
1505
 
 
1506
 
      if (r_mask = $FF0000 ) and
1507
 
         (b_mask = $FF ) then
1508
 
       case m_specific.m_format of
1509
 
        pix_format_argb32 :
1510
 
         begin
1511
 
          m_specific.m_sys_format:=pix_format_argb32;
1512
 
          m_specific.m_byte_order:=MSBFirst;
1513
 
 
1514
 
         end;
1515
 
 
1516
 
        pix_format_bgra32 :
1517
 
         begin
1518
 
          m_specific.m_sys_format:=pix_format_bgra32;
1519
 
          m_specific.m_byte_order:=LSBFirst;
1520
 
 
1521
 
         end;
1522
 
 
1523
 
        else
1524
 
         begin
1525
 
          m_specific.m_byte_order:=hw_byte_order;
1526
 
 
1527
 
          if hw_byte_order = MSBFirst then
1528
 
           m_specific.m_sys_format:=pix_format_argb32
1529
 
          else
1530
 
           m_specific.m_sys_format:=pix_format_bgra32;
1531
 
 
1532
 
         end;
1533
 
 
1534
 
       end;
1535
 
 
1536
 
     end;
1537
 
 
1538
 
   end;
1539
 
 
1540
 
 end;
1541
 
 
1542
 
 if m_specific.m_sys_format = pix_format_undefined then
1543
 
  begin 
1544
 
   writeln(stderr ,'RGB masks are not compatible with AGG pixel formats:' );
1545
 
   write  (stderr ,'R=' ,r_mask ,'G=' ,g_mask ,'B=' ,b_mask );
1546
 
 
1547
 
   XCloseDisplay(m_specific.m_display );
1548
 
 
1549
 
   result:=false;
1550
 
 
1551
 
   exit;
1552
 
 
1553
 
  end;
1554
 
 
1555
 
 fillchar(
1556
 
  m_specific.m_window_attributes ,
1557
 
  sizeof(m_specific.m_window_attributes ) ,0 );
1558
 
 
1559
 
 m_specific.m_window_attributes.border_pixel:=
1560
 
  XBlackPixel(m_specific.m_display ,m_specific.m_screen );
1561
 
 
1562
 
 m_specific.m_window_attributes.background_pixel:=
1563
 
  XWhitePixel(m_specific.m_display ,m_specific.m_screen );
1564
 
 
1565
 
 m_specific.m_window_attributes.override_redirect:=xfalse;
1566
 
 
1567
 
 window_mask:=CWBackPixel or CWBorderPixel;
1568
 
 
1569
 
 m_specific.m_window:=
1570
 
  XCreateWindow(
1571
 
   m_specific.m_display ,
1572
 
   XDefaultRootWindow(m_specific.m_display ) ,
1573
 
   0 ,0 ,
1574
 
   width_ ,height_ ,
1575
 
   0 ,
1576
 
   m_specific.m_depth ,
1577
 
   InputOutput ,
1578
 
   CopyFromParent ,
1579
 
   window_mask ,
1580
 
   @m_specific.m_window_attributes );
1581
 
 
1582
 
 m_specific.m_gc:=XCreateGC(m_specific.m_display ,m_specific.m_window ,0 ,0 ); 
1583
 
 
1584
 
 m_specific.m_buf_alloc:=width_ * height_ * (m_bpp div 8 );
1585
 
 
1586
 
 agg_getmem(m_specific.m_buf_window ,m_specific.m_buf_alloc );
1587
 
 fillchar  (m_specific.m_buf_window^ ,m_specific.m_buf_alloc ,255 );
1588
 
 
1589
 
 if m_flip_y then
1590
 
  m_rbuf_window.attach(
1591
 
   m_specific.m_buf_window ,
1592
 
   width_ ,height_ ,
1593
 
   -width_ * (m_bpp div 8 ) )
1594
 
 else
1595
 
  m_rbuf_window.attach(
1596
 
   m_specific.m_buf_window ,
1597
 
   width_ ,height_ ,
1598
 
   width_ * (m_bpp div 8 ) );
1599
 
 
1600
 
 m_specific.m_ximg_window:=
1601
 
  XCreateImage(
1602
 
   m_specific.m_display ,
1603
 
   m_specific.m_visual , //CopyFromParent, 
1604
 
   m_specific.m_depth ,
1605
 
   ZPixmap ,
1606
 
   0 ,
1607
 
   m_specific.m_buf_window ,
1608
 
   width_ ,height_ ,
1609
 
   m_specific.m_sys_bpp ,
1610
 
   width_ * (m_specific.m_sys_bpp div 8 ) );
1611
 
 
1612
 
 m_specific.m_ximg_window.byte_order:=m_specific.m_byte_order;
1613
 
 
1614
 
 m_specific.caption_(PChar(@m_caption[1 ] ) ); 
1615
 
 
1616
 
 m_initial_width :=width_;
1617
 
 m_initial_height:=height_;
1618
 
 
1619
 
 if not m_specific.m_initialized then
1620
 
  begin
1621
 
   on_init;
1622
 
 
1623
 
   m_specific.m_initialized:=true;
1624
 
 
1625
 
  end;
1626
 
 
1627
 
 trans_affine_resizing_(width_ ,height_ );
1628
 
 
1629
 
 on_resize(width_ ,height_ );
1630
 
 
1631
 
 m_specific.m_update_flag:=true;
1632
 
 
1633
 
 hints:=XAllocSizeHints;
1634
 
 
1635
 
 if hints <> NIL then
1636
 
  begin
1637
 
   if flags and window_resize <> 0 then
1638
 
    begin
1639
 
     hints.min_width :=32;
1640
 
     hints.min_height:=32;
1641
 
     hints.max_width :=4096;
1642
 
     hints.max_height:=4096;
1643
 
 
1644
 
    end
1645
 
   else
1646
 
    begin
1647
 
     hints.min_width :=width_;
1648
 
     hints.min_height:=height_;
1649
 
     hints.max_width :=width_;
1650
 
     hints.max_height:=height_;
1651
 
 
1652
 
    end;
1653
 
 
1654
 
   hints.flags:=PMaxSize or PMinSize;
1655
 
 
1656
 
   XSetWMNormalHints(m_specific.m_display ,m_specific.m_window ,hints );
1657
 
   XFree            (hints );
1658
 
 
1659
 
  end;
1660
 
 
1661
 
 XMapWindow  (m_specific.m_display ,m_specific.m_window );
1662
 
 XSelectInput(m_specific.m_display ,m_specific.m_window ,xevent_mask );
1663
 
 
1664
 
 m_specific.m_close_atom:=
1665
 
  XInternAtom(m_specific.m_display ,'WM_DELETE_WINDOW' ,false );
1666
 
 
1667
 
 XSetWMProtocols(
1668
 
  m_specific.m_display ,
1669
 
  m_specific.m_window ,
1670
 
  @m_specific.m_close_atom ,1 );
1671
 
 
1672
 
 result:=true;
1673
 
 
1674
 
end;
1675
 
 
1676
 
{ RUN }
1677
 
function platform_support.run;
1678
 
var
1679
 
 flags ,i : unsigned;
1680
 
 
1681
 
 cur_x ,cur_y ,width ,height : int;
1682
 
 
1683
 
 x_event ,te : TXEvent;
1684
 
 
1685
 
 key : TKeySym;
1686
 
 
1687
 
 left ,up ,right ,down : boolean;
1688
 
 
1689
 
begin
1690
 
 XFlush(m_specific.m_display );
1691
 
 
1692
 
 m_quit:=false;
1693
 
 
1694
 
 while not m_quit do
1695
 
  begin
1696
 
   if m_specific.m_update_flag then
1697
 
    begin
1698
 
     on_draw;
1699
 
     update_window;
1700
 
 
1701
 
     m_specific.m_update_flag:=false;
1702
 
 
1703
 
    end;
1704
 
 
1705
 
   if not m_wait_mode then
1706
 
    if XPending(m_specific.m_display ) = 0 then
1707
 
     begin
1708
 
      on_idle;
1709
 
      continue;
1710
 
 
1711
 
     end;
1712
 
 
1713
 
   XNextEvent(m_specific.m_display ,@x_event );
1714
 
 
1715
 
  // In the Idle mode discard all intermediate MotionNotify events
1716
 
   if not m_wait_mode and
1717
 
      (x_event._type = MotionNotify ) then
1718
 
    begin
1719
 
     te:=x_event;
1720
 
 
1721
 
     repeat
1722
 
      if XPending(m_specific.m_display ) = 0 then
1723
 
       break;
1724
 
 
1725
 
      XNextEvent(m_specific.m_display ,@te );
1726
 
 
1727
 
      if te._type <> MotionNotify then
1728
 
       break;
1729
 
 
1730
 
     until false;
1731
 
 
1732
 
     x_event:=te;
1733
 
 
1734
 
    end;
1735
 
 
1736
 
   case x_event._type of
1737
 
    ConfigureNotify :
1738
 
     if (x_event.xconfigure.width <> trunc(m_rbuf_window._width ) ) or
1739
 
        (x_event.xconfigure.height <> trunc(m_rbuf_window._height ) ) then
1740
 
      begin
1741
 
       width :=x_event.xconfigure.width;
1742
 
       height:=x_event.xconfigure.height;
1743
 
 
1744
 
       agg_freemem(m_specific.m_buf_window ,m_specific.m_buf_alloc );
1745
 
 
1746
 
       m_specific.m_ximg_window.data:=0;
1747
 
 
1748
 
       XDestroyImage(m_specific.m_ximg_window );
1749
 
 
1750
 
       m_specific.m_buf_alloc:=width * height * (m_bpp div 8 );
1751
 
 
1752
 
       agg_getmem(m_specific.m_buf_window ,m_specific.m_buf_alloc );
1753
 
 
1754
 
       if m_flip_y then
1755
 
        m_rbuf_window.attach(
1756
 
         m_specific.m_buf_window ,
1757
 
         width ,height ,
1758
 
         -width * (m_bpp div 8 ) )
1759
 
       else
1760
 
        m_rbuf_window.attach(
1761
 
         m_specific.m_buf_window ,
1762
 
         width ,height ,
1763
 
         width * (m_bpp div 8 ) );
1764
 
 
1765
 
       m_specific.m_ximg_window:=
1766
 
        XCreateImage(m_specific.m_display ,
1767
 
        m_specific.m_visual , //CopyFromParent, 
1768
 
        m_specific.m_depth ,
1769
 
        ZPixmap ,
1770
 
        0 ,
1771
 
        m_specific.m_buf_window ,
1772
 
        width ,height ,
1773
 
        m_specific.m_sys_bpp ,
1774
 
        width * (m_specific.m_sys_bpp div 8 ) );
1775
 
 
1776
 
       m_specific.m_ximg_window.byte_order:=m_specific.m_byte_order;
1777
 
 
1778
 
       trans_affine_resizing_(width ,height );
1779
 
 
1780
 
       on_resize(width ,height );
1781
 
       on_draw;
1782
 
       update_window;
1783
 
 
1784
 
      end;
1785
 
 
1786
 
    Expose :
1787
 
     begin
1788
 
      m_specific.put_image(@m_rbuf_window );
1789
 
 
1790
 
      XFlush(m_specific.m_display );
1791
 
      XSync (m_specific.m_display ,false );
1792
 
 
1793
 
     end;
1794
 
 
1795
 
    KeyPress :
1796
 
     begin
1797
 
      key  :=XLookupKeysym(@x_event.xkey ,0 );
1798
 
      flags:=0;
1799
 
 
1800
 
      if x_event.xkey.state and Button1Mask <> 0 then
1801
 
       flags:=flags or mouse_left;
1802
 
 
1803
 
      if x_event.xkey.state and Button3Mask <> 0 then
1804
 
       flags:=flags or mouse_right;
1805
 
 
1806
 
      if x_event.xkey.state and ShiftMask <> 0 then
1807
 
       flags:=flags or kbd_shift;
1808
 
 
1809
 
      if x_event.xkey.state and ControlMask <> 0 then
1810
 
       flags:=flags or kbd_ctrl;
1811
 
 
1812
 
      left :=false;
1813
 
      up   :=false;
1814
 
      right:=false;
1815
 
      down :=false;
1816
 
 
1817
 
      case m_specific.m_keymap[key and $FF ] of
1818
 
       key_left  : left :=true;
1819
 
       key_up    : up   :=true;
1820
 
       key_right : right:=true;
1821
 
       key_down  : down :=true;
1822
 
 
1823
 
       key_f2 :
1824
 
        begin
1825
 
         copy_window_to_img(max_images - 1 );
1826
 
         save_img          (max_images - 1 ,'screenshot.ppm' );
1827
 
 
1828
 
        end;
1829
 
 
1830
 
      end;
1831
 
 
1832
 
      if m_ctrls.on_arrow_keys(left ,right ,down ,up ) then
1833
 
       begin
1834
 
        on_ctrl_change;
1835
 
        force_redraw;
1836
 
 
1837
 
       end
1838
 
      else
1839
 
       if m_flip_y then
1840
 
        on_key(
1841
 
         x_event.xkey.x ,
1842
 
         trunc(m_rbuf_window._height ) - x_event.xkey.y ,
1843
 
         m_specific.m_keymap[key and $FF ] ,flags )
1844
 
       else
1845
 
        on_key(
1846
 
         x_event.xkey.x ,
1847
 
         x_event.xkey.y ,
1848
 
         m_specific.m_keymap[key and $FF ] ,flags )
1849
 
 
1850
 
     end;
1851
 
 
1852
 
    ButtonPress :
1853
 
     begin
1854
 
      flags:=0;
1855
 
 
1856
 
      if x_event.xbutton.state and ShiftMask <> 0 then
1857
 
       flags:=flags or kbd_shift;
1858
 
 
1859
 
      if x_event.xbutton.state and ControlMask <> 0 then
1860
 
       flags:=flags or kbd_ctrl;
1861
 
 
1862
 
      if x_event.xbutton.button = Button1 then
1863
 
       flags:=flags or mouse_left;
1864
 
 
1865
 
      if x_event.xbutton.button = Button3 then
1866
 
       flags:=flags or mouse_right;
1867
 
 
1868
 
      cur_x:=x_event.xbutton.x;
1869
 
 
1870
 
      if m_flip_y then
1871
 
       cur_y:=trunc(m_rbuf_window._height ) - x_event.xbutton.y 
1872
 
      else
1873
 
       cur_y:=x_event.xbutton.y;
1874
 
 
1875
 
      if flags and mouse_left <> 0 then
1876
 
       if m_ctrls.on_mouse_button_down(cur_x ,cur_y ) then
1877
 
        begin
1878
 
         m_ctrls.set_cur(cur_x ,cur_y );
1879
 
         on_ctrl_change;
1880
 
         force_redraw;
1881
 
 
1882
 
        end
1883
 
       else
1884
 
        if m_ctrls.in_rect(cur_x ,cur_y ) then
1885
 
         if m_ctrls.set_cur(cur_x ,cur_y ) then
1886
 
          begin
1887
 
           on_ctrl_change;
1888
 
           force_redraw;
1889
 
 
1890
 
          end
1891
 
         else
1892
 
        else
1893
 
         on_mouse_button_down(cur_x ,cur_y ,flags );
1894
 
 
1895
 
      if flags and mouse_right <> 0 then
1896
 
       on_mouse_button_down(cur_x ,cur_y ,flags );
1897
 
 
1898
 
      //m_specific.m_wait_mode:=m_wait_mode;
1899
 
      //m_wait_mode           :=true;
1900
 
 
1901
 
     end;
1902
 
 
1903
 
    MotionNotify :
1904
 
     begin
1905
 
      flags:=0;
1906
 
 
1907
 
      if x_event.xmotion.state and Button1Mask <> 0 then
1908
 
       flags:=flags or mouse_left;
1909
 
 
1910
 
      if x_event.xmotion.state and Button3Mask <> 0 then
1911
 
       flags:=flags or mouse_right;
1912
 
 
1913
 
      if x_event.xmotion.state and ShiftMask <> 0 then
1914
 
       flags:=flags or kbd_shift;
1915
 
 
1916
 
      if x_event.xmotion.state and ControlMask <> 0 then
1917
 
       flags:=flags or kbd_ctrl;
1918
 
 
1919
 
      cur_x:=x_event.xbutton.x;
1920
 
 
1921
 
      if m_flip_y then
1922
 
       cur_y:=trunc(m_rbuf_window._height ) - x_event.xbutton.y
1923
 
      else
1924
 
       cur_y:=x_event.xbutton.y;
1925
 
 
1926
 
      if m_ctrls.on_mouse_move(cur_x ,cur_y ,flags and mouse_left <> 0 ) then
1927
 
       begin
1928
 
        on_ctrl_change;
1929
 
        force_redraw;
1930
 
 
1931
 
       end
1932
 
      else
1933
 
       if not m_ctrls.in_rect(cur_x ,cur_y ) then
1934
 
        on_mouse_move(cur_x ,cur_y ,flags );
1935
 
 
1936
 
     end;
1937
 
 
1938
 
    ButtonRelease :
1939
 
     begin
1940
 
      flags:=0;
1941
 
 
1942
 
      if x_event.xbutton.state and ShiftMask <> 0 then
1943
 
       flags:=flags or kbd_shift;
1944
 
 
1945
 
      if x_event.xbutton.state and ControlMask <> 0 then
1946
 
       flags:=flags or kbd_ctrl;
1947
 
 
1948
 
      if x_event.xbutton.button = Button1 then
1949
 
       flags:=flags or mouse_left;
1950
 
 
1951
 
      if x_event.xbutton.button = Button3 then
1952
 
       flags:=flags or mouse_right;
1953
 
 
1954
 
      cur_x:=x_event.xbutton.x;
1955
 
 
1956
 
      if m_flip_y then
1957
 
       cur_y:=trunc(m_rbuf_window._height ) - x_event.xbutton.y
1958
 
      else
1959
 
       cur_y:=x_event.xbutton.y;
1960
 
 
1961
 
      if flags and mouse_left <> 0 then
1962
 
       if m_ctrls.on_mouse_button_up(cur_x ,cur_y ) then
1963
 
        begin
1964
 
         on_ctrl_change;
1965
 
         force_redraw;
1966
 
 
1967
 
        end;
1968
 
 
1969
 
      if flags and (mouse_left or mouse_right ) <> 0 then
1970
 
       on_mouse_button_up(cur_x ,cur_y ,flags );
1971
 
 
1972
 
      //m_wait_mode:=m_specific.m_wait_mode;
1973
 
 
1974
 
     end;
1975
 
 
1976
 
    ClientMessage :
1977
 
     if (x_event.xclient.format = 32 ) and
1978
 
        (x_event.xclient.data.l[0 ] = int(m_specific.m_close_atom ) ) then
1979
 
      m_quit:=true;
1980
 
 
1981
 
   end;
1982
 
 
1983
 
  end;
1984
 
 
1985
 
 i:=max_images;
1986
 
 
1987
 
 while i <> 0 do
1988
 
  begin
1989
 
   dec(i );
1990
 
 
1991
 
   if m_specific.m_buf_img[i ] <> NIL then
1992
 
    agg_freemem(m_specific.m_buf_img[i ] ,m_specific.m_img_alloc[i ] );
1993
 
 
1994
 
  end;
1995
 
 
1996
 
 agg_freemem(m_specific.m_buf_window ,m_specific.m_buf_alloc );
1997
 
 
1998
 
 m_specific.m_ximg_window.data:=NIL;
1999
 
 
2000
 
 XDestroyImage (m_specific.m_ximg_window );
2001
 
 XFreeGC       (m_specific.m_display ,m_specific.m_gc );
2002
 
 XDestroyWindow(m_specific.m_display ,m_specific.m_window );
2003
 
 XCloseDisplay (m_specific.m_display );
2004
 
 
2005
 
 result:=0;
2006
 
 
2007
 
end;
2008
 
 
2009
 
{ QUIT }
2010
 
procedure platform_support.quit;
2011
 
begin
2012
 
 m_quit:=true;
2013
 
 
2014
 
end;
2015
 
 
2016
 
{ _FORMAT }
2017
 
function platform_support._format;
2018
 
begin
2019
 
 result:=m_format;
2020
 
 
2021
 
end;
2022
 
 
2023
 
{ _FLIP_Y }
2024
 
function platform_support._flip_y;
2025
 
begin
2026
 
 result:=m_flip_y;
2027
 
 
2028
 
end;
2029
 
 
2030
 
{ _BPP }
2031
 
function platform_support._bpp;
2032
 
begin
2033
 
 result:=m_bpp;
2034
 
 
2035
 
end;
2036
 
 
2037
 
{ _WAIT_MODE }
2038
 
function platform_support._wait_mode;
2039
 
begin
2040
 
 result:=m_wait_mode;
2041
 
 
2042
 
end;
2043
 
 
2044
 
{ WAIT_MODE_ }
2045
 
procedure platform_support.wait_mode_;
2046
 
begin
2047
 
 m_wait_mode:=wait_mode;
2048
 
 
2049
 
end;
2050
 
 
2051
 
{ FORCE_REDRAW }
2052
 
procedure platform_support.force_redraw;
2053
 
begin
2054
 
 m_specific.m_update_flag:=true;
2055
 
 
2056
 
end;
2057
 
 
2058
 
{ UPDATE_WINDOW }
2059
 
procedure platform_support.update_window;
2060
 
begin
2061
 
 m_specific.put_image(@m_rbuf_window );
2062
 
 
2063
 
// When m_wait_mode is true we can discard all the events 
2064
 
// came while the image is being drawn. In this case 
2065
 
// the X server does not accumulate mouse motion events.
2066
 
// When m_wait_mode is false, i.e. we have some idle drawing
2067
 
// we cannot afford to miss any events
2068
 
 XSync(m_specific.m_display ,m_wait_mode );
2069
 
 
2070
 
end;
2071
 
 
2072
 
{ RBUF_WINDOW }
2073
 
function platform_support.rbuf_window;
2074
 
begin
2075
 
 result:=@m_rbuf_window;
2076
 
 
2077
 
end;
2078
 
 
2079
 
{ RBUF_IMG }
2080
 
function platform_support.rbuf_img;
2081
 
begin
2082
 
 result:=@m_rbuf_img[idx ];
2083
 
 
2084
 
end;
2085
 
 
2086
 
{ _IMG_EXT }
2087
 
function platform_support._img_ext;
2088
 
begin
2089
 
 result:='.ppm';
2090
 
 
2091
 
end;
2092
 
 
2093
 
{ COPY_IMG_TO_WINDOW }
2094
 
procedure platform_support.copy_img_to_window;
2095
 
begin
2096
 
 if (idx < max_images ) and
2097
 
    (rbuf_img(idx )._buf <> NIL ) then
2098
 
  rbuf_window.copy_from(rbuf_img(idx ) );
2099
 
 
2100
 
end;
2101
 
 
2102
 
{ COPY_WINDOW_TO_IMG }
2103
 
procedure platform_support.copy_window_to_img;
2104
 
begin
2105
 
 if idx < max_images then
2106
 
  begin
2107
 
   create_img(idx ,rbuf_window._width ,rbuf_window._height );
2108
 
   rbuf_img  (idx ).copy_from(rbuf_window );
2109
 
 
2110
 
  end;
2111
 
 
2112
 
end;
2113
 
 
2114
 
{ COPY_IMG_TO_IMG }
2115
 
procedure platform_support.copy_img_to_img;
2116
 
begin
2117
 
 if (idx_from < max_images ) and
2118
 
    (idx_to < max_images ) and
2119
 
    (rbuf_img(idx_from )._buf <> NIL ) then
2120
 
  begin
2121
 
   create_img(
2122
 
    idx_to ,
2123
 
    rbuf_img(idx_from )._width ,
2124
 
    rbuf_img(idx_from )._height );
2125
 
 
2126
 
   rbuf_img(idx_to ).copy_from(rbuf_img(idx_from ) );
2127
 
 
2128
 
  end;
2129
 
 
2130
 
end;
2131
 
 
2132
 
{ ON_INIT }
2133
 
procedure platform_support.on_init;
2134
 
begin
2135
 
end;
2136
 
 
2137
 
{ ON_RESIZE }
2138
 
procedure platform_support.on_resize;
2139
 
begin
2140
 
end;
2141
 
 
2142
 
{ ON_IDLE }
2143
 
procedure platform_support.on_idle;
2144
 
begin
2145
 
end;
2146
 
 
2147
 
{ ON_MOUSE_MOVE }
2148
 
procedure platform_support.on_mouse_move;
2149
 
begin
2150
 
end;
2151
 
 
2152
 
{ ON_MOUSE_BUTTON_DOWN }
2153
 
procedure platform_support.on_mouse_button_down;
2154
 
begin
2155
 
end;
2156
 
 
2157
 
{ ON_MOUSE_BUTTON_UP }
2158
 
procedure platform_support.on_mouse_button_up;
2159
 
begin
2160
 
end;
2161
 
 
2162
 
{ ON_KEY }
2163
 
procedure platform_support.on_key;
2164
 
begin
2165
 
end;
2166
 
 
2167
 
{ ON_CTRL_CHANGE }
2168
 
procedure platform_support.on_ctrl_change;
2169
 
begin
2170
 
end;
2171
 
 
2172
 
{ ON_DRAW }
2173
 
procedure platform_support.on_draw;
2174
 
begin
2175
 
end;
2176
 
 
2177
 
{ ON_POST_DRAW }
2178
 
procedure platform_support.on_post_draw;
2179
 
begin
2180
 
end;
2181
 
 
2182
 
{ ADD_CTRL }
2183
 
procedure platform_support.add_ctrl;
2184
 
begin
2185
 
 m_ctrls.add(c );
2186
 
 
2187
 
 c.transform(@m_resize_mtx );
2188
 
 
2189
 
end;
2190
 
 
2191
 
{ TRANS_AFFINE_RESIZING_ }
2192
 
procedure platform_support.trans_affine_resizing_;
2193
 
var
2194
 
 vp : trans_viewport;
2195
 
 ts : trans_affine_scaling;
2196
 
 
2197
 
begin
2198
 
 if m_window_flags and window_keep_aspect_ratio <> 0 then
2199
 
  begin
2200
 
   vp.Construct;
2201
 
   vp.preserve_aspect_ratio(0.5 ,0.5 ,aspect_ratio_meet );
2202
 
 
2203
 
   vp.device_viewport(0 ,0 ,width_ ,height_ );
2204
 
   vp.world_viewport (0 ,0 ,m_initial_width ,m_initial_height );
2205
 
 
2206
 
   vp.to_affine(@m_resize_mtx );
2207
 
 
2208
 
  end
2209
 
 else
2210
 
  begin
2211
 
   ts.Construct(
2212
 
    width_ / m_initial_width ,
2213
 
    height_ / m_initial_height );
2214
 
 
2215
 
   m_resize_mtx.assign(@ts );
2216
 
 
2217
 
  end;
2218
 
 
2219
 
end;
2220
 
 
2221
 
{ _TRANS_AFFINE_RESIZING }
2222
 
function platform_support._trans_affine_resizing;
2223
 
begin
2224
 
 result:=@m_resize_mtx;
2225
 
 
2226
 
end;
2227
 
 
2228
 
{ _WIDTH }
2229
 
function platform_support._width;
2230
 
begin
2231
 
 result:=m_rbuf_window._width;
2232
 
 
2233
 
end;
2234
 
 
2235
 
{ _HEIGHT }
2236
 
function platform_support._height;
2237
 
begin
2238
 
 result:=m_rbuf_window._height;
2239
 
 
2240
 
end;
2241
 
 
2242
 
{ _INITIAL_WIDTH }
2243
 
function platform_support._initial_width;
2244
 
begin
2245
 
 result:=m_initial_width;
2246
 
 
2247
 
end;
2248
 
 
2249
 
{ _INITIAL_HEIGHT }
2250
 
function platform_support._initial_height;
2251
 
begin
2252
 
 result:=m_initial_height;
2253
 
 
2254
 
end;
2255
 
 
2256
 
{ _WINDOW_FLAGS }
2257
 
function platform_support._window_flags;
2258
 
begin
2259
 
 result:=m_window_flags;
2260
 
 
2261
 
end;
2262
 
 
2263
 
{ _RAW_DISPLAY_HANDLER }
2264
 
function platform_support._raw_display_handler;
2265
 
begin
2266
 
end;
2267
 
 
2268
 
{ MESSAGE_ }
2269
 
procedure platform_support.message_;
2270
 
const
2271
 
 x_event_mask =
2272
 
  ExposureMask or
2273
 
  KeyPressMask;
2274
 
 
2275
 
 capt = '  PRESS ANY KEY TO CONTINUE THE AGGPAS DEMO ...';
2276
 
 plus = 4;
2277
 
 
2278
 
var
2279
 
 x_display : PDisplay;
2280
 
 x_window  : TWindow;
2281
 
 x_event   : TXEvent;
2282
 
 x_close   : TAtom;
2283
 
 x_changes : TXWindowChanges;
2284
 
 x_hints   : PXSizeHints;
2285
 
 
2286
 
 x_gc : TGC;
2287
 
 x_tp : TXTextProperty;
2288
 
 x_tx : TXTextItem;
2289
 
 
2290
 
 str ,cur : char_ptr;
2291
 
 
2292
 
 y ,len ,cnt ,max ,x_dx ,x_dy : unsigned;
2293
 
 
2294
 
 font_dir ,font_ascent ,font_descent : int;
2295
 
 
2296
 
 font_str : TXCharStruct;
2297
 
 
2298
 
procedure draw_text;
2299
 
begin
2300
 
 x_dx:=0;
2301
 
 x_dy:=0;
2302
 
 
2303
 
 y  :=20;
2304
 
 cur:=PChar(@msg[0 ] );
2305
 
 max:=strlen(msg );
2306
 
 len:=0;
2307
 
 cnt:=0;
2308
 
 
2309
 
 while cnt < max do
2310
 
  begin
2311
 
   if len = 0 then
2312
 
    str:=cur;
2313
 
 
2314
 
   case cur^ of
2315
 
    #13 :
2316
 
     begin
2317
 
      XDrawString      (x_display ,x_window ,x_gc ,10 ,y ,str ,len );
2318
 
      XQueryTextExtents(
2319
 
       x_display ,XGContextFromGC(x_gc) ,
2320
 
       str ,len ,
2321
 
       @font_dir ,
2322
 
       @font_ascent ,
2323
 
       @font_descent ,
2324
 
       @font_str );
2325
 
 
2326
 
      inc(y ,font_str.ascent + font_str.descent + plus );
2327
 
      inc(x_dy ,font_str.ascent + font_str.descent + plus );
2328
 
 
2329
 
      if font_str.width > x_dx then
2330
 
       x_dx:=font_str.width;
2331
 
 
2332
 
      len:=0;
2333
 
 
2334
 
     end;
2335
 
 
2336
 
    else
2337
 
     inc(len );
2338
 
 
2339
 
   end;
2340
 
 
2341
 
   inc(ptrcomp(cur ) );
2342
 
   inc(cnt );
2343
 
 
2344
 
  end;
2345
 
 
2346
 
 if len > 0 then
2347
 
  begin
2348
 
   XDrawString      (x_display ,x_window ,x_gc ,10 ,y ,str ,len );
2349
 
   XQueryTextExtents(
2350
 
    x_display ,XGContextFromGC(x_gc) ,
2351
 
    str ,len ,
2352
 
    @font_dir ,
2353
 
    @font_ascent ,
2354
 
    @font_descent ,
2355
 
    @font_str );
2356
 
 
2357
 
   inc(x_dy ,font_str.ascent + font_str.descent + plus );
2358
 
 
2359
 
   if font_str.width > x_dx then
2360
 
    x_dx:=font_str.width;
2361
 
 
2362
 
  end;
2363
 
 
2364
 
end;
2365
 
 
2366
 
begin
2367
 
 x_display:=XOpenDisplay(NIL );
2368
 
 
2369
 
 if x_display <> NIL then
2370
 
  begin
2371
 
   x_window :=
2372
 
    XCreateSimpleWindow(
2373
 
     x_display ,
2374
 
     XDefaultRootWindow(x_display ) ,
2375
 
     50 ,50 ,
2376
 
     550 ,300 ,
2377
 
     0 ,0 ,
2378
 
     255 + (255 shl 8 ) + (255 shl 16 ) );
2379
 
 
2380
 
   x_gc:=XCreateGC(x_display ,x_window ,0 ,0 ); 
2381
 
 
2382
 
   draw_text;
2383
 
   XResizeWindow(x_display ,x_window ,x_dx + 20 ,x_dy + 40 );
2384
 
 
2385
 
   x_hints:=XAllocSizeHints;
2386
 
 
2387
 
   if x_hints <> NIL then
2388
 
    begin
2389
 
     x_hints.min_width :=x_dx + 20;
2390
 
     x_hints.min_height:=x_dy + 40;
2391
 
     x_hints.max_width :=x_dx + 20;
2392
 
     x_hints.max_height:=x_dy + 40;
2393
 
 
2394
 
     x_hints.flags:=PMaxSize or PMinSize;
2395
 
 
2396
 
     XSetWMNormalHints(x_display ,x_window ,x_hints );
2397
 
     XFree            (x_hints );
2398
 
 
2399
 
    end;
2400
 
 
2401
 
   x_tp.value   :=PCUChar(@capt[1 ] );
2402
 
   x_tp.encoding:=XA_WM_NAME;
2403
 
   x_tp.format  :=8;
2404
 
   x_tp.nitems  :=strlen(capt );
2405
 
 
2406
 
   XSetWMName    (x_display ,x_window ,@x_tp );
2407
 
   XStoreName    (x_display ,x_window ,capt );
2408
 
   XSetIconName  (x_display ,x_window ,capt );
2409
 
   XSetWMIconName(x_display ,x_window ,@x_tp );
2410
 
 
2411
 
   XMapWindow  (x_display ,x_window );
2412
 
   XSelectInput(x_display ,x_window ,x_event_mask );
2413
 
 
2414
 
   x_close:=
2415
 
    XInternAtom(x_display ,'WM_DELETE_WINDOW' ,false );
2416
 
 
2417
 
   XSetWMProtocols(
2418
 
    x_display ,
2419
 
    x_window ,
2420
 
    @x_close ,1 );
2421
 
 
2422
 
   XFlush(x_display );
2423
 
 
2424
 
   repeat
2425
 
    XNextEvent(x_display ,@x_event );
2426
 
 
2427
 
    XFlush(x_display );
2428
 
    XSync (x_display ,true );
2429
 
 
2430
 
    case x_event._type of
2431
 
     Expose :
2432
 
      draw_text;
2433
 
 
2434
 
     KeyPress :
2435
 
      break;
2436
 
 
2437
 
     ClientMessage :
2438
 
      if (x_event.xclient.format = 32 ) and
2439
 
         (x_event.xclient.data.l[0 ] = int(x_close ) ) then
2440
 
       break;
2441
 
 
2442
 
    end;
2443
 
 
2444
 
 
2445
 
   until false;
2446
 
 
2447
 
   while XPending(x_display ) > 0 do
2448
 
    begin
2449
 
     XNextEvent(x_display ,@x_event );
2450
 
 
2451
 
     XFlush(x_display );
2452
 
     XSync (x_display ,true );
2453
 
 
2454
 
    end;
2455
 
 
2456
 
   XFreeGC       (x_display ,x_gc );
2457
 
   XDestroyWindow(x_display ,x_window );
2458
 
   XCloseDisplay (x_display );
2459
 
 
2460
 
  end
2461
 
 else
2462
 
  writeln(stderr ,msg );
2463
 
 
2464
 
end;
2465
 
 
2466
 
{ START_TIMER }
2467
 
procedure platform_support.start_timer;
2468
 
begin
2469
 
 m_specific.m_sw_start:=clock;
2470
 
 
2471
 
end;
2472
 
 
2473
 
{ ELAPSED_TIME }
2474
 
function platform_support.elapsed_time;
2475
 
var
2476
 
 stop : clock_t;
2477
 
 
2478
 
begin
2479
 
 stop:=clock;
2480
 
 
2481
 
 result:=(stop - m_specific.m_sw_start ) * 1000.0 / CLOCKS_PER_SEC;
2482
 
 
2483
 
end;
2484
 
 
2485
 
{ FULL_FILE_NAME }
2486
 
function platform_support.full_file_name;
2487
 
begin
2488
 
 result:=file_name;
2489
 
 
2490
 
end;
2491
 
 
2492
 
{ FILE_SOURCE }
2493
 
function platform_support.file_source;
2494
 
var
2495
 
 f : file;
2496
 
 e : integer;
2497
 
 
2498
 
begin
2499
 
 result:=fname;
2500
 
 
2501
 
 e:=ioresult;
2502
 
 
2503
 
 AssignFile(f ,result );
2504
 
 reset     (f ,1 );
2505
 
 
2506
 
 if ioresult <> 0 then
2507
 
  result:=path + '/' + fname;
2508
 
 
2509
 
 close(f );
2510
 
 
2511
 
 e:=ioresult;
2512
 
 
2513
 
end;
2514
 
 
2515
 
END.
2516