Tk::LCD Investigations

I recently made a UTC clock script using Tk::LCD. It simulates the look of a 7-segment LCD display. The elements/digits are designed around a 22x36 pixel block(large) and an 11x18 pixel block(small). In using this package, I determined that the digits were too small and that leading zeros weren't displayed. I implemented an option for displaying leading zeros and another for scaling the elements to an arbitrary multiple(where 1 equals the original large size). I plan a separate post to discuss these changes further.

This post concerns a test script for adding support for special characters in this case the : (colon). Currently Tk::LCD only supports numbers, minus, and space. This script draws a : within a 22x36 pixel block and provides for scaling to an arbitrary multiple.

The challenge of this script was in returning lists from a callback. While I came across the solution(call by reference and the $_[0] construct) fairly quickly the implementation was not obvious to me. The result is shown below.

I plan to integrate this code into my version of Tk::LCD to allow display of an HH:MM format. Other specical characters could be implemented in a similar way.

Update1: colon2.pl listed below includes changes based on comments to colon1.pl. Thanks to all who provided comments.

#! /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 re
+ctangle
#                   The colon is drawn as two circles within this rect
+angle
#
#                   @Base shapes are scaled and moved into @scaled sha
+pes 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 b
+ounding box
my @baseTopColon = (8, 9, 14, 15);                  # Base Circle boun
+ding box
my @baseBotColon = (8, 21, 14, 27);                 # Base Circle boun
+ding box

my @scaledBox;                                      # Scaled Rectangle
my @scaledTopColon;                                 # Scaled Circle To
+p
my @scaledBotColon;                                 # Scaled Circle Bo
+ttom

my $scale     = 1;                                  # Base scale facto
+r

scale(\@scaledBox, \@scaledTopColon, \@scaledBotColon); # Initial scal
+ing


# 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");
}

[download]
#! /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 re
+ctangle
#                   The colon is drawn as two circles within this rect
+angle
#
#                   @Base shapes are scaled and moved into @scaled sha
+pes 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 b
+ounding box
my @baseTopColon = (8, 9, 14, 15);                  # Base Circle boun
+ding box
my @baseBotColon = (8, 21, 14, 27);                 # Base Circle boun
+ding box

my @scaledBox;                                      # Scaled Rectangle
my @scaledTopColon;                                 # Scaled Circle To
+p
my @scaledBotColon;                                 # Scaled Circle Bo
+ttom

my $scale     = 1;                                  # Base scale facto
+r
my $baseelw   = 22;                                 # Base element wid
+th
my $selw      = $baseelw * $scale;                  # Scaled element w
+idth

scale(\@scaledBox, \@scaledTopColon, \@scaledBotColon);    # Initial s
+caling

