Moduł X11::Protocol

Uniwersytet Gdański - Instytut Matematyki - Zakład Informatyki - Strona domowa

Spis treści

Co to jest
Download
Instalacja
Konstruktor
Podstawowe metody
Stałe symboliczne
Informacje serwera
Żądania
Zdarzenia
Rozszerzenia
Przykłady
Dodatkowe informacje

Obsługa modułu X11::Protocol

Co to jest

X Window System – graficzny system komputerowy (system okienkowy) stworzony w latach 80. w laboratoriach Massachusetts Institute of Technology (MIT). System ten jest odpowiedzialny za tworzenie okien, w których program może tworzyć obraz oraz zajmuje się obsługą urządzeń wejściowych takich jak myszka, klawiatura, tablet. Serwer X może rysować tylko najprostsze obiekty (odcinki, wielokąty, elipsy, wyświetlać bitmapy, stawiać pojedyncze piksele), nie dostarcza natomiast żadnego interfejsu użytkownika. Rysowaniem oraz obsługą różnego rodzaju przycisków, pasków przewijania musi się zająć program. Tutaj z pomocą przychodzi nam moduł X11::Protocol autorstwa Stephena McCamant'a. Moduł ten pozwala programom perlowym na wyświetlanie okienek i wszelkiego rodzaju grafiki na serwerach X11.

Download

Pakiet możemy pobrać z CPANu

Instalacja w systemie UNIX'owym

Po rozpakowaniu modułu wydajemy polecenie

perl Makefile.PL make make install

Sprawdzamy, czy został on pomyślnie zainstalowany, pisząc jednolinijkowca perl -e 'use X11::Protocol' Pomyślne wykonanie programu (żadnych komunikatów) daje nadzieję, że moduł został zainstalowany poprawnie i będzie działał. Jeżeli wszystko poszło zgodnie z planem to możemy już korzystać z możliwości naszego nowego modułu.

Konstruktor

$x = X11::Protocol->new();
$x = X11::Protocol->new($display_name);
$x = X11::Protocol->new($connection);
$x = X11::Protocol->new($display_name, [$auth_type, $auth_data]);
$x = X11::Protocol->new($connection, [$auth_type, $auth_data]);

Otwiera połączenie z serwerem. Jeżeli nie podamy żadnych argumentów, to zostanie użyta zmienna środowiskowa wyświetlania. Dane potrzebne do autoryzacji zą pozyskiwane z X11::Auth lub z drugiego argumentu. Zwracany jest nowy obiekt protokołu.

Podstawowe metody

new_rsrc: Zwraca nowy identyfikator zasobu. Unikalny identyfikator jest wymagany dla każdego obiektu tworzonego przez server. Warto zauważyć, że całkowita liczba dostępnych identyfikatorów jest duża, ale skończona. Po rozpoczęciu połączenia identyfikatory zasobu są umieszczane sekwencyjnie w obszarze zależnym od serwera (limit około miliona). Jeżeli limit jest osiągnięty, a serwer nie obsługuje rozszerzenia XC_MISC, kolejne odwołania do new_rsrc nie powiodą się. Jeżeli serwer obsługuje rozszerzenie, to moduł będzie żądał nowego zasobu wolnych identyfikatorów. Powinno to pozwolić programowi na kontynuację, jednak nie jest zalecane.$x->new_rsrc;
handle_input: Pobiera blok informacji z serwera. Jeżeli wystąpi błąd, to należy go obsłużyć, używając obiektowego uchwytu error_handler, który domyślnie "zabija" program z objaśniającą wiadomością. Jeżeli wystąpiło zdarzenie, należy je przenieść do wybranego uchwytu lub umieścić je w kolejce. Jeżeli zdarzenie jest odpowiedzią na żądanie, należy zapisać je do dalszego użycia, używając hasza.$x->handle_input;
atom_name: Zwraca string nawiązujący do atomu $atom. Jest to podobne do żądania GetAtomName, ale dla wydajności cach'uje wynik.$name = $x->atom_name($atom);
atom: Odwrotna operacja, zwraca numeryczny atom nawiązujący do $name. Jest to podobne do żądania InternAtom, również cach'uje wynik.$atom = $x->atom($name);
choose_screen: Wskazuje, że chcemy używać szczególnego ekranu wyświetlania. $x->choose_screen($screen_num);
Dla ekranu wyświetlania informacje takie jak root, width_in_pixels, white_pixel będą dostępne jako $x->{'root'};
zamiast
$x->{'screens'}[$screen_num]{'root'};

