{************************************************}
{                                                }
{   Turbo Vision File Manager Demo               }
{   Copyright (c) 1992 by Borland International  }
{                                                }
{************************************************}

{ This file has been modified by Matthias Koeppe for Graphics Vision.
  The original file is \BP\EXAMPLES\DOS\TVFM\TVFM.PAS.

  All changes have been commented. Note: The real function of this
  program is located in the TVFM units, WHICH HAVE NOT BEEN MODIFIED,
  though they extensively access Turbo Vision functions.

  All Turbo Vision functionality needed is simulated and mirrored by GvTv,
  the Graphics Vision Turbo Vision emulator. This enables a step-by-step
  conversion of Turbo Vision applications into Graphics Vision applications.
  The next step for this app might be graphical dialogs, or a graphical
  trash, or yet more sensible things.

  Note: Some features of this app don't work.
  * The drag'n'drop facility doesn't work properly here, since
    there appear some problems with global coordinates.
  * 'Run Dos Command' and 'View Custom' don't work, since
    they perform Turbo-Vision shut-down/start-up code, which need
    to be replaced by their Graphics Vision equivalents.
    (Unit Tools needs to be changed.)
}

{$M 16384,8192,655360}
{$X+,V-}

program TVFM;

uses
  { Standard units }
  Dos, Objects, Strings,
  { Turbo Vision units }
  Drivers, Views, HistList, Memory, Menus, Dialogs, App, StdDlg,
  { Graphics and support units }
  Misc, Vesa, Gr, WinRes, MetaGr, VgaMem, Bitmap, ExtGraph, MyMouse, MyFonts,
  { Graphics Vision standard units }
  GvDriver, GvViews, GvDialog, GvMenus, GvStdDlg, GvApp, GvMsgBox,
  GVTexts, GvEdit, GvBitmap, GvWinDlg, GvGadget, GvClock, GvEyes,
  GvFonts, GvFiler, GvTable, GvWList, GvWinNum, KeyNames, GvBWCC,
  GvValid, GvTerm, GvVirt, GvHint, GvColor, GvTv,
  { original TVFM units }
  Globals, Equ, Tools, TreeWin, Colors, Assoc, Trash, FileFind;

{ If you get a FILE NOT FOUND error when compiling this program
  from a DOS IDE, change to the \BP\EXAMPLES\DOS\TVFM directory
  (use File|Change dir).

  This will enable the compiler to find all of the units used by
  this program.

  You will also need to create the TVFM.TVR resource for this
  program by compiling and running MAKERES.PAS.
}

const
  { We supply the resource name explicitly here.
  }
  RezName = '\BP\EXAMPLES\DOS\TVFM\TVFM.TVR';

{ The graphical version of THCStatusLine. We can't easily use a
  text-mode statusline, so we take this one to perform the required
  function.
}
type
  PGHCStatusLine = ^TGHCStatusLine;
  TGHCStatusLine = object(TStatusLine)
    function Hint(AHelpCtx: Word): String; virtual;
  end;

function TGHCStatusLine.Hint(AHelpCtx: Word): string;
begin
  Hint := RezStrings^.Get(AHelpCtx);
end;

type
  TMyApp = object(TApplication)
    TrashCan: PTrashCan;
    ExitDir: String;
    constructor Init;
    destructor Done; virtual;
    procedure Idle; virtual;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure OutOfMemory; virtual;
    procedure ToggleVideoMode;
  end;

constructor TMyApp.Init;
var
  R: TRect;
  H: Word;
  CurDir: PathStr;
begin
  RezStream := New(PProtectedStream, Init(RezName, stOpenRead, 4096));
  if RezStream^.Status <> stOK then
  begin
    PrintStr('Unable to open resource file.');
    Halt(1);
  end;
  RezFile.Init(RezStream);

  RegisterObjects;
  RegisterViews;
  RegisterMenus;
  RegisterDialogs;
  RegisterApp;
  RegisterStdDlg;
  RegisterGlobals;
  RegisterType(RStringList);
  RegisterAssociations;

  RezStrings := PStringList(RezFile.Get('Strings'));

  if RezStrings = nil then
  begin
    PrintStr('Unable to read resources from resource file.');
    Halt(1);
  end;

  inherited Init;
  InitAssociations;

  { These commands aren't enabled by default in Graphics Vision.
    So we need to enable them explicitly.
  }
  EnableCommands([cmTile, cmCascade]);

  { Since we access the text-mode desktop's size, we need to
    adapt its size from the real Graphics Vision desktop.
    This is done by GvTv.UpdateSizes.
  }
  UpdateSizes;

  { Here we need to refer explicitly to App.Desktop, since
    a TrashCan is a Turbo Vision object, which can't be directly
    inserted into the Graphics Vision desktop. We could have
    wrapped it into a graphic shell manually by GvTv.NewGGate,
    but this approach does it automatically.
  }
  App.Desktop^.GetExtent(R);
  Dec(R.B.Y); Inc(R.A.X);
  R.A.Y := R.B.Y - 3;
  R.B.X := R.A.X + 5;
  TrashCan := New(PTrashCan, Init(R));
  App.Desktop^.Insert(TrashCan);

  ConfigRec.Video := ScreenMode and smFont8x8;
  ReadConfig;
  if ConfigRec.Video <> (ScreenMode and smFont8x8) then
    ToggleVideoMode;

  GetDir(0, CurDir);
  InsertTreeWindow(CurDir[1]);
