pas2ps - pascal to postscript compiler

A simple pascal to postscript compiler. I have ported the sources from Dulith Herath to a modern linux system.

This port was made by Dirk Jagdmann <doj@cubic.org>.

Download

pas2ps release 2005-12-05

Example

This pascal program provides the procedure i which will set an interpolated color depending on the real argument given. A testpage is produced by the main routine.

program palette;

var r : array[1..6] of real;
var g : array[1..6] of real;
var b : array[1..6] of real;
var size :  integer;

var x : integer;
var f : real;

procedure i(c : real);
var f : real;
var x,y : integer;
begin

   f:=size-1;
   f:=1.0/f;
   x:=1;
   while (x<(size-1)) and (c>f) do begin
      x:=x+1;
      c:=c-f;
   end;
   y:=x+1;

   c:=c/f;
   setrgbcolor(r[x]*(1.0-c)+r[y]*c, g[x]*(1.0-c)+g[y]*c, b[x]*(1.0-c)+b[y]*c);
end;

begin

   size:=6;
   r[1]:=1; g[1]:=0; b[1]:=0.25;
   r[2]:=1; g[2]:=0; b[2]:=0;
   r[3]:=1; g[3]:=1; b[3]:=0;
   r[4]:=1; g[4]:=1; b[4]:=0;
   r[5]:=0; g[5]:=0; b[5]:=1;
   r[6]:=0; g[6]:=0; b[6]:=0.2;

   f := 0;
   for x := 1 to 51 do begin
      i(f);
      writeln(f);
      f:=f+0.02;
   end;
   showpage();

end.

The pascal source is compiled to postscript with ./pas2ps < test.pas > test.ps

%!PS-Adobe
/fontsize 12 def
/default_font { /Helvetica findfont fontsize scalefont setfont } def
/LM 12 def  % left margin
/TM 750 def % top margin
/CP TM def % current position
/reset { showpage default_font LM TM moveto } def
/write_line_string 255 string def
default_font LM TM moveto
% Begin Program
 /f_1_6 0 def
 /x_1_5 0 def
 /size_1_4 0 def
 /b_1_3 6 array def
 /g_1_2 6 array def
 /r_1_1 6 array def
 /i { % Set new frame with 4 slots
 % and intitialize variables to 0
 4 dict begin
 /x_2_3 0 def
 /y_2_4 0 def
 /f_2_2 0 def
 /c_2_1 exch def
 /f_2_2  size_1_4  1  sub
 store
 /f_2_2  1  f_2_2  div
 store
 /x_2_3  1  store
{ % beginning of while loop
 x_2_3  size_1_4  1  sub
 lt  c_2_1  f_2_2  gt  and

  {  /x_2_3  x_2_3  1  add
 store
 /c_2_1  c_2_1  f_2_2  sub
 store
  }
 {exit} ifelse
} loop %  end of while
 /y_2_4  x_2_3  1  add
 store
 /c_2_1  c_2_1  f_2_2  div
 store
 r_1_1  x_2_3 1 sub
 get  1  c_2_1  sub
 mul
 r_1_1  y_2_4 1 sub
 get  c_2_1  mul
 add
 g_1_2  x_2_3 1 sub
 get  1  c_2_1  sub
 mul
 g_1_2  y_2_4 1 sub
 get  c_2_1  mul
 add
 b_1_3  x_2_3 1 sub
 get  1  c_2_1  sub
 mul
 b_1_3  y_2_4 1 sub
 get  c_2_1  mul
 add
setrgbcolor
 r_1_1  g_1_2  b_1_3  size_1_4  x_1_5  f_1_6  end
 /f_1_6 exch def
 /x_1_5 exch def
 /size_1_4 exch def
 /b_1_3 exch def
 /g_1_2 exch def
 /r_1_1 exch def
  } store
 /size_1_4  6  store
 r_1_1  1 1 sub
 1  put
 g_1_2  1 1 sub
 0  put
 b_1_3  1 1 sub
 0.25  put
 r_1_1  2 1 sub
 1  put
 g_1_2  2 1 sub
 0  put
 b_1_3  2 1 sub
 0  put
 r_1_1  3 1 sub
 1  put
 g_1_2  3 1 sub
 1  put
 b_1_3  3 1 sub
 0  put
 r_1_1  4 1 sub
 1  put
 g_1_2  4 1 sub
 1  put
 b_1_3  4 1 sub
 0  put
 r_1_1  5 1 sub
 0  put
 g_1_2  5 1 sub
 0  put
 b_1_3  5 1 sub
 1  put
 r_1_1  6 1 sub
 0  put
 g_1_2  6 1 sub
 0  put
 b_1_3  6 1 sub
 0.2  put
 /f_1_6  0  store
 1 1  51 { f_1_6  i
 f_1_6 write_line_string cvs  show
 /CP CP fontsize sub 1 sub def
 LM CP moveto
 /f_1_6  f_1_6  0.02  add
 store
} for
showpage