tests/perl/xmessage.fpl

   1 # Usage: SendToModule FvwmPerl load xmessage.fpl
   2
   3 package Test;
   4 no strict;
   5
   6 ($WIDTH, $HEIGHT) = `xdpyinfo | grep dimensions` =~ /(\d+)x(\d+)/;
   7
   8 %window_size = ( x => 300, y => 150 );
   9 $border_width = 8;
  10 $title_height = 20;  # several vertical points are not very important
  11 $pos_x = ($WIDTH - $window_size{x}) / 2 - $border_width;
  12 $pos_y = ($HEIGHT - $window_size{y} - $title_height) / 2 - $border_width;
  13
  14 $shade_commands = "
  15 All (MyXMessage) WindowShade ShadeAgain NE
  16 All (MyXMessage) WindowShade ShadeAgain N
  17 All (MyXMessage) WindowShade ShadeAgain E
  18 All (MyXMessage) WindowShade ShadeAgain SE
  19 All (MyXMessage) WindowShade ShadeAgain S
  20 All (MyXMessage) WindowShade ShadeAgain N
  21 All (MyXMessage) WindowShade Off
  22 All (MyXMessage) WindowShade ShadeAgain W
  23 All (MyXMessage) WindowShade ShadeAgain NW
  24 All (MyXMessage) WindowShade Off
  25 ";
  26 $shade_function = "DestroyFunc ShadeMyXMessage\nAddToFunc ShadeMyXMessage\n";
  27 $shade_function .= "+ I None (MyXMessage) Wait MyXMessage\n";
  28 $shade_function .= join("\n+ I ", split(/\n/, $shade_commands));
  29
  30 ::command(qq[
  31         Style MyXMessage BorderWidth $border_width, NoHandles
  32         Style MyXMessage WindowShadeShrinks, WindowShadeSteps 80
  33
  34         Exec xmessage -g $window_size{x}x$window_size{y}+$pos_x+$pos_y \\
  35                 -fg black -xrm "*textSink*font:lucidasans-18" \\
  36                 -xrm "*form*background:rgb:c0/c0/a0" \\
  37                 -xrm "*form*okay*background:rgb:90/90/7a" \\
  38                 -xrm "*form*message*background:rgb:f0/f0/c0" \\
  39                 -name MyXMessage -title "Testing FvwmPerl load" "Hello world!"
  40 ]);
  41
  42 # We are just asked to open a window, give fvwm a chance to do it
  43 ::unlock();
  44
  45 ::command(qq[
  46         # Wait only works in functions or "Read file", but not in command()!
  47         # So do it in a function.
  48         $shade_function
  49         ShadeMyXMessage
  50 ]);