qmenu.pas

delphi编的不错的贪吃蛇

{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): qmenu.c + qmenu.h                                                 }
{                                                                            }
{ Initial conversion by : YgriK (Igor Karpov) - [e-mail]            }
{ Initial conversion on : 13-Feb-2002                                        }
{                                                                            }
{ This File contains part of convertion of Quake2 source to ObjectPascal.    }
{ More information about this project can be found at:                       }
{ http://www.sulaco.co.za/quake2/                                            }
{                                                                            }
{ Copyright (C) 1997-2001 Id Software, Inc.                                  }
{                                                                            }
{ This program is free software; you can redistribute it and/or              }
{ modify it under the terms of the GNU General Public License                }
{ as published by the Free Software Foundation; either version 2             }
{ of the License, or (at your option) any later version.                     }
{                                                                            }
{ This program is distributed in the hope that it will be useful,            }
{ but WITHOUT ANY WARRANTY; without even the implied warranty of             }
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }
{                                                                            }
{ See the GNU General Public License for more details.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ Updated on : 04-jun-2002                                                              }
{ Updated by : Juha Hartikainen                                                               }
{ - Made this real unit }
{ - Added qmenu.h stuff }
{ - Finished conversion }
{ Updated on : 25-jul-2002                                                   }
{ Updated by : burnin ([e-mail])                                }
{ - Pointer renaming                                                         }
{                                                                            }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{                                                                            }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ 1) Implement Field_key Paste from clipboard functionality                  }
{ 2) Error checking                                                          }
{----------------------------------------------------------------------------}
unit Qmenu;

interface

uses
    {$IFDEF LINUX}
    libc,
    {$ENDIF}
    q_shared;

const
  MAXMENUITEMS = 64;

  MTYPE_SLIDER = 0;
  MTYPE_LIST = 1;
  MTYPE_ACTION = 2;
  MTYPE_SPINCONTROL = 3;
  MTYPE_SEPARATOR = 4;
  MTYPE_FIELD = 5;

  K_TAB = 9;
  K_ENTER = 13;
  K_ESCAPE = 27;
  K_SPACE = 32;

  // normal keys should be passed as lowercased ascii

  K_BACKSPACE = 127;
  K_UPARROW = 128;
  K_DOWNARROW = 129;
  K_LEFTARROW = 130;
  K_RIGHTARROW = 131;

  QMF_LEFT_JUSTIFY = $00000001;
  QMF_GRAYED = $00000002;
  QMF_NUMBERSONLY = $00000004;

type
  menuframework_p = ^menuframework_s;
  menuframework_s = record
    x, y: Integer;
    cursor: Integer;

    nitems: Integer;
    nslots: Integer;
    items: array[0..64 - 1] of pointer;
    statusbar: pchar;
    cursordraw: procedure(menuframework: menuframework_p);
  end;

  menucommon_p = ^menucommon_s;
  menucommon_s = record
    type_: integer;
    name: pchar;
    x, y: integer;
    parent: menuframework_p;
    cursor_offset: integer;
    localdata: array[0..3] of integer;
    flags: Cardinal;

    statusbar: PChar;

    callback: procedure(Self: Pointer);
    statusbarfunc: procedure(Self: Pointer);
    ownerdraw: procedure(Self: Pointer);
    cursordraw: procedure(Self: Pointer);
  end;

  menufield_p = ^menufield_s;
  menufield_s = record
    generic: menucommon_s;
    buffer: array[0..80 - 1] of char;
    cursor: integer;
    length: integer;
    visible_length: integer;
    visible_offset: integer;
  end;

  menuslider_p = ^menuslider_s;
  menuslider_s = record
    generic: menucommon_s;
    minvalue: single;
    maxvalue: single;
    curvalue: single;
    range: single;
  end;

  menulist_p = ^menulist_s;
  menulist_s = record
    generic: menucommon_s;
    curvalue: integer;
    itemnames: PPCharArray;
  end;

  menuaction_p = ^menuaction_s;
  menuaction_s = record
    generic: menucommon_s;
  end;

  menuseparator_p = ^menuseparator_s;
  menuseparator_s = record
    generic: menucommon_s;
  end;

function Field_Key(f: menufield_p; key: integer): qboolean;

