Here's another C++ to wxPerl port from the "wxBook"(I know, it's a sickness...).

This one is a simulated 7 segment LCD display. Nice graphic, clever implementation. I don't claim to understand all of the logic yet. The port included some perlish updates so that it looks a little less C++ish and lots of comments that weren't in the original. See the code comments for the author credits. Several other wxIndustrial Controls are available, so I may go there next.

I couldn't get this port working a year ago, but it was completed in a few days this attempt. So, some learning is taking place! :)

James

#! /home/pete/CitrusPerl/perl/bin/perl # # LCDdisplay.pl # This script draws a simulated seven segment LCD Display. # Segments are drawn as 4 or 6 sided polygons # The colon(:) is drawn as 2 ellipses # For demo purposes the value to be displayed is stored in %wxGlobals{ +mValue} # # Written in wxPerl. Tested on Citrus Perl 5.16 with wxWidgets 2.8.x. # Ported by: James M. Lynes. Jr. # Last Modified Date: January 18, 2013 # # Adapted from LCDWindow.cpp by Marco Cavallini # based in part(mostly) on the work of # the KWIC project (http://www.koansoftware.com/kwic/index.htm). # Referenced on pg 596 of the "Wx Book" - # "Cross-Platform GUI Programming with wxWidgets", Smart, Hock, & Csom +or # # use 5.010; # Using Given/When use strict; use warnings; use Wx qw(:everything :allclasses); use Wx::Event qw( EVT_PAINT EVT_SIZE ); my %wxGlobals = ( # Configuration Data mSegmentLen => 40, mSegmentWidth => 10, mSpace => 5, mNumberDigits => 6, mValue => "12:45", # Default string to be +displayed LCD_Number_Segments => 8, mLightColour => sub{Wx::Colour->new(0, 255, 0)}, # +Bright green mGrayColour => sub{Wx::Colour->new(0, 64, 0)}, + # Dim green mDefaultColour => sub{Wx::Colour->new(0, 0, 0)}, +# Black ); my %wxDigitData = ( # Actual string to be displ +ayed value => "", comma => 0, # 0=false, 1=true ? this fe +ature ); my %ctbl = ( # Map character to segments - 0 => 0x3F, # Not defined in the 7-segme +nt "abcdefg" format 1 => 0x14, 2 => 0x6D, # ***0*** Bit Num +bers -654 3210 3 => 0x75, # * * 4 => 0x56, # 1 2 5 => 0x73, # * * 6 => 0x7B, # ***6*** 7 => 0x15, # * * 8 => 0x7F, # 3 4 9 => 0x77, # * * A => 0x5F, # ***5*** B => 0x7A, C => 0x2B, D => 0x7C, E => 0x6B, F => 0x4B, '-' => 0x40, '_' => 0x20, '^' => 0x47, # code for degree symbol '=' => 0x61, # code for undefined symbo +l ' ' => 0x00, # code for a space ); # Other options could be added # # Main Application --------------------------------------------------- +-------------------- # my $app = Wx::SimpleApp->new; my $frame = Wx::Frame->new(undef, -1, "Simulated 7-segment LCD Display +", wxDefaultPosition, [400,150]); $frame->SetBackgroundColour($wxGlobals{mDefaultColour}->()); EVT_PAINT( $frame, \&onPaint ); EVT_SIZE( $frame, \&onSize ); $frame->Show; $app->MainLoop; # # Dismiss a size event # sub onSize{ my($self, $event) = @_; $event->Skip(); } # # Paint the simulated LCD Display ------------------------------------ +---------------------- # sub onPaint{ my($self, $event) = @_; my $disp = Wx::PaintDC->new($self); # Create paint +device context my( $dw, $dh) = $disp->GetSizeWH(); # Calculate dis +play scaling my $bw = GetBitmapWidth(); my $bh = GetBitmapHeight(); my $xs = $dw/$bw; my $ys = $dh/$bh; my $as = $xs > $ys ? $ys : $xs; $disp->SetUserScale($as, $as); $disp->SetDeviceOrigin((($dw-$bw*$as)/2), (($dh-$bh*$as)/2)); DoDrawing($disp); # Paint the display } sub DoDrawing{ my($dc) = @_; my @cbuf = reverse(split(//,$wxGlobals{mValue})); # Process + one character at a time my $cbuflen = @cbuf; if($cbuflen > $wxGlobals{mNumberDigits}) { # Truncate s +tring to max display width $cbuflen = $wxGlobals{mNumberDigits}; } my $ctr = 0; while($ctr < $cbuflen) { $wxDigitData{value} = $cbuf[$ctr]; $wxDigitData{comma} = 0; # ? not clear on comma + feature yet DrawDigit($dc, $ctr); $ctr++ } } sub DrawDigit{ my($dc, $digit) = @_; my $value = $wxDigitData{value}; my $dec = Decode($value); if($value eq ':') { # Draw a colon(:) DrawTwoDots($dc, $digit); } else{ my $ctr = 0; while($ctr < $wxGlobals{LCD_Number_Segments}-1) { DrawSegment($dc, $digit, $ctr, ($dec>>$ctr)&1); $ctr++; } DrawSegment($dc, $digit, 7, $wxDigitData{comma}); # ? not c +lear on digit 7 yet } } sub DrawTwoDots{ # Draws a colon(:) my($dc, $digit) = @_; my $sl = $wxGlobals{mSegmentLen}; my $sw = $wxGlobals{mSegmentWidth}; my $sp = $wxGlobals{mSpace}; my $x = DigitX($digit); my $y = DigitY($digit); $x += ($sl/2)-$sw; $y += ($sl/2)-$sw; my $brushOn = Wx::Brush->new($wxGlobals{mLightColour}->(), wxSOLID +); $dc->SetBrush($brushOn); $dc->SetPen(Wx::Pen->new($frame->GetBackgroundColour(), 1, wxSOLID +)); $dc->DrawEllipse($x, $y, $sw*2, $sw*2); $y += $sl; $dc->DrawEllipse($x, $y, $sw*2, $sw*2); } sub DrawSegment{ my($dc, $digit, $segment, $state) = @_; my $sl = $wxGlobals{mSegmentLen}; my $sw = $wxGlobals{mSegmentWidth}; my $x = DigitX($digit); my $y = DigitY($digit); my $brushOn = Wx::Brush->new($wxGlobals{mLightColour}->(), wxSOLID +); my $brushOff = Wx::Brush->new($wxGlobals{mGrayColour}->(), wxSOLID +); if($state) { # bit set for On segment $dc->SetBrush($brushOn); # Bright color for On +segment } else { # bit cleared for Off segment $dc->SetBrush($brushOff); # Dim color for Off s +egment } $dc->SetPen(Wx::Pen->new($frame->GetBackgroundColour(), 1, wxSOLID +)); my @points; # Verticies for 4 sided seg +ments my @p6; # Verticies for the 6 sided seg +ment given($segment) { when(0) { $points[0] = Wx::Point->new($x, $y); $points[1] = Wx::Point->new($x+$sl, $y); $points[2] = Wx::Point->new($x+$sl-$sw, $y+$sw); $points[3] = Wx::Point->new($x+$sw, $y+$sw); } when(1) { $points[0] = Wx::Point->new($x, $y); $points[1] = Wx::Point->new($x, $y+$sl); $points[2] = Wx::Point->new($x+$sw, $y+$sl-$sw/2); $points[3] = Wx::Point->new($x+$sw, $y+$sw); } when(2) { $x += $sl-$sw; $points[0] = Wx::Point->new($x,$y+$sw); $points[1] = Wx::Point->new($x+$sw, $y); $points[2] = Wx::Point->new($x+$sw, $y+$sl); $points[3] = Wx::Point->new($x, $y+$sl-$sw/2); } when(3) { $y += $sl; $points[0] = Wx::Point->new($x, $y); $points[1] = Wx::Point->new($x, $y+$sl); $points[2] = Wx::Point->new($x+$sw, $y+$sl-$sw); $points[3] = Wx::Point->new($x+$sw, $y+$sw-$sw/2); } when(4) { $x += $sl-$sw; $y += $sl; $points[0] = Wx::Point->new($x, $y+$sw/2); $points[1] = Wx::Point->new($x+$sw, $y); $points[2] = Wx::Point->new($x+$sw, $y+$sl); $points[3] = Wx::Point->new($x, $y+$sl-$sw); } when(5) { $y += 2*$sl-$sw; $points[0] = Wx::Point->new($x+$sw, $y); $points[1] = Wx::Point->new($x+$sl-$sw, $y); $points[2] = Wx::Point->new($x+$sl, $y+$sw); $points[3] = Wx::Point->new($x, $y+$sw); } when(6) { $y += $sl-$sw/2; $p6[0] = Wx::Point->new($x, $y+$sw/2); $p6[1] = Wx::Point->new($x+$sw, $y); $p6[2] = Wx::Point->new($x+$sl-$sw, $y); $p6[3] = Wx::Point->new($x+$sl, $y+$sw/2); $p6[4] = Wx::Point->new($x+$sl-$sw, $y+$sw); $p6[5] = Wx::Point->new($x+$sw, $y+$sw); } default {} } if($segment < 6) { # Draw the 4 sided segme +nts(0-5) $dc->DrawPolygon(\@points, 0, 0); } elsif($segment = 6) { # Draw the 6 sided segmen +t(6) $dc->DrawPolygon(\@p6, 0, 0); } else { # ? not clear on this feature ye +t(7) $y += 2*$sl; $x += $sl; $dc->DrawEllipse($x+1, $y-$sw, $sw, $sw); } } sub Decode { # Table lookup for character t +o my($char) = @_; # Segment translation my $return; if(defined($ctbl{$char})) { $return = $ctbl{$char}; } else { $return = $ctbl{'='}; # Triple bar for und +efined character } } # # Support subs ------------------------------------------------------- +--------------------- # sub GetDigitWidth{ my $return = $wxGlobals{mSegmentLen} + $wxGlobals{mSegmentWidth} + + $wxGlobals{mSpace}; } sub GetDigitHeight{ my $return = ($wxGlobals{mSegmentLen}*2) + ($wxGlobals{mSpace}*2); } sub GetBitmapWidth{ my $return = ($wxGlobals{mNumberDigits}*GetDigitWidth()) + $wxGlob +als{mSpace}; } sub GetBitmapHeight{ my $return = GetDigitHeight(); } sub DigitX{ my($digit) = @_; my $return = GetBitmapWidth()-(($digit+1)*GetDigitWidth()); } sub DigitY{ my($digit) = @_; my $return = $wxGlobals{mSpace}; } sub SetNumberDigits{ my $ndigits = @_; $wxGlobals{mNumberDigits} = $ndigits; } sub SetValue{ my $value = @_; $wxGlobals{mValue} = $value; } sub GetValue{ my $return = $wxGlobals{mValue}; } sub GetNumberDigits{ my $return = $wxGlobals{mNumberDigits}; } sub SetLightColour{ my($ref) = @_; $wxGlobals{mLightColour} = $ref; } sub SetGrayColour{ my($ref) = @_; $wxGlobals{mGrayColour} = $ref; } sub GetLightColour{ my $ref = $wxGlobals{mLightColour}; } sub GetGrayColour{ my $ref = $wxGlobals{mGrayColour}; } sub GetDigitsNeeded{ my($string) = @_; $string =~ s/\.//; my $return = strlen($string); }

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

