Category : A Collection of Games for DOS and Windows
Archive   : EMPIREU.ZIP
Filename : LSCAPE.PAS

program LSCAPE(OUTPUT,TEXT_FILE) ;

var TEXT_FILE : file of CHAR ;

{ LandSCAPE printing on Panasonic KX-P1092i printer }

const
BLANK = chr(32) ;
CR = chr(13) ;
DEL = chr(127);
ESC = chr(27) ;
FF = chr(12) ;
LF = chr(10) ;
NUL = chr(0) ;
TAB = chr(9) ;

FONT_MIN_BIT = 1 ; { minimum bit within byte to use }
FONT_MAX_BIT = 7 ;
FONT_MIN_BYTE = 2 ; { minimum byte of character rep }
FONT_MAX_BYTE = 10 ;

MAX_CPL = 128 ; { maximum characters per line of text }
MAX_LPP = 160 ; { maximum lines per page of text }

P_DPL = 720 { 576 { 480 } ; { printer dots per line }
P_MODE = 6 { 5 { 0 } ; { printer 8-pin bit image graphic mode }

var
FONT : array [chr(0)..chr(255)] of array [1..10] of CHAR ;
FONT_HEIGHT, FONT_WIDTH : INTEGER ; { height and width of character }
{ in dots (normal orientation) }
LONGEST_LINE : INTEGER ; { length of longest line on current page }
LPP : INTEGER ; { lines per printed page }
N_LINES : INTEGER ; { number of lines on current page }
PAGE : array [1..MAX_LPP] of array [1..MAX_CPL] of CHAR ;
PAGE_NUMBER : INTEGER ;
PREV_C : CHAR ; { last character read from text file }
PRINTER : file of CHAR ;
P_DPLHI, P_DPLLO : INTEGER ; { low and high bytes of P_DPL }

procedure set_character(ch: char; charset: integer;
pat1, pat2, pat3, pat4, pat5,
pat6, pat7, pat8, pat9, pat10:
integer) ;
begin
FONT[CH][ 1] := chr(PAT1) ;
FONT[CH][ 2] := chr(PAT2) ;
FONT[CH][ 3] := chr(PAT3) ;
FONT[CH][ 4] := chr(PAT4) ;
FONT[CH][ 5] := chr(PAT5) ;
FONT[CH][ 6] := chr(PAT6) ;
FONT[CH][ 7] := chr(PAT7) ;
FONT[CH][ 8] := chr(PAT8) ;
FONT[CH][ 9] := chr(PAT9) ;
FONT[CH][10] := chr(PAT10);
end ;

procedure SET_CSET_1 ;
begin
{ United States/Keyboard 00, 01 }
set_character(blank,1,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00);
set_character('!',1,#00,#10,#10,#10,#10,#10,#00,#10,#00,#00);
set_character('"',1,#00,#24,#24,#24,#00,#00,#00,#00,#00,#00);
set_character('#',1,#00,#28,#28,#7C,#28,#7C,#28,#28,#00,#00);
set_character('$',1,#00,#10,#3C,#50,#38,#14,#78,#10,#00,#00);
set_character('%',1,#00,#60,#64,#08,#10,#20,#4C,#0C,#00,#00);
set_character('&',1,#00,#20,#50,#50,#20,#54,#48,#34,#00,#00);
set_character('''',1,#0,#10,#10,#20,#00,#00,#00,#00,#00,#00);
set_character('(',1,#00,#08,#10,#20,#20,#20,#10,#08,#00,#00);
set_character(')',1,#00,#20,#10,#08,#08,#08,#10,#20,#00,#00);
set_character('*',1,#00,#00,#10,#54,#38,#54,#10,#00,#00,#00);
set_character('+',1,#00,#00,#10,#10,#7C,#10,#10,#00,#00,#00);
set_character(',',1,#00,#00,#00,#00,#00,#00,#10,#10,#20,#00);
set_character('-',1,#00,#00,#00,#00,#7C,#00,#00,#00,#00,#00);
set_character('.',1,#00,#00,#00,#00,#00,#00,#00,#10,#00,#00);
set_character('/',1,#00,#00,#04,#08,#10,#20,#40,#00,#00,#00);
set_character('0',1,#00,#30,#48,#48,#48,#48,#48,#30,#00,#00);
set_character('1',1,#00,#10,#30,#10,#10,#10,#10,#38,#00,#00);
set_character('2',1,#00,#38,#44,#04,#18,#20,#40,#7C,#00,#00);
set_character('3',1,#00,#38,#44,#04,#18,#04,#44,#38,#00,#00);
set_character('4',1,#00,#08,#18,#28,#48,#7C,#08,#08,#00,#00);
set_character('5',1,#00,#7C,#40,#78,#04,#04,#44,#38,#00,#00);
set_character('6',1,#00,#1C,#20,#40,#78,#44,#44,#38,#00,#00);
set_character('7',1,#00,#7C,#04,#08,#10,#20,#20,#20,#00,#00);
set_character('8',1,#00,#38,#44,#44,#38,#44,#44,#38,#00,#00);
set_character('9',1,#00,#38,#44,#44,#3C,#04,#08,#70,#00,#00);
set_character(':',1,#00,#00,#00,#10,#00,#00,#10,#00,#00,#00);
set_character(';',1,#00,#00,#00,#10,#00,#00,#10,#10,#20,#00);
set_character('<',1,#00,#08,#10,#20,#40,#20,#10,#08,#00,#00);
set_character('=',1,#00,#00,#00,#7C,#00,#7C,#00,#00,#00,#00);
set_character('>',1,#00,#20,#10,#08,#04,#08,#10,#20,#00,#00);
set_character('?',1,#00,#38,#44,#04,#08,#10,#10,#00,#10,#00);
set_character('@',1,#00,#38,#44,#4C,#54,#5C,#40,#38,#00,#00);
set_character('A',1,#00,#10,#28,#44,#44,#7C,#44,#44,#00,#00);
set_character('B',1,#00,#78,#44,#44,#78,#44,#44,#78,#00,#00);
set_character('C',1,#00,#38,#44,#40,#40,#40,#44,#38,#00,#00);
set_character('D',1,#00,#78,#24,#24,#24,#24,#24,#78,#00,#00);
set_character('E',1,#00,#7C,#40,#40,#78,#40,#40,#7C,#00,#00);
set_character('F',1,#00,#7C,#40,#40,#78,#40,#40,#40,#00,#00);
set_character('G',1,#00,#38,#44,#40,#40,#4C,#44,#3C,#00,#00);
set_character('H',1,#00,#44,#44,#44,#7C,#44,#44,#44,#00,#00);
set_character('I',1,#00,#38,#10,#10,#10,#10,#10,#38,#00,#00);
set_character('J',1,#00,#0C,#04,#04,#04,#04,#44,#38,#00,#00);
set_character('K',1,#00,#44,#48,#50,#60,#50,#48,#44,#00,#00);
set_character('L',1,#00,#40,#40,#40,#40,#40,#40,#7C,#00,#00);
set_character('M',1,#00,#44,#6C,#54,#54,#44,#44,#44,#00,#00);
set_character('N',1,#00,#44,#64,#54,#4C,#44,#44,#44,#00,#00);
set_character('O',1,#00,#38,#44,#44,#44,#44,#44,#38,#00,#00);
set_character('P',1,#00,#78,#44,#44,#78,#40,#40,#40,#00,#00);
set_character('Q',1,#00,#38,#44,#44,#44,#44,#54,#28,#04,#00);
set_character('R',1,#00,#78,#44,#44,#78,#50,#48,#44,#00,#00);
set_character('S',1,#00,#38,#44,#40,#38,#04,#44,#38,#00,#00);
set_character('T',1,#00,#7C,#10,#10,#10,#10,#10,#10,#00,#00);
set_character('U',1,#00,#44,#44,#44,#44,#44,#44,#38,#00,#00);
set_character('V',1,#00,#44,#44,#44,#28,#28,#10,#10,#00,#00);
set_character('W',1,#00,#44,#44,#44,#54,#54,#6C,#44,#00,#00);
set_character('X',1,#00,#44,#44,#28,#10,#28,#44,#44,#00,#00);
set_character('Y',1,#00,#44,#44,#28,#10,#10,#10,#10,#00,#00);
set_character('Z',1,#00,#7C,#04,#08,#10,#20,#40,#7C,#00,#00);
set_character('[',1,#00,#38,#20,#20,#20,#20,#20,#38,#00,#00);
set_character('\',1,#00,#00,#40,#20,#10,#08,#04,#00,#00,#00);
set_character(']',1,#00,#38,#08,#08,#08,#08,#08,#38,#00,#00);
set_character('^',1,#00,#10,#28,#44,#00,#00,#00,#00,#00,#00);
set_character('_',1,#00,#00,#00,#00,#00,#00,#00,#7C,#00,#00);
set_character('`',1,#00,#10,#10,#08,#00,#00,#00,#00,#00,#00);
set_character('a',1,#00,#00,#00,#38,#04,#3C,#44,#3C,#00,#00);
set_character('b',1,#00,#40,#40,#78,#44,#44,#44,#78,#00,#00);
set_character('c',1,#00,#00,#00,#38,#40,#40,#44,#38,#00,#00);
set_character('d',1,#00,#04,#04,#3C,#44,#44,#44,#3C,#00,#00);
set_character('e',1,#00,#00,#00,#38,#44,#7C,#40,#38,#00,#00);
set_character('f',1,#00,#18,#24,#20,#78,#20,#20,#20,#00,#00);
set_character('g',1,#00,#00,#00,#3C,#44,#44,#3C,#04,#44,#38);
set_character('h',1,#00,#40,#40,#58,#64,#44,#44,#44,#00,#00);
set_character('i',1,#00,#10,#00,#30,#10,#10,#10,#38,#00,#00);
set_character('j',1,#00,#08,#00,#18,#08,#08,#08,#08,#48,#30);
set_character('k',1,#00,#40,#40,#44,#48,#70,#48,#44,#00,#00);
set_character('l',1,#00,#30,#10,#10,#10,#10,#10,#38,#00,#00);
set_character('m',1,#00,#00,#00,#EC,#92,#92,#92,#92,#00,#00);
set_character('n',1,#00,#00,#00,#58,#64,#44,#44,#44,#00,#00);
set_character('o',1,#00,#00,#00,#38,#44,#44,#44,#38,#00,#00);
set_character('p',1,#00,#00,#00,#78,#44,#44,#78,#40,#40,#40);
set_character('q',1,#00,#00,#00,#3C,#44,#44,#3C,#04,#04,#04);
set_character('r',1,#00,#00,#00,#58,#64,#44,#40,#40,#00,#00);
set_character('s',1,#00,#00,#00,#3C,#40,#38,#04,#78,#00,#00);
set_character('t',1,#00,#00,#20,#78,#20,#20,#20,#18,#00,#00);
set_character('u',1,#00,#00,#00,#44,#44,#44,#4C,#34,#00,#00);
set_character('v',1,#00,#00,#00,#44,#44,#44,#28,#10,#00,#00);
set_character('w',1,#00,#00,#00,#44,#44,#54,#54,#28,#00,#00);
set_character('x',1,#00,#00,#00,#44,#28,#10,#28,#44,#00,#00);
set_character('y',1,#00,#00,#00,#44,#44,#44,#3C,#04,#44,#38);
set_character('z',1,#00,#00,#00,#7C,#08,#10,#20,#7C,#00,#00);
set_character('{',1,#00,#0C,#10,#10,#20,#10,#10,#0C,#00,#00);
set_character('|',1,#00,#10,#10,#10,#10,#10,#10,#10,#00,#00);
set_character('}',1,#00,#60,#10,#10,#08,#10,#10,#60,#00,#00);
set_character('~',1,#00,#00,#34,#48,#00,#00,#00,#00,#00,#00);
set_character(DEL,1,#00,#54,#2A,#54,#2A,#54,#2A,#54,#2A,#00);
end ;


procedure SET_UP_PRINTER ;
begin
ASSIGN(PRINTER,'PRN') ;
REWRITE(PRINTER) ;
PAGE_NUMBER := 0 ;
FONT_WIDTH := FONT_MAX_BIT - FONT_MIN_BIT + 1 ;
FONT_HEIGHT := FONT_MAX_BYTE - FONT_MIN_BYTE + 1 ;
{ set vertical spacing: 1/72" per dot so set to number of bits }
{ per character representation ("width" of character in }
{ normal orientation, "height" on paper in landscape mode }
WRITE(PRINTER,ESC,'A',chr(FONT_WIDTH)) ;
{ compute low and high bytes of P_DPL for use in shifting into }
{ graphics mode }
P_DPLHI := P_DPL div 256 ;
P_DPLLO := P_DPL - 256*P_DPLHI ;
{ compute number of "lines" we can accommodate on a printed page }
{ (i.e., number of characters turned sideways that will fit on a }
{ line }
LPP := P_DPL div FONT_HEIGHT ;
end ;

procedure OPEN_TEXT ;
begin
RESET(TEXT_FILE) ;
PREV_C := NUL ;
end ;

procedure READ_PAGE ;
var END_OF_PAGE : BOOLEAN ;
C : CHAR ;
COL, LINE : INTEGER ;
begin
for LINE := 1 to MAX_LPP do
for COL := 1 to MAX_CPL do
PAGE[LINE,COL] := BLANK ;
LONGEST_LINE := 0 ;
N_LINES := 1 ;
COL := 1 ;
END_OF_PAGE := FALSE ;
repeat
READ(TEXT_FILE,C) ;
if ord(C) > 127 then C := chr( ord(C) - 128 ) ;
if ord(C) < 32 then
begin
if ( C = CR ) or ( C = LF ) then
if ord(C) + ord(PREV_C) <> ord(CR) + ord(LF) then
{ treat as end-of-line }
if N_LINES < LPP then
begin
N_LINES := N_LINES + 1 ;
COL := 1 ;
end
else END_OF_PAGE := TRUE
else C := NUL { not end-of-line, but don't let suppress next one }
else if C = FF then END_OF_PAGE := TRUE
else if C = TAB then COL := ( COL + 7 ) div 8 * 8 + 1
end
else if COL <= MAX_CPL then
begin
PAGE[N_LINES,COL] := C ;
if COL > LONGEST_LINE then LONGEST_LINE := COL ;
COL := COL + 1 ;
end ;
PREV_C := C ;
if EOF(TEXT_FILE) then END_OF_PAGE := TRUE ;
until END_OF_PAGE ;
end ;

procedure START_GRAPHICS_LINE ;
begin
WRITE(PRINTER,ESC,'*',chr(P_MODE),chr(P_DPLLO),chr(P_DPLHI)) ;
end ;


procedure PRINT_PAGE ;
var C : CHAR ;
B, COL, LINE, N : INTEGER ;
begin
{ if not first page, advance to top of form }
PAGE_NUMBER := PAGE_NUMBER + 1 ;
if PAGE_NUMBER > 1 then WRITE(PRINTER,FF) ;
{ Print page sideways }
for COL := 1 to LONGEST_LINE do
begin
{ space over as many "lines" as we don't have on this page }
N := P_DPL - N_LINES * FONT_HEIGHT ;
START_GRAPHICS_LINE ;
for B := 1 to N do WRITE(PRINTER,NUL) ;
{ now print one column of page }
for LINE := N_LINES downto 1 do
begin
C := PAGE[LINE,COL] ;
for B := FONT_MAX_BYTE downto FONT_MIN_BYTE do
WRITE(PRINTER,FONT[C][B])
end
end ;
{ try to flush printer's buffer }
WRITE(PRINTER,LF)
end ;


procedure PRINT_TEXT ;
begin
while not EOF(TEXT_FILE) do
begin
READ_PAGE ;
PRINT_PAGE ;
end
end ;


procedure ANALYZE ;
var C : CHAR ;
B, B2, V : INTEGER ;

NONZERO : array [1..10] of INTEGER ;
begin
for B := 1 to 10 do NONZERO[B] := 0 ;
for C := chr(32) to chr(127) do
for B := 1 to 10 do
if FONT[C][B] <> NUL then NONZERO[B] := NONZERO[B] + 1 ;
WRITELN(' Number of characters with non-zero byte in each position:') ;
for B := 1 to 10 do
WRITELN(B:2, ': ', NONZERO[B]:5) ;
for B := 1 to 8 do NONZERO[B] := 0 ;
for C := chr(32) to chr(127) do
for B := 1 to 10 do
begin
V := ord(FONT[C][B]) ;
for B2 := 1 to 8 do
begin
if V mod 2 <> 0 then NONZERO[B] := NONZERO[B] + 1 ;
V := V div 2 ;
end ;
end ;
WRITELN(' Number of bytes with non-zero bit in each position:') ;
for B := 1 to 8 do
WRITELN(B:2, ': ', NONZERO[B]:5) ;
end ;

begin
SET_CSET_1 ;
SET_UP_PRINTER ;
OPEN_TEXT ;
PRINT_TEXT ;
{ ANALYZE ; }
end .