Unit Base;

Interface

Uses frmDebuggerUnt,Classes,IntvDis,DirectX,Profile,ZipMstr,Windows;

Type
  TRGB = Packed Record
    R,G,B: Byte;
  End;
  RGB = Packed Record
    B,G,R: Byte;
  End;
  TPalette = Packed Array[0..255] Of RGB;
  T6502Mem = Packed Array[0..65535] Of Byte;
  
Const
  Version : String = '1.1';
  ScnBufWidth  = 320;
  ScnBufHeight = 200;
  ScnBufSize   = ScnBufWidth * ScnBufHeight;
  SndBufSize   = 10*1024+512;
  _Palette: Array[0..22] Of TRGB =
   ((R:$00; G:$00; B:$00),(R:$00; G:$00; B:$37),(R:$3A; G:$00; B:$00),(R:$30; G:$34; B:$1D),
    (R:$01; G:$21; B:$00),(R:$00; G:$2C; B:$00),(R:$3F; G:$38; B:$06),(R:$3F; G:$3F; B:$3F),
    (R:$2A; G:$2A; B:$2A),(R:$15; G:$2F; B:$33),(R:$3F; G:$23; B:$03),(R:$0D; G:$18; B:$0A),
    (R:$3F; G:$15; B:$15),(R:$26; G:$27; B:$3F),(R:$15; G:$34; B:$00),(R:$32; G:$05; B:$14),
    (R:$3F; G:$3F; B:$3F),(R:$38; G:$38; B:$38),(R:$32; G:$32; B:$32),(R:$2F; G:$00; B:$00),
    (R:$1F; G:$20; B:$3F),(R:$17; G:$18; B:$3F),(R:$10; G:$10; B:$3F));  

Type
  PZipDirEntry = ^ZipDirEntry;
  TKailleraControls = Packed Record
    P       : Word;
    Console : Byte;
  End;
  TKailleraGameCallBack          = Function(Game: PChar; Player: Integer; NumPlayers: Integer): Integer; stdcall;
  TKailleraChatReceivedCallBack  = Procedure(Nick: PChar; Text: PChar);                                  stdcall;
  TKailleraClientDroppedCallBack = Procedure(Nick: PChar; PlayerNB: Integer);                            stdcall;
  TKailleraMoreInfoCallBack      = Procedure(GameName: PChar);                                           stdcall;
  TKailleraInfo = Packed Record
    AppName               : PChar;
    GameList              : PChar;
    GameCallBack          : TKailleraGameCallBack;
    ChatReceivedCallBack  : TKailleraChatReceivedCallBack;
    ClientDroppedCallBack : TKailleraClientDroppedCallBack;
    MoreInfoCallBack      : TKailleraMoreInfoCallBack;
  End;
  TScreen  = Packed Array[0..160 * 192 - 1] Of Byte;
  TIntvScreenMode = (smForeBack,smColorStack);
  TSpriteLoc = Array[0..7] Of Integer;
  TMenuSort  = (msName,msSize,msType,msManufacturer,msYear,msScreenShot,msExtras);
  TRGBQUAD = Packed Record
    rgbBlue     : Byte;
    rgbGreen    : Byte;
    rgbRed      : Byte;
    rgbReserved : Byte;
  End;
  TMenuInfo = Record
    Sel         : Integer;
    _Top        : Integer;
    FileName    : String;
    ZipFileName : String;
    Title       : String;
    ProfileRec  : TFileType;
  End;
  TFileListItem = Class
    Name         : String;
    ZIPName      : String;
    Size         : LongInt;
    Prof         : TFileType;
    RNam         : String;
    ScreenShot   : Boolean;
    BoxFrontScan : Boolean;
    BoxBackScan  : Boolean;
    BoxSideScan  : Boolean;
    CartScan     : Boolean;
    Manual       : Boolean;
    OverlayScan  : Boolean;
    Extras       : String;
  End;
  TColorScheme   = (csGameType,csAlphabetical,csEvery3,csEvery4,csEvery5,csEvery6);
  TDisplayScheme = (dsNameExt4,dsNameExt3,dsNameExt2,
                    dsNameOnly4,dsNameOnly3,dsNameOnly2,
                    dsRealNameLeft,dsRealNameCenter);  
  ConfigRec      = Packed Record
    DoSound            : Boolean;
    FrameRate          : SmallInt;
    ScreenModeWidth    : Word;
    ScreenModeHeight   : Word;
    ScreenModeDepth    : Word;
    MenuColorScheme    : TColorScheme;
    MenuForeColor1     : LongInt;
    MenuForeColor2     : LongInt;
    MenuBackColor1     : LongInt;
    MenuBackColor2     : LongInt;
    MenuDisplayScheme  : TDisplayScheme;
    GamePath           : String;
    ScreenShotPath     : String;
    BoxFrontScanPath   : String;
    BoxBackScanPath    : String;
    BoxSideScanPath    : String;
    CartScanPath       : String;
    ManualPath         : String;
    OverlayScanPath    : String;
    AlternateGameMenu  : Boolean;
    Exec               : String;
    GROM               : String;
    ECS                : String;
    KBDC               : String;
    KBDAlpha           : String;
    ROM6502            : String;
    IVoiceROM          : String;
    HideAllOnZoomFull  : Boolean;
    ShowFPS            : Boolean;
    ZoomMode           : Integer;
  End;

