utils/todologo

   1 #!/usr/bin/perl
   2 # $Id$
   3 #
   4 # Author: Tomi Ollila <Tomi.Ollila@iki.fi>
   5 #
   6 # Created: Tue Oct 10 18:04:02 2000 too
   7 # Last modified: Wed Oct 25 22:41:50 2000 too
   8 #
   9 # HISTORY
  10 # $Log$
  11 # Revision 1.1.1.1  2001/11/25 21:59:23  short
  12 # :pserver:cvs@pserver.samba.org:/cvsroot - gnokii - Sun Nov 25 22:56 CET 2001
  13 #
  14 # Revision 1.1  2000/11/03 13:18:08  pavel
  15 #
  16 # Tomi's todologo.
  17 #
  18
  19
  20 $a1= " a  b    c dd  ee ff  gg h h i   j k   l  m m nn   o  pp   q  r r ss ";
  21 $a2= "a a bb  c  d d ee f  g   hhh i   j k k l  mmm n n o o p p q q rr  s  ";
  22 $a3= "aaa b b c  d d e  ff g g hhh i j j kk  l  m m n n o o pp   q  r    s ";
  23 $a4= "a a bb   c dd   e f   gg h h i  j  k k ll m m n n  o  p     q r   ss ";
  24
  25 $a1 .= "ttt u u v v w w x x y y zz 333 4   55   6 777  88  9  ";
  26 $a2 .= " t  u u v v w w  x  y y  z  3  4 4 5   6    7  88 9 9 ";
  27 $a3 .= " t  u u v v www  x   y  z    3 444  5 6 6  7  88   9  ";
  28 $a4 .= " t  uuu  v  w w x x  y  zz 33    4 5   6   7  88  9   ";
  29
  30 $a1 =~ tr/ /0/;
  31 $a2 =~ tr/ /0/;
  32 $a3 =~ tr/ /0/;
  33 $a4 =~ tr/ /0/;
  34
  35
  36 sub searchalpha
  37 {
  38     $_ = $_[0];
  39     tr/A-Z/a-z/;
  40     tr/210/zio/;
  41
  42     $width = 1;
  43     $aa1 = $aa2 = $aa3 = $aa4 = '0';
  44
  45     $i = index $a4, $_; return if ($i < 0);
  46     $m = index $a3, $_; $i = $m if ($i >= 0 && $m < $i);
  47     $m = index $a2, $_; $i = $m if ($i >= 0 && $m < $i);
  48     $m = index $a1, $_; $i = $m if ($i >= 0 && $m < $i);
  49
  50     $j = rindex $a4, $_;
  51     $m = rindex $a3, $_; $j = $m if ($m > $j);
  52     $m = rindex $a2, $_; $j = $m if ($m > $j);
  53     $m = rindex $a1, $_; $j = $m if ($m > $j);
  54
  55
  56     $width = $j - $i + 2;
  57
  58     $aa1 = substr $a1, $i, $width; $aa1 =~ tr/0/1/c;
  59     $aa2 = substr $a2, $i, $width; $aa2 =~ tr/0/1/c;
  60     $aa3 = substr $a3, $i, $width; $aa3 =~ tr/0/1/c;
  61     $aa4 = substr $a4, $i, $width; $aa4 =~ tr/0/1/c;
  62 }
  63
  64 @ilines = split /\s*-\s*/, "@ARGV";
  65
  66 for ($i = 0; $i < 14; $i++)
  67 {
  68     $line[$i] = "0" x 72;
  69 }
  70
  71 $l = 0;
  72 foreach (@ilines)
  73 {
  74     $p = 0;
  75
  76     @lc = split //, $_;
  77
  78     foreach (@lc)
  79     {
  80         searchalpha($_);
  81         $l1 .= $aa1;
  82         $l2 .= $aa2;
  83         $l3 .= $aa3;
  84         $l4 .= $aa4;
  85     }
  86
  87     $line[$l++] = substr $l1 . "0" x 72, 0, 72;
  88     $line[$l++] = substr $l2 . "0" x 72, 0, 72;
  89     $line[$l++] = substr $l3 . "0" x 72, 0, 72;
  90     $line[$l++] = substr $l4 . "0" x 72, 0, 72;
  91     $line[$l++] = "0" x 72;
  92
  93     undef $l1;  undef $l2;  undef $l3;  undef $l4;
  94 }
  95
  96 # header is just copied from gnokii.nol.
  97 print "NOL\000\001\000\346\000\001\000\110\000\016\000\001\000\001\000\126\000";
  98
  99 for ($i = 0; $i < 14; $i++)
 100 {
 101     print "$line[$i]";
 102 }