[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/gnugo ae888ba 105/357: [gnugo] Add command ‘gnugo-oops
From: |
Stefan Monnier |
Subject: |
[elpa] externals/gnugo ae888ba 105/357: [gnugo] Add command ‘gnugo-oops’ and keybinding. |
Date: |
Sun, 29 Nov 2020 14:50:59 -0500 (EST) |
branch: externals/gnugo
commit ae888bad053df8162bd82c3d95be25e5f4348c0c
Author: Thien-Thi Nguyen <ttn@gnu.org>
Commit: Thien-Thi Nguyen <ttn@gnu.org>
[gnugo] Add command ‘gnugo-oops’ and keybinding.
* packages/gnugo/gnugo.el (gnugo--no-regrets): New defsubst.
(gnugo-note): Detect déjà-vu; handle non-tip growth.
(gnugo-magic-undo): Take optional 3rd arg KEEP;
inhibit truncation if non-nil or if already "remorseful".
(gnugo-oops): New command.
(gnugo-board-mode-map): Bind ‘o’ to ‘gnugo-oops’.
---
NEWS | 1 +
gnugo.el | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------
2 files changed, 88 insertions(+), 9 deletions(-)
diff --git a/NEWS b/NEWS
index 47f570b..ee374a2 100644
--- a/NEWS
+++ b/NEWS
@@ -15,6 +15,7 @@ NB: "RCS: X..Y " means that the particular release includes
- PASS for SZ <= 19 normalized to "" on read, written as ""
- new keybinding for ‘gnugo-undo-one-move’: M-u
- ‘gnugo-undo-one-move’ can optionally arrange for you to play next
+ - new command: ‘o’ (gnugo-oops)
- ‘gnugo-move-history’ returns last two moves w/ RSEL ‘two’
- performance improvements
- of interest to hackers (see source, BI => backward incompatible)
diff --git a/gnugo.el b/gnugo.el
index 9cd05fc..1107f18 100644
--- a/gnugo.el
+++ b/gnugo.el
@@ -688,6 +688,10 @@ For all other values of RSEL, do nothing and return nil."
(defsubst gnugo--passp (string)
(string= "PASS" string))
+(defsubst gnugo--no-regrets (monkey tree)
+ (eq (aref tree (aref monkey 1))
+ (aref monkey 0)))
+
(defun gnugo-note (property value &optional mogrifyp)
(when mogrifyp
(let ((sz (gnugo-get :SZ)))
@@ -702,16 +706,71 @@ For all other values of RSEL, do nothing and return nil."
(setq value (if (consp value)
(mapcar #'mog value)
(mog value))))))
- (let* ((fruit (list (cons property value)))
+ (let* ((pair (cons property value))
+ (fruit (list pair))
(monkey (gnugo-get :monkey))
(mem (aref monkey 0)))
(if (memq property '(:B :W))
(let ((tree (gnugo-get :sgf-gametree))
(bidx (aref monkey 1)))
- (push fruit mem)
- ;; todo: do variation check/merge/branch here.
- (setf (aref monkey 0) mem
- (aref tree bidx) mem)
+ ;; Detect déjà-vu. That is, when placing "A", avoid:
+ ;;
+ ;; X---Y---A new
+ ;; \
+ ;; --A---B old
+ ;;
+ ;; (such "variations" do not actually vary!) in favor of:
+ ;;
+ ;; X---Y---A new
+ ;; \
+ ;; --B old
+ ;;
+ ;; This presumes ‘bidx’ is 0 (main line) and that
+ ;; all growth should occur on the main line.
+ (cl-labels
+ ((continue-on (bx)
+ (rotatef (aref tree bidx)
+ (aref tree bx))))
+ ;; ugh, quadratic
+ (loop
+ with count = (length tree)
+ with (bx previous)
+ for i
+ ;; Start with latest / highest likelihood for hit.
+ ;; todo: prune unfeasible candidates
+ from 0 above (- count)
+ if (setq bx (mod i count)
+ previous
+ ;; todo: early termination based on move number
+ (loop for m on (aref tree bx)
+ if (eq mem (cdr m))
+ return
+ (when (equal pair (assoc property (car m)))
+ m)
+ finally return
+ nil))
+ ;; yes => follow
+ return
+ (progn
+ ;; (message "déjà-vu! %d follows %d" bidx bx)
+ (unless (= bidx bx)
+ (continue-on bx))
+ (setq mem previous))
+ ;; no => construct
+ finally do
+ (progn
+ ;; (message "new %d" bidx)
+ (unless (gnugo--no-regrets monkey tree)
+ ;; <grumble grumble> SGF sez "move" node in the root
+ ;; position of a (sub-)gametree is "bad style". :-/
+ (let ((where (memq tree (gnugo-get :sgf-collection))))
+ (setq tree (apply 'vector (append tree (list mem))))
+ (continue-on count)
+ (gnugo-put :sgf-gametree tree)
+ (setcar where tree)))
+ (push fruit mem)
+ (aset tree bidx mem))))
+ (setf (aref monkey 0) mem)
(incf (aref monkey 2)))
(setcdr (last (car mem)) fruit))))
@@ -1357,7 +1416,7 @@ If FILENAME already exists, Emacs confirms that you wish
to overwrite it."
(set-buffer-modified-p nil)
(gnugo--who-is-who wait play samep)))
-(defun gnugo-magic-undo (spec &optional noalt)
+(defun gnugo-magic-undo (spec &optional noalt keep)
"Undo moves on the GNUGO Board, based on SPEC, a string or number.
If SPEC is a string in the form of a board position (e.g., \"T19\"),
check that the position is occupied by a stone of the user's color,
@@ -1373,11 +1432,17 @@ a number) after finishing, the color to play is not the
user's color,
schedule a move by GNU Go.
After undoing the move(s), schedule a move by GNU Go if it is GNU Go's
-turn to play. Optional second arg NOALT non-nil inhibits this."
+turn to play. Optional second arg NOALT non-nil inhibits this.
+
+Optional third arg KEEP non-nil means do not prune the undone moves
+from the gametree, such that they become a sub-gametree (variation)
+when play resumes."
(gnugo-gate)
(let* ((n 0)
(user-color (gnugo-get :user-color))
(monkey (gnugo-get :monkey))
+ (tree (gnugo-get :sgf-gametree))
+ (remorseful (not (gnugo--no-regrets monkey tree)))
done ans)
(cond ((numberp spec)
(setq n (if (zerop spec)
@@ -1421,8 +1486,8 @@ turn to play. Optional second arg NOALT non-nil inhibits
this."
ubpos
(gnugo-get :center-position)))
(gnugo-refresh t)
- ;; preserve restricted-functionality semantics (todo: remove restriction)
- (aset (gnugo-get :sgf-gametree) (aref monkey 1) (aref monkey 0))
+ (unless (or keep remorseful)
+ (aset tree (aref monkey 1) (aref monkey 0)))
(when (and ulastp (not noalt))
(gnugo-get-move (gnugo-get :gnugo-color))))))
@@ -1455,6 +1520,18 @@ Regardless, after undoing, it is your turn to play
again."
(gnugo-gate)
(gnugo-magic-undo 0))
+(defun gnugo-oops (&optional position)
+ "Like `gnugo-undo-two-moves', but keep the undone moves.
+The kept moves become a sub-gametree (variation) when play resumes.
+Prefix arg means, instead, undo repeatedly up to and including
+the move which placed the stone at point, like `\\[gnugo-fancy-undo]'."
+ (interactive "P")
+ (gnugo-gate)
+ (gnugo-magic-undo (if position
+ (gnugo-position)
+ 0)
+ nil t))
+
(defun gnugo-display-final-score ()
"Display final score and other info in another buffer (when game over).
If the game is still ongoing, Emacs asks if you wish to stop play (by
@@ -1871,6 +1948,7 @@ starting a new one. See `gnugo-board-mode' documentation
for more info."
("\M-u" . gnugo-undo-one-move)
("u" . gnugo-undo-two-moves)
("\C-?" . gnugo-undo-two-moves)
+ ("o" . gnugo-oops)
("\C-l" . gnugo-refresh)
("\M-_" . gnugo-boss-is-near)
("_" . gnugo-boss-is-near)
- [elpa] externals/gnugo 7293802 088/357: [gnugo int] Use ‘setq’ less., (continued)
- [elpa] externals/gnugo 7293802 088/357: [gnugo int] Use ‘setq’ less., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 35b1551 091/357: [gnugo int] Use ‘loop’ instead of ‘mapc’ + ‘apply’., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo b5990a0 085/357: [gnugo int] Use ‘gnugo-treeroot’ more., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo f9668f0 090/357: [gnugo int] Add abstraction: gnugo--blackp, Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo c164c40 092/357: [gnugo int] Add abstraction: gnugo--passp, Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo bf04735 094/357: [gnugo] Fix bug: Don't misuse SGF prop ‘:EV’ for "resign" state., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo e036fed 096/357: [gnugo] Fix bug: On load, follow mainline through subtrees., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo eaaa7c8 102/357: [gnugo int] Invert gametree IR to hang by the leaves., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo ed11a74 101/357: [gnugo int] Embrace (NODE[...] [SUBTREE...]) IR, for now., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo b7843bf 103/357: [gnugo maint] Move hi-lock hint from NEWS to HACKING; nfc., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo ae888ba 105/357: [gnugo] Add command ‘gnugo-oops’ and keybinding.,
Stefan Monnier <=
- [elpa] externals/gnugo 2c5e356 107/357: [gnugo maint] Add some debugging aids to HACKING; nfc., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo a708759 110/357: [gnugo int] Use ‘cl-labels’ less., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo a35f657 115/357: [gnugo] Support SGF[4] parsing from string data., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 3d8db48 119/357: [gnugo] Declare dependency on ‘ascii-art-to-unicode’., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 4b866c7 127/357: [gnugo int] Avoid lower move-num candidates in déjà-vu search., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 5b51e4f 129/357: [gnugo int] Decruft: Consolidate "breathe in" loops., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo fda0ca5 130/357: [gnugo int] Move precise fanout computation to "breathe in"., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo cbf99df 131/357: [gnugo int] Insert frolic xrep starting w/ the leaves., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo 5c87b11 141/357: [gnugo frolic int] Use ‘move-to-column’ more., Stefan Monnier, 2020/11/29
- [elpa] externals/gnugo d62412f 144/357: [gnugo int] Add abstraction: gnugo--move-to-bcol, Stefan Monnier, 2020/11/29