Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!seismo!ll-xn!ames!necntc!ncoast!allbery
From: rcb@rti.UUCP (Randy Buckland)
Newsgroups: comp.sources.misc
Subject: VMS DVI preview (part 2 of 3)
Message-ID: <2808@ncoast.UUCP>
Date: Mon, 6-Jul-87 21:47:31 EDT
Article-I.D.: ncoast.2808
Posted: Mon Jul  6 21:47:31 1987
Date-Received: Fri, 10-Jul-87 01:26:07 EDT
Sender: allbery@ncoast.UUCP
Lines: 1525
Approved: allbery@ncoast.UUCP
X-Archive: comp.sources.misc/8707/


This is the second part of the DVI previewer code for VMS.

----------------------------cut here------------------------------
$ write sys$output "Creating [.src]dvi_def_.ada"
$ create [.src]dvi_def_.ada
$ deck
---------------------------------------------------------------------------
--|									|--
--| Title:  Dvi_def							|--
--| Date:    9-JUN-1987							|--
--| Name:   Randy Buckland						|--
--|									|--
--| Purpose:	Defintions related to DVI file format.			|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Revision History							|--
--|									|--
--| Who	    Date	Description					|--
--| ---	    ----	-----------					|--
--| rcb	     9-JUN-1987	New file.					|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Copyright (c) 1987 by Research Triangle Institute.			|--
--| Written by Randy Buckland. Not derived from licensed software.	|--
--|									|--
--| Permission is granted to anyone to use this software for any	|--
--| purpose on any computer system, and to redistribute it freely,	|--
--| subject to the following restrictions.				|--
--|									|--
--| 1. Research Triangle Institute supplies this software "as is",	|--
--|	without any warranty. The author and the Institute do not	|--
--|	accept any responsibility for any damage caused by use or	|--
--|	mis-use of this program.					|--
--| 2. The copyright notice must remain a part of all sources files.	|--
--| 3. This software may not be sold in any fashion.			|--
--|									|--
---------------------------------------------------------------------------
with font_def;
use  font_def;

with unchecked_deallocation;

package dvi_def is

---------------------------------------------------------------------------
--|									|--
--| Global types.							|--
--|									|--
---------------------------------------------------------------------------
type page_array (size : integer) is record
    height      : integer;
    width       : integer;
    page_number : integer;
    bits        : pixel_array (1..size);
end record;

type page_ptr is access page_array;

procedure free is new unchecked_deallocation (page_array, page_ptr);

---------------------------------------------------------------------------
--|									|--
--| Global variables.							|--
--|									|--
---------------------------------------------------------------------------
--|
--| Scaling parameters
--|
dvi_to_nano_meter : float;
magstep           : float;

page_height : integer;
page_width  : integer;

temp_page : page_ptr := null;
prev_page : page_ptr := null;
curr_page : page_ptr := null;
next_page : page_ptr := null;

---------------------------------------------------------------------------
--|									|--
--| Constant definitions.						|--
--|									|--
---------------------------------------------------------------------------
--|
--| Misc constants
--|
resolution : constant := 78.0;
--|
--| Dvi commands
--|
set_char_0   : constant := 0;
set_char_127 : constant := 127;
set1	     : constant := 128;
set2	     : constant := 129;
set3	     : constant := 130;
set4	     : constant := 131;
set_rule     : constant := 132;
put1	     : constant := 133;
put2	     : constant := 134;
put3	     : constant := 135;
put4	     : constant := 136;
put_rule     : constant := 137;
nop	     : constant := 138;
bop	     : constant := 139;
eop	     : constant := 140;
push	     : constant := 141;
pop	     : constant := 142;
right1	     : constant := 143;
right2	     : constant := 144;
right3	     : constant := 145;
right4	     : constant := 146;
w0	     : constant := 147;
w1	     : constant := 148;
w2	     : constant := 149;
w3	     : constant := 150;
w4	     : constant := 151;
x0	     : constant := 152;
x1	     : constant := 153;
x2	     : constant := 154;
x3	     : constant := 155;
x4	     : constant := 156;
down1	     : constant := 157;
down2	     : constant := 158;
down3	     : constant := 159;
down4	     : constant := 160;
y0	     : constant := 161;
y1	     : constant := 162;
y2	     : constant := 163;
y3	     : constant := 164;
y4	     : constant := 165;
z0	     : constant := 166;
z1	     : constant := 167;
z2	     : constant := 168;
z3	     : constant := 169;
z4	     : constant := 170;
fnt_num_0    : constant := 171;
fnt_num_63   : constant := 234;
fnt1	     : constant := 235;
fnt2	     : constant := 236;
fnt3	     : constant := 237;
fnt4	     : constant := 238;
xxx1	     : constant := 239;
xxx2	     : constant := 240;
xxx3	     : constant := 241;
xxx4	     : constant := 242;
fnt_def1     : constant := 243;
fnt_def2     : constant := 244;
fnt_def3     : constant := 245;
fnt_def4     : constant := 246;
preamble     : constant := 247;
postamble    : constant := 248;
post_post    : constant := 249;

