#! /usr/bin/perl # colon2.pl - Draw a scalable : (colon) on a canvas # Test script for a planned addition to Tk::LCD.pm # Tk::LCD defines elements within a 22 x 36 pixel rectangle # The colon is drawn as two circles within this rectangle # # @Base shapes are scaled and moved into @scaled shapes for display # Clicking the Next or Previous button rescales # and redraws the screen # # James M. Lynes, Jr. - KE4MIQ # Created: March 14, 2023 # Last Modified: 03/14/2023 - Initial Version # 03/15/2023 - First working version # 03/17/2023 - Updated with PerlMonks comments # # Environment: Ubuntu 22.04LTS # # Notes: Install Perl Tk and non-core modules # sudo apt update # sudo apt install perl-tk use strict; use warnings; use Tk; my @baseBox = (0, 0, 22, 0, 22, 36, 0, 36); # Base Rectangle bounding box my @baseTopColon = (8, 9, 14, 15); # Base Circle bounding box my @baseBotColon = (8, 21, 14, 27); # Base Circle bounding box my @scaledBox; # Scaled Rectangle my @scaledTopColon; # Scaled Circle Top my @scaledBotColon; # Scaled Circle Bottom my $scale = 1; # Base scale factor scale(\@scaledBox, \@scaledTopColon, \@scaledBotColon); # Initial scaling # Define the Widgets my $mw = MainWindow->new(); my $f1 = $mw->Frame; my $bnext = $f1->Button(-text => 'Next', -command => \&next) ->pack(-side => 'left'); my $bprev = $f1->Button(-text => 'Previous', -command => \&previous) ->pack(-side => 'left'); my $label = $f1->Label(-text => 'Scale:', -font => ['Ariel', 10]) ->pack(-side => 'left'); my $txt = $f1->Text(-height => 1, -width => 1, -font => ['Ariel', 10]) ->pack(-side => 'left'); my $bexit = $f1->Button(-text => 'Exit', -command => sub{exit}) ->pack(-side => 'left'); $txt->insert(0.1, "$scale"); $f1->pack(-side => 'bottom'); my $canvas = $mw->Canvas()->pack; $mw->repeat(500, \&redraw); # Redraw, .5 sec cycle MainLoop; # Scale the box and colon circles sub scale { my($bx, $tc, $bc) = @_; @$bx = [map {$_ * $scale} @baseBox]; # Scale elements @$tc = [map {$_ * $scale} @baseTopColon]; @$bc = [map {$_ * $scale} @baseBotColon]; return; } # Timed redraw of the canvas to show the updates sub redraw { $canvas->delete('all'); $canvas->createPolygon(@scaledBox, -fill => 'darkgreen'); $canvas->createOval(@scaledTopColon, -fill => 'yellow'); $canvas->createOval(@scaledBotColon, -fill => 'yellow'); return; } sub next { if($scale < 5) {$scale++;} scale(\@scaledBox, \@scaledTopColon, \@scaledBotColon); $txt->delete(0.1, 'end'); $txt->insert(0.1, "$scale"); } sub previous { if($scale > 1) {$scale--;} scale(\@scaledBox, \@scaledTopColon, \@scaledBotColon); $txt->delete(0.1, 'end'); $txt->insert(0.1, "$scale"); } #### #! /usr/bin/perl # colon1.pl - Draw a scalable : (colon) on a canvas # Test script for a planned addition to Tk::LCD.pm # Tk::LCD defines elements within a 22 x 36 pixel rectangle # The colon is drawn as two circles within this rectangle # # @Base shapes are scaled and moved into @scaled shapes for display # Clicking the Next buttons rescales and redraws the screen # # James M. Lynes, Jr. - KE4MIQ # Created: March 14, 2023 # Last Modified: 03/14/2023 - Initial Version # 03/15/2023 - First working version # # Environment: Ubuntu 22.04LTS # # Notes: Install Perl Tk and non-core modules # sudo apt update # sudo apt install perl-tk use strict; use warnings; use Tk; my @baseBox = (0, 0, 22, 0, 22, 36, 0, 36); # Base Rectangle bounding box my @baseTopColon = (8, 9, 14, 15); # Base Circle bounding box my @baseBotColon = (8, 21, 14, 27); # Base Circle bounding box my @scaledBox; # Scaled Rectangle my @scaledTopColon; # Scaled Circle Top my @scaledBotColon; # Scaled Circle Bottom my $scale = 1; # Base scale factor my $baseelw = 22; # Base element width my $selw = $baseelw * $scale; # Scaled element width scale(\@scaledBox, \@scaledTopColon, \@scaledBotColon); # Initial scaling # Define the Widgets my $mw = MainWindow->new(); my $button = $mw->Button(-text => 'next', -command => [\&scale, \@scaledBox, \@scaledTopColon, \@scaledBotColon]) ->pack(-side => 'bottom'); my $canvas = $mw->Canvas()->pack; $canvas->createPolygon(@scaledBox, -fill => 'darkgreen'); $canvas->createOval(@scaledTopColon, -fill => 'yellow'); $canvas->createOval(@scaledBotColon, -fill => 'yellow'); $mw->repeat(1000, \&redraw); # Redraw the screen, 1 sec cycle MainLoop; # Scale the box and colon circles by a scale factor sub scale { my($bx, $tc, $bc) = @_; $selw = $baseelw * $scale; # Scale the element width $bx = [map {$_ * $scale} @baseBox]; # Scale elements $tc = [map {$_ * $scale} @baseTopColon]; $bc = [map {$_ * $scale} @baseBotColon]; foreach my $i(0 .. $#$bx) { # Return scaled elements $_[0][$i] = @$bx[$i]; # via references } foreach my $i(0 .. $#$tc) { $_[1][$i] = @$tc[$i]; } foreach my $i(0 .. $#$bc) { $_[2][$i] = @$bc[$i]; } $scale = $scale + 1; # Bump for next cycle return; } # Timed redraw of the canvas to show the updates sub redraw { $canvas->delete('all'); $canvas->createPolygon(@scaledBox, -fill => 'darkgreen'); $canvas->createOval(@scaledTopColon, -fill => 'yellow'); $canvas->createOval(@scaledBotColon, -fill => 'yellow'); return; }