DEADSOFTWARE

added common file with compiler flags; cosmetic fix in g_monsters.pas
[d2df-sdl.git] / src / game / g_gui.pas
index 22cb48d1e4317c46a4f39adcb2f98115741d8ded..ca49c711d8e7107ecda7cf0784dd8f62cfc7c9de 100644 (file)
@@ -13,7 +13,7 @@
  * You should have received a copy of the GNU General Public License
  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  *)
-{$MODE DELPHI}
+{$INCLUDE g_amodes.inc}
 unit g_gui;
 
 interface
@@ -115,17 +115,22 @@ type
     FWindow : TGUIWindow;
     FName: string;
     FUserData: Pointer;
+    FRightAlign: Boolean; //HACK! this works only for "normal" menus, only for menu text labels, and generally sux. sorry.
+    FMaxWidth: Integer; //HACK! used for right-aligning labels
   public
     constructor Create;
     procedure OnMessage(var Msg: TMessage); virtual;
     procedure Update; virtual;
     procedure Draw; virtual;
+    function GetWidth(): Integer; virtual;
+    function GetHeight(): Integer; virtual;
     function WantActivationKey (key: LongInt): Boolean; virtual;
     property X: Integer read FX write FX;
     property Y: Integer read FY write FY;
     property Enabled: Boolean read FEnabled write FEnabled;
     property Name: string read FName write FName;
     property UserData: Pointer read FUserData write FUserData;
+    property RightAlign: Boolean read FRightAlign write FRightAlign; // for menu
   end;
 
   TGUIWindow = class
@@ -177,8 +182,8 @@ type
     procedure OnMessage(var Msg: TMessage); override;
     procedure Update(); override;
     procedure Draw(); override;
-    function GetWidth(): Integer;
-    function GetHeight(): Integer;
+    function GetWidth(): Integer; override;
+    function GetHeight(): Integer; override;
     procedure Click(Silent: Boolean = False);
     property Caption: string read FText write FText;
     property Color: TRGB read FColor write FColor;
@@ -197,8 +202,8 @@ type
     constructor Create(Text: string; FontID: DWORD);
     procedure OnMessage(var Msg: TMessage); override;
     procedure Draw; override;
-    function GetWidth: Integer;
-    function GetHeight: Integer;
+    function GetWidth: Integer; override;
+    function GetHeight: Integer; override;
     property OnClick: TOnClickEvent read FOnClickEvent write FOnClickEvent;
     property FixedLength: Word read FFixedLen write FFixedLen;
     property Text: string read FText write FText;
@@ -221,7 +226,7 @@ type
     procedure OnMessage(var Msg: TMessage); override;
     procedure Update; override;
     procedure Draw; override;
-    function GetWidth(): Word;
+    function GetWidth(): Integer; override;
     property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
     property Max: Word read FMax write FMax;
     property Value: Integer read FValue write FSetValue;
@@ -240,7 +245,7 @@ type
     procedure AddItem(Item: string);
     procedure Update; override;
     procedure Draw; override;
-    function GetWidth(): Word;
+    function GetWidth(): Integer; override;
     function GetText: string;
     property ItemIndex: Integer read FIndex write FIndex;
     property Color: TRGB read FColor write FColor;
@@ -268,7 +273,7 @@ type
     procedure OnMessage(var Msg: TMessage); override;
     procedure Update; override;
     procedure Draw; override;
-    function GetWidth(): Word;
+    function GetWidth(): Integer; override;
     property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
     property OnEnter: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent;
     property Width: Word read FWidth write FWidth;
@@ -289,13 +294,35 @@ type
     constructor Create(FontID: DWORD);
     procedure OnMessage(var Msg: TMessage); override;
     procedure Draw; override;
-    function GetWidth(): Word;
+    function GetWidth(): Integer; override;
     function WantActivationKey (key: LongInt): Boolean; override;
     property Key: Word read FKey write FKey;
     property Color: TRGB read FColor write FColor;
     property Font: TFont read FFont write FFont;
   end;
 
