home *** CD-ROM | disk | FTP | other *** search
/ Computer Club Elmshorn Atari PD / CCE_PD.iso / pc / 0400 / CCE_0417.ZIP / CCE_0417.PD / ASCREEN.ZOO / fontstuf / flip next >
Text File  |  1992-03-19  |  3KB  |  87 lines
  1. #!/usr/local/bin/perl
  2. # flip --- generiert FLIB-Zeichensatzbibliothek aus Dateihierarchie
  3. # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  4. # Copyright (C) 1992 by Anselm Lingnau. Alle Rechte vorbehalten.
  5. #
  6. # Sie d"urfen dieses Skript frei benutzen und weitergeben, solange Sie dadurch
  7. # kein Geld verdienen oder behaupten, Sie h"atten es geschrieben.
  8. #
  9. # Achtung: Dieses Skript macht diverse unangebrachte Annahmen "uber das
  10. # TeX-System, auf dem die Zeichens"atze generiert werden. Insbesondere geht
  11. # es davon aus, dass die Zeichens"atze eine Aufl"osung von 101dpi haben
  12. # (siehe Definition von %mag), dass keine Zeichens"atze auftreten, deren
  13. # Vergr"osserung anders ist als 0.8, 0.9, 1.0, magstephalf und magstep1..5
  14. # (siehe ebenfalls Definition von %mag), und dass die zu packenden Zeichens"atze
  15. # in Unterverzeichnissen der Form `pk<dpi>' des `Grundverzeichnisses' stehen.
  16. # Es funktioniert f"ur mich auf einem IBM RISC System/6000. Your mileage may
  17. # vary.
  18. #
  19. ($dir, $res, $flib, $pat) = @ARGV;
  20. unless (defined $dir) {
  21.     print "Verzeichnis, das die pk-Verzeichnisse enth\"alt: ";
  22.     chop($dir = <STDIN>);
  23. }
  24. unless (defined $res) {
  25.     print "Aufl\"osung des Ger\"ats in dpi: ";
  26.     chop($res = <STDIN>);
  27. }
  28. unless (defined $flib) {
  29.     print "Name der zu erzeugenden FLIB-Datei: ";
  30.     chop($flib = <STDIN>);
  31. }
  32. unless (defined $pat) {
  33.     print "Perl-Regexp f\"ur die zu packenden Dateien (oder <Enter>): ";
  34.     chop($pat = <STDIN>);
  35.     $pat = '.*' if $pat eq '';
  36. }
  37. opendir(THISDIR, $dir);
  38. @allfiles = readdir(THISDIR);
  39. closedir(THISDIR);
  40.  
  41. open(FLIB, ">$flib") || die "couldn't open $flib\n";
  42.  
  43. # Diese Tabelle "ubersetzt DPI-Werte in Scaled-Werte. Grausig, aber wahr.
  44.  
  45. %mag = ( 81, 0.8, 91, 0.9, 101, 1.0, 111, 1.095, 121, 1.2,
  46.     145, 1.44, 175, 1.44*1.2, 209, 1.44*1.44, 251, 1.2 ** 5);
  47.  
  48. @sizes = sort { $a <=> $b; } grep(s/^pk//, @allfiles);
  49. $total_names = $total_fonts = 0;
  50. chop($cwd = `pwd`);
  51. for $d (@sizes) {
  52.     print "pk$d\n";
  53.     chdir "$cwd", chdir "$dir/pk$d";
  54.     opendir(FONTDIR, ".");
  55.     @ffs = grep(($_) = /^(\w+)\.\d+pk$/, readdir(FONTDIR));
  56.     closedir(FONTDIR);
  57.     $sfonts{$d} = @ffs, $dpi{$d} = int($res * $mag{$d} * 65536 + .5);
  58.     $sn = 0;
  59.     for (sort @ffs) {
  60.         next unless /$pat/;
  61.         $name = "$_.${d}pk";
  62.         $size = -s $name;
  63.         print "$name ($size bytes)\n";
  64.         $sn += length($_); $total_fonts++;
  65.         push(@fonts, $_, length($files), $size);
  66.         open(F, "$name") || die "couldn't open $dir/pk$d/$name\n";
  67.         read(F, $f, $size) || die "couldn't read $dir/pk$d/$name\n";
  68.         $files .= $f;
  69.     }
  70.     $snames{$d} = $sn; $total_names += $sn;
  71. }
  72.  
  73. $dirlen = 8 * @sizes + 9 * $total_fonts + $total_names;
  74. print FLIB "FLIB\002\000" . pack("S3", $dirlen, scalar(@sizes),
  75.                     $total_fonts) . "\000\000";
  76. for (@sizes) {
  77.     $sizlen = 9 * $sfonts{$_} + $snames{$_};
  78.     print FLIB pack("S2I", $sizlen, $sfonts{$_}, $dpi{$_});
  79.     for (1 .. $sfonts{$_}) {
  80.         ($name, $off, $size) = splice(@fonts, 0, 3);
  81.         printf "%8u %8u %s\n", $off, $size, $name;
  82.         print FLIB pack("I2C", $size, $off + $dirlen + 14,
  83.                         length($name)), $name;
  84.     }
  85. }
  86. print FLIB $files;
  87.