Apus.Engine.MessageScene.pas

// -----------------------------------------------------
// Apus.Engine.MessageScene — modal message dialogs.
//
// Provides ShowMessage, Ask, and Confirm dialogs rendered
// as overlay scenes. Fires signal events on user response.
//
// Copyright (C) 2004 Ivan Polyacov, Apus Software (ivan@apus-software.com)
// This file is licensed under the terms of BSD-3 license (see license.txt)
// This file is a part of the Apus Game Engine (http://apus-software.com/engine/)
// -----------------------------------------------------
unit Apus.Engine.MessageScene;
interface
 uses Apus.Core;

 var
  msgMainFont:cardinal; // regular font for text and buttons (0 - use inherited or default)
  msgTitleFont:cardinal; // large font for message title (0 - use inherited or default)

 procedure InitMessageScene;
 // mes format: [Title]<CRLF>line1<CRLF>line2...lineN
 // String separator: CRLF or '~'
 procedure ShowMessage(mes:String8;OkEvent:String8='';x:integer=0;y:integer=0);
 procedure Ask(mes,YesEvent:String8;NoEvent:String8='';x:integer=0;y:integer=0);
 procedure Confirm(mes,OkEvent,CancelEvent:String8;x:integer=0;y:integer=0);

implementation
 uses Types, Apus.EventMan, Apus.Lib, Apus.Strings,
   Apus.Engine.API, Apus.Engine.UIRender, Apus.Engine.UITypes, Apus.Engine.UI,
   Apus.Engine.UIShapes, Apus.Engine.UIScene, Apus.Engine.SceneEffects;

 const
  MODE_MSG = 1;
  MODE_ASK = 2;
  MODE_CONFIRM = 3;

 type
  TMessageScene=class(TUIScene)
   wnd:TUIElement;
   btnOk,btnYes,btnNo:TUIButton;
   title:String8;
   lines:Strings8;
   constructor Create;
   procedure UpdateUI(msgText:string8;mode,x,y:integer);
   procedure Render; override;
  end;

  TQueuedMessage=class
   mType:integer;
   msg,event1,event2:String8;
   x,y:integer;
  end;

var
 scene:TMessageScene;
 queue:TObjectQueue;
 curMsg:TQueuedMessage;

 procedure DPIChangedHandler(event:TEventStr;tag:TTag); forward;

 procedure InitMessageScene;
  begin
   queue.Init(64);
   scene:=TMessageScene.Create;
   SetEventHandler('ENGINE\DPICHANGED\DONE',DPIChangedHandler,emInstant);
  end;

 procedure QueueMsg(msg,e1,e2:String8;mType,x,y:integer);
  var
   obj:TQueuedMessage;
  begin
   obj:=TQueuedMessage.Create;
   obj.mType:=mType;
   obj.msg:=msg;
   obj.event1:=e1;
   obj.event2:=e2;
   obj.x:=x;
   obj.y:=y;
   queue.Add(obj);
  end;

 // Process next queued message if the scene is not currently active.
 procedure CheckQueue;
  begin
   if scene.IsActive then exit;
   if curMsg<>nil then curMsg.Free;
   curMsg:=TQueuedMessage(queue.Get);
   if curMsg=nil then exit;
   // Build UI for current message.
   with curMsg do
    scene.UpdateUI(msg,mType,x,y);
   // Show with transition effect.
   Log.Msg('ShowMessage: '+curMsg.msg);
   TShowWindowEffect.Create(scene,200,sweShowModal,2);
  end;

 procedure ShowMessage(mes:String8;OkEvent:String8='';x:integer=0;y:integer=0);
  begin
   QueueMsg(mes,okEvent,'',MODE_MSG,x,y);
   CheckQueue;
  end;

 procedure Ask(mes,YesEvent,NoEvent:String8;x:integer;y:integer);
  begin
   QueueMsg(mes,YesEvent,NoEvent,MODE_ASK,x,y);
   CheckQueue;
  end;

 procedure Confirm(mes,OkEvent,CancelEvent:String8;x:integer=0;y:integer=0);
  begin
   QueueMsg(mes,OkEvent,CancelEvent,MODE_CONFIRM,x,y);
   CheckQueue;
  end;

 // UI\Message
 // Scene\MessageScene
 procedure EventHandler(event:TEventStr;tag:TTag);
  var
   close:boolean;
  begin
   if event.Same('UI\Message\Next') then begin
    CheckQueue;
    exit;
   end;

   close:=false;
   if (event.Same('Scene\MessageScene\KEYDOWN') and (TKey(tag and $FF)=TKey.Enter)) or
      (event.Same('UI\Message\OK\OnClick') or
       event.Same('UI\Message\YES\OnClick')) then begin
    if curMsg.event1<>'' then Signal(curMsg.event1);
    close:=true;
   end;

   if (event.Same('Scene\MessageScene\KEYDOWN') and (TKey(tag and $FF)=TKey.Escape)) or
       event.Same('UI\Message\NO\OnClick') then begin
    if curMsg.event2<>'' then Signal(curMsg.event2);
    close:=true;
   end;

   if close then begin
    TShowWindowEffect.Create(scene,150,sweHide,2);
    DelayedSignal('UI\Message\Next',200);
   end;
  end;

 procedure DPIChangedHandler(event:TEventStr;tag:TTag);
  begin
   if scene=nil then exit;
   if window=nil then exit;
   window.Lock;
   try
    if (curMsg<>nil) and scene.IsActive then
     scene.UpdateUI(curMsg.msg,curMsg.mType,curMsg.x,curMsg.y);
   finally
    window.Unlock;
   end;
  end;

