#!/usr/bin/perl
#
#   adremotest.pl is a small testscript that checks the connection
#                 with the Adremo electrical wheelchair. It will
#                 only work with newer models, but at the appropiate
#                 place in the source I indicated what should be
#                 done to make it work with older models
#
#
# author:            Jouke Visser
# last modification: March 26, 2004
#
# more information on the Adremo electrical wheelchair can be found
# at http://www.adremo.nl
#
# we need the grey.gif and green.gif images, the pvoice.ico
# and the inpout32.dll
# and Win32::API and Wx

use strict;
use warnings;

our $VERSION = 1.0;

package AdremoTest;
# This is the wxApplication that does the whole thing
use Wx qw(:everything);
use Wx::Perl::Carp;
use base "Wx::App";

sub OnInit
{
    my $self = shift;
    my $Appname        = "Adremo Test Utility";
    my $Appvendor      = "pVoice Applications - Jouke Visser";

    $self->SetAppName($Appname);
    $self->SetVendorName($Appvendor);

    # call the frame
    my $frame = AdremoTestFrame->new( undef,
                                      Wx::NewId(),
                                      "Adremo Test Utility");
    $frame->Show(1);
}

package AdremoTestFrame;
# This is the window where it all happens
use Wx qw(:everything);
use Wx::Perl::Carp;
use Wx::Event qw(EVT_TIMER);
use Win32::API;

use base "Wx::Frame";

use constant ADREMO_PARPORT_MASK => 0xf8; # to mask out the statusbits
use constant PARPORT_ADDRESS     => 0x379;# lpt1
use constant INTERVAL         => 10;   # how many times per second
                                          # do we check?

sub new
{
    my $class = shift;
    # call the superclass' constructor with our parameters
    my $self = $class->SUPER::new(@_);
    # all items will appear on this panel
    $self->{panel} = Wx::Panel->new($self, Wx::NewId());
    # this could be done more elegantly because we only have .gif imag
+es
    Wx::InitAllImageHandlers;

    # we set the icon for the application
    my $icon=Wx::Icon->new( 'pvoice.ico',        # name
                            wxBITMAP_TYPE_ICO);  # type
    $self->SetIcon($icon );
    
    # load the images to indicate the status
    my $grey  = Wx::Image->new('grey.gif',  wxBITMAP_TYPE_ANY)
                    if -e 'grey.gif';
    my $green = Wx::Image->new('green.gif', wxBITMAP_TYPE_ANY)
                    if -e 'green.gif';
    # die if we can't find them
    die "Can't find icons\n" unless $grey && $green;
    # otherwise save them as a property of ourselves
    $self->{greybmp}  = Wx::Bitmap->new($grey);
    $self->{greenbmp} = Wx::Bitmap->new($green);
    
    #create a few sizers for nice layout
    $self->{tls}  = Wx::GridSizer->new(0,2);
    $self->{left} = Wx::GridSizer->new(0,1);
    $self->{right}= Wx::GridSizer->new(0,1);
    $self->{row1} = Wx::GridSizer->new(1,2);
    $self->{row2} = Wx::GridSizer->new(1,2);
    $self->{row3} = Wx::GridSizer->new(1,2);
    $self->{row4} = Wx::GridSizer->new(1,2);
    $self->{row5} = Wx::GridSizer->new(1,2);

    # set up the labels and icons and put them in the approiate sizer
    $self->{connected_txt} = Wx::StaticText->new( $self->{panel},
                                                  Wx::NewId(),
                                        "Adremo Connection detected");
    $self->{connected_ico} = Wx::StaticBitmap->new( $self->{panel},
                                                    Wx::NewId(),
                                                    $self->{greybmp});
+   
    $self->{row1}->Add($self->{connected_txt}, 0, wxGROW|wxALL, 2);
    $self->{row1}->Add($self->{connected_ico}, 0, wxALL, 2);
    $self->{commode_txt} = Wx::StaticText->new( $self->{panel},
                                                Wx::NewId(),
                                        "Adremo Communication mode on"
+);
    $self->{commode_ico} = Wx::StaticBitmap->new( $self->{panel},
                                                  Wx::NewId(),
                                                  $self->{greybmp});  
+ 
    $self->{row2}->Add($self->{commode_txt}, 0, wxGROW|wxALL, 2);
    $self->{row2}->Add($self->{commode_ico}, 0, wxALL, 2);
    $self->{headright_txt} = Wx::StaticText->new( $self->{panel},
                                                  Wx::NewId(),
                                                  "Adremo Head Right")
+;   
    $self->{headright_ico} = Wx::StaticBitmap->new( $self->{panel},
                                                    Wx::NewId(),
                                                    $self->{greybmp});
+   
    $self->{row3}->Add($self->{headright_txt}, 0, wxGROW|wxALL, 2);
    $self->{row3}->Add($self->{headright_ico}, 0, wxALL, 2);
    $self->{headleft_txt} = Wx::StaticText->new( $self->{panel},
                                                 Wx::NewId(),
                                                 "Adremo Head Left"); 
+  
    $self->{headleft_ico} = Wx::StaticBitmap->new( $self->{panel},
                                                   Wx::NewId(),
                                                   $self->{greybmp}); 
+  
    $self->{row4}->Add($self->{headleft_txt}, 0, wxGROW|wxALL, 2);
    $self->{row4}->Add($self->{headleft_ico}, 0, wxALL, 2);
    $self->{toeright_txt} = Wx::StaticText->new( $self->{panel},
                                                 Wx::NewId(),
                                                 "Adremo Toe Right"); 
+  
    $self->{toeright_ico} = Wx::StaticBitmap->new( $self->{panel},
                                                   Wx::NewId(),
                                                   $self->{greybmp}); 
+  
    $self->{row5}->Add($self->{toeright_txt}, 0, wxGROW|wxALL, 2);
    $self->{row5}->Add($self->{toeright_ico}, 0, wxALL, 2);
    # and a log window
    $self->{log} = Wx::TextCtrl->new( $self->{panel},
                                      Wx::NewId(),
                                      "",
                                      wxDefaultPosition,
                                      wxDefaultSize,
                                      wxTE_MULTILINE|
                                      wxHSCROLL|
                                      wxTE_READONLY);   
    $self->{right}->Add($self->{log}, 0, wxGROW|wxALL, 2);
    
    # finalize the Sizer-setup
    $self->{left}->Add($self->{row1}, 0, wxGROW|wxALL, 2);
    $self->{left}->Add($self->{row2}, 0, wxGROW|wxALL, 2);
    $self->{left}->Add($self->{row3}, 0, wxGROW|wxALL, 2);
    $self->{left}->Add($self->{row4}, 0, wxGROW|wxALL, 2);
    $self->{left}->Add($self->{row5}, 0, wxGROW|wxALL, 2);
    
    $self->{tls}->Add($self->{left}, 0, wxGROW|wxALL, 2);
    $self->{tls}->Add($self->{right}, 0, wxGROW|wxALL, 2);

    $self->{panel}->SetSizer($self->{tls});
    $self->{panel}->SetAutoLayout(1);
    $self->{tls}->Fit($self);

    # Set up the timer to call the sub monitorport every INTERVAL
    my $timerid = Wx::NewId();
    $self->{timer} = Wx::Timer->new($self, $timerid);
    $self->{timer}->Start(INTERVAL, 0); #the 0 means no one-shot
    EVT_TIMER($self, $timerid, \&monitorport);

    return $self;
}

