unit filemgru;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls;

type
  TFileManageForm = class(TForm)
    OpenDialog1: TOpenDialog;
    sbFile: TStatusBar;
    pbFile: TProgressBar;
    btnImport: TBitBtn;
    lblAction: TLabel;
    btnClose: TBitBtn;
    btnStop: TBitBtn;
    btnExport: TBitBtn;
    btnHelp: TBitBtn;
    SaveDialog1: TSaveDialog;
    Bevel1: TBevel;
    procedure btnImportClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnHelpClick(Sender: TObject);
    procedure btnExportClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure btnStopMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    Stopped : Boolean;
    Counter,
    WordLen : Integer;
    function CheckProg(Value : Integer) : Boolean;
    procedure ImportWordFile(const fName : String);
    procedure ExportWordFile(const fName : String);
    procedure EnableDisable(Dis : Boolean);
  public
    { Public declarations }
    procedure SetWordLength(Value : Integer);
    procedure SetHint(Gen : Boolean; const S : String);
  end;

var
  FileManageForm: TFileManageForm;

implementation

uses ladSharU;

{$R *.DFM}

procedure TFileManageForm.FormCreate(Sender: TObject);
begin
  Stopped := False;
  Counter := 0;
  lblAction.Caption := '';
  OpenDialog1.InitialDir := ExtractFileDir(Application.ExeName);
  SaveDialog1.InitialDir := ExtractFileDir(Application.ExeName);
end;

procedure TFileManageForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose := btnClose.Enabled;
end;

procedure TFileManageForm.FormMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
// This enables flyover hints for disabled buttons
VAR P : TPoint;
begin
  P := Point(X,Y);
  IF PtInRect(btnExport.BoundsRect, P) THEN
    SetHint(False, btnExport.Hint)
  ELSE IF PtInRect(btnImport.BoundsRect, P) THEN
    SetHint(False, btnImport.Hint)
  ELSE IF PtInRect(btnStop.BoundsRect, P) THEN
    SetHint(False, btnStop.Hint)
  ELSE IF PtInRect(btnClose.BoundsRect, P) THEN
    SetHint(False, btnClose.Hint)
  ELSE SetHint(False, GenHint);
end;

procedure TFileManageForm.btnExportClick(Sender: TObject);
begin
  WITH SaveDialog1 DO
    begin
      Title := Format('Save %d-letter word file',
        [WordLen]);
      IF Execute THEN
        begin
          OpenDialog1.Filename := Filename;
          lblAction.Caption := Format('Exporting %d-letter word-list to %s',
            [WordLen, ExtractFileName(Filename)]);
          EnableDisable(True);
          ExportWordFile(Filename);
          IF Stopped THEN
            SetHint(True, 'Processing interrupted')
          ELSE
            SetHint(True, 'Processing completed');
          EnableDisable(False);
        end;
    end;
end;

procedure TFileManageForm.btnStopClick(Sender: TObject);
begin
  Stopped := True;
end;

procedure TFileManageForm.btnStopMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  WITH Sender AS TBitBtn DO
    SetHint(False, Hint);
end;

procedure TFileManageForm.btnImportClick(Sender: TObject);
begin
  WITH OpenDialog1 DO
    begin
      Title := Format('Open %d-letter word file', [WordLen]);
      IF Execute THEN
        begin
          lblAction.Caption := Format('Processing %s into %d-letter'+
            ' word-list', [ExtractFileName(Filename), WordLen]);
          EnableDisable(True);
          ImportWordFile(Filename);
          IF Stopped THEN
            SetHint(True, 'Processing interrupted')
          ELSE
            SetHint(True, 'Processing completed');
          EnableDisable(False);
        end;
    end;
end;

procedure TFileManageForm.btnHelpClick(Sender: TObject);
begin
  Application.HelpCommand(HELP_CONTEXT, 2);
end;

