Category : Science and Education
Archive   : FBI10MST.ZIP
Filename : HRLE.PAS

 
Output of file : HRLE.PAS contained in archive : FBI10MST.ZIP
Program HerculesRLE;


{$I typedef.sys}
{$I graphix.sys}
{$I kernel.sys}
{$I windows.sys}


{
*********************************************

By Ivar Sanders, Compuserve # 72306,14

Version 2.0

Given to the public domain on August 21, 1986

*********************************************

Version 2.0 corrects world-to-screen coordinate problems of version 1.0
involving Graphics Toolbox proceedure calls.

*********************************************

Displays run-length encoded graphics images using a Hercules graphics display.

Allows variable scaling of the image's horizontal dimension and printing of
the image on an Epson printer.

Invoke the program as HRLE (with no command-line parameters)
for a description of its use.

Written in Turbo Pascal (3.01A) using the Turbo Graphix Toolbox (1.05).
The standard Graphix Toolbox files ERROR.MSG and 4X6.FON are needed
to run the program.
}

type

str255 = string[255];

var

TheFile : file of byte;
FileName : str255;
Index : integer;
ErrCode : integer;
MinXWin : integer;
MaxXwin : integer;
XWinSize : integer;
XRatio : integer;


Procedure NoFileName;

begin
LowVideo;
WriteLn;
WriteLn('Program HRLE displays run-length encoded graphics images');
WriteLn('utilizing a Hercules graphics display.');
WriteLn;
WriteLn('Run the program as follows: HRLE FILENAME.EXT XSIZE');
WriteLn;
WriteLn('Where FILENAME.EXT is the name of a 256 x 192 run-length');
WriteLn('encoded graphics file. The file name extension (.EXT)');
WriteLn('is optional and defaults to .RLE if not specified.');
WriteLn('XSIZE is an optional integer (in the range 20 to 140)');
WriteLn('which scales the horizontal size of the display.');
WriteLn('The default value is 100 (2 pixels per horizontal step).');
WriteLn('The displayed image may be printed on an Epson printer');
WriteLn('by pressing the number keys: 1, 2, 3, 4 or 6, corresponding');
WriteLn('to the Epson graphics print mode of the same number');
WriteLn('(960, 960, 1920, 640 or 720 points per line, respectively).');
WriteLn('Holding the shift key down while pressing a number key');
WriteLn('causes black and white to be reversed on the printed image.');
WriteLn;
WriteLn('The files ERROR.MSG and 4X6.FON must also be in the directory.');
WriteLn;
WriteLn('Press the ESC key to end the program.')
end; { of procedure NoFileName }


Procedure GetFile;

Begin
for Index := 1 to length(FileName) do
FileName[Index] := upcase(FileName[Index]);
if pos('.',FileName) = 0 then FileName := FileName + '.RLE';
Assign(TheFile,FileName);
{$I- }
Reset(TheFile);
{$I+ }
If IOResult > 0
then
Begin
WriteLn;
WriteLn('File ',FileName,' was not found.');
NoFileName;
Halt
End { if }
end; { of procedure GetFile }


Procedure Decode;

var

XStart,
CurrentLine,
WhiteCnt,
NextLine,
XStop : integer;
Data : byte;
Ok,
ExitProgram : boolean;
Cmd : char;

begin

Ok := false;
While (not EOF(TheFile)) and (not Ok) do
begin
Read(TheFile,Data); { look for ESC }
If Data = $1B then
begin
Read(TheFile,Data); { look for character G }
If Data = $47 then
begin
Read(TheFile,Data); { look for character H }
If Data = $48 then Ok := true { if ESC, G, H found, then }
end { generate graphics }
end
end;
If not Ok then { if end of file with no ESC, G, H then assume no graphics }
begin
WriteLn;
WriteLn('Sorry, ',FileName,' must not be a run-length encoded file!');
NoFileName;
Halt
end;

XStart := 0;
CurrentLine := 2; { first 2 lines obscured by header }

FileName := FileName + ' -- press ESC to exit'; { header text }

If XRatio < 20 then XRatio := 20; { make sure scaling fits }
If XRatio > 140 then XRatio := 140;
XWinSize := (64 * XRatio) div 100; { find X size in 8-pixel units }
MinXWin := (90 - XWinSize) div 2;
MaxXWin := MinXWin + XWinSize;

InitGraphic;
SetBackground($55); { fill background with alternate 1 and 0 }
DrawBorder;

