nxhtml/util/n-back.el

   1 ;;; n-back.el --- n-back game
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: 2009-05-23 Sat
   5 (defconst n-back:version "0.5");; Version:
   6 ;; Last-Updated: 2009-08-04 Tue
   7 ;; URL:
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; Features that might be required by this library:
  12 ;;
  13 ;; `winsize'.
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;; n-back game for brain training.  See `n-back-game' for more
  20 ;; information.
  21 ;;
  22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 ;;
  24 ;;; Change log:
  25 ;;
  26 ;;
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28 ;;
  29 ;; This program is free software; you can redistribute it and/or
  30 ;; modify it under the terms of the GNU General Public License as
  31 ;; published by the Free Software Foundation; either version 3, or
  32 ;; (at your option) any later version.
  33 ;;
  34 ;; This program is distributed in the hope that it will be useful,
  35 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  36 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  37 ;; General Public License for more details.
  38 ;;
  39 ;; You should have received a copy of the GNU General Public License
  40 ;; along with this program; see the file COPYING.  If not, write to
  41 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  42 ;; Floor, Boston, MA 02110-1301, USA.
  43 ;;
  44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45 ;;
  46 ;;; Code:
  47
  48 ;;(eval-when-compile (require 'viper))
  49
  50 ;; (setq n-back-trials 2)
  51 (eval-when-compile (require 'cl))
  52 (eval-when-compile (require 'nxhtml-base nil t))
  53 (eval-when-compile (require 'nxhtml-web-vcs nil t))
  54 (require 'winsize nil t) ;; Ehum...
  55
  56 (defvar n-back-game-window nil)
  57 (defvar n-back-game-buffer nil)
  58
  59 (defvar n-back-ctrl-window nil)
  60 (defvar n-back-ctrl-buffer nil)
  61
  62 (defvar n-back-info-window nil)
  63 (defvar n-back-info-buffer nil)
  64
  65 (defvar n-back-trials-left nil)
  66 (defvar n-back-timer nil)
  67 (defvar n-back-clear-timer nil)
  68
  69 (defvar n-back-result nil)
  70 (defvar n-back-this-result nil)
  71
  72 (defvar n-back-ring nil)
  73
  74 (defvar n-back-num-active nil)
  75
  76
  77 ;;;###autoload
  78 (defgroup n-back nil
  79   "Customizations for `n-back-game' game."
  80   :group 'games)
  81
  82 (defgroup n-back-feel nil
  83   "Customizations for `n-back-game' game keys, faces etc."
  84   :group 'n-back)
  85
  86 (defface n-back-ok
  87   '((t (:foreground "black" :background "green")))
  88   "Face for OK answer."
  89   :group 'n-back-feel)
  90
  91 (defface n-back-bad
  92   '((t (:foreground "black" :background "OrangeRed1")))
  93   "Face for bad answer."
  94   :group 'n-back-feel)
  95
  96 (defface n-back-hint
  97   '((t (:foreground "black" :background "gold")))
  98   "Face for bad answer."
  99   :group 'n-back-feel)
 100
 101 (defface n-back-do-now
 102   '((((background dark)) (:foreground "yellow"))
 103     (t (:foreground "blue")))
 104   "Face for start and stop hints."
 105   :group 'n-back-feel)
 106
 107 (defface n-back-game-word
 108   '((t (:foreground "black")))
 109   "Face for word displayed in game."
 110   :group 'n-back-feel)
 111
 112 (defface n-back-header
 113   '((((background dark)) (:background "OrangeRed4"))
 114     (t (:background "gold")))
 115   "Face for headers."
 116   :group 'n-back-feel)
 117
 118 (defface n-back-keybinding
 119   '((((background dark)) (:background "purple4"))
 120     (t (:background "OliveDrab1")))
 121   "Face for key bindings."
 122   :group 'n-back-feel)
 123
 124 (defface n-back-last-result
 125   '((((background dark)) (:background "OliveDrab4"))
 126     (t (:background "yellow")))
 127   "Face for last game result header."
 128   :group 'n-back-feel)
 129
 130 (defface n-back-welcome
 131   '((((background dark)) (:foreground "OliveDrab3"))
 132     (t (:foreground "OliveDrab4")))
 133   "Face for welcome string"
 134   :group 'n-back-feel)
 135
 136 (defface n-back-welcome-header
 137   '((t (:height 2.0)))
 138   "Face for welcome header."
 139   :group 'n-back-feel)
 140
 141 (defcustom n-back-level 1
 142   "The n-Back level."
 143   :type '(radio (const 1)
 144                 (const 2)
 145                 (const 3)
 146                 (const 4))
 147   :set (lambda (sym val)
 148          (set-default sym val)
 149          (when (featurep 'n-back)
 150            (n-back-update-control-buffer)
 151            (n-back-update-info)))
 152   :group 'n-back)
 153
 154 (defcustom n-back-active-match-types '(position color sound)
 155   "Active match types."
 156   :type '(set (const position)
 157               (const color)
 158               (const sound)
 159               (const word))
 160   :set (lambda (sym val)
 161          (set-default sym val)
 162          (setq n-back-num-active (length val))
 163          (when (featurep 'n-back)
 164            (n-back-init-control-status)
 165            (n-back-update-control-buffer)
 166            (n-back-update-info)))
 167   :group 'n-back)
 168
 169 (defcustom n-back-allowed-match-types '(position color sound word)
 170   "Match types allowed in auto challenging."
 171   :type '(set (const position)
 172               (const color)
 173               (const sound)
 174               (const word))
 175   :set (lambda (sym val)
 176          (set-default sym val)
 177          (when (featurep 'n-back)
 178            (n-back-set-random-match-types (length n-back-active-match-types) nil)
 179            (n-back-init-control-status)
 180            (n-back-update-control-buffer)
 181            (n-back-update-info)))
 182   :group 'n-back)
 183
 184 (defcustom n-back-auto-challenge t
 185   "Automatic challenge decrease/increase."
 186   :type 'boolean
 187   :group 'n-back)
 188
 189 (defun n-back-toggle-auto-challenge ()
 190   "Toggle `n-back-auto-challenge'."
 191   (interactive)
 192   (let ((val (not n-back-auto-challenge)))
 193     (customize-set-variable 'n-back-auto-challenge val)
 194     (customize-set-value 'n-back-auto-challenge val)))
 195
 196 (defcustom n-back-colors
 197   '("gold" "orange red" "lawn green" "peru" "pink" "gray" "light blue")
 198   "Random colors to display."
 199   :type '(repeat color)
 200   :group 'n-back)
 201
 202 (defcustom n-back-words "you cat going me forest crying brown"
 203   "Random words to display."
 204   :type 'string
 205   :group 'n-back)
 206
 207 (defcustom n-back-sound-volume 0.2
 208   "Sound volume 0-1."
 209   :type 'float
 210   :group 'n-back-feel)
 211
 212 (defcustom n-back-sounds '("c:/program files/brain workshop/res" "piano-")
 213   "Random sounds location."
 214   :type '(list (directory :tag "Directory")
 215                (regexp :tag "File name regexp"))
 216   :group 'n-back)
 217
 218 (defcustom n-back-keys
 219   '(
 220     [?p]
 221     [?c]
 222     [?s]
 223     [?w]
 224     )
 225   "Key bindings for answering."
 226   :type '(list
 227           (key-sequence :tag "position key")
 228           (key-sequence :tag "color key")
 229           (key-sequence :tag "sound key")
 230           (key-sequence :tag "word key")
 231           )
 232   ;; :set (lambda (sym val)
 233   ;;        (set-default sym val)
 234   ;;        (n-back-make-keymap))
 235   :group 'n-back-feel)
 236
 237 (defvar n-back-control-mode-map nil)
 238
 239 (defun n-back-key-binding (what)
 240   "Return key binding used for WHAT match answers."
 241   (nth
 242    (case what
 243      (position 0)
 244      (color    1)
 245      (sound    2)
 246      (word     3))
 247    n-back-keys))
 248
 249 (defun n-back-make-keymap ()
 250   "Make keymap for the game."
 251   (let ((map (make-sparse-keymap)))
 252     (define-key map [?1] 'n-back-change-level)
 253     (define-key map [?2] 'n-back-change-level)
 254     (define-key map [?3] 'n-back-change-level)
 255     (define-key map [?4] 'n-back-change-level)
 256     (define-key map [?5] 'n-back-change-level)
 257     (define-key map [?6] 'n-back-change-level)
 258     (define-key map [??] 'n-back-help)
 259     (define-key map [?\ ] 'n-back-play)
 260     (define-key map [(control ?g)] 'n-back-stop)
 261     (define-key map [?-] 'n-back-decrease-speed)
 262     (define-key map [?+] 'n-back-increase-speed)
 263
 264     (define-key map [(control ?r)] 'n-back-reset-game-to-saved)
 265     (define-key map [(control ?s)] 'n-back-save-game-settings)
 266
 267     (define-key map [?t ?p] 'n-back-toggle-position)
 268     (define-key map [?t ?c] 'n-back-toggle-color)
 269     (define-key map [?t ?s] 'n-back-toggle-sound)
 270     (define-key map [?t ?w] 'n-back-toggle-word)
 271
 272     (define-key map [?T ?a] 'n-back-toggle-auto-challenge)
 273     (define-key map [up]    'n-back-challenge-up)
 274     (define-key map [down]  'n-back-challenge-down)
 275
 276     (define-key map [?T ?p] 'n-back-toggle-allowed-position)
 277     (define-key map [?T ?c] 'n-back-toggle-allowed-color)
 278     (define-key map [?T ?s] 'n-back-toggle-allowed-sound)
 279     (define-key map [?T ?w] 'n-back-toggle-allowed-word)
 280
 281     (define-key map (n-back-key-binding 'position) 'n-back-position-answer)
 282     (define-key map (n-back-key-binding 'color)    'n-back-color-answer)
 283     (define-key map (n-back-key-binding 'sound)    'n-back-sound-answer)
 284     (define-key map (n-back-key-binding 'word)     'n-back-word-answer)
 285     ;;(define-key map [t] 'ignore)
 286     (setq n-back-control-mode-map map)))
 287
 288 (defvar n-back-display-hint nil)
 289 (defcustom n-back-hint t
 290   "Display hints - learning mode."
 291   :type 'boolean
 292   :group 'n-back)
 293
 294
 295
 296 (defvar n-back-sound-files nil)
 297 ;;(n-back-get-sound-files)
 298 (defun n-back-get-sound-files ()
 299   "Get sound file names."
 300   (let ((dir (nth 0 n-back-sounds))
 301         (regexp (nth 1 n-back-sounds)))
 302     (when (file-directory-p dir)
 303       (setq n-back-sound-files (directory-files dir nil regexp)))))
 304
 305 (defun n-back-toggle-position ()
 306   "Toggle use of position in `n-back-active-match-types'."
 307   (interactive)
 308   (n-back-toggle 'position))
 309
 310 (defun n-back-toggle-color ()
 311   "Toggle use of color in `n-back-active-match-types'."
 312   (interactive)
 313   (n-back-toggle 'color))
 314
 315 (defun n-back-toggle-sound ()
 316   "Toggle use of sound in `n-back-active-match-types'."
 317   (interactive)
 318   (n-back-toggle 'sound))
 319
 320 (defun n-back-toggle-word ()
 321   "Toggle use of word in `n-back-active-match-types'."
 322   (interactive)
 323   (n-back-toggle 'word))
 324
 325 (defun n-back-toggle (match-type)
 326   "Toggle use of MATCH-TYPE in `n-back-active-match-types'."
 327   (n-back-toggle-1 match-type 'n-back-active-match-types))
 328
 329 (defun n-back-toggle-allowed-position ()
 330   "Toggle use of position in `n-back-allowed-match-types'."
 331   (interactive)
 332   (n-back-toggle-allowed 'position))
 333
 334 (defun n-back-toggle-allowed-color ()
 335   "Toggle use of color in `n-back-allowed-match-types'."
 336   (interactive)
 337   (n-back-toggle-allowed 'color))
 338
 339 (defun n-back-toggle-allowed-sound ()
 340   "Toggle use of sound in `n-back-allowed-match-types'."
 341   (interactive)
 342   (n-back-toggle-allowed 'sound))
 343
 344 (defun n-back-toggle-allowed-word ()
 345   "Toggle use of word in `n-back-allowed-match-types'."
 346   (interactive)
 347   (n-back-toggle-allowed 'word))
 348
 349 (defun n-back-toggle-allowed (match-type)
 350   "Toggle use of MATCH-TYPE in `n-back-allowed-match-types'."
 351   (n-back-toggle-1 match-type 'n-back-allowed-match-types))
 352
 353 (defun n-back-sort-types (types)
 354   "Sort TYPES to order used in defcustoms here."
 355   (sort types
 356         (lambda (a b)
 357           (let ((all '(position color sound word)))
 358             (< (length (memq a all))
 359                (length (memq b all)))))))
 360
 361 (defun n-back-toggle-1 (match-type active-list-sym)
 362   "Toggle use of MATCH-TYPE in list ACTIVE-LIST-SYM."
 363   (let (active-types)
 364     (if (memq match-type (symbol-value active-list-sym))
 365         (setq active-types (delq match-type (symbol-value active-list-sym)))
 366       (setq active-types (cons match-type (symbol-value active-list-sym))))
 367     (setq active-types (n-back-sort-types active-types))
 368     (customize-set-variable active-list-sym active-types)
 369     (customize-set-value active-list-sym active-types)))
 370
 371 (defcustom n-back-sec-per-trial 3.0
 372   "Seconds per trial."
 373   :type 'float
 374   :set (lambda (sym val)
 375          (set-default sym val)
 376          (when (featurep 'n-back)
 377            (n-back-update-info)))
 378   :group 'n-back)
 379
 380 (defun n-back-decrease-speed ()
 381   "Decrease speed of trials."
 382   (interactive)
 383   (setq n-back-sec-per-trial (+ n-back-sec-per-trial 0.25))
 384   (when (> n-back-sec-per-trial 5.0)
 385     (setq n-back-sec-per-trial 5.0))
 386   (n-back-update-info))
 387
 388 (defun n-back-increase-speed ()
 389   "Increase speed of trials."
 390   (interactive)
 391   (let ((sec (- n-back-sec-per-trial 0.25)))
 392     (when (< sec 1.0)
 393       (setq sec 1.0))
 394     (customize-set-variable 'n-back-sec-per-trial sec)
 395     (customize-set-value 'n-back-sec-per-trial sec)))
 396
 397 (defun n-back-help ()
 398   "Show help for `n-back-game' game."
 399   (interactive)
 400   (save-selected-window
 401     (describe-function 'n-back-game)))
 402
 403 (defun n-back-change-level (level)
 404   "Change n-Back level to LEVEL."
 405   (interactive (progn
 406                  (if (and (numberp last-input-event)
 407                           (>= last-input-event ?1)
 408                           (<= last-input-event ?9))
 409                      (list (- last-input-event ?0))
 410                    (list (string-to-number (read-string "n Back: "))))))
 411   (customize-set-variable 'n-back-level level)
 412   (customize-set-value 'n-back-level level))
 413
 414 (defvar n-back-frame nil)
 415
 416 ;;;###autoload
 417 (defun n-back-game ()
 418   "Emacs n-Back game.
 419 This game is supposed to increase your working memory and fluid
 420 intelligence.
 421
 422 In this game something is shown for half a second on the screen
 423 and maybe a sound is played.  You should then answer if parts of
 424 it is the same as you have seen or heard before.  This is
 425 repeated for about 20 trials.
 426
 427 You answer with the keys shown in the bottom window.
 428
 429 In the easiest version of the game you should answer if you have
 430 just seen or heard what is shown now.  By default the game gets
 431 harder as you play it with success.  Then first the number of
 432 items presented in a trial grows.  After that it gets harder by
 433 that you have to somehow remember not the last item, but the item
 434 before that \(or even earlier). That is what \"n-Back\" stands
 435 for.
 436
 437 Note that remember does not really mean remember clearly.  The
 438 game is for training your brain getting used to keep those things
 439 in the working memory, maybe as a cross-modal unit.  You are
 440 supposed to just nearly be able to do what you do in the game.
 441 And you are supposed to have fun, that is what your brain like.
 442
 443 You should probably not overdue this. Half an hour a day playing
 444 might be an optimal time according to some people.
 445
 446 The game is shamelessly modeled after Brain Workshop, see URL
 447 `http://brainworkshop.sourceforge.net/' just for the fun of
 448 getting it into Emacs.  The game resembles but it not the same as
 449 that used in the report by Jaeggi mentioned at the above URL.
 450
 451 Not all features in Brain Workshop are implemented here, but some
 452 new are maybe ... - and you have it available here in Emacs."
 453   ;; -----
 454   ;; Below is a short excerpt from the report by Jaeggi et al which
 455   ;; gave the idea to the game:
 456
 457   ;; Training task.  For the training task, we used the same material
 458   ;; as described by Jaeggi et al.  (33), which was a dual n-Back task
 459   ;; where squares at eight different locations were presented
 460   ;; sequentially on a computer screen at a rate of 3 s (stimulus
 461   ;; length, 500 ms; interstimulus interval, 2,500 ms).
 462   ;; Simultaneously with the presentation of the squares, one of eight
 463   ;; consonants was presented sequentially through headphones.  A
 464   ;; response was required whenever one of the presented stimuli
 465   ;; matched the one presented n positions back in the sequence.  The
 466   ;; value of n was the same for both streams of stimuli.  There were
 467   ;; six auditory and six visual targets per block (four appearing in
 468   ;; only one modality, and two appearing in both modalities
 469   ;; simultaneously), and their positions were determined randomly.
 470   ;; Participants made responses manually by pressing on the letter
 471   ;; ‘‘A’’ of a standard keyboard with their left index finger for
 472   ;; visual targets, and on the letter ‘‘L’’ with their right index
 473   ;; finger for auditory targets.  No responses were required for
 474   ;; non-targets.
 475   (interactive)
 476   (n-back-make-keymap)
 477   (when window-system
 478     (unless (frame-live-p n-back-frame)
 479       (setq n-back-frame (make-frame
 480                           (list '(name . "n-back game")
 481                                 '(tool-bar-lines . 0)
 482                                 '(menu-bar-lines . 0)
 483                                 (case (frame-parameter nil 'background-mode)
 484                                   (light '(background-color . "cornsilk"))
 485                                   (dark  '(background-color . "MidnightBlue"))
 486                                   (otherwise nil))
 487                                 '(height . 45)
 488                                 '(width . 150)))))
 489     (select-frame n-back-frame)
 490     (raise-frame n-back-frame))
 491   (n-back-cancel-timers)
 492   (n-back-get-sound-files)
 493   (unless n-back-sound-files
 494     (when (memq 'sound n-back-allowed-match-types)
 495       (n-back-toggle-allowed-sound))
 496     (when (memq 'sound n-back-active-match-types)
 497       (n-back-toggle-sound)))
 498   (n-back-init-control-status)
 499   (n-back-setup-windows)
 500   )
 501
 502 (defconst n-back-match-types
 503   '((position ": position match" nil)
 504     (color    ": color match" nil)
 505     (sound    ": sound match" nil)
 506     (word     ": word match" nil)
 507     ))
 508
 509 (defvar n-back-control-status nil
 510   "For showing status in control window.")
 511 (setq n-back-control-status nil)
 512
 513 ;;(n-back-set-match-status 'position 'bad)
 514 (defun n-back-set-match-status (match-type status)
 515   "Set MATCH-TYPE status to STATUS for control window."
 516   (unless (memq status '(ok bad miss nil)) (error "n-back: Bad status=%s" status))
 517   (let ((entry (assoc match-type n-back-control-status)))
 518     (setcar (cddr entry) status)
 519     ))
 520
 521 ;;(n-back-clear-match-status)
 522 (defun n-back-clear-match-status ()
 523   "Clear match status for control window."
 524   ;;(dolist (entry n-back-control-status)
 525   (dolist (entry n-back-match-types)
 526     (setcar (cddr entry) nil)
 527     ))
 528
 529 ;; (n-back-init-control-status)
 530 (defun n-back-init-control-status ()
 531   "Init match status for control window."
 532   (setq n-back-control-status nil)
 533   (dolist (what n-back-active-match-types)
 534     (setq n-back-control-status
 535           (cons (assoc what n-back-match-types)
 536                 n-back-control-status))))
 537
 538 (defsubst n-back-is-playing ()
 539   "Return non-nil when game is active."
 540   (timerp n-back-timer))
 541
 542 ;;(n-back-update-control-buffer)
 543 (defun n-back-update-control-buffer ()
 544   "Update content of control buffer."
 545   (save-match-data ;; runs in timer
 546     (when (buffer-live-p n-back-ctrl-buffer)
 547       (with-current-buffer n-back-ctrl-buffer
 548         (setq buffer-read-only nil)
 549         (erase-buffer)
 550         (insert (propertize (format "%s %s-back"
 551                                     (let ((n (length n-back-active-match-types)))
 552                                       (cond
 553                                        ((= 1 n) "Single")
 554                                        ((= 2 n) "Dual")
 555                                        ((= 3 n) "Triple")
 556                                        ))
 557                                     n-back-level
 558                                     ) 'face 'n-back-header)
 559                 (propertize
 560                  (if (n-back-is-playing) "  Press C-g to stop" "  Press SPACE to play")
 561                  'face 'n-back-do-now)
 562                 (if (n-back-is-playing) (format "  Left %s" n-back-trials-left) "")
 563                 "\n")
 564         ;;(unless n-back-control-status (n-back-init-control-status))
 565         (dolist (entry n-back-control-status)
 566           (let* ((what (nth 0 entry))
 567                  (msg  (nth 1 entry))
 568                  (sts  (nth 2 entry))
 569                  (key (key-description (n-back-key-binding what))))
 570             ;;(setq msg (concat (key-description (n-back-key-binding what)) msg))
 571             (cond
 572              ((eq sts 'bad)
 573               (setq msg (propertize (concat key msg) 'face 'n-back-bad)))
 574              ((eq sts 'ok)
 575               (setq msg (propertize (concat key msg) 'face 'n-back-ok)))
 576              ((eq sts 'miss)
 577               (setq msg (concat
 578                          (if n-back-display-hint
 579                              (propertize key 'face 'n-back-header)
 580                            key)
 581                          msg)))
 582              ((not sts)
 583               (setq msg (concat key msg)))
 584              (t
 585               (error "n-back:Unknown sts=%s" sts)
 586               ))
 587             (insert msg "   "))
 588           )
 589         (when n-back-display-hint
 590           (setq n-back-display-hint nil)
 591           (run-with-timer 0.1 nil 'n-back-update-control-buffer))
 592         (setq buffer-read-only t)
 593         (if (window-live-p n-back-ctrl-window)
 594             (with-selected-window n-back-ctrl-window
 595               (goto-char 1))
 596           (goto-char 1))))))
 597
 598 (defcustom n-back-trials 20
 599   "Number of trials per session."
 600   :type 'integer
 601   :group 'n-back)
 602
 603 ;;(n-back-compute-result-values n-back-result)
 604 (defvar n-back-result-values nil)
 605 (defun n-back-compute-single-result-value (entry)
 606   "Compute result stored in ENTRY."
 607   (let* ((what (nth 0 entry))
 608          (good (nth 1 entry))
 609          (bad  (nth 2 entry))
 610          (miss (nth 3 entry))
 611          (err (+ bad miss))
 612          ;;(tot  (+ good bad miss 0.0))
 613          ;;(gnum 6)
 614          ;;(weighted-err (* err (/ gnum tot)))
 615          )
 616     (cons what (if (= 0 good)
 617                    0
 618                  (/ (- n-back-trials err 0.0)
 619                     n-back-trials)))))
 620
 621 (defun n-back-compute-result-values (result)
 622   "Compute result values from game result RESULT."
 623   (let ((results nil))
 624     (dolist (entry result)
 625       (let ((res (n-back-compute-single-result-value entry)))
 626         (setq results (cons res results))))
 627     (setq n-back-result-values (reverse results))))
 628
 629 ;; Thresholds
 630 (defun n-back-view-threshold-discussion-page ()
 631   "View some discussion of threshold."
 632   (interactive)
 633   (browse-url "http://groups.google.com/group/brain-training/browse_thread/thread/f4bfa452943c2a2d/ba31adfd0b97771c?lnk=gst&q=threshold#ba31adfd0b97771c"))
 634
 635 ;;(n-back-set-next-challenge)
 636 (defvar n-back-worst nil)
 637
 638 (defvar n-back-challenge-change nil)
 639
 640 (defun n-back-set-next-challenge ()
 641   "Set next game difficulty level from last game result."
 642   (let ((r 2.8)) ;; stay as default
 643     (setq n-back-worst nil)
 644     (dolist (res n-back-result-values)
 645       (when (< (cdr res) r)
 646         (setq r (cdr res))
 647         (setq n-back-worst res)))
 648     (setq n-back-challenge-change (if (< r 0.74)
 649                                       'down
 650                                     (if (> r 0.91)
 651                                         'up
 652                                       'stay)))
 653     (n-back-change-challenge n-back-challenge-change)))
 654
 655 (defun n-back-challenge-up ()
 656   "Make the game harder."
 657   (interactive)
 658   (n-back-change-challenge 'up))
 659
 660 (defun n-back-challenge-down ()
 661   "Make the game easier."
 662   (interactive)
 663   (n-back-change-challenge 'down))
 664
 665 (defun n-back-change-challenge (challenge-change)
 666   "Change game difficulty level by CHALLENGE-CHANGE."
 667   (let ((new-level n-back-level)
 668         (new-num-active n-back-num-active)
 669         (num-allowed (length n-back-allowed-match-types)))
 670     (case challenge-change
 671       (down
 672        (if (= 1 n-back-num-active)
 673            (unless (= 1 n-back-level)
 674              (setq new-num-active (min 3 num-allowed))
 675              (setq new-level (1- n-back-level)))
 676          (setq new-num-active (1- n-back-num-active))))
 677       (up
 678        (if (or (<= 3 n-back-num-active)
 679                (<= num-allowed n-back-num-active))
 680            (progn
 681              (setq new-level (1+ n-back-level))
 682              (setq new-num-active 1))
 683          (setq new-num-active (min 3 (1+ n-back-num-active))))))
 684     ;;(when (= new-level 0) (setq new-level 1))
 685     ;;(when (= new-num-active 0) (setq new-num-active 1))
 686     (when (and (= new-level n-back-level)
 687                (= new-num-active n-back-num-active))
 688       (setq n-back-challenge-change 'stay))
 689     (unless (= new-level n-back-level)
 690       (customize-set-variable 'n-back-level new-level)
 691       (customize-set-value 'n-back-level new-level))
 692     (n-back-set-random-match-types new-num-active (car n-back-worst))))
 693
 694 (defun n-back-set-random-match-types (num worst)
 695   "Select NUM random match types.
 696 If type WORST is non-nil try to include that."
 697   (let ((alen (length n-back-allowed-match-types))
 698         (old-types n-back-active-match-types)
 699         types)
 700     (unless (<= num alen)
 701       (error "n-back: Too many match types required = %s" num))
 702     (when (and worst
 703                (< 1 num)
 704                (memq worst n-back-allowed-match-types))
 705       (add-to-list 'types worst))
 706     (while (< (length types) num)
 707       (add-to-list 'types (nth (random alen) n-back-allowed-match-types)))
 708     (setq types (n-back-sort-types types))
 709     (unless (equal old-types types)
 710       (customize-set-variable 'n-back-active-match-types types)
 711       (customize-set-value 'n-back-active-match-types types))))
 712
 713 ;; (defcustom n-back-keybinding-color "OliveDrab1"
 714 ;;   "Background color for key binding hints."
 715 ;;   :type 'color
 716 ;;   :group 'n-back)
 717
 718 (defun n-back-update-info ()
 719   "Update info buffer."
 720   (when (buffer-live-p n-back-info-buffer)
 721     (when (window-live-p n-back-info-window)
 722       (set-window-buffer n-back-info-window n-back-info-buffer))
 723     (with-current-buffer n-back-info-buffer
 724       (setq buffer-read-only nil)
 725       (erase-buffer)
 726
 727       (insert (propertize "n-back" 'face 'n-back-header)
 728               "  "
 729               (propertize "Help: ?" 'face 'n-back-keybinding))
 730
 731       ;; Auto challenging
 732       (insert "\n\nAuto challenging: "
 733               (if n-back-auto-challenge "on " "off ")
 734               (propertize "toggle: Ta" 'face 'n-back-keybinding))
 735
 736       (insert "\n  Manually change challenging: "
 737               (propertize "up-arrow/down-arrow" 'face 'n-back-keybinding))
 738
 739       (insert "\n  Allowed match types: ")
 740       (dolist (type n-back-allowed-match-types)
 741         (insert (format "%s " type)))
 742       (insert (propertize "toggle: T" 'face 'n-back-keybinding))
 743
 744       ;; Current game
 745       (insert "\n\nCurrent game:")
 746
 747       (insert (format "\n  n Back: %s " n-back-level)
 748               (propertize "change: number 1-9" 'face 'n-back-keybinding))
 749       (insert "\n  Match types: ")
 750       (dolist (type n-back-active-match-types)
 751         (insert (format "%s " type)))
 752       (insert (propertize "toggle: t" 'face 'n-back-keybinding))
 753
 754       (insert (format "\n  %.2f seconds per trial " n-back-sec-per-trial)
 755               (propertize "change: +/-" 'face 'n-back-keybinding))
 756
 757       ;; Save and restore
 758       (insert "\n\n")
 759       (insert "Game settings: "
 760               (propertize "reset: C-r" 'face 'n-back-keybinding)
 761               " "
 762               (propertize "save: C-s" 'face 'n-back-keybinding))
 763
 764       (insert "\n\n")
 765       (unless (or (n-back-is-playing)
 766                   (not n-back-result))
 767         (insert (propertize (format "Last result, %s" n-back-challenge-change)
 768                             'face 'n-back-last-result)
 769                 "\n  Good-Bad-Miss:")
 770         (dolist (entry n-back-result)
 771           (let* ((what (nth 0 entry))
 772                  (good (nth 1 entry))
 773                  (bad  (nth 2 entry))
 774                  (miss (nth 3 entry))
 775                  (tot  (+ good bad miss 0.0))
 776                  (res (n-back-compute-single-result-value entry)))
 777             (insert (format "  %s: %s-%s-%s (%d%%)"
 778                             (key-description (n-back-key-binding what))
 779                             good
 780                             bad
 781                             miss
 782                             (floor (* 100 (cdr res))))))))
 783
 784       (setq buffer-read-only t))))
 785
 786 (defun n-back-show-welcome (msg)
 787   "Show welcome startup info and message MSG."
 788   (when (and n-back-game-buffer
 789              (buffer-live-p n-back-game-buffer))
 790     (with-current-buffer n-back-game-buffer
 791       (let ((src (or (when (boundp 'nxhtml-install-dir)
 792                        (expand-file-name "nxhtml/doc/img/fun-brain-2.png" nxhtml-install-dir))
 793                      "c:/program files/brain workshop/res/brain_graphic.png"))
 794             img
 795             buffer-read-only)
 796         (erase-buffer)
 797         ;;(insert (propertize "\nEmacs n-back game (after Brain Workshop)\n\n" 'face '(:height 2.0)))
 798         (insert (propertize "\nEmacs n-back game (after Brain Workshop)\n\n" 'face 'n-back-welcome-header))
 799         (unless (file-exists-p src)
 800           (n-back-maybe-download-files (file-name-directory src) (list (file-name-nondirectory src))))
 801         (if (file-exists-p src)
 802             (condition-case err
 803                 (setq img (create-image src nil nil
 804                                         :relief 0
 805                                         ;;:margin inlimg-margins
 806                                         ))
 807               (error (setq img (error-message-string err))))
 808           (setq img (concat "Image not found: " src)))
 809         (if (stringp img)
 810             (insert img)
 811           (insert-image img))
 812         (insert (propertize "\n\nPlay for fun and maybe a somewhat happier brain"
 813                             'face 'n-back-welcome))
 814         (when msg (insert "\n\n" msg))
 815         ))))
 816
 817 (defun n-back-setup-windows ()
 818   "Setup game frame and windows."
 819   (delete-other-windows)
 820   ;; Info
 821   (split-window-horizontally)
 822   (setq n-back-info-window (next-window (frame-first-window)))
 823   (setq n-back-info-buffer (get-buffer-create "* n-back info *"))
 824   (when (< 75 (window-width n-back-info-window))
 825     (with-selected-window n-back-info-window
 826       (enlarge-window (- 75 (window-width n-back-info-window)) t)))
 827   (with-current-buffer n-back-info-buffer
 828     (n-back-control-mode)
 829     (setq wrap-prefix "      "))
 830   (n-back-update-info)
 831   ;; Control
 832   (split-window-vertically)
 833   (setq n-back-ctrl-window (next-window (frame-first-window)))
 834   (setq n-back-ctrl-buffer (get-buffer-create "* n-back control *"))
 835   (set-window-buffer n-back-ctrl-window n-back-ctrl-buffer)
 836   (with-current-buffer n-back-ctrl-buffer (n-back-control-mode))
 837   (n-back-update-control-buffer)
 838   (fit-window-to-buffer n-back-ctrl-window)
 839   (set-window-dedicated-p n-back-ctrl-window t)
 840   ;; Game
 841   (setq n-back-game-window (frame-first-window))
 842   (setq n-back-game-buffer (get-buffer-create "*n-back game*"))
 843   (set-window-buffer n-back-game-window n-back-game-buffer)
 844   (set-window-dedicated-p n-back-game-window t)
 845   (with-current-buffer n-back-game-buffer (n-back-control-mode))
 846   (n-back-show-welcome nil)
 847   ;; Position in control window
 848   (select-window n-back-ctrl-window)
 849   )
 850
 851 ;;(n-back-display "str" 1 0 3 3 6)
 852 (defun n-back-display (str x y cols rows max-strlen color)
 853   "Display a trial.
 854 Display item with text STR at column X in row Y using COLS
 855 columns and ROWS rows.  Strings to display have max length
 856 MAX-STRLEN.  Display item with background color COLOR."
 857   (unless (< x cols) (error "n-back: Not x=%s < cols=%s" x cols))
 858   (unless (< y rows) (error "Not y=%s < rows=%s" y rows))
 859   (unless str (setq str ""))
 860   (with-current-buffer n-back-game-buffer
 861     (let* (buffer-read-only
 862            (tot-str "")
 863            ;; Pad spaces left, two right, four between
 864            (game-w (window-width n-back-game-window))
 865            (pad-x 0)
 866            (scale (if (not window-system)
 867                       1.0
 868                     (/ (* 1.0 game-w)
 869                        (+ (* 2 pad-x)
 870                           (* (1- cols) 4)
 871                           (* cols max-strlen)))))
 872            (str-diff (- max-strlen (length str)))
 873            (str-l-len (/ str-diff 2))
 874            (str-r-len (- max-strlen (length str) str-l-len))
 875            (face-spec (if window-system
 876                           (list :inherit 'n-back-game-word :background color :height scale)
 877                         (list :inherit 'n-back-game-word :background color)))
 878            (str-disp (propertize
 879                       (concat (make-string str-l-len 32) str (make-string str-r-len 32))
 880                       'face face-spec))
 881            (col-str (concat
 882                      (make-string pad-x ?p)
 883                      (make-string
 884                       (+ (* x (+ 4 max-strlen)))
 885                       32
 886                       ;;?x
 887                       )))
 888            ;; Pad lines above and below, two between
 889            (pad-y 0)
 890            (game-h (window-body-height n-back-game-window))
 891            (game-h-scaled (/ game-h scale))
 892            (lines-between (/ (- game-h-scaled rows (* 2 pad-y))
 893                              (1- rows)))
 894            (row-scaled (+ pad-y (* y (1+ lines-between)) (1- y)))
 895            (row-num (if (= y 0)
 896                         pad-y
 897                       (round row-scaled)))
 898            (row-str (make-string row-num ?\n)))
 899       (setq show-trailing-whitespace nil)
 900       ;;(setq cursor-type nil)
 901       (erase-buffer)
 902       (setq tot-str row-str)
 903       (setq tot-str (concat tot-str col-str))
 904       (insert (propertize tot-str 'face (list :height scale)))
 905       (insert str-disp)
 906       )))
 907
 908 ;; (setq timer-list nil)
 909 ;;(n-back-display-in-timer)
 910 ;; (setq n-back-trials-left 3)
 911
 912 (defun n-back-clear-game-window ()
 913   "Erase game buffer."
 914   (save-match-data ;; runs in timer
 915     (with-current-buffer n-back-game-buffer
 916       (let (buffer-read-only)
 917         (erase-buffer)))))
 918
 919 (defun n-back-play ()
 920   "Start playing."
 921   (interactive)
 922   (message "  ") ;; For easier reading *Messages*
 923   (n-back-update-info)
 924   (if (not n-back-active-match-types)
 925       (message (propertize "No active match types"
 926                            'face 'secondary-selection))
 927     ;;(setq n-back-result nil)
 928     (n-back-init-control-status)
 929     (n-back-init-this-result)
 930     (n-back-cancel-timers)
 931     (winsize-set-mode-line-colors t)
 932     (setq n-back-ring (make-ring (1+ n-back-level)))
 933     (n-back-clear-game-window)
 934     (setq n-back-trials-left (+ n-back-trials n-back-level))
 935     (random t)
 936     (n-back-start-main-timer)
 937     (n-back-update-control-buffer)))
 938
 939 (defun n-back-start-main-timer ()
 940   "Start main game timer."
 941   (setq n-back-timer
 942         (run-with-timer
 943          n-back-sec-per-trial
 944          nil ;;n-back-sec-per-trial
 945          'n-back-display-in-timer)))
 946
 947 (defun n-back-maybe-download-files (dir file-name-list)
 948   (nxhtml-get-missing-files (file-relative-name dir nxhtml-install-dir) file-name-list))
 949
 950 (defun n-back-finish-game ()
 951   "Finish the game."
 952   (n-back-cancel-timers)
 953   (fit-window-to-buffer n-back-ctrl-window)
 954   (setq n-back-result n-back-this-result)
 955   (n-back-compute-result-values n-back-result)
 956   (when n-back-auto-challenge (n-back-set-next-challenge))
 957   (n-back-update-info)
 958   (n-back-init-control-status)
 959   (n-back-clear-match-status)
 960   (n-back-update-control-buffer)
 961   (n-back-show-welcome "Game over")
 962   (with-current-buffer n-back-game-buffer
 963     ;;(setq n-back-challenge-change 'up)
 964     (let (buffer-read-only)
 965       (insert
 966        "\n\n"
 967        (case n-back-challenge-change
 968          (up "Congratulations! I see you need more challenge, raising difficulty!")
 969          (down "Making it a bit easier for now to make your playing more fun.")
 970          (otherwise "This game challenges seems the right way for you now.")))
 971       (let* ((dir (when (boundp 'nxhtml-install-dir)
 972                     (expand-file-name "nxhtml/doc/img/" nxhtml-install-dir)))
 973              (up-imgs '("rembrandt-self-portrait.jpg"
 974                         "bacchante2.jpg"
 975                         "giraffe.jpg"
 976                         "Las_Medulas.jpg"
 977                         ))
 978              (t-imgs '("continue-play.jpg"
 979                        "Toco_toucan.jpg"
 980                        "raindrops2.jpg"
 981                        "divine2.jpg"
 982                        ;;"butterflies.png"
 983                        "volga.jpg"
 984                        "healthy_feet2.jpg"
 985                        ))
 986              ;; (setq n-back-trials 1)
 987              (pic (when dir (case n-back-challenge-change
 988                               (up (nth (random (length up-imgs)) up-imgs))
 989                               (otherwise  (nth (random (length t-imgs))  t-imgs)))))
 990              (src (when dir (expand-file-name pic dir)))
 991              img)
 992         (when (and src (not (file-exists-p src)))
 993           ;; Time to download?
 994           (n-back-maybe-download-files (file-name-directory src) (append up-imgs t-imgs nil)))
 995         (when (and src (file-exists-p src))
 996           (condition-case err
 997               (setq img (create-image src nil nil
 998                                       :relief 0
 999                                       ))
1000             (error (setq img (error-message-string err)))))
1001         (if (stringp img)
1002             img
1003           (insert "\n\n")
1004           (insert-image img)))))
1005   (message "Game over"))
1006
1007 (defun n-back-display-random ()
1008   "Display a random item."
1009   (when (current-message) (message ""))
1010   ;;(message "here start display")
1011   (let* ((use-position (memq 'position n-back-active-match-types))
1012          (use-color (memq 'color n-back-active-match-types))
1013          (use-sound (memq 'sound n-back-active-match-types))
1014          (use-word  (memq 'word  n-back-active-match-types))
1015          (old-rec (when (n-back-match-possible)
1016                     (ring-ref n-back-ring (1- n-back-level))))
1017          (cols 3)
1018          (rows 3)
1019          (x (if use-position (random 3) 1))
1020          (y (if use-position (random 3) 1))
1021          (old-x (if use-position (nth 1 old-rec)))
1022          (old-y (if use-position (nth 2 old-rec)))
1023          (color (nth (if use-color (random (length n-back-colors)) 0) n-back-colors))
1024          (old-color (if use-color (nth 3 old-rec)))
1025          (sound (when use-sound (expand-file-name (nth (random (length n-back-sound-files))
1026                                                        n-back-sound-files)
1027                                                   (nth 0 n-back-sounds))))
1028          (old-sound (if use-sound (nth 4 old-rec)))
1029          (words (when use-word (split-string n-back-words)))
1030          (word (when use-word (nth (random (length words)) words)))
1031          (old-word (when use-word (nth 5 old-rec)))
1032          (str (if word word "")) ;(format "%s" n-back-trials-left))
1033          (max-strlen (if words
1034                          (+ 2 (apply 'max (mapcar (lambda (w) (length w)) words)))
1035                        5))
1036          (compensate 24)
1037          )
1038     ;; To get more targets make it more plausible that it is the same here.
1039     ;; (/ (- 6 (/ 20.0 8)) 20)
1040     (when old-rec
1041       (when (and use-position
1042                  (not (and (= x old-x)
1043                            (= y old-y)))
1044                  (< (random 100) compensate))
1045         (setq x (nth 1 old-rec))
1046         (setq y (nth 2 old-rec)))
1047       (when (and use-color
1048                  (not (equal color old-color))
1049                  (< (random 100) compensate))
1050         (setq color (nth 3 old-rec)))
1051       (when (and use-sound
1052                  (not (equal sound old-sound))
1053                  (< (random 100) compensate))
1054         (setq sound (nth 4 old-rec)))
1055       (when (and use-word
1056                  (not (equal word old-word))
1057                  (< (random 100) compensate))
1058         (setq word (nth 5 old-rec))))
1059     (setq str word) ;; fix-me
1060     (ring-insert n-back-ring (list str x y color sound word))
1061     ;;(message "here before display")
1062     (n-back-display str x y cols rows max-strlen color)
1063     ;;(when sound (play-sound (list 'sound :file sound)))
1064     ;;(message "here before clear-m")
1065     (n-back-clear-match-status)
1066     ;;(message "here before position")
1067     (when (and use-position (n-back-matches 'position)) (n-back-set-match-status 'position 'miss))
1068     ;;(message "here before color")
1069     (when (and use-color (n-back-matches 'color)) (n-back-set-match-status 'color 'miss))
1070     ;;(message "here before sound")
1071     (when (and use-sound (n-back-matches 'sound)) (n-back-set-match-status 'sound 'miss))
1072     ;;(message "here before word")
1073     (when (and use-word (n-back-matches 'word)) (n-back-set-match-status 'word 'miss))
1074     (setq n-back-display-hint n-back-hint)
1075     ;;(message "here before control")
1076     (n-back-update-control-buffer)
1077     ;;(message "here before clear timer")
1078     (setq n-back-clear-timer (run-with-timer 0.5 nil 'n-back-clear-game-window))
1079     ;;(message "here before sound timer")
1080     (when sound (run-with-timer 0.01 nil 'n-back-play-sound-in-timer sound))
1081     ;;(message "here exit display")
1082     ))
1083
1084 (defun n-back-display-in-timer ()
1085   "Display a trial in a timer."
1086   (condition-case err
1087       (save-match-data ;; runs in timer
1088         (n-back-add-result)
1089         (if (>= 0 (setq n-back-trials-left (1- n-back-trials-left)))
1090             (n-back-finish-game)
1091           (n-back-display-random)
1092           (n-back-start-main-timer)
1093           ;;(message "after start-main-timer")
1094           ))
1095     (error (message "n-back-display: %s" (error-message-string err))
1096            (n-back-cancel-timers))))
1097
1098 (defun n-back-play-sound-in-timer (sound-file)
1099   "Play sound SOUND-FILE in a timer."
1100   (condition-case err
1101       (save-match-data ;; runs in timer
1102         (play-sound (list 'sound :file sound-file :volume n-back-sound-volume)))
1103     (error (message "n-back-sound: %s" (error-message-string err))
1104            (n-back-cancel-timers))))
1105
1106
1107 ;;; Answers
1108
1109 ;;(defvar n-back-answers nil)
1110
1111 (defun n-back-init-this-result ()
1112   "Init `n-back-this-result'."
1113   (setq n-back-this-result nil)
1114   (dolist (sts-entry n-back-control-status)
1115     (let* ((what (nth 0 sts-entry))
1116            (res-entry (list what 0 0 0)))
1117       (setq n-back-this-result (cons res-entry n-back-this-result)))))
1118
1119 (defun n-back-match-possible ()
1120   "Return t if enouch entries have been shown to match."
1121   (= (ring-length n-back-ring) (1+ n-back-level)))
1122
1123 (defun n-back-add-result ()
1124   "Add result of last trial."
1125   (when (n-back-match-possible)
1126     (dolist (sts-entry n-back-control-status)
1127       (let* ((what (nth 0 sts-entry))
1128              (sts  (nth 2 sts-entry))
1129              (matches (n-back-matches what))
1130              (num (cond
1131                    ((eq sts 'ok) 1)
1132                    ((eq sts 'bad) 2)
1133                    ;;((eq sts nil) (when matches 3))
1134                    ((eq sts 'miss) 3)
1135                    ((not sts) nil)
1136                    (t (error "n-back: Bad status=%s" sts))))
1137              (res-entry (when num (assoc what n-back-this-result)))
1138              (lst (when num (nthcdr num res-entry))))
1139         (when num
1140           (if res-entry
1141               (setcar lst (1+ (car lst)))
1142             (setq res-entry (list what 0 0 0))
1143             ;;(setq lst (nthcdr num res-entry))
1144             (setq n-back-this-result (cons res-entry n-back-this-result))))))))
1145
1146 (defun n-back-matches-position ()
1147   "Return non-nil iff last trial position match."
1148   (when (n-back-match-possible)
1149     (let* ((comp-item (ring-ref n-back-ring n-back-level))
1150            (curr-item (ring-ref n-back-ring 0))
1151            (comp-x (nth 1 comp-item))
1152            (curr-x (nth 1 curr-item))
1153            (comp-y (nth 2 comp-item))
1154            (curr-y (nth 2 curr-item)))
1155       (and (= comp-y curr-y)
1156            (= comp-x curr-x)))))
1157
1158 (defun n-back-matches-color ()
1159   "Return non-nil iff last trial color match."
1160   (when (n-back-match-possible)
1161     (let* ((comp-item (ring-ref n-back-ring n-back-level))
1162            (curr-item (ring-ref n-back-ring 0))
1163            (comp-color (nth 3 comp-item))
1164            (curr-color (nth 3 curr-item)))
1165       (equal comp-color curr-color))))
1166
1167 (defun n-back-matches-sound ()
1168   "Return non-nil iff last trial sound match."
1169   (when (n-back-match-possible)
1170     (let* ((comp-item (ring-ref n-back-ring n-back-level))
1171            (curr-item (ring-ref n-back-ring 0))
1172            (comp-sound (nth 4 comp-item))
1173            (curr-sound (nth 4 curr-item)))
1174       (equal comp-sound curr-sound))))
1175
1176 (defun n-back-matches-word ()
1177   "Return non-nil iff last trial word match."
1178   (when (n-back-match-possible)
1179     (let* ((comp-item (ring-ref n-back-ring n-back-level))
1180            (curr-item (ring-ref n-back-ring 0))
1181            (comp-word (nth 5 comp-item))
1182            (curr-word (nth 5 curr-item)))
1183       (equal comp-word curr-word))))
1184
1185 (defun n-back-matches (what)
1186   "Return non-nil iff last trial part WHAT match."
1187   (cond
1188    ((eq what 'position) (n-back-matches-position))
1189    ((eq what 'color) (n-back-matches-color))
1190    ((eq what 'sound) (n-back-matches-sound))
1191    ((eq what 'word)  (n-back-matches-word))
1192    (t (error "n-back: Unknown match type: %s" what))))
1193
1194 (defun n-back-answer (what)
1195   "Tell that you think WHAT matched."
1196   (when (n-back-is-playing)
1197     (if (memq what n-back-active-match-types)
1198         (if (n-back-match-possible)
1199             (let ((sts (if (n-back-matches what) 'ok 'bad)))
1200               (n-back-set-match-status what sts)
1201               (n-back-update-control-buffer))
1202           (message "%s n-back items must be displayed before anything can match"
1203                    n-back-level))
1204       (message "%s match is not active" what)
1205       (ding t))))
1206
1207 (defun n-back-position-answer ()
1208   "Tell that you think position matched."
1209   (interactive)
1210   (n-back-answer 'position))
1211
1212 (defun n-back-color-answer ()
1213   "Tell that you think color matched."
1214   (interactive)
1215   (n-back-answer 'color))
1216
1217 (defun n-back-sound-answer ()
1218   "Tell that you think sound matched."
1219   (interactive)
1220   (n-back-answer 'sound))
1221
1222 (defun n-back-word-answer ()
1223   "Tell that you think word matched."
1224   (interactive)
1225   (n-back-answer 'word))
1226
1227 (defun n-back-stop ()
1228   "Stop playing."
1229   (interactive)
1230   (n-back-cancel-timers)
1231   (n-back-update-control-buffer)
1232   (message "Stopped n-back game")
1233   (n-back-show-welcome "Stopped"))
1234
1235 (defvar viper-emacs-state-mode-list) ;; silence compiler
1236 (defvar viper-emacs-state-hook) ;; silence compiler
1237
1238 (define-derived-mode n-back-control-mode nil "N-back"
1239   "Mode for controlling n-back game."
1240   (setq cursor-type nil)
1241   (setq buffer-read-only t)
1242   (set (make-local-variable 'viper-emacs-state-mode-list) '(n-back-control-mode))
1243   (set (make-local-variable 'viper-emacs-state-hook) nil) ;; in vis cursor
1244   (abbrev-mode -1)
1245   (setq show-trailing-whitespace nil)
1246   (when (fboundp 'visual-line-mode) (visual-line-mode 1))
1247   (n-back-make-keymap))
1248
1249 (defun n-back-cancel-timers ()
1250   "Cancel game timers."
1251   (when (timerp n-back-timer)
1252     (cancel-timer n-back-timer))
1253   (setq n-back-timer nil)
1254   (when (timerp n-back-clear-timer)
1255     (cancel-timer n-back-clear-timer))
1256   (setq n-back-clear-timer nil)
1257   (winsize-set-mode-line-colors nil))
1258
1259 (defvar n-back-game-settings-symbols
1260   '(
1261     ;;n-back-keys
1262     n-back-level
1263     n-back-active-match-types
1264     n-back-allowed-match-types
1265     n-back-auto-challenge
1266     ;;n-back-colors
1267     ;;n-back-words
1268     ;;n-back-sound-volume
1269     ;;n-back-sounds
1270     n-back-sec-per-trial
1271     ;;n-back-keybinding-color
1272     ;;n-back-trials
1273     ))
1274
1275 (defun n-back-save-game-settings ()
1276   "Save game settings."
1277   (interactive)
1278   (dolist (var n-back-game-settings-symbols)
1279     )
1280   (custom-save-all))
1281
1282 (defun n-back-reset-game-to-saved ()
1283   "Reset game playing options to saved values."
1284   (interactive)
1285   (dolist (pass '(1 2))
1286     (dolist (var n-back-game-settings-symbols)
1287       (if (= pass 1)
1288           ;; pass 1 is for my lousy programming:
1289           (condition-case err
1290               (custom-reevaluate-setting var)
1291             (error nil))
1292         (custom-reevaluate-setting var)))))
1293
1294 (provide 'n-back)
1295 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1296 ;;; n-back.el ends here