Stałe symboliczne

Ogólnie stałe symboliczne używane przez protokół takie jak CopyFromParent lub PieSlice, są przekazywane do metod jako string, następnie konwertowane przez moduł na liczby. Ich nazwy są takie same jak w specyfikacji modułu, jeżeli z jakiegoś powodu chcemy własnoręcznie dokonać konwersji, mamy do dyspozycji następujące metody

num: Podany jest string reprezentujący stałą oraz string określający jakiego typu jest ta stała. Zwracany zostaje odpowiedni numer. $type powinien być nazwą taką jak VisualClass lub GCLineStyle. Jeżeli nazwa jest nierozpoznana, zwracany jest niezmieniony string.$num = $x->num($type, $str);
interp: Odwrotna operacja do poprzedniej, podawany jest numer i string określający typ, zwracany jest string reprezentujący stałą.

$name = $x->interp($type, $num);
Możemy wyłączyć interp() i zarazem wewnętrzną interpretację numerów, ustawiając $x->{'do_interp'} na zero. Oczywiście nie jest to użyteczne dopóki nie mamy własnych definicji dla wszystkich stałych. Oto lista dostępnych typów stałych:
AccessMode, AllowEventsMode, AutoRepeatMode, BackingStore, BitGravity, Bool, ChangePropertyMode, CirculateDirection, CirculatePlace, Class, ClipRectangleOrdering, CloseDownMode, ColormapNotifyState, CoordinateMode, CrossingNotifyDetail, CrossingNotifyMode, DeviceEvent, DrawDirection, Error, EventMask, Events, FocusDetail, FocusMode, GCArcMode, GCCapStyle, GCFillRule, GCFillStyle, GCFunction, GCJoinStyle, GCLineStyle, GCSubwindowMode, GrabStatus, HostChangeMode, HostFamily, ImageFormat, InputFocusRevertTo, KeyMask, LedMode, MapState, MappingChangeStatus, MappingNotifyRequest, PointerEvent, PolyShape, PropertyNotifyState, Request, ScreenSaver, ScreenSaverAction, Significance, SizeClass, StackMode, SyncMode, VisibilityState, VisualClass, WinGravity

Dostępne informacje serwera

W momencie połączenia serwer wysyła do klienta dużą ilość informacji o sobie. Te informacje są przechowywane w obiekcie protokołu do którego możemy się odwołać w następujący sposób

$x->{'release_number'}: Oto przykład jak takie informacje mogą wyglądać

'connection' => X11::Connection::UNIXSocket(0x814526fd), 'byte_order' => 'l', 'protocol_major_version' => 11, 'protocol_minor_version' => 0, 'authorization_protocol_name' => 'MIT-MAGIC-COOKIE-1', 'release_number' => 3110, 'resource_id_base' => 0x1c000002, 'motion_buffer_size' => 0, 'maximum_request_length' => 65535, # units of 4 bytes 'image_byte_order' => 'LeastSiginificant', 'bitmap_bit_order' => 'LeastSiginificant', 'bitmap_scanline_unit' => 32, 'bitmap_scanline_pad' => 32, 'min_keycode' => 8, 'max_keycode' => 134, 'vendor' => 'The XFree86 Project, Inc', 'pixmap_formats' => { 1 => { 'bits_per_pixel' => 1, 'scanline_pad' => 32 }, 8 => { 'bits_per_pixel' => 8, 'scanline_pad' => 32}}, 'screens' => [ { 'root' => 43, 'width_in_pixels' => 800, 'height_in_pixels' => 600, 'width_in_millimeters' => 271, 'height_in_millimeters' => 203, 'root_depth' => 8, 'root_visual' => 34, 'default_colormap' => 33, 'white_pixel' => 0, 'black_pixel' => 1, 'min_installed_maps' => 1, 'max_installed_maps' => 1, 'backing_stores' => 'Always', 'save_unders' => 1, 'current_input_masks' => 0x58003d, 'allowed_depths' => [ { 'depth' => 1, 'visuals' => [ ] }, { 'depth' => 8, 'visuals' => [ { 'visual_id' => 34, 'blue_mask' => 0, 'green_mask' => 0, 'red_mask' => 0, 'class' => 'PseudoColor', 'bits_per_rgb_value' => 6, 'colormap_entries' => 256 }, { 'visual_id' => 35, 'blue_mask' => 0xc0, 'green_mask' => 0x38, 'red_mask' => 0x7, 'class' => 'DirectColor', 'bits_per_rgb_value' => 6, 'colormap_entries' => 8}, ... ] } ] ], 'visuals' => { 34 => { 'depth' => 8, 'class' => 'PseudoColor', 'red_mask' => 0, 'green_mask' => 0, 'blue_mask'=> 0, 'bits_per_rgb_value' => 6, 'colormap_entries' => 256 }, 35 => { 'depth' => 8, 'class' => 'DirectColor', 'red_mask' => 0x7, 'green_mask' => 0x38, 'blue_mask'=> 0xc0, 'bits_per_rgb_value' => 6, 'colormap_entries' => 8 }, ... } 'error_handler' => &\X11::Protocol::default_error_handler, 'event_handler' => sub { }, 'do_interp' => 1

