vptk_w

 view release on metacpan or  search on metacpan

vptk_w/Project.pm  view on Meta::CPAN

  - Widgets (main part of the project)
  - Code (user-defined code placed after MainLoop)
=cut

use strict;

sub new { # default constructor
  my $class = shift;
  my $this  = {list=>[],data=>{}};

  bless $this => $class;
}

sub init { # just clean all
  my $this = shift;
  my $pData = shift;
  $this->{list}=[];
  $this->{data}={};
  map ($this->push($_,$pData->{$_}), keys %$pData) if ref $pData;
}

vptk_w/Project/Code.pm  view on Meta::CPAN

package vptk_w::Project::Code;

use strict;
use base qw(vptk_w::Project);

sub new {
  my $class = shift;
  my $this  = vptk_w::Project->new(@_);
  bless $this => $class;
}

sub print {
  my $this = shift;
  my $parent = shift;
  my @result;

  return () unless scalar(@{$this->get('user code')});
  return () unless $parent->get('Options')->get('fullcode');
#  push(@result, "#===vptk end===< DO NOT CODE ABOVE THIS LINE >===\n\n");

vptk_w/Project/Options.pm  view on Meta::CPAN

  my $class = shift;
  my $this  = vptk_w::Project->new(@_);
  foreach($^X, '/usr/local/bin/perl', '/usr/bin/perl') {
    if(-f $_) {
      s/\.exe$//;
      $this->push('perl executable'=>$_);
      last;
    }
  }
#  $this->push('description'=>"This is automatic code generated by $0");
  bless $this => $class;
}

sub print {
  my $this = shift;
  my $parent = shift;
  my @result;
  if ($this->get('fullcode')) {
    push(@result, '#!'.$this->get('perl executable')." -w\n") if $this->get('perl executable');
    push(@result, '# '.$this->get('description')."\n") if $this->get('description');
  }

vptk_w/Project/Widgets.pm  view on Meta::CPAN

package vptk_w::Project::Widgets;

use strict;
use base qw(vptk_w::Project);
use vars qw/@user_auto_vars/;

sub new {
  my $class = shift;
  my $this  = vptk_w::Project->new(@_);
  $this->{tree}=[]; # a list of widgets with their paths
  bless $this => $class;
}

sub init {
  my $this = shift;
  $this->{tree}=[];
  $this->{list}=[];
  $this->{data}={};
}

# this function to be revised and extended

vptk_w/VPTK_Geometry.pm  view on Meta::CPAN

package vptk_w::VPTK_Geometry;
use strict;

# Constructor - just create empty instance
sub new {
  my $class = shift;
  die "ERROR: missing class name"
    unless $class;
  die "ERROR: uneven arguments number (@_)"
    if scalar(@_)%2;
  return bless {@_} => $class;
}

# Putter/Getter method
sub GeometryData {
  my $this = shift;

  die "ERROR: missing instance"
    unless $this;
  die "ERROR: uneven arguments number (@_)"
    if scalar(@_)%2;

vptk_w/VPTK_Widget.pm  view on Meta::CPAN

  $class = $class.'::'.$sub_class;
  die "ERROR: missing 1st arg"
    unless $class;
  my @args = @_;

  die "ERROR: wrong parameters number (@args) in ".(caller(0))[3]."\n"
    if scalar(@args) % 2;
  push (@args, 
    -instance_data => {-widget_data=>{},-geometry_data=>{}}
  );
  return bless { @args } => $class;
}

# putter/getter method for '-instance_data' property
# When called without args retrieves object's parameters
sub InstanceData {
  my $this = shift;
  die "ERROR: wrong this/missing ($this) in ".(caller(0))[3]."\n"
    unless ref $this;
  
  if(@_) {