observerlog.pas

一个不出名的GBA模拟器

//////////////////////////////////////////////////////////////////////
//                                                                  //
// observerLog.pas: Log viewer                                      //
//                                                                  //
// The contents of this file are subject to the Bottled Light       //
// Public License Version 1.0 (the "License"); you may not use this //
// file except in compliance with the License. You may obtain a     //
// copy of the License at http://www.bottledlight.com/BLPL/         //
//                                                                  //
// Software distributed under the License is distributed on an      //
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or   //
// implied. See the License for the specific language governing     //
// rights and limitations under the License.                        //
//                                                                  //
// The Original Code is the Mappy VM User Interface, released       //
// April 1st, 2003. The Initial Developer of the Original Code is   //
// Bottled Light, Inc. Portions created by Bottled Light, Inc. are  //
// Copyright (C) 2001-2003 Bottled Light, Inc. All Rights Reserved. //
//                                                                  //
// Author(s):                                                       //
//   Michael Noland (joat), [e-mail]                //
//                                                                  //
// Changelog:                                                       //
//   1.0: First public release (April 1st, 2003)                    //
//                                                                  //
// Notes:                                                           //
//   None at present.                                               //
//                                                                  //
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
unit observerLog; ////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
interface ////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ImgList, ExtCtrls, Math, IniFiles, SynEdit,
  Menus, cpuObservers, console, nexus;

//////////////////////////////////////////////////////////////////////

type
  TjdevLog = class(TCpuObserver)
    logDisp: TSynEdit;
    scrollbar: TScrollBar;
    popupMenu: TPopupMenu;
    mClearConsole: TMenuItem;
    mSaveToFile: TMenuItem;
    N1: TMenuItem;
    mChangeFont: TMenuItem;
    fontDialog: TFontDialog;
    panel: TPanel;
    bTools: TButton;
    command: TEdit;
    saveDialog: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ClearLog(Sender: TObject);
    procedure commandKeyPress(Sender: TObject; var Key: Char);
    procedure commandKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure scrollbarChange(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure SaveLogToFile(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    procedure logDispEnter(Sender: TObject);
    procedure ChangeFont(Sender: TObject);
    procedure ShowMenu(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    amUpdating: boolean;
    commandHistory: TStringList;
    wasFollowing: boolean;
    historyPos: integer;
    fontString: string;
    procedure ConsoleCallback(newLines: integer);
  public
    procedure UpdateObserver; override;
    class function OCaption: string; override;
    procedure LoadSettings(ini: TIniFile); override;
    procedure SaveSettings(ini: TIniFile); override;
  end;

//////////////////////////////////////////////////////////////////////

var
  jdevLog: TjdevLog;

//////////////////////////////////////////////////////////////////////
implementation ///////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

{$R *.DFM}

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.FormCreate(Sender: TObject);
begin
  HelpContext := LinkHelp('console.html');

  amUpdating := false;
  command.Align := alClient;
  bTools.Align := alRight;
  wasFollowing := true;
  console.logSetCallback(ConsoleCallback);

  // Set up the command history
  commandHistory := TStringList.Create;
  historyPos := 0;
  commandHistory.Add('');
  logDisp.DoubleBuffered := true;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.FormDestroy(Sender: TObject);
begin
  commandHistory.Free;
  console.logSetCallback(nil);
end;

//////////////////////////////////////////////////////////////////////

class function TjdevLog.OCaption: string;
begin
  Result := 'Console';
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.UpdateObserver;
var
  i: integer;
begin
  if not amUpdating then begin
    amUpdating := true;

    i := Max(1, logDisp.LinesInWindow-1);
    scrollbar.Max := MaxInt;
    scrollbar.Min := Min(i, logNumEntries);
    scrollbar.Max := logNumEntries;
    scrollBar.LargeChange := logDisp.LinesInWindow - 1;
    if wasFollowing then scrollbar.Position := scrollbar.Max;

    logDisp.Lines.Clear;
    logGetEntries(scrollbar.Position, i, logDisp.lines);

    amUpdating := false;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.ClearLog(Sender: TObject);
begin
  logProcessCommand('clear');
  UpdateObserver;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.commandKeyPress(Sender: TObject; var Key: Char);
begin
  if (key = #10) or (key = #13) then begin
    // Process the command
    logProcessCommand(command.Text);
    if (command.Text <> commandHistory.Strings[historyPos]) then begin
      historyPos := commandHistory.Add(command.Text);
      if commandHistory.Count = 11 then commandHistory.Delete(0);
    end;

    command.Text := '';
    Key := Chr(08);
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.ConsoleCallback(newLines: integer);
begin
  UpdateObserver;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.commandKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_F3: command.Text := commandHistory.Strings[historyPos];
    VK_UP: begin
      historyPos := Max(historyPos-1, 0);
      command.Text := commandHistory.Strings[historyPos];
    end;
    VK_DOWN: begin
      historyPos := Min(historyPos+1, commandHistory.Count-1);
      command.Text := commandHistory.Strings[historyPos];
    end;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.scrollbarChange(Sender: TObject);
begin
  if not amUpdating then begin
    wasFollowing := scrollbar.Position = scrollbar.Max;
    UpdateObserver;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.FormResize(Sender: TObject);
begin
  UpdateObserver;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.SaveLogToFile(Sender: TObject);
begin
  saveDialog.Filter := 'Log Files|*.log;*.txt|All Files|*.*';
  saveDialog.DefaultExt := 'log';
  if saveDialog.Execute then logSaveLog(saveDialog.FileName);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_PRIOR: scrollbar.Position := Max(scrollbar.Position-scrollBar.LargeChange, scrollbar.Min);
    VK_NEXT: scrollbar.Position := Min(scrollbar.Position+scrollBar.LargeChange, scrollbar.Max);
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  scrollbar.Position := Min(scrollbar.Position+1, scrollbar.Max);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
   scrollbar.Position := Max(scrollbar.Position-1, scrollbar.Min);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.logDispEnter(Sender: TObject);
begin
//  ActiveControl := command;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.ChangeFont(Sender: TObject);
begin
  if fontString <> '' then StringToFont(fontString, fontDialog.Font);
  if fontDialog.Execute then begin
    fontString := FontToString(fontDialog.Font);
    if fontString <> '' then StringToFont(fontString, Font);
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.ShowMenu(Sender: TObject);
var
  mouse: TPoint;
begin
  GetCursorPos(mouse);
  popupMenu.Popup(mouse.x, mouse.y);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.LoadSettings(ini: TIniFile);
begin
  inherited;
  fontString := ini.ReadString(OCaption, 'Font', '');
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.SaveSettings(ini: TIniFile);
begin
  inherited;
  ini.WriteString(OCaption, 'Font', fontString);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevLog.FormShow(Sender: TObject);
begin
  if fontString <> '' then StringToFont(fontString, Font);

  // Load the translation
  LoadTranslation(self, translation);
end;

//////////////////////////////////////////////////////////////////////

initialization
  RegisterViewer(TjdevLog);
end.

//////////////////////////////////////////////////////////////////////