Const
  MenuSortName : Array[TMenuSort] Of String =
   ('Name','Size','Type','Manufacturer','Year','Shot','Extras');

Var
  Cart                           : TCart;
  DoSlowDown                     : Boolean;
  NewList                        : Boolean;
  LeftController                 : Word;
  RightController                : Word;
  ECSLeftController              : Word;
  ECSRightController             : Word;
  IntvMem                        : CP1600Mem;
  Regs                           : CP1600Regs;
  StatusWord                     : Word;
  EBCA                           : Byte;
  EBCI                           : Boolean;
  InsCount                       : Word;
  SlowCount                      : Word;
  Cycles                         : Packed Array[0..1023] Of Byte;
  LogOutput                      : Boolean;
  LogFile                        : System.Text;
  IntPending                     : Boolean;
  IntPending6502                 : Boolean;
  ECSKey                         : Boolean;
  ECSPCKey                       : Integer;
  ECSDelay                       : Integer;
  ECSSaveBuf                     : Packed Array[0..15] Of Byte;
  ECSSaveBufI                    : Integer;                   { Index into save buffer }
  ECSCassFile                    : File;
  ECSSave                        : Boolean;
  ECSLoad                        : Boolean;
  ECSLoadable                    : Boolean;
  ECSPrint                       : Boolean;
  Interrupts                     : Byte;  { 0,1-off, 2-coming on, 3-on }
  DoubleByte                     : Boolean;
  ScreenMode                     : TIntvScreenMode;
  DoubleBuf                      : TScreen;
  ScreenColl                     : TScreen;
  ScreenCollB                    : TScreen;
  SpriteX                        : TSpriteLoc;
  SpriteY                        : TSpriteLoc;
  VDelay                         : Integer;
  HDelay                         : Integer;
  Trace                          : Integer;
  DebugAddr                      : Word;
  Debug6502                      : Boolean;
  ReadMem                        : Boolean;
  WriteMem                       : Boolean;
  RWMemLoc                       : Word;
  ReadMem6502                    : Boolean;
  WriteMem6502                   : Boolean;
  RWMemLoc6502                   : Word;
  ECSKeyList                     : Packed Array[0..255] Of Byte;
  Importing                      : Boolean;
  ImportFile                     : File;
  ImportRead                     : Boolean;
  ImportKey                      : Byte;
  ImportCount                    : Integer;
  ImportCont                     : Byte;
  ImportShift                    : Boolean;
  GameE                          : Packed Array[0..$FFF] Of Word;
  ECSE                           : Packed Array[0..$FFF] Of Word;
  LeftDiscPos                    : Word;
  RightDiscPos                   : Word;
  LeftMouseDown                  : Boolean;
  RightMouseDown                 : Boolean;
  ResetSound                     : Boolean;

  KInfo                          : TKailleraInfo;
  KValues                        : Packed Array[1..8] Of TKailleraControls;
  UsingKaillera                  : Boolean;
  KailleraPlayer                 : Integer;
  KSyncInfo                      : Packed Array[1..8] Of LongInt;

  MenuInfo                       : TMenuInfo;
  Limit                          : LongInt;
  Config                         : ConfigRec;
  ScnPtr                         : Pointer;
  ScnPtr2                        : Pointer;
  ScnBuf                         : Packed Array[0..ScnBufSize - 1] Of Byte;
  ScnBuf2                        : Packed Array[0..ScnBufSize - 1] Of Byte;
  DebugScnBuf                    : Packed Array[0..ScnBufSize - 1] Of Byte;
  Exiting                        : Boolean;
  BreakExpColl                   : TStringList;
  BreakExpColl6502               : TStringList;
  Path                           : String;
  Debugger                       : Boolean;
  ROMBackup                      : TGameROM;
  SoundBufPtr                    : Pointer;
  SoundBufSize                   : LongInt;
  SoundBufPtr2                   : Pointer;
  SoundBufSize2                  : LongInt;
  SoundQueue                     : Packed Array[0..1025] Of Byte;
  SDesc                          : DDSurfaceDesc;
  Mem6502                        : T6502Mem;
  KBDAlpha                       : Packed Array[0..2047] Of Byte;
  KBDBuffer                      : Packed Array[0..ScnBufSize - 1] Of Byte;
  ScrollKBDC                     : Integer;
  WorkSoundBuf                   : Packed Array[0..44100 - 1] Of Byte; // One full second worth
  OldPos                         : Integer;
  LastWrite                      : Integer;