end;
$ eod
$ checksum [.src]dvi_def_.ada
$ if checksum$checksum .nes. "1919110043" then write sys$output -
    "    ******Checksum error for file [.src]dvi_def_.ada******"
$ write sys$output "Creating [.src]dvi_io.ada"
$ create [.src]dvi_io.ada
$ deck
---------------------------------------------------------------------------
--|									|--
--| Title:  Dvi_io							|--
--| Date:    9-JUN-1987							|--
--| Name:   Randy Buckland						|--
--|									|--
--| Purpose:	Handle input of DVI file.				|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Revision History							|--
--|									|--
--| Who	    Date	Description					|--
--| ---	    ----	-----------					|--
--| rcb	     9-JUN-1987	New file.					|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Copyright (c) 1987 by Research Triangle Institute.			|--
--| Written by Randy Buckland. Not derived from licensed software.	|--
--|									|--
--| Permission is granted to anyone to use this software for any	|--
--| purpose on any computer system, and to redistribute it freely,	|--
--| subject to the following restrictions.				|--
--|									|--
--| 1. Research Triangle Institute supplies this software "as is",	|--
--|	without any warranty. The author and the Institute do not	|--
--|	accept any responsibility for any damage caused by use or	|--
--|	mis-use of this program.					|--
--| 2. The copyright notice must remain a part of all sources files.	|--
--| 3. This software may not be sold in any fashion.			|--
--|									|--
---------------------------------------------------------------------------
with text_io, sys, system;
use  text_io, sys, system;

with direct_io;

package body dvi_io is

---------------------------------------------------------------------------
--|									|--
--| Instantiations.							|--
--|									|--
---------------------------------------------------------------------------
type dvi_block is array(0..511) of unsigned_byte;
package block_io is new direct_io (dvi_block); use block_io;
---------------------------------------------------------------------------
--|									|--
--| Static variables.							|--
--|									|--
---------------------------------------------------------------------------
--|
--| File access variables.
--|
dvi_file   : block_io.file_type;
dvi_record : block_io.count := 0;
dvi_offset : integer := 511;
dvi_buffer : dvi_block;

---------------------------------------------------------------------------
--|									|--
--| Open								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Name of DVI file to open.			|--
--|									|--
--| Description:    Open the DVI file.					|--
--|									|--
---------------------------------------------------------------------------
procedure open (
    name : in string) is

begin
    open (dvi_file, in_file, name, "file; default_name *.dvi");

