#!/usr/bin/perl use warnings; use strict; use Tk; my @VehicleProgram = ( 'AA', 'BB' ); my @CrashMode = ( '12', '13' ); my @Drive = ( 'lhd', 'rhd' ); my @Side = ( 'Driver', 'Passanger' ); my @Dummy = ( '50', '95', '5' ); my @Load = ( 'AA_121', 'AA_13', 'BB_12', 'CC_12', 'AA_122' ); my @LoadArrayRef = @Load; my $Program = 'undef'; my $CrashMode = 'undef'; my $Drive = 'undef'; my $Side = 'undef'; my $dummy = 'undef'; my $Load = 'undef'; my $Error = 'no'; my $font2 = '-adobe-courier-medium-r-normal--16-100-100-100-m-90-iso8859-2'; my $sw4; my $comment; my $mw = MainWindow->new; my $toplevel = $mw->toplevel; my $menubar = $toplevel->Menu( -type => 'menubar' )->pack; my $w1 = $menubar->cascade( -label => 'Program', -tearoff => 0 ); my $w2 = $menubar->cascade( -label => 'Crash Mode', -tearoff => 0 ); my $w3 = $menubar->cascade( -label => 'Drive', -tearoff => 0 ); my $w4 = $menubar->cascade( -label => 'Side', -tearoff => 0 ); my $w5 = $menubar->cascade( -label => 'Dummy', -tearoff => 0 ); my $w6 = $menubar->cascade( -label => 'Load', -tearoff => 0 ); my $w11 = $menubar->Button( -label => 'CreateRun', -command => \&CreateRun, -state => 'disabled' ); $menubar->Button( -label => 'Exit', -command => sub { exit } ); my $sw3 = $mw->Frame( -relief => 'ridge', -bd => 2, -height => '40' )->pack( -side => 'top', -anchor => 'w', -expand => 0, -fill => 'both' ); my $cm1 = $sw3->Label( -text => " Comment: ", -font => "$font2" )->pack( -side => 'left', -anchor => 'w' ); my $cm2 = $sw3->Entry( -textvariable => \$comment, -background => "white", -foreground => "black", -relief => 'ridge', -font => "$font2" )->pack( -side => 'left', -anchor => 'w' ); foreach my $i ( @VehicleProgram ) { $w1->radiobutton( -label => "$i", -command => \&set_bg, -variable => \$Program, -font => "$font2", -value => "$i" ); } foreach my $i ( @CrashMode ) { $w2->radiobutton( -label => "$i", -command => \&set_bg, -variable => \$CrashMode, -font => "$font2", -value => "$i" ); } foreach my $i ( @Drive ) { $w3->radiobutton( -label => "$i", -command => \&set_bg, -variable => \$Drive, -font => "$font2", -value => "$i" ); } foreach my $i ( @Side ) { $w4->radiobutton( -label => "$i", -command => \&set_bg, -variable => \$Side, -font => "$font2", -value => "$i" ); } foreach my $i ( @Dummy ) { $w5->radiobutton( -label => "$i", -command => \&set_bg, -variable => \$dummy, -font => "$font2", -value => "$i" ); } foreach my $i ( @LoadArrayRef ) { $w6->radiobutton( -label => "$i", -command => \&set_bg, -variable => \$Load, -font => "$font2", -value => "$i" ); } MainLoop; sub set_bg { $sw4->destroy if Exists( $sw4 ); $sw4 = $mw->Frame( -relief => 'ridge', -bd => 2, -height => '40' )->pack( -side => 'top', -anchor => 'w', -expand => 0, -fill => 'both' ); $sw4->Label( -text => "$Program", -font => "$font2" )->pack( -side => 'left', -anchor => 'w' ); $sw4->Label( -text => "$CrashMode", -font => "$font2" )->pack( -side => 'left', -anchor => 'w' ); $sw4->Label( -text => "$Drive", -font => "$font2" )->pack( -side => 'left', -anchor => 'w' ); $sw4->Label( -text => "$Side", -font => "$font2" )->pack( -side => 'left', -anchor => 'w' ); $sw4->Label( -text => "$dummy", -font => "$font2" )->pack( -side => 'left', -anchor => 'w' ); $sw4->Label( -textvariable => \$Load, -font => "$font2" )->pack( -side => 'left', -anchor => 'w' ); $w11->configure( -state => 'active' ) if ( $Program ne 'undef' and $CrashMode ne 'undef' and $Drive ne 'undef' and $Side ne 'undef' and $dummy ne 'undef' and $Load ne 'undef' ); @LoadArrayRef = @Load; UpdateLoadArray(); } sub UpdateLoadArray { my ( @new ); print "@LoadArrayRef\n\n"; foreach ( @LoadArrayRef ) { if ( $_ !~ /$Program/ ) { next } if ( $_ !~ /$CrashMode/ ) { next } print "$_\n"; push( @new, $_ ); } @LoadArrayRef = @new; print "-----\n"; print "new-> @new\n"; print "Program:$Program CrashMode:$CrashMode\n"; # update label thru textvariable $Load = join ' ', @new; foreach ( @LoadArrayRef ) { print "$_\n" } print "-----\n"; } sub CreateRun { }