+  // can hold two keys
+  TGUIKeyRead2 = class(TGUIControl)
+  private
+    FFont: TFont;
+    FFontID: DWORD;
+    FColor: TRGB;
+    FKey0, FKey1: Word; // this should be an array. sorry.
+    FKeyIdx: Integer;
+    FIsQuery: Boolean;
+    FMaxKeyNameWdt: Integer;
+  public
+    constructor Create(FontID: DWORD);
+    procedure OnMessage(var Msg: TMessage); override;
+    procedure Draw; override;
+    function GetWidth(): Integer; override;
+    function WantActivationKey (key: LongInt): Boolean; override;
+    property Key0: Word read FKey0 write FKey0;
+    property Key1: Word read FKey1 write FKey1;
+    property Color: TRGB read FColor write FColor;
+    property Font: TFont read FFont write FFont;
+  end;
+
   TGUIModelView = class(TGUIControl)
   private
     FModel: TPlayerModel;
@@ -374,8 +401,8 @@ type
     procedure AddItem(Item: String);
     procedure SelectItem(Item: String);
     procedure Clear();
-    function  GetWidth(): Word;
-    function  GetHeight(): Word;
+    function  GetWidth(): Integer; override;
+    function  GetHeight(): Integer; override;
     function  SelectedItem(): String;
 
     property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent;
@@ -424,8 +451,8 @@ type
     procedure OnMessage(var Msg: TMessage); override;
     procedure Draw; override;
     procedure Clear;
-    function GetWidth(): Word;
-    function GetHeight(): Word;
+    function GetWidth(): Integer; override;
+    function GetHeight(): Integer; override;
     procedure SetText(Text: string);
     property DrawBack: Boolean read FDrawBack write FDrawBack;
     property DrawScrollBar: Boolean read FDrawScroll write FDrawScroll;
@@ -487,6 +514,7 @@ type
     function AddSwitch(fText: string): TGUISwitch;
     function AddEdit(fText: string): TGUIEdit;
     function AddKeyRead(fText: string): TGUIKeyRead;
+    function AddKeyRead2(fText: string): TGUIKeyRead2;
     function AddList(fText: string; Width, Height: Word): TGUIListBox;
     function AddFileList(fText: string; Width, Height: Word): TGUIFileListBox;
     function AddMemo(fText: string; Width, Height: Word): TGUIMemo;
@@ -834,6 +862,8 @@ begin
   FY := 0;
 
   FEnabled := True;
+  FRightAlign := false;
+  FMaxWidth := -1;
 end;
 
 procedure TGUIControl.OnMessage(var Msg: TMessage);
@@ -855,6 +885,16 @@ begin
   result := false;
 end;
 
+function TGUIControl.GetWidth(): Integer;
+begin
+  result := 0;
+end;
+
+function TGUIControl.GetHeight(): Integer;
+begin
+  result := 0;
+end;
+
 { TGUITextButton }
 
 procedure TGUITextButton.Click(Silent: Boolean = False);
@@ -1182,8 +1222,18 @@ begin
 end;
 
 procedure TGUILabel.Draw;
+var
+  w, h: Word;
 begin
-  FFont.Draw(FX, FY, FText, FColor.R, FColor.G, FColor.B);
+  if RightAlign then
+  begin
+    FFont.GetTextSize(FText, w, h);
+    FFont.Draw(FX+FMaxWidth-w, FY, FText, FColor.R, FColor.G, FColor.B);
+  end
+  else
+  begin
+    FFont.Draw(FX, FY, FText, FColor.R, FColor.G, FColor.B);
+  end;
 end;
 
 function TGUILabel.GetHeight: Integer;
@@ -1373,6 +1423,11 @@ begin
     begin
       x := FItems[FIndex].Text.FX;
       y := FItems[FIndex].Text.FY;
