[Pythianproject-cvsmail] CVS: PythianProject/Source/Conversation/GUI ConversationGUIComponents.pas,N

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/pythianproject/PythianProject/Source/Conversation/GUI
In directory usw-pr-cvs1:/tmp/cvs-serv23470/Conversation/GUI

Added Files:
	ConversationGUIComponents.pas GUIMockup.cfg GUIMockup.dof 
	GUIMockup.dpr GUIMockup.res StartupForm.dfm StartupForm.pas 
Log Message:
Adding conversation stuff -mike

--- NEW FILE ---
unit ConversationGUIComponents;

interface
uses Windows, Classes, Math, GLCanvas, vglClasses, Graphics, SysUtils, Trace;

type

  TvglConversationLogItem = record
    Name :string;
    Color :TColor;
    Content :string;
  end;
  TvglConversationLogItemList = array of TvglConversationLogItem;

  TvglConversationLog = class(TvglComponent)
  protected
    FText :TGLText; // for each line
    FLines :TvglConversationLogItemList;
    FLineSpacing: integer;
    FMaxLines: integer;
    function GetComponentType:string; override;
  public
    property Lines :TvglConversationLogItemList read FLines;
    property LineSpacing :integer read FLineSpacing write FLineSpacing;
    property MaxLines :integer read FMaxLines write FMaxLines;

    constructor Create(aName:string; AOwner:TvglComponent);
    destructor Destroy; override;
    procedure DrawSelf(where:TRect); override;

    procedure AddLine(aName,aContent:string; aColor:TColor);
  end;

  TvglConversationSelectEvent = procedure (Item:integer; Sender:TObject) of object;

  TvglConversationSelector = class(TvglComponent)
  protected
    FSkin :TGLBitmap;
    FText :TGLText;
    FOptions :TStringList;
    FOptionSpacing :integer;
    FOptionsButtonWidth :integer;
    FHighlightedItem :integer;

    FOnItemSelect: TvglConversationSelectEvent;

    function GetComponentType:string; override;
    procedure DoOnMouseMove(X, Y: Integer); override ;
    procedure DoOnMouseClick(x,y:integer); override ;

  public
    property Options :TStringList read FOptions;
    property OptionSpacing :integer read FOptionSpacing write FOptionSpacing;
    property HighlightedItem :integer read FHighlightedItem write FHighlightedItem;

    // called when a conversation object is selected
    property OnItemSelect :TvglConversationSelectEvent read FOnItemSelect write FOnItemSelect;

    constructor Create(aName:string; AOwner:TvglComponent);
    destructor Destroy; override;
    procedure DrawSelf(where:TRect); override;
  end;

implementation

{ TvglConversationLog }

procedure TvglConversationLog.AddLine(aName,aContent:string; aColor:TColor);
var i:TvglConversationLogItem;
    a:integer;
begin
  SetLength(Flines,Length(FLines)+1);
  i.Name := aName;
  i.Content := aContent;
  i.Color := aColor;
  FLines[Length(FLines)-1] := i;

  if Length(FLines) > MaxLines then
  begin
    // shift them all down by one, and then remove last item.
    for a := 0 to Length(FLines)-1 do
      FLines[a] := FLines[Min(a+1,Length(Flines)-1)];
    SetLength(FLines,Length(FLines)-1);
  end;
end;

constructor TvglConversationLog.Create(aName:string; AOwner: TvglComponent);
begin
  inherited Create(aName,AOwner);
  SetLength(FLines,0);
  LineSpacing := 12;

  FText := TGLText.Create('Arial8');
  MaxLines := 5;
end;

destructor TvglConversationLog.Destroy;
begin
  FText.Free;
  inherited;
end;

procedure TvglConversationLog.DrawSelf(where: TRect);
const Gap = 6;  // left hand border
var i,w:integer;
begin
  inherited DrawSelf(where);
  // discover longest line for name alignment
  w := 0;
  for i := 0 to Length(FLines)-1 do
  begin
    FText.Text := FLines[i].Name;
    if FText.Width[0] > w then w := FText.Width[0];
  end;
  for i := 0 to Length(FLines)-1 do
  begin
    FText.Text := FLines[i].Name+':';
    FText.SetColor(Flines[i].Color);

    Canvas.DrawText(where.left+Gap+w-FText.Width[0],where.top+(i*LineSpacing),FText);
    FText.Text := FLines[i].Content;
    FText.SetColor(clWhite);
    Canvas.DrawText(where.left+Gap+w,where.top+(i*LineSpacing),FText);
  end;
