home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / worldmap / mapvu20.arc / SLIDE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-01-13  |  10KB  |  266 lines
  1. Program slide; { display series of pictures from disk                        }
  2. { as produced by, e.g., MapView 2.0 or later                                 }
  3. { Freeware by Gisbert W.Selke, 11 Jan 1989. TurboPascal 4.0/5.0              }
  4.  
  5. { Additions and enhancements by Stefan Kaufmann                              }
  6. { - Introduced SetActivePage/SetVisualPage pair for sake of better animation }
  7. { - Added early Error-Handling for failed InitGraph (simple form)            }
  8.  
  9.  
  10. {$R-,S+,I+,D-,F-,V-,B-,N-,L+ }
  11. {$M 1300,0,655360 }
  12. { If you change and recompile, better first set $S+ : stack size has been    }
  13. { optimized.                                                                 }
  14.  
  15.   Uses Graph, CRT;
  16.  
  17.   Const defext = '.PIC';
  18.         maxpics = 75;
  19.         thisversion = 2;
  20.         version = '1.1';
  21.   crnotice : string[50] = 'Freeware by TapirSoft Gisbert W.Selke, 11 Jan 1989';
  22.  
  23.   Type scrf    = File;
  24.        picdesc = Record                   { screen file header record }
  25.                    versionc, followc : byte;
  26.                    grdriverc, grmodec : integer;
  27.                    sizec : word;
  28.                    xminc, yminc : integer;
  29.                  End;
  30.        picdata = Record
  31.                    follow : byte;
  32.                    grmoda : integer;
  33.                    size : word;
  34.                    xmin, ymin : integer;
  35.                    psc : pointer;
  36.                  End;
  37.  
  38.   Var grdriver, grmode : integer;
  39.       minfree : longint;
  40.       clearct, readct, wait, repts, repct, picds, nread, i : word;
  41.       ch : char;
  42.       curpic, lastpic, maxlastpic : byte;
  43.       finish, first, dowait, keywait : boolean;
  44.       picarr : Array [1..maxpics] Of picdata;
  45.       filename : string[80];
  46.       screenfile : scrf;
  47.       picd : picdesc;
  48.       PageSwitch, PNr : word;        { Additional PageNr between 0..1 }
  49.                                      { Stefan Kaufmann, 24.11.88      }
  50.  
  51.   Procedure FastKey; InLine
  52.   { fast way of testing for a key pressed                                    }
  53.   { nicked from PC Magazine, 26 Jan 1988                                     }
  54.     ($31/$C0/                         { XOR AX,AX }
  55.      $8E/$C0/                         { MOV ES,AX }
  56.      $26/$A1/$1A/$04/                 { MOV AX,ES:[041A] }
  57.      $26/$3B/$06/$1C/$04/             { CMP AX,ES:[041C] }
  58.      $74/$03);                        { JZ  $+3 }
  59.  
  60.   Procedure abort(t : string; i : byte);
  61.   { display an error message and abort                                       }
  62.   Begin                                                              { abort }
  63.     RestoreCRTMode;
  64.     writeln(t);
  65.     Halt(i);
  66.   End;                                                               { abort }
  67.  
  68.   Procedure init;
  69.   { process command line arguments                                           }
  70.     Var i : byte;
  71.         t : string[80];
  72.   Begin                                                               { init }
  73.     If ParamCount = 0 Then
  74.     Begin
  75.       writeln(
  76.       'Usage: slide <filename>[.<ext>] [/R<repetitions] [/D<delay>] [/K]');
  77.       Halt(1);
  78.     End;
  79.     wait  := 0;
  80.     repts := 1;
  81.     keywait := False;
  82.     filename := '';
  83.     For i := 1 To ParamCount Do
  84.     Begin
  85.       t := ParamStr(i);
  86.       If (t[1] = '/') Or (t[1] = '-') Then
  87.       Begin
  88.         If Length(t) >=3 Then
  89.         Begin
  90.           Case UpCase(t[2]) Of
  91.             'D' : Begin
  92.                     val(copy(t,3,255),minfree,grdriver);
  93.                     If (grdriver = 0) And (minfree >=0)
  94.                         And (minfree <= MaxInt) Then wait := minfree
  95.                       Else abort('Illegal /D specification',4);
  96.                     If wait = 0 Then wait := 2*MaxInt
  97.                                 Else wait := (wait+5) Div 10;
  98.                   End;
  99.             'R' : Begin
  100.                     val(copy(t,3,255),minfree,grdriver);
  101.                     If (grdriver = 0) And (minfree >=0)
  102.                         And (minfree <= MaxInt) Then repts := minfree
  103.                       Else abort('Illegal /R specification',4);
  104.                   End;
  105.             Else abort('Illegal command line option',4);
  106.           End;
  107.         End Else
  108.         Begin
  109.           If (Length(t) = 2) And (UpCase(t[2]) = 'K') Then keywait := True
  110.             Else abort('Illegal command line option',4);
  111.         End;
  112.       End Else
  113.       Begin
  114.         If filename <> '' Then abort('Multiple input files not supported',4);
  115.         filename := ParamStr(i);
  116.       End;
  117.     End;
  118.     If filename = '' Then abort('No input file specified',4);
  119.     If Pos('.',filename) = 0 Then filename := filename + defext;
  120.     dowait := wait > 0;
  121.     ch := #0;
  122.   End;                                                                { init }
  123.  
  124.   Procedure leaveprog;
  125.   { leave the programme orderly, if certain conditions hold                  }
  126.   Begin                                                          { leaveprog }
  127.     If ch <> #27 Then ch := ReadKey;
  128.     If (Not keywait) Or (ch In [#3,#27,'Q','q']) Then
  129.     Begin
  130.       CloseGraph;
  131.       writeln('SLIDE ',version,'  --  ',crnotice);
  132.       If clearct = 0 Then maxlastpic := lastpic;
  133.       If Not first Then write('Number of screens in file: ',readct,'. ');
  134.       writeln('Maximum number of screens stored: ',maxlastpic,'.');
  135.       If clearct = 0 Then minfree := MaxAvail;
  136.       writeln('Minimum memory available was about ',minfree,' bytes.');
  137.       writeln('Buffer was cleared ',clearct,' times.');
  138.       If KeyPressed Then curpic := ord(ReadKey);
  139.       Halt;
  140.     End;
  141.   End;                                                           { leaveprog }
  142.  
  143.   Procedure dodelay;
  144.   { waits <wait> times 10 milliseconds or until keypress                     }
  145.   Begin                                                            { dodelay }
  146.     i := 0;
  147.     ch := #0;
  148.     Repeat
  149.       Delay(10);
  150.       Inc(i);
  151.       Fastkey;
  152.       leaveprog;
  153.     Until (ch <> #0) Or (i >= wait);
  154.   End;                                                             { dodelay }
  155.  
  156. Begin                                                                 { main }
  157.   writeln('SLIDE ',version,'  --  ',crnotice);
  158.   init;
  159.   CheckBreak := False;
  160.   Assign(screenfile,filename);
  161.   {$I- } Reset(screenfile,1);  {$I+ }
  162.   If IOResult <> 0 Then abort('Cannot open input file ' + filename,3);
  163.   grdriver := Detect;
  164.   InitGraph(grdriver,grmode,'');
  165.   minfree := GraphResult;
  166.   If minfree <> 0 Then abort(GraphErrorMsg(minfree),1);
  167.   { detect Graph-Error as soon as possible!! Stefan Kaufmann. 24.11.88       }
  168.   If (grdriver = EGA) Or (grdriver = VGA) Or (grdriver = HercMono)
  169.                Then PageSwitch := 1          { PageSwitching supported??     }
  170.                Else PageSwitch := 0;
  171.   picds := SizeOf(picdesc);
  172.   lastpic := 0;
  173.   maxlastpic := 0;
  174.   clearct := 0;
  175.   If repts = 0 Then repct := 1 Else repct := 0;
  176.   readct := 0;
  177.   first := True;
  178.   PNr   := 0;
  179.   SetVisualPage(PNr);                 { Page switching for better animation }
  180.   PNr := PageSwitch - PNr;            { Stefan Kaufmann, 24.11.88           }
  181.   SetActivePage(PNr);
  182.   Repeat
  183.     Repeat
  184.       If eof(screenfile) Then finish := True
  185.       Else
  186.       Begin
  187.         BlockRead(screenfile,picd,picds,nread);
  188.         If nread <> picds Then abort('Illegal size record in file',2);
  189.         With picd Do
  190.         Begin
  191.           If versionc > thisversion Then abort('Illegal pic file version',2);
  192.           If grdriver <> grdriverc Then
  193.                               abort('Incompatible graphics mode in file',2);
  194.           If grmode <> grmodec Then
  195.           Begin
  196.             grmode := grmodec;
  197.             SetGraphMode(grmode);
  198.             If GraphResult <> 0 Then abort('Illegal graphics mode in file',2);
  199.           End;
  200.           If (MaxAvail < sizec) Or (lastpic >= Pred(maxpics)) Then
  201.           Begin
  202.             minfree := MaxAvail;
  203.             For curpic := lastpic DownTo 1 Do
  204.                            FreeMem(picarr[curpic].psc,picarr[curpic].size);
  205.             If lastpic > maxlastpic Then maxlastpic := lastpic;
  206.             lastpic := 0;
  207.             Inc(clearct);
  208.           End;
  209.           Inc(lastpic);
  210.           With picarr[lastpic] Do
  211.           Begin
  212.             follow := followc;
  213.             grmoda := grmodec;
  214.             size := sizec;
  215.             xmin := xminc;
  216.             ymin := yminc;
  217.             GetMem(psc,size);
  218.             BlockRead(screenfile,psc^,size,nread);
  219.             If nread <> size Then abort('Illegal pic size in file',2);
  220.           End;
  221.         End;
  222.         finish := False;
  223.         SetActivePage(PNr);                   { see above, SK }
  224.         With picarr[lastpic] Do PutImage(xmin,ymin,psc^,NormalPut);
  225.         If picarr[lastpic].follow = 0 Then
  226.         Begin
  227.           SetVisualPage(PNr);{ see above, SK }
  228.           PNr := PageSwitch - PNr;
  229.           SetActivePage(PNr);                   { see above, SK }
  230.           If dowait Then dodelay;
  231.           If first Then Inc(readct);
  232.         End;
  233.       End;
  234.       FastKey;
  235.       leaveprog;
  236.     Until finish;
  237.     first := False;
  238.     Reset(screenfile,1);
  239.     If repts <> 0 Then Inc(repct);
  240.   Until (repct = repts) Or (clearct = 0);
  241.   Close(screenfile);
  242.   If clearct = 0 Then
  243.   Begin
  244.     While repct <> repts Do
  245.     Begin
  246.       If repct <> 0 Then Inc(repct);
  247.       For curpic := 1 To lastpic Do
  248.       Begin
  249.         SetActivePage(PNr);         { see above, SK }
  250.         With picarr[curpic] Do PutImage(xmin,ymin,psc^,NormalPut);
  251.         If picarr[curpic].follow = 0 Then
  252.         Begin
  253.           SetVisualPage(PNr);       { see above, SK }
  254.           PNr := PageSwitch - PNr;
  255.           SetActivePage(PNr);
  256.           If dowait Then dodelay;
  257.         End;
  258.         FastKey;
  259.         leaveprog;
  260.       End;
  261.     End;
  262.   End;
  263.   ch := #27;
  264.   leaveprog;
  265. End.
  266.