(****************************************************************************)
(*                                 PRODISK                                  *)
(*--------------------------------------------------------------------------*)
(* Author :  Enrico Croce                                                   *)
(*                                                                          *)
(* Program: ProDisk - C.L.I., shows Prodos HD, does file(s) import/exeport  *)
(* Version:  1.0                                                            *)
(* Creation Date: 00/00/0000    Last Modify Date: 01/09/96                  *)
(*                                                                          *)
(****************************************************************************)
(* NOTE:                                                                    *)
(* This program source code is copyrighted in the sense that it may be used *)
(* for free purposes (public domain, freeware, ...) until its original      *)
(* copyrights are preserved. The package as a whole, or parts thereof,      *)
(* cannot be included or used in any commercial application without written *)
(* permission granted by the author. See LICENSE.TXT for a complete license *)
(* agreement. All comments concerning the program may be sent to the author *)
(****************************************************************************)
program ProDisk;

uses Crt, Dos, Prodos;

var
  ExitFlag: boolean;
  Disk: TProDosDisk;
  DiskOpen: boolean;

type
  TCmd = record
    Tokn: integer;
    Name: string[10];
    Parm: string[20];
  end;

const
  NumCmds = 18;

const

  DoNothing = 0;
  DoUpCase  = 1;
  DoLoCase  = 2;

  cmNone =  0;
  cmExit =  1;
  cmHelp =  2;
  cmOpen =  3;
  cmClos =  4;
  cmDire =  5;
  cmPref =  6;
  cmStat =  7;
  cmClea =  8;
  cmExpF =  9;
  cmExpD = 10;
  cmImpo = 11;

  Cmds : array[1..NumCmds] of TCmd = (
    (Tokn: cmExit; Name: 'exit';    Parm: ''),
    (Tokn: cmExit; Name: 'quit';    Parm: ''),
    (Tokn: cmHelp; Name: 'help';    Parm: ''),
    (Tokn: cmOpen; Name: 'open';    Parm: '$m'),
    (Tokn: cmClos; Name: 'close';   Parm: ''),
    (Tokn: cmDire; Name: 'dir';     Parm: '-l'),
    (Tokn: cmDire; Name: 'cat';     Parm: '-l'),
    (Tokn: cmDire; Name: 'ls';      Parm: '-l'),
    (Tokn: cmDire; Name: 'catalog'; Parm: '-l'),
    (Tokn: cmPref; Name: 'cd';      Parm: '[$p|..|/]'),
    (Tokn: cmPref; Name: 'prefix';  Parm: '$p'),
    (Tokn: cmStat; Name: 'stat';    Parm: ''),
    (Tokn: cmClea; Name: 'clrscr';  Parm: ''),
    (Tokn: cmClea; Name: 'cls';     Parm: ''),
    (Tokn: cmClea; Name: 'home';    Parm: ''),
    (Tokn: cmExpF; Name: 'export';  Parm: '$p $m'),
    (Tokn: cmExpD; Name: 'exportdir'; Parm: '$m'),
    (Tokn: cmImpo; Name: 'import';  Parm: '$m*.*')
  );

function ForceExt(tmp: PathStr; Exte: ExtStr): PathStr;
var
  Dir: DirStr;
  Nam: NameStr;
  Ext: ExtStr;
begin
  FSplit(tmp, Dir, Nam, Ext);
  if Ext='' then Ext:=Exte;
  ForceExt:= Dir+Nam+Ext;
end;


procedure LoCase(var ch: char);
begin
  if ch in ['A'..'Z'] then ch:= chr(ord(ch)+32);
end;

function GetToken(var cmdstr: string): integer;
var
  tkn, i, len: integer;
begin
  for i:= 1 to length(cmdstr) do LoCase(cmdstr[i]);
  tkn:= cmNone;
  if cmdstr = '' then exit;
  for i:= 1 to NumCmds do begin
    if cmdstr = Cmds[i].Name then begin
      tkn:= Cmds[i].Tokn;
      break;
    end;
  end;
  if tkn = cmNone then begin
    len:= length(cmdstr);
    for i:= 1 to NumCmds do begin
      if cmdstr = copy(Cmds[i].Name,1,len) then begin
        tkn:= Cmds[i].Tokn;
        break;
      end;
    end;
  end;
  GetToken:= tkn;
end;

procedure Trim(var str: string);
begin
  while str[length(str)]=' ' do dec(str[0]);
  while (length(str)>0) and (str[1]=' ') do delete(str,1,1);
end;

procedure SplitStr(var raw, cmd, prm: string);
var i: integer;
begin
  trim(raw);
  i:= pos(' ', raw);
  if i = 0 then begin
    cmd:= raw; prm:= '';
  end
  else begin
    cmd:= copy(raw, 1, i-1);
    prm:= copy(raw, i+1,255);
    trim(prm);
  end;
end;

function GetParm(var prm: string; opr: integer): string;
var
  tmp, new: string;
  i: integer;
begin
  SplitStr(prm, tmp, new);
  prm:= new;
  if tmp <> '' then begin
    case opr of
      DoUpCase: for i:= 1 to length(tmp) do tmp[i]:= UpCase(tmp[i]);
      DoLoCase: for i:= 1 to length(tmp) do LoCase(tmp[i]);
    end;
  end;
  GetParm:= tmp;
end;

procedure Error(msg: string);
begin
  writeln('Error: ', msg);
  writeln;
end;