Function RemoveFileExt(St: String): String;
Function FileExistsZip(FileName: String; Extract: Boolean; Var ZIP: Boolean): Boolean;

Procedure kailleraInit;                                             stdcall; External 'kailleraclient.dll' Name '_kailleraInit@0';
Procedure kailleraShutdown;                                         stdcall; External 'kailleraclient.dll' Name '_kailleraShutdown@0';
Procedure kailleraGetVersion(Version: PChar);                       stdcall; External 'kailleraclient.dll' Name '_kailleraGetVersion@4';
Procedure kailleraSetInfo(Var KailleraInfo: TKailleraInfo);         stdcall; External 'kailleraclient.dll' Name '_kailleraSetInfos@4';
Procedure kailleraSelectServerDialog(Parent: HWND);                 stdcall; External 'kailleraclient.dll' Name '_kailleraSelectServerDialog@4';
Function  kailleraModifyPlayValues(Values: Pointer; Size: Integer): Integer; stdcall; External 'kailleraclient.dll' Name '_kailleraModifyPlayValues@8';
Procedure kailleraChatSend(Text: PChar);                            stdcall; External 'kailleraclient.dll' Name '_kailleraChatSend@4';
Procedure kailleraEndGame;                                          stdcall; External 'kailleraclient.dll' Name '_kailleraEndGame@0';

Function  KailleraGameCallBack(Game: PChar; Player: Integer; NumPlayers: Integer): Integer; stdcall;
Procedure KailleraChatReceivedCallBack(Nick: PChar; Text: PChar);                           stdcall;
Procedure KailleraClientDroppedCallBack(Nick: PChar; PlayerNB: Integer);                    stdcall;
Procedure KailleraMoreInfoCallBack(GameName: PChar);                                        stdcall;

Implementation

Uses SysUtils,frmMainUnt,frmAltMenuUnt,frmKailleraUnt,Dialogs;

Var
  ZipCacheName : String;
  ZipCacheList : TList;
  ZipCacheLow  : Array[0..255] Of LongInt;
  ZipCacheHigh : Array[0..255] Of LongInt;

