### Comment on

 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!
• Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
• Read Where should I post X? if you're not absolutely sure you're posting in the right place.
• 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
• You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
 For: Use: & & < < > > [ [ ] ]
• Link using PerlMonks shortcuts! What shortcuts can I use for linking?

Create A New User
Chatterbox?
 [robby_dobby]: marto: Ldn, right now [marto]: icy here today, snow on the hills [Corion]: Oh yes, Friday! [Corion]: Last day at \$work before 3 weeks of vacation (well, not that I'd be really travelling, but no-work-time ;) ) [robby_dobby]: marto: yeah, I'd eventually visit Glasgow some day - just to visit the home town of GHC :-) [robby_dobby]: Corion: Oh, that's awesome! Your timing is perfect enough to see all hell break loose when you get back at work :P [marto]: well, let me know in advance, I'll buy you a pint :) [Corion]: robby_dobby: No, I'm returning in the second workweek of January. The main hectic parts are in the first days after the start of the new year [robby_dobby]: marto: and, I'm not sure I'd be around here long enough for YAPC::EU [marto]: Corion nice, what are you plans for Christmas?

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (10)
As of 2017-12-15 10:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
What programming language do you hate the most?

Results (431 votes). Check out past polls.

Notices?