function TFileManageForm.CheckProg(Value : Integer) : Boolean;
begin
  Counter := Succ(Counter) MOD 64;
  IF Counter = 0 THEN
    begin
      IF Value >= 0 THEN pbFile.Position := Value;
      Application.ProcessMessages;
    end;
  Result := Stopped;
end;

procedure TFileManageForm.SetHint(Gen : Boolean; const S : String);
// Display a hint on status bar; if desired retain as "generic"
// hint that's used when not displaying flyover help
begin
  sbFile.Panels[1].Text := S;
  IF Gen THEN GenHint := S;
end;

procedure TFileManageForm.SetWordLength(Value : Integer);
begin
  WordLen := Value;
  Caption := Format('PC Ladder - %d-letter words', [WordLen]);
end;

procedure TFileManageForm.ExportWordFile(const fName : String);
VAR
  sl_temp : TStringList;
  N      : Integer;
begin
  sl_temp := TStringList.Create;
  try
    Screen.Cursor := crHourglass;
    sl_temp.LoadFromFile(Format(NameSpec, [WordLen]));
    pbFile.Max := sl_temp.Count-1;
    FOR N := 0 TO sl_temp.Count-1 DO
      begin
        IF CheckProg(N) THEN Exit;
        sl_temp[N] := Copy(sl_temp[N], 1, WordLen);
      end;
    sl_temp.Sort;
    IF CheckProg(-1) THEN Exit;
    sl_temp.SaveToFile(fName);
  finally
    Screen.Cursor := crDefault;
    sl_temp.Free;
  end;
end;

procedure TFileManageForm.ImportWordFile(const fName : String);
VAR
  G      : Integer;
  S            : String;
  FileOK       : Boolean;
  sl_in, sl_temp,
  sl_out, sl_bad : TStringList;

  function ValidateFile : Boolean;
  // Returns true unless stopped
  VAR N : Integer;
  begin
    Result := False;
    pbFile.Max := sl_in.Count-1;
    SetHint(True, 'Validating File');
    FileOK := True;
    // make sure file contains only words of the
    // specified length, all 'A'..'Z'
    FOR N := 0 TO sl_in.Count-1 DO
      begin
        IF CheckProg(N) THEN Exit;
        IF NOT GoodWord(sl_in[N], WordLen) THEN
          begin
            FileOK := False;
            Break;
          end;
      end;
    Result := True;
  end;

  // FIG3.DOC begin
  function BuildWordGroups : Boolean;
  VAR
    N, M, Posn : Integer;
    C1, C2     : Char;
  begin
    Result := False;      // Returns false if interrupted
    G      := 1;          // Start with group number 1
    pbFile.Position := 0; // Initialize progress bar
    SetHint(True, 'Building word-groups');
    sbFile.Panels[0].Text := Format('GRP# %d', [G]);
    WHILE sl_in.Count > 0 DO
      begin
        sl_temp.Clear;
        sl_temp.AddObject(sl_in[sl_in.Count-1], TWordObj.Create(G));
        sl_in.Delete(sl_in.Count-1);
        N := 0;
        WHILE N < sl_temp.Count DO
          begin // Note: sl_temp.count *increases* within this loop
            IF CheckProg(pbFile.Max - sl_in.Count + 1) THEN Exit;
            S := sl_temp[N];
            M := sl_in.Count-1;
            WHILE M >= 0 DO
              begin
                IF CheckProg(-1) THEN Exit;
                IF OneDifferent(S, sl_in[M], Posn, C1, C2) THEN
                  begin
                    sl_temp.AddObject(sl_in[M], TWordObj.Create(G));
                    sl_in.Delete(M);
                  end;
                Dec(M);
              end;
            Inc(N);
          end;
        IF sl_temp.Count >= WordLen THEN
          begin
            Inc(G);
            sbFile.Panels[0].Text := Format('GRP# %d', [G]);
            Application.ProcessMessages;
            sl_out.AddStrings(sl_temp);
          end
        ELSE sl_bad.AddStrings(sl_temp);
      end;
    Result := True;
  end;
  // FIG3.DOC end

  function BuildWordLinks : Boolean;
  VAR
    N, M, Posn, TheGrp : Integer;
    C1, C2 : Char;
  begin
    Result := False;
    pbFile.Max := sl_out.Count-1;
    SetHint(True, 'Building word-links');
    TheGrp := -1;
    FOR N := 0 TO sl_out.Count-1 DO
      WITH TWordObj(sl_out.Objects[N]) DO
        begin
          IF TheGrp <> Group THEN
            sbFile.Panels[0].Text := Format('TheGrp# %d', [Group]);
          TheGrp := Group;
          IF N MOD 64=0 THEN
            pbFile.Position := N;
          FOR M := N+1 TO sl_out.Count-1 DO
            begin
              IF TWordObj(sl_out.Objects[M]).Group <> TheGrp THEN Break;
              IF CheckProg(-1) THEN Exit;
              IF OneDifferent(sl_out[N], sl_out[M], Posn, C1, C2) THEN
                begin
                  TWordObj(sl_out.Objects[N]).AddLink(Posn, C1);
                  TWordObj(sl_out.Objects[M]).AddLink(Posn, C2);
                end;
            end;
        end;
    Result := True;
    G := TheGrp;
  end;

  procedure WriteItOut(sl_out : TStringList; sl_bad : TStrings);
  const plural : ARRAY[Boolean] OF String = ('', 's');
  VAR
    T : TextFile;
    N : Integer;
  begin
    sl_out.Sort;
    AssignFile(T, Format(NAMESPEC,[WordLen]));
    Rewrite(T);
    pbFile.Max := sl_out.Count-1+sl_bad.Count-1;
    SetHint(True, 'Saving file');
    sbFile.Panels[0].Text := '';
    FOR N := 0 TO sl_out.Count-1 DO
      WITH TWordObj(sl_out.Objects[N]) DO
        begin
          CheckProg(N);
          WriteLn(T, Format('%s%.03X%s', [sl_out[N], Group, LinkString]));
        end;
    FOR N := 0 TO sl_bad.Count-1 DO
      begin
        pbFile.Position := sl_out.Count-1+N;
        WriteLn(T, sl_bad[N]+'000');
      end;
    CloseFile(T);
    lblAction.Caption := Format('%d words of %d letters processed'+
      ' into %d group%s',
      [sl_out.Count, WordLen, G, plural[G>1]]);
  end;