+      //HACK!
+      if FItems[FIndex].Text.RightAlign then
+      begin
+        x := x+FItems[FIndex].Text.FMaxWidth-FItems[FIndex].Text.GetWidth;
+      end;
     end
     else if FItems[FIndex].Control <> nil then
     begin
@@ -1540,10 +1595,27 @@ end;
 procedure TGUIMenu.ReAlign();
 var
   a, tx, cx, w, h: Integer;
+  cww: array of Integer; // cached widths
+  maxcww: Integer;
 begin
   if FItems = nil then Exit;
 
-  if not FAlign then tx := FLeft else
+  SetLength(cww, length(FItems));
+  maxcww := 0;
+  for a := 0 to High(FItems) do
+  begin
+    if FItems[a].Text <> nil then
+    begin
+      cww[a] := FItems[a].Text.GetWidth;
+      if maxcww < cww[a] then maxcww := cww[a];
+    end;
+  end;
+
+  if not FAlign then
+  begin
+    tx := FLeft;
+  end
+  else
   begin
     tx := gScreenWidth;
     for a := 0 to High(FItems) do
@@ -1553,27 +1625,17 @@ begin
       if FItems[a].Control <> nil then
       begin
         w := w+MENU_HSPACE;
-
-        if FItems[a].ControlType = TGUILabel then
-          w := w+(FItems[a].Control as TGUILabel).GetWidth
-        else if FItems[a].ControlType = TGUITextButton then
-          w := w+(FItems[a].Control as TGUITextButton).GetWidth
-        else if FItems[a].ControlType = TGUIScroll then
-          w := w+(FItems[a].Control as TGUIScroll).GetWidth
-        else if FItems[a].ControlType = TGUISwitch then
-          w := w+(FItems[a].Control as TGUISwitch).GetWidth
-        else if FItems[a].ControlType = TGUIEdit then
-          w := w+(FItems[a].Control as TGUIEdit).GetWidth
-        else if FItems[a].ControlType = TGUIKeyRead then
-          w := w+(FItems[a].Control as TGUIKeyRead).GetWidth
-        else if (FItems[a].ControlType = TGUIListBox) then
-          w := w+(FItems[a].Control as TGUIListBox).GetWidth
-        else if (FItems[a].ControlType = TGUIFileListBox) then
-          w := w+(FItems[a].Control as TGUIFileListBox).GetWidth
-        else if FItems[a].ControlType = TGUIMemo then
-          w := w+(FItems[a].Control as TGUIMemo).GetWidth;
+             if FItems[a].ControlType = TGUILabel then w := w+(FItems[a].Control as TGUILabel).GetWidth
+        else if FItems[a].ControlType = TGUITextButton then w := w+(FItems[a].Control as TGUITextButton).GetWidth
+        else if FItems[a].ControlType = TGUIScroll then w := w+(FItems[a].Control as TGUIScroll).GetWidth
+        else if FItems[a].ControlType = TGUISwitch then w := w+(FItems[a].Control as TGUISwitch).GetWidth
+        else if FItems[a].ControlType = TGUIEdit then w := w+(FItems[a].Control as TGUIEdit).GetWidth
+        else if FItems[a].ControlType = TGUIKeyRead then w := w+(FItems[a].Control as TGUIKeyRead).GetWidth
+        else if FItems[a].ControlType = TGUIKeyRead2 then w := w+(FItems[a].Control as TGUIKeyRead2).GetWidth
+        else if FItems[a].ControlType = TGUIListBox then w := w+(FItems[a].Control as TGUIListBox).GetWidth
+        else if FItems[a].ControlType = TGUIFileListBox then w := w+(FItems[a].Control as TGUIFileListBox).GetWidth
+        else if FItems[a].ControlType = TGUIMemo then w := w+(FItems[a].Control as TGUIMemo).GetWidth;
       end;
-
       tx := Min(tx, (gScreenWidth div 2)-(w div 2));
     end;
   end;
