Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8707 / 8 < prev next >

Wrap

Text File | 1993-09-02 | 44.2 KB | 1,542 lines

Article 99 of comp.sources.misc: Relay-Version: version B 2.10.3 alpha 5/22/85; site osu-eddie.UUCP Path: osu-eddie!cbosgd!ihnp4!ptsfa!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: 7 Jul 87 01:47:31 GMT Date-Received: 8 Jul 87 03:35:01 GMT Sender: allbery@ncoast.UUCP Lines: 1525 Approved: allbery@ncoast.UUCP X-Archive: comp.sources.misc/8707/8 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******"