home *** CD-ROM | disk | FTP | other *** search
/ Fish 'n' More 2 / fishmore-publicdomainlibraryvol.ii1991xetec.iso / disks / disk454.lzh / Redaktu / Redaktu.ps < prev    next >
Text File  |  1991-02-14  |  17KB  |  495 lines
  1. %!PS-Adobe 2.0 for PixelScript interpreter on the Amiga 2000
  2. %%Title: Redaktu.ps
  3. %%Creator: John Wesley Starling
  4. %%CreationDate: 26 Jan 91
  5. %%BoundingBox: Not Applicable, edits a file,  nothing is drawn.
  6. %%Comments: Send suggestions & improvements to creator at his home %%address: 224 Rose Place,  Kalamazoo MI 49001-2617 USA
  7. %%EndComments
  8.  
  9. %=========================================
  10. %==== THESE ARRAYS ARE TO BE USED IN =====
  11. %====   FILES HAVING EITHER .myps    =====
  12. %====     OR .mytxt  SUFFIXES        =====
  13. %==== fill them in with your own     =====
  14. %====         definitions            =====
  15. %=========================================
  16.  
  17. /string1
  18. (
  19. /newdeffont {exch dup /grando exch def exch deffont} def
  20. /d {grando 1000 div mul} def
  21. /D {grando 750 div mul} def
  22. ) def
  23.  
  24. % newdeffont, d and D give you variables to use in creating characters
  25. % that will size themselves automatically in relation to the size of the
  26. % last defined font.  See how I used them in my definitions for the various
  27. % superscript characters in similar set described below.
  28.  
  29. /string2  () def
  30. /string99 () def
  31.  
  32. /prologArray [ string1 string2 string99 ] def
  33.  
  34. % PixelScript has a bug that will truncate long strings sent with the
  35. % writestring operator.  Breaking up your prolog insert into smaller
  36. % strings will overcome this.
  37.  
  38. /nonPrologArray [ (remove) (insert) ] def
  39.  
  40. /otherArray [ (remove) (insert) ] def
  41.  
  42. % PixelScript has another bug that will cause a series of odd control-2
  43. % characters to be present at the beginning of every string sent to your
  44. % text file.  These characters look like this...   but Pro Page
  45. % just ignores them when importing text.  So I did too.
  46.  
  47.  
  48. %====================================================
  49. %===== DEFINE STRINGS FOR INSERTION INTO PROLOG =====
  50. %=====     AND DEFINE SEARCH/REPLACE ARRAY      =====
  51. %=====        FOR USE IN .ps FILES ONLY         =====
  52. %====================================================
  53.  
  54. /fadeno1 (
  55.  
  56. /newdeffont {exch dup /grando exch def exch deffont} def
  57. /d {grando 1000 div mul} def
  58. /D {grando 750 div mul} def
  59.  
  60. /uSuper
  61.  {  gsave currentpoint translate newpath
  62.    -91 d -670 d moveto
  63.   -157 d -470 d -387 d -470 d -453 d -670 d curveto
  64.   -427 d -670 d lineto
  65.   -357 d -550 d -187 d -550 d -118 d -670 d curveto
  66.   closepath fill grestore} def
  67.  
  68. /USuper
  69.  {  gsave currentpoint translate newpath
  70.    -91 D -700 D moveto
  71.   -157 D -500 D -387 D -500 D -453 D -700 D curveto
  72.   -427 D -700 D lineto
  73.   -357 D -580 D -187 D -580 D -118 D -700 D curveto
  74.   closepath fill grestore} def
  75.  
  76. /SSuper
  77.  {  gsave currentpoint translate newpath
  78.     -51 D -565 D moveto -190 D -700 D lineto
  79.    -230 D -700 D lineto -369 D -565 D lineto
  80.    -349 D -555 D lineto -210 D -630 D lineto
  81.     -71 D -555 D lineto
  82.    closepath fill grestore} def ) def
  83.  
  84. /fadeno2 (
  85.  
  86. /sSuper
  87.  {  gsave currentpoint translate newpath
  88.     -50 d -535 d moveto -185 d -670 d lineto
  89.    -215 d -670 d lineto -350 d -535 d lineto
  90.    -325 d -525 d lineto -200 d -600 d lineto
  91.     -75 d -525 d lineto
  92.    closepath fill grestore} def
  93.  
  94. /CSuper
  95.  {  gsave currentpoint translate newpath
  96.     -51 D -560 D moveto -210 D -700 D lineto
  97.    -250 D -700 D lineto -413 D -560 D lineto
  98.    -387 D -550 D lineto -230 D -630 D lineto
  99.     -81 D -550 D lineto
  100.    closepath fill grestore} def
  101.  
  102. /cSuper
  103.  {  gsave currentpoint translate newpath
  104.     -36 d -530 d moveto -190 d -670 d lineto
  105.    -220 d -670 d lineto -388 d -530 d lineto
  106.    -362 d -520 d lineto -205 d -600 d lineto
  107.     -66 d -520 d lineto
  108.    closepath fill grestore} def ) def
  109.  
  110. /fadeno3 (
  111.  
  112. /GSuper
  113.  {  gsave currentpoint translate newpath
  114.     -81 D -560 D moveto -250 D -700 D lineto
  115.    -290 D -700 D lineto -459 D -560 D lineto
  116.    -429 D -550 D lineto -270 D -630 D lineto
  117.    -111 D -540 D lineto
  118.    closepath fill grestore} def
  119.  
  120. /gSuper
  121.  {  gsave currentpoint translate newpath
  122.     -91 d -535 d moveto -230 d -670 d lineto
  123.    -270 d -670 d lineto -409 d -535 d lineto
  124.    -389 d -525 d lineto -250 d -600 d lineto
  125.    -121 d -525 d lineto
  126.    closepath fill grestore} def
  127.  
  128. /JSuper
  129.  {  gsave currentpoint translate newpath
  130.      12 D -560 D moveto  -105 D -700 D lineto
  131.    -135 D -700 D lineto  -252 D -560 D lineto
  132.    -240 D -550 D lineto  -120 D -630 D lineto
  133.       0 D -550 D lineto
  134.    closepath fill grestore} def ) def
  135.  
  136. /fadeno4 (
  137.  
  138. /jSuper
  139.  {  gsave currentpoint translate newpath
  140.      12 d -530 d moveto  -90 d -720 d lineto
  141.    -150 d -720 d lineto -252 d -530 d lineto
  142.    closepath 1 setgray fill
  143.    newpath 0 setgray
  144.      12 d -530 d moveto  -107 d -670 d lineto
  145.    -133 d -670 d lineto  -252 d -530 d lineto
  146.    -233 d -520 d lineto  -120 d -600 d lineto
  147.      -7 d -520 d lineto
  148.    closepath fill grestore} def
  149.  
  150. /HSuper
  151.  {  gsave currentpoint translate newpath
  152.     -51 D -560 D moveto  -235 D -700 D lineto
  153.    -295 D -700 D lineto  -479 D -560 D lineto
  154.    -449 D -550 D lineto  -265 D -610 D lineto
  155.     -81 D -550 D lineto
  156.    closepath fill grestore} def
  157.  
  158. /hSuper
  159.  {  gsave currentpoint translate newpath
  160.     -81  d -755 d moveto -220  d -890 d lineto
  161.    -260  d -890 d lineto -399  d -755 d lineto
  162.    -379  d -745 d lineto -240  d -820 d lineto
  163.    -101  d -745 d lineto
  164.    closepath fill grestore} def
  165.  
  166. %% EndProlog
  167.  
  168. ) def     % string entry for psArray defined
  169.  
  170. /fadenArray [ fadeno1 fadeno2 fadeno3 fadeno4 ] def
  171.  
  172. /psArray [ ((c) show cSuper\n) ((c) sho)   ((C) show CSuper\n) ((C) sho)
  173.            ((u) show uSuper\n) ((u) sho)   ((U) show USuper\n) ((U) sho)
  174.            ((j) show jSuper\n) ((j) sho)   ((J) show JSuper\n) ((J) sho)
  175.            ((g) show gSuper\n) ((g) sho)   ((G) show GSuper\n) ((G) sho)
  176.            ((h) show hSuper\n) ((h) sho)   ((H) show HSuper\n) ((H) sho)
  177.            ((s) show sSuper\n) ((s) sho)   ((S) show SSuper\n) ((S) sho)
  178.          ] def
  179.  
  180.  
  181. %=======================================================
  182. %===== DEFINE THE ARRAY OF SEARCH/REPLACE STRINGS  =====
  183. %=====        FOR USE IN .txt FILES ONLY           =====
  184. %=======================================================
  185.  
  186. /txtArray [ (q)   (\\ls<1>c\\ls<0>)    (Q)   (\\ls<1>C\\ls<0>)
  187.             ([)   (\\ls<1>g\\ls<0>)    ({)   (\\ls<1>G\\ls<0>)
  188.             (])   (\\ls<1>h\\ls<0>)    (})   (\\ls<1>H\\ls<0>)
  189.             (y)   (\\ls<1>j\\ls<0>)    (Y)   (\\ls<1>J\\ls<0>)
  190.             (x)   (\\ls<1>s\\ls<0>)    (X)   (\\ls<1>S\\ls<0>)
  191.             (w)   (\\ls<1>u\\ls<0>)    (W)   (\\ls<1>U\\ls<0>)
  192.             (--)  (-\\t<-12>-\\t<0>)   (---) (-\\t<-12>--\\t<0>)
  193.             (...) (.\\t<-8>..\\t<0>)
  194.           ] def
  195.  
  196.  
  197. %===========================================
  198. %===== BEGIN DEFINITION OF PROCEDURES ======
  199. %===========================================
  200.  
  201.  
  202. /stringSplice            % assumes (Right) (Left)
  203.  
  204.   { dup length           % (Right) (Left) LLength
  205.     dup                  % (Right) (Left) LLength LLength
  206.     3 1 roll             % (Right) LLength (Left) LLength
  207.     3 index length       % (Right) LLength (Left) LLength RLength
  208.     add                  % (Right) LLength (Left) TotLength
  209.     string               % (Right) LLength (Left) (---------)
  210.     copy                 % (Right) LLength (Left-----)
  211.     /splice exch def     % (Right) LLength
  212.     splice               % (Right) LLength splice
  213.     3 1 roll exch        % splice (Right) LLeft
  214.     putinterval          % stack empty...
  215.     splice               % splice
  216.   } bind def             % ...splice = (LeftRight)
  217.  
  218. %==== NEW PROCEDURE ====
  219.  
  220. /rootOut              % assumed are... (bad) (good) (input)
  221.   {                   % def
  222.     {                 % loop
  223.       2 index         % (bad) (good) (input) (bad)
  224.       search          % (bad) (good) (post) (bad) (pre) true
  225.                       % (bad) (good) (input) false
  226.       dup {/trovis true def} if
  227.       {               % ifelse
  228.         exch pop      % (bad) (good) (post) (pre)
  229.         2 index       % (bad) (good) (post) (pre) (good)
  230.         exch          % (bad) (good) (post) (good) (pre)
  231.         stringSplice  % (bad) (good) (post) (pregood) &  splice = (pregood)
  232.         stringSplice  % (bad) (good) (pregoodpost) & splice = (pregoodpost)
  233.       }{              % ifelse
  234.         3 1 roll      % (pregoodpost) (bad) (good)
  235.         pop pop       % (pregoodpost)
  236.         exit          % ...break out of loop
  237.       } ifelse
  238.      } loop           % go back for next (bad)
  239.    } bind def
  240.  
  241.  
  242. %==== NEW PROCEDURE ====
  243.  
  244. /swapOut                       % assumed is...  (input)
  245.   {                            % def
  246.     dup                        % (input) (input)
  247.  
  248.     (mvx) search               % (input) (post) (mvx) (pre) true
  249.                                % (input) (input) false
  250.       { 3 1 roll               % (input) (pre) (post) (mvx)
  251.         pop pop                % (input) (pre)
  252.         outfile exch
  253.         writestring
  254.         ( mvx\n)
  255.         outfile exch           % (input)
  256.         writestring            % put back the integer and "mvx"
  257.       }{                       % ifelse
  258.          pop                   % (input)
  259.        } ifelse                % ifelse
  260.  
  261.  
  262.     mark exch         % mark (input)
  263.     swapArray         % mark (input) [ () ()...]
  264.     length            % mark (input) int
  265.     /longo exch def   % mark (input)
  266.     swapArray         % mark (input [ () ()...]
  267.     aload pop         % mark (input) () ()
  268.     longo 1 add       % mark (input) () () int
  269.     -1 roll           % mark () () (input)
  270.     longo 2 div cvi   % mark () () (input) int
  271.  
  272.       {                  % repeat
  273.          dup             % mark (good) (bad) (input) (input)
  274.          4 1 roll        % mark (input) (good) (bad) (input)
  275.          exch            % mark (input) (good) (input) (bad)
  276.          search          % mark (input) (good) (post) (bad) (pre) true
  277.                          % mark (input) (good) (input) false
  278.         {                % ifelse
  279.           4 -1 roll      % mark (input) (post) (bad) (pre) (good)
  280.           outfile
  281.           exch
  282.           writestring    % write substitution string to file
  283.           cleartomark    % stack empty
  284.           exit           % break out of loop
  285.         }{               % ifelse
  286.            pop pop       % (input)
  287.          } ifelse
  288.  
  289.       } repeat           % go back for next (bad)
  290.    } bind def
  291.  
  292. %==== NEW PROCEDURE ====
  293.  
  294.  
  295. /rootOutAll                    % assumed is... (input)
  296.    {                           % def
  297.      swapArray                 % (input) [(bad) (good)...]
  298.      dup length                % (input) [(b)(g)] int
  299.      /longo exch def           % (input) [(b)(g)]
  300.      aload pop                 % (input) (b) (g)
  301.      longo 1 add               % (input) (b) (g) int
  302.      -1 roll                   % (b) (g) (input)
  303.      longo 2 div cvi {rootOut} % ...search and replace entire input string.
  304.      repeat                    %  (output)
  305.    } bind def
  306.  
  307.  
  308. %==== NEW PROCEDURE ====
  309.  
  310.  
  311. /setFiles                     % assumed is (HD:Name.txt) or (HD:Name.ps)
  312.   {                           % def
  313.     /ps? false def            % initialize the flags
  314.     /txt? false def
  315.     /mytxt? false def
  316.     /myps? false def
  317.  
  318.     (\nChecking for proper suffix on input file... ) print flush
  319.     dup print flush
  320.     dup                       % (HD:Name.--) (HD:Name.--)
  321.     /infile exch (r) file def % (HD:Name.--)
  322.  
  323.     (.) search                % (-) (.) (HD:Name) true
  324.                               % (HD:Name) false
  325.  
  326.      {                        % ifelse true case assumes (-) (.) (HD:Name)
  327.        3 1 roll               % (HD:Name) (-) (.)
  328.        pop                    % (HD:Name) (-)
  329.                               % stack ready to compare suffixes
  330.  
  331.        dup                    % (HD:Name) (-) (-)
  332.        (txt) eq               % (HD:Name) (-) bool
  333.          {                    % if
  334.            (.fmtd)            % (HD:Name) (-) (.fmtd)
  335.            /txt? true def     % set flag
  336.          } if                 % if
  337.  
  338.        dup                    % (HD:Name) (-) (-)
  339.        (ps) eq                % (HD:Name) (-) bool
  340.          {                    % if
  341.            (.Eo-ps)           % (HD:Name) (-) (.Eo-ps)
  342.            /ps? true def
  343.          } if
  344.  
  345.        dup                    % (HD:Name) (-) (-)
  346.        (mytxt) eq             % if
  347.          {                    % (HD:Name) (-) bool
  348.            (.my-txt)          % (HD:Name) (-) (.mytxt)
  349.            /mytxt? true def   % set fllag
  350.          } if                 % if
  351.  
  352.        dup                    % (HD:Name) (-) (-)
  353.        (myps) eq              % (HD:Name) (-) bool
  354.          {                    % if
  355.            (.my-ps)           % (HD:Name) (-) (.my-ps)
  356.            /myps? true def    % set flag
  357.          } if                 % if
  358.  
  359.  
  360.         3 -1 roll                     % (-) (.suffix) (HD:Name)
  361.         stringSplice                 % (-) (HD:Name.suffix)
  362.         dup                          % (-) (HD:Name.suffix) (HD:Name.suffix)
  363.         /outfile exch (w) file def   % (-) (HD:Name.suffix)
  364.  
  365.         (\nThe name of your output file will be......... ) print flush
  366.  
  367.         print flush                  % (-)
  368.  
  369.  
  370.         myps? mytxt? or ps? or txt? or not
  371.         { (\n\nERROR -- UNKNOWN SUFFIX ON INPUT FILE !
  372. Input file suffix was...) print flush dup print flush  % prints suffix name
  373. (\n) print flush                                       % new line on screen
  374.         } if                                           % if
  375.  
  376.         pop                                            % empty stack
  377.  
  378.      }{                        % ifelse false case assumes (HD:Name)
  379.  
  380.         (\n\n ERROR -- NO SUFFIX ON INPUT FILE !
  381. Input file name was... ) print flush print flush       % prints file name
  382. (\n) print flush                                       % new line on screen
  383.       } ifelse                                         % ifelse, stack empty
  384.  
  385.      /ujo 1024 string def     % ujo is a holder for read strings
  386.   } def
  387.  
  388. %===== New Procedure =====
  389.  
  390. /editProlog
  391.       { %def
  392.         { %loop
  393.           infile ujo
  394.           readline not
  395.              { (\n\n"%%EndProlog" MISSING FROM INPUT FILE.
  396. Could not perform prolog insertion!\n \
  397. Check contents of input file.\n) print flush
  398.                exit
  399.              } if
  400.           dup
  401.           (%%EndProlog) eq
  402.              { (\n\nFound "%%EndProlog" comment. \n) print flush
  403.                pop
  404.                swapArray {outfile exch writestring} forall
  405.                (Prolog insertion successful. \n) print flush
  406.                exit
  407.              } if
  408.           ( \n) exch  stringSplice
  409.           outfile exch writestring
  410.         } bind loop
  411.       } def
  412.  
  413.  
  414. %===== New Procedure =====
  415.  
  416. /editNonProlog
  417.       { %def
  418.         (\nBusy editing page descriptions.\n) print flush
  419.         { %loop
  420.           infile ujo
  421.           readline not
  422.              { infile outfile currentfile
  423.                3 {closefile} repeat
  424.                exit
  425.              } if
  426.           dup
  427.           (-1.041 mvy) ne                    % baseline shift marker
  428.              {
  429.                (deffon) search               % (t) (deffon) (pre) true
  430.                                              % (input) false
  431.  
  432.                  { outfile exch writestring  % write in the (pre)
  433.                    pop pop                   % throw out (deffon) and (t)
  434.                    outfile (newdeffont \n) writestring
  435.                  }{                          % ifelse
  436.                     outfile exch writestring
  437.                     outfile (\n) writestring
  438.                   } ifelse
  439.              }{                              % ifelse
  440.                 pop
  441.                  infile ujo readline
  442.                  not { (\n\nERROR... a "-1.041 mvy" found out of place
  443. ) print flush} if
  444.                  swapOut
  445.                  infile ujo readline     % read and discard the "0.000 mvy"
  446.                  pop
  447.               }  ifelse
  448.         } bind loop
  449.         (\nAll done.  Ready for next operation.\n\n) print flush
  450.       } def
  451.  
  452.  
  453. %===== New Procedure =====
  454.  
  455. /editOther
  456.   { %def
  457.    { %loop
  458.      infile ujo
  459.      readline
  460.  
  461.       {                             %ifelse
  462.          ( \n) exch  stringSplice
  463.          rootOutAll
  464.          outfile exch writestring
  465.       }{                            %ifelse
  466.          ( \n) exch stringSplice
  467.          rootOutAll
  468.          outfile exch writestring
  469.          infile closefile
  470.          outfile closefile
  471.          exit
  472.        } ifelse                      % ifelse
  473.    } bind loop
  474.   } def
  475.  
  476.  
  477. %%EndProlog
  478.  
  479.  
  480.  
  481. setFiles
  482.  
  483. ps? { /swapArray fadenArray def editProlog
  484.       /swapArray psArray def editNonProlog
  485.     } if
  486.  
  487. txt? { /swapArray txtArray def editOther } if
  488.  
  489. myps? { /swapArray prologArray def editProlog
  490.         /swapArray nonPrologArray def editNonProlog
  491.       } if
  492.  
  493. mytxt? { /swapArray otherArray def editOther } if
  494.  
  495. (\n\nAll done.  Ready for next operation.\n\n) print flush