Żądania

request: Wysyła żądanie do serwera i otrzymuje odpowiedź jeżeli takowa jest.$x->request('CreateWindow', ...); $x->req('CreateWindow', ...); $x->CreateWindow(...);
robust_req: Jak request(), ale jeżeli serwer zwróci błąd, zwraca informację o błędzie. Jeżeli żądanie się powiedzie zwraca tablicę referencji zawierającą informacje o żądaniu.$x->robust_req('CreateWindow', ...);
add_reply: Dodaje wycinek oczekiwanego żądania do hasza przechowującego żądania obiektu. Kiedy nadejdzie numer żądania $sequence_num zostanie on przechowany w $var.$x->add_reply($sequence_num, \$var);
delete_reply: Usuwa żądanie o podanym numerze (powinno odbywać się po odebraniu żądania). $x->delete_reply($sequence_num);
send: Wysyła żądanie, ale nie czeka na odpowiedź. Musimy obsłużyć żądanie używając add_reply(), handle_input(), delete_reply() i unpack_reply() $x->send('CreateWindow', ...);
unpack_reply: Interpretuje wiersz danych $data żądania, zgodnie z formatem danego żądania. Zwraca dane w tym samym formacie, co request($request_name, ...) $x->unpack_reply('GetWindowAttributes', $data);

Zdarzenia

Aby odbierać zdarzenia, najpierw należy ustawić atrybut 'event_mask' na oknie, aby wskazać jakiego typu zdarzeń żądamy (patrz "pack_event_mask"). Następnie ustawiamy obiektowy 'uchwyt zdarzeń' na referencję do funkcji, która będzie obsługiwać zdarzenie. Alternatywnie możemy ustawić uchwyt na 'kolejkę' i pobierać zdarzenia używając dequeue_event() lub next_event(). W obu przypadkach zdarzenia są zwracane jako hasz. Typowe zdarzenie MotionNotify może wyglądać tak

 %event = ('name' => 'MotionNotify', 'sequence_number' => 12,
 'state' => 0, 'event' => 58720256, 'root' => 43,
 'child' => None, 'same_screen' => 1, 'time' => 966080746,
 'detail' => 'Normal', 'event_x' => 10, 'event_y' => 3,
 'code' => 6, 'root_x' => 319, 'root_y' => 235)

pack_event_mask: $mask = $x->pack_event_mask('ButtonPress', 'KeyPress', 'Exposure');
unpack_event_mask: Odwrotna operacja do poprzedniej, przekształca maskę zdarzenia, otrzymaną z serwera w listę nazw kategorii zdarzenia. @event_types = $x->unpack_event_mask($mask);
dequeue_event: Zwraca zdarzenie, jeżeli jakieś oczekuje w kolejce.%event = $x->dequeue_event;
next_event: Podobnie jak Xlib's XNextEvent()%event = $x->next_event;Ta funkcja jest analogiczna do $x->handle_input until %event = dequeue_event;
pack_event: Daje zdarzenie w formnie hasza, następnie umieszcza go w stringu. Jest to użyteczne jako argument SendEvent() $data = $x->pack_event(%event);
unpack_event: Odwrotna operacja do poprzedniej, daje wiersz danych zdarzenia (32b), następnie umieszcza go w formie hasza. Zazwyczaj jest to robione automatycznie. %event = $x->unpack_event($data);

Rozszerzenia

Protokół rozszerzeń dodaje nowe żądania, typy zdarzeń, typy błędów do protokołu. Wsparcie dla nich jest oddzielone w moduły hierarchii X11::Protocol::Ext::. W następujący sposób możemy stwierdzić, czy moduł załadował rozszerzenie

$x->{'ext'}{$extension_name}
Jeżeli rozszerzenie zostało zainicjalizowane, ta wartość będzie referencją do tablicy [$major_request_number, $first_event_number, $first_error_number, $obj], gdzie $obj jest obiektem zawierającym prywatne informacje rozszerzenia.

