[Back to ANSI SWAG index] [Back to Main SWAG index] [Original]
{Ok, I was inspired by whoever posted that smooth scrolling text file viewer,
I wanted to add ANSi support and also a File Finder which displays SAUCE info.
So here it is...
The main SmoothScroll routine I pulled from this echo, the ANSI3 TPU started
out as a ANSI tpu in the SWAG, except i rewerote it so that it doesnt use
the standard WRITE routine, which would generate a scroll after 25 lines.
This just keeps filling up video ram for 255 lines, so you can scroll up
and down.
About the only original bit was the file finder, which comes in 2 parts -
ReadDir which makes up a data structure, and GetFile which lets you move
through that structure.
The dodgy.pas is just a TheDraw saved screen.
There is at least one bug I know of, certain ansimation screens dont work
properly, if anyone can tell me why I would be majorly pleased!
any comments, etc, you can get me at
mammoth@sydney.DIALix.OZ.au
cya
Slack Mammoth
}
Program AnsiView;
{$i-}
uses dos,crt,Ansi3; { ANSI3 also found in the ANSI.SWG file }
{$i dodgey.pas}
{the screen template}
TYPE T_SAUCEREC = RECORD {pulled from ACiD's SAUCE.TXT}
ID : Array[1..5] of Char;
Version : Array[1..2] of Char;
Title : Array[1..35] of Char;
Author : Array[1..20] of Char;
Group : Array[1..20] of Char;
Date : Array[1..8] of Char;
FileSize : Longint;
DataType : Byte;
FileType : Byte;
TInfo1 : Word;
TInfo2 : Word;
TInfo3 : Word;
TInfo4 : Word;
Comments : Byte;
Flags : Byte;
Filler : Array[1..22] of Char;
END;
type T_EntryType =(Drive,Dir,Sauce,Normal,None);
{ie is this entry a Drive, a Directory, a file with SAUCE
code, a file without, or the end marker}
type T_DirEntry = record
Name : String[12]; {12 chars - filename.ext}
EntryType : T_EntryType;
Tested : boolean; {have we checked if its got sauce?}
SAUCErec : T_SAUCEREC;
end;
Var
DIR_INFO : array[0..255] of T_DirEntry; {the whole dir structure}
mask : string[14]; {file mask}
OldPath : PathStr; {the file path to here}
OldMode : Byte; {old video mode}
Num_Entries : Byte; {number of entries in the dir}
FileToView : string[14]; { the file to view, or '*' to exit - set by
getfile}selected : integer; {the record currently selected}
Top, Bottom : integer; {current top and bottom of section of list}
HighDrive : char; {letter of the highest disk found}
{---------------------------------------------------------------------------}
procedure shuffle(n : byte);
{make a space at position 'n' by moving top to n up one}
var
loop : byte;
begin
for loop:=255 downto n+1 do
DIR_INFO[loop]:=DIR_INFO[Loop-1];
end;
{---------------------------------------------------------------------------}
function DiskExist(disk : char) : boolean;
{is there a disk with letter 'disk'?}
var
result : byte;
d : byte; {turn letter A-Z into a number 1..255}
begin
disk:=UpCase(disk);
d:=ord(disk);
d:=d-ord('A')+1;
DiskExist:=(DiskSize(d)>0);
end; {diskexist}
{--------------------------------------------------------------------------}
procedure cls;assembler;
{clears a whole chunk of video ram, not just the current page}
asm
mov cx,$8000
mov ax,$b800
mov es,ax
xor di,di
xor ax,ax
rep stosw
end;
{---------------------------------------------------------------------------}
procedure SetScreenStart(ScanLine:word);
var
StartAddress: word;
begin
StartAddress := (ScanLine div 16)*80;
portw[$3D4] := hi(StartAddress) shl 8 + $0C; { Set start address }
portw[$3D4] := lo(StartAddress) shl 8 + $0D;
repeat until port[$3DA] and 8<>0; { wait for retrace }
portw[$3D4] := (ScanLine mod 16) shl 8 + 8; { Set start scanline }
repeat until port[$3DA] and 8=0; { wait out retrace }
end;
{--------------------------------------------------------------------------}
procedure ReadDir; {reads in the current dir, makes the DIR_INFO table}
Var
ThisFileRec : FileRec; {alias for the file we are working on}
RecNum : byte; {tracks number of records built}
f : File; {the actual file, which we open to do the SAUCE}
S : SearchRec; {info used during the search}
ThisEntry : T_DirEntry; {used to alias one entry}
n : byte; {counter to find place to insert}
loop : byte;
loopchar : char;
begin
Recnum:=0; {init the vars}
for loop:=0 to 255 do DIR_INFO[loop].Entrytype:=none;
{first find all the directories}
findfirst('*.*', (Directory),S); {find all dirs}
if IOresult >0 then
begin
chdir(oldpath); {if go to a dud disk}
findfirst(mask, (Directory),S);
end;
while ((DosError<>18) and (RecNum<225)) do
begin
ThisEntry.Name:=S.Name;
If (((s.Attr and directory)>0) and (S.name<>'.'))then
begin
ThisEntry.EntryType:=dir;
{ie its a directory}
{Now insert it in the right place}
if recnum=0 then DIR_INFO[0]:=ThisEntry
else
begin
n:=0;
while ((ThisEntry.Name>DIR_INFO[n].Name) and (n<RecNum)
and (DIR_INFO[n].entrytype=DIR)) do inc(n);
{now n points to the right spot}
shuffle(n); {make the gap};
DIR_INFO[n]:=ThisEntry;
end; {insert at right place}
inc(RecNum);
end; {if its a dir, and not '.'}
FindNext(s); {get the next file}
end ; {while not end of file, or to many files}
findfirst(mask, (01),S); {find all normal files}
while ((DosError<>18) and (RecNum<225)) {ie end of file, or to many
files} do begin
ThisEntry.Name:=S.Name;
ThisEntry.EntryType:=Normal; {if its SAUCE we will change}
ThisEntry.Tested:=false;
{Now insert it in the right place}
if recnum=0 then DIR_INFO[0]:=ThisEntry
else
begin
n:=0;
while (DIR_INFO[n].EntryType=DIR)
do inc(n);
while ((ThisEntry.Name>DIR_INFO[n].Name) and (n<RecNum))
do inc(n);
{now n points to the right spot}
shuffle(n); {make the gap};
DIR_INFO[n]:=ThisEntry;
end; {insert at right place}
inc(recnum);
FindNext(s); {get the next file}
end; {while}
{now do the drives}
for loopchar:='A' to HighDrive do
begin
with DIR_INFO[recnum] do
begin
Name:=LoopChar+':';
EntryType:=drive;
end; {with this record}
inc(recnum);
end;
Num_Entries:=RecNum; {Num_Entries-1 is the last valid}
end; {procedure ReadDir}
{--------------------------------------------------------------------------}
Procedure GetFile;
{lets the user move around, finding the file - sets FileToView to the
file to view, or '*' if exit.
Use the DIR_INFO array created by ReadDir}
var
ThisEntry : T_DirEntry; {used to alias one entry}
RecNum : Byte; {loops through the array}
done : boolean; {escape pressed}
loop : byte;
FKey : Char;
ThisKey : Char;
ThisLine : String[74]; {string built up to display}
ThisLineY : Byte; {Y pos of this line}
Loop2 : byte;
Movement : shortint; {how does selected change ?}
f : file; {file opened for SAUCE}
size : integer; {size of the file}
thisSAUCE : T_SAUCErec; {recored loaded in}
begin
done:=false;
{draw the screen}
MOVE(IMAGEDATA,mem[$b800:0000],sizeof(IMAGEDATA));
TextBackground(Black);
repeat
if Top < 0 then Top:=0;
Bottom:=Top+6; {to display 8}
if bottom > Num_Entries-1 then bottom:=Num_Entries-1;
if selected< top then selected:=top;
if selected> bottom then selected:=bottom;
{boundary checking}
ThisLineY:=15; { first entry goes on line 15}
TextBackground(black);
for loop:= Top to top + 6 do
{this builds up a string called 'ThisLine' and writes it, seven
times}
begin
ThisLine:=' ';
for loop2:=1 to 74 do ThisLine:=ThisLine+' ';
{now ThisLine is empty}
if loop<=Bottom then
{make sure we dont go past the good elements}
begin
with DIR_INFO[loop] do
begin
if ((EntryType=Normal) and (Tested=False))
{ok, this file we havnt checked for SAUCE, so
look now}
then begin
Tested:=True;
Assign(f,Name); {alias the file}
Reset(f,1); {get ready to
read it} if IOresult=0 then
begin
size:=filesize(f);
if (size >128) then {cant
be sauce if <=128} begin
Seek(f,(size-sizeof(thisSAUCE)));
{where the SAUCE record MIGHT be}
blockread(f,ThisSAUCE,SizeOf(ThisSAUCE)); {read in the SAUCE info}
SAUCErec:=ThisSAUCE;
if SAUCErec.ID='SAUCE' then {is it
valid?} EntryType:=SAUCE;
end; {if filesize >128}
Close(f);
end; {if no error}
end; {if need to check for SAUCE}
for loop2:=1 to length(NAME) do
ThisLine[loop2]:=NAME[loop2];
{copy the name into ThisLine}
if EntryType=DIR then
Begin
ThisLine[17]:='D';
ThisLine[18]:='I'; {clumsy }
ThisLine[19]:='R';
end {if its a dir}
else if EntryType=Drive then
Begin
ThisLine[17]:='D';
ThisLine[18]:='r';
ThisLine[19]:='i';
ThisLine[20]:='v';
ThisLine[21]:='e';
end {if its a drive}
else if EntryType=SAUCE then
begin
for loop2:=1 to length(SAUCErec.Title) do
ThisLine[loop2+16]:=SAUCErec.Title[Loop2];
for loop2:=1 to length(SAUCErec.Author) do
ThisLine[loop2+53]:=SAUCErec.Author[Loop2]; end;
{else if its sauce} end; {with}
end; {if loop <= bottom}
{now ThisLine has been built}
GotoXY(4,ThisLineY); {position the cursor}
{now do the lightbar/highlight etc}
if (loop=selected)
then begin
TextColor(White);
TextBackground(green);
end
else if ((loop=selected-1) or (loop=selected+1))
then begin
TextColor(LightGray);
TextBackground(Black);
end
else TextColor(DarkGray);
{write it!}
Write(ThisLine);
inc(ThisLineY);
end; {for loop}
{now get a key press}
FKey:=#0;
ThisKey:=Readkey;
if (ThisKey=#0) then FKey:=ReadKey;
If ThisKey=#27 then
begin
done:=true;
FileToView:='*';
{so that the main loop knows to exit}
end;
movement:=0;
if FKey=#$48 then movement:=-1; {up arrow}
if FKey=#$49 then movement:=-7; {page up}
if FKey=#$50 then movement:=1; {down arrow}
if FKey=#$51 then movement:=7; {page down}
selected:=selected+movement;
if selected<0 then selected:=0;
if selected>Num_Entries-1 then selected:=Num_Entries-1;
if top>selected then top:=top+movement;
if bottom<selected then top:=top+(movement);
if Fkey=#$47 then
begin
top:=0; {home}
selected:=0;
end;
if Fkey=#$4F then
begin
top:=Num_Entries-7; {end}
selected:=Num_Entries;
end;
if ThisKey=#13 then
begin
ThisEntry:=Dir_Info[Selected];
if ((ThisEntry.EntryType=dir) or ((ThisEntry.EntryType=drive)
))then begin
{ok, we have changed drives or directories so read in
the new info}
ChDir(ThisEntry.Name);
if IOresult>0 then chdir(oldpath);
ReadDir;
Top:=0;
selected:=0;
end
else {we have a file!}
begin
done:=true;
FileToView:=Dir_Info[selected].NAME;
end;
{f its a dir}
end; {if enter pressed}
until done;
end; {procedure showdir}
{--------------------------------------------------------------------------}
procedure ViewFile;
{view the file in FileToView, treat it as an ANSi file}
var
f : text; {the actual file}
ThisLine : string; {line just readin}
ThisChar : char;
velocity: shortint; {how fast are we scrolling?}
ScreenStart : longint; {what is the start of the screen in scanlines}
ThisKey, Fkey : char; {used to get characters}
loop : word;
skip : boolean; {skip the scroll down?}
done : boolean;
frames : byte; {number of retraces before decreasing velocity}
begin
assign(f,FileToView);
reset(f);
textColor(LightGray);
TextBackground(Black);
screen_bottom:=0;
My_gotoxy(1,1);
while ((not EOF(f)) and (screen_bottom<255)) do
begin
ThisLine:='';
repeat
read(f,ThisChar);
if thischar<>#12 then ThisLine:=ThisLine+ThisChar;
until ((eoln(f)) or (thischar=' ')or (thischar='m'));
{this is cos some lines in ansi files have 2000+ chars before a cr,
so if you just go readln you lose heaps}
AnsiWriteLn(ThisLine);
if ((eoln(f)) and (not eof(f))) then
begin
readln(f);
inc(My_WhereY);
My_WhereX:=1;
end;
end;
close(f);
{now the file is in memory, so lets go scrolling!}
velocity:=0;
screenStart:=0;
{scroll to the bottom}
if screen_bottom>25 then
begin
skip:=false;
done:=false;
for loop :=0 to (screen_bottom-25)*1 do
begin
if keypressed then
begin
screenstart:=loop*16;
skip:=true;
end;
if not skip then setscreenstart(loop*16)
else loop:=(screen_bottom-25)*1
end;
{and back up}
if not skip then for loop :=(screen_bottom-25)*1 downto 0 do
begin
if not keypressed then setscreenstart(loop*16);
{if loop>2 then dec(loop);}
if keypressed then
begin
screenstart:=loop*16;
loop:=0;
end;
end;
end; {if screen bottom is off the screen}
if keypressed then thiskey:=readkey else thiskey:=#0;
{now if theres more than 25 lines let the user scroll}
if (screen_bottom >25) then repeat
setscreenstart(screenstart);
fkey:=#0;
if keypressed then
begin
thiskey:=readkey;
if thiskey=#0 then fkey:=readkey;
end;
if thiskey=#27 then done:=true; {escape}
if thiskey=#13 then velocity:=0; {freeze on enter}
if thiskey=#32 then velocity:=0; {freeze on space}
if fkey=#$47 then
begin
velocity:=0;
screenstart:=0;
end; {home key}
if fkey=#$4f then
begin
velocity:=0;
screenstart:=(screen_bottom-25)*16;
end; {end key}
if fkey=#$48 then dec(velocity,3); {up}
if ((fkey=#$49) and (screenstart>160)) then dec(velocity,16); {page
up} if ((fkey=#$49) and (screenstart<=160)) then dec(velocity,6);
{page up} if fkey=#$50 then inc(velocity,3); {down}
if ((fkey=#$51) and (screenstart<((screen_bottom-30)*16) ))then
inc(velocity,16); {page down} if ((fkey=#$51) and
(screenstart>=((screen_bottom-30)*16) ))then inc(velocity,6); {page down}
inc(screenstart, velocity); { update screen position
}
inc(frames);
if frames=3 then
begin
{ie only reduce the velocity every 4 times through = 4 retraces}
frames:=0;
if velocity >0 then dec(velocity);
if velocity <0 then inc(velocity);
end; {if frame =10}
{if we hit the top or bootm, reverse velocity}
if screenstart>(screen_bottom-25)*16 then
begin
screenstart:=(screen_bottom-25)*16;
velocity:=0-(velocity div 2);
end;
if screenstart<0 then
begin
screenstart:=0;
velocity:=-0-(velocity div 2);
end;
until (thisKey=#27)
else {if the file is less than 25 lines, just wait for a keypress}
repeat
thiskey:=readkey;
until (thiskey=#27);
if keypressed then thiskey:=readkey;
{just kill that char}
setscreenstart(0);
end; {procedure ViewFile}
{--------------------------------------------------------------------------}
procedure ShutDown;
begin
{restore old mode}
asm
mov al,OldMode
mov ah,0
int $10
end; {restore old mode}
chdir(OldPath); {restore the path}
{now turn on the cursor}
asm
mov cx,$0708
mov ah,$01
int $10
end; {turn on cursor}
end; {shutdown}
{--------------------------------------------------------------------------}
procedure SetUp;
{misc stuff to get set}
var
path : string;
d : dirstr;
n : namestr;
e : extstr;
s : searchrec;
begin
{get the current drive}
GetDir(0,OldPath);
cls;
mask:='*.*';
{grab the old video mode}
asm
mov ah,$0f
int $10
mov oldmode,al
end; {asm}
{new mode}
{ TextMode(CO80);}
{now turn of the cursor}
asm
mov ch,$20
mov ah,$01
int $10
end; {turn off cursor}
{find the highest drive}
HighDrive:='C';
while DiskExist(HighDrive) do
begin
HighDrive:=char(ord(HighDrive)+1);
end;
HighDrive:=char(ord(HighDrive)-1);
Top:=0;
selected:=0;
{now, if there is a command line parameter, use it as a path.
if there is only one match, then just display that file and exit.
so av *.ans will mean dirs will only show .ans files, but av file.ans
will display file.ans and then exit}
if paramcount > 0 then
begin
path:=paramstr(1);
{check if only one file matches}
findfirst(path, (01),S);
if doserror=0 then
begin
FindNext(s);
if doserror=18 {ie no more matches} then
begin
FileToView:=path;
ViewFile;
shutdown;
Halt(0); {we are all done!}
end;
end;
fsplit(path,d,n,e);
if n='' then n:='*';
if e='' then e:='.*';
mask:=n+e;
chdir(d);
end;
end;
{--------------------------------------------------------------------------}
var loop1 : byte;
begin {main}
Setup;
ReadDir;
repeat
GetFile;
if FileToView<>'*' then
begin
cls;
ViewFile;
end;
until FileToView='*'; {thats the sentinel}
ShutDown;
end.
[Back to ANSI SWAG index] [Back to Main SWAG index] [Original]