Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Snoopy Calendar

by timpoiko (Novice)
on May 18, 2014 at 08:08 UTC ( #1086485=CUFP: print w/ replies, xml ) Need Help??

I heard that every real programmer has a Snoopy Calendar dated from 1969. Because Fortran felt slightly uncomfortable for me, I decided to make own version with Perl. In my country first day of week is Monday. You can modify the zeller function if this is a question. This is not obfuscated code, but this code is not written as clearly as possible. Since this code requires some data, at bottom of message there is a link to .tar.bz2. Have fun.

#!/usr/bin/perl # Copyleft Timo Poikola use strict; my %N; $N{0} = " 000 0 00 00 0 000 "; $N{1} = " 1 11 1 1 11111"; $N{2} = " 222 2 2 2 2 22222"; $N{3} = "33333 3 33 3 3 333 "; $N{4} = " 4 44 4 4 44444 4 "; $N{5} = "555555 5555 55555 "; $N{6} = " 666 6 6666 6 6 666 "; $N{7} = "77777 7 7 7 7 "; $N{8} = " 888 8 8 888 8 8 888 "; $N{9} = " 999 9 9 9999 9 999 "; $N{_} = " "; my @t = localtime(time); my $a = defined $ARGV[0]? $ARGV[0] : $t[5]+1900; my @dim = (undef,31,28,31,30,31,30,31,31,30,31,30,31); sub pn { my $n = shift; my $r = shift; if ($n eq "I") { print " I "; } else { print " "; print substr $N{$n},5*$r,5; print " "; } return $n; } sub zeller { use integer; my $month = shift; my $day = shift; my $year = shift; my $aa = (14 - $month) / 12; my $y = $year - $aa; my $m = $month + 12*$aa - 2; 1+(--$day + $y + $y/4 - $y/100 + $y/400 + (31*$m)/12) %7; } sub lightyear { my $ly = shift; return 1 if (0 == $ly % 4 and 0 != $ly % 100 or 0 == $ly % 400); return 0; } my $text = do { local( @ARGV, $/ ) = "snpdat.txt" ; <> } ; my @str = split //, do {local (@ARGV, $/ ) = "data.txt" ; <> } ; my $ascii = ""; for my $i (0..scalar(@str)/2-1) { $ascii .= $str[2*$i + 1] x unpack("C", $str[2*$i]); } my @art = split(/1/, $ascii); my $d="DAY"; sub label { my $z = shift; $z--; substr $text, $z*553,553; } $dim[2]++ if lightyear($a); for my $cnt (1..13) { my $aux; my $aux2; my $s; my $mm = $cnt; if ($cnt == 13) { $a++; $mm = 1; } $aux = zeller($mm,1,$a); if ($aux > 1) { if ($aux >= 3) { $aux--; $s .= "__I"x$aux; } else { $s .= "__I"; } } for $aux (1..$dim[$mm]) { if ($aux < 10) { $s .="_"; } $s .= $aux; if ((zeller($mm,$aux,$a) == 7) && ($aux < $dim[$mm])) { $s .= "\n"; } elsif ((zeller($mm,$aux,$a) == 7) && ($aux == $dim[$mm])) { $s .= " "; } else { $s .= "I"; } if (($aux == $dim[$mm]) && (zeller($mm,$aux,$a)) < 7) { $aux2 = 7-zeller($mm,$aux,$a); if ($aux2 == 1) { $s .= "__"; } else { $s .= "__I"x($aux2-1); } } } my @arr = split(/\n/, $s); my @l = split(/\n/, label($mm)); print @art[$cnt],"\n\n"; $a =~ /(.)(.)(.)(.)/; print" "x8;pn($2,0);print" "x13,$l[0]," "x13;pn($3,0);print "\n"; print" "x8;pn($2,1);print" "x13,$l[1]," "x13;pn($3,1);print "\n"; print" ";pn($1,0);pn($2,2);print" "x13,$l[2]," "x13;pn($3,2);pn($4,0 +);print"\n"; print" ";pn($1,1);pn($2,3);print" "x13,$l[3]," "x13;pn($3,3);pn($4,1 +);print"\n"; print" ";pn($1,2);pn($2,4);print" "x13,$l[4]," "x13;pn($3,4);pn($4,2 +);print"\n"; print" ";pn($1,3);print" "x20,$l[5]," "x20;pn($4,3);print "\n"; print" ";pn($1,4);print" "x20,$l[6]," "x20;pn($4,4);print "\n\n"; print " "x9,"MON$d"," "x12,"TUES$d"," "x10,"WEDNES$d"," "x9,"THURS$d +"," "x11,"FRI$d"," "x11,"SATUR$d"," "x10,"SUN$d\n"; for (@arr) { print " "," "x20,"I"," I"x5," "x20,"\n"; for my $x (0..4) { print " ";s/(.)/pn($1,$x)/eg;print"\n"; } print " "," "x20,"I"," I"x5," "x20,"\n"; print " ","-"x20,"I","-----------------I"x5,"-"x20,"\n"; } print "\n\n"; }
http://ig.fi/snoopy.tar.bz2 : Datafiles and source

Comment on Snoopy Calendar
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://1086485]
Approved by boftx
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (4)
As of 2014-10-25 22:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (149 votes), past polls