File Coverage

blib/lib/X11/Protocol/Ext/MIT_SCREEN_SAVER.pm

Criterion	Covered	Total	%
statement	16	43	37.2
branch	0	4	0.0
condition	0	7	0.0
subroutine	6	11	54.5
pod	0	1	0.0
total	22	66	33.3

# Copyright 2011, 2012, 2013, 2014, 2016, 2017 Kevin Ryde

# This file is part of X11-Protocol-Other.
#
# X11-Protocol-Other is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# X11-Protocol-Other is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with X11-Protocol-Other.  If not, see .


# /usr/share/doc/x11proto-scrnsaver-dev/saver.txt.gz
#
# /usr/include/X11/extensions/saver.h
# /usr/include/X11/extensions/saverproto.h
#
# /usr/share/doc/x11proto-core-dev/x11protocol.txt.gz


BEGIN { require 5 }
package X11::Protocol::Ext::MIT_SCREEN_SAVER;
use strict;
use X11::Protocol;

use vars '$VERSION', '@CARP_NOT';
$VERSION = 30;
@CARP_NOT = ('X11::Protocol');

# uncomment this to run the ### lines
#use Smart::Comments;


# these not documented yet ... and not used as such
use constant CLIENT_MAJOR_VERSION => 1;
use constant CLIENT_MINOR_VERSION => 0;

#------------------------------------------------------------------------------

my $reqs =
  [
   [ 'MitScreenSaverQueryVersion',  # 0
     sub {
       my ($X, $client_major, $client_minor) = @_;
       ### MitScreenSaverQueryVersion request
       return pack 'CCxx', $client_major, $client_minor;
     },
     sub {
       my ($X, $data) = @_;
       return unpack 'x8SS', $data;
     }],

   [ 'MitScreenSaverQueryInfo',  # 1
     \&_request_card32s,
     sub {
       my ($X, $data) = @_;
       my ($state, $window, $til_or_since, $idle, $event_mask, $kind)
         = unpack 'xCx6LLLLC', $data;
       return ($X->interp('MitScreenSaverState',$state),
               _interp_none($X,$window),
               $til_or_since,
               $idle,
               $event_mask,
               $X->interp('MitScreenSaverKind',$kind));
     } ],

   [ 'MitScreenSaverSelectInput',  # 2
     \&_request_card32s ],  # ($X, $drawable, $event_mask)

   [ 'MitScreenSaverSetAttributes',  # 3
     sub {
       ### MitScreenSaverSetAttributes request
       # same args as $X->CreateWindow(), but pack format a bit different
       my ($X, $drawable,
           $class, $depth, $visual,
           $x, $y, $width, $height,
           $border_width,
           @values) = @_;

       # ChangeWindow
       my ($data) = &{$X->{'requests'}->[2]->[1]} ($X, $drawable, @values);
       ### $data

       return (pack ('LssSSSCCL',
                     $drawable,
                     $x, $y,
                     $width, $height,
                     $border_width,
                     $X->num('Class',$class),
                     $depth,
                     _num_visual($visual))
               . substr ($data, 4));
     } ],

   [ 'MitScreenSaverUnsetAttributes',     # 4
     \&_request_card32s ],  # ($X, $drawable)

  ];

sub _num_visual {
  my ($visual) = @_;
  if ($visual eq 'CopyFromParent') {
    return 0;
  } else {
    return $visual;
  }
}

#------------------------------------------------------------------------------

my $MitScreenSaverNotify_event
  = [ 'xCxxLLLCC',
      ['state','MitScreenSaverState'],
      'time',
      'root',
      'window',
      ['kind','MitScreenSaverKind'],
      'forced' ];

#------------------------------------------------------------------------------

my %const_arrays
  = (
     MitScreenSaverKind      => ['Blanked', 'Internal', 'External'],
     MitScreenSaverState     => ['Off', 'On', 'Cycle', 'Disabled'],

     # not sure about this one yet
     # MitScreenSaverEventMask => ['Notify', 'Cycle'],
    );
my %const_hashes
  = (map { $_ => { X11::Protocol::make_num_hash($const_arrays{$_}) } }
     keys %const_arrays);

#------------------------------------------------------------------------------

sub new {
  my ($class, $X, $request_num, $event_num, $error_num) = @_;
  ### MIT_SCREEN_SAVER new()

  # Constants
  %{$X->{'ext_const'}}     = (%{$X->{'ext_const'}     ||= {}}, %const_arrays);
  %{$X->{'ext_const_num'}} = (%{$X->{'ext_const_num'} ||= {}}, %const_hashes);

  # Events
  $X->{'ext_const'}{'Events'}[$event_num] = 'MitScreenSaverNotify';
  $X->{'ext_events'}[$event_num] = $MitScreenSaverNotify_event;

  _ext_requests_install ($X, $request_num, $reqs);

  # my ($server_major, $server_minor) = $X->req ('MitScreenSaverQueryVersion',
  #                                              CLIENT_MAJOR_VERSION,
  #                                              CLIENT_MINOR_VERSION);
  # ### $server_major
  # ### $server_minor
  return bless {
                # major => $server_major,
                # minor => $server_minor,
               }, $class;
}

sub _ext_requests_install {
  my ($X, $request_num, $reqs) = @_;

  $X->{'ext_request'}->{$request_num} = $reqs;
  my $href = $X->{'ext_request_num'};
  my $i;
  foreach $i (0 .. $#$reqs) {
    $href->{$reqs->[$i]->[0]} = [$request_num, $i];
  }
}

sub _request_card32s {
  shift;
  ### _request_card32s(): @_
  return pack 'L*', @_;
}

sub _interp_none {
  my ($X, $xid) = @_;
  if ($X->{'do_interp'} && $xid == 0) {
    return 'None';
  } else {
    return $xid;
  }
}

# Similar to Xlib XScreenSaverSaverRegister() maybe.
# Or plain funcs X11::Protocol::Ext::MIT_SCREEN_SAVER::register()
# set_screen_saver_id()
# get_screen_saver_id()
#
# {
#   package X11::Protocol;
#
#   sub MitScreenSaverRegister {
#     my ($X, $screen, $type, $xid) = @_;
#     $X->ChangeProperty ($X->{'screen'}->[$screen]->{'root'},
#                         $X->atom('_SCREEN_SAVER_ID'),  # property
#                         $type,
#                         32,                            # format
#                         'Replace',
#                         $xid);
#   }
#   sub MitScreenSaverUnregister {
#     my ($X, $screen) = @_;
#     $X->DeleteProperty ($X->{'screen'}->[$screen]->{'root'},
#                         $X->atom('_SCREEN_SAVER_ID'));
#   }
#   sub MitScreenSaverGetRegistered {
#     my ($X, $screen, $type, $xid) = @_;
#     my ($value, $got_type, $format, $bytes_after)
#       = $X->GetProperty ($X->{'screen'}->[$screen]->{'root'},
#                          $X->atom('_SCREEN_SAVER_ID'),  # property
#                          $type,
#                          0,  # offset
#                          1,  # length
#                          0); # delete;
#     if ($format == 32) {
#       return unpack 'L', $value;
#     } else {
#       return undef;
#     }
#   }
# }

1;
__END__