Procedure FreeZipCacheList;
Begin
  While ZipCacheList.Count > 0 Do
  Begin
    Dispose(PZipDirEntry(ZipCacheList.Items[0]));
    ZipCacheList.Delete(0);
  End; // While
End; // FreeZipCacheList

Function FileExistsZip(FileName: String; Extract: Boolean; Var ZIP: Boolean): Boolean;
Var
  B     : Boolean;
  FName : String;
  Path  : String;
  S     : TSearchRec;
  Found : Boolean;
  Z     : ZipDirEntry;
  I,J   : Integer;
  L,H   : Integer;
  C     : Integer;
  P,P1  : PZipDirEntry;
  Ch    : Char;

Begin
  B   := FileExists(FileName);
  ZIP := False;
  If B Then FileExistsZip := B
  Else
  Begin
    FileName := ExpandFileName(FileName);
    Path     := ExtractFilePath(FileName);
    FName    := UpperCase(ExtractFileName(FileName));
    Found    := False;

    // Check the ZIP cache first, but only if it's in the same folder

    If UpperCase(ExtractFilePath(FileName)) = UpperCase(ExtractFilePath(ZipCacheName)) Then
    Begin
      L := ZipCacheLow[Byte(FName[1])];
      H := ZipCacheHigh[Byte(FName[1])];
      If L >= 0 Then
      Begin
        // Perform a binary search for the file name
        
        I := L;
        J := H - L;
        While (J <> 0) And Not Found Do
        Begin
          P := PZipDirEntry(ZipCacheList.Items[I]);
          C := AnsiCompareStr(P^.FileName,FName);
          If C = 0 Then Found := True Else
          Begin
            If C < 0 Then
            Begin
              If J > 0 Then
              Begin
                If I < H Then
                Begin
                  Inc(I,J);
                  If I > H Then I := H;
                End
                Else J := 0;
              End
              Else
              Begin
                J := -(J Div 2);
                Inc(I,J);
                If I > H Then I := H;
              End;
            End
            Else
            Begin
              If J < 0 Then
              Begin
                If I > L Then
                Begin
                  Inc(I,J);
                  If I < L Then I := L;
                End
                Else J := 0;
              End
              Else
              Begin
                J := -(J Div 2);
                Inc(I,J);
                If I < L Then I := L;
              End;
            End;
          End;
        End; // While
      End;
    End;

    // Start checking ZIP files if it wasn't in the cache

    If Not Found Then
    Begin
      If FindFirst(Path + '*.ZIP',faArchive,S) = 0 Then
      Repeat
        // If we already cached this ZIP file, don't reload the data (assume it hasn't changed)

        If ZipCacheName <> UpperCase(Path + S.Name) Then
        Begin
          frmMain.ZipMaster1.ZipFilename := Path + S.Name;

          // Check the file list

          I := 0;
          While (I < frmMain.ZipMaster1.ZipContents.Count) And Not Found Do
          Begin
            Z := PZipDirEntry(frmMain.ZipMaster1.ZipContents.Items[I])^;
            If UpperCase(Z.FileName) = UpperCase(FName) Then Found := True Else Inc(I);
          End; // While

          // If the file was found, cache the ZIP file

          If Found Then
          Begin

            // Copy the ZIP file list to the cache

            ZipCacheName := UpperCase(Path + S.Name);
            FreeZipCacheList;
            For I := 0 To frmMain.ZipMaster1.ZipContents.Count - 1 Do
            Begin
              New(P);
              P^ := PZipDirEntry(frmMain.ZipMaster1.ZipContents.Items[I])^;
              P^.FileName := UpperCase(P^.FileName);
              ZipCacheList.Add(P);
            End; // For I

            // Sort the cache (simple bubble sort for now)

            For I := 0 To ZipCacheList.Count - 2 Do
            Begin
              P := PZipDirEntry(ZipCacheList.Items[I]);
              For J := I + 1 To ZipCacheList.Count - 1 Do
              Begin
                P1 := PZipDirEntry(ZipCacheList.Items[J]);
                If P1^.FileName < P^.FileName Then
                Begin
                  ZipCacheList.Exchange(I,J);
                  P := P1;
                End;
              End; // For J
            End; // For I

            // Fill in the indexes

            For I := 0 To 255 Do
            Begin
              ZipCacheLow[I]  := -1;
              ZipCacheHigh[I] := -1;
            End; // For I
            For I := 0 To ZipCacheList.Count - 1 Do
            Begin
              Ch := PZipDirEntry(ZipCacheList.Items[I])^.FileName[1];
              If ZipCacheLow[Byte(Ch)] < 0 Then ZipCacheLow[Byte(Ch)] := I;
              ZipCacheHigh[Byte(Ch)] := I;
            End; // For I
          End;
        End;
      Until (FindNext(S) <> 0) Or Found;
    End;

    // Extract if we are told to

    If Extract And Found Then
    Begin
      frmMain.ZipMaster1.ZipFilename := ZipCacheName;
      frmMain.ZipMaster1.FSpecArgs.Clear;
      frmMain.ZipMaster1.FSpecArgs.Add(FName);
      frmMain.ZipMaster1.ExtrBaseDir := Path;
      frmMain.ZipMaster1.Extract;
    End;
    ZIP           := Found;
    FileExistsZip := Found;
  End;
