http://www.perlmonks.org?node_id=340235

This code, for quite some part derrived from a small script jcwren once wrote for me (in 2001) tests the connection with an Adremo electrical wheelchair (http://www.adremo.nl). 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 http://jouke.pvoice.org/files/adremotest.tar.gz

Jouke Visser, Perl 'Adept'
Using Perl to help the disabled: pVoice and pStory
#!/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();