Category : Science and Education
Archive   : MAPVU20.ZIP
Filename : SLIDE.PAS

 
Output of file : SLIDE.PAS contained in archive : MAPVU20.ZIP

Program slide; { display series of pictures from disk }
{ as produced by, e.g., MapView 2.0 or later }
{ Freeware by Gisbert W.Selke, 11 Jan 1989. TurboPascal 4.0/5.0 }

{ Additions and enhancements by Stefan Kaufmann }
{ - Introduced SetActivePage/SetVisualPage pair for sake of better animation }
{ - Added early Error-Handling for failed InitGraph (simple form) }


{$R-,S+,I+,D-,F-,V-,B-,N-,L+ }
{$M 1300,0,655360 }
{ If you change and recompile, better first set $S+ : stack size has been }
{ optimized. }

Uses Graph, CRT;

Const defext = '.PIC';
maxpics = 75;
thisversion = 2;
version = '1.1';
crnotice : string[50] = 'Freeware by TapirSoft Gisbert W.Selke, 11 Jan 1989';

Type scrf = File;
picdesc = Record { screen file header record }
versionc, followc : byte;
grdriverc, grmodec : integer;
sizec : word;
xminc, yminc : integer;
End;
picdata = Record
follow : byte;
grmoda : integer;
size : word;
xmin, ymin : integer;
psc : pointer;
End;

Var grdriver, grmode : integer;
minfree : longint;
clearct, readct, wait, repts, repct, picds, nread, i : word;
ch : char;
curpic, lastpic, maxlastpic : byte;
finish, first, dowait, keywait : boolean;
picarr : Array [1..maxpics] Of picdata;
filename : string[80];
screenfile : scrf;
picd : picdesc;
PageSwitch, PNr : word; { Additional PageNr between 0..1 }
{ Stefan Kaufmann, 24.11.88 }

Procedure FastKey; InLine
{ fast way of testing for a key pressed }
{ nicked from PC Magazine, 26 Jan 1988 }
($31/$C0/ { XOR AX,AX }
$8E/$C0/ { MOV ES,AX }
$26/$A1/$1A/$04/ { MOV AX,ES:[041A] }
$26/$3B/$06/$1C/$04/ { CMP AX,ES:[041C] }
$74/$03); { JZ $+3 }

Procedure abort(t : string; i : byte);
{ display an error message and abort }
Begin { abort }
RestoreCRTMode;
writeln(t);
Halt(i);
End; { abort }

Procedure init;
{ process command line arguments }
Var i : byte;
t : string[80];
Begin { init }
If ParamCount = 0 Then
Begin
writeln(
'Usage: slide [.] [/R] [/K]');
Halt(1);
End;
wait := 0;
repts := 1;
keywait := False;
filename := '';
For i := 1 To ParamCount Do
Begin
t := ParamStr(i);
If (t[1] = '/') Or (t[1] = '-') Then
Begin
If Length(t) >=3 Then
Begin
Case UpCase(t[2]) Of
'D' : Begin
val(copy(t,3,255),minfree,grdriver);
If (grdriver = 0) And (minfree >=0)
And (minfree <= MaxInt) Then wait := minfree
Else abort('Illegal /D specification',4);
If wait = 0 Then wait := 2*MaxInt
Else wait := (wait+5) Div 10;
End;
'R' : Begin
val(copy(t,3,255),minfree,grdriver);
If (grdriver = 0) And (minfree >=0)
And (minfree <= MaxInt) Then repts := minfree
Else abort('Illegal /R specification',4);
End;
Else abort('Illegal command line option',4);
End;
End Else
Begin
If (Length(t) = 2) And (UpCase(t[2]) = 'K') Then keywait := True
Else abort('Illegal command line option',4);
End;
End Else
Begin
If filename <> '' Then abort('Multiple input files not supported',4);
filename := ParamStr(i);
End;
End;
If filename = '' Then abort('No input file specified',4);
If Pos('.',filename) = 0 Then filename := filename + defext;
dowait := wait > 0;
ch := #0;
End; { init }

