TuX as LLG logo
Software
DMX4Linux
Driver Suite for Linux
csv2iif.pl suite
convert PayPal transactions to IIF, OFX, QIF
Hardware
DMX30 Interface
128Ch SPP
DMX43 Interface
2out 2in EPP
LED Hardware
for Linux and Windows
EPROM Sampler
for 8 bits of sound
Misc
CatWeasel
Linux drivers for MK3/4 PCI
pg_trompe
PostgreSQL replication
trycatch
C exception/signal handling lib
Patches
to various software
Tools
and small scripts
Docs
misc documents
Links
to lighting stuff

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

Search:
http://llg.cubic.org © 2001-2017 by Dirk Jagdmann