ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/GRAPHICS/PLOT/SURFUTI3.ZIP/PLAYBACK.PAS

Pascal/Delphi Source File | 1991-11-29 | 16.9 KB | 540 lines

{$I DEFINES.INC}
program playback;

{ KVC 09/14/91 Made SURFbgi use conditional }
uses crt,
  XMS,
  surfGRAF,
  SHAREDEC,
{$IFDEF EXTERNAL}
  SURFbgi;
{$ELSE}
  Graph;
{$ENDIF}

{plays back a graphic image stored with Surfmodl}

type
  picptr = ^pic;

  pic = record
          speed       : integer;        { delay between screens }
          next        : picptr;         { next in linked list }
          prev        : picptr;         { prev for doubly-linked list }
          image       : picbuf;         { screen buffers }
          xms_image   : xmsbuf;         { screen buffers in XMS }
          nbuf        : integer;        { # screen buffers used }
          nlines_buf  : nlpic;          { # screen lines in each buffer }
          xms_bufsize : xmsbuf;         { # bytes stored in XMS buffer }
          buftype     : buffertype;     { buffer type (1=std mem, 2=xms mem) }
          grsys       : integer;        { graphic system type }
          grmode      : integer;        { graphic mode }
          dispmode    : word;           { display option (reg,XOR,etc.) }
          vgapalette  : SurfPalette;    { pallette, if grsys = VGA256 }
        end;

CONST
  VERSNUM = '2.00c';
  VERSDATE = '29 November, 1991';

var
  header,position,lastpos : picptr;
  filename : string;
  infile : text;
  oldgrsys, oldgrmode : integer;
  done : boolean;
  advance_pos : boolean;
  goforward : boolean;
  buf : integer;
  y1 : integer;
  membuffer : pointer;      { buffer for copying to/from XMS }
  buf_avail : boolean;      { is membuffer available? }
  pbuf : pointer;
  ch : char;
  cnv_memused : longint;    { kbytes of conventional memory used in run }
  xms_memused : longint;    { kbytes of xms memory used in run }
  xms_hdlused : integer;    { # xms handles used in run }

label ABORTGRPH;


procedure waitforkey;
{beeps, then waits for a key to be pressed}
var ch: char;

begin {waitforkey}
  write (chr(7));
  repeat until keypressed;
  while keypressed do
    ch := readkey;

end; {waitforkey}

{ KVC Moved readscrn into PLAYBACK.PAS (from SURFGRAF.PAS) so SURFMODL
  doesn't have to have all the extra baggage associated with XMS support.
}
function readscrn (filename : string; var grsys,grmode : integer;
    var image : picbuf; var xms_image: xmsbuf; var buftype: buffertype;
    var xms_bufsize: xmsbuf; var nbuf : integer; var nlines_buf : nlpic;
    var vgapalette : SurfPalette; oldgrsys, oldgrmode : integer) : boolean;
var
  imagefile   : file;
  success     : boolean;
  nbytes      : longint;
  tmp         : real;
  xmax        : integer;
  ymax        : integer;
  nbytes_line : longint;
  y1, y2      : integer;
  grtmp       : integer;
  grmtmp      : integer;

begin
  success := true;
  {$I-}
  assign (imagefile,filename);

  if ioresult <> 0 then begin
    success := false;
    restorecrtmode;
    writeln ('File "',filename,'" not found');
  end;

  reset (imagefile,1);
  if ioresult <> 0 then begin
    success := false;
    restorecrtmode;
    writeln ('File "',filename,'" not found');
  end;

  blockread (imagefile,grsys,sizeof(grsys));
  if ioresult <> 0 then begin
    success := false;
    restorecrtmode;
    writeln ('Could not read grsys');
  end;

  blockread (imagefile,grmode,sizeof(grmode));
  if ioresult <> 0 then begin
    success := false;
    restorecrtmode;
    writeln ('Could not read grmode');
  end;

  if (grsys = VGA256) then begin
    { Have to restore the VGA palette too }
    blockread (imagefile, vgapalette, sizeof(vgapalette));
    if ioresult <> 0 then begin
      success := false;
      restorecrtmode;
      writeln ('Could not read VGA palette');
    end;
  end;

  {$I+}


  if success then begin
    { Have to go into graphics mode to read line size }
    if (grsys <> oldgrsys) then begin
      if (oldgrsys <> -1) then
        { Not the first time, exit graphics mode first }
        closegraph;
{$IFNDEF EXTERNAL}
      { KVC 04/20/91 Make Turbo recognize the SVGA256.BGI file }
      grtmp := InstallUserDriver('SVGA256', @DetectVGA256);
{$ENDIF}
      { KVC 09/11/91 This call to detect shouldn't be necessary, but otherwise
          Turbo does not seem to be using the SVGA256.BGI file.
      }
      grtmp := detect;
      grmtmp := 0;
      if (grsys <> VGA256) then
          grtmp := grsys;
      initgraph (grtmp,grmtmp,BGIDIR);
      if (graphresult < 0) then
        success := false
      else begin
        setgraphmode(grmode);
        if (graphresult < 0) then
          success := false
        else begin
          if (grsys = VGA256) then
            { Set the palette }
            VGASetAllPalette (vgapalette);
        end;
      end;
    end else if (grmode <> oldgrmode) then
      setgraphmode (grmode);

    if success then begin
      xmax := GetMaxX;
      ymax := GetMaxY;
      if (Grsys = VGA256) then
        { Bug in SVGA256 doesn't set imagesize correctly }
        nbytes_line := xmax + 5
      else
        nbytes_line := imagesize (0, 0, xmax, 0);

      { Find out how many lines we can fit in a 64K buffer }
      if (nbytes_line * (ymax+1) > MAXALLOC) then
        nlines_buf[1] := MAXALLOC div nbytes_line
      else
        nlines_buf[1] := ymax + 1;
    end;

    y1 := 0;
    y2 := nlines_buf[1] - 1;
    nbuf := 0;

    { The following loop is done once per buffer }
    while (success) and (y1 <= y2) do begin

      { Make sure we don't allocate more than we need }
      nbuf := nbuf + 1;
      if (nbuf > MAXPICBUF) then begin
        restorecrtmode;
        writeln ('ERROR: More than ', MAXPICBUF,
            ' buffers required for bitmap!');
        writeln ('  (Grsys=', grsys, ' Grmode=', grmode, ')');
        writeln ('Please report this problem to Ken Van Camp.');
        halt;
      end;
      nlines_buf[nbuf] := y2 - y1 + 1;
      buftype[nbuf] := 1;
      if (Grsys = VGA256) then
        { Bug in SVGA256 doesn't set imagesize correctly }
        { KVC added longint() per suggestion from Gisbert Selke 11/19/91 }
        nbytes := longint (xmax+1) * (y2-y1+1) + 4
      else
        nbytes := imagesize (0, y1, xmax, y2);

      { KVC 11/09/91 No longer need to check for available memory before
        the getmem() call, since HeapErrorTrap now stops the Error 203's.
      }
      getmem (image[nbuf], nbytes);

      if (image[nbuf] = nil) then begin
        { Not enough conventional memory available, try XMS }
        if (buf_avail) then begin
          xms_bufsize[nbuf] := nbytes;
          xms_image[nbuf] := EMBGetMem (nbytes div 1024 + 1);
          if (XMSError <> 0) then begin
            restorecrtmode;
            writeln ('XMS Error getting mem: ', XMSErrorString (XMSError));
            success := false;
          end else begin
            xms_memused := xms_memused + nbytes div 1024 + 1;
            xms_hdlused := xms_hdlused + 1;
            buftype[nbuf] := 2;
          end;
          pbuf := membuffer;
        end else
          { XMS not available }
          success := false;
        if (not success) then begin
          restorecrtmode;
          writeln ('Could not allocate memory for bitmap');
        end;
      end else begin
        pbuf := image[nbuf];
        cnv_memused := cnv_memused + nbytes div 1024 + 1;
      end; { if image[nbuf] }

      if (success) then begin
        {memory successfully allocated}
        {$I-}
        blockread (imagefile, pbuf^, nbytes);
        if ioresult <> 0 then begin
          success := false;
          restorecrtmode;
          writeln ('Could not read image');
        end;
        {$I+}
        { Move to XMS, if used }
        if (buftype[nbuf] = 2) then begin
          MoveToEMB (pbuf^, xms_image[nbuf], nbytes);
          if (XMSError <> 0) then begin
            restorecrtmode;
            writeln ('XMS Error moving to EMB: ', XMSErrorString (XMSError));
            success := false;
          end;
        end;
      end; {Memory allocated}

      y1 := y1 + nlines_buf[nbuf];
      y2 := y2 + nlines_buf[nbuf];
      if (y2 > ymax) then
        y2 := ymax;

    end; { while }

  end; { Image successfully read }

  {$I-}
  close (imagefile);
  {$I+}
  if ioresult <> 0 then
    success := false;

  readscrn := success;
end; {readscrn}


procedure xms_shutdown;
{ Release all allocated extended memory }
begin
  position := header;
  while (position <> nil) do begin
    for buf := 1 to position^.nbuf do begin
      if (position^.buftype[buf] = 2) then begin
        EMBFreeMem (position^.xms_image[buf]);
        if (XMSError <> 0) then begin
          restorecrtmode;
          writeln ('XMS Error releasing handle: ', XMSErrorString (XMSError));
        end;
      end;
    end;
    position := position^.next;
  end;
end; { xms_shutdown }


begin { main }
  if paramcount <> 1 then begin {usage}
    writeln ('Program PLAYBACK, Version',VERSNUM,', ',VERSDATE);
    writeln ('Written by Kevin Lowey ([e-mail])');
    writeln ('Version 2.0 by Ken Van Camp');
    writeln ('USAGE: PLAYBACK playfile');
    writeln;
    writeln ('Description:');
    writeln ('This program replays files saved by SURFMODL using the');
    writeln ('"F" option while the picture is being displayed.');
    writeln ('Files created on one graphics device CANNOT be played back');
    writeln ('on another, for example files in the AT&T hires mode cannot');
    writeln ('be played back on a hercules system.');
    writeln;
    writeln ('Press a key to continue');
    repeat until keypressed;
    while keypressed do
      ch := readkey;
    writeln;
    writeln ('The data file parameter contains a file consisting of lines');
    writeln ('of the following format:');
    writeln;
    writeln ('  DELAY  DISPLAYMODE  FILENAME');
    writeln;
    writeln ('DELAY is the number of milliseconds (1/1000 sec) to');
    writeln ('show the file.  Special values are:');
    writeln ('  0 : No delay');
    writeln (' -1 : Wait until a key is pressed');
    writeln (' -2 : Rewind to first image and start again');
    writeln (' -3 : Start playing backwards, until first image is reached.');
    writeln ('(Both modes -2 and -3 will start an infinite loop, which is');
    writeln ('terminated when the first key is pressed.');
    writeln;
    writeln ('DISPLAYMODE is the mode the image should be displayed in.');
    writeln ('  0 : Normal mode, image replaces image on screen.');
    writeln ('  1 : XOR mode, Shows image EXCEPT where it matches screen.');
    writeln ('  2 : OR mode,  Shows both image and screen.');
    writeln ('  3 : AND mode, Shows only where image and screen intersect.');
    writeln ('  4 : NOT mode, Shows the inverse of the image.');
    writeln;
    writeln ('The filename is the file containing the image to display.');
  end
  else begin
    {$I-}
    assign (infile,paramstr(1));
    {$I+}
    if ioresult <> 0 then begin
      writeln ('The file "',paramstr(1),'" does not exist.');
      halt(1);
    end;
    {$I-}
    reset (infile);
    {$I+}
    if ioresult <> 0 then begin
      writeln ('The file "',paramstr(1),'" does not exist.');
      halt(1);
    end;

    writeln ('Reading data files . . .');

    { Check for XMS memory manager.  If installed, allocate one 64K
      buffer to use in case we need it.  Have to allocate it here,
      because if we wait till we need it then it's too late.
    }
    cnv_memused := 0;
    xms_memused := 0;
    xms_hdlused := 0;
    if (XMMPresent) then begin
      getmem (membuffer, MAXALLOC);
      if (membuffer = nil) then begin
        writeln ('Out of memory getting a buffer.');
        halt;
      end;
      cnv_memused := cnv_memused + MAXALLOC div 1024 + 1;
      buf_avail := TRUE;
    end else
      buf_avail := FALSE;

    header := nil;
    lastpos := nil;

    done := false;
    oldgrsys := -1;
    oldgrmode := -1;

    while ((not eof(infile)) and (not done)) do begin
      new (position);
      if (position = nil) then
        done := true
      else begin
        position^.next := nil;
        position^.prev := lastpos;
        position^.speed := 0;
        position^.grsys := 0;
        position^.grmode := 0;
        position^.dispmode := 0;
        position^.image[1] := nil;
        position^.xms_image[1] := 0;
        position^.nlines_buf[1] := 0;
        position^.buftype[1] := 0;
        position^.nbuf := 0;
        if (lastpos <> nil) then
          lastpos^.next := position;
        if (header = nil) then
          { head of list }
          header := position;
        lastpos := position;

        read (infile,position^.speed);
        read (infile, position^.dispmode);
        readln (infile, filename);

        { Remove leading blanks and tabs from file name }
        while filename[1] in [' ',^I] do
          delete(filename,1,1);

        if readscrn(filename,position^.grsys, position^.grmode,
            position^.image, position^.xms_image, position^.buftype,
            position^.xms_bufsize, position^.nbuf, position^.nlines_buf,
            position^.vgapalette, oldgrsys, oldgrmode) then begin

          oldgrsys := position^.grsys;
          oldgrmode := position^.grmode;
        end else
          done := true;
      end; { if position = nil }
    end; {while}

    close (infile);

    if ((oldgrsys <> header^.grsys) or (oldgrmode <> header^.grmode))
        and (not done) then begin
      { readscrn left us in graphics mode, but not the right one }
      oldgrsys := header^.grsys;
      oldgrmode := header^.grmode;

      closegraph;
      initgraph (header^.grsys,header^.grmode,BGIDIR);
      if (grsys = VGA256) then
        { Set the palette }
        VGASetAllPalette (header^.vgapalette);
    end;

    position := header;
    goforward := true;

    while (not done) and (position <> nil) do begin
      if oldgrsys <> position^.grsys then begin
        closegraph;
        oldgrsys := position^.grsys;
        oldgrmode := position^.grmode;
        initgraph (position^.grsys,position^.grmode,BGIDIR);;
        if (grsys = VGA256) then
          { Set the palette }
          VGASetAllPalette (position^.vgapalette);
      end
      else if position^.grmode <> oldgrmode then begin
        setgraphmode(position^.grmode);
        oldgrmode := position^.grmode;
      end;

      { graph.putimage (0,0,position^.image^,position^.dispmode); }
      y1 := 0;
      for buf := 1 to position^.nbuf do begin
        { Read from XMS memory, if it's there }
        if (position^.buftype[buf] = 2) then begin
          pbuf := membuffer;
          MoveFromEMB (position^.xms_image[buf], pbuf^,
              position^.xms_bufsize[buf]);
          if (XMSError <> 0) then begin
            restorecrtmode;
            writeln ('XMS Error moving from EMB: ', XMSErrorString (XMSError));
            xms_shutdown;
            halt;
          end;
        end else
          pbuf := position^.image[buf];

        graph.putimage (0,y1,pbuf^,position^.dispmode);
        y1 := y1 + position^.nlines_buf[buf];
      end;

      advance_pos := true;
      if position^.speed = -1 then
        waitforkey
      else if position^.speed = -2 then begin
        { rewind to first picture }
        position := header;
        advance_pos := false;
        { first keypress aborts }
        if keypressed then
          goto ABORTGRPH;
      end else if position^.speed = -3 then begin
        { start playing in reverse }
        goforward := false;
        { first keypress aborts }
        if keypressed then
          goto ABORTGRPH;
      end else
        delay (position^.speed);

      if advance_pos then begin
        if goforward then
          position := position^.next
        else begin
          position := position^.prev;
          if position = nil then begin
            position := header;
            goforward := true;
          end;
        end;
      end; { if advance_pos }
    end; { while position }

ABORTGRPH:
    if (not done) then
      exgraphic;
    { Empty the keyboard buffer }
    while keypressed do
      ch := readkey;
    xms_shutdown;
    writeln ('Playback complete: ', MemAvail div 1024,
        ' KBytes of conventional memory still available.');
    writeln ('  ', cnv_memused,
        ' KBytes of dynamically-allocated conventional memory were used.');
    if (xms_memused > 0) or (xms_hdlused > 0) then begin
      writeln ('  XMS Memory Manager v.', GetXMSVersion, ' was used.');
      writeln ('  ', xms_memused,
          ' KBytes of dynamically-allocated XMS memory were used out of');
      writeln ('      ', XMSMemAvail, ' KBytes available and ', XMSMaxAvail,
          ' KBytes max available.');
      writeln ('  ', xms_hdlused, ' XMS handles used out of ',
          GetAvailEMBHandles, ' available.');
    end else
      writeln ('NO XMS memory was used.');
  end; {not usage}
end.