end;

function TvglConversationLog.GetComponentType: string;
begin
  Result := 'ConversationLog';
end;

{ TvglConversationSelector }

constructor TvglConversationSelector.Create(aName: string;
  AOwner: TvglComponent);
begin
  inherited Create(aName,aOwner);
  FSkin := TGLBitmap(Manager.GetResource(VGL_SKIN_1));
  FText := TGLText.Create('Arial8');
  FOptions := TStringList.Create;
  FOptionSpacing := 20;
  FOptionsButtonWidth := 90;
  HighlightedItem := 0; // no highlight
  FOnItemSelect := nil;
end;

destructor TvglConversationSelector.Destroy;
begin
  FSkin := nil;
  FOptions.Free;
  FText.Free;
  inherited;
end;

procedure TvglConversationSelector.DoOnMouseClick(x, y: integer);
var h:integer;
begin
  inherited DoOnMouseClick(x,y);

  if not assigned(FOnItemSelect) then exit;
  if not ((X >= Bounds.Left) and (X <= Bounds.Right) and (Y >= Bounds.Top) and (Y <= Bounds.Bottom)) then exit;

  if (Y - Bounds.Top) > 20 then
    h := (Y - Bounds.Top) div 20 // which item to highlight?
  else h := 0;

  TraceString(IntToStr(h));
  if (h > 0) and (h <= Options.Count) then
    FOnItemSelect(h,self);

end;

procedure TvglConversationSelector.DoOnMouseMove(X, Y: Integer);
begin
  inherited DoOnMouseMove(x,y);
  if not ((X >= Bounds.Left) and (X <= Bounds.Right) and (Y >= Bounds.Top) and (Y <= Bounds.Bottom)) then exit;

  if (Y - Bounds.Top) > 20 then
    HighlightedItem := (Y - Bounds.Top) div 20 // which item to highlight?
  else HighlightedItem := 0;
end;

procedure TvglConversationSelector.DrawSelf(where: TRect);
var i:integer;

  procedure Splat(x,y:integer);
  begin
    Canvas.DrawBitmapSubRect(x,y,VGL_SKINRECT_SMALLBUTTON1,FSkin);
  end;

  procedure SplatWithNum(x,y,n:integer);
  begin
    Splat(x,y);
    FText.SetColor(clWhite);
    FText.Text := IntToStr(n);
    Canvas.DrawText(x+3,y-3,FText);
  end;

begin
  inherited DrawSelf(where);
  // Draw top line and options button
  Canvas.Line(where.left,where.top+7,where.right - FOptionsButtonWidth,where.top+7);
  SplatWithNum(where.right - FOptionsButtonWidth + 5, where.top, 0 );
  FText.Text := 'Options';
  Canvas.DrawText(where.right - FOptionsButtonWidth + 20, where.top-3,FText);
  // Draw options
  for i := 0 to FOptions.Count-1 do
  begin
    SplatWithNum(where.left,where.top+ (OptionSpacing*(i+1)),i+1);
    FText.Text := FOptions[i];
    if HighlightedItem-1 = i then
      FText.SetColor(clYellow)
    else FText.SetColor(clWhite);
    Canvas.DrawText(where.left+20,where.top+ (OptionSpacing*(i+1)) - 3, FText);
  end;
end;

function TvglConversationSelector.GetComponentType: string;
begin
  Result := 'ConversationSelector';
end;

end.

--- NEW FILE ---
-$A+
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-E..\..\..\Bin
-LNe:\program files\borland\delphi4\Lib
-U..\..\VGL;..\..\GLCanvas;..\..\Units;..\..\Textures
-O..\..\VGL;..\..\GLCanvas;..\..\Units;..\..\Textures
-I..\..\VGL;..\..\GLCanvas;..\..\Units;..\..\Textures
-R..\..\VGL;..\..\GLCanvas;..\..\Units;..\..\Textures