Comment on wxPerl Simulated 7 Segment LCD Display
Download Code
Re: wxPerl Simulated 7 Segment LCD Display
by ww (Bishop) on Jan 19, 2013 at 01:42 UTC
    Nicely done.

    A followup( to convert this to a running clock) should be easy and not too protracted a job.

    1. Remove (comment out) the mvalue in $wxGlobals{mValue}.
    2. Insert code to use localtime() to obtain $hour and $minute (as global vars).
    3. Write a routine to ensure those values have two digits.
    4. Use the (global) formatted $hour and $min in the sub do drawing{ instead of the hash element.
    5. And, of course, put the whole thing in a loop with a sleep 15 (or so, +/-) so the clock will update.

    Of course, there are easier ways -- including perching a USD 2.49 (cheapo) clock in your view... and better than this top-of-the-head expression of enthusiasm for your "learning...taking place." :)

Re: wxPerl Simulated 7 Segment LCD Display
by Athanasius (Prior) on Jan 19, 2013 at 04:57 UTC

    As ww says, nicely done! A couple of minor points:

    1. In sub DrawSegment{, the line:

      elsif($segment = 6) { # Draw the 6 sided segment(6)

      is almost certainly a mistake: it sets $segment to the value 6, which is “true”, so the following else block will never be reached. Replace = with ==.

    2. A subroutine such as:

      sub GetValue{ my $return = $wxGlobals{mValue}; }

      would be better written as:

      sub GetValue{ return $wxGlobals{mValue}; }

      as the lexical variable $return serves no purpose here — it is being created and initialised only to be immediately thrown away. Likewise, this:

      sub Decode { # Table lookup for character t +o my($char) = @_; # Segment translation my $return; if(defined($ctbl{$char})) { $return = $ctbl{$char}; } else { $return = $ctbl{'='}; # Triple bar for undefined cha +racter } }

      works, but only (in a sense) by accident: the last expression evaluated will be an assignment to $return, so the value assigned will be returned by the sub. But with a small code change, this logic could easily break. Simpler, safer, and clearer:

      sub Decode # Table lookup for character t +o segment translation { my ($char) = @_; if (defined $ctbl{$char}) { return $ctbl{$char}; } return $ctbl{'='}; # Triple bar for undefined cha +racter }

      Update: ++BrowserUk for the much better version below!

    Hope that helps,

    Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

      Simpler, safer, and clearer:

      Or just:

      # Table lookup for character to segment translation sub Decode { $ctbl{ $_[0] } // $ctbl{ '=' } }

      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
Re: wxPerl Simulated 7 Segment LCD Display
by jmlynesjr (Pilgrim) on Jan 20, 2013 at 02:06 UTC

    Thank you ww, Athanasius, & BrowserUK for the comments.

    The $segment = 6 does look wrong, but the six-sided segment is getting drawn. I will make the suggested changes and replace the code in the post. A clock will make a nice follow-on project and was another of the examples in the KWIC project.

    Update1: After a more careful reading of the comments, it's the following else clause that's not getting executed which happens to be part of the logic I haven't figured out yet. It's probably supposed to draw a comma or decimal point.

    Update2: The $segment = 6 error/typo was preventing the comma(EU)/decimal(USA) point from being drawn. This and other changes are included below.

    James

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