[Back to SCREEN SWAG index]  [Back to Main SWAG index]  [Original]

program screen { save screen in file / restore screen from file };
               { only text mode screens }

 { no error checking! the video mode and
   (if restoring the screen from a file)
   the content of the file are not checked.

   it only moves the video memory to a file
   or from a file to the video memory }

 { if the file does not exist: the screen is saved in a new file
     with the given name;
   if the file does exist: the screen is restored from that file
     the file is not deleted. }

uses dos;
Const
  NoFAttr : word = $1C; { dir-, volume-, system attributen }
  FAttr   : word = $23; { readonly-, hidden-, archive attributen }
Var
  { bios area }
  mode      : byte absolute $40:$49;  { current video mode }
  columns   : byte absolute $40:$4A;  { number of columns  }
  dispOfs   : word absolute $40:$4E;  { current video page offset }
  CrtPort   : word absolute $40:$63;  { CRT port address }
  lastRow   : byte absolute $40:$84;  { newer bios only: rows on screen-1 }

  VidSeg    : word;
  dispSize  : word;
  ScreenF   : file;
  Fname     : string[128];
  Attr      : word;
  Exists    : boolean;
  tel       : word;

function GetVidSeg : word;
begin
 if CrtPort = $3D4 then
   GetVidSeg := $B800        { color }
 else
   GetVidSeg := $B000;       { mono  }
end;                         

Procedure SaveScreen;
begin
  BlockWrite( ScreenF, mem[ vidseg : dispOfs ], dispSize, tel );
end;

Procedure RestoreScreen;
begin
  BlockRead( ScreenF, mem[ vidseg : dispOfs ], dispSize, tel );
end;

begin
  VidSeg := GetVidSeg;
  dispSize := columns * (lastRow+1);

  if ParamCount > 0 then
  begin
    Fname := FExpand( ParamStr( 1 ) );
    Assign ( ScreenF, Fname );

    { ---------------------------------------------------------------------- }
    { does file exist? }
    GetFAttr( ScreenF, Attr );
    if DosError = 0 then
      Exists := ((Attr and NoFAttr) = 0)  { not dir-, volume- or system bit? }
    else
      Exists := False;                    { DosError }
    { ---------------------------------------------------------------------- }

    if Exists then
      Reset( ScreenF, 2 )         { open file }
    else
      Rewrite( ScreenF, 2 );      { create new file }
    {}

    if IOResult = 0 then       { no error reading or creating file }
    begin
      if Exists then
        RestoreScreen
      else
        SaveScreen;
      Close( ScreenF );
    end   { if IOResult = 0 }
    else  { IOResult <> 0 ! }
      Writeln( 'Error reading or creating file ', Fname );
    { endif IO error Fname }
  end;  { if ParamCount > 0 }
end.

[Back to SCREEN SWAG index]  [Back to Main SWAG index]  [Original]