Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/EXBINE.ZIP/DEMO0A.PAS

Pascal/Delphi Source File | 1993-01-04 | 8.7 KB | 283 lines

{ DEMO0.PAS Binary Editor 2.00A }
{Copyright 1986,87 (c) Borland International }
{Modified by Jeff Duntemann for Turbo Technix 8/31/87 }

program BinaryEditorDemo0;

uses
  bined,
  crt,
  dos;        {JD}

  {***************************************************************}
  {****************** demonstration follows **********************}
  {***************************************************************}
  {* This demonstration shows the use of one editor window which *}
  {********* works just like a standalone Turbo editor. **********}
  {***************************************************************}

const
  {Coordinates of the editor window}
  Windx1 = 1;
  Windy1 = 1;
  Windx2 = 80;
  Windy2 = 25;                {Change to 43 for EGA 43-line operation}
  MakeBackup = True;          {True to create .BAK files}

var
  EdData : EdCB;              {Editor control block}
  ExitCode : Word;            {Status code set by bin. ed. functions}
  ExitCommand : Integer;      {Code for command used to leave editor}
  Fname : string;             {Input name of file being edited}
  Junk : Boolean;
  XSave,YSave : Integer;      {JD}
  VidSegment : Word;          {JD}
  VideoBufferSize : Word;     {JD}
  SavePtr  : ^Word;           {JD}
  VideoPtr : ^Word;           {JD}
  VideoSeg : Word;            {JD}
  Now      : DateTime;        {JD}