@@ -1616,35 +1678,46 @@ begin
   end;
 
   for a := 0 to High(FItems) do
+  begin
     with FItems[a] do
     begin
       if Text <> nil then
+      begin
         with Text do
         begin
           FX := tx;
           FY := h;
         end;
+        //HACK!
+        if Text.RightAlign and (length(cww) > a) then
+        begin
+          //Text.FX := Text.FX+maxcww;
+          Text.FMaxWidth := maxcww;
+        end;
+      end;
 
-        if Control <> nil then
-          with Control do
-            if Text <> nil then
-            begin
-              FX := cx;
-              FY := h;
-            end
-            else
-            begin
-              FX := tx;
-              FY := h;
-            end;
+      if Control <> nil then
+      begin
+        with Control do
+        begin
+          if Text <> nil then
+          begin
+            FX := cx;
+            FY := h;
+          end
+          else
+          begin
+            FX := tx;
+            FY := h;
+          end;
+        end;
+      end;
 
-        if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then
-          Inc(h, (Control as TGUIListBox).GetHeight+MENU_VSPACE)
-        else if ControlType = TGUIMemo then
-          Inc(h, (Control as TGUIMemo).GetHeight+MENU_VSPACE)
-        else
-          Inc(h, e_CharFont_GetMaxHeight(FFontID)+MENU_VSPACE);
+           if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then Inc(h, (Control as TGUIListBox).GetHeight+MENU_VSPACE)
+      else if ControlType = TGUIMemo then Inc(h, (Control as TGUIMemo).GetHeight+MENU_VSPACE)
+      else Inc(h, e_CharFont_GetMaxHeight(FFontID)+MENU_VSPACE);
     end;
+  end;
 
   // another ugly hack
   if FYesNo and (length(FItems) > 1) then
@@ -1796,6 +1869,37 @@ begin
   ReAlign();
 end;
 
+function TGUIMenu.AddKeyRead2(fText: string): TGUIKeyRead2;
+var
+  i: Integer;
+begin
+  i := NewItem();
+  with FItems[i] do
+  begin
+    Control := TGUIKeyRead2.Create(FFontID);
+    with Control as TGUIKeyRead2 do
+    begin
+      FWindow := Self.FWindow;
+      FColor := MENU_ITEMSCTRL_COLOR;
+    end;
+
+    Text := TGUILabel.Create(fText, FFontID);
+    with Text do
+    begin
+      FColor := MENU_ITEMSCTRL_COLOR; //MENU_ITEMSTEXT_COLOR;
+      RightAlign := true;
+    end;
+
+    ControlType := TGUIKeyRead2;
+
+    Result := (Control as TGUIKeyRead2);
+  end;
+
+  if FIndex = -1 then FIndex := i;
+
+  ReAlign();
+end;
+
 function TGUIMenu.AddList(fText: string; Width, Height: Word): TGUIListBox;
 var
   i: Integer;
@@ -1974,7 +2078,7 @@ begin
   if a > FMax then FValue := FMax else FValue := a;
 end;
 
-function TGUIScroll.GetWidth: Word;
+function TGUIScroll.GetWidth: Integer;
 begin
   Result := 16+(FMax+1)*8;
 end;
@@ -2046,7 +2150,7 @@ begin
   else Result := '';
 end;
 
-function TGUISwitch.GetWidth: Word;
+function TGUISwitch.GetWidth: Integer;
 var
   a: Integer;
   w, h: Word;
@@ -2143,7 +2247,7 @@ begin
   end;
 end;
 
-function TGUIEdit.GetWidth: Word;
+function TGUIEdit.GetWidth: Integer;
 begin
   Result := 16+FWidth*16;
 end;
@@ -2223,6 +2327,8 @@ end;
 constructor TGUIKeyRead.Create(FontID: DWORD);
 begin
   inherited Create();
+  FKey := 0;
+  FIsQuery := false;
 
   FFont := TFont.Create(FontID, FONT_CHAR);
 end;
