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.