Trailing-Edge
-
PDP-10 Archives
-
decuslib20-10
-
decus/20-189/macps.pas
There are no other files named macps.pas in the archive.
program macps;
(*
* M. Kaczmarczik 12-Sep-85
*
* Utility for converting MacPaint files into ones suitable for
* including in a Scribe document.
*
* Credits:
*
* The conversion code and PostScr ipt prelude are from J. W. Peterson's
* extract_top program for the LaserWriter. The command parsing and
* general style were inspired by E. Lavitsky's MacQms.
*
* History:
*
* 12-Sep-85 MPK Initial version
*)
include 'pas:pascmd.pas';
include 'pas:jsys.pas';
const
Line_W_Def = 52; (* Default # of bytes to extract *)
S_Line_W_Def = '52 '; (* Default is width of MacPaint *)
Mac_H_Bytes = 72; (* window *)
ScanlinesDef = 240; (* # of vertical scan lines to get *)
S_ScanlinesDef = '240 '; (* Default is height of MacPaint *)
Mac_V_Scan = 720; (* window *)
ColumnDef = 6.5; (* Width of column in which to *)
S_ColumnDef = '6.5 '; (* center the image *)
HeightDef = 3; (* Default image height. *)
S_HeightDef = '3 '; (* Image width depends on height *)
UpDef = 0; (* Amount to move image up relative *)
S_UpDef = '0 '; (* to the defined area on page *)
PsCodefile = 'uns:macps.ps'; (* Prelude file *)
type
byte = 0..377B;
var
Mac_filename : packed array[1..80] of char;
Ps_filename : packed array[1..80] of char;
Mac_file : file of byte;
Mac_length : integer;
Ps_file : file of char;
Ps_length : integer;
Ps_Code : text;
current_line : integer; (* Counter *)
change : integer; (* Used as a boolean for *)
yes_no : table; (* Yes/No questions *)
(* Parameters for postscript code *)
columnwidth : real; (* Width of Scribe column *)
height : real; (* Height of area on page *)
up : real; (* Vertical displacement *)
invert : boolean; (* Should pixels be inverted? *)
line_width : integer; (* Width of bitmap in bytes *)
scanlines : integer; (* Height of bitmap in bits *)
procedure init;
(* Define all parameters, set up command table *)
begin (* init *)
scanlines := ScanlinesDef;
height := Heightdef;
columnwidth := Columndef;
line_width := Line_W_Def;
up := Updef;
invert := false;
yes_no := tbmak(2);
tbadd(yes_no,0,'No',0);
tbadd(yes_no,1,'Yes',0);
end; (* init *)
procedure get_files;
(* Get file names from user *)
begin (* get_files *)
cmini('Mac filename: ');
cmhlp('Name of Mac file to convert ');
cmifi(Mac_file);
Mac_length := cmatom(Mac_filename);
cmcfm;
cmini('Output filename: ');
cmhlp('Name of output file ');
gjgen(400000000000B);
gjext('PS');
cmfil(Ps_file);
Ps_length := cmatom(Ps_filename);
cmcfm;
reset(Mac_file,Mac_filename,'/B:08');
rewrite(Ps_file,Ps_filename);
end; (* get_files *)
procedure get_page_params;
(* Change parameters having to do with the Scribe document page *)
begin (* get_page_params *)
cmini('Image height: ');
cmhlp('Height desired for image (in inches) ');
cmdef(S_HeightDef);
Height := cmflt;
cmcfm;
cmini('Scribe column width: ');
cmhlp('Width of text columns in document');
cmdef(S_ColumnDef);
ColumnWidth := cmflt;
cmcfm;
cmini('Upward translation: ');
cmhlp('Distance to move image up, in inches');
cmdef(S_UpDef);
Up := cmflt;
cmcfm;
end; (* get_page_params *)
procedure get_doc_params;
(* Get info having to do with the MacPaint document *)
begin (* get_doc_params *)
repeat
cmini('Vertical scan lines: ');
cmhlp('Number of scan lines to extract');
cmdef(S_ScanlinesDef);
scanlines := cmnum;
cmcfm;
if (scanlines < 1) or (scanlines > Mac_V_Scan) then
writeln(tty,'Scan lines must be between 1 and ',Mac_V_Scan:1);
until (scanlines >= 1) and (scanlines <= Mac_V_Scan);
repeat
cmini('Horizontal Line Width: ');
cmhlp('Number of bytes to extract from scan line');
cmdef(S_Line_W_Def);
Line_Width := cmnum;
cmcfm;
if (Line_Width < 1) or (Line_Width > Mac_H_Bytes) then
writeln(tty,'Number of bytes must be between 1 and ',Mac_H_Bytes:1);
until (Line_Width >= 1) and (Line_Width <= Mac_H_Bytes);
cmini('Inverted image? ');
cmhlp('Exchange black and white pixels (Yes or No)');
cmdef('No ');
Invert := cmkey(yes_no) = 1;
cmcfm;
end; (* get_doc_params *)
procedure discard_macpaint_header;
(* Read away the first .5K of the document, since we don't use it *)
var
i : integer;
b : byte;
begin (* discard_macpaint_header *)
for i := 1 to 512 do
read(Mac_file,b);
end; (* discard_macpaint_header *)
procedure copy_ps_code;
(* Put the PostScript prelude in the output file *)
var
ch : char;
begin (* copy_ps_code *)
reset(Ps_Code,PsCodeFile);
while not eof(Ps_Code) do begin
while not eoln(Ps_Code) do
begin
read(Ps_Code,ch);
write(Ps_File,ch);
end;
readln(Ps_Code);
writeln(Ps_File);
end;
close(Ps_Code);
end; (* copy_ps_code *)
procedure scan_a_line;
(* Read in one scan line of data and encode it in hex.
* Only the first line_width bytes are encoded.
*)
var
in_pos : integer; (* Byte position in scan line *)
count : integer; (* Count byte from file *)
mcount : integer; (* Count byte for encoding *)
data_byte : byte;
repeat_byte : byte;
n : integer; (* counter *)
begin (* scan_a_line *)
in_pos := 0;
while (in_pos < Mac_H_Bytes) do
begin
read(Mac_file,count);
if count > 127 then
count := count - 256;
mcount := abs(count); (* see how many bytes we may write *)
if (mcount + in_pos >= line_width) then (* must truncate *)
mcount := line_width - 1 - in_pos;
if count < 0 then (* restore the sign *)
mcount := -mcount;
if (in_pos < line_width) then
write(Ps_file,((mcount + 256) mod 256):2:h);
if (count >= 0) then (* string of count + 1 data bytes *)
for n := count downto 0 do
begin
read(Mac_file,data_byte);
if (in_pos < line_width) then
write(Ps_file,data_byte:2:h);
in_pos := in_pos + 1;
end
else (* Count + 1 compressed bytes *)
begin
read(Mac_file,repeat_byte);
if (in_pos < line_width) then
write(Ps_file,repeat_byte:2:h);
in_pos := in_pos - count + 1; (* count < 0, so subtract *)
end;
end; (* while in_pos < Mac_H_Bytes *)
if (in_pos > Mac_H_Bytes) then (* error -- probably a bad file *)
begin
writeln(tty,' [FAILED]');
writeln(tty,'Input file is not a Mac bitmap file');
close(Mac_File);
jsys(haltf);
end;
writeln(Ps_file);
end;
begin (* main program *)
init;
writeln(tty,'MacPs -- MacPaint to Postscript converter');
get_files;
cmini('Change MacPaint image parameters? ');
cmhlp('Yes or No ');
cmdef('No ');
change := cmkey(yes_no);
cmcfm;
if (change = 1) then
get_doc_params;
cmini('Change Scribe page parameters? ');
cmhlp('Yes or No ');
cmdef('No ');
change := cmkey(yes_no);
cmcfm;
if (change = 1) then
get_page_params;
discard_macpaint_header;
copy_ps_code;
(* if invert is false, postscript code needs a 1 *)
write(Ps_file,ord(Invert = false):1,' ',line_width:3,' ',scanlines:3,' ');
writeln(Ps_file,columnwidth:8:6,' ',height:8:6,' ',up:8:6);
write(tty,'Processing file ',Mac_Filename:Mac_Length,'... ');
for current_line := 1 to scanlines do
scan_a_line;
writeln(tty,'[OK]');
end.