Unit Profile;

Interface

Uses Classes;

Type
  TCart = (ctStandard,ct4800,ctECS,ct6502);
  TFileType = Class
    Name         : String;
    RealName     : String;
    Cart         : TCart;
    Manufacturer : String;
    Year         : Integer;
    MemStr       : String;
  End;

Const
  MenuKey : Array[TCart] Of Char =
   (#13,'4','E','K');

Var ProfileList: TList;

Procedure MakeProfile(Path: String);
Function  FindProfile(Name: String;
                      Var FileRec: TFileType): TCart;
Procedure AddToProfile(Const Name: String;
                       Const RealName: String;
                       Const Cart: TCart;
                       Const Manufacturer: String;
                       Const Year: Integer;
                       Const MemStr: String);
Function FindByTitle(Title: String): TFileType;
Function ConcatAllNames: PChar;

Implementation

Uses SysUtils,Forms;

Const
  OutFileName = 'INTVWIN.PRO';

Type
  TIndex = Array[0..255] Of Integer;

Const
  CartID : Array[TCart] Of String[2] =
   ('C5','C4','EC','65');

Var FileIndex: TIndex;

Function FindByTitle(Title: String): TFileType;
Var
  I     : Integer;
  Found : Boolean;
  F     : TFileType;
  St    : String;

Begin
  I     := 0;
  F     := Nil;
  Found := False;
  While (I < ProfileList.Count) And Not Found Do
  Begin
    F := ProfileList[I];
    If F.RealName <> '' Then St := F.RealName Else St := F.Name;
    If St = Title Then Found := True Else Inc(I);
  End; // While
  If Found Then FindByTitle := F Else FindByTitle := Nil;
End; // FindByTitle

Procedure Separate(Var St,St1: String);
{ ------------------------------------------------------------------ }
{ Takes an input string St, separates such that the left portion is  }
{ returned in St1 and the right portion is returned in St.  If the   }
{ string has no spaces, St1 returns the entire string and St returns }
{ a string containing two spaces.                                    }
{ ------------------------------------------------------------------ }
Var I: Integer;
Begin
  I := Pos(' ',St);
  If I <> 0 Then
  Begin
    St1 := UpperCase(Trim(Copy(St,1,I - 1)));
    St  := Trim(Copy(St,I + 1,Length(St) - I));
  End
  Else
  Begin
    St1 := UpperCase(St);
    St  := '  ';
  End;
End; { Separate }

Procedure SortFileList;
Var
  I,J   : Integer;
  F1,F2 : TFileType;
  F3    : TFileType;

Begin
  I := 0;
  While I < ProfileList.Count - 1 Do
  Begin
    F1 := ProfileList[I];
    J := I + 1;
    While J < ProfileList.Count Do
    Begin
      F2 := ProfileList[J];
      If F2.Name < F1.Name Then
      Begin
        F3 := F1;
        ProfileList[I] := F2;
        ProfileList[J] := F3;
        F1 := F2;
      End;
      Inc(J);
    End; { While }
    Inc(I);
  End;
End; { SortFileList }

Procedure SortFileListByTitle;
Var
  I,J   : Integer;
  F1,F2 : TFileType;
  F3    : TFileType;
  St1   : String;
  St2   : String;

Begin
  I := 0;
  While I < ProfileList.Count - 1 Do
  Begin
    F1 := ProfileList[I];
    If F1.RealName <> ''
     Then St1 := F1.RealName
     Else St1 := F1.Name;
    J := I + 1;
    While J < ProfileList.Count Do
    Begin
      F2 := ProfileList[J];
      If F2.RealName <> ''
       Then St2 := F2.RealName
       Else St2 := F2.Name;
      If St2 < St1 Then
      Begin
        F3 := F1;
        ProfileList[I] := F2;
        ProfileList[J] := F3;
        F1 := F2;
        St1 := St2;
      End;
      Inc(J);
    End; { While }
    Inc(I);
  End;
End; { SortFileListByTitle }

Function ConcatAllNames: PChar;
Var
  I     : Integer;
  F     : TFileType;
  Len   : Integer;
  P,P1  : PChar;

Begin
  SortFileListByTitle;
  Len := 0;
  For I := 0 To ProFileList.Count - 1 Do
  Begin
    F := ProfileList[I];
    If F.RealName <> ''
     Then Inc(Len,Length(F.RealName) + 1)
     Else Inc(Len,Length(F.Name) + 1);
  End; // For I
  Inc(Len);
  GetMem(P,Len);
  FillChar(P^,SizeOf(P^),#0);
  P1 := P;
  For I := 0 To ProFileList.Count - 1 Do
  Begin
    F := ProfileList[I];
    If F.RealName <> '' Then
    Begin
      StrPCopy(P1,F.RealName);
      Inc(LongInt(P1),Length(F.RealName) + 1);
    End
    Else
    Begin
      StrPCopy(P1,F.Name);
      Inc(LongInt(P1),Length(F.Name) + 1);
    End;
  End; // For I
  ConcatAllNames := P;
  SortFileList;
End; // ConcatAllNames

Procedure LoadFileList(Path: String);
Var
  S      : TSearchRec;
  F      : TFileType;

Begin
  If FindFirst(Path + '*.BIN',faArchive,S) = 0 Then
  Repeat
    FindProfile(UpperCase(S.Name),F);
    If F = Nil Then
    Begin
      F              := TFileType.Create;
      F.Name         := UpperCase(S.Name);
      F.RealName     := '';
      F.Cart         := ctStandard;
      F.Manufacturer := '';
      F.Year         := 0;
      F.MemStr       := '';
      ProfileList.Add(F);
    End;
  Until FindNext(S) <> 0;
End; { LoadFileList }

Procedure Cleanup;
Var I: Integer;
Begin
  I := 0;
  While I < ProfileList.Count Do
  Begin
    TFileType(ProfileList[I]).Free;
    Inc(I);
  End; // While
  ProfileList.Free;
  FillChar(FileIndex,SizeOf(FileIndex),#0);
End; { Cleanup }

Procedure OutputFile(Path: String);
Var
  F       : TFileType;
  St      : String;
  Lines   : Integer;
  OutFile : System.Text;

Begin
  AssignFile(OutFile,Path + OutFileName);
  ReWrite(OutFile);
  WriteLn(OutFile,'; INTVWIN cartridge profile list');
  WriteLn(OutFile,'; Valid cart codes: C5 C4 EC 65');
  WriteLn(OutFile);
  Lines := 0;
  While Lines < ProfileList.Count Do
  Begin
    F := ProfileList[Lines];
     
    // File name

    St := '/' + F.Name + '/ ';
    While Length(St) < 15 Do St := St + ' ';

    // Cart type

    St := St + CartID[F.Cart] + '  ';

    // Title

    If (F.RealName <> '') And (F.RealName <> F.Name) Then
     St := St + '"' + F.RealName + '" ';
    While Length(St) < 58 Do St := St + ' ';

    // Manufacturer

    If F.Manufacturer <> '' Then St := St + 'MN[' + F.Manufacturer + ']MN ';
    While Length(St) < 80 Do St := St + ' ';

    // Year

    If F.Year <> 0 Then St := St + 'YR[' + IntToStr(F.Year) + ']YR ';
    While Length(St) < 95 Do St := St + ' ';

    // Memory layout

    If F.MemStr <> '' Then St := St + 'MEM=' + F.MemStr;
    WriteLn(OutFile,St);
    Inc(Lines);
    If (Lines Mod 10) = 0 Then
     WriteLn(OutFile,'; ---------------------------------------------------');
  End; { While }
  CloseFile(OutFile);
End; { OutputFile }

Procedure IndexFileList;
Var
  FWork : TFileType;
  C     : Char;
  I     : Integer;

Begin
  FillChar(FileIndex,SizeOf(FileIndex),#0);
  I := 0;
  C     := '*';   { Choose a character that cannot be in the filename }
  While I < ProfileList.Count Do
  Begin
    FWork := ProfileList[I];
    If FWork.Name <> '' Then
    Begin
      If FWork.Name[1] <> C Then
      Begin
        C                 := FWork.Name[1];
        FileIndex[Ord(C)] := I;
      End;
    End;
    Inc(I);
  End; { While }
End; { IndexFileList }

Procedure MakeProfile(Path: String);
Begin
  If (Path <> '') And Not (Path[Length(Path)] In [':','\']) Then Path := Path + '\';
  LoadFileList(Path);
  SortFileList;
  IndexFileList;
  OutputFile(Path);
End; { MakeProfile }

Procedure LoadProfile;
Var
  St,St1  : String;
  I,J     : Integer;
  Cart    : TCart;
  OutFile : System.Text;
  F       : TFileType;

Begin
  If FileExists(ExtractFilePath(Application.ExeName) + OutFileName) Then
  Begin
    AssignFile(OutFile,OutFileName);
    Reset(OutFile);
    While Not Eof(OutFile) Do
    Begin
      ReadLn(OutFile,St);
      St := Trim(St);

      { Exclude remarks and blank lines }

      If (St <> '') And (St[1] <> ';') Then
      Begin

        { Locate the file name }

        St1 := St;
        I   := Pos('/',St);
        If I <> 0 Then
        Begin
          St := Copy(St,I + 1,Length(St) - I);
          I  := Pos('/',St);
          If I <> 0 Then
          Begin
            St1 := Trim(Copy(St,1,I - 1));
            St  := Trim(Copy(St,I + 1,Length(St) - I));
          End;
        End
        Else Separate(St,St1);

//        Separate(St,St1);
        F              := TFileType.Create;
        F.Name         := UpperCase(St1);
        F.RealName     := '';
        F.Cart         := ctStandard;
        F.Manufacturer := '';
        F.Year         := 0;
        F.MemStr       := '';
        ProfileList.Add(F);

        { Locate the cartridge mnemonic }

        Separate(St,St1);
        For Cart := Low(TCart) To High(TCart) Do
         If CartID[Cart] = St1 Then F.Cart := Cart;

        { Locate the game's real name }

        I := Pos('"',St);
        If I <> 0 Then
        Begin
          St := Copy(St,I + 1,Length(St) - I);
          I := Pos('"',St);
          If I <> 0 Then
          Begin
            St1 := Trim(Copy(St,1,I - 1));
            St  := Trim(Copy(St,I + 1,Length(St) - I));
            If St1 <> '' Then F.RealName := St1;
          End;
        End;

        // Locate the game's manufacturer

        I := Pos('MN[',St);
        If I <> 0 Then
        Begin
          St := Copy(St,I + 3,Length(St) - I - 2);
          I := Pos(']MN',St);
          If I <> 0 Then
          Begin
            St1 := Trim(Copy(St,1,I - 1));
            St  := Trim(Copy(St,I + 3,Length(St) - I - 2));
            If St1 <> '' Then F.Manufacturer := St1;
          End;
        End;

        // Locate the year the game was made

        I := Pos('YR[',St);
        If I <> 0 Then
        Begin
          St := Copy(St,I + 3,Length(St) - I - 2);
          I := Pos(']YR',St);
          If I <> 0 Then
          Begin
            St1 := Trim(Copy(St,1,I - 1));
            St  := Trim(Copy(St,I + 3,Length(St) - I - 2));
            If St1 <> '' Then
            Begin
              Val(St1,I,J);
              If J = 0 Then F.Year := I;
            End;
          End;
        End;

        { Load the memory placement information }

        I := Pos('MEM=',UpperCase(St));
        If I <> 0 Then
        Begin
          St := Trim(Copy(St,I + 4,Length(St) - I - 3));
          I  := Pos(' ',St);
          If I <> 0 Then
          Begin
            St1 := Trim(Copy(St,1,I - 1));
            St  := Trim(Copy(St,I + 1,Length(St) - I));
            If St1 <> '' Then F.MemStr := St1;
          End
          Else
          Begin
            If St <> '' Then F.MemStr := St;
          End;
        End;
      End;
    End; { While }
    CloseFile(OutFile);
  End;
End; { LoadProfile }

Procedure KillProfile;
Begin
  MakeProfile(ExtractFilePath(Application.ExeName));
  Cleanup;
End; { KillProfile }

Function FindProfile(Name: String;
                     Var FileRec: TFileType): TCart;
Var
  FWork : TFileType;
  Found : Boolean;
  I     : Integer;

Begin
  Name  := UpperCase(Name);
  Found := False;
  I     := 0;
  If Name <> '' Then
  Begin
    I := FileIndex[Ord(Name[1])];
    While (I >= 0) And (I < ProfileList.Count) And
          (TFileType(ProfileList[I]).Name[1] = Name[1]) And Not Found Do
    Begin
      If Name = TFileType(ProfileList[I]).Name Then Found := True Else Inc(I);
    End; { While }
  End;
  If Found Then
  Begin
    FWork       := ProfileList[I];
    FindProfile := FWork.Cart;
    FileRec     := FWork;
  End
  Else
  Begin
    FindProfile := ctStandard;
    FileRec     := Nil;
  End;
End; { FindProfile }

Procedure AddToProfile(Const Name: String;
                       Const RealName: String;
                       Const Cart: TCart;
                       Const Manufacturer: String;
                       Const Year: Integer;
                       Const MemStr: String);
Var F: TFileType;
Begin
  F              := TFileType.Create;
  F.Name         := Name;
  F.RealName     := RealName;
  F.Cart         := Cart;
  F.Manufacturer := Manufacturer;
  F.Year         := Year;
  F.MemStr       := MemStr;
  ProfileList.Add(F);
  SortFileList;
  IndexFileList;
End; { AddToProfile }

Initialization
  ProfileList := TList.Create;
  LoadProfile;
  IndexFileList;
Finalization
  KillProfile;
End.

// ----------------------------------------------------------------------
// IntvWin - Mattel Intellivision Emulator
// Copyright (C) 2000 John Dullea
//
//  This program is free software; you can redistribute it and/or modify
//  it under the terms of the GNU General Public License as published by
//  the Free Software Foundation; either version 2 of the License, or
//  (at your option) any later version.
//
//  This program is distributed in the hope that it will be useful,
//  but WITHOUT ANY WARRANTY; without even the implied warranty of
//  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
//  GNU General Public License for more details.
//
//  You should have received a copy of the GNU General Public License
//  along with this program; if not, write to the Free Software
//  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
// ----------------------------------------------------------------------