End; // FileExistsZip

Procedure KailleraSync;
//Var J: Integer;
Begin

    FillChar(KSyncInfo,SizeOf(KSyncInfo),#0);
    KSyncInfo[1] := KailleraPlayer;
    KailleraModifyPlayValues(@KSyncInfo,4);
//    Sleep(500);

(*
  J := 0;
  frmMain.Label3.Caption := 'SYNC START';
  Repeat
    FillChar(KSyncInfo,SizeOf(KSyncInfo),#0);
    KSyncInfo[1] := KailleraPlayer;
    KailleraModifyPlayValues(@KSyncInfo,1);
    Sleep(500);
    Inc(J);
  Until (J > 100) Or ((KSyncInfo[1] = 1) And (KSyncInfo[2] = 2));
  If J > 100 Then
   frmMain.Label3.Caption := 'Unable to sync'#13#10 +
                             'KSyncInfo[1] = ' + IntToStr(KSyncInfo[1]) + #13#10 +
                             'KSyncInfo[2] = ' + IntToStr(KSyncInfo[2])
  Else frmMain.Label3.Caption := 'SYNC OK';
*)
End; // KailleraSync

Function KailleraGameCallBack(Game: PChar; Player: Integer; NumPlayers: Integer): Integer;
Var
  Path     : String;
  F        : TFileType;
  Name     : String;
  FileList : TList;
  Item     : TFileListItem;
  S        : TSearchRec;
  I,J      : Integer;
  Found    : Boolean;
  Found1   : Boolean;
  Z        : ZipDirEntry;
  St       : String;

Begin
  Name     := StrPas(Game);
  FileList := TList.Create;

  // Locate all .BIN and .ROM files

  If ParamCount > 0 Then Path := ParamStr(1) Else Path := Config.GamePath;
  If (Path <> '') And Not (Path[Length(Path)] In [':','\']) Then Path := Path + '\';

  If FindFirst(Path + '*.BIN',faArchive,S) = 0 Then
  Repeat
    Item := TFileListItem.Create;
    FileList.Add(Item);
    Item.Name         := S.Name;
    Item.ZIPName      := '';
    Item.Size         := S.Size;
    Item.BoxFrontScan := False;
    Item.BoxBackScan  := False;
    Item.BoxSideScan  := False;
    Item.CartScan     := False;
    Item.Manual       := False;
    Item.Extras       := '';
  Until FindNext(S) <> 0;

  If FindFirst(Path + '*.ROM',faArchive,S) = 0 Then
  Repeat
    Item := TFileListItem.Create;
    FileList.Add(Item);
    Item.Name         := S.Name;
    Item.ZIPName      := '';
    Item.Size         := S.Size;
    Item.BoxFrontScan := False;
    Item.BoxBackScan  := False;
    Item.BoxSideScan  := False;
    Item.CartScan     := False;
    Item.Manual       := False;
    Item.Extras       := '';
  Until FindNext(S) <> 0;

  // Locate all .ZIP files, and locate all .BIN and .ROM files in those files

  If FindFirst(Path + '*.ZIP',faArchive,S) = 0 Then
  Repeat
    frmMain.ZipMaster1.ZipFilename := ExpandFileName(Path + S.Name);
    I := 0;
    While I < frmMain.ZipMaster1.ZipContents.Count Do
    Begin
      Z := PZipDirEntry(frmMain.ZipMaster1.ZipContents.Items[I])^;
      Z.FileName := UpperCase(Z.FileName);
      If (ExtractFileExt(Z.FileName) = '.BIN') Or
         (ExtractFileExt(Z.FileName) = '.ROM') Then
      Begin
        Item := TFileListItem.Create;
        FileList.Add(Item);
        Item.Name         := ExtractFileName(Z.FileName);
        Item.ZIPName      := S.Name;
        Item.Size         := Z.UncompressedSize;
        Item.BoxFrontScan := False;
        Item.BoxBackScan  := False;
        Item.BoxSideScan  := False;
        Item.CartScan     := False;
        Item.Manual       := False;
        Item.Extras       := '';
      End;
      Inc(I);
    End; // While
  Until FindNext(S) <> 0;

  frmAltMenu.SortFileList(FileList,0,FileList.Count - 1);

  // Load the game if possible

  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 = Name Then
    Begin
      J      := 0;
      Found1 := False;
      While (J < FileList.Count) And Not Found1 Do
      Begin
        St  := UpperCase(TFileListItem(FileList.Items[J]).Name);
        If St = UpperCase(F.Name) Then Found1 := True Else Inc(J);
      End; // While
      If Found1 Then Found := True Else Inc(I);
    End
    Else Inc(I);
  End; // While
  If Found Then
  Begin
    If TFileListItem(FileList.Items[I]).ZipName <> ''
     Then frmMain.LoadGame(Path + St,Path + TFileListItem(FileList.Items[I]).ZipName,F.RealName)
     Else frmMain.LoadGame(Path + St,'',F.RealName);
    UsingKaillera  := True;
    KailleraPlayer := Player;
    KailleraSync;
    Emulate;
  End;
  UsingKaillera := False;
  KailleraGameCallBack := 0;
End; // KailleraGameCallBack

Procedure KailleraChatReceivedCallBack(Nick: PChar; Text: PChar);
Begin
  If frmKaillera.lbChat.Items.Count > Max_Chat Then frmKaillera.lbChat.Items.Delete(0);
  frmKaillera.lbChat.Items.Add(StrPas(Nick) + ': ' + StrPas(Text));
End; // KailleraChatReceivedCallBack

Procedure KailleraClientDroppedCallBack(Nick: PChar; PlayerNB: Integer);
Begin
//  ShowMessage('KailleraClientDroppedCallBack');
End; // KailleraClientDroppedCallBack

Procedure KailleraMoreInfoCallBack(GameName: PChar);
Begin
//  ShowMessage('KailleraModeInfoCallBack');
End; // KailleraMoreInfoCallBack

Function RemoveFileExt(St: String): String;
Var I: Integer;
Begin
  I := Length(St);
  While (St[I] <> '.') And (I > 0) Do Dec(I);
  If I <> 0 Then St := Copy(St,1,I - 1);
  Result := St;
End; // RemoveFileExt

Initialization
  Debugger         := False;
  Path             := '';
  ScnPtr           := @ScnBuf;
  ScnPtr2          := @ScnBuf2;
  BreakExpColl     := Nil;
  BreakExpColl6502 := Nil;
  ResetSound       := True;
  ZipCacheName := '';
  ZipCacheList := TList.Create;
Finalization
  FreeZipCacheList;
  ZipCacheList.Free;
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.
// ----------------------------------------------------------------------
