1package X11::Xlib::Struct;
2use strict;
3use warnings;
4use X11::Xlib ();
5use Carp ();
6
7# All modules in dist share a version
8BEGIN { our $VERSION= $X11::Xlib::VERSION; }
9
10=head1 NAME
11
12X11::Xlib::Struct - Base class for X11 packed structures
13
14=head1 DESCRIPTION
15
16Base class for the various exposed C-structs of Xlib, which are represented
17as a blessed scalar-ref of the raw bytes of the struct.  This makes them more
18efficient than fully inflating/deflating perl hashrefs for every Xlib call.
19
20All attribute accessors are defined in XS.
21
22=head1 ATTRIBUTES
23
24=head2 display
25
26This is a 'magic' attribute that can be attached to all structs (except for
27XEvent where it is a real attribute).  Many times a struct will have
28
29=head1 METHODS
30
31=head2 new
32
33  my $struct= X11::Xlib::....->new( %optional_fields );
34
35The constructor sets all fields to their initial value (i.e. zero)
36and then applies the list of key/value pairs.  Warns on un-known
37field names.
38
39=cut
40
41sub new {
42    my $class= shift;
43    $class= ref $class if ref $class;
44    my $self= bless \(my $buffer), $class;
45    $self->_initialize;
46    $self->apply(@_) if @_; # If arguments, then initialize using apply
47    $self;
48}
49
50=head2 initialize
51
52Set all struct fields to a sensible initial value (like zero)
53
54=cut
55
56sub initialize {
57    shift->_initialize;
58}
59
60=head2 pack
61
62  $struct->pack( \%fields, $consume, $warn );
63
64Pack field values into the bytes of the struct.  Only C<%fields> is required.
65
66If C<$consume> is true, then remove any key of C<%fields> that was processed.
67
68If C<$warn> is true, then emit a warning if any un-recognized field was given.
69
70=cut
71
72sub pack {
73    my ($self, $fields, $consume, $warn)= @_;
74    $fields= { %$fields } unless $consume;
75    $self->_pack($fields, 1);
76    Carp::carp("Un-used parameters passed to pack: ".join(',', keys %$fields))
77        if $warn && keys %$fields;
78    return $self;
79}
80
81=head2 apply
82
83  $struct->apply( \%fields );
84  $struct->apply( field => $val, ... );
85
86Alias for C< pack(\%fields, 1, 1) >.
87For each given field, update that member of the struct.
88Emits a warning if the hash contains unknown fields.
89
90=cut
91
92sub apply {
93    my $self= shift;
94    Carp::croak("Expected hashref or even-length list")
95        unless 1 == @_ && ref($_[0]) eq 'HASH' or !(1 & @_);
96    my %args= @_ == 1? %{ shift() } : @_;
97
98    $self->pack(\%args, 1, 1);
99}
100
101=head2 unpack
102
103  my $hashref= $struct->unpack();
104
105Extract all fields as Perl data.
106
107=cut
108
109sub unpack {
110    my $self= shift;
111    $self->_unpack(my $ret= {});
112    if ($self->can('display') && defined (my $dpy= $self->display)) {
113        # tag all objects returned as belonging to this display
114        for (values %$ret) {
115            $_->display($dpy) if ref $_ && ref($_)->can('display');
116        }
117    }
118    $ret;
119}
120
121=head2 bytes
122
123Access the scalar holding the bytes of the struct.
124
125=cut
126
127sub bytes { ${$_[0]} }
128*buffer= *bytes;
129
130# The struct code is all in XS, so all we need to do is declare the package
131# inheritence.  Except for XEvent, which is complicated.
132
133require X11::Xlib::XEvent;
134@X11::Xlib::XVisualInfo::ISA= ( __PACKAGE__ );
135@X11::Xlib::XWindowChanges::ISA= ( __PACKAGE__ );
136@X11::Xlib::XWindowAttributes::ISA= ( __PACKAGE__ );
137@X11::Xlib::XSetWindowAttributes::ISA= ( __PACKAGE__ );
138@X11::Xlib::XSizeHints::ISA= ( __PACKAGE__ );
139@X11::Xlib::XRectangle::ISA= ( __PACKAGE__ );
140@X11::Xlib::XRenderPictFormat::ISA= ( __PACKAGE__ );
141
1421;
143
144__END__
145
146=head1 AUTHOR
147
148Olivier Thauvin, E<lt>nanardon@nanardon.zarb.orgE<gt>
149
150Michael Conrad, E<lt>mike@nrdvana.netE<gt>
151
152=head1 COPYRIGHT AND LICENSE
153
154Copyright (C) 2009-2010 by Olivier Thauvin
155
156Copyright (C) 2017 by Michael Conrad
157
158This library is free software; you can redistribute it and/or modify
159it under the same terms as Perl itself, either Perl version 5.10.0 or,
160at your option, any later version of Perl 5 you may have available.
161
162=cut
163