procedure Menu_AddItem(menu: menuframework_p; item: pointer);
procedure Menu_AdjustCursor(menu: menuframework_p; dir: integer);
procedure Menu_Center(menu: menuframework_p);
procedure Menu_Draw(menu: menuframework_p);
function Menu_ItemAtCursor(m: menuframework_p): pointer;
function Menu_SelectItem(s: menuframework_p): qboolean;
procedure Menu_SetStatusBar(m: menuframework_p; string_: pchar);
procedure Menu_SlideItem(s: menuframework_p; dir: integer);
function Menu_TallySlots(menu: menuframework_p): integer;

procedure Menu_DrawString(x, y: integer; string_: pchar);
procedure Menu_DrawStringDark(x, y: integer; string_: pchar);
procedure Menu_DrawStringR2L(x, y: integer; string_: pchar);
procedure Menu_DrawStringR2LDark(x, y: integer; string_: pchar);

implementation

uses
  {$IFDEF WIN32}
  q_shwin,
  sys_win,
  vid_dll,
  {$ELSE}
  q_shlinux,
  sys_linux,
  vid_so,
  {$ENDIF}
  keys,
  SysUtils,
  cpas;

const
  RCOLUMN_OFFSET = 16;
  LCOLUMN_OFFSET = -16;

  { JUHA: MACRO REPLACEMENTS }

function VID_WIDTH: integer;
begin
  Result := viddef.width;
end;

function VID_HEIGHT: integer;
begin
  Result := viddef.height;
end;
(*

#define re.DrawChar re.DrawChar
#define Draw_Fill re.DrawFill
*)

procedure Slider_Draw(s: menuslider_p); forward;
procedure MenuList_Draw(l: menulist_p); forward;
procedure SpinControl_Draw(s: menulist_p); forward;
procedure Separator_Draw(s: menuseparator_p); forward;
procedure Menu_DrawStatusBar(string_: PChar); forward;
procedure Slider_DoSlide(s: menuslider_p; dir: integer); forward;
procedure SpinControl_DoSlide(s: menulist_p; dir: integer); forward;

procedure Action_DoEnter(a: menuaction_p);
begin
  if @a.generic.callback <> nil then
    a.generic.callback(a);
end;

procedure Action_Draw(a: menuaction_p);
begin
  if (a^.generic.flags and QMF_LEFT_JUSTIFY) <> 0 then
  begin
    if (a^.generic.flags and QMF_GRAYED) <> 0 then
      Menu_DrawStringDark(a^.generic.x + a^.generic.parent.x + LCOLUMN_OFFSET, a^.generic.y + a^.generic.parent.y, a^.generic.name)
    else
      Menu_DrawString(a^.generic.x + a^.generic.parent.x + LCOLUMN_OFFSET, a^.generic.y + a^.generic.parent.y, a^.generic.name);
  end
  else
  begin
    if (a^.generic.flags and QMF_GRAYED) <> 0 then
      Menu_DrawStringR2LDark(a^.generic.x + a^.generic.parent.x + LCOLUMN_OFFSET, a^.generic.y + a^.generic.parent.y, a^.generic.name)
    else
      Menu_DrawStringR2L(a^.generic.x + a^.generic.parent.x + LCOLUMN_OFFSET, a^.generic.y + a^.generic.parent.y, a^.generic.name);
  end;
  if @a^.generic.ownerdraw <> nil then
    a^.generic.ownerdraw(a);
end;

function Field_DoEnter(f: menufield_p): qboolean;
begin
  if @f^.generic.callback <> nil then
  begin
    f^.generic.callback(f);
    Result := true;
    Exit;
  end;
  Result := false;
end;

procedure Field_Draw(f: menufield_p);
var
  i, offset: Integer;
  tempbuffer: array[0..128 - 1] of Char;