procedure Execute(tokn: integer; var cmd, prm: string);
  procedure DoHelp;
  var i, j: integer;
  begin
    for i:= 1 to NumCmds div 4 do begin
      for j:= 1 to 4 do begin
        GotoXY((j-1)*20+1, WhereY);
        with Cmds[4*(i-1)+j] do write(Name,' ',Parm);
      end;
      writeln;
    end;
    i:= (NumCmds mod 4);
    if i > 0 then begin
      for j:= 1 to i do begin
        GotoXY((j-1)*20+1, WhereY);
        with Cmds[(NumCmds div 4)*4+j] do write(Name,' ',Parm);
      end;
      writeln;
    end;
    writeln('$p = Prodos filename, $m = MsDos filename');
    writeln;
  end;
  procedure DoOpen;
  var
    FN: PathStr;
  begin
    FN:= ForceExt(GetParm(prm, DoNothing),'.hdv');
    if FN = '' then begin
      write('Prodos Disk file = '); readln(FN);
    end;
    if not FileExist(FN) then begin
      Error('file do not exit.');
      exit;
    end;
    OpenDisk(Disk, FN);
    OpenDir(Disk, Disk.VolBlk);
    writeln;
    PrintVolItem(@Disk.Vol, false);
    writeln;
    DiskOpen:= true;
  end;
  procedure DoClose;
  begin
    CloseDisk(Disk);
    writeln(Disk.FilNam,' closed.');
    writeln;
    DiskOpen:= false;
  end;
  procedure DoDir;
  begin
    writeln;
    if prm <> '' then PrintDir(Disk, true) else PrintDir(Disk, false);
    writeln;
  end;
  procedure DoPrefix;
  var
    Name: TNameStr;
    Item: TFileItem;
  begin
    Name:= GetParm(prm, DoUpcase);
    with Disk do begin
      if Name = '' then begin
        PrintSubItem(@Dir, false);
      end
      else if Name ='/' then begin
        while (Disk.Dir.KndLen and $F0) <> $F0 do CloseDir(Disk);
        exit;
      end
      else if Name = '..' then begin
        if (DirBlk = VolBlk) then begin
          Error('Root level!');
          exit;
        end
        else begin
          CloseDir(Disk);
        end;
      end
      else if GetFileName(Disk, Name, Item) then begin
        if (Item.KndLen and $F0) = $D0 then begin
          OpenDir(Disk, Item.PosBlk);
        end
        else Error('Not a directory!')
      end
      else Error('Directory not found');
    end;
  end;
  procedure DoStat;
  begin
    with Disk,VBM^ do begin
      writeln;
      writeln('VBM Pos. : ', Strt);
      writeln('VBM Size : ', Size);
      writeln('Num Block: ', NumBlk);
      writeln('FreeBlock: ', BlkFree);
      writeln('UsedBlock: ', Numblk-BlkFree);
      writeln('Changed  : ', Changed);
      writeln;
    end;
  end;
  procedure DoClear;
  begin
    ClrScr;
  end;
  procedure DoExportFile;
  var
    Name: TNameStr;
    tmp: PathStr;
    Item: TFileItem;
  begin
    Name:= GetParm(prm, DoUpCase);
    if GetFileName(Disk, Name, Item) then begin
      tmp := GetParm(prm, DoNothing);
      if tmp = '' then tmp:= MsDosName(Name, Item.Kind);
      ExportFile(Disk, Item, tmp);
    end
    else Error('File not found');
  end;
  procedure DoExportDir;
  begin
    ExportDir(Disk);
  end;
  procedure DoImportFiles;
  begin
    ImportFiles(Disk);
  end;
var
  Name: TNameStr;
  Item: TFileItem;
begin
  case tokn of
    cmExit: begin
      if DiskOpen then DoClose;
      ExitFlag:= true;
    end;
    cmHelp: DoHelp;
    cmOpen: if DiskOpen then Error('disk open. Close it!') else DoOpen;
    cmClos: if not DiskOpen then Error('disk not open!') else DoClose;
    cmDire: if not DiskOpen then Error('disk not open!') else DoDir;
    cmPref: if not DiskOpen then Error('disk not open!') else DoPrefix;
    cmStat: if not DiskOpen then Error('disk not open!') else DoStat;
    cmExpF: if not DiskOpen then Error('disk not open!') else DoExportFile;
    cmExpD: if not DiskOpen then Error('disk not open!') else DoExportDir;
    cmImpo: if not DiskOpen then Error('disk not open!') else DoImportFiles;
    cmClea: DoClear;
    else begin
      if DiskOpen then begin
        prm:= cmd+prm;
        Name:= GetParm(prm, DoUpCase);
        if GetFileName(Disk, Name, Item) then begin
          if (Item.KndLen and $F0) = $D0 then begin
            prm:= Name+' '+prm;
            DoPrefix;
          end
          else if (Item.KndLen and $30) <> 0 then begin
            prm:= Name+ ' '+prm;
            DoExportFile;
          end;
        end
        else Error('Unknown command.');
      end
      else Error('Unknown command.');
    end;
  end;
end;

var
  raw, cmd, prm: string;
  tokn: integer;
begin
  ClrScr;
  writeln('Prodos disk mini command line interpeter v1.0. Type help for help.');
  writeln;
  ExitFlag:= false;
  DiskOpen:= false;
  if ParamCount >= 1 then begin
    cmd:= 'open';
    prm:= ParamStr(1);
    Execute(cmOpen, cmd, prm);
  end;
  repeat
    write('Command: '); readln(raw);
    SplitStr(raw, cmd, prm);
    tokn:= GetToken(cmd);
    Execute(tokn, cmd, prm);
  until ExitFlag;
end.