# Define the Widgets
my $mw     = MainWindow->new();
my $button = $mw->Button(-text => 'next',
                         -command => [\&scale, \@scaledBox, \@scaledTo
+pColon,
                                      \@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 scree
+n, 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 eleme
+nt width
    
    $bx = [map {$_ * $scale} @baseBox];              # Scale elements
    $tc = [map {$_ * $scale} @baseTopColon];
    $bc = [map {$_ * $scale} @baseBotColon];

    foreach my $i(0 .. $#$bx) {                      # Return scaled e
+lements
        $_[0][$i] = @$bx[$i];                        #    via referenc
+es
    }
    foreach my $i(0 .. $#$tc) {
        $_[1][$i] = @$tc[$i];
    }
    foreach my $i(0 .. $#$bc) {
        $_[2][$i] = @$bc[$i];
    }
    $scale = $scale + 1;                             # Bump for next c
+ycle
    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;
}

[download]

James

There's never enough time to do it right, but always enough time to do it over...

Replies are listed 'Best First'.
Re: Tk::LCD Investigations
by kcott (Archbishop) on Mar 16, 2023 at 08:11 UTC

    G'day James,

    ++ It worked as described for me.

    There's an unlimited amount of times that "next" can be used. You may want to add a limit. At the moment, for the first several uses, the proportions are retained; something like this: 

    +-----+
|     |
|     |
|  O  |
|     |
|  O  |
|     |
|     |
+-----+

    After half a dozen uses, the layout degrades; very roughly like this: 

    +-----+  +-----+  +-----+  +-----+
|     |  |     |  |     |  |     |
|     |  |     |  |     |  |     |
|  O  |  |  O  |  |  O  |  |  O  |
|     |  |     |  |     |  |     |
|  O  |  |  O  |  |  O  |  +-----+
|     |  |     |  +-----+
|     |  +-----+
+-----+

    As a general rule-of-thumb in Tk applications, unless I want to pass an absolute value to a callback which doesn't change that value, I use references. In many cases, even if the value isn't being changed in the callback, it may be changed prior to the callback being invoked; references are typically a good option in these cases also.

    You also may want add a "prev" button to test down-scaling.

    Not intended as a huge criticism, but I do see the following code repeated: 

    $canvas->createPolygon(@scaledBox,   -fill => 'darkgreen');
$canvas->createOval(@scaledTopColon, -fill => 'yellow');
$canvas->createOval(@scaledBotColon, -fill => 'yellow');

    [download]

    Consider abstracting that into a single routine. If you subsequently want to change something, you'll only need to do it in one place (see "DRY principle").

    — Ken

[reply]
[d/l]

      Ken, thanks for your comments.

      I had noticed the offset, but hadn't had a chance to look into it yet. The down-scaling I believe will work as all scaling is calculated from the base rather than from the previous. Errors shouldn't accumulate. The duplicate code in redraw() came from another post and at that moment I was happy to get it working! It had been a lot of trial and error at that point. It won't be necessary when I update the main package. It was an artifact from wanting a way to demo a changing scale without repeatedly editing the source.

      I next have to work in move-> to draw multiple colons at different sizes on the same canvas. That's how Tk::LCD draws multiple digits. Move->Polygon, Move->Polygon, etc.

      Several years back I ported a wxWidgets clock demo to wxPerl. While more flexible, it was a lot more code.

      My learning from this test was using the $_[0] notation for returning data back from a callback.

      James

      There's never enough time to do it right, but always enough time to do it over...

[reply]
Re: Tk::LCD Investigations
by Tux (Canon) on Mar 16, 2023 at 15:59 UTC

    Reminds me of xwekker, a perl/Tk script used as alarm-clock. I wrote it in Jan 2007 and its dependencies are likely outdated.

    screenshot


    Enjoy, Have FUN! H.Merijn
[reply]

      Tux, very nice! Was that a clean-sheet or a port?

      James

      There's never enough time to do it right, but always enough time to do it over...

[reply]
Re: Tk::LCD Investigations
by jwkrahn (Abbot) on Mar 16, 2023 at 21:32 UTC 
    # Scale the box and colon circles by a scale factor
sub scale {
    my($bx, $tc, $bc) = @_; 

    $selw  = $baseelw * $scale;                      # Scale the eleme
+nt width
    
    $bx = [map {$_ * $scale} @baseBox];              # Scale elements
    $tc = [map {$_ * $scale} @baseTopColon];
    $bc = [map {$_ * $scale} @baseBotColon];

    foreach my $i(0 .. $#$bx) {                      # Return scaled e
+lements
        $_[0][$i] = @$bx[$i];                        #    via referenc
+es
    }
    foreach my $i(0 .. $#$tc) {
        $_[1][$i] = @$tc[$i];
    }
    foreach my $i(0 .. $#$bc) {
        $_[2][$i] = @$bc[$i];
    }
    $scale = $scale + 1;                             # Bump for next c
+ycle
    return;
}

    [download]

    That could be written more simply as: 

    # Scale the box and colon circles by a scale factor
sub scale {
    my($bx, $tc, $bc) = @_; 

    $selw  = $baseelw * $scale;                      # Scale the eleme
+nt width

    @$bx = map {$_ * $scale} @baseBox;              # Scale elements
    @$tc = map {$_ * $scale} @baseTopColon;
    @$bc = map {$_ * $scale} @baseBotColon;

    ++$scale;                             # Bump for next cycle
    return;
}

    [download]
    Naked blocks are fun! -- Randal L. Schwartz, Perl hacker
[reply]
[d/l]
[select]

      jwkrahn, thank you for the hint! I came very close to that in one of my many trials. I only missed by an @. I'll update my code.

      James

      There's never enough time to do it right, but always enough time to do it over...

[reply]
Re: Tk::LCD Investigations
by Anonymous Monk on Mar 16, 2023 at 11:38 UTC
    Create / delete ? The classic is sbow hide ;P
[reply]

Back to Cool Uses for Perl