--- NEW FILE ---
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;

[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=

[Directories]
OutputDir=..\..\..\Bin
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=..\..\VGL;..\..\GLCanvas;..\..\Units;..\..\Textures
Packages=VCL40;VCLX40;VCLDB40;VCLDBX40;VCLSMP40;QRPT40;TEEUI40;TEEDB40;TEE40;ibevnt40;nmfast40;TreeNTControl;glPanelPkg
Conditionals=
DebugSourceDirs=
UsePackages=0

[Parameters]
RunParams=
HostApplication=

[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=2057
CodePage=1252

[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=

[Excluded Packages]
E:\cvs\pythianproject\Prototypes\AI\Flocking\Flocking.bpl=RiverSoftAVG Flocking Components

[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;

[HistoryLists\hlSearchPath]
Count=3
Item0=..\..\VGL;..\..\GLCanvas;..\..\Units;..\..\Textures
Item1=..\Units;..\GLForm;..\GLCanvas;..\Textures
Item2=..\Units;..\GLForm;..\GLCanvas

[HistoryLists\hlOutputDirectorry]
Count=7
Item0=..\..\..\Bin
Item1=E:\cvs\pythianproject-openave\PythianProject\Bin
Item2=E:\cvs\pythianproject\PythianProject\Bin
Item3=E:\cvs\pythianproject-\PythianProject\Bin
Item4=..\..\Bin
Item5=.\..\..\Bin
Item6="..\..\Bin"

--- NEW FILE ---
program GUIMockup;

uses
  Forms,
  StartupForm in 'StartupForm.pas' {Form1},
  ConversationGUIComponents in 'ConversationGUIComponents.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

--- NEW FILE ---

--- NEW FILE ---
ÿ

Font.ColorclWindowTextFont.Heightõ	Font.Name
MS Sans Serif
Font.Style
TextHeight
--- NEW FILE ---
unit StartupForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, GLForms, GLCanvas, OpenGL, vglClasses, vglStdCtrls, vglEdits,
  vglAnimatedImage, DeviceModes, Trace, ConversationGUIComponents;

{$DEFINE DEVELOPMENT}

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }

    GLForm :TGLForm;
    InterfaceManager :TvglInterfaceManager;
    GLC: TGLCanvas;
    Wallpaper :TvglImage;

    ConvLog :TvglConversationLog;
    ConvSelector :TvglConversationSelector;

    Elapsed,FirstTime:Cardinal;
  public
    { Public declarations }
    procedure Go;

    procedure OnItemSelect(Item:integer; Sender:TObject);

    procedure GLFormPaint(Sender:TObject);
    procedure GLKeypress(Sender: TObject; KeyCode, KeyData: LongInt;
              ButtonState: TButtonState; Modifiers: TKBModifiers);
    procedure GLMouseMove(Sender: TObject; X, Y: Integer;
              Modifiers: TKBModifiers);
    procedure GLMousebutton(Sender: TObject; Button: TMouseButton;
              X, Y: Integer; ButtonState: TButtonState;
              Modifiers: TKBModifiers);
  end;

var
  Form1: TForm1;

function timeGetTime: Cardinal; external 'winmm.dll' name 'timeGetTime';

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  go;
end;

procedure TForm1.GLFormPaint(Sender: TObject);
begin
  glClear(GL_DEPTH_BUFFER_BIT);
  Elapsed := timeGetTime - FirstTime; // elapsed time from beginning - GLForm.Run
  InterfaceManager.Update(Elapsed);
  InterfaceManager.DrawAll;
end;

procedure TForm1.GLKeypress(Sender: TObject; KeyCode, KeyData: Integer;
  ButtonState: TButtonState; Modifiers: TKBModifiers);
begin
  if keycode = vk_escape then DestroyWindow(GLForm.Handle)
  else begin
    case ButtonState of
      bsUp: InterfaceManager.KeyUp(KeyCode, KeyData);
      bsDown: InterfaceManager.KeyDown(KeyCode, KeyData);
    end;
  end;
end;

procedure TForm1.GLMousebutton(Sender: TObject; Button: TMouseButton; X,
  Y: Integer; ButtonState: TButtonState; Modifiers: TKBModifiers);
begin
  case Button of
    mbLeft: if ButtonState = bsUp then InterfaceManager.MouseUp(VGL_MOUSE_LEFT,X,Y) else InterfaceManager.MouseDown(VGL_MOUSE_LEFT,X,Y);
    mbRight: if ButtonState = bsUp then InterfaceManager.MouseUp(VGL_MOUSE_RIGHT,X,Y) else InterfaceManager.MouseDown(VGL_MOUSE_RIGHT,X,Y);
  end;
end;

procedure TForm1.GLMouseMove(Sender: TObject; X, Y: Integer;
  Modifiers: TKBModifiers);
begin
  InterfaceManager.MouseMove(X,Y);
end;

procedure TForm1.Go;
begin
  // Begin initialization of GUI
  GetDeviceModes;
  GLForm := TGLForm.Create;
  GLForm.FullScreen := True;
  GLForm.SetBounds(0,0,640,480);
  GLForm.DeviceMode := FindMode(640,480,16);
  GLForm.Caption := 'Conversation Demo v1';
  GLForm.OnPaint := GLFormPaint;
  GLForm.OnKeyPress := GLKeypress;
  GLForm.OnMouseButton := GLMousebutton;
  GLForm.OnMouseMove := GLMouseMove;
  GLForm.ShowFPS := true;
  // run the program
  GLForm.Open;

  {$IFDEF DEVELOPMENT}
  VGL_DATADIR := 'data\gui\';
  FontsDirectory := 'data\gui\';
  {$ENDIF}

  VGL_SKIN_1 := VGL_DATADIR + 'skin1.png';
  VGL_SKIN_2 := VGL_DATADIR + 'newskin-background.png';

  if not GLForm.FullScreen then
    GLC := TGLCanvas.Create(GLForm.Width-6,GLForm.Height-25) // must take into account window borders
  else
    GLC := TGLCanvas.Create(638,478);

  InterfaceManager := TvglInterfaceManager.Create(GLForm.Handle, GLC);

  // Create components
  Wallpaper := TvglImage.Create('Wallpaper',InterfaceManager.Desktop);
  Wallpaper.Bounds := Rect(0,0,640,480);
  Wallpaper.LoadImage('data\gui\ConversationGUIMockupBackground.png');

  ConvLog := TvglConversationLog.Create('ConvLog',InterfaceManager.Desktop);
  ConvLog.Bounds := Rect(10,10,630,100);
  ConvLog.AddLine('Player','Who is that fox?',clRed);
  ConvLog.AddLine('Mike','Nelly Furtardo  - she is a goddess',clAqua);

  ConvSelector := TvglConversationSelector.Create('ConvSelector',InterfaceManager.Desktop);
  ConvSelector.Bounds := Rect(10,370,630,470);
  ConvSelector.Options.Add('Yes, I agree, Nelly totally rocks');
  ConvSelector.Options.Add('As always Mike you are totally correct.');
  ConvSelector.Options.Add('Indeed, I went to worship her at Bargain CD Basement only the other day!');
  ConvSelector.OnItemSelect := OnItemSelect; 

  Hide;
  ShowCursor(false);
  FirstTime := timeGetTime;
  GLForm.Run;
  ShowCursor(true);

  // clear up
  GLForm.Close;
  GLForm.Free;
  InterfaceManager.Free;
  Close;
end;

procedure TForm1.OnItemSelect(Item: integer; Sender: TObject);
begin
  ConvLog.AddLine('Player',ConvSelector.Options[item-1],clRed);
  ConvLog.AddLine('Mike','So what are you waiting for - go and buy her album!',clAqua);
end;

end.

[Pythianproject-cvsmail] CVS: PythianProject/Source/Conversation/GUI ConversationGUIComponents.pas,N

[Pythianproject-cvsmail] CVS: PythianProject/Source/Conversation/GUI ConversationGUIComponents.pas,NONE,1.1 GUIMockup.cfg,NONE,1.1 GUIMockup.dof,NONE,1.1 GUIMockup.dpr,NONE,1.1 GUIMockup.res,NONE,1.1 StartupForm.dfm,NONE,1.1 StartupForm.pas,NONE,1.1