once wrote for me (in 2001) tests the connection with an Adremo electrical wheelchair (
). This wheelchair can be connected to the parallel port of a PC. Unfortunately the script will only run on Win32 systems, because it needs a Windows DLL to run.
The files this script needs can be downloaded in one package from
#!/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();