{ TMessageScene }

constructor TMessageScene.Create;
 begin
  inherited Create('MessageScene',false);
  frequency:=20;
  zOrder:=100;
  SetEventHandler('UI\Message',EventHandler,emQueued);
  SetEventHandler('Scene\MessageScene',EventHandler,emMixed);

  wnd:=TUIElement.Create(400,200,ui,'Message\Wnd');
  wnd.SetPos(window.renderWidth/2,window.renderHeight/2,pivotCenter);
  wnd.shape:=shapeFull;
  wnd.flags.manualDraw:=true;
  wnd.styleInfo:='border:FFD0D8E0; radius:8; fill:C0C0C8D0';

  btnOk:=TUIButton.Create(90,35,wnd,'Message\OK').Setup('Ok');
  btnOk.SetPos(200,165,pivotCenter).SetAnchors(0.5,1,0.5,1);

  btnYes:=TUIButton.Create(90,35,wnd,'Message\YES').Setup('Yes');
  btnYes.SetPos(200-70,165,pivotCenter).SetAnchors(0.5,1,0.5,1);

  btnNo:=TUIButton.Create(90,35,wnd,'Message\NO').Setup('No');
  btnNo.SetPos(200+70,165,pivotCenter).SetAnchors(0.5,1,0.5,1);
 end;

// Update scene with new text and buttons
procedure TMessageScene.UpdateUI(msgText:string8;mode,x,y:integer);
 var
  i,width,height:integer;
 begin
  msgText:=msgText.ReplaceAll('~',#13);
  msgText:=msgText.ReplaceAll(#10,'');
  lines:=msgText.Split(#13);
  if (length(lines)>0) and lines[0].StartsWith('[') and lines[0].EndsWith(']') then begin
   title:=lines[0];
   title:=copy(title,2,length(title)-2);
   lines.Delete(0);
  end else
   title:='';

  width:=300;
  if title<>'' then width:=Max(width,txt.Width(msgTitleFont,title));
  for i:=0 to high(lines) do
   width:=Max(width,txt.Width(msgMainFont,lines[i]));

  inc(width,100);
  height:=120+30*length(lines)+40*byte(title<>'');

  wnd.Resize(width,height);

  btnOk.flags.visible:=(mode=MODE_MSG);
  btnYes.flags.visible:=(mode in [MODE_ASK,MODE_CONFIRM]);
  btnNo.flags.visible:=(mode in [MODE_ASK,MODE_CONFIRM]);

  if mode=MODE_ASK then begin
   btnYes.caption:='Yes';
   btnNo.caption:='No';
  end;
  if mode=MODE_CONFIRM then begin
   btnYes.caption:='Ok';
   btnNo.caption:='Cancel';
  end;

  if (x>0) or (y>0) then begin
   wnd.position.x:=x;
   wnd.position.y:=y;
  end else
   wnd.Center;
 end;

procedure TMessageScene.Render;
 var
  r:TRect;
  i,x,y:integer;
 begin
  // Draw background
  r:=wnd.GetPosOnScreen;
  DrawManualUI(wnd);

  // Draw content
  x:=r.CenterPoint.X;
  y:=r.Top+40;
  if title<>'' then begin
   txt.Write(msgTitleFont,x,y,$FF402000,title,TTextAlignment.taCenter);
   inc(y,40);
  end else
   inc(y,8);

  for i:=0 to high(lines) do begin
   txt.Write(msgMainFont,x,y,$FF202020,lines[i],TTextAlignment.taCenter);
   inc(y,30);
  end;
  // Buttons and child elements
  inherited;
 end;

end.