const
  {Commands other than ^K^D to exit editor}
  ExitCommands : array[0..3] of Char =
  (#2, ^K, ^Q, #0);

  {Procedures and functions used as part of the demo}

  procedure WriteStatus(msg : string);
    {-Write a status message}

  begin                       {WriteStatus}
    GoToXY(1, Windy2);
    TextColor(White);
    Write(msg);
  end;                        {WriteStatus}

  procedure CheckInitBinary(ExitCode : Word);
    {-Check the results of the editor load operation}

  begin                       {CheckInitBinary}
    if ExitCode <> 0 then begin
      {Couldn't load editor}
      case ExitCode of
        1 : WriteStatus('Insufficient heap space for text buffer');
      else
        WriteStatus('Unknown load error');
      end;
      GoToXY(1, Windy2);
      Halt(1);
    end;
  end;                        {CheckInitBinary}

  procedure CheckReadFile(ExitCode : Word; Fname : string);
    {-Check the results of the file read}
  var
    f : file;

  begin                       {CheckReadFile}
    if ExitCode <> 0 then begin
      {Couldn't read file}
      case ExitCode of
        1 : begin
              {New file, assure valid file name}
              {$I-}
              Assign(f, Fname);
              Rewrite(f);
              if IOResult <> 0 then begin
                Close(f);
                WriteStatus('Illegal file name '+Fname);
              end else begin
                Close(f);
                Erase(f);
                Write('New File');
                Delay(2000);
                Write(^M);
                ClrEol;
                GoToXY(1, 1);
                ClrEol;
                Exit;
              end;
              {$I+}
            end;
        2 : WriteStatus('Insufficient text buffer size');
      else
        WriteStatus('Unknown read error');
      end;
      GoToXY(1, Windy2);
      Halt(1);
    end;
    GoToXY(1, 1);
    ClrEol;
  end;                        {CheckReadFile}

  procedure CheckSaveFile(ExitCode : Word; Fname : string);
    {-Check the results of a file save}

  begin                       {CheckSaveFile}
    if ExitCode <> 0 then begin
      {Couldn't save file}
      case ExitCode of
        1 : WriteStatus('Unable to create output file '+Fname);
        2 : WriteStatus('Error while writing output to '+Fname);
        3 : WriteStatus('Unable to close output file '+Fname);
      else
        WriteStatus('Unknown write error');
      end;
      GoToXY(1, Windy2);
      Halt(1);
    end;
  end;                        {CheckSaveFile}

  function GetFileName : string;
    {-Return a file name either from the command line or a prompt}
  var
    Fname : string;

  begin                       {GetFileName}
    if ParamCount > 0 then
      Fname := ParamStr(1)
    else begin
      Write('Enter file name to edit: ');
      ReadLn(Fname);
    end;
    if Fname = '' then
      Halt;
    GetFileName := Fname;
  end;                        {GetFileName}

  function ExitBinaryEditor(var EdData      : EdCB;
                                ExitCommand : Integer) : Boolean;
    {-Handle an editor exit - save or abandon file}
  var
    ExitCode : Word;

    function YesAnswer(prompt : string) : Boolean;
      {-Return true for a yes answer to the prompt}
    var
      ch : Char;

    begin                     {YesAnswer}
      WriteStatus(prompt);
      repeat
        ch := UpCase(readkey);
      until ch in ['Y', 'N'];
      Write(ch);
      YesAnswer := (ch = 'Y');
    end;                      {YesAnswer}

  begin                       {ExitBinaryEditor}
    case ExitCommand of
      -1 :                    {^K^D}
        begin
          ExitCode := SaveFileBinaryEditor(EdData, MakeBackup);
          CheckSaveFile(ExitCode, FileNameBinaryEditor(EdData));
          ExitBinaryEditor := True;
          GoToXY(1, Windy2);
        end;

      0 :                     {^K^Q}
        begin
          if ModifiedFileBinaryEditor(EdData) then
            if YesAnswer('File modified. Save it? (Y/N) ') then begin
              ExitCode := SaveFileBinaryEditor(EdData, MakeBackup);
              CheckSaveFile(ExitCode, FileNameBinaryEditor(EdData));
            end;
          ExitBinaryEditor := True;
          GoToXY(1, Windy2);
        end;

    end;
  end;                        {ExitBinaryEditor}

{$F+} { All User-Event procesudures must be FAR calls!}
PROCEDURE Clocker(EventNo,Info : Integer);

VAR
  Hours,Minutes,Seconds,Hundredths : Integer;
  TimeBuf,TimeTemp : String;

BEGIN
  GetTime(Hours,Minutes,Seconds,Hundredths);
  Str(Hours:2,TimeBuf);
  Str(Minutes:2,TimeTemp);
  IF TimeTemp[1] = ' ' THEN TimeTemp[1] := '0';
  TimeBuf := TimeBuf+':'+TimeTemp;
  Str(Seconds:2,TimeTemp);
  IF TimeTemp[1] = ' ' THEN TimeTemp[1] := '0';
  TimeBuf := TimeBuf+':'+TimeTemp;
  CRTPutFast(65,1,TimeBuf)
END;
{$F-}

{<<<< Monochrome >>>>}
{ From: COMPLETE TURBO PASCAL by Jeff Duntemann  }
{ Scott, Foresman & Co. 1986  ISBN 0-673-18600-8 }
{ Described in section 17.2 -- Last mod 2/1/86   }
{ HIGHLY specific to the IBM PC! }

FUNCTION Monochrome : Boolean;

VAR
  Regs : Registers;

BEGIN
  INTR(17,Regs);
  IF (Regs.AX AND $0030) = $30 THEN Monochrome := True
    ELSE Monochrome := False
END;


begin                         {Demo0}
  XSave := WhereX; YSave := WhereY;                {JD}
  VideoBufferSize := Windx2*Windy2*2;              {JD}
  GetMem(SavePtr,VideoBufferSize);                 {JD}
  IF Monochrome THEN VidSegment := $B000 ELSE      {JD}
    VidSegment := $B800;                           {JD}
  VideoPtr := Ptr(VidSegment,0);                   {JD}
  Move(VideoPtr^,SavePtr^,VideoBufferSize);        {JD}

  {Get a file name}
  Fname := GetFileName;

  {Initialize a window for the file}
  ExitCode :=
  InitBinaryEditor(
  EdData,                     {Editor control block }
  MaxFileSize,                {Size of data area to reserve for}
                              {binary editor text buffer, $FFE0 max}
  Windx1,                     {X of upper left corner; 1..80}
  Windy1,                     {Y of upper left corner}
  Windx2,                     {X of lower right corner}
  Windy2,                     {Y of lower right corner}
  True,                       {True = wait for retrace on CGA cards}
  EdOptInsert+EdOptIndent,    {Initial editor toggles}
  '.PAS',                     {Default extension for file names}
  ExitCommands,               {Commands which will exit the editor}
  Addr(Clocker));             {JD: Add a clock in the corner}
  CheckInitBinary(ExitCode);

  {Read the file}
  ExitCode := ReadFileBinaryEditor(EdData, Fname);
  CheckReadFile(ExitCode, FileNameBinaryEditor(EdData));

  {Reset the editor for the new file}
  ResetBinaryEditor(EdData);

  {Edit the file}
  ExitCommand :=
  UseBinaryEditor(
  EdData,                     {Editor control block for this window}
  '');                        {No startup commands passed to editor}

  {Handle the exit by saving the file or whatever}
  Junk := ExitBinaryEditor(EdData, ExitCommand);

  {Release heap space used by the editor data structure}
  ReleaseBinaryEditorHeap(EdData);

  Move(SavePtr^,VideoPtr^,VideoBufferSize);   {JD}
  FreeMem(SavePtr,VideoBufferSize);           {JD}
  GotoXY(XSave,YSave-1);                      {JD}
end.                          {Demo0}