home *** CD-ROM | disk | FTP | other *** search
/ Fish 'n' More 2 / fishmore-publicdomainlibraryvol.ii1991xetec.iso / disks / disk454.lzh / Redaktu / Redaktu.bak < prev    next >
Text File  |  1991-02-14  |  12KB  |  367 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:
  7. %%          224 Rose Place,  Kalamazoo MI 49001-2617 USA
  8. %%EndComments
  9.  
  10. %===========================================
  11. %==== ARRAY "newArray" IS FOR USE IN =======
  12. %====   FILES HAVING UNEXPECTED OR   =======
  13. %====        ABSENT SUFFIXES         =======
  14. %===========================================
  15.  
  16. /newArray [ ( remove ) ( insert ) ] def
  17.  
  18.  
  19. %====================================================
  20. %===== DEFINE STRINGS FOR INSERTION INTO PROLOG =====
  21. %=====     AND DEFINE SEARCH/REPLACE ARRAY      =====
  22. %=====        FOR USE IN .ps FILES ONLY         =====
  23. %====================================================
  24.  
  25. /fadeno1 (
  26.  
  27. /newdeffont {exch dup /grando exch def exch deffont} def
  28. /d {grando 1000 div mul} def
  29. /D {grando 750 div mul} def
  30.  
  31. /breve
  32.  { pop gsave currentpoint translate newpath
  33.    -91 d -670 d moveto
  34.   -157 d -470 d -387 d -470 d -453 d -670 d curveto
  35.   -427 d -670 d lineto
  36.   -357 d -550 d -187 d -550 d -118 d -670 d curveto
  37.   closepath fill grestore} def
  38.  
  39. /BREVE
  40.  { pop gsave currentpoint translate newpath
  41.    -91 D -700 D moveto
  42.   -157 D -500 D -387 D -500 D -453 D -700 D curveto
  43.   -427 D -700 D lineto
  44.   -357 D -580 D -187 D -580 D -118 D -700 D curveto
  45.   closepath fill grestore} def
  46.  
  47. /SCircum
  48.  { pop gsave currentpoint translate newpath
  49.     -51 D -565 D moveto -190 D -700 D lineto
  50.    -230 D -700 D lineto -369 D -565 D lineto
  51.    -349 D -555 D lineto -210 D -630 D lineto
  52.     -71 D -555 D lineto
  53.    closepath fill grestore} def ) def
  54.  
  55. /fadeno2 (
  56.  
  57. /sCircum
  58.  { pop gsave currentpoint translate newpath
  59.     -50 d -535 d moveto -185 d -670 d lineto
  60.    -215 d -670 d lineto -350 d -535 d lineto
  61.    -325 d -525 d lineto -200 d -600 d lineto
  62.     -75 d -525 d lineto
  63.    closepath fill grestore} def
  64.  
  65. /CCircum
  66.  { pop gsave currentpoint translate newpath
  67.     -51 D -560 D moveto -210 D -700 D lineto
  68.    -250 D -700 D lineto -413 D -560 D lineto
  69.    -387 D -550 D lineto -230 D -630 D lineto
  70.     -81 D -550 D lineto
  71.    closepath fill grestore} def
  72.  
  73. /cCircum
  74.  { pop gsave currentpoint translate newpath
  75.     -36 d -530 d moveto -190 d -670 d lineto
  76.    -220 d -670 d lineto -388 d -530 d lineto
  77.    -362 d -520 d lineto -205 d -600 d lineto
  78.     -66 d -520 d lineto
  79.    closepath fill grestore} def ) def
  80.  
  81. /fadeno3 (
  82.  
  83. /GCircum
  84.  { pop gsave currentpoint translate newpath
  85.     -81 D -560 D moveto -250 D -700 D lineto
  86.    -290 D -700 D lineto -459 D -560 D lineto
  87.    -429 D -550 D lineto -270 D -630 D lineto
  88.    -111 D -540 D lineto
  89.    closepath fill grestore} def
  90.  
  91. /gCircum
  92.  { pop gsave currentpoint translate newpath
  93.     -91 d -535 d moveto -230 d -670 d lineto
  94.    -270 d -670 d lineto -409 d -535 d lineto
  95.    -389 d -525 d lineto -250 d -600 d lineto
  96.    -121 d -525 d lineto
  97.    closepath fill grestore} def
  98.  
  99. /JCircum
  100.  { pop gsave currentpoint translate newpath
  101.      12 D -560 D moveto  -105 D -700 D lineto
  102.    -135 D -700 D lineto  -252 D -560 D lineto
  103.    -240 D -550 D lineto  -120 D -630 D lineto
  104.       0 D -550 D lineto
  105.    closepath fill grestore} def ) def
  106.  
  107. /fadeno4 (
  108.  
  109. /jCircum
  110.  { pop gsave currentpoint translate newpath
  111.      12 d -530 d moveto  -90 d -720 d lineto
  112.    -150 d -720 d lineto -252 d -530 d lineto
  113.    closepath 1 setgray fill
  114.    newpath 0 setgray
  115.      12 d -530 d moveto  -107 d -670 d lineto
  116.    -133 d -670 d lineto  -252 d -530 d lineto
  117.    -233 d -520 d lineto  -120 d -600 d lineto
  118.      -7 d -520 d lineto
  119.    closepath fill grestore} def
  120.  
  121. /HCircum
  122.  { pop gsave currentpoint translate newpath
  123.     -51 D -560 D moveto  -235 D -700 D lineto
  124.    -295 D -700 D lineto  -479 D -560 D lineto
  125.    -449 D -550 D lineto  -265 D -610 D lineto
  126.     -81 D -550 D lineto
  127.    closepath fill grestore} def
  128.  
  129. /hCircum
  130.  { pop gsave currentpoint translate newpath
  131.     -81  d -755 d moveto -220  d -890 d lineto
  132.    -260  d -890 d lineto -399  d -755 d lineto
  133.    -379  d -745 d lineto -240  d -820 d lineto
  134.    -101  d -745 d lineto
  135.    closepath fill grestore} def
  136.  
  137. %% EndProlog
  138.  
  139. ) def     % string entry for psArray defined
  140.  
  141. /fadenArray [ fadeno1 fadeno2 fadeno3 fadeno4 ] def
  142.  
  143. /psArray
  144.   [ ( deffont )     ( newdeffont \n [)
  145.     ( mvx (c) show) ( cCircum \n [)
  146.     ( mvx (C) show) ( CCircum \n [)
  147.     ( mvx (j) show) ( jCircum \n [)
  148.     ( mvx (J) show) ( JCircum \n [)
  149.     ( mvx (g) show) ( gCircum \n [)
  150.     ( mvx (G) show) ( GCircum \n [)
  151.     ( mvx (h) show) ( hCircum \n [)
  152.     ( mvx (H) show) ( HCircum \n [)
  153.     ( mvx (s) show) ( sCircum \n [)
  154.     ( mvx (S) show) ( SCircum \n [)
  155.     ( mvx (U) show) ( BREVE \n [)
  156.     ( mvx (u) show) ( breve \n [)
  157.   ] def                         % psArray defined
  158.  
  159.  
  160. %=======================================================
  161. %===== DEFINE THE ARRAY OF SEARCH/REPLACE STRINGS  =====
  162. %=====        FOR USE IN .txt FILES ONLY           =====
  163. %=======================================================
  164.  
  165. /txtArray [ (q) (c\\t<-44>c\\t<0>)    (Q) (C\\t<-67>C\\t<0>)
  166.             ([) (g\\t<-50>g\\t<0>)    ({) (G\\t<-72>G\\t<0>)
  167.             (]) (h\\t<-50>h\\t<0>)    (}) (H\\t<-72>H\\t<0>)
  168.             (y) (j\\t<-28>j\\t<0>)    (Y) (J\\t<-39>J\\t<0>)
  169.             (x) (s\\t<-39>s\\t<0>)    (X) (S\\t<-56>S\\t<0>)
  170.             (w) (u\\t<-50>u\\t<0>)    (W) (U\\t<-72>U\\t<0>)
  171.             (--) (-\\t<-10>-\\t<0>)   (---) (-\\t<-10>--\\t<0>)
  172.             (...) (.\\t<10>..\\t<0>)
  173.           ] def
  174.  
  175.  
  176. %===========================================
  177. %===== BEGIN DEFINITION OF PROCEDURES ======
  178. %===========================================
  179.  
  180.  
  181. /stringSplice            % assumes (Right) (Left)
  182.  
  183.   { dup length           % (Right) (Left) LLength
  184.     dup                  % (Right) (Left) LLength LLength
  185.     3 1 roll             % (Right) LLength (Left) LLength
  186.     3 index length       % (Right) LLength (Left) LLength RLength
  187.     add                  % (Right) LLength (Left) TotLength
  188.     string               % (Right) LLength (Left) (---------)
  189.     copy                 % (Right) LLength (Left-----)
  190.     /splice exch def     % (Right) LLength
  191.     splice               % (Right) LLength splice
  192.     3 1 roll exch        % splice (Right) LLeft
  193.     putinterval          % stack empty...
  194.     splice               % splice
  195.   } bind def             % ...splice = (LeftRight)
  196.  
  197. %==== NEW PROCEDURE ====
  198.  
  199. /rootOut              % assumed are... (bad) (good) (input)
  200.   {                   % def
  201.     {                 % loop
  202.       2 index         % (bad) (good) (input) (bad)
  203.       search          % (bad) (good) (post) (bad) (pre) true
  204.                       % (bad) (good) (input) false
  205.       dup {/trovis true def} if
  206.       {               % ifelse
  207.         exch pop      % (bad) (good) (post) (pre)
  208.         2 index       % (bad) (good) (post) (pre) (good)
  209.         exch          % (bad) (good) (post) (good) (pre)
  210.         stringSplice  % (bad) (good) (post) (pregood) &  splice = (pregood)
  211.         stringSplice  % (bad) (good) (pregoodpost) & splice = (pregoodpost)
  212.       }{              % ifelse
  213.         3 1 roll      % (pregoodpost) (bad) (good)
  214.         pop pop       % (pregoodpost)
  215.         exit          % ...break out of loop
  216.       } ifelse
  217.      } loop           % go back for next (bad)
  218.    } bind def
  219.  
  220.  
  221. %==== NEW PROCEDURE ====
  222.  
  223.  
  224. /rootOutAll                    % assumed is... (input)
  225.    {                           % def
  226.      swapArray                 % (input) [(bad) (good)...]
  227.      dup length                % (input) [(b)(g)] int
  228.      /longo exch def           % (input) [(b)(g)]
  229.      aload pop                 % (input) (b) (g)
  230.      longo 1 add               % (input) (b) (g) int
  231.      -1 roll                   % (b) (g) (input)
  232.      longo 2 div cvi {rootOut} % ...search and replace entire input string.
  233.      repeat                    %  (output)
  234.    } bind def
  235.  
  236.  
  237. %==== NEW PROCEDURE ====
  238.  
  239.  
  240. /autoEdit                     % assumed is (HD:Name.txt) or (HD:Name.ps)
  241.   {                           % def
  242.     (\nChecking for proper suffix on input file... ) print flush
  243.     dup print flush
  244.     dup                       % (HD:Name.--) (HD:Name.--)
  245.     /infile exch (r) file def % (HD:Name.--)
  246.     (.) search                % (-) (.) (HD:Name) true
  247.                               % (HD:Name) false
  248.      {                         % ifelse
  249.        2 index
  250.        (txt) eq
  251.  
  252.          { 3 1 roll                % if... (HD:Name) (--) (.)
  253.            pop pop                 % (HD:Name)
  254.            (.fmtd) exch            % (.fmtd) (HD:Name)
  255.            stringSplice            % (HD:Name.fmtd)
  256.            dup                     % (HD:Name.fmtd) (HD:Name.fmtd)
  257.            /outfile exch           % (HD:Name.fmtd)
  258.            (w) file def            % (HD:Name.fmtd)
  259.            /swapArray txtArray def % choose set of exchanges for .txt
  260.            /ps? false def          % (HD:Name.fmtd)
  261.          }                        % ifelse
  262.          {
  263.             2 index
  264.             (ps) eq
  265.  
  266.             {  3 1 roll               % (HD:Name) (ps) (.)
  267.                pop pop                 % (HD:Name)
  268.                (.Eo-ps) exch           % (HD:Name.Eo-ps) (HD:Name.Eo-ps)
  269.                stringSplice
  270.                dup
  271.                /outfile exch           % (HD:Name.Eo-ps)
  272.                (w) file def            % (HD:Name.Eo-ps)
  273.                /swapArray psArray def  % choose set of exchanges for .ps
  274.                /ps? true def           % (HD:Name.Eo-ps)
  275.             }                          % ifelse
  276.             {
  277.                3 1 roll
  278.                pop pop
  279.                (.edtd) exch
  280.                stringSplice
  281.                dup
  282.                /outfile exch
  283.                (w) file def
  284.                /swapArray newArray def
  285.                /ps? false def
  286.                (\n\nUnexpected suffix on input file name.
  287. Therefor, "newArray" will be used for all search/replace's.\n)
  288.                print flush
  289.             }  ifelse
  290.          } ifelse
  291.      }
  292.      {
  293.        (.new) exch stringSplice
  294.        dup
  295.        /outfile exch
  296.        (w) file def
  297.        /swapArray newArray def
  298.        /ps? false def
  299.        (\n\nNo suffix on input file name.
  300. Therefor, "newArray" will be used for all search/replace's.)
  301.              print flush
  302.      } ifelse                   % ifelse
  303.  
  304.  
  305.  
  306.   (\n\nThe name of your output file will be... ) print flush
  307.   print flush
  308.  
  309.   /ujo 1024 string def
  310.   /trovis false def
  311.  
  312.   ps? {
  313.         { %loop
  314.           infile ujo
  315.           readline not
  316.              { (\n\n"%%EndProlog" MISSING FROM INPUT FILE.
  317. Could not perform prolog insertion!\n \
  318. Check contents of input file.\n) print flush
  319.                exit
  320.              } if
  321.           dup
  322.           (%%EndProlog) eq
  323.              { (\n\nFound "%%EndProlog" comment. \n) print flush
  324.                pop
  325.                fadenArray {outfile exch writestring} forall
  326.                (Prolog insertion successful. \n) print flush
  327.                exit
  328.              } if
  329.           ( \n) exch  stringSplice
  330.           outfile exch writestring
  331.         } bind loop
  332.       } if
  333.  
  334. (\nBusy editing.  Please be patient.\n) print flush
  335.  
  336.  
  337.   { %loop
  338.     infile ujo
  339.     readline
  340.  
  341.       {                            %ifelse
  342.         ( \n) exch  stringSplice
  343.         rootOutAll
  344.         ps? { trovis { (] pop \n) exch stringSplice } if }if
  345.         outfile exch writestring
  346.       }{                           %ifelse
  347.         ( \n) exch stringSplice
  348.         rootOutAll
  349.         ps? { trovis { (] pop \n) exch stringSplice } if }if
  350.         outfile exch writestring
  351.  
  352.         infile closefile
  353.         outfile closefile
  354.         exit
  355.       } ifelse                     % ifelse
  356.  
  357.       /trovis false def
  358.   } bind loop
  359. } def
  360.  
  361.  
  362. %%EndProlog
  363.  
  364.  
  365. autoEdit                      % Assumes (HD:Name.ps) or (HD:Name.txt)
  366.  
  367. (\nAll done.  Ready for next operation.\n\n) print flush