init_extension: Inicjalizuje rozszerzenie, pyta serwer o numer żądania rozszerzenia, następnie ładuje odpowiedni moduł. Zwraca 0 jeżeli serwer nie obsługuje danego rozszerzenia.$x->init_extension($name);
init_extensions: Inicjalizuje rozszerzenia protokołu. Wysyła żądanie ListExtensions, następnie używa init_extension() dla każdego rozszerzenia, które obsługuje serwer.$x->init_extensions;

Przykłady

Pierwszym naszym programem będzie bardzo prosta rzecz, mianowicie narysowanie pionowej czarnej lini na zielonym tle.

Program realizujący to zadanie wygląda następująco

#!/usr/bin/perl

use X11::Protocol;

use X11::Protocol::Constants qw(InputOutput CopyFromParent Replace Exposure_m);

use IO::Select;
use strict;

#Rozmiar głównego okna
my $rozm_okna = 500;

#Rozmiar naszej lini
my $szerokosc_paska = 20;
my $wysokosc_paska = 300;

#Konstruktor
my $X = X11::Protocol->new;

#Nowy identyfikator zasobu
my $main_win = $X->new_rsrc;

#Tworzymy główne okienko
$X->CreateWindow($main_win, $X->root, InputOutput, CopyFromParent,
     CopyFromParent, (0,0), $rozm_okna, $rozm_okna, 0,
     'background_pixel' => 60000);

#Ustawiamy nazwę dla okna
$X->ChangeProperty($main_win, $X->atom('WM_NAME'), $X->atom('STRING'), 8,
                   Replace, "Pierwszy program -- pionowa kreska");

#Nowy identyfikator zasobu
my $font = $X->new_rsrc;

$X->OpenFont($font, "fixed");
$X->MapWindow($main_win);

#Uchwyt do połączenia
my $fds = IO::Select->new($X->connection->fh);

#Pętla
for (;;) {

    while ($fds->can_read(0)) {
  $X->handle_input;
    }

    #Położenie paska
    my $x=220;
    my $y=100;

    #Nowy identyfikator zasobu
    my $win = $X->new_rsrc;

    #Tworzymy całe okienko
    $X->CreateWindow($win, $main_win, InputOutput, CopyFromParent,
      CopyFromParent, ($x, $y), $szerokosc_paska, $wysokosc_paska,
      1, 'background_pixel' => 1,
      'event_mask' => Exposure_m);
    $X->MapWindow($win);

}

Wynik wykonania naszego programu

Pionowa kreska

Drugim przykładowym programem może być okienko ze zmieniającym się, różnokolorowym tłem oraz tekstem na środku.

Program realizujący to zadanie wygląda następująco

#!/usr/bin/perl

use X11::Protocol;
use X11::Protocol::Constants qw(InputOutput CopyFromParent Replace Exposure_m);

use IO::Select;
use strict;

#Rozmiar głównego okna
my $rozm_okna = 500;

#Rozmiar naszego tła
my $szer_obraz = 500;
my $wys_obraz= 500;

#Konstruktor
my $X = X11::Protocol->new;

my $cmap = $X->default_colormap;

#Nowy identyfikator zasobu
my $main_win = $X->new_rsrc;

#Tworzymy główne okno
$X->CreateWindow($main_win, $X->root, InputOutput, CopyFromParent,
     CopyFromParent, (0, 0), $rozm_okna, $rozm_okna, 0);

#Ustawiamy tytuł okna
$X->ChangeProperty($main_win, $X->atom('WM_NAME'), $X->atom('STRING'), 8,
                   Replace, "Drugi program -- roznokolorowe okieno");

#Nowy indentyfikator zasobu
my $text_gc = $X->new_rsrc;
my($text_pixel,) = $X->AllocColor($cmap, (0x0000, 0x0000, 0x0000));

#Nowy indentyfikator zasobu
my $font = $X->new_rsrc;
$X->OpenFont($font, "fixed");
$X->CreateGC($text_gc, $main_win, 'foreground' => $text_pixel,
       'font' => $font);

$X->MapWindow($main_win);

#Uchwyt do połączenia
my $fds = IO::Select->new($X->connection->fh);

#Funkcja dodajaca napis
sub label {
    my($win) = @_;
    $X->PolyText8($win, $text_gc, 170, 250,[0, sprintf("ROZNOKOLOROWE OKIENKO :P", $win)]);
}

