Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

Early yesterday, there was a mention of Thinkgeek's BCD Clock in the chatterbox. Later in the day, another friend mentioned it to me. Given 2 occurances in the same day, I figured fate *had* to be telling me something, and so here we are. :)

Anyways, this code is a direct simulation of the electrical schmatic needed to build such a clock, with a few lines of "pure perl" used to initialize it to the correct time. You may want to adjust the last 3 lines so that the output looks best on your console.

A gold star to anyone who can draw up a correct state-diagram or schematic based on this code.

Update: If the output looks garbled on your console, change lines 115 and 174 to the versions that are commented out below them.

Update 2: Added output flush thanks to broquaint, which should improve output on some systems.

#!/usr/bin/perl # Binary Logic? use strict; use warnings 'all'; ++$|; ################################ # Combinational Blocks sub inv($) { 0+(!$_[0]) } sub nand($$) { inv ($_[0] && $_[1]) } sub mux_2x1 { my $select = shift; ($select && $_[0]) || (inv $select && $_[1]) } ################################ # Counter Functions # BCD - 0-9 my $r_a = sub { ( $_[0] && inv $_[2] && inv $_[3] ) || ( $_[1] && $_[2] && $_[3] ) }; my $r_b = sub { ( $_[1] && inv $_[2] ) || ( $_[1] && $_[2] && inv $_[3] ) || ( inv $_[1] && $_[2] && $_[3] ) }; my $r_c = sub { ( $_[2] && inv $_[3] ) || ( inv $_[0] && inv $_[2] && $_[3] ) }; # 0-5 my $l_b = sub { ( inv $_[0] && $_[2] && $_[3] ) || ( $_[1] && inv $_[2] && inv $_[3] ) }; my $l_c = sub { ( $_[2] && inv $_[3] ) || ( inv $_[1] && inv $_[2] && $_[3] ) }; # 0-12 my $h_a = sub { ( $_[0] && inv $_[2] ) || ( $_[0] && inv $_[3] ) || ( $_[1] && $_[2] && $_[3] ) }; my $h_b = sub { ( $_[1] && inv $_[2] ) || ( $_[1] && $_[2] && inv $_[3] ) || ( inv $_[0] && inv $_[1] && $_[2] && $_[3] ) }; my $h_c = sub { $_[2] xor $_[3] }; # Flip my $d = sub { inv $_[3] }; ################################ # clock functions my $on_next = sub { inv $_[0] && $_[1] }; my $ground = sub { 0 }; my $voltage = sub { 1 }; ################################ # Sequential Blocks sub mk_sr_latch() { my $s = 0; return sub { my $clock_state = shift; $s = inv (nand nand($clock_state, $_[1]), nand(nand($clock_state, $_[0]), inv $s)); $s # We don't use R. } } sub mk_d_flipflop() { my $sr = mk_sr_latch; return sub { $sr->($voltage->(), $_[0], inv $_[0]); # We don't use Q' either. } } sub mk_counter(@) { my $clock = shift; my ($f1,$f2,$f3,$f4) = splice @_,0,4; my ($a,$b,$c,$d) = splice @_,0,4; my @dff = (mk_d_flipflop)x4; return sub { my $clock_state = $clock->(@_); my ($ta,$tb,$tc,$td) = ($a,$b,$c,$d); $a = mux_2x1($clock_state, $dff[0]->(0+$f1->($ta,$tb,$tc,$td)) +, $a); $b = mux_2x1($clock_state, $dff[1]->(0+$f2->($ta,$tb,$tc,$td)) +, $b); $c = mux_2x1($clock_state, $dff[2]->(0+$f3->($ta,$tb,$tc,$td)) +, $c); $d = mux_2x1($clock_state, $dff[3]->(0+$f4->($ta,$tb,$tc,$td)) +, $d); return ($a,$b,$c,$d); } } sub mk_output_reg() { my $space_count = mk_counter $voltage, $ground, $ground, $h_c, $d; my ($c1,$c2,$c3,$c4); my ($dff_3,$dff_4)=(mk_d_flipflop)x2; return sub { print chr mux_2x1($_[0],4,45); # If output is garbled, change to: # print chr mux_2x1($_[0],120,45); print mux_2x1($c3 && $c4," ",""); ($c1,$c2,$c3,$c4) = $space_count->(); $c3 = $dff_3->($c3); $c4 = $dff_4->($c4); } } ################################ # Use "pure perl" to intitialize # counters my (@i_sec1,@i_sec2,@i_min1,@i_min2,@i_hour,@i_ampm); my @sec = ((split//,sprintf("%04b",substr(sprintf("%02d",(localtime)[0 +]),0,1))), (split//,sprintf("%04b",substr(sprintf("%02d",(localtime)[0 +]),1,1)))); my @min = ((split//,sprintf("%04b",substr(sprintf("%02d",(localtime)[1 +]),0,1))), (split//,sprintf("%04b",substr(sprintf("%02d",(localtime)[1 +]),1,1)))); my @hr = split//,sprintf("%08b",(localtime)[2]-12) if (localtime)[2 +] > 11; @hr = split//,sprintf("%08b",(localtime)[2]) if (localtime)[2 +] < 12; @i_sec1 = @sec[4..7]; @i_sec2 = @sec[0..3]; @i_min1 = @min[4..7]; @i_min2 = @min[0..3]; @i_hour = @hr [4..7]; @i_ampm = (0,0,0,0+((localtime)[2]>11)); ################################ # Create our blocks my $sec1 = mk_counter $voltage, $r_a, $r_b, $r_c, $d, @i_sec1 +; my $sec2 = mk_counter $on_next, $ground, $l_b, $l_c, $d, @i_sec2 +; my $min1 = mk_counter $on_next, $r_a, $r_b, $r_c, $d, @i_min1 +; my $min2 = mk_counter $on_next, $ground, $l_b, $l_c, $d, @i_min2 +; my $hour = mk_counter $on_next, $h_a, $h_b, $h_c, $d, @i_hour +; my $ampm = mk_counter $on_next, $ground, $ground, $ground, $d, @i_ampm +; my ($ls1,$ls2,$lm1,$lm2,$lh1); my ($dff_s1,$dff_s2,$dff_m1,$dff_m2,$dff_h1) = (mk_d_flipflop)x5; my $output_reg = mk_output_reg; ################################ # Turn on while (1) { my ($s_b3,$s_b2,$s_b1,$s_b0) = $sec1->(); my ($s_b7,$s_b6,$s_b5,$s_b4) = $sec2->($s_b3,$ls1); my ($m_b3,$m_b2,$m_b1,$m_b0) = $min1->($s_b6,$ls2); my ($m_b7,$m_b6,$m_b5,$m_b4) = $min2->($m_b3,$lm1); my ($h_b3,$h_b2,$h_b1,$h_b0) = $hour->($m_b6,$lm2); my $am = $ampm->($h_b3,$lh1); print chr mux_2x1($am,17,16); # If output is garbled, change to: # print mux_2x1($am,'p','a'); print " "; # Cross wires and output # Abstracted with a loop to save 25 # lines of identical code foreach ($h_b3,$h_b2,$h_b1,$h_b0, $m_b7,$m_b6,$m_b5,$m_b4, $m_b3,$m_b2,$m_b1,$m_b0, $s_b7,$s_b6,$s_b5,$s_b4, $s_b3,$s_b2,$s_b1,$s_b0) { $output_reg->($_); } $ls1 = $dff_s1->($s_b3); $ls2 = $dff_s2->($s_b6); $lm1 = $dff_m1->($m_b3); $lm2 = $dff_m2->($m_b6); $lh1 = $dff_h1->($h_b3); sleep 1; # Separate output however you'd like. # print "\n"; # $^O !~ /win/i && system('clear'); $^O =~ /win/i && system('cls'); }

In reply to BCD Clock built using only binary logic. by jryan

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others musing on the Monastery: (13)
    As of 2014-10-21 10:25 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      For retirement, I am banking on:










      Results (99 votes), past polls