unit m2fMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ToolWin, ActnMan, ActnCtrls, ActnMenus,
  ActnList, ExtCtrls, ImgList, Config, StdCtrls, Buttons, thPerif;

const
  ErrChooseMessage = 'First choose a configuration file';

type
  TfMain = class (TForm)
    MainMenu1:    TMainMenu;
    File1:        TMenuItem;
    StartEmulation1: TMenuItem;
    StopEmulation1: TMenuItem;
    Em1:          TMenuItem;
    DlgOpen:      TOpenDialog;
    MainBar:      TStatusBar;
    ChangeConfiguration2: TMenuItem;
    ListImages:   TImageList;
    Exit1:        TMenuItem;
    About1:       TMenuItem;
    EnableMouse1: TMenuItem;
    N2:           TMenuItem;
    N3:           TMenuItem;
    N4:           TMenuItem;
    N5:           TMenuItem;
    N6:           TMenuItem;
    N7:           TMenuItem;
    N8:           TMenuItem;
    N9:           TMenuItem;
    N10:          TMenuItem;
    N11:          TMenuItem;
    N1:           TMenuItem;
    N12:          TMenuItem;
    N13:          TMenuItem;
    N14:          TMenuItem;
    N15:          TMenuItem;
    N16:          TMenuItem;
    N17:          TMenuItem;
    procedure FormCreate (Sender: TObject);
    procedure StartEmulation1Click (Sender: TObject);
    procedure StopEmulation1Click (Sender: TObject);
    procedure MainBarDrawPanel (StatusBar: TStatusBar; Panel: TStatusPanel;
      const Rect: TRect);
    procedure Exit1Click (Sender: TObject);
    procedure EnableMouse1Click (Sender: TObject);
    procedure ChangeConfiguration2Click (Sender: TObject);
    procedure FormClose (Sender: TObject; var Action: TCloseAction);
    procedure N2Click (Sender: TObject);
    procedure N6Click (Sender: TObject);
    procedure N8Click (Sender: TObject);
    procedure N7Click (Sender: TObject);
    procedure N9Click (Sender: TObject);
    procedure N13Click (Sender: TObject);
    procedure N15Click (Sender: TObject);
    procedure N16Click (Sender: TObject);
    procedure N17Click (Sender: TObject);
  private
    WorkDir, EmulDir: string;
    StopEvent:        THandle;
    OriginalForm:     TRect;
    THddOn, THddOff:  TBitmap;
    THddLed:          TThPerif;
    LedHddVisible:    boolean;
    procedure InitVars;
    procedure StopEmulation;
    procedure LoadMenuEmuls;
    procedure CreateListItem (const AName: string);
  public
    procedure WMPaint (var Msg: TWMPaint); message WM_PAINT;
    procedure WMKeyDown (var Msg: TWMKeyDown); message WM_KEYDOWN;
    procedure WMKeyUp (var Msg: TWMKeyUp); message WM_KEYUP;
    procedure CM_DIALOGKEY (var Message: TWMKey); message CM_DIALOGKEY;
    procedure WMSysKeyDown (var Msg: TWMSysKeyDown); message WM_SYSKEYDOWN;
    procedure WMSysKeyUp (var Msg: TWMSysKeyUp); message WM_SYSKEYUP;
    procedure WMChar (var Msg: TWMChar); message WM_CHAR;
    procedure WMMouseMouse (var Msg: TWMMouseMove); message WM_MOUSEMOVE;
    procedure WMMouseDown (var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMMouseUp (var Msg: TWMLButtonUp); message WM_LBUTTONUP;
    procedure LoadVMConfig;
    procedure SaveVMConfig;
  end;

  TMessageThread = class (TThread)
    procedure Execute; override;
  end;

const
  MAX_TIME_WAIT = 5000;

var
  fMain:    TfMain;
  KT:       TMessageThread;
  VMConfig: TConf;

  IsStarted: boolean;

implementation

uses Gui32, cpu, iodev, InitSystemNames, Service, Memory, IniFiles, instrCounter,
  CreateIsoForm, frmConfig, floppy, HDD, cdrom;


{$R *.dfm}

{ TfMain }


procedure TfMain.LoadVMConfig;
  begin
    LoadConfigFile(WorkDir + 'config\vm.ini', @VMConfig);
    SaveConfigFile(WorkDir + 'config\vm.ini', @VMConfig);

  end;

procedure TfMain.SaveVMConfig;
  begin
    SaveConfigFile(WorkDir + 'config\vm.ini', @VMConfig);
  end;

procedure TfMain.InitVars;
  begin
    WorkDir := ExtractFilePath(Application.ExeName);


    if not DirectoryExists(WorkDir + 'logs') then
      MkDir(WorkDir + 'logs');

    IsStarted := False;

  end;

procedure TfMain.FormClose (Sender: TObject; var Action: TCloseAction);
  begin
    SaveVMConfig;
  end;

procedure TfMain.FormCreate (Sender: TObject);
  begin

    THddOn := TBitmap.Create;
    ListImages.GetBitmap(0, THddOn);
    THddOff := TBitmap.Create;
    InitVars;

    if not DirectoryExists(workdir + 'disks') then
      ForceDirectories(workdir + 'disks');

    if not DirectoryExists(workdir + 'snaps') then
      ForceDirectories(workdir + 'snaps');

    if not DirectoryExists(workdir + 'config') then
      ForceDirectories(workdir + 'config');

    LoadMenuEmuls;
    LoadVMConfig;

  end;

procedure StartEmulation;

  begin
      try
        try
        bx_cpu.cpu_loop;
        except
        on e: Exception do
          begin
          fMain.File1.Enabled := True;
          fMain.BoundsRect := fMain.OriginalForm;
          BX_PANIC(e.Message);
          end;
        end;
      finally
      DeleteCriticalSection(MouseCS);
      DeleteCriticalSection(drawCs);
      DeleteCriticalSection(KeyCs);
      DeleteCriticalSection(FakeCs);
      TerminateEmul;
      Gui32Stop;
      sysmemory.Free;
      bx_cpu.Free;
      bx_pc_system.Free;
      bx_devices.Free;
      SetEvent(fMain.StopEvent);
      end;
  end;

procedure LedHdd (OnOff: boolean);
  begin
    TryEnterCriticalSection(FakeCS);
    fMain.LedHddVisible := OnOff;
    fMain.MainBar.Refresh;
    LeaveCriticalSection(FakeCS);
  end;

procedure TfMain.StartEmulation1Click (Sender: TObject);
  var
    OldSize: TRect;
    I: integer;
  begin

    MouseEnabled := False;
    if IsStarted then
      begin
      ShowMessage('Сначала остановите виртуальную машину');
      exit;
      end;

    LoadVMConfig;

    for I := 0 to 1028 do
      BxOpcodeInfo[I].Counter := 0;
    OldSize := BoundsRect;
    File1.Enabled := False;
    MainWnd := Handle;
    InitLogFiles;
    SetConfiguration(@VMConfig);
    stoprun := False;
    LastMessage := '';
    ips_count := 0;
    m_ips := 0;
    LedHddVisible := False;

      try


      THddLed := TThPerif.Init(LedHdd);
      Gui32Init(MainWnd, 0);
      bx_cpu := BX_CPU_C.Create;
      bx_devices := bx_devices_c.Create;


      bx_devices.init(nil, @VMConfig);
      bx_cpu.init(nil);
      InitSystem;
      InitNames;
      InitFont;
      IsStarted := True;
      OriginalForm := BoundsRect;
      bx_cpu.reset(0);
      InitializeCriticalSection(FakeCS);
      InitializeCriticalSection(drawCS);
      InitializeCriticalSection(KeyCS);
      InitializeCriticalSection(MouseCS);
      StartEvent := CreateEvent(nil, False, False, nil);
      StartEmulation;
      finally
      StopEmulation;
      BoundsRect := OldSize;

      end;
  end;

procedure TfMain.WMPaint (var Msg: TWMPaint);
  var
    ps: PAINTSTRUCT;
    VideoDC, MemDC: HDC;
    OldObject: THandle;
  begin
    if IsStarted then
      begin
      EnterCriticalSection(DrawCS);
      VideoDC := BeginPaint(Self.Handle, ps);
      MemDC := CreateCompatibleDC(VideoDC);

      OldObject := SelectObject(MemDC, MemoryBitmap);

      StretchBlt(VideoDC, ps.rcPaint.left, ps.rcPaint.top, ps.rcPaint.right -
        ps.rcPaint.left + 1,
        ps.rcPaint.bottom - ps.rcPaint.top + 1, MemDC,
        ps.rcPaint.left div stretch_factor, ps.rcPaint.top div stretch_factor,
        (ps.rcPaint.right - ps.rcPaint.left + 1) div stretch_factor,
        (ps.rcPaint.bottom - ps.rcPaint.top + 1) div stretch_factor, SRCCOPY);

      SelectObject(MemDC, OldObject);

      DeleteDC(MemDC);
      EndPaint(Self.Handle, ps);
      leavecriticalsection(DrawCs);
      Msg.Result := 0;
      end
    else
      begin
      inherited;
      Msg.Result := 1;
      end;
  end;

{ TRunner }

procedure TfMain.StopEmulation;
  var
    _res: DWORD;
  begin
    stoprun := True;
    _res := WaitForSingleObject(StopEvent, MAX_TIME_WAIT);
    Invalidate;
    File1.Enabled := True;
    BoundsRect := OriginalForm;
    IsStarted  := False;
  end;

procedure TfMain.StopEmulation1Click (Sender: TObject);
  begin

    if not IsStarted then
      begin
      ShowMessage('Сначала запустите виртуальную машину');
      exit;
      end;
    StopEmulation;
  end;

procedure TfMain.WMKeyDown (var Msg: TWMKeyDown);
  begin
    if IsStarted then
      begin
      EnterCriticalSection(KeyCS);
      enq_key_event(HiWord(Msg.KeyData) and $01FF, BX_KEY_PRESSED);
      Msg.KeyData  := 0;
      Msg.CharCode := 0;
      leavecriticalsection(KeyCs);
      Msg.Result := 0;
      end
    else
      inherited;
  end;

procedure TfMain.WMKeyUp (var Msg: TWMKeyUp);
  begin
    if IsStarted then
      begin
      EnterCriticalSection(KeyCS);
      enq_key_event(HiWord(Msg.KeyData) and $01FF, BX_KEY_RELEASED);
      Msg.KeyData  := 0;
      Msg.CharCode := 0;
      leavecriticalsection(KeyCs);
      Msg.Result := 0;
      end
    else
      inherited;
  end;


procedure TfMain.CM_DIALOGKEY (var Message: TWMKey);
  begin
    if IsStarted and (((Message.KeyData shr 16) and $01FF) = 15) then
      begin

      // Kill Delphi TAB handler event 

      EnterCriticalSection(KeyCS);
      Message.KeyData := 0;
      Message.CharCode := 0;
      Message.Result := 0;
      leavecriticalsection(KeyCs);
      end
    else
      inherited;
  end;

procedure TfMain.WMSysKeyDown (var Msg: TWMSysKeyDown);
  begin
    if IsStarted then
      begin
      EnterCriticalSection(KeyCS);
      enq_key_event(HiWord(Msg.KeyData) and $01FF, BX_KEY_PRESSED);
      Msg.KeyData  := 0;
      Msg.CharCode := 0;
      leavecriticalsection(KeyCs);
      Msg.Result := 0;
      end
    else
      inherited;
  end;

procedure TfMain.WMSysKeyUp (var Msg: TWMSysKeyUp);
  begin
    if IsStarted then
      begin
      EnterCriticalSection(KeyCS);
      enq_key_event(HiWord(Msg.KeyData) and $01FF, BX_KEY_RELEASED);
      Msg.KeyData  := 0;
      Msg.CharCode := 0;
      leavecriticalsection(KeyCs);
      Msg.Result := 0;
      end
    else
      inherited;
  end;


procedure TfMain.WMChar (var Msg: TWMChar);
  begin
    if IsStarted then
      begin
      Msg.Result := 0;
      end
    else
      inherited;
  end;

procedure TfMain.ChangeConfiguration2Click (Sender: TObject);
  var
    CF: TConfigForm;
  begin

    CF := TConfigForm.Create(nil);
    CF.ShowModal;
    CF.Free;

  end;


procedure TfMain.WMMouseMouse (var Msg: TWMMouseMove);
  begin
    if MouseEnabled then
      processMouseXY(Msg.XPos, Msg.YPos, Msg.Keys, 0);
    inherited;
  end;

procedure TfMain.WMMouseDown (var Msg: TWMLButtonDown);
  begin
    if MouseEnabled then
      processMouseXY(Msg.XPos, Msg.YPos, Msg.Keys, 1);
    inherited;
  end;

procedure TfMain.WMMouseUp (var Msg: TWMLButtonUp);
  begin
    if MouseEnabled then
      processMouseXY(Msg.XPos, Msg.YPos, Msg.Keys, 1);
    inherited;
  end;

{ TMessageThread }

procedure TMessageThread.Execute;
  begin
    while not Application.Terminated do
      Synchronize(Application.ProcessMessages);
  end;

procedure TfMain.MainBarDrawPanel (StatusBar: TStatusBar; Panel: TStatusPanel;
  const Rect: TRect);
  begin
    if Panel.Index = 1 then
      begin
      if LedHddVisible then
        StatusBar.Canvas.Draw(Rect.Left, Rect.Top, THddOn)
      else
        StatusBar.Canvas.FillRect(Rect);
      end;
  end;

procedure TfMain.N13Click (Sender: TObject);
  var
    od: TOpenDialog;
  begin

    if not Assigned(bx_floppy) then
      exit;

    od := TOpenDialog.Create(nil);
    od.Filter := '*.img|*.img|*.iso|*.iso|*.ima|*.ima';

    if od.Execute then
      begin

      VMConfig.FloppyFile := od.FileName;
      SetConfiguration(@VMConfig);
      SaveVMConfig;
      bx_floppy.evaluate_media(vmconfig.FloppyType, PChar(vmconfig.FloppyFile),
        @bx_floppy.s.media[0]);
      bx_floppy.s.media_present[0] := 1;

      end;


    od.Free;

  end;

procedure TfMain.N15Click (Sender: TObject);

  var
    od: TOpenDialog;
  begin

    if (not Assigned(bx_hard_drive)) or (BX_CDROM_PRESENT <> 1) then
      exit;


    if bx_hard_drive.s[1].cdrom.ready <> 0 then
      begin
      ShowMessage('Сначала извлеките компакт-диск!');
      exit;
      end;

    od := TOpenDialog.Create(nil);
    od.Filter := '*.img|*.img|*.iso|*.iso|*.ima|*.ima';

    if od.Execute then
      begin

      VMConfig.CDFile := od.FileName;
      SetConfiguration(@VMConfig);
      SaveVMConfig;

      bx_hard_drive.s[1].cdrom.ready := 0;
      bx_hard_drive.s[1].cdrom.cd.eject_cdrom;

      if (BX_CD_STATE = True) then
        begin
        if (bx_hard_drive.s[1].cdrom.cd.insert_cdrom(BX_CD_FILEPATH)) then
          begin
          BX_INFO(('Компакт-диск присутствует'));
          bx_hard_drive.s[1].cdrom.ready := 1;
          bx_hard_drive.s[1].cdrom.capacity := bx_hard_drive.s[1].cdrom.cd.capacity();
          end
        else
          begin
          BX_INFO(('Компакт-диск не обнаружен'));
          bx_hard_drive.s[1].cdrom.ready := 0;
          //bx_options.cdromd.Oinserted^.set(BX_EJECTED);
          end;
        end;

      end;


    od.Free;

  end;

procedure TfMain.N16Click (Sender: TObject);
  begin

    if (not Assigned(bx_hard_drive)) or (BX_CDROM_PRESENT <> 1) then
      exit;

    bx_hard_drive.s[1].cdrom.ready := 0;
    bx_hard_drive.s[1].cdrom.cd.eject_cdrom;

  end;

procedure TfMain.N17Click (Sender: TObject);
  begin
    bx_floppy.s.media_present[0] := 0;
  end;

procedure TfMain.N2Click (Sender: TObject);
  begin
    ShowMessage('Эмулятор ПЭВМ ДОС Моза (версия 0.95)'#13#10'ДОС-адаптированный эмулятор персональной ЭВМ'#13#10'Автор ядра: Макс Бойди'#13#10'Доработка: А.Мясников');
  end;

procedure TfMain.N6Click (Sender: TObject);
  begin

    if isStarted then
      begin

      if VMConfig.HddFile <> '' then
        begin
        if CopyFile(PChar(VMConfig.HddFile), PChar(WorkDir + 'snaps\hdd.img'),
          False) then
          ShowMessage('Снимок успещно создан')
        else
          ShowMessage('Снимок не был создан!');
        end
      else
        begin
        ShowMessage('Диск не подключен!');
        end;

      end
    else
      ShowMessage('Машина не запущена!');

  end;

procedure TfMain.N7Click (Sender: TObject);
  begin

    if not isStarted then
      begin

      if VMConfig.HddFile <> '' then
        begin

        if FileExists(WorkDir + 'snaps\hdd.img') then
          begin
          if CopyFile(PChar(WorkDir + 'snaps\hdd.img'), PChar(VMConfig.HddFile),
            False) then
            ShowMessage('Диск успешно восстановлен')
          else
            ShowMessage('Диск не был восстановлен!');
          end
        else
          ShowMessage('Снимок не существует!');

        end
      else
        begin
        ShowMessage('Диск не подключен!');
        end;

      end
    else
      ShowMessage('Сначала остановите машину');

  end;

procedure TfMain.N8Click (Sender: TObject);
  begin

    if isStarted then
      begin

      if VMConfig.FloppyFile <> '' then
        begin
        if CopyFile(PChar(VMConfig.FloppyFile), PChar(WorkDir + 'snaps\fdd.img'),
          False) then
          ShowMessage('Снимок успешно создан')
        else
          ShowMessage('Снимок не был создан!');
        end
      else
        begin
        ShowMessage('Диск не подключен!');
        end;

      end
    else
      ShowMessage('Машина не запущена!');

  end;

procedure TfMain.N9Click (Sender: TObject);
  begin

    if not isStarted then
      begin

      if VMConfig.FloppyFile <> '' then
        begin

        if FileExists(WorkDir + 'snaps\fdd.img') then
          begin
          if CopyFile(PChar(WorkDir + 'snaps\fdd.img'),
            PChar(VMConfig.FloppyFile), False) then
            ShowMessage('Диск успещно восстановлен')
          else
            ShowMessage('Диск не был восстановлен!');
          end
        else
          ShowMessage('Снимок не существует!');

        end
      else
        begin
        ShowMessage('Диск не подключен!');
        end;

      end
    else
      ShowMessage('Сначала остановите машину');

  end;

procedure TfMain.CreateListItem (const AName: string);
  begin
  end;

procedure TfMain.LoadMenuEmuls;
  var
    T:  TSearchRec;
    _r: integer;
  begin
    _r := FindFirst(EmulDir + '\*.ini', faANyFile, T);
    while _r = 0 do
      begin
      CreateListItem(t.Name);
      _r := FindNext(T);
      end;
    FindClose(T);
  end;


procedure TfMain.Exit1Click (Sender: TObject);
  begin
    Close;
  end;

procedure TfMain.EnableMouse1Click (Sender: TObject);
  begin
    MouseEnabled := True;
  end;

end.
