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