From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sat, 2 Jul 2022 10:54:10 +0000 (+0100)
Subject: wip export
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=commitdiff_plain;h=4952809ec8caf1cf452b38a4e445be22f0f8e8e2;p=quacks.git

wip export

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---

diff --git a/Quacks.pm b/Quacks.pm
index cc80f70..7980d03 100644
--- a/Quacks.pm
+++ b/Quacks.pm
@@ -11,6 +11,13 @@ use Exporter qw(import);
 our @EXPORT = qw(
 
  $pumpkin $green $red $blue $yellow $moth $purple $lotus $white
+ $anychip $black colour
+
+ $ps_framing
+
+ $page_pre ps_head
+
+ arrow_any
 
 	       );
 
@@ -23,3 +30,85 @@ our $moth    = [" 0  0  0", "1 1 1"];
 our $purple  = ["145/44/238", "0 0 0"];
 our $lotus   = [("0/245/255",) x 2];
 our $white   = ["1  1   1", "0 0 0"];
+
+our $anychip = ['0.8', '0'];
+our $black = colour('0');
+
+sub colour ($) {
+  my ($c) = @_;
+  if ($c =~ m{^(\d+)/(\d+)/(\d+)$}) {
+    return (join ' ', map { $_ / 255.0 } ($1,$2,$3)).' setrgbcolor';
+  } elsif ($c =~ m/[^ 0-9.]/) {
+    return $c;
+  } elsif ($c =~ m/^\s*\S+\s*$/) {
+    return "$c setgray";
+  } elsif ($c =~ m/./) {
+    return "$c setrgbcolor";
+  } else {
+    return '';
+  }
+}
+
+our $page_pre = <<END;
+72 25.4 div dup scale
+%210 0 translate
+%90 rotate
+7 30 translate
+END
+
+our $ps_framing = '';
+
+sub arrow_any ($) { <<END;
+  $black 1 setlinewidth
+    newpath
+       $_[0]
+       arrowlen 0 moveto
+       arrowhead dup neg exch  rmoveto
+       arrowhead dup neg       rlineto
+       arrowhead neg dup       rlineto
+       stroke
+END
+};
+
+sub ps_head () {
+  $ps_framing .= <<END;
+%!
+
+$page_pre
+
+/tw 57.5 def
+/th 73 def
+/bdiag 5 def
+/thirdlineh 0.45 def
+/costcirch 0.3 def
+/chip 15 def
+/spot 3.5 def
+/arrowlen 6 def
+/arrowhead 3 def
+/putback_len 10 def
+
+/costtexth 0.215 def
+/costtextsz 12 def
+/costtextdx -0.03 def
+/costfont /Heletica-BoldOblique findfont costtextsz scalefont def
+
+/rubysz 4 def
+
+% diagonal conversion
+/dc {                    % xprop yprop
+    dup th mul           % xprop yprop y
+    3 1 roll             % y xprop yprop
+    bdiag mul neg        % y xprop x-margin-at-this-height
+    tw add               % y xprop x-width-at-this-height
+    exch mul             % y x-width-at-this-height xprop
+    exch                 % x y
+} def
+
+/arrow {
+  ${\ arrow_any("0 0 moveto  arrowlen 0 rlineto") }
+} def
+
+END
+}
+
+1;
diff --git a/pumpkin-books.ps.pl b/pumpkin-books.ps.pl
index 89a78af..377bb7b 100755
--- a/pumpkin-books.ps.pl
+++ b/pumpkin-books.ps.pl
@@ -8,32 +8,6 @@ use strict;
 BEGIN { unshift @INC, '.'; }
 use Quacks;
 
-my $anychip = ['0.8', '0'];
-
-our $page_pre = <<END;
-72 25.4 div dup scale
-%210 0 translate
-%90 rotate
-7 30 translate
-END
-
-sub colour ($) {
-  my ($c) = @_;
-  if ($c =~ m{^(\d+)/(\d+)/(\d+)$}) {
-    return (join ' ', map { $_ / 255.0 } ($1,$2,$3)).' setrgbcolor';
-  } elsif ($c =~ m/[^ 0-9.]/) {
-    return $c;
-  } elsif ($c =~ m/^\s*\S+\s*$/) {
-    return "$c setgray";
-  } elsif ($c =~ m/./) {
-    return "$c setrgbcolor";
-  } else {
-    return '';
-  }
-}
-
-our $black = colour('0');
-
 sub chip ($$) {
   my ($cary, $pips) = @_; # put in a gsave translate
   my $o = <<END;
@@ -614,58 +588,7 @@ END
 
   $o;
 }
-
-sub arrow_any ($) { <<END;
-  $black 1 setlinewidth
-    newpath
-       $_[0]
-       arrowlen 0 moveto
-       arrowhead dup neg exch  rmoveto
-       arrowhead dup neg       rlineto
-       arrowhead neg dup       rlineto
-       stroke
-END
-};
-
-
-our $ps_framing = <<END;
-%!
-
-$page_pre
-
-/tw 57.5 def
-/th 73 def
-/bdiag 5 def
-/thirdlineh 0.45 def
-/costcirch 0.3 def
-/chip 15 def
-/spot 3.5 def
-/arrowlen 6 def
-/arrowhead 3 def
-/putback_len 10 def
-
-/costtexth 0.215 def
-/costtextsz 12 def
-/costtextdx -0.03 def
-/costfont /Heletica-BoldOblique findfont costtextsz scalefont def
-
-/rubysz 4 def
-
-% diagonal conversion
-/dc {                    % xprop yprop
-    dup th mul           % xprop yprop y
-    3 1 roll             % y xprop yprop
-    bdiag mul neg        % y xprop x-margin-at-this-height
-    tw add               % y xprop x-width-at-this-height
-    exch mul             % y x-width-at-this-height xprop
-    exch                 % x y
-} def
-
-/arrow {
-  ${\ arrow_any("0 0 moveto  arrowlen 0 rlineto") }
-} def
-
-END
+ps_head();
 
 sub def_image ($$) {
   my ($ncomps, $name) = @_;