{
Some trial and error went into determining the correct window and world
dimensions. The Graphix Toolbox documentation could be much better.
}

DefineWindow(1,MinXWin,40,MaxXWin-1,243); { window 1 in RLE image }
DefineHeader(1,FileName); { put file name and exit info in header }

{
The 256 x 192 RLE image is actually expanded to a 512 x 192 "image space"
so that RLE pixels will be drawn properly by proceedere DrawLine, which
will not draw single-pixel horizontal lines at all and shortens other lines
by one screen pixel if 256 x 192 "image space" is used. This has to do
with the way the Toolbox truncates numbers. This is especially a problem
when the world coordinate system is of lower resolution than the screen
coordinates -- which is the case with RLE on a Hercules display.

The default XRatio of 100 causes each RLE pixel to be represented by
two screen pixels.
}

DefineWorld(1,0,194,511,0);
SelectWorld(1);
SelectWindow(1);
SetHeaderOn;
SetBackground(0); { fill window background with black }
DrawBorder;

repeat { read and display the RLE data }
read(TheFile,Data);
Data := Data - 32; { reduce byte by 32 to get # of W or B pixels }
Ok := (Data >= 0); { make sure it's in the right range }
if Ok then
Begin { start with black data }
XStart := XStart + (Data shl 1);
if XStart > 511 then { if the line is full, then put the }
begin { remainder in the next line }
CurrentLine := CurrentLine + 1;
XStart := XStart - 512
end;
if not EOF(TheFile) then read(TheFile,Data)
else Data := 0;
WhiteCnt := Data - 32; { do the white data }
Ok := (WhiteCnt >= 0);
if Ok and (WhiteCnt > 0) then
begin { draw out the white data }
XStop := (WhiteCnt shl 1) + XStart;
if XStop > 511 then { wrap to the next line if needed }
begin
DrawLine(XStart,CurrentLine,511,CurrentLine);
NextLine := CurrentLine + 1;
XStop := XStop - 512;
DrawLine(0,NextLine,XStop,NextLine);
XStart := XStart + (WhiteCnt shl 1)
end
else
begin
DrawLine(XStart,CurrentLine,XStop,CurrentLine);
XStart := XStart + (WhiteCnt shl 1)
end
end
end
Until not Ok or EOF(TheFile);
Close(TheFile);
sound(440); { beep (low freq) to signal picture complete }
delay(250);
Nosound;
ExitProgram := false;
while not ExitProgram do { wait for ESC or number key }
if KeyPressed then
begin
Read(Kbd,Cmd); { exit if ESC, print if number, else beep }
case Cmd of { norm and inv printing definition opposite Toolbox }
#27 : ExitProgram := true; { if ESC then exit }
#49 : HardCopy(true,1); { 1: print norm, mode 1 }
#50 : HardCopy(true,2); { 2: print norm, mode 2 }
#51 : HardCopy(true,3); { 3: print norm, mode 3 }
#52 : HardCopy(true,4); { 4: print norm, mode 4 }
#54 : HardCopy(true,6); { 6: print norm, mode 6 }
#33 : HardCopy(false,1); { 1: print inverse, mode 1 }
#64 : HardCopy(false,2); { 2: print inverse, mode 2 }
#35 : HardCopy(false,3); { 3: print inverse, mode 3 }
#36 : HardCopy(false,4); { 4: print inverse, mode 4 }
#94 : HardCopy(false,6); { 6: print inverse, mode 6 }
else
begin
sound(880); { beep (high freq) if some other key }
delay(100);
nosound
end
end
end;
textmode

end; { of procedure Decode }


begin { main part of program Hercules Run Length Encode }
NormVideo;
case paramcount of { see if there is anything on the command line }
0 : NoFileName; { no command-line parameters }
1 : begin { assume RLE file name only }
FileName := paramstr(1);
XRatio := 100; { give it the default X scaling }
GetFile;
Decode
end;
2 : begin { RLE file name and X scale }
FileName := paramstr(1);
Val(paramstr(2),XRatio,ErrCode);
If ErrCode = 0 then { make sure it's an integer }
begin
GetFile;
Decode { do it! }
end
else
begin
WriteLn;
WriteLn('Sorry, ',paramstr(2),' is not an integer.');
NoFileName
end
end;
else NoFileName end { if more on command line, treat like no parameter }

end. { of program HerculesRLE }


  3 Responses to “Category : Science and Education
Archive   : FBI10MST.ZIP
Filename : HRLE.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/