Procedure leaveprog;
{ leave the programme orderly, if certain conditions hold }
Begin { leaveprog }
If ch <> #27 Then ch := ReadKey;
If (Not keywait) Or (ch In [#3,#27,'Q','q']) Then
Begin
CloseGraph;
writeln('SLIDE ',version,' -- ',crnotice);
If clearct = 0 Then maxlastpic := lastpic;
If Not first Then write('Number of screens in file: ',readct,'. ');
writeln('Maximum number of screens stored: ',maxlastpic,'.');
If clearct = 0 Then minfree := MaxAvail;
writeln('Minimum memory available was about ',minfree,' bytes.');
writeln('Buffer was cleared ',clearct,' times.');
If KeyPressed Then curpic := ord(ReadKey);
Halt;
End;
End; { leaveprog }

Procedure dodelay;
{ waits times 10 milliseconds or until keypress }
Begin { dodelay }
i := 0;
ch := #0;
Repeat
Delay(10);
Inc(i);
Fastkey;
leaveprog;
Until (ch <> #0) Or (i >= wait);
End; { dodelay }

Begin { main }
writeln('SLIDE ',version,' -- ',crnotice);
init;
CheckBreak := False;
Assign(screenfile,filename);
{$I- } Reset(screenfile,1); {$I+ }
If IOResult <> 0 Then abort('Cannot open input file ' + filename,3);
grdriver := Detect;
InitGraph(grdriver,grmode,'');
minfree := GraphResult;
If minfree <> 0 Then abort(GraphErrorMsg(minfree),1);
{ detect Graph-Error as soon as possible!! Stefan Kaufmann. 24.11.88 }
If (grdriver = EGA) Or (grdriver = VGA) Or (grdriver = HercMono)
Then PageSwitch := 1 { PageSwitching supported?? }
Else PageSwitch := 0;
picds := SizeOf(picdesc);
lastpic := 0;
maxlastpic := 0;
clearct := 0;
If repts = 0 Then repct := 1 Else repct := 0;
readct := 0;
first := True;
PNr := 0;
SetVisualPage(PNr); { Page switching for better animation }
PNr := PageSwitch - PNr; { Stefan Kaufmann, 24.11.88 }
SetActivePage(PNr);

Repeat
Repeat
If eof(screenfile) Then finish := True
Else
Begin
BlockRead(screenfile,picd,picds,nread);
If nread <> picds Then abort('Illegal size record in file',2);
With picd Do
Begin
If versionc > thisversion Then abort('Illegal pic file version',2);
If grdriver <> grdriverc Then
abort('Incompatible graphics mode in file',2);
If grmode <> grmodec Then
Begin
grmode := grmodec;
SetGraphMode(grmode);
If GraphResult <> 0 Then abort('Illegal graphics mode in file',2);
End;
If (MaxAvail < sizec) Or (lastpic >= Pred(maxpics)) Then
Begin
minfree := MaxAvail;
For curpic := lastpic DownTo 1 Do
FreeMem(picarr[curpic].psc,picarr[curpic].size);
If lastpic > maxlastpic Then maxlastpic := lastpic;
lastpic := 0;
Inc(clearct);
End;
Inc(lastpic);
With picarr[lastpic] Do
Begin
follow := followc;
grmoda := grmodec;
size := sizec;
xmin := xminc;
ymin := yminc;
GetMem(psc,size);
BlockRead(screenfile,psc^,size,nread);
If nread <> size Then abort('Illegal pic size in file',2);
End;
End;
finish := False;
SetActivePage(PNr); { see above, SK }
With picarr[lastpic] Do PutImage(xmin,ymin,psc^,NormalPut);
If picarr[lastpic].follow = 0 Then
Begin
SetVisualPage(PNr);{ see above, SK }
PNr := PageSwitch - PNr;
SetActivePage(PNr); { see above, SK }
If dowait Then dodelay;
If first Then Inc(readct);
End;
End;
FastKey;
leaveprog;
Until finish;
first := False;
Reset(screenfile,1);
If repts <> 0 Then Inc(repct);
Until (repct = repts) Or (clearct = 0);
Close(screenfile);
If clearct = 0 Then
Begin
While repct <> repts Do
Begin
If repct <> 0 Then Inc(repct);
For curpic := 1 To lastpic Do
Begin
SetActivePage(PNr); { see above, SK }
With picarr[curpic] Do PutImage(xmin,ymin,psc^,NormalPut);
If picarr[curpic].follow = 0 Then
Begin
SetVisualPage(PNr); { see above, SK }
PNr := PageSwitch - PNr;
SetActivePage(PNr);
If dowait Then dodelay;
End;
FastKey;
leaveprog;
End;
End;
End;
ch := #27;
leaveprog;
End.