home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
games
/
rle.zip
/
RLE1.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1986-04-25
|
3KB
|
140 lines
{
RLE.PAS - Written by Wes Meier (76703,747).
Version 1.00 - 4/25/86.
Based on Dick McCaleb's (72236,3206) April 1986
RLE decoder for the TRS-80 Color Computer.
---> for Public Domain Only <---
}
type
str255 = string[255];
var
filename : file of byte;
sx : str255;
Procedure Instruct;
begin
writeln('RLE: Run Length Encoded Graphics Decoder. Version 1.00 4/25/86.');
writeln(' by Wes Meier [76703,747].');
writeln(' for Public Domain ONLY');
writeln;
writeln('Usage: RLE filespec[.RLE]')
end; { Proc Instruct }
Procedure GetFile(sf : str255);
Var
i : integer;
Begin
for i := 1 to length(sf) do sf[i] := upcase(sf[i]);
if pos('.',sf) = 0 then sf := sf + '.RLE';
Assign(Filename,sf);
{$I- }
Reset(Filename);
{$I+ }
If IOResult > 0
then
Begin
Writeln('File "',sf,'" wasn',#39,'t found.');
Halt
End { if }
End; { Proc GetFile }
Procedure Decode;
label loop;
var
x,
y,
tc,
w,
i,
j : integer;
b : byte;
Ok : boolean;
Begin
tc := 1;
GraphColorMode;
GraphBackground(0);
GraphWindow(32,0,319,199);
Palette(1);
x := 0;
y := 0;
loop:
read(filename,b);
if b <> 27 then goto loop;
read(filename,b);
if b <> ord('G') then goto loop;
read(filename,b);
if b <> ord('H') then goto loop;
Ok := true;
Repeat { until NOT Ok or EOF }
read(filename,b);
b := b - 32;
Ok := (b >= 0);
if Ok
then
Begin
x := x + b;
if x > 255
then
begin
y := y + 1;
x := x mod 256
end; { if x }
if not EOF(filename)
then
read(filename,b)
else
b := 0;
w := b - 32;
Ok := (w >= 0);
if Ok and (w > 0)
then
begin
j := w + x - 1;
if j > 255
then
begin
draw(x,y,255,y,tc);
i := y + 1;
j := j mod 256;
draw(0,i,j,i,tc);
x := x + w
end { if j }
else
begin
draw(x,y,j,y,tc);
x := x + w
end { else if j }
end { if Ok and (w > 0) }
end { if ok }
Until not Ok or EOF(filename);
Close(Filename)
End; { Proc Decode }
Begin { Main }
lowvideo;
if paramcount = 0
then
instruct
else
begin
getfile(paramstr(1));
decode;
sound(440);
delay(250);
Nosound;
repeat until keypressed;
textmode
end { else }
End.