#!/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');
}