end;

destructor TMyApp.Done;
begin
  DoneAssociations;
  Dispose(TrashCan, Done);
{$I-}
  if ExitDir <> '' then
  begin
    if ExitDir[Length(ExitDir)] = ':' then ExitDir := ExitDir + '\';
    ChDir(ExitDir);
  end;
{$I+}
  inherited Done;
  DoneMemory;
end;

procedure TMyApp.Idle;
const
  FileListCmds : TCommandSet =
    [cmExecute, cmViewAsHex, cmViewAsText, cmViewCustom, cmCopy, cmDelete,
     cmRename, cmChangeAttr, cmReverseTags, cmClearTags, cmTagPerCard,
     cmAssociate];
var
  TopWindow: PWindow;
begin
  inherited Idle;

  TopWindow := Message(Desktop, evBroadcast, cmTopWindow, nil);
  if TopWindow = nil then
  begin
    DisableCommands(FileListCmds);
    DisableCommands([cmExitHere]);
  end
  else
  begin
    EnableCommands([cmExitHere]);
    if Message(TopWindow, evBroadcast, cmFileListFocused, nil) <> nil then
      EnableCommands(FileListCmds)
    else
      DisableCommands(FileListCmds);
  end;
  Message(Desktop, evIdle, 0, nil);
end;

procedure TMyApp.InitMenuBar;
{ We can't easily use a text-mode menubar. Instead, we install a
  Graphics Vision menubar. Since the menus are binary-compatible,
  we capture them from the TV menubar loaded from the resource.
}
var
  R: TRect;
  TVMenuBar: menus.PMenuBar;
begin
  TVMenuBar := menus.PMenuBar(RezFile.Get('MainMenu'));
  GetExtent(R);
  R.B.Y := 21;
  MenuBar := New(PMenuBar, Init(R, PMenu(TVMenuBar^.Menu)));
  TVMenuBar^.Menu := nil;
  Dispose(TVMenuBar, Done);
end;

procedure TMyApp.InitStatusLine;
{ We can't easily use a text-mode statusline. Instead, we install a
  Graphics Vision statusline. Since the statusdefs are binary-compatible,
  we capture them from the TV statusline loaded from the resource.
}
var
  R: TRect;
  TVStatusLine: menus.PStatusLine;
begin
  TVStatusLine := PHCStatusLine(RezFile.Get('StatusLine'));
  GetExtent(R);
  R.A.Y := R.B.Y - 21;
  StatusLine := New(PGHCStatusLine, Init(R, PStatusDef(TVStatusLine^.Defs)));
  TVStatusLine^.Defs := nil;
  Dispose(TVStatusLine, Done);
end;

procedure TMyApp.ToggleVideoMode;
var
  NewMode: Word;
  R: TRect;
begin
  { ToggleVideoMode is unfunctional in Graphics Vision.

  NewMode := ScreenMode xor smFont8x8;
  if NewMode and smFont8x8 <> 0 then ShadowSize.X := 1
  else ShadowSize.X := 2;
  SetScreenMode(NewMode);
  Desktop^.GetExtent(R);
  TrashCan^.Reposition(R);
  ConfigRec.Video := ScreenMode and smFont8x8;}
end;

procedure TMyApp.HandleEvent(var Event: TEvent);
var
  NewDrive: Char;
begin
  inherited HandleEvent(Event);
  if Event.What = evCommand then
  begin
    case Event.Command of
      cmNewWindow:
	begin
	  NewDrive := SelectDrive;
	  if NewDrive <> ' ' then InsertTreeWindow(NewDrive);
	  ClearEvent(Event);
	end;
      cmBeginSearch: BeginSearch;
      cmInstallViewer : InstallViewer;
      cmDisplayOptions : SetDisplayPrefs;
      cmSaveConfig : SaveConfig;
      cmTile : Tile;
      cmCascade : Cascade;
      cmCloseAll: Message(Desktop, evBroadcast, cmCloseAll, nil);
      cmDosShell : DosShell;
      cmRun : RunDosCommand('');
      cmVideoMode: ToggleVideoMode;
      cmExitHere:
	begin
	  Message(Desktop, evBroadcast, cmGetCurrentDir, @ExitDir);
	  EndModal(cmQuit);
	  ClearEvent(Event);
	end;
      cmColorChange: SelectNewColors;
    end;
  end;
end;

procedure TMyApp.OutOfMemory;
begin
  MessageBox('There is not enough memory to complete this operation.',
    nil, mfError+mfOKButton);
end;

var
  MyApp : TMyApp;

begin
  MyApp.Init;
  MyApp.Run;
  MyApp.Done;
end.