begin
  FillChar(tempbuffer, sizeof(tempbuffer), 0);
  if f^.generic.name <> nil then
    Menu_DrawStringR2LDark(f^.generic.x + f^.generic.parent.x + LCOLUMN_OFFSET, f^.generic.y + f^.generic.parent.y, f^.generic.name);

  strncpy(tempbuffer, f^.buffer + f^.visible_offset, f^.visible_length);

  re.DrawChar(f^.generic.x + f^.generic.parent.x + 16, f^.generic.y + f^.generic.parent.y - 4, 18);
  re.DrawChar(f^.generic.x + f^.generic.parent.x + 16, f^.generic.y + f^.generic.parent.y + 4, 24);

  re.DrawChar(f^.generic.x + f^.generic.parent.x + 24 + f^.visible_length * 8, f^.generic.y + f^.generic.parent.y - 4, 20);
  re.DrawChar(f^.generic.x + f^.generic.parent.x + 24 + f^.visible_length * 8, f^.generic.y + f^.generic.parent.y + 4, 26);

  for i := 0 to f^.visible_length - 1 do
  begin
    re.DrawChar(f^.generic.x + f^.generic.parent.x + 24 + i * 8, f^.generic.y + f^.generic.parent.y - 4, 19);
    re.DrawChar(f^.generic.x + f^.generic.parent.x + 24 + i * 8, f^.generic.y + f^.generic.parent.y + 4, 25);
  end;

  Menu_DrawString(f^.generic.x + f^.generic.parent.x + 24, f^.generic.y + f^.generic.parent.y, tempbuffer);

  if (Menu_ItemAtCursor(f^.generic.parent) = f) then
  begin
    if (f^.visible_offset <> 0) then
      offset := f^.visible_length
    else
      offset := f^.cursor;

    if ((Sys_Milliseconds() div 250) and 1 <> 0) then
      re.DrawChar(f^.generic.x + f^.generic.parent.x + (offset + 2) * 8 + 8,
        f^.generic.y + f^.generic.parent.y,
        11)
    else
      re.DrawChar(f^.generic.x + f^.generic.parent.x + (offset + 2) * 8 + 8,
        f^.generic.y + f^.generic.parent.y,
        Byte(' '));
  end;
end;

function Field_Key(f: menufield_p; key: integer): qboolean;
var
  cbd: PChar;
begin
  case key of
    K_KP_SLASH: key := byte('/');
    K_KP_MINUS: key := byte('-');
    K_KP_PLUS: key := byte('+');
    K_KP_HOME: key := byte('7');
    K_KP_UPARROW: key := byte('8');
    K_KP_PGUP: key := byte('9');
    K_KP_LEFTARROW: key := byte('4');
    K_KP_5: key := byte('5');
    K_KP_RIGHTARROW: key := byte('6');
    K_KP_END: key := byte('1');
    K_KP_DOWNARROW: key := byte('2');
    K_KP_PGDN: key := byte('3');
    K_KP_INS: key := byte('0');
    K_KP_DEL: key := byte('.');
  end;                                  //case

  if (key > 127) then
  begin
    Result := false;
    Exit;
  end;

  {*
  ** support pasting from the clipboard
  *}
  if ((UpperCase(char(key)) = 'V') and (keydown[K_CTRL]) or
    (((key = K_INS) or (key = K_KP_INS)) and keydown[K_SHIFT])) then
  begin
    cbd := Sys_GetClipboardData();
    if (cbd <> nil) then
    begin
      strtok(cbd, #10#13#08);
      strncpy(f^.buffer, cbd, f^.length - 1);
      f^.cursor := strlen(f^.buffer);
      f^.visible_offset := f^.cursor - f^.visible_length;
      if (f^.visible_offset < 0) then
        f^.visible_offset := 0;
      FreeMem(cbd);
    end;
    Result := true;
    Exit;
  end;

  case key of
    K_KP_LEFTARROW,
      K_LEFTARROW,
      K_BACKSPACE: if (f^.cursor > 0) then
      begin
        Move(f^.buffer[f^.cursor], f^.buffer[f^.cursor - 1], strlen(@f^.buffer[f^.cursor]) + 1);
        Dec(f^.cursor);
        if (f^.visible_offset <> 0) then
          Dec(f^.visible_offset);
      end;
    K_KP_DEL,
      K_DEL: Move(f^.buffer[f^.cursor + 1], f^.buffer[f^.cursor], strlen(@f^.buffer[f^.cursor + 1]) + 1);

    K_KP_ENTER,
      K_ENTER,
      K_ESCAPE,
      K_TAB:
      begin
        Result := false;
        Exit;
      end;

    {K_SPACE, }
  else if (isdigit(key) = 0) and
    ((f^.generic.flags and QMF_NUMBERSONLY) <> 0) then
  begin
    Result := false;
    Exit;
  end;

  if (f^.cursor < f^.length) then
  begin
    //                    f->buffer[f->cursor++] = key;
    f^.buffer[f^.cursor] := Char(key);
    Inc(f^.cursor);

    f^.buffer[f^.cursor] := #0;

    if (f^.cursor > f^.visible_length) then
      Inc(f^.visible_offset);
  end;
  end;                                  //case

  Result := true;
end;

procedure Menu_AddItem(menu: menuframework_p; item: pointer);
begin
  if (menu^.nitems = 0) then
    menu^.nslots := 0;