sub monitorport
# This subroutine actually monitors the parallel port
{
    my ($self, $event) = @_;
    # If we're already running, just return
    return if $self->{monitorrun};
    # indicate that we're running
    $self->{monitorrun} = 1;
    # Get the function from the inpout32.dll to read
    # IO ports
    $self->{getportval} = Win32::API->new(  "inpout32", # dll
                                            "Inp32",    # function
                                            ["I"],      # Parameterlis
+t
                                            "I")        # returnvalue
                            if not exists $self->{getportval};
    # get the current value from the parallel port and mask out the
    # statusbits (they're unused)
    my $curvalue = ($self->{getportval}
                         ->Call(PARPORT_ADDRESS) &
                                ADREMO_PARPORT_MASK);
    # end the sub if we can't get a value
    if (not defined $curvalue)
    {
        $self->{monitorrun} = 0;
    warn "Can't get a value from the parallel port\n";
        return;
    }
    # initialize lastvalue if nessecary
    $self->{lastvalue} = 0 if not exists $self->{lastvalue};

    # if we get a new value, do our thing...
    if ($curvalue != $self->{lastvalue})
    {
        # first set all indicators back to off (grey bullet)
    $self->{headright_ico}->SetBitmap($self->{greybmp}); 
    $self->{headleft_ico}->SetBitmap($self->{greybmp});  
    $self->{toeright_ico}->SetBitmap($self->{greybmp});  
    $self->{commode_ico}->SetBitmap($self->{greybmp});   
    $self->{commode_ico}->SetBitmap($self->{greybmp});   
    $self->{connected_ico}->SetBitmap($self->{greybmp}); 

=for doc

# Krista's old adremo:
    0x38 = 'head right'
    0xf8 = 'head left'

# Krista's new adremo:
    0x20 = 'head right'
    0xe0 = 'head left'
    0x40 = 'right toe'
    0x60 = 'communication mode - no action'
    0x70 = 'not in communication mode'
    0x78 = 'no adremo connection'
    
=cut 

        # unless we don't have a connection...
    unless ($curvalue == 0x78) # = 'no adremo connection'
    {
            # set the connected bullet to green
        $self->{connected_ico}->SetBitmap($self->{greenbmp}); 
            # set the commode bullet to green unless we get the
            # signal that we're not in commode
        $self->{commode_ico}->SetBitmap($self->{greenbmp})
                unless $curvalue == 0x70; #= 'not in communication mod
+e'
        # light up the appropiate bullets if we get a corresponding
            # signal
            $self->{headright_ico}->SetBitmap($self->{greenbmp})
                if $curvalue == 0x20; # = 'head right'
        $self->{headleft_ico}->SetBitmap($self->{greenbmp})
                if $curvalue == 0xe0; # = 'head left'
        $self->{toeright_ico}->SetBitmap($self->{greenbmp})
                if $curvalue == 0x40; # = 'right toe'
    }
        # add the value we just got to the log window
    my $cv = sprintf("Last value: %x\n", $curvalue);
    $self->{log}->AppendText($cv);
    
    }
    # make lastvalue the current value for the next run
    $self->{lastvalue} = $curvalue if $curvalue;

    # we're not running anymore
    $self->{monitorrun} = 0;
}

package main;

my $obj = AdremoTest->new();
$obj->MainLoop();
[download]