begin
  sl_in := TStringList.Create;
  try
    Screen.Cursor := crHourglass;
    sl_temp := TStringList.Create;
    try
      sl_out := TStringList.Create;
        try
          sl_bad := TStringList.Create;
            try
              sl_in.LoadFromFile(fName);
              IF NOT ValidateFile THEN Exit;
              IF NOT FileOK THEN
                begin
                  ShowMessage(Format('File %s is not valid. It '+
                    'should contain only %d-letter uppercase words',
                    [fName, WordLen]));
                  Exit;
                end;
              IF NOT BuildWordGroups THEN Exit;
              IF NOT BuildWordLinks THEN Exit;
              WriteItOut(sl_out, sl_bad);
        finally
          sl_bad.Free;
        end;
      finally
        sl_out.Free;
      end;
    finally
      sl_temp.Free;
    end;
  finally
    sl_in.Free;
    Screen.Cursor := crDefault;
    sbFile.Panels[0].Text := '';
  end;
end;

procedure TFileManageForm.EnableDisable(Dis : Boolean);
begin
  IF Dis THEN
    begin
      btnImport.Enabled := False;
      btnExport.Enabled := False;
      btnClose.Enabled  := False;
      btnStop.Enabled   := True;
      Stopped := False;
    end
  ELSE
    begin
      btnClose.Enabled := True;
      btnStop.Enabled := False;
      btnImport.Enabled := True;
      btnExport.Enabled := True;
    end;
  pbFile.Position := 0;
end;

end.