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