Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Adremo electrical wheelchair testutility

by Jouke (Curate)
on Mar 27, 2004 at 08:26 UTC ( #340235=CUFP: print w/ replies, xml ) Need Help??

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();

Comment on Adremo electrical wheelchair testutility
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://340235]
Approved by markmoon
Front-paged by grinder
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (14)
As of 2014-08-22 15:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (159 votes), past polls