#Pętla
for (;;) {

    while ($fds->can_read(0)) {
  $X->handle_input;
    }


    #Losowy kolor tła
    my($rand_pixel,) =$X->AllocColor($cmap, (rand(65536), rand(65535), rand(65535)));
    my $rand_pixel = rand(2**32);

    #Nowy indentyfikator zasobu
    my $win = $X->new_rsrc;

    #Tworzymy okno z tłem
    $X->CreateWindow($win, $main_win, InputOutput, CopyFromParent,
         CopyFromParent, (0, 0), $szer_obraz, $wys_obraz,
         1, 'background_pixel' => $rand_pixel,
         'event_mask' => Exposure_m);

    $X->MapWindow($win);

    label($win);
}

Wynik działania naszego programu (oglądanie nie jest zalecane dla osób z epilepsją ;P)

Różnokolorowe okienko

UWAGA ! Tylko dla ludzi o mocnych nerwach

Ostatnim programem wykorzystującym możliwości modułu będzie program, który jest bezpośrednio zawarty w pakiecie z naszym modułem. Mianowicie jest nim wyrenderowany zegarek, pokazujący godzinę w czasie rzeczywistym. Oto kod programu, który może niektórych przyprawić o zawrót głowy.

#!/usr/bin/perl use strict; use X11::Protocol; use IO::Select; use Time::HiRes 'gettimeofday'; sub min { $_[0] <= $_[1] ? $_[0] : $_[1] } sub max { $_[0] >= $_[1] ? $_[0] : $_[1] } my $X = new X11::Protocol; $X->init_extension("RENDER") or die "The Render extension is required"; my($rgba32, $screen_fmt); my($formats, $screens,) = $X->RenderQueryPictFormats(); for my $f (@$formats) { $rgba32 = $f->[0] if $f->[2] == 32 and $f->[3] == 16 and $f->[5] == 8 and $f->[7] == 0 and $f->[9] == 24; } for my $s (@$screens) { my @s = @$s; shift @s; for my $d (@s) { my @d = @$d; next unless shift(@d) == $X->root_depth; for my $v (@d) { if ($v->[0] == $X->root_visual) { $screen_fmt = $v->[1]; } } } } my $size = 70; my($width_fact, $radius, $tick_size, $depth); use constant PI => 4*atan2(1,1); sub tri_to_traps { my($x1, $y1, $x2, $y2, $x3, $y3) = @_; my @points = ([$x1, $y1], [$x2, $y2], [$x3, $y3]); @points = sort {$a->[1] <=> $b->[1]} @points; ($x1, $y1, $x2, $y2, $x3, $y3) = (@{$points[0]}, @{$points[1]}, @{$points[2]}); my($trap1, $trap2); if (($x2-$x1)*($y3-$y1) < ($x3-$x1)*($y2-$y1)) { $trap1 = [$y1, $y2, ($x1, $y1), ($x2, $y2), ($x1, $y1), ($x3, $y3)]; $trap2 = [$y2, $y3, ($x2, $y2), ($x3, $y3), ($x1, $y1), ($x3, $y3)]; } else { $trap1 = [$y1, $y2, ($x1, $y1), ($x3, $y3), ($x1, $y1), ($x2, $y2)], $trap2 = [$y2, $y3, ($x1, $y1), ($x3, $y3), ($x2, $y2), ($x3, $y3)]; } return ($trap1, $trap2); } sub render_tri { my($op, $src_pict, $src_x, $src_y, $dst_pict, $mask, $tri) = @_; my($trap1, $trap2) = tri_to_traps(@$tri); $X->RenderTrapezoids($op, $src_pict, $src_x, $src_y, $dst_pict, $mask, $trap1, $trap2); # $X->RenderTriangles($op, $src_pict, $src_x, $src_y, $dst_pict, $mask, # $tri); } sub render_quad { my($op, $src_pict, $src_x, $src_y, $dst_pict, $mask, @points) = @_; render_tri($op, $src_pict, $src_x, $src_y, $dst_pict, $mask, [@points[0,1, 2,3, 4,5]]); render_tri($op, $src_pict, $src_x, $src_y, $dst_pict, $mask, [@points[0,1, 4,5, 6,7]]); } sub polar2rect { my($r, $theta) = @_; my $x = $size/2 + $r * sin($theta); my $y = $size/2 - $r * cos($theta); return ($x, $y); } my $win = $X->new_rsrc; $X->CreateWindow($win, $X->root, 'InputOutput', $X->root_depth, 'CopyFromParent', (0, 0), $size, $size, 0, 'background_pixel' => $X->white_pixel, 'event_mask' => $X->pack_event_mask('Exposure', 'KeyPress', 'ButtonRelease', 'StructureNotify')); $X->ChangeProperty($win, $X->atom('WM_ICON_NAME'), $X->atom('STRING'), 8, 'Replace', "render-clock"); $X->ChangeProperty($win, $X->atom('WM_NAME'), $X->atom('STRING'), 8, 'Replace', "Rendered Clock"); $X->ChangeProperty($win, $X->atom('WM_NORMAL_HINTS'), $X->atom('WM_SIZE_HINTS'), 32, 'Replace', pack("Lx40llllx12", 128, 1, 1, 1, 1)); $X->ChangeProperty($win, $X->atom('WM_HINTS'), $X->atom('WM_HINTS'), 32, 'Replace', pack("IIIx24", 1|2, 1, 1)); my $delete_atom = $X->atom('WM_DELETE_WINDOW'); $X->ChangeProperty($win, $X->atom('WM_PROTOCOLS'), $X->atom('ATOM'), 32, 'Replace', pack("L", $delete_atom)); my $progname = $0; $progname =~ s[^.*/][]; $progname = $ENV{'RESOURCE_NAME'} || $progname; $X->ChangeProperty($win, $X->atom('WM_CLASS'), $X->atom('STRING'), 8, 'Replace', "$progname\0Render-clock"); my($tick_color, $minute_color, $hour_color, $second_color); # Red Green Blue Opacity # $tick_color = [0, 0, 0, 0xffff]; # $minute_color = [0xffff,0, 0, 0x8000]; # $hour_color = [0, 0xffff,0, 0x8000]; # $second_color = [0, 0, 0xffff,0x8000]; # # Red Green Blue Opacity # $tick_color = [0, 0, 0, 0xffff]; # $minute_color = [0, 0, 0, 0x8000]; # $hour_color = [0, 0, 0, 0x8000]; # $second_color = [0, 0, 0, 0x8000]; # # Red Green Blue Opacity # $tick_color = [0, 0, 0, 0xffff]; # $minute_color = [0, 0, 0x4fff,0x8000]; # $hour_color = [0, 0, 0x4fff,0x8000]; # $second_color = [0, 0, 0x4fff,0x8000]; # Red Green Blue Opacity $tick_color = [0, 0, 0, 0xffff]; $minute_color = [0xffff,0, 0, 0x8000]; $hour_color = [0, 0x4fff,0, 0x8000]; $second_color = [0, 0, 0x4fff,0x8000]; my($face_pixmap, $face_pict); my $black_pixmap = $X->new_rsrc; $X->CreatePixmap($black_pixmap, $win, 32, 1, 1); my $black_pict = $X->new_rsrc; $X->RenderCreatePicture($black_pict, $black_pixmap, $rgba32, 'repeat' => 1); $X->RenderFillRectangles('Src', $black_pict, $tick_color, [0, 0, 1, 1]); my $red_pixmap = $X->new_rsrc; $X->CreatePixmap($red_pixmap, $win, 32, 1, 1); my $red_pict = $X->new_rsrc; $X->RenderCreatePicture($red_pict, $red_pixmap, $rgba32, 'repeat' => 1); $X->RenderFillRectangles('Src', $red_pict, $minute_color, [0, 0, 1, 1]); my $green_pixmap = $X->new_rsrc; $X->CreatePixmap($green_pixmap, $win, 32, 1, 1); my $green_pict = $X->new_rsrc; $X->RenderCreatePicture($green_pict, $green_pixmap, $rgba32, 'repeat' => 1); $X->RenderFillRectangles('Src', $green_pict, $hour_color, [0, 0, 1, 1]); my $blue_pixmap = $X->new_rsrc; $X->CreatePixmap($blue_pixmap, $win, 32, 1, 1); my $blue_pict = $X->new_rsrc; $X->RenderCreatePicture($blue_pict, $blue_pixmap, $rgba32, 'repeat' => 1); $X->RenderFillRectangles('Src', $blue_pict, $second_color, [0, 0, 1, 1]); my $hilite_pixmap = $X->new_rsrc; $X->CreatePixmap($hilite_pixmap, $win, 32, 1, 1); my $hilite_pict = $X->new_rsrc; $X->RenderCreatePicture($hilite_pict, $hilite_pixmap, $rgba32, 'repeat' => 1); my($buffer_pixmap, $buffer_pict); sub setup_face { $width_fact = 2; $radius = 0.475 * $size; $tick_size = $size / 10; $depth = $size / 150; if ($face_pixmap) { $X->FreePixmap($face_pixmap); $X->RenderFreePicture($face_pict); } else { $face_pixmap = $X->new_rsrc; $face_pict = $X->new_rsrc; } $X->CreatePixmap($face_pixmap, $win, 32, $size, $size); $X->RenderCreatePicture($face_pict, $face_pixmap, $rgba32, 'poly_edge' => 'Smooth', 'poly_mode' => 'Precise'); $X->RenderFillRectangles('Src', $face_pict, [0xefff,0xefff,0xefff,0xffff], [0, 0, $size, $size]); for my $tick (0 .. 59) { my $theta = $tick/30 * PI; my $size_outer = 0.01; my $inner_rad; if ($tick % 5) { $inner_rad = $radius - $tick_size/2; } else { $inner_rad = $radius - $tick_size; } my $size_inner = $size_outer * ($radius/$inner_rad); my($x1, $y1) = polar2rect($radius, $theta - $size_outer); my($x2, $y2) = polar2rect($radius, $theta + $size_outer); my($x3, $y3) = polar2rect($inner_rad, $theta + $size_inner); my($x4, $y4) = polar2rect($inner_rad, $theta - $size_inner); render_quad('Over', $black_pict, $size, $size, $face_pict, 'None', ($x1, $y1), ($x2, $y2), ($x3, $y3), ($x4, $y4)); } #$X->RenderFillRectangles('Over', $face_pict, [0,0,0,0xffff], # [$size/2-5, $size/2-5, 10, 10]); if ($buffer_pixmap) { $X->FreePixmap($buffer_pixmap); $X->RenderFreePicture($buffer_pict); } else { $buffer_pixmap = $X->new_rsrc; $buffer_pict = $X->new_rsrc; } $X->CreatePixmap($buffer_pixmap, $win, $X->root_depth, $size, $size); $X->RenderCreatePicture($buffer_pict, $buffer_pixmap, $screen_fmt, 'poly_edge' => 'Smooth', 'poly_mode' => 'Precise'); } setup_face(); my $copy_gc = $X->new_rsrc; $X->CreateGC($copy_gc, $win); $X->MapWindow($win); sub draw_hand { my($pict, $x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4) = @_; my @p = ([$x1, $y1], [$x2, $y2], [$x3, $y3], [$x4, $y4]); my @ip; $#ip = $#p; for my $j (-2 .. $#p - 2) { my($ix, $iy) = ($p[$j+1][0] - $p[$j][0], $p[$j+1][1] - $p[$j][1]); my($ox, $oy) = ($p[$j+2][0] - $p[$j+1][0], $p[$j+2][1] - $p[$j+1][1]); if ($ix*$oy > $iy*$ox) { $ix = -$ix; $iy = -$iy; } else { $ox = -$ox; $oy = -$oy; } my($in) = sqrt($ix*$ix + $iy*$iy); $ix /= $in; $iy /= $in; my($on) = sqrt($ox*$ox + $oy*$oy); $ox /= $on; $oy /= $on; my($mx, $my) = (($ix + $ox)/2, ($iy + $oy)/2); my($mn) = max(abs($mx), abs($my)); $mx /= $mn; $my /= $mn; $ip[$j+1][0] = $p[$j+1][0] + $depth * $mx; $ip[$j+1][1] = $p[$j+1][1] + $depth * $my; } render_quad('Over', $pict, $size, $size, $buffer_pict, 'None', ($x1, $y1), ($x2, $y2), ($x3, $y3), ($x4, $y4)); for my $j (-1 .. $#p - 1) { my $angle = atan2($p[$j+1][1]-$p[$j][1], $p[$j+1][0]-$p[$j][0]); my $gray = 0x8000 + 0x4000 * sin($angle + 3*PI / 4); my $alpha = 0.5; $X->RenderFillRectangles('Src', $hilite_pict, [$gray, $gray, $gray, $alpha*0xffff], [0, 0, 1, 1]); render_quad('Over', $hilite_pict, $size, $size, $buffer_pict, 'None', @{$p[$j]}, @{$ip[$j]}, @{$ip[$j + 1]}, @{$p[$j + 1]}); } } sub draw { $X->RenderFillRectangles('Src', $buffer_pict, [0xffff, 0xffff, 0xffff, 0xffff], [0, 0, $size, $size]); $X->RenderComposite('Over', $face_pict, 'None', $buffer_pict, 0, 0, 0, 0, 0, 0, $size, $size); my($unix_time, $microsec) = gettimeofday(); my($sec, $min, $hour) = localtime($unix_time); $sec += $microsec / 1_000_000; { my $hour_theta = ($hour % 12 + $min/60 + $sec/3600)/6 * PI; my $hour_size_outer = 0.04 * $width_fact; my $hour_size_inner = $hour_size_outer * (.6/.3) * 1.4; my($x1, $y1) = polar2rect(.6*$radius, $hour_theta - $hour_size_outer); my($x2, $y2) = polar2rect(.6*$radius, $hour_theta + $hour_size_outer); my($x3, $y3) = polar2rect(-.3*$radius, $hour_theta - $hour_size_inner); my($x4, $y4) = polar2rect(-.3*$radius, $hour_theta + $hour_size_inner); draw_hand($green_pict, ($x1, $y1), ($x2, $y2), ($x3, $y3), ($x4, $y4)); } { my $min_theta = ($min + $sec/60)/30 * PI; my $min_size_outer = 0.02 * $width_fact; my $min_size_inner = $min_size_outer * (.8/.2) * 1.3; my($x1, $y1) = polar2rect(.8*$radius, $min_theta - $min_size_outer); my($x2, $y2) = polar2rect(.8*$radius, $min_theta + $min_size_outer); my($x3, $y3) = polar2rect(-.2*$radius, $min_theta - $min_size_inner); my($x4, $y4) = polar2rect(-.2*$radius, $min_theta + $min_size_inner); draw_hand($red_pict, ($x1, $y1), ($x2, $y2), ($x3, $y3), ($x4, $y4)); } { my $sec_theta = $sec/30 * PI; my $sec_size_outer = 0.01 * $width_fact; my $sec_size_inner = $sec_size_outer * (.95/.15) * 1.3; my($x1, $y1) = polar2rect(.95*$radius, $sec_theta - $sec_size_outer); my($x2, $y2) = polar2rect(.95*$radius, $sec_theta + $sec_size_outer); my($x3, $y3) = polar2rect(-.15*$radius, $sec_theta - $sec_size_inner); my($x4, $y4) = polar2rect(-.15*$radius, $sec_theta + $sec_size_inner); draw_hand($blue_pict, ($x1, $y1), ($x2, $y2), ($x3, $y3), ($x4, $y4)); } $X->CopyArea($buffer_pixmap, $win, $copy_gc, 0, 0, $size, $size, 0, 0); } $X->event_handler('queue'); my $fds = IO::Select->new($X->connection->fh); my $start_time = time; my $sample_time = Time::HiRes::time; my $frames = 0; my $delay = 0.00001; for (;;) { $X->flush(); $X->GetScreenSaver(); # AKA XSync() #$X->handle_input if $fds->can_read(0); Time::HiRes::sleep(0.01 + $delay); my %e; while (%e = $X->dequeue_event) { if ($e{'name'} eq "Expose") { draw(); } elsif ($e{'name'} eq "ButtonRelease" or $e{'name'} eq "KeyPress") { exit; } elsif ($e{'name'} eq "ConfigureNotify") { my($w, $h) = @e{'width', 'height'}; $size = min($w, $h); setup_face(); $frames = 0; $start_time = time; $sample_time = Time::HiRes::time; } elsif ($e{'name'} eq "ClientMessage" and unpack("L", $e{'data'}) == $delete_atom) { exit; } } draw(); $frames++; if (!($frames % 20)) { my $fps = $frames/(Time::HiRes::time-$sample_time); #print "$fps FPS delay $delay\n"; if ($fps > 30) { $delay = 0.75 * $delay + 0.25 * ($delay + 1/30 - 1/$fps); } elsif ($fps < 30) { $delay = 0.75 * $delay; } } }

A oto wynik naszego programu

Rendered Clock

Dodatkowe informacje

Opisałem tutaj tylko wybrane elementy tego modułu, jest on o wiele bardziej złożony i posiada duże możliwości, a cała specyfikacja zapewnia wiele godzin lektury. Może być z powodzeniem stosowany do wszelkiego rodzaju grafiki, czy animacji związajej z X11. Po bardziej szczegółowe informacje odsyłam na strone z dokumentacją.

Macierzysta strona dokumentacji do modułu http://search.cpan.org/~smccam/X11-Protocol-0.56/Protocol.pm

Autor opracowania

Adrian Sielski

Email: adrian.sielski@gmail.com

Uniwersytet Gdański - Instytut Informatyki - Strona domowa - Perl - Wyklady

[c] Piotr Arłukowicz, materiały z tej strony udostępnione są na licencji GNU.