exception
    when others =>
	put_line ("Error opening file " & name);
	sys_exit (16#1000002c#);
end;

---------------------------------------------------------------------------
--|									|--
--| Find_post								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Description:    Find the postamble and position at the POST byte.	|--
--|									|--
---------------------------------------------------------------------------
procedure find_post is

last_good_record : block_io.count;
offset           : block_io.count;

begin
--|
--| Probe past end of file.
--|
    begin
	dvi_record := 1;
	loop
	    read (dvi_file, dvi_buffer, dvi_record);
	    last_good_record := dvi_record;
	    dvi_record := dvi_record * 2;
	end loop;
    exception
	when block_io.end_error => null;
    end;
--|
--| Divide difference until end of file is found.
--|
    offset := (dvi_record - last_good_record)/2;
    while (offset /= 0) loop
	begin
	    read (dvi_file, dvi_buffer, last_good_record + offset);
	    last_good_record := last_good_record + offset;
	exception
	    when block_io.end_error => null;
	end;
	offset := offset / 2;
    end loop;
--|
--| Scan backwards in buffer until byte with value of 2 is found.
--|
    dvi_offset := 511;
    dvi_record := last_good_record;
    
    while (dvi_buffer (dvi_offset) = 223) loop
	dvi_offset := dvi_offset - 1;
	if (dvi_offset < 0) then
	    dvi_record := dvi_record - 1;
	    dvi_offset := 511;
	    read (dvi_file, dvi_buffer, dvi_record);
	end if;
    end loop;
--|
--| Get position of POST byte and go there
--|
    go_to (integer((dvi_record-1)*512)+dvi_offset-4);
    go_to (get_4byte);
end;

---------------------------------------------------------------------------
--|									|--
--| Go_to								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Offset to goto.					|--
--|									|--
--| Description:    Goto specified offset in file.			|--
--|									|--
---------------------------------------------------------------------------
procedure go_to (
    offset : in integer) is

begin
    if (dvi_record /= block_io.count((offset/512)+1)) then
	dvi_record := block_io.count((offset/512)+1);
	read (dvi_file, dvi_buffer, dvi_record);
    end if;
    dvi_offset := offset mod 512;
end;

---------------------------------------------------------------------------
--|									|--
--| Get_byte								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Description:    Return the next 1-4 bytes as an integer.		|--
--|									|--
---------------------------------------------------------------------------
function get_byte 
    return integer is

temp : integer;

begin
    if (dvi_offset > 511) then
	dvi_record := dvi_record + 1;
	read (dvi_file, dvi_buffer, dvi_record);
	dvi_offset := 0;
    end if;
    
    temp := integer (dvi_buffer (dvi_offset));
    dvi_offset := dvi_offset + 1;
    return temp;
end;
--|
--| Get a 2 byte value
--|
function get_2byte
    return integer is

temp : integer := 0;

begin
    for i in 1..2 loop
	temp := temp*256 + get_byte;
    end loop;
    return temp;
end;
--|
--| Get a 3 byte value
--|
function get_3byte
    return integer is

temp : integer := 0;

begin
    for i in 1..3 loop
	temp := temp*256 + get_byte;
    end loop;
    return temp;
end;
--|
--| Get a 4 byte value
--|
function get_4byte 
    return integer is

temp : bit_array_32;

begin
    for i in reverse 0..3 loop
	temp(i*8..i*8+7) := to_bit_array_8 (unsigned_byte (get_byte));
    end loop;
    return integer (to_unsigned_longword (temp));
end;

---------------------------------------------------------------------------
--|									|--
--| Get_s_byte								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Description:    Get a sign extended value of 1-4 bytes in		|--
--|		    length and return it as an integer.			|--
--|									|--
---------------------------------------------------------------------------
function get_s_byte 
    return integer is

temp : bit_array_32;

begin
    temp := to_bit_array_32 (unsigned_longword (get_byte));
    temp (8..31) := (8..31 => temp(7));
    return integer (to_unsigned_longword (temp));
end;
--|
--| Get a 2 byte value
--|
function get_s_2byte 
    return integer is

temp : bit_array_32;

begin
    temp := to_bit_array_32 (unsigned_longword (get_2byte));
    temp (16..31) := (16..31 => temp(15));
    return integer (to_unsigned_longword (temp));
end;
--|
--| Get a 3 byte value
--|
function get_s_3byte 
    return integer is

temp : bit_array_32;

begin
    temp := to_bit_array_32 (unsigned_longword (get_3byte));
    temp (24..31) := (24..31 => temp(23));
    return integer (to_unsigned_longword (temp));
end;

---------------------------------------------------------------------------
--|									|--
--| Close								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Description:    Close the DVI file.					|--
--|									|--
---------------------------------------------------------------------------
procedure close is

begin
    close (dvi_file);
end;

end;
$ eod
$ checksum [.src]dvi_io.ada
$ if checksum$checksum .nes. "707123688" then write sys$output -
    "    ******Checksum error for file [.src]dvi_io.ada******"
$ write sys$output "Creating [.src]dvi_io_.ada"
$ create [.src]dvi_io_.ada
$ deck
---------------------------------------------------------------------------
--|									|--
--| Title:  Dvi_io							|--
--| Date:    9-JUN-1987							|--
--| Name:   Randy Buckland						|--
--|									|--
--| Purpose:	Handle input of DVI file.				|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Revision History							|--
--|									|--
--| Who	    Date	Description					|--
--| ---	    ----	-----------					|--
--| rcb	     9-JUN-1987	New file.					|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Copyright (c) 1987 by Research Triangle Institute.			|--
--| Written by Randy Buckland. Not derived from licensed software.	|--
--|									|--
--| Permission is granted to anyone to use this software for any	|--
--| purpose on any computer system, and to redistribute it freely,	|--
--| subject to the following restrictions.				|--
--|									|--
--| 1. Research Triangle Institute supplies this software "as is",	|--
--|	without any warranty. The author and the Institute do not	|--
--|	accept any responsibility for any damage caused by use or	|--
--|	mis-use of this program.					|--
--| 2. The copyright notice must remain a part of all sources files.	|--
--| 3. This software may not be sold in any fashion.			|--
--|									|--
---------------------------------------------------------------------------
package dvi_io is

---------------------------------------------------------------------------
--|									|--
--| Routine definitions.						|--
--|									|--
---------------------------------------------------------------------------
procedure open (name : in string);

procedure find_post;
procedure go_to (offset : in integer);

function get_byte return integer;
function get_2byte return integer;
function get_3byte return integer;
function get_4byte return integer;

function get_s_byte return integer;
function get_s_2byte return integer;
function get_s_3byte return integer;

procedure close;

end;
$ eod
$ checksum [.src]dvi_io_.ada
$ if checksum$checksum .nes. "1701279364" then write sys$output -
    "    ******Checksum error for file [.src]dvi_io_.ada******"
$ write sys$output "Creating [.src]dvi_tasks.ada"
$ create [.src]dvi_tasks.ada
$ deck
---------------------------------------------------------------------------
--|									|--
--| Title:  Dvi_tasks							|--
--| Date:    9-JUN-1987							|--
--| Name:   Randy Buckland						|--
--|									|--
--| Purpose:	Task manager for DVI file related operations.		|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Revision History							|--
--|									|--
--| Who	    Date	Description					|--
--| ---	    ----	-----------					|--
--| rcb	     9-JUN-1987	New file.					|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Copyright (c) 1987 by Research Triangle Institute.			|--
--| Written by Randy Buckland. Not derived from licensed software.	|--
--|									|--
--| Permission is granted to anyone to use this software for any	|--
--| purpose on any computer system, and to redistribute it freely,	|--
--| subject to the following restrictions.				|--
--|									|--
--| 1. Research Triangle Institute supplies this software "as is",	|--
--|	without any warranty. The author and the Institute do not	|--
--|	accept any responsibility for any damage caused by use or	|--
--|	mis-use of this program.					|--
--| 2. The copyright notice must remain a part of all sources files.	|--
--| 3. This software may not be sold in any fashion.			|--
--|									|--
---------------------------------------------------------------------------
with dvi_io, font_tasks, text_io, sys, str, dvi_translate, ots;
use  dvi_io, font_tasks, text_io, sys, str, dvi_translate, ots;

package body dvi_tasks is

---------------------------------------------------------------------------
--|									|--
--| Private types.							|--
--|									|--
---------------------------------------------------------------------------
type page_list_array is array (integer range <>) of integer;
type page_list_ptr is access page_list_array;

---------------------------------------------------------------------------
--|									|--
--| Static variables.							|--
--|									|--
---------------------------------------------------------------------------
--|
--| Page information
--|
page_list : page_list_ptr;

---------------------------------------------------------------------------
--|									|--
--| Read_pre								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Description:    Read the preamble and get scaling values.		|--
--|									|--
---------------------------------------------------------------------------
procedure read_pre (
    magnification : in float) is

n : float;
d : float;
m : float;

begin
--|
--| Check file type is dvi file
--|
    go_to (0);
    if (get_byte /= preamble)
    or else (get_byte /= 2) then
	put_line ("Bad dvi file");
	sys_exit (16#1000002c#);
    end if;
--|
--| Load scaling parameters
--|
    n := float (get_4byte);
    d := float (get_4byte);
    m := float (get_4byte);
    
    dvi_to_nano_meter := n/d;
    magstep := m/1000.0*magnification;
end;

---------------------------------------------------------------------------
--|									|--
--| Load_font								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Font load command.				|--
--|									|--
--| Description:    Read font definition and cause it to be loaded	|--
--|		    by the font_load task				|--
--|									|--
---------------------------------------------------------------------------
procedure load_font (
    command : in integer) is

font_number : integer;
name        : string(1..60);
size        : integer;
scale       : float;
trash	    : integer;

begin
    case command is
	when fnt_def1 => font_number := get_byte;
	when fnt_def2 => font_number := get_2byte;
	when fnt_def3 => font_number := get_3byte;
	when fnt_def4 => font_number := get_4byte;
	when others   => null;
    end case;
    
    trash := get_4byte;			-- Trash checksum
    scale := float (get_4byte);
    scale := scale / float (get_4byte);
    size := get_byte + get_byte;
    
    for i in 1..size loop
	name(i) := character'val(get_byte);
    end loop;
    copy (name(size+1..60), integer'image (integer (scale*magstep*resolution)) &
	"PK");
    name(size+1) := '.';
    for i in name'range loop
	size := i-1;
	exit when (name(i) = ' ');
    end loop;
    
    font_load.add_font (name(1..size), font_number);
end;

---------------------------------------------------------------------------
--|									|--
--| Read_post								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Description:    Read the postamble and activate the font loader.	|--
--|									|--
---------------------------------------------------------------------------
procedure read_post (
    magnification : in float) is

trash      : integer;
page_count : integer;
command    : integer;
last_page  : integer;

begin
--|
--| Trash header stuff
--|
    trash := get_byte;		-- Trash POST command
    last_page := get_4byte;
    trash := get_4byte;		-- Trash numerator
    trash := get_4byte;		-- Trash denominator
    trash := get_4byte;		-- Trash magnification
    trash := get_4byte;		-- Trash max length
    trash := get_4byte;		-- Trash max width
    trash := get_2byte;		-- Trash max stack depth
    page_count := get_2byte;
--|
--| Process font definitions.
--|
    loop
	command := get_byte;
	case command is
	    when post_post          => exit;
	    when nop                => null;
	    when fnt_def1..fnt_def4 => load_font (command);

	    when others =>
		put_line ("Unknown command in postamble" & 
		    integer'image(command));
		sys_exit (16#1000002c#);
	end case;
    end loop;
--|
--| Build page list
--|
    page_list := new page_list_array (1..page_count);
    page_list(page_count) := last_page;
    loop
	page_count := page_count - 1;
	exit when (page_count = 0);
	go_to (last_page+41);
	last_page := get_4byte;
	exit when (last_page = -1);
	page_list (page_count) := last_page;
    end loop;
end;

---------------------------------------------------------------------------
--|									|--
--| Reset_page								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Pointer to page.					|--
--|									|--
--| Description:    Reset the data in a page description.		|--
--|									|--
---------------------------------------------------------------------------
procedure reset_page (
    page : in page_ptr) is

begin
    page.height := page_height;
    page.width := page_width;
    page.page_number := 0;
    move5 (0, page.bits'address, 0, (page.size+7)/8, page.bits'address);
end;

---------------------------------------------------------------------------
--|									|--
--| Load_page								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Page number to load.				|--
--|		    2. Page pointer to place page into.			|--
--|									|--
--| Description:    Load a page from a DVI file.			|--
--|									|--
---------------------------------------------------------------------------
procedure load_page (
    page_number : in     integer;
    page	: in out page_ptr) is

begin
    go_to (page_list(page_number));
    reset_page (page);
    page.page_number := page_number;
    build_page (page);
end;

---------------------------------------------------------------------------
--|									|--
--| Dvi_read								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Description:    Task to handle reading of DVI file and building	|--
--|		    page images in memory.				|--
--|									|--
---------------------------------------------------------------------------
task body dvi_read is

do_load : boolean;

begin
--|
--| Initialize file reader
--|
    accept init (file_name : in string; magnification : in float;
	page_count : out integer) do
	
	open (file_name);
	read_pre (magnification);
	find_post;
	read_post (magnification);
	font_load.get_fonts;
	
	page_height := integer (11.0 * resolution * magstep);
	page_width := integer (8.5 * resolution * magstep);
	page_width := (page_width+7)/8;
	page_width := page_width*8;
	page_count := page_list'last;
    end;
--|
--| Main page loop
--|
    loop
	select
	    accept get_next (page : out page_ptr) do
		if (next_page.page_number = 0) then
		    page := curr_page;
		else
		    temp_page := prev_page;
		    prev_page := curr_page;
		    curr_page := next_page;
		    next_page := temp_page;
		    next_page.page_number := 0;
		end if;
		page := curr_page;
	    end;
	    if (curr_page.page_number < page_list.all'last) then
		load_page (curr_page.page_number+1, next_page);
	    end if;
	or
	    accept get_prev (page : out page_ptr) do
		if (prev_page.page_number = 0) then
		    page := curr_page;
		else
		    temp_page := next_page;
		    next_page := curr_page;
		    curr_page := prev_page;
		    prev_page := temp_page;
		    prev_page.page_number := 0;
		end if;
		page := curr_page;
	    end;
	    if (curr_page.page_number > 1) then
		load_page (curr_page.page_number-1, prev_page);
	    end if;
	or
	    accept get_page (page_num : in integer; page : out page_ptr) do
		if (page_num in page_list'range) then
		    load_page (page_num, curr_page);
		    do_load := true;
		else
		    do_load := false;
		end if;
		page := curr_page;
	    end;
	    if (curr_page.page_number > 1) then
		load_page (curr_page.page_number-1, prev_page);
	    else
		prev_page.page_number := 0;
	    end if;
	    
	    if (curr_page.page_number < page_list.all'last) then
		load_page (curr_page.page_number+1, next_page);
	    else
		next_page.page_number := 0;
	    end if;
	or
	    terminate;
	end select;
    end loop;
end;

end;
$ eod
$ checksum [.src]dvi_tasks.ada
$ if checksum$checksum .nes. "1332153152" then write sys$output -
    "    ******Checksum error for file [.src]dvi_tasks.ada******"
$ write sys$output "Creating [.src]dvi_tasks_.ada"
$ create [.src]dvi_tasks_.ada
$ deck
---------------------------------------------------------------------------
--|									|--
--| Title:  Dvi_tasks							|--
--| Date:    9-JUN-1987							|--
--| Name:   Randy Buckland						|--
--|									|--
--| Purpose:	Task manager for DVI file related operations.		|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Revision History							|--
--|									|--
--| Who	    Date	Description					|--
--| ---	    ----	-----------					|--
--| rcb	     9-JUN-1987	New file.					|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Copyright (c) 1987 by Research Triangle Institute.			|--
--| Written by Randy Buckland. Not derived from licensed software.	|--
--|									|--
--| Permission is granted to anyone to use this software for any	|--
--| purpose on any computer system, and to redistribute it freely,	|--
--| subject to the following restrictions.				|--
--|									|--
--| 1. Research Triangle Institute supplies this software "as is",	|--
--|	without any warranty. The author and the Institute do not	|--
--|	accept any responsibility for any damage caused by use or	|--
--|	mis-use of this program.					|--
--| 2. The copyright notice must remain a part of all sources files.	|--
--| 3. This software may not be sold in any fashion.			|--
--|									|--
---------------------------------------------------------------------------
with dvi_def;
use  dvi_def;

package dvi_tasks is

---------------------------------------------------------------------------
--|									|--
--| Task definitions.							|--
--|									|--
---------------------------------------------------------------------------
procedure reset_page (page : in page_ptr);

task dvi_read is
    pragma priority(6);
    entry init (file_name : in string; magnification : in float;
	page_count : out integer);
    entry get_next (page : out page_ptr);
    entry get_prev (page : out page_ptr);
    entry get_page (page_num : in integer; page : out page_ptr);
end;

end;
$ eod
$ checksum [.src]dvi_tasks_.ada
$ if checksum$checksum .nes. "1763783910" then write sys$output -
    "    ******Checksum error for file [.src]dvi_tasks_.ada******"
$ write sys$output "Creating [.src]dvi_translate.ada"
$ create [.src]dvi_translate.ada
$ deck
---------------------------------------------------------------------------
--|									|--
--| Title:  Dvi_translate						|--
--| Date:   12-JUN-1987							|--
--| Name:   Randy Buckland						|--
--|									|--
--| Purpose:	Translate DVI commands into a bitmap.			|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Revision History							|--
--|									|--
--| Who	    Date	Description					|--
--| ---	    ----	-----------					|--
--| rcb	    12-JUN-1987	New file.					|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Copyright (c) 1987 by Research Triangle Institute.			|--
--| Written by Randy Buckland. Not derived from licensed software.	|--
--|									|--
--| Permission is granted to anyone to use this software for any	|--
--| purpose on any computer system, and to redistribute it freely,	|--
--| subject to the following restrictions.				|--
--|									|--
--| 1. Research Triangle Institute supplies this software "as is",	|--
--|	without any warranty. The author and the Institute do not	|--
--|	accept any responsibility for any damage caused by use or	|--
--|	mis-use of this program.					|--
--| 2. The copyright notice must remain a part of all sources files.	|--
--| 3. This software may not be sold in any fashion.			|--
--|									|--
---------------------------------------------------------------------------
with dvi_io, text_io, sys, font_tasks, font_def;
use  dvi_io, text_io, sys, font_tasks, font_def;

with unchecked_deallocation;

package body dvi_translate is

---------------------------------------------------------------------------
--|									|--
--| Local_types.							|--
--|									|--
---------------------------------------------------------------------------
type stack_node;
type stack_ptr is access stack_node;

type stack_node is record
    h : integer;
    v : integer;
    w : integer;
    x : integer;
    y : integer;
    z : integer;
    next : stack_ptr;
end record;

procedure free is new unchecked_deallocation (stack_node, stack_ptr);
---------------------------------------------------------------------------
--|									|--
--| Static values.							|--
--|									|--
---------------------------------------------------------------------------
--|
--| Positioning parameters.
--|
h : integer;
v : integer;
w : integer;
x : integer;
y : integer;
z : integer;

stack_head : stack_ptr := null;
--|
--| Misc variables
--|
curr_font : font_ptr;
curr_page : page_ptr;
trash     : integer;
command   : integer;

---------------------------------------------------------------------------
--|									|--
--| Push_stack								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Description:    Push current positions onto stack.			|--
--|									|--
---------------------------------------------------------------------------
procedure push_stack is

temp : stack_ptr;

begin
    temp := new stack_node;
    temp.h := h;
    temp.v := v;
    temp.w := w;
    temp.x := x;
    temp.y := y;
    temp.z := z;
    temp.next := stack_head;
    stack_head := temp;
end;

---------------------------------------------------------------------------
--|									|--
--| Pop_stack								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Description:    Pop top stack positions and place into		|--
--|		    position variables.					|--
--|									|--
---------------------------------------------------------------------------
procedure pop_stack is

temp : stack_ptr;

begin
    if (stack_head /= null) then
	temp := stack_head;
	stack_head := temp.next;
	h := temp.h;
	v := temp.v;
	w := temp.w;
	x := temp.x;
	y := temp.y;
	z := temp.z;
	free (temp);
    end if;
end;

---------------------------------------------------------------------------
--|									|--
--| Dvi_to_pixel							|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Dvi units value to convert.			|--
--|									|--
--| Description:    Convert a DVI units value to a pixel count.		|--
--|									|--
---------------------------------------------------------------------------
function dvi_to_pixel (
    dvi_value : in integer)
    return integer is

temp : integer;

begin
    temp := integer(float(dvi_value)*
	(((dvi_to_nano_meter*magstep)/100000.0/2.54)*resolution));
    return temp;
end;

---------------------------------------------------------------------------
--|									|--
--| Pixel_to_dvi							|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Pixel count to convert to DVI units.		|--
--|									|--
--| Description:    Convert a pixel count to DVI units.			|--
--|									|--
---------------------------------------------------------------------------
function pixel_to_dvi (
    pixel_value : in float)
    return integer is

temp : integer;

begin
    temp := integer(pixel_value/
	(((dvi_to_nano_meter*magstep)/100000.0/2.54)*resolution));
    return temp;
end;

---------------------------------------------------------------------------
--|									|--
--| Set_font								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Font number.					|--
--|									|--
--| Description:    Set current font to desired font number.		|--
--|									|--
---------------------------------------------------------------------------
procedure set_font (
    font_number : in integer) is

begin
    font_search.find_font (font_number, curr_font);
end;

---------------------------------------------------------------------------
--|									|--
--| Set_character							|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Character to set.				|--
--|									|--
--| Description:    Set a character at current position on the		|--
--|		    bit map and advance the H value.			|--
--|									|--
---------------------------------------------------------------------------
procedure set_character (
    char : in integer) is

x_pos : integer;
y_pos : integer;

char_width : integer;
char_index : integer;
page_index : integer;

begin
    x_pos := dvi_to_pixel (h) + integer(resolution*magstep) +
	curr_font(char).x_offset;
    y_pos := dvi_to_pixel (v) + integer(resolution*magstep) -
	(curr_font(char).height + curr_font(char).y_offset);
    
    char_width := curr_font(char).width;
    char_index := 1;
    page_index := (y_pos-1)*curr_page.width + x_pos;
    
    for i in 1..curr_font(char).height loop
	curr_page.bits(page_index..page_index+char_width-1) :=
	    curr_font(char).bits(char_index..char_index+char_width-1);

	char_index := char_index + char_width;
	page_index := page_index + curr_page.width;
    end loop;
    
    h := h + pixel_to_dvi (curr_font(char).x_delta);
end;

---------------------------------------------------------------------------
--|									|--
--| Put_character							|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Character to set.				|--
--|									|--
--| Description:    Put  a character at current position on the		|--
--|		    bit map.						|--
--|									|--
---------------------------------------------------------------------------
procedure put_character (
    char : in integer) is

x_pos : integer;
y_pos : integer;

char_width : integer;
char_index : integer;
page_index : integer;

begin
    x_pos := dvi_to_pixel (h) + integer(resolution*magstep) + 
	curr_font(char).x_offset;
    y_pos := dvi_to_pixel (v) + integer(resolution*magstep) -
	(curr_font(char).height + curr_font(char).y_offset);
    
    char_width := curr_font(char).width;
    char_index := 1;
    page_index := (y_pos-1)*curr_page.width + x_pos;
    
    for i in 1..curr_font(char).height loop
	curr_page.bits(page_index..page_index+char_width-1) :=
	    curr_font(char).bits(char_index..char_index+char_width-1);

	char_index := char_index + char_width;
	page_index := page_index + curr_page.width;
    end loop;
end;

---------------------------------------------------------------------------
--|									|--
--| Trash_fnt_def							|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Font number being defined.			|--
--|									|--
--| Description:    Read and ignore a font definition since the		|--
--|		    fonts are already being loaded by the font		|--
--|		    tasks.						|--
--|									|--
---------------------------------------------------------------------------
procedure trash_fnt_def (
    font_number : in integer) is

trash : integer;
size  : integer;

begin
    trash := get_4byte;
    trash := get_4byte;
    trash := get_4byte;
    size := get_byte + get_byte;
    for i in 1..size loop
	trash := get_byte;
    end loop;
end;

---------------------------------------------------------------------------
--|									|--
--| Do_special								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Length of special command			|--
--|									|--
--| Description:    Read and discard special commands since they	|--
--|		    are not to be implemented yet.			|--
--|									|--
---------------------------------------------------------------------------
procedure do_special (
    size : in integer) is

temp : string(1..size);

begin
    for i in 1..size loop
	temp(i) := character'val(get_byte);
    end loop;
end;

---------------------------------------------------------------------------
--|									|--
--| Set_rule_box							|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Description:    Set a rule box on the page and advance the		|--
--|		    horizontal position.				|--
--|									|--
---------------------------------------------------------------------------
procedure set_rule_box is

x_pos : integer;
y_pos : integer;

x_offset : integer;
y_offset : integer;

page_index : integer;
row_count  : integer;
row_width  : integer;

begin
    x_pos := dvi_to_pixel (h) + integer(resolution*magstep);
    y_pos := dvi_to_pixel (v) + integer(resolution*magstep);

    y_offset := get_4byte;
    x_offset := get_4byte;
    
    if (x_offset > 0)
    and (y_offset > 0) then
	page_index := (y_pos-1)*curr_page.width + x_pos;
	row_count := dvi_to_pixel (y_offset);
	row_width := dvi_to_pixel (x_offset);
	
	if (row_count < 1) then row_count := 1; end if;
	if (row_width < 1) then row_width := 1; end if;
	
	for i in 1..row_count loop
	    if (row_width = 1) then
		curr_page.bits(page_index) := true;
	    else
		curr_page.bits(page_index..page_index+row_width-1) :=
		    (1..row_width => true);
	    end if;
	    page_index := page_index - curr_page.width;
	end loop;
    end if;

    h := h + x_offset;
end;

---------------------------------------------------------------------------
--|									|--
--| Put_rule_box							|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Description:    Put a rule box on the page.				|--
--|									|--
---------------------------------------------------------------------------
procedure put_rule_box is

x_pos : integer;
y_pos : integer;

x_offset : integer;
y_offset : integer;

page_index : integer;
row_count  : integer;
row_width  : integer;

begin
    x_pos := dvi_to_pixel (h) + integer(resolution*magstep);
    y_pos := dvi_to_pixel (v) + integer(resolution*magstep);

    y_offset := get_4byte;
    x_offset := get_4byte;
    
    if (x_offset > 0)
    and (y_offset > 0) then
	page_index := (y_pos-1)*curr_page.width + x_pos;
	row_count := dvi_to_pixel (y_offset);
	row_width := dvi_to_pixel (x_offset);
	
	if (row_count < 1) then row_count := 1; end if;
	if (row_width < 1) then row_width := 1; end if;
	
	for i in 1..row_count loop
	    if (row_width = 1) then
		curr_page.bits(page_index) := true;
	    else
		curr_page.bits(page_index..page_index+row_width-1) :=
		    (1..row_width => true);
	    end if;
	    page_index := page_index - curr_page.width;
	end loop;
    end if;
end;

---------------------------------------------------------------------------
--|									|--
--| Build_page								|--
--|									|--
---------------------------------------------------------------------------
--|									|--
--| Parameters:	    1. Pointer to page.					|--
--|									|--
--| Description:    Build a bitmap representation of current page of	|--
--|		    DVI file. Next byte of DVI file should be BOP	|--
--|		    command.						|--
--|									|--
---------------------------------------------------------------------------
procedure build_page (
    page : in page_ptr) is

temp : stack_ptr;

begin
--|
--| Check for valid page start.
--|
    if (get_byte /= bop) then
	put_line ("Invalid DVI file. Can't find BOP.");
	sys_exit;
    end if;
--|
--| Set to start state.
--|
    curr_page := page;
    
    h := 0;
    v := 0;
    w := 0;
    x := 0;
    y := 0;
    z := 0;
    
    while (stack_head /= null) loop
	temp := stack_head;
	stack_head := stack_head.next;
	free (temp);
    end loop;
    
    curr_font := null;
--|
--| Trash BOP parameters
--|
    for i in 1..11 loop
	trash := get_4byte;
    end loop;
--|
--| Main command loop
--|
    loop
	command := get_byte;
	case command is
	
	    when set_char_0..set_char_127 => set_character (command);

	    when set1 => set_character (get_byte);
	    when set2 => set_character (get_2byte);
	    when set3 => set_character (get_3byte);
	    when set4 => set_character (get_4byte);
	    
	    when set_rule => set_rule_box;
	    
	    when put1 => put_character (get_byte);
	    when put2 => put_character (get_2byte);
	    when put3 => put_character (get_3byte);
	    when put4 => put_character (get_4byte);
	    
	    when put_rule => put_rule_box;
	    
	    when nop => null;
	    when eop => exit;
	    when push => push_stack;
	    when pop  => pop_stack;
	    
	    when right1 => h := h + get_s_byte;
	    when right2 => h := h + get_s_2byte;
	    when right3 => h := h + get_s_3byte;
	    when right4 => h := h + get_4byte;
	    
	    when w0 => h := h + w;
	    when w1 => w := get_s_byte;  h := h + w;
	    when w2 => w := get_s_2byte; h := h + w;
	    when w3 => w := get_s_3byte; h := h + w;
	    when w4 => w := get_4byte;   h := h + w;

	    when x0 => h := h + x;
	    when x1 => x := get_s_byte;  h := h + x;
	    when x2 => x := get_s_2byte; h := h + x;
	    when x3 => x := get_s_3byte; h := h + x;
	    when x4 => x := get_4byte;   h := h + x;
	    
	    when down1 => v := v + get_s_byte;
	    when down2 => v := v + get_s_2byte;
	    when down3 => v := v + get_s_3byte;
	    when down4 => v := v + get_4byte;
	    
	    when y0 => v := v + y;
	    when y1 => y := get_s_byte;  v := v + y;
	    when y2 => y := get_s_2byte; v := v + y;
	    when y3 => y := get_s_3byte; v := v + y;
	    when y4 => y := get_4byte;   v := v + y;

	    when z0 => v := v + z;
	    when z1 => z := get_s_byte;  v := v + z;
	    when z2 => z := get_s_2byte; v := v + z;
	    when z3 => z := get_s_3byte; v := v + z;
	    when z4 => z := get_4byte;   v := v + z;
	    
	    when fnt_num_0..fnt_num_63 => set_font (command - fnt_num_0);
	    
	    when fnt1 => set_font (get_byte);
	    when fnt2 => set_font (get_2byte);
	    when fnt3 => set_font (get_3byte);
	    when fnt4 => set_font (get_4byte);
	    
	    when xxx1 => do_special (get_byte);
	    when xxx2 => do_special (get_2byte);
	    when xxx3 => do_special (get_3byte);
	    when xxx4 => do_special (get_4byte);
	    
	    when fnt_def1 => trash_fnt_def (get_byte);
	    when fnt_def2 => trash_fnt_def (get_2byte);
	    when fnt_def3 => trash_fnt_def (get_3byte);
	    when fnt_def4 => trash_fnt_def (get_4byte);

	    when others =>
		put_line ("Invalid command while setting page.");
		sys_exit (16#1000002c#);
	end case;
    end loop;
end;

end;
$ eod
$ checksum [.src]dvi_translate.ada
$ if checksum$checksum .nes. "947875448" then write sys$output -
    "    ******Checksum error for file [.src]dvi_translate.ada******"