@@ -2235,7 +2341,7 @@ begin
              FColor.R, FColor.G, FColor.B);
 end;
 
-function TGUIKeyRead.GetWidth: Word;
+function TGUIKeyRead.GetWidth: Integer;
 var
   a: Byte;
   w, h: Word;
@@ -2259,8 +2365,6 @@ function TGUIKeyRead.WantActivationKey (key: LongInt): Boolean;
 begin
   result :=
     (key = IK_BACKSPACE) or
-    (key = IK_LEFT) or (key = IK_RIGHT) or
-    (key = IK_KPLEFT) or (key = IK_KPRIGHT) or
     false; // oops
 end;
 
@@ -2325,7 +2429,6 @@ begin
           end
           else if FIsQuery and (wParam <> IK_ENTER) and (wParam <> IK_KPRETURN) then // Not <Enter
           begin
-            e_WriteLog(Format('HIT! %s', ['3']), MSG_WARNING);
             if e_KeyNames[wParam] <> '' then
               FKey := wParam;
             FIsQuery := False;
@@ -2335,6 +2438,167 @@ begin
     end;
 end;
 
+{ TGUIKeyRead2 }
+
+constructor TGUIKeyRead2.Create(FontID: DWORD);
+var
+  a: Byte;
+  w, h: Word;
+begin
+  inherited Create();
+
+  FKey0 := 0;
+  FKey1 := 0;
+  FKeyIdx := 0;
+  FIsQuery := False;
+
+  FFontID := FontID;
+  FFont := TFont.Create(FontID, FONT_CHAR);
+
+  FMaxKeyNameWdt := 0;
+  for a := 0 to 255 do
+  begin
+    FFont.GetTextSize(e_KeyNames[a], w, h);
+    FMaxKeyNameWdt := Max(FMaxKeyNameWdt, w);
+  end;
+
+  FMaxKeyNameWdt := FMaxKeyNameWdt-(FMaxKeyNameWdt div 3);
+
+  FFont.GetTextSize(KEYREAD_QUERY, w, h);
+  if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w;
+
+  FFont.GetTextSize(KEYREAD_CLEAR, w, h);
+  if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w;
+end;
+
+procedure TGUIKeyRead2.Draw;
+  procedure drawText (idx: Integer);
+  var
+    x, y: Integer;
+    r, g, b: Byte;
+    kk: DWORD;
+  begin
+    if idx = 0 then kk := FKey0 else kk := FKey1;
+    y := FY;
+    if idx = 0 then x := FX+8 else x := FX+8+FMaxKeyNameWdt+16;
+    r := 255;
+    g := 0;
+    b := 0;
+    if FKeyIdx = idx then begin r := 255; g := 255; b := 255; end;
+    if FIsQuery and (FKeyIdx = idx) then
+      FFont.Draw(x, y, KEYREAD_QUERY, r, g, b)
+    else
+      FFont.Draw(x, y, IfThen(kk <> 0, e_KeyNames[kk], KEYREAD_CLEAR), r, g, b);
+  end;
+
+begin
+  inherited;
+
+  //FFont.Draw(FX+8, FY, IfThen(FIsQuery and (FKeyIdx = 0), KEYREAD_QUERY, IfThen(FKey0 <> 0, e_KeyNames[FKey0], KEYREAD_CLEAR)), FColor.R, FColor.G, FColor.B);
+  //FFont.Draw(FX+8+FMaxKeyNameWdt+16, FY, IfThen(FIsQuery and (FKeyIdx = 1), KEYREAD_QUERY, IfThen(FKey1 <> 0, e_KeyNames[FKey1], KEYREAD_CLEAR)), FColor.R, FColor.G, FColor.B);
+  drawText(0);
+  drawText(1);
+end;
+
+function TGUIKeyRead2.GetWidth: Integer;
+begin
+  Result := FMaxKeyNameWdt*2+8+8+16;
+end;
+
+function TGUIKeyRead2.WantActivationKey (key: LongInt): Boolean;
+begin
+  result :=
+    (key = IK_BACKSPACE) or
+    (key = IK_LEFT) or (key = IK_RIGHT) or
+    (key = IK_KPLEFT) or (key = IK_KPRIGHT) or
+    false; // oops
+end;
+
+procedure TGUIKeyRead2.OnMessage(var Msg: TMessage);
+  procedure actDefCtl ();
+  begin
+    with FWindow do
+      if FDefControl <> '' then
+        SetActive(GetControl(FDefControl))
+      else
+        SetActive(nil);
+  end;
+
+begin
+  inherited;
+
+  if not FEnabled then
+    Exit;
+
+  with Msg do
+    case Msg of
+      WM_KEYDOWN:
+        case wParam of
+          IK_ESCAPE:
+            begin
+              if FIsQuery then actDefCtl();
+              FIsQuery := False;
+            end;
+          IK_RETURN, IK_KPRETURN:
+            begin
+              if not FIsQuery then
+                begin
+                  with FWindow do
+                    if FActiveControl <> Self then
+                      SetActive(Self);
+
+                  FIsQuery := True;
+                end
+              else
+                begin
+                  if (FKeyIdx = 0) then FKey0 := IK_ENTER else FKey1 := IK_ENTER; // <Enter>
+                  FIsQuery := False;
+                  actDefCtl();
+                end;
+            end;
+          IK_BACKSPACE: // clear keybinding if we aren't waiting for a key
+            begin
+              if not FIsQuery then
+              begin
+                if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0;
+                actDefCtl();
+              end;
+            end;
+          IK_LEFT, IK_KPLEFT:
+            if not FIsQuery then
+            begin
+              FKeyIdx := 0;
+              actDefCtl();
+            end;
+          IK_RIGHT, IK_KPRIGHT:
+            if not FIsQuery then
+            begin
+              FKeyIdx := 1;
+              actDefCtl();
+            end;
+        end;
+
+      MESSAGE_DIKEY:
+        begin
+          if not FIsQuery and (wParam = IK_BACKSPACE) then
+          begin
+            if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0;
+            actDefCtl();
+          end
+          else if FIsQuery and (wParam <> IK_ENTER) and (wParam <> IK_KPRETURN) then // Not <Enter
+          begin
+            if e_KeyNames[wParam] <> '' then
+            begin
+              if (FKeyIdx = 0) then FKey0 := wParam else FKey1 := wParam;
+            end;
+            FIsQuery := False;
+            actDefCtl();
+          end;
+        end;
+    end;
+end;
+
+
 { TGUIModelView }
 
 constructor TGUIModelView.Create;
@@ -2376,7 +2640,7 @@ begin
   if FModel = nil then
     Exit;
 
-  if FModel.Weapon < WEAPON_SUPERPULEMET then
+  if FModel.Weapon < WP_LAST then
     FModel.SetWeapon(FModel.Weapon+1)
   else
     FModel.SetWeapon(WEAPON_KASTET);
@@ -2696,12 +2960,12 @@ begin
     end;
 end;
 
-function TGUIListBox.GetHeight: Word;
+function TGUIListBox.GetHeight: Integer;
 begin
   Result := 8+FHeight*16;
 end;
 
-function TGUIListBox.GetWidth: Word;
+function TGUIListBox.GetWidth: Integer;
 begin
   Result := 8+(FWidth+1)*16;
 end;
@@ -3065,12 +3329,12 @@ begin
       FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, FLines[a], FColor.R, FColor.G, FColor.B);
 end;
 
-function TGUIMemo.GetHeight: Word;
+function TGUIMemo.GetHeight: Integer;
 begin
   Result := 8+FHeight*16;
 end;
 
-function TGUIMemo.GetWidth: Word;
+function TGUIMemo.GetWidth: Integer;
 begin
   Result := 8+(FWidth+1)*16;
 end;