From: Ketmar Dark Date: Mon, 28 Aug 2017 13:54:24 +0000 (+0300) Subject: completely rebindable keyboard and mouse in Holmes X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=e540bbf4ebb46a3c4b3ae2fd69ba64a149189a32;p=d2df-sdl.git completely rebindable keyboard and mouse in Holmes --- diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr index 97b451e..e5ecf92 100644 --- a/src/game/Doom2DF.dpr +++ b/src/game/Doom2DF.dpr @@ -101,6 +101,7 @@ uses binheap in '../shared/binheap.pas', hashtable in '../shared/hashtable.pas', idpool in '../shared/idpool.pas', + xparser in '../shared/xparser.pas', BinEditor in '../shared/BinEditor.pas', envvars in '../shared/envvars.pas', g_panel in 'g_panel.pas', diff --git a/src/game/g_holmes.pas b/src/game/g_holmes.pas index f97952b..ae7c7b4 100644 --- a/src/game/g_holmes.pas +++ b/src/game/g_holmes.pas @@ -101,8 +101,8 @@ var implementation uses - SysUtils, GL, SDL2, - MAPDEF, g_options; + SysUtils, Classes, GL, SDL2, + MAPDEF, g_options, utils, hashtable, xparser; var @@ -133,7 +133,8 @@ begin kmods := 255; mbuts := 255; pos := 1; - while (pos <= Length(s)) and (s[pos] <= ' ') do Inc(pos); + //while (pos <= Length(s)) and (s[pos] <= ' ') do Inc(pos); + if (pos < Length(s)) and ((s[pos] = '+') or (s[pos] = '-') or (s[pos] = '*')) then Inc(pos); while (pos < Length(s)) do begin if (Length(s)-pos >= 2) and (s[pos+1] = '-') then @@ -170,6 +171,13 @@ var kname: AnsiString; begin result := false; + if (Length(s) > 0) then + begin + if (s[1] = '+') then begin if (ev.kind <> ev.Press) then exit; end + else if (s[1] = '-') then begin if (ev.kind <> ev.Release) then exit; end + else if (s[1] = '*') then begin end + else if (ev.kind <> ev.Press) then exit; + end; kname := parseModKeys(s, kmods, mbuts); if (kmods = 255) then kmods := 0; if (ev.kstate <> kmods) then exit; @@ -199,6 +207,15 @@ var but: Integer = -1; begin result := false; + + if (Length(s) > 0) then + begin + if (s[1] = '+') then begin if (ev.kind <> ev.Press) then exit; end + else if (s[1] = '-') then begin if (ev.kind <> ev.Release) then exit; end + else if (s[1] = '*') then begin if (ev.kind <> ev.Motion) then exit; end + else if (ev.kind <> ev.Press) then exit; + end; + kname := parseModKeys(s, kmods, mbuts); if (CompareText(kname, 'LMB') = 0) then but := THMouseEvent.Left else if (CompareText(kname, 'RMB') = 0) then but := THMouseEvent.Right @@ -209,7 +226,8 @@ begin //conwritefln('s=[%s]; kname=[%s]; kmods=%s; mbuts=%s; but=%s', [s, kname, kmods, mbuts, but]); if (mbuts = 255) then mbuts := 0; - if (kmods <> 255) and (ev.kstate <> kmods) then exit; + if (kmods = 255) then kmods := 0; + if (ev.kstate <> kmods) then exit; if (ev.kind = ev.Press) then mbuts := mbuts or but else if (ev.kind = ev.Release) then mbuts := mbuts and (not but); @@ -226,6 +244,12 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // +{$INCLUDE g_holmes_cmd.inc} +procedure holmesInitCommands (); forward; +procedure holmesInitBinds (); forward; + + // ////////////////////////////////////////////////////////////////////////// // var g_ol_nice: Boolean = false; @@ -248,32 +272,132 @@ var winOutlines: THTopWindow = nil; +procedure createHelpWindow (); forward; +procedure createOptionsWindow (); forward; +procedure createLayersWindow (); forward; +procedure createOutlinesWindow (); forward; + + +procedure toggleLayersWindowCB (me: THControl; checked: Integer); +begin + if showLayersWindow then + begin + if (winLayers = nil) then createLayersWindow(); + uiAddWindow(winLayers); + end + else + begin + uiRemoveWindow(winLayers); + end; +end; + + +procedure toggleOutlineWindowCB (me: THControl; checked: Integer); +begin + if showOutlineWindow then + begin + if (winOutlines = nil) then createOutlinesWindow(); + uiAddWindow(winOutlines); + end + else + begin + uiRemoveWindow(winOutlines); + end; +end; + + procedure createHelpWindow (); var llb: THCtlSimpleText; + slist: array of AnsiString = nil; + cmd: PHolmesCommand; + bind: THolmesBinding; + f, maxkeylen: Integer; + s: AnsiString; begin + for cmd in cmdlist do cmd.helpmark := false; + + maxkeylen := 0; + for bind in keybinds do + begin + if (Length(bind.key) = 0) then continue; + if cmdlist.get(bind.cmdName, cmd) then + begin + if (Length(cmd.help) > 0) then + begin + cmd.helpmark := true; + if (maxkeylen < Length(bind.key)) then maxkeylen := Length(bind.key); + end; + end; + end; + + for cmd in cmdlist do + begin + if not cmd.helpmark then continue; + if (Length(cmd.help) = 0) then continue; + f := 0; + while (f < Length(slist)) and (CompareText(slist[f], cmd.section) <> 0) do Inc(f); + if (f = Length(slist)) then + begin + SetLength(slist, Length(slist)+1); + slist[High(slist)] := cmd.section; + end; + end; + llb := THCtlSimpleText.Create(0, 0); - llb.appendItem('common keys', true, true); - llb.appendItem(' F1 -- toggle this window'); - llb.appendItem(' M-F1 -- toggle options window'); - llb.appendItem(''); - llb.appendItem('control keys', true, true); - llb.appendItem(' M-M -- one monster think step'); - llb.appendItem(' M-I -- toggle monster info'); - llb.appendItem(' M-K -- toggle monster LOS to player'); - llb.appendItem(' M-G -- toggle "show all cells occupied by monsters" (SLOW!)'); - llb.appendItem(' M-A -- wake up monster'); - llb.appendItem(' C-T -- teleport player'); - llb.appendItem(' C-P -- show cursor position on the map'); - llb.appendItem(' C-G -- toggle grid'); - llb.appendItem(' C-L -- toggle layers window'); - llb.appendItem(' C-O -- toggle outlines window'); + for f := 0 to High(slist) do + begin + if (f > 0) then llb.appendItem(''); + llb.appendItem(slist[f], true, true); + for cmd in cmdlist do + begin + if not cmd.helpmark then continue; + if (CompareText(cmd.section, slist[f]) <> 0) then continue; + for bind in keybinds do + begin + if (Length(bind.key) = 0) then continue; + if (cmd.name = bind.cmdName) then + begin + s := bind.key; + while (Length(s) < maxkeylen) do s += ' '; + s := ' '+s+' -- '+cmd.help; + llb.appendItem(s); + end; + end; + end; + end; + + maxkeylen := 0; + for bind in msbinds do + begin + if (Length(bind.key) = 0) then continue; + if cmdlist.get(bind.cmdName, cmd) then + begin + if (Length(cmd.help) > 0) then + begin + cmd.helpmark := true; + if (maxkeylen < Length(bind.key)) then maxkeylen := Length(bind.key); + end; + end; + end; + llb.appendItem(''); llb.appendItem('mouse', true, true); - llb.appendItem(' LMB -- select monster'); - llb.appendItem(' M-LMB -- dump monsters in cell (to log)'); - llb.appendItem(' RMB -- dump wall info to log'); - llb.appendItem(' M-LMB -- disable wall'); + for bind in msbinds do + begin + if (Length(bind.key) = 0) then continue; + if cmdlist.get(bind.cmdName, cmd) then + begin + if (Length(cmd.help) > 0) then + begin + s := bind.key; + while (Length(s) < maxkeylen) do s += ' '; + s := ' '+s+' -- '+cmd.help; + llb.appendItem(s); + end; + end; + end; + winHelp := THTopWindow.Create('Holmes Help', 10, 10); winHelp.escClose := true; winHelp.appendChild(llb); @@ -327,34 +451,6 @@ begin end; -procedure toggleLayersWindow (me: THControl; checked: Integer); -begin - if showLayersWindow then - begin - if (winLayers = nil) then createLayersWindow(); - uiAddWindow(winLayers); - end - else - begin - uiRemoveWindow(winLayers); - end; -end; - - -procedure toggleOutlineWindow (me: THControl; checked: Integer); -begin - if showOutlineWindow then - begin - if (winOutlines = nil) then createOutlinesWindow(); - uiAddWindow(winOutlines); - end - else - begin - uiRemoveWindow(winOutlines); - end; -end; - - procedure createOptionsWindow (); var llb: THCtlCBListBox; @@ -366,8 +462,8 @@ begin llb.appendItem('monster LOS to player', @showMonsLOS2Plr); llb.appendItem('monster cells (SLOW!)', @showAllMonsCells); llb.appendItem('WINDOWS', nil); - llb.appendItem('layers window', @showLayersWindow, toggleLayersWindow); - llb.appendItem('outline window', @showOutlineWindow, toggleOutlineWindow); + llb.appendItem('layers window', @showLayersWindow, toggleLayersWindowCB); + llb.appendItem('outline window', @showOutlineWindow, toggleOutlineWindowCB); winOptions := THTopWindow.Create('Holmes Options', 100, 100); winOptions.escClose := true; winOptions.appendChild(llb); @@ -375,6 +471,31 @@ begin end; +procedure toggleLayersWindow (arg: Integer=-1); +begin + showLayersWindow := not showLayersWindow; + toggleLayersWindowCB(nil, 0); +end; + +procedure toggleOutlineWindow (arg: Integer=-1); +begin + showOutlineWindow := not showOutlineWindow; + toggleOutlineWindowCB(nil, 0); +end; + +procedure toggleHelpWindow (arg: Integer=-1); +begin + if (winHelp = nil) then createHelpWindow(); + if not uiVisibleWindow(winHelp) then uiAddWindow(winHelp) else uiRemoveWindow(winHelp); +end; + +procedure toggleOptionsWindow (arg: Integer=-1); +begin + if (winOptions = nil) then createOptionsWindow(); + if not uiVisibleWindow(winOptions) then uiAddWindow(winOptions) else uiRemoveWindow(winOptions); +end; + + // ////////////////////////////////////////////////////////////////////////// // procedure g_Holmes_VidModeChanged (); begin @@ -434,65 +555,12 @@ function pmsCurMapY (): Integer; inline; begin result := msY+vpy; end; procedure plrDebugMouse (var ev: THMouseEvent); - - function wallToggle (pan: TPanel; tag: Integer): Boolean; - begin - result := false; // don't stop - e_WriteLog(Format('wall #%d(%d); enabled=%d (%d); (%d,%d)-(%d,%d)', [pan.arrIdx, pan.proxyId, Integer(pan.Enabled), Integer(mapGrid.proxyEnabled[pan.proxyId]), pan.X, pan.Y, pan.Width, pan.Height]), MSG_NOTIFY); - if (kbS = THKeyEvent.ModAlt) then - begin - if pan.Enabled then g_Map_DisableWall(pan.arrIdx) else g_Map_EnableWall(pan.arrIdx); - end; - end; - - function monsAtDump (mon: TMonster; tag: Integer): Boolean; - begin - result := false; // don't stop - e_WriteLog(Format('monster #%d; UID=%d', [mon.arrIdx, mon.UID]), MSG_NOTIFY); - monMarkedUID := mon.UID; - //if pan.Enabled then g_Map_DisableWall(pan.arrIdx) else g_Map_EnableWall(pan.arrIdx); - end; - - function monsInCell (mon: TMonster; tag: Integer): Boolean; - begin - result := false; // don't stop - e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), MSG_NOTIFY); - end; - begin //e_WriteLog(Format('mouse: x=%d; y=%d; but=%d; bstate=%d', [msx, msy, but, bstate]), MSG_NOTIFY); if (gPlayer1 = nil) or not vpSet then exit; - if (ev.kind <> THMouseEvent.Press) then exit; - - e_WriteLog(Format('mev: %d', [Integer(ev.kind)]), MSG_NOTIFY); - - if (ev.but = THMouseEvent.Right) then - begin - // dump/toggle wall - e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY); - mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor)); - e_WriteLog('--- toggle wall ---', MSG_NOTIFY); - exit; - end; - - if (ev.but = THMouseEvent.Left) then - begin - if (kbS = THKeyEvent.ModAlt) then - begin - // dump monsters in cell - e_WriteLog('===========================', MSG_NOTIFY); - monsGrid.forEachInCell(pmsCurMapX, pmsCurMapY, monsInCell); - e_WriteLog('---------------------------', MSG_NOTIFY); - end - else if (kbS = 0) then - begin - monMarkedUID := -1; - e_WriteLog('===========================', MSG_NOTIFY); - monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump); - e_WriteLog('---------------------------', MSG_NOTIFY); - end; - exit; - end; + //if (ev.kind <> THMouseEvent.Press) then exit; + //e_WriteLog(Format('mev: %d', [Integer(ev.kind)]), MSG_NOTIFY); + msbindExecute(ev); end; @@ -700,7 +768,6 @@ end; procedure plrDebugDraw (); - procedure drawTileGrid (); var x, y: Integer; @@ -891,6 +958,8 @@ end; // ////////////////////////////////////////////////////////////////////////// // function g_Holmes_MouseEvent (var ev: THMouseEvent): Boolean; begin + holmesInitCommands(); + holmesInitBinds(); result := true; msX := ev.x; msY := ev.y; @@ -901,21 +970,22 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // function g_Holmes_KeyEvent (var ev: THKeyEvent): Boolean; +{$IF DEFINED(D2F_DEBUG)} var - mon: TMonster; - x, y, w, h: Integer; - {$IF DEFINED(D2F_DEBUG)} pan: TPanel; ex, ey: Integer; dx, dy: Integer; - {$ENDIF} +{$ENDIF} procedure dummyWallTrc (cx, cy: Integer); begin end; begin + holmesInitCommands(); + holmesInitBinds(); result := false; msB := ev.bstate; kbS := ev.kstate; @@ -926,107 +996,10 @@ begin result := true; end; if uiKeyEvent(ev) then begin result := true; exit; end; + if keybindExecute(ev) then begin result := true; exit; end; // press if (ev.kind = THKeyEvent.Press) then begin - // M-M: one monster think step - if (ev = 'M-M') then - begin - result := true; - gmon_debug_think := false; - gmon_debug_one_think_step := true; // do one step - exit; - end; - // M-I: toggle monster info - if (ev = 'M-I') then - begin - result := true; - showMonsInfo := not showMonsInfo; - exit; - end; - // M-L: toggle monster LOS to player - if (ev = 'M-L') then - begin - result := true; - showMonsLOS2Plr := not showMonsLOS2Plr; - exit; - end; - // M-G: toggle "show all cells occupied by monsters" - if (ev = 'M-G') then - begin - result := true; - showAllMonsCells := not showAllMonsCells; - exit; - end; - // M-A: wake up monster - if (ev = 'M-A') then - begin - result := true; - if (monMarkedUID <> -1) then - begin - mon := g_Monsters_ByUID(monMarkedUID); - if (mon <> nil) then mon.WakeUp(); - end; - exit; - end; - // C-T: teleport player - if (ev = 'C-T') then - begin - result := true; - //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY); - if (gPlayers[0] <> nil) then - begin - gPlayers[0].getMapBox(x, y, w, h); - gPlayers[0].TeleportTo(pmsCurMapX-w div 2, pmsCurMapY-h div 2, true, 69); // 69: don't change dir - end; - exit; - end; - // C-P: show cursor position on the map - if (ev = 'C-P') then - begin - result := true; - showMapCurPos := not showMapCurPos; - exit; - end; - // C-G: toggle grid - if (ev = 'C-G') then - begin - result := true; - showGrid := not showGrid; - exit; - end; - // C-L: toggle layers window - if (ev = 'C-L') then - begin - result := true; - showLayersWindow := not showLayersWindow; - toggleLayersWindow(nil, 0); - exit; - end; - // C-O: toggle outlines window - if (ev = 'C-O') then - begin - result := true; - showOutlineWindow := not showOutlineWindow; - toggleOutlineWindow(nil, 0); - exit; - end; - // F1: toggle options window - if (ev = 'F1') then - begin - result := true; - if (winHelp = nil) then createHelpWindow(); - if not uiVisibleWindow(winHelp) then uiAddWindow(winHelp) else uiRemoveWindow(winHelp); - exit; - end; - // M-F1: toggle options window - if (ev = 'M-F1') then - begin - result := true; - if (winOptions = nil) then createOptionsWindow(); - if not uiVisibleWindow(winOptions) then uiAddWindow(winOptions) else uiRemoveWindow(winOptions); - exit; - end; {$IF DEFINED(D2F_DEBUG)} // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction if ((ev.scan = SDL_SCANCODE_UP) or (ev.scan = SDL_SCANCODE_DOWN) or (ev.scan = SDL_SCANCODE_LEFT) or (ev.scan = SDL_SCANCODE_RIGHT)) and @@ -1061,6 +1034,9 @@ end; // ////////////////////////////////////////////////////////////////////////// // procedure g_Holmes_Draw (); begin + holmesInitCommands(); + holmesInitBinds(); + glColorMask(GL_TRUE, GL_TRUE, GL_TRUE, GL_TRUE); // modify color buffer glDisable(GL_STENCIL_TEST); glDisable(GL_BLEND); @@ -1083,4 +1059,189 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // +procedure bcOneMonsterThinkStep (); begin gmon_debug_think := false; gmon_debug_one_think_step := true; end; +procedure bcToggleMonsterInfo (arg: Integer=-1); begin if (arg < 0) then showMonsInfo := not showMonsInfo else showMonsInfo := (arg > 0); end; +procedure bcToggleMonsterLOSPlr (arg: Integer=-1); begin if (arg < 0) then showMonsLOS2Plr := not showMonsLOS2Plr else showMonsLOS2Plr := (arg > 0); end; +procedure bcToggleMonsterCells (arg: Integer=-1); begin if (arg < 0) then showAllMonsCells := not showAllMonsCells else showAllMonsCells := (arg > 0); end; + +procedure bcToggleCurPos (arg: Integer=-1); begin if (arg < 0) then showMapCurPos := not showMapCurPos else showMapCurPos := (arg > 0); end; +procedure bcToggleGrid (arg: Integer=-1); begin if (arg < 0) then showGrid := not showGrid else showGrid := (arg > 0); end; + +procedure bcMonsterWakeup (); +var + mon: TMonster; +begin + if (monMarkedUID <> -1) then + begin + mon := g_Monsters_ByUID(monMarkedUID); + if (mon <> nil) then mon.WakeUp(); + end; +end; + +procedure bcPlayerTeleport (); +var + x, y, w, h: Integer; +begin + //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY); + if (gPlayers[0] <> nil) then + begin + gPlayers[0].getMapBox(x, y, w, h); + gPlayers[0].TeleportTo(pmsCurMapX-w div 2, pmsCurMapY-h div 2, true, 69); // 69: don't change dir + end; +end; + +procedure cbAtcurSelectMonster (); + function monsAtDump (mon: TMonster; tag: Integer): Boolean; + begin + result := true; // stop + e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), MSG_NOTIFY); + monMarkedUID := mon.UID; + end; +begin + monMarkedUID := -1; + //e_WriteLog('===========================', MSG_NOTIFY); + monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump); + //e_WriteLog('---------------------------', MSG_NOTIFY); +end; + +procedure cbAtcurDumpMonsters (); + function monsAtDump (mon: TMonster; tag: Integer): Boolean; + begin + result := false; // don't stop + e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), MSG_NOTIFY); + end; +begin + e_WriteLog('===========================', MSG_NOTIFY); + monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump); + e_WriteLog('---------------------------', MSG_NOTIFY); +end; + +procedure cbAtcurDumpWalls (); + function wallToggle (pan: TPanel; tag: Integer): Boolean; + begin + result := false; // don't stop + e_WriteLog(Format('wall #%d(%d); enabled=%d (%d); (%d,%d)-(%d,%d)', [pan.arrIdx, pan.proxyId, Integer(pan.Enabled), Integer(mapGrid.proxyEnabled[pan.proxyId]), pan.X, pan.Y, pan.Width, pan.Height]), MSG_NOTIFY); + end; +begin + e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY); + mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor)); + e_WriteLog('--- toggle wall ---', MSG_NOTIFY); +end; + +procedure cbAtcurToggleWalls (); + function wallToggle (pan: TPanel; tag: Integer): Boolean; + begin + result := false; // don't stop + //e_WriteLog(Format('wall #%d(%d); enabled=%d (%d); (%d,%d)-(%d,%d)', [pan.arrIdx, pan.proxyId, Integer(pan.Enabled), Integer(mapGrid.proxyEnabled[pan.proxyId]), pan.X, pan.Y, pan.Width, pan.Height]), MSG_NOTIFY); + if pan.Enabled then g_Map_DisableWall(pan.arrIdx) else g_Map_EnableWall(pan.arrIdx); + end; +begin + //e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY); + mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor)); + //e_WriteLog('--- toggle wall ---', MSG_NOTIFY); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +procedure holmesInitCommands (); +begin + if (cmdlist <> nil) then exit; + cmdAdd('win_layers', toggleLayersWindow, 'toggle layers window', 'window control'); + cmdAdd('win_outline', toggleOutlineWindow, 'toggle outline window', 'window control'); + cmdAdd('win_help', toggleHelpWindow, 'toggle help window', 'window control'); + cmdAdd('win_options', toggleOptionsWindow, 'toggle options window', 'window control'); + + cmdAdd('mon_think_step', bcOneMonsterThinkStep, 'one monster think step', 'monster control'); + cmdAdd('mon_info', bcToggleMonsterInfo, 'toggle monster info', 'monster control'); + cmdAdd('mon_los_plr', bcToggleMonsterLOSPlr, 'toggle monster LOS to player', 'monster control'); + cmdAdd('mon_cells', bcToggleMonsterCells, 'toggle "show all cells occupied by monsters" (SLOW!)', 'monster control'); + cmdAdd('mon_wakeup', bcMonsterWakeup, 'toggle "show all cells occupied by monsters" (SLOW!)', 'monster control'); + + cmdAdd('plr_teleport', bcPlayerTeleport, 'teleport player', 'player control'); + + cmdAdd('dbg_curpos', bcToggleCurPos, 'toggle "show cursor position on the map"', 'various'); + cmdAdd('dbg_grid', bcToggleGrid, 'toggle grid', 'various'); + + cmdAdd('atcur_select_monster', cbAtcurSelectMonster, 'select monster to operate', 'monster control'); + cmdAdd('atcur_dump_monsters', cbAtcurDumpMonsters, 'dump monsters in cell', 'monster control'); + cmdAdd('atcur_dump_walls', cbAtcurDumpWalls, 'dump walls in cell', 'wall control'); + cmdAdd('atcur_disable_walls', cbAtcurToggleWalls, 'disable walls', 'wall control'); +end; + + +procedure holmesInitBinds (); +var + st: TStream = nil; + pr: TTextParser = nil; + s, kn, v: AnsiString; + kmods: Byte; + mbuts: Byte; +begin + kbS := kbS; + if not keybindsInited then + begin + // keyboard + keybindAdd('F1', 'win_help'); + keybindAdd('M-F1', 'win_options'); + keybindAdd('C-O', 'win_outline'); + keybindAdd('C-L', 'win_layers'); + + keybindAdd('M-M', 'mon_think_step'); + keybindAdd('M-I', 'mon_info'); + keybindAdd('M-L', 'mon_los_plr'); + keybindAdd('M-G', 'mon_cells'); + keybindAdd('M-A', 'mon_wakeup'); + + keybindAdd('C-T', 'plr_teleport'); + + keybindAdd('C-P', 'dbg_curpos'); + keybindAdd('C-G', 'dbg_grid'); + + // mouse + msbindAdd('LMB', 'atcur_select_monster'); + msbindAdd('M-LMB', 'atcur_dump_monsters'); + msbindAdd('RMB', 'atcur_dump_walls'); + msbindAdd('M-RMB', 'atcur_disable_walls'); + + // load bindings from file + try + st := openDiskFileRO('holmes.rc'); + pr := TFileTextParser.Create(st); + conwriteln('parsing "holmes.rc"...'); + while (pr.tokType <> pr.TTEOF) do + begin + s := pr.expectId(); + if (s = 'stop') then break + else if (s = 'unbind_keys') then keybinds := nil + else if (s = 'unbind_mouse') then msbinds := nil + else if (s = 'bind') then + begin + if (pr.tokType = pr.TTStr) then s := pr.expectStr(false) + else if (pr.tokType = pr.TTInt) then s := Format('%d', [pr.expectInt()]) + else s := pr.expectId(); + + if (pr.tokType = pr.TTStr) then v := pr.expectStr(false) + else if (pr.tokType = pr.TTInt) then v := Format('%d', [pr.expectInt()]) + else v := pr.expectId(); + + kn := parseModKeys(s, kmods, mbuts); + if (CompareText(kn, 'lmb') = 0) or (CompareText(kn, 'rmb') = 0) or (CompareText(kn, 'mmb') = 0) or (CompareText(kn, 'None') = 0) then + begin + msbindAdd(s, v); + end + else + begin + keybindAdd(s, v); + end; + end; + end; + except on e: Exception do // sorry + if (pr <> nil) then conwritefln('Holmes config parse error at (%s,%s): %s', [pr.tokLine, pr.tokCol, e.message]); + end; + if (pr <> nil) then pr.Free() else st.Free(); // ownership + end; +end; + + end. diff --git a/src/game/g_holmes_cmd.inc b/src/game/g_holmes_cmd.inc new file mode 100644 index 0000000..60e72b4 --- /dev/null +++ b/src/game/g_holmes_cmd.inc @@ -0,0 +1,285 @@ +(* Copyright (C) DooM 2D:Forever Developers + * + * 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 3 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. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) +// ////////////////////////////////////////////////////////////////////////// // +type + TBindArgLessCB = procedure (); + TBindToggleCB = procedure (arg: Integer); // -1: no arg + + PHolmesCommand = ^THolmesCommand; + THolmesCommand = record + public + type TType = (TArgLess, TToggle); + + public + name: AnsiString; + help: AnsiString; + section: AnsiString; + cb: Pointer; + ctype: TType; + helpmark: Boolean; + + // command name already taken + procedure execute (pr: TTextParser); + end; + + PHolmesBinding = ^THolmesBinding; + THolmesBinding = record + key: AnsiString; // or mouse + cmd: AnsiString; + + function cmdName (): AnsiString; + end; + + TCmdHash = specialize THashBase; + + +// ////////////////////////////////////////////////////////////////////////// // +function THolmesBinding.cmdName (): AnsiString; +var + pr: TTextParser = nil; +begin + result := ''; + try + pr := TStrTextParser.Create(cmd); + if (pr.tokType = pr.TTStr) then result := pr.expectStr(false) else result := pr.expectId(); + except on E: Exception do + begin + result := ''; + end; + end; + pr.Free(); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +// command name already taken +procedure THolmesCommand.execute (pr: TTextParser); +var + a: Integer = -1; +begin + if not assigned(cb) then exit; + if (ctype = TType.TToggle) then + begin + if pr.skipBlanks() then + begin + if pr.eatId('true') or pr.eatId('tan') or pr.eatId('yes') then a := 1 + else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then a := 0 + else begin conwritefln('%s: invalid argument', [name]); exit; end; + end; + end; + if pr.skipBlanks() then begin conwritefln('%s: too many arguments', [name]); exit; end; + case ctype of + TType.TArgLess: TBindArgLessCB(cb)(); + TType.TToggle: TBindToggleCB(cb)(a); + else assert(false); + end; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +function ansistrEquCB (constref a, b: AnsiString): Boolean; begin result := (a = b); end; +function ansistrHashCB (constref a: AnsiString): LongWord; begin if (Length(a) > 0) then result := fnvHash(PChar(a)^, Length(a)) else result := 0; end; + +function hashNewCommand (): TCmdHash; +begin + result := TCmdHash.Create(ansistrHashCB, ansistrEquCB); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +type + PHBA = ^THBA; + THBA = array of THolmesBinding; + + +var + cmdlist: TCmdHash = nil; + keybinds: THBA = nil; + msbinds: THBA = nil; + keybindsInited: Boolean = false; + + +// ////////////////////////////////////////////////////////////////////////// // +function cmdNewInternal (const aname: AnsiString; const ahelp: AnsiString; const asection: AnsiString): PHolmesCommand; +begin + if (cmdlist = nil) then cmdlist := hashNewCommand(); + if not cmdlist.get(aname, result) then + begin + GetMem(result, sizeof(THolmesCommand)); + FillChar(result^, sizeof(THolmesCommand), 0); + result.name := aname; + result.help := ahelp; + result.section := asection; + result.cb := nil; + result.ctype := result.TType.TArgLess; + cmdlist.put(aname, result); + end + else + begin + result.help := ahelp; + result.section := asection; + end; +end; + + +procedure cmdAdd (const aname: AnsiString; cb: TBindArgLessCB; const ahelp: AnsiString; const asection: AnsiString); overload; +var + cmd: PHolmesCommand; +begin + if (Length(aname) = 0) or not assigned(cb) then exit; + cmd := cmdNewInternal(aname, ahelp, asection); + cmd.cb := Pointer(@cb); + cmd.ctype := cmd.TType.TArgLess; +end; + + +procedure cmdAdd (const aname: AnsiString; cb: TBindToggleCB; const ahelp: AnsiString; const asection: AnsiString); overload; +var + cmd: PHolmesCommand; +begin + if (Length(aname) = 0) or not assigned(cb) then exit; + cmd := cmdNewInternal(aname, ahelp, asection); + cmd.cb := Pointer(@cb); + cmd.ctype := cmd.TType.TToggle; +end; + + +function getCommandHelp (const aname: AnsiString): AnsiString; +var + cmd: PHolmesCommand = nil; +begin + if not cmdlist.get(aname, cmd) then result := '' else result := cmd.help; +end; + + +function getCommandSection (const aname: AnsiString): AnsiString; +var + cmd: PHolmesCommand = nil; +begin + if not cmdlist.get(aname, cmd) then result := '' else result := cmd.section; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +function internalBindAdd (ba: PHBA; const akey: AnsiString; const acmd: AnsiString): Boolean; +var + f, c: Integer; +begin + for f := 0 to High(ba^) do + begin + if (CompareText(ba^[f].key, akey) = 0) then + begin + if (Length(acmd) = 0) then + begin + // remove + result := false; + for c := f+1 to High(ba^) do ba^[c-1] := ba^[c]; + SetLength(ba^, Length(ba^)-1); + end + else + begin + // replace + result := true; + ba^[f].cmd := acmd; + end; + exit; + end; + end; + if (Length(acmd) > 0) then + begin + result := true; + SetLength(ba^, Length(ba^)+1); + ba^[High(ba^)].key := akey; + ba^[High(ba^)].cmd := acmd; + end + else + begin + result := false; + end; +end; + + +procedure keybindAdd (const akey: AnsiString; const acmd: AnsiString); +begin + internalBindAdd(@keybinds, akey, acmd); + keybindsInited := true; +end; + +procedure msbindAdd (const akey: AnsiString; const acmd: AnsiString); +begin + internalBindAdd(@msbinds, akey, acmd); + keybindsInited := true; +end; + + +procedure execCommand (const s: AnsiString); +var + pr: TTextParser = nil; + cmd: AnsiString; + cc: PHolmesCommand; +begin + if (cmdlist = nil) then + begin + conwriteln('holmes command system is not initialized!'); + exit; + end; + try + pr := TStrTextParser.Create(s); + if (pr.tokType = pr.TTStr) then cmd := pr.expectStr(false) else cmd := pr.expectId(); + if cmdlist.get(cmd, cc) then cc.execute(pr) else conwritefln('holmes command ''%s'' not found', [cmd]); + except on E: Exception do + begin + conwritefln('error executing holmes command: [%s]', [s]); + //conwritefln('* [%s] [%s]', [Integer(pr.tokType), E.message]); + end; + end; + pr.Free(); +end; + + +function keybindExecute (var ev: THKeyEvent): Boolean; +var + f: Integer; +begin + result := false; + for f := 0 to High(keybinds) do + begin + if (ev = keybinds[f].key) then + begin + result := true; + //conwritefln('found command [%s] for keybind <%s>', [keybinds[f].cmd, keybinds[f].key]); + execCommand(keybinds[f].cmd); + exit; + end; + end; +end; + + +function msbindExecute (var ev: THMouseEvent): Boolean; +var + f: Integer; +begin + result := false; + for f := 0 to High(msbinds) do + begin + if (ev = msbinds[f].key) then + begin + result := true; + execCommand(msbinds[f].cmd); + exit; + end; + end; +end; diff --git a/src/shared/hashtable.pas b/src/shared/hashtable.pas index b847720..8e6158f 100644 --- a/src/shared/hashtable.pas +++ b/src/shared/hashtable.pas @@ -49,6 +49,17 @@ type nextFree: PEntry; // next free entry end; + TValEnumerator = class + private + mEntries: PEntry; + mFirstEntry, mLastEntry, cur: Integer; + public + constructor Create (aents: PEntry; afirst, alast: Integer); + function MoveNext: Boolean; + function getCurrent (): ValueT; + property Current: ValueT read getCurrent; + end; + private hashfn: THashFn; equfn: TEquFn; @@ -90,11 +101,12 @@ type //WARNING! don't modify table in iterator (queries are ok, though) function forEach (it: TIteratorFn): Boolean; + function GetEnumerator (): TValEnumerator; + property count: Integer read mBucketsUsed; property capacity: Integer read getCapacity; end; - type TJoaatHasher = record private @@ -107,7 +119,7 @@ type procedure reset (); inline; overload; procedure reset (aseed: LongWord); inline; overload; - procedure put (const buf; len: LongWord); + procedure put (constref buf; len: LongWord); // current hash value // you can continue putting data, as this is not destructive @@ -122,8 +134,8 @@ function hashNewIntInt (): THashIntInt; function u32Hash (a: LongWord): LongWord; inline; -function fnvHash (const buf; len: LongWord): LongWord; -function joaatHash (const buf; len: LongWord): LongWord; +function fnvHash (constref buf; len: LongWord): LongWord; +function joaatHash (constref buf; len: LongWord): LongWord; function nextPOT (x: LongWord): LongWord; inline; @@ -198,7 +210,7 @@ begin end; -procedure TJoaatHasher.put (const buf; len: LongWord); +procedure TJoaatHasher.put (constref buf; len: LongWord); var bytes: PByte; h: LongWord; @@ -228,12 +240,12 @@ end; {$POP} -function joaatHash (const buf; len: LongWord): LongWord; +function joaatHash (constref buf; len: LongWord): LongWord; var h: TJoaatHasher; begin h := TJoaatHasher.Create(0); - h.put(buf, len); + h.put(PByte(@buf)^, len); result := h.value; end; @@ -242,7 +254,7 @@ end; {$PUSH} {$RANGECHECKS OFF} // fnv-1a: http://www.isthe.com/chongo/tech/comp/fnv/ -function fnvHash (const buf; len: LongWord): LongWord; +function fnvHash (constref buf; len: LongWord): LongWord; var b: PByte; begin @@ -861,4 +873,40 @@ begin end; +function THashBase.GetEnumerator (): TValEnumerator; +begin + if (Length(mEntries) > 0) then + begin + result := TValEnumerator.Create(@mEntries[0], mFirstEntry, mLastEntry); + end + else + begin + result := TValEnumerator.Create(nil, -1, -1); + end; +end; + +constructor THashBase.TValEnumerator.Create (aents: PEntry; afirst, alast: Integer); +begin + mEntries := aents; + mFirstEntry := afirst; + mLastEntry := alast; + cur := mFirstEntry-1; +end; + +function THashBase.TValEnumerator.MoveNext: Boolean; +begin + Inc(cur); + while (cur <= mLastEntry) do + begin + if (mEntries[cur].hash <> 0) then begin result := true; exit; end; + end; + result := false; +end; + +function THashBase.TValEnumerator.getCurrent (): ValueT; +begin + result := mEntries[cur].value; +end; + + end. diff --git a/src/shared/xparser.pas b/src/shared/xparser.pas index fe17d0c..d8b600d 100644 --- a/src/shared/xparser.pas +++ b/src/shared/xparser.pas @@ -110,6 +110,7 @@ type public constructor Create (const fname: AnsiString; loadToken: Boolean=true); + constructor Create (st: TStream; loadToken: Boolean=true); // will take ownership on st destructor Destroy (); override; end; @@ -591,6 +592,14 @@ begin end; +constructor TFileTextParser.Create (st: TStream; loadToken: Boolean=true); +begin + if (st = nil) then raise Exception.Create('cannot create parser for nil stream'); + mFile := st; + inherited Create(loadToken); +end; + + destructor TFileTextParser.Destroy (); begin mFile.Free();