1296 lines
45 KiB
EmacsLisp
1296 lines
45 KiB
EmacsLisp
;;; n-back.el --- n-back game
|
||
;;
|
||
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
|
||
;; Created: 2009-05-23 Sat
|
||
(defconst n-back:version "0.5");; Version:
|
||
;; Last-Updated: 2009-08-04 Tue
|
||
;; URL:
|
||
;; Keywords:
|
||
;; Compatibility:
|
||
;;
|
||
;; Features that might be required by this library:
|
||
;;
|
||
;; `winsize'.
|
||
;;
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;
|
||
;;; Commentary:
|
||
;;
|
||
;; n-back game for brain training. See `n-back-game' for more
|
||
;; information.
|
||
;;
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;
|
||
;;; Change log:
|
||
;;
|
||
;;
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;
|
||
;; 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, 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; see the file COPYING. If not, write to
|
||
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||
;; Floor, Boston, MA 02110-1301, USA.
|
||
;;
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;
|
||
;;; Code:
|
||
|
||
;;(eval-when-compile (require 'viper))
|
||
|
||
;; (setq n-back-trials 2)
|
||
(eval-when-compile (require 'cl))
|
||
(eval-when-compile (require 'nxhtml-base nil t))
|
||
(eval-when-compile (require 'nxhtml-web-vcs nil t))
|
||
(require 'winsize nil t) ;; Ehum...
|
||
|
||
(defvar n-back-game-window nil)
|
||
(defvar n-back-game-buffer nil)
|
||
|
||
(defvar n-back-ctrl-window nil)
|
||
(defvar n-back-ctrl-buffer nil)
|
||
|
||
(defvar n-back-info-window nil)
|
||
(defvar n-back-info-buffer nil)
|
||
|
||
(defvar n-back-trials-left nil)
|
||
(defvar n-back-timer nil)
|
||
(defvar n-back-clear-timer nil)
|
||
|
||
(defvar n-back-result nil)
|
||
(defvar n-back-this-result nil)
|
||
|
||
(defvar n-back-ring nil)
|
||
|
||
(defvar n-back-num-active nil)
|
||
|
||
|
||
;;;###autoload
|
||
(defgroup n-back nil
|
||
"Customizations for `n-back-game' game."
|
||
:group 'games)
|
||
|
||
(defgroup n-back-feel nil
|
||
"Customizations for `n-back-game' game keys, faces etc."
|
||
:group 'n-back)
|
||
|
||
(defface n-back-ok
|
||
'((t (:foreground "black" :background "green")))
|
||
"Face for OK answer."
|
||
:group 'n-back-feel)
|
||
|
||
(defface n-back-bad
|
||
'((t (:foreground "black" :background "OrangeRed1")))
|
||
"Face for bad answer."
|
||
:group 'n-back-feel)
|
||
|
||
(defface n-back-hint
|
||
'((t (:foreground "black" :background "gold")))
|
||
"Face for bad answer."
|
||
:group 'n-back-feel)
|
||
|
||
(defface n-back-do-now
|
||
'((((background dark)) (:foreground "yellow"))
|
||
(t (:foreground "blue")))
|
||
"Face for start and stop hints."
|
||
:group 'n-back-feel)
|
||
|
||
(defface n-back-game-word
|
||
'((t (:foreground "black")))
|
||
"Face for word displayed in game."
|
||
:group 'n-back-feel)
|
||
|
||
(defface n-back-header
|
||
'((((background dark)) (:background "OrangeRed4"))
|
||
(t (:background "gold")))
|
||
"Face for headers."
|
||
:group 'n-back-feel)
|
||
|
||
(defface n-back-keybinding
|
||
'((((background dark)) (:background "purple4"))
|
||
(t (:background "OliveDrab1")))
|
||
"Face for key bindings."
|
||
:group 'n-back-feel)
|
||
|
||
(defface n-back-last-result
|
||
'((((background dark)) (:background "OliveDrab4"))
|
||
(t (:background "yellow")))
|
||
"Face for last game result header."
|
||
:group 'n-back-feel)
|
||
|
||
(defface n-back-welcome
|
||
'((((background dark)) (:foreground "OliveDrab3"))
|
||
(t (:foreground "OliveDrab4")))
|
||
"Face for welcome string"
|
||
:group 'n-back-feel)
|
||
|
||
(defface n-back-welcome-header
|
||
'((t (:height 2.0)))
|
||
"Face for welcome header."
|
||
:group 'n-back-feel)
|
||
|
||
(defcustom n-back-level 1
|
||
"The n-Back level."
|
||
:type '(radio (const 1)
|
||
(const 2)
|
||
(const 3)
|
||
(const 4))
|
||
:set (lambda (sym val)
|
||
(set-default sym val)
|
||
(when (featurep 'n-back)
|
||
(n-back-update-control-buffer)
|
||
(n-back-update-info)))
|
||
:group 'n-back)
|
||
|
||
(defcustom n-back-active-match-types '(position color sound)
|
||
"Active match types."
|
||
:type '(set (const position)
|
||
(const color)
|
||
(const sound)
|
||
(const word))
|
||
:set (lambda (sym val)
|
||
(set-default sym val)
|
||
(setq n-back-num-active (length val))
|
||
(when (featurep 'n-back)
|
||
(n-back-init-control-status)
|
||
(n-back-update-control-buffer)
|
||
(n-back-update-info)))
|
||
:group 'n-back)
|
||
|
||
(defcustom n-back-allowed-match-types '(position color sound word)
|
||
"Match types allowed in auto challenging."
|
||
:type '(set (const position)
|
||
(const color)
|
||
(const sound)
|
||
(const word))
|
||
:set (lambda (sym val)
|
||
(set-default sym val)
|
||
(when (featurep 'n-back)
|
||
(n-back-set-random-match-types (length n-back-active-match-types) nil)
|
||
(n-back-init-control-status)
|
||
(n-back-update-control-buffer)
|
||
(n-back-update-info)))
|
||
:group 'n-back)
|
||
|
||
(defcustom n-back-auto-challenge t
|
||
"Automatic challenge decrease/increase."
|
||
:type 'boolean
|
||
:group 'n-back)
|
||
|
||
(defun n-back-toggle-auto-challenge ()
|
||
"Toggle `n-back-auto-challenge'."
|
||
(interactive)
|
||
(let ((val (not n-back-auto-challenge)))
|
||
(customize-set-variable 'n-back-auto-challenge val)
|
||
(customize-set-value 'n-back-auto-challenge val)))
|
||
|
||
(defcustom n-back-colors
|
||
'("gold" "orange red" "lawn green" "peru" "pink" "gray" "light blue")
|
||
"Random colors to display."
|
||
:type '(repeat color)
|
||
:group 'n-back)
|
||
|
||
(defcustom n-back-words "you cat going me forest crying brown"
|
||
"Random words to display."
|
||
:type 'string
|
||
:group 'n-back)
|
||
|
||
(defcustom n-back-sound-volume 0.2
|
||
"Sound volume 0-1."
|
||
:type 'float
|
||
:group 'n-back-feel)
|
||
|
||
(defcustom n-back-sounds '("c:/program files/brain workshop/res" "piano-")
|
||
"Random sounds location."
|
||
:type '(list (directory :tag "Directory")
|
||
(regexp :tag "File name regexp"))
|
||
:group 'n-back)
|
||
|
||
(defcustom n-back-keys
|
||
'(
|
||
[?p]
|
||
[?c]
|
||
[?s]
|
||
[?w]
|
||
)
|
||
"Key bindings for answering."
|
||
:type '(list
|
||
(key-sequence :tag "position key")
|
||
(key-sequence :tag "color key")
|
||
(key-sequence :tag "sound key")
|
||
(key-sequence :tag "word key")
|
||
)
|
||
;; :set (lambda (sym val)
|
||
;; (set-default sym val)
|
||
;; (n-back-make-keymap))
|
||
:group 'n-back-feel)
|
||
|
||
(defvar n-back-control-mode-map nil)
|
||
|
||
(defun n-back-key-binding (what)
|
||
"Return key binding used for WHAT match answers."
|
||
(nth
|
||
(case what
|
||
(position 0)
|
||
(color 1)
|
||
(sound 2)
|
||
(word 3))
|
||
n-back-keys))
|
||
|
||
(defun n-back-make-keymap ()
|
||
"Make keymap for the game."
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map [?1] 'n-back-change-level)
|
||
(define-key map [?2] 'n-back-change-level)
|
||
(define-key map [?3] 'n-back-change-level)
|
||
(define-key map [?4] 'n-back-change-level)
|
||
(define-key map [?5] 'n-back-change-level)
|
||
(define-key map [?6] 'n-back-change-level)
|
||
(define-key map [??] 'n-back-help)
|
||
(define-key map [?\ ] 'n-back-play)
|
||
(define-key map [(control ?g)] 'n-back-stop)
|
||
(define-key map [?-] 'n-back-decrease-speed)
|
||
(define-key map [?+] 'n-back-increase-speed)
|
||
|
||
(define-key map [(control ?r)] 'n-back-reset-game-to-saved)
|
||
(define-key map [(control ?s)] 'n-back-save-game-settings)
|
||
|
||
(define-key map [?t ?p] 'n-back-toggle-position)
|
||
(define-key map [?t ?c] 'n-back-toggle-color)
|
||
(define-key map [?t ?s] 'n-back-toggle-sound)
|
||
(define-key map [?t ?w] 'n-back-toggle-word)
|
||
|
||
(define-key map [?T ?a] 'n-back-toggle-auto-challenge)
|
||
(define-key map [up] 'n-back-challenge-up)
|
||
(define-key map [down] 'n-back-challenge-down)
|
||
|
||
(define-key map [?T ?p] 'n-back-toggle-allowed-position)
|
||
(define-key map [?T ?c] 'n-back-toggle-allowed-color)
|
||
(define-key map [?T ?s] 'n-back-toggle-allowed-sound)
|
||
(define-key map [?T ?w] 'n-back-toggle-allowed-word)
|
||
|
||
(define-key map (n-back-key-binding 'position) 'n-back-position-answer)
|
||
(define-key map (n-back-key-binding 'color) 'n-back-color-answer)
|
||
(define-key map (n-back-key-binding 'sound) 'n-back-sound-answer)
|
||
(define-key map (n-back-key-binding 'word) 'n-back-word-answer)
|
||
;;(define-key map [t] 'ignore)
|
||
(setq n-back-control-mode-map map)))
|
||
|
||
(defvar n-back-display-hint nil)
|
||
(defcustom n-back-hint t
|
||
"Display hints - learning mode."
|
||
:type 'boolean
|
||
:group 'n-back)
|
||
|
||
|
||
|
||
(defvar n-back-sound-files nil)
|
||
;;(n-back-get-sound-files)
|
||
(defun n-back-get-sound-files ()
|
||
"Get sound file names."
|
||
(let ((dir (nth 0 n-back-sounds))
|
||
(regexp (nth 1 n-back-sounds)))
|
||
(when (file-directory-p dir)
|
||
(setq n-back-sound-files (directory-files dir nil regexp)))))
|
||
|
||
(defun n-back-toggle-position ()
|
||
"Toggle use of position in `n-back-active-match-types'."
|
||
(interactive)
|
||
(n-back-toggle 'position))
|
||
|
||
(defun n-back-toggle-color ()
|
||
"Toggle use of color in `n-back-active-match-types'."
|
||
(interactive)
|
||
(n-back-toggle 'color))
|
||
|
||
(defun n-back-toggle-sound ()
|
||
"Toggle use of sound in `n-back-active-match-types'."
|
||
(interactive)
|
||
(n-back-toggle 'sound))
|
||
|
||
(defun n-back-toggle-word ()
|
||
"Toggle use of word in `n-back-active-match-types'."
|
||
(interactive)
|
||
(n-back-toggle 'word))
|
||
|
||
(defun n-back-toggle (match-type)
|
||
"Toggle use of MATCH-TYPE in `n-back-active-match-types'."
|
||
(n-back-toggle-1 match-type 'n-back-active-match-types))
|
||
|
||
(defun n-back-toggle-allowed-position ()
|
||
"Toggle use of position in `n-back-allowed-match-types'."
|
||
(interactive)
|
||
(n-back-toggle-allowed 'position))
|
||
|
||
(defun n-back-toggle-allowed-color ()
|
||
"Toggle use of color in `n-back-allowed-match-types'."
|
||
(interactive)
|
||
(n-back-toggle-allowed 'color))
|
||
|
||
(defun n-back-toggle-allowed-sound ()
|
||
"Toggle use of sound in `n-back-allowed-match-types'."
|
||
(interactive)
|
||
(n-back-toggle-allowed 'sound))
|
||
|
||
(defun n-back-toggle-allowed-word ()
|
||
"Toggle use of word in `n-back-allowed-match-types'."
|
||
(interactive)
|
||
(n-back-toggle-allowed 'word))
|
||
|
||
(defun n-back-toggle-allowed (match-type)
|
||
"Toggle use of MATCH-TYPE in `n-back-allowed-match-types'."
|
||
(n-back-toggle-1 match-type 'n-back-allowed-match-types))
|
||
|
||
(defun n-back-sort-types (types)
|
||
"Sort TYPES to order used in defcustoms here."
|
||
(sort types
|
||
(lambda (a b)
|
||
(let ((all '(position color sound word)))
|
||
(< (length (memq a all))
|
||
(length (memq b all)))))))
|
||
|
||
(defun n-back-toggle-1 (match-type active-list-sym)
|
||
"Toggle use of MATCH-TYPE in list ACTIVE-LIST-SYM."
|
||
(let (active-types)
|
||
(if (memq match-type (symbol-value active-list-sym))
|
||
(setq active-types (delq match-type (symbol-value active-list-sym)))
|
||
(setq active-types (cons match-type (symbol-value active-list-sym))))
|
||
(setq active-types (n-back-sort-types active-types))
|
||
(customize-set-variable active-list-sym active-types)
|
||
(customize-set-value active-list-sym active-types)))
|
||
|
||
(defcustom n-back-sec-per-trial 3.0
|
||
"Seconds per trial."
|
||
:type 'float
|
||
:set (lambda (sym val)
|
||
(set-default sym val)
|
||
(when (featurep 'n-back)
|
||
(n-back-update-info)))
|
||
:group 'n-back)
|
||
|
||
(defun n-back-decrease-speed ()
|
||
"Decrease speed of trials."
|
||
(interactive)
|
||
(setq n-back-sec-per-trial (+ n-back-sec-per-trial 0.25))
|
||
(when (> n-back-sec-per-trial 5.0)
|
||
(setq n-back-sec-per-trial 5.0))
|
||
(n-back-update-info))
|
||
|
||
(defun n-back-increase-speed ()
|
||
"Increase speed of trials."
|
||
(interactive)
|
||
(let ((sec (- n-back-sec-per-trial 0.25)))
|
||
(when (< sec 1.0)
|
||
(setq sec 1.0))
|
||
(customize-set-variable 'n-back-sec-per-trial sec)
|
||
(customize-set-value 'n-back-sec-per-trial sec)))
|
||
|
||
(defun n-back-help ()
|
||
"Show help for `n-back-game' game."
|
||
(interactive)
|
||
(save-selected-window
|
||
(describe-function 'n-back-game)))
|
||
|
||
(defun n-back-change-level (level)
|
||
"Change n-Back level to LEVEL."
|
||
(interactive (progn
|
||
(if (and (numberp last-input-event)
|
||
(>= last-input-event ?1)
|
||
(<= last-input-event ?9))
|
||
(list (- last-input-event ?0))
|
||
(list (string-to-number (read-string "n Back: "))))))
|
||
(customize-set-variable 'n-back-level level)
|
||
(customize-set-value 'n-back-level level))
|
||
|
||
(defvar n-back-frame nil)
|
||
|
||
;;;###autoload
|
||
(defun n-back-game ()
|
||
"Emacs n-Back game.
|
||
This game is supposed to increase your working memory and fluid
|
||
intelligence.
|
||
|
||
In this game something is shown for half a second on the screen
|
||
and maybe a sound is played. You should then answer if parts of
|
||
it is the same as you have seen or heard before. This is
|
||
repeated for about 20 trials.
|
||
|
||
You answer with the keys shown in the bottom window.
|
||
|
||
In the easiest version of the game you should answer if you have
|
||
just seen or heard what is shown now. By default the game gets
|
||
harder as you play it with success. Then first the number of
|
||
items presented in a trial grows. After that it gets harder by
|
||
that you have to somehow remember not the last item, but the item
|
||
before that \(or even earlier). That is what \"n-Back\" stands
|
||
for.
|
||
|
||
Note that remember does not really mean remember clearly. The
|
||
game is for training your brain getting used to keep those things
|
||
in the working memory, maybe as a cross-modal unit. You are
|
||
supposed to just nearly be able to do what you do in the game.
|
||
And you are supposed to have fun, that is what your brain like.
|
||
|
||
You should probably not overdue this. Half an hour a day playing
|
||
might be an optimal time according to some people.
|
||
|
||
The game is shamelessly modeled after Brain Workshop, see URL
|
||
`http://brainworkshop.sourceforge.net/' just for the fun of
|
||
getting it into Emacs. The game resembles but it not the same as
|
||
that used in the report by Jaeggi mentioned at the above URL.
|
||
|
||
Not all features in Brain Workshop are implemented here, but some
|
||
new are maybe ... - and you have it available here in Emacs."
|
||
;; -----
|
||
;; Below is a short excerpt from the report by Jaeggi et al which
|
||
;; gave the idea to the game:
|
||
|
||
;; Training task. For the training task, we used the same material
|
||
;; as described by Jaeggi et al. (33), which was a dual n-Back task
|
||
;; where squares at eight different locations were presented
|
||
;; sequentially on a computer screen at a rate of 3 s (stimulus
|
||
;; length, 500 ms; interstimulus interval, 2,500 ms).
|
||
;; Simultaneously with the presentation of the squares, one of eight
|
||
;; consonants was presented sequentially through headphones. A
|
||
;; response was required whenever one of the presented stimuli
|
||
;; matched the one presented n positions back in the sequence. The
|
||
;; value of n was the same for both streams of stimuli. There were
|
||
;; six auditory and six visual targets per block (four appearing in
|
||
;; only one modality, and two appearing in both modalities
|
||
;; simultaneously), and their positions were determined randomly.
|
||
;; Participants made responses manually by pressing on the letter
|
||
;; ‘‘A’’ of a standard keyboard with their left index finger for
|
||
;; visual targets, and on the letter ‘‘L’’ with their right index
|
||
;; finger for auditory targets. No responses were required for
|
||
;; non-targets.
|
||
(interactive)
|
||
(n-back-make-keymap)
|
||
(when window-system
|
||
(unless (frame-live-p n-back-frame)
|
||
(setq n-back-frame (make-frame
|
||
(list '(name . "n-back game")
|
||
'(tool-bar-lines . 0)
|
||
'(menu-bar-lines . 0)
|
||
(case (frame-parameter nil 'background-mode)
|
||
(light '(background-color . "cornsilk"))
|
||
(dark '(background-color . "MidnightBlue"))
|
||
(otherwise nil))
|
||
'(height . 45)
|
||
'(width . 150)))))
|
||
(select-frame n-back-frame)
|
||
(raise-frame n-back-frame))
|
||
(n-back-cancel-timers)
|
||
(n-back-get-sound-files)
|
||
(unless n-back-sound-files
|
||
(when (memq 'sound n-back-allowed-match-types)
|
||
(n-back-toggle-allowed-sound))
|
||
(when (memq 'sound n-back-active-match-types)
|
||
(n-back-toggle-sound)))
|
||
(n-back-init-control-status)
|
||
(n-back-setup-windows)
|
||
)
|
||
|
||
(defconst n-back-match-types
|
||
'((position ": position match" nil)
|
||
(color ": color match" nil)
|
||
(sound ": sound match" nil)
|
||
(word ": word match" nil)
|
||
))
|
||
|
||
(defvar n-back-control-status nil
|
||
"For showing status in control window.")
|
||
(setq n-back-control-status nil)
|
||
|
||
;;(n-back-set-match-status 'position 'bad)
|
||
(defun n-back-set-match-status (match-type status)
|
||
"Set MATCH-TYPE status to STATUS for control window."
|
||
(unless (memq status '(ok bad miss nil)) (error "n-back: Bad status=%s" status))
|
||
(let ((entry (assoc match-type n-back-control-status)))
|
||
(setcar (cddr entry) status)
|
||
))
|
||
|
||
;;(n-back-clear-match-status)
|
||
(defun n-back-clear-match-status ()
|
||
"Clear match status for control window."
|
||
;;(dolist (entry n-back-control-status)
|
||
(dolist (entry n-back-match-types)
|
||
(setcar (cddr entry) nil)
|
||
))
|
||
|
||
;; (n-back-init-control-status)
|
||
(defun n-back-init-control-status ()
|
||
"Init match status for control window."
|
||
(setq n-back-control-status nil)
|
||
(dolist (what n-back-active-match-types)
|
||
(setq n-back-control-status
|
||
(cons (assoc what n-back-match-types)
|
||
n-back-control-status))))
|
||
|
||
(defsubst n-back-is-playing ()
|
||
"Return non-nil when game is active."
|
||
(timerp n-back-timer))
|
||
|
||
;;(n-back-update-control-buffer)
|
||
(defun n-back-update-control-buffer ()
|
||
"Update content of control buffer."
|
||
(save-match-data ;; runs in timer
|
||
(when (buffer-live-p n-back-ctrl-buffer)
|
||
(with-current-buffer n-back-ctrl-buffer
|
||
(setq buffer-read-only nil)
|
||
(erase-buffer)
|
||
(insert (propertize (format "%s %s-back"
|
||
(let ((n (length n-back-active-match-types)))
|
||
(cond
|
||
((= 1 n) "Single")
|
||
((= 2 n) "Dual")
|
||
((= 3 n) "Triple")
|
||
))
|
||
n-back-level
|
||
) 'face 'n-back-header)
|
||
(propertize
|
||
(if (n-back-is-playing) " Press C-g to stop" " Press SPACE to play")
|
||
'face 'n-back-do-now)
|
||
(if (n-back-is-playing) (format " Left %s" n-back-trials-left) "")
|
||
"\n")
|
||
;;(unless n-back-control-status (n-back-init-control-status))
|
||
(dolist (entry n-back-control-status)
|
||
(let* ((what (nth 0 entry))
|
||
(msg (nth 1 entry))
|
||
(sts (nth 2 entry))
|
||
(key (key-description (n-back-key-binding what))))
|
||
;;(setq msg (concat (key-description (n-back-key-binding what)) msg))
|
||
(cond
|
||
((eq sts 'bad)
|
||
(setq msg (propertize (concat key msg) 'face 'n-back-bad)))
|
||
((eq sts 'ok)
|
||
(setq msg (propertize (concat key msg) 'face 'n-back-ok)))
|
||
((eq sts 'miss)
|
||
(setq msg (concat
|
||
(if n-back-display-hint
|
||
(propertize key 'face 'n-back-header)
|
||
key)
|
||
msg)))
|
||
((not sts)
|
||
(setq msg (concat key msg)))
|
||
(t
|
||
(error "n-back:Unknown sts=%s" sts)
|
||
))
|
||
(insert msg " "))
|
||
)
|
||
(when n-back-display-hint
|
||
(setq n-back-display-hint nil)
|
||
(run-with-timer 0.1 nil 'n-back-update-control-buffer))
|
||
(setq buffer-read-only t)
|
||
(if (window-live-p n-back-ctrl-window)
|
||
(with-selected-window n-back-ctrl-window
|
||
(goto-char 1))
|
||
(goto-char 1))))))
|
||
|
||
(defcustom n-back-trials 20
|
||
"Number of trials per session."
|
||
:type 'integer
|
||
:group 'n-back)
|
||
|
||
;;(n-back-compute-result-values n-back-result)
|
||
(defvar n-back-result-values nil)
|
||
(defun n-back-compute-single-result-value (entry)
|
||
"Compute result stored in ENTRY."
|
||
(let* ((what (nth 0 entry))
|
||
(good (nth 1 entry))
|
||
(bad (nth 2 entry))
|
||
(miss (nth 3 entry))
|
||
(err (+ bad miss))
|
||
;;(tot (+ good bad miss 0.0))
|
||
;;(gnum 6)
|
||
;;(weighted-err (* err (/ gnum tot)))
|
||
)
|
||
(cons what (if (= 0 good)
|
||
0
|
||
(/ (- n-back-trials err 0.0)
|
||
n-back-trials)))))
|
||
|
||
(defun n-back-compute-result-values (result)
|
||
"Compute result values from game result RESULT."
|
||
(let ((results nil))
|
||
(dolist (entry result)
|
||
(let ((res (n-back-compute-single-result-value entry)))
|
||
(setq results (cons res results))))
|
||
(setq n-back-result-values (reverse results))))
|
||
|
||
;; Thresholds
|
||
(defun n-back-view-threshold-discussion-page ()
|
||
"View some discussion of threshold."
|
||
(interactive)
|
||
(browse-url "http://groups.google.com/group/brain-training/browse_thread/thread/f4bfa452943c2a2d/ba31adfd0b97771c?lnk=gst&q=threshold#ba31adfd0b97771c"))
|
||
|
||
;;(n-back-set-next-challenge)
|
||
(defvar n-back-worst nil)
|
||
|
||
(defvar n-back-challenge-change nil)
|
||
|
||
(defun n-back-set-next-challenge ()
|
||
"Set next game difficulty level from last game result."
|
||
(let ((r 2.8)) ;; stay as default
|
||
(setq n-back-worst nil)
|
||
(dolist (res n-back-result-values)
|
||
(when (< (cdr res) r)
|
||
(setq r (cdr res))
|
||
(setq n-back-worst res)))
|
||
(setq n-back-challenge-change (if (< r 0.74)
|
||
'down
|
||
(if (> r 0.91)
|
||
'up
|
||
'stay)))
|
||
(n-back-change-challenge n-back-challenge-change)))
|
||
|
||
(defun n-back-challenge-up ()
|
||
"Make the game harder."
|
||
(interactive)
|
||
(n-back-change-challenge 'up))
|
||
|
||
(defun n-back-challenge-down ()
|
||
"Make the game easier."
|
||
(interactive)
|
||
(n-back-change-challenge 'down))
|
||
|
||
(defun n-back-change-challenge (challenge-change)
|
||
"Change game difficulty level by CHALLENGE-CHANGE."
|
||
(let ((new-level n-back-level)
|
||
(new-num-active n-back-num-active)
|
||
(num-allowed (length n-back-allowed-match-types)))
|
||
(case challenge-change
|
||
(down
|
||
(if (= 1 n-back-num-active)
|
||
(unless (= 1 n-back-level)
|
||
(setq new-num-active (min 3 num-allowed))
|
||
(setq new-level (1- n-back-level)))
|
||
(setq new-num-active (1- n-back-num-active))))
|
||
(up
|
||
(if (or (<= 3 n-back-num-active)
|
||
(<= num-allowed n-back-num-active))
|
||
(progn
|
||
(setq new-level (1+ n-back-level))
|
||
(setq new-num-active 1))
|
||
(setq new-num-active (min 3 (1+ n-back-num-active))))))
|
||
;;(when (= new-level 0) (setq new-level 1))
|
||
;;(when (= new-num-active 0) (setq new-num-active 1))
|
||
(when (and (= new-level n-back-level)
|
||
(= new-num-active n-back-num-active))
|
||
(setq n-back-challenge-change 'stay))
|
||
(unless (= new-level n-back-level)
|
||
(customize-set-variable 'n-back-level new-level)
|
||
(customize-set-value 'n-back-level new-level))
|
||
(n-back-set-random-match-types new-num-active (car n-back-worst))))
|
||
|
||
(defun n-back-set-random-match-types (num worst)
|
||
"Select NUM random match types.
|
||
If type WORST is non-nil try to include that."
|
||
(let ((alen (length n-back-allowed-match-types))
|
||
(old-types n-back-active-match-types)
|
||
types)
|
||
(unless (<= num alen)
|
||
(error "n-back: Too many match types required = %s" num))
|
||
(when (and worst
|
||
(< 1 num)
|
||
(memq worst n-back-allowed-match-types))
|
||
(add-to-list 'types worst))
|
||
(while (< (length types) num)
|
||
(add-to-list 'types (nth (random alen) n-back-allowed-match-types)))
|
||
(setq types (n-back-sort-types types))
|
||
(unless (equal old-types types)
|
||
(customize-set-variable 'n-back-active-match-types types)
|
||
(customize-set-value 'n-back-active-match-types types))))
|
||
|
||
;; (defcustom n-back-keybinding-color "OliveDrab1"
|
||
;; "Background color for key binding hints."
|
||
;; :type 'color
|
||
;; :group 'n-back)
|
||
|
||
(defun n-back-update-info ()
|
||
"Update info buffer."
|
||
(when (buffer-live-p n-back-info-buffer)
|
||
(when (window-live-p n-back-info-window)
|
||
(set-window-buffer n-back-info-window n-back-info-buffer))
|
||
(with-current-buffer n-back-info-buffer
|
||
(setq buffer-read-only nil)
|
||
(erase-buffer)
|
||
|
||
(insert (propertize "n-back" 'face 'n-back-header)
|
||
" "
|
||
(propertize "Help: ?" 'face 'n-back-keybinding))
|
||
|
||
;; Auto challenging
|
||
(insert "\n\nAuto challenging: "
|
||
(if n-back-auto-challenge "on " "off ")
|
||
(propertize "toggle: Ta" 'face 'n-back-keybinding))
|
||
|
||
(insert "\n Manually change challenging: "
|
||
(propertize "up-arrow/down-arrow" 'face 'n-back-keybinding))
|
||
|
||
(insert "\n Allowed match types: ")
|
||
(dolist (type n-back-allowed-match-types)
|
||
(insert (format "%s " type)))
|
||
(insert (propertize "toggle: T" 'face 'n-back-keybinding))
|
||
|
||
;; Current game
|
||
(insert "\n\nCurrent game:")
|
||
|
||
(insert (format "\n n Back: %s " n-back-level)
|
||
(propertize "change: number 1-9" 'face 'n-back-keybinding))
|
||
(insert "\n Match types: ")
|
||
(dolist (type n-back-active-match-types)
|
||
(insert (format "%s " type)))
|
||
(insert (propertize "toggle: t" 'face 'n-back-keybinding))
|
||
|
||
(insert (format "\n %.2f seconds per trial " n-back-sec-per-trial)
|
||
(propertize "change: +/-" 'face 'n-back-keybinding))
|
||
|
||
;; Save and restore
|
||
(insert "\n\n")
|
||
(insert "Game settings: "
|
||
(propertize "reset: C-r" 'face 'n-back-keybinding)
|
||
" "
|
||
(propertize "save: C-s" 'face 'n-back-keybinding))
|
||
|
||
(insert "\n\n")
|
||
(unless (or (n-back-is-playing)
|
||
(not n-back-result))
|
||
(insert (propertize (format "Last result, %s" n-back-challenge-change)
|
||
'face 'n-back-last-result)
|
||
"\n Good-Bad-Miss:")
|
||
(dolist (entry n-back-result)
|
||
(let* ((what (nth 0 entry))
|
||
(good (nth 1 entry))
|
||
(bad (nth 2 entry))
|
||
(miss (nth 3 entry))
|
||
(tot (+ good bad miss 0.0))
|
||
(res (n-back-compute-single-result-value entry)))
|
||
(insert (format " %s: %s-%s-%s (%d%%)"
|
||
(key-description (n-back-key-binding what))
|
||
good
|
||
bad
|
||
miss
|
||
(floor (* 100 (cdr res))))))))
|
||
|
||
(setq buffer-read-only t))))
|
||
|
||
(defun n-back-show-welcome (msg)
|
||
"Show welcome startup info and message MSG."
|
||
(when (and n-back-game-buffer
|
||
(buffer-live-p n-back-game-buffer))
|
||
(with-current-buffer n-back-game-buffer
|
||
(let ((src (or (when (boundp 'nxhtml-install-dir)
|
||
(expand-file-name "nxhtml/doc/img/fun-brain-2.png" nxhtml-install-dir))
|
||
"c:/program files/brain workshop/res/brain_graphic.png"))
|
||
img
|
||
buffer-read-only)
|
||
(erase-buffer)
|
||
;;(insert (propertize "\nEmacs n-back game (after Brain Workshop)\n\n" 'face '(:height 2.0)))
|
||
(insert (propertize "\nEmacs n-back game (after Brain Workshop)\n\n" 'face 'n-back-welcome-header))
|
||
(unless (file-exists-p src)
|
||
(n-back-maybe-download-files (file-name-directory src) (list (file-name-nondirectory src))))
|
||
(if (file-exists-p src)
|
||
(condition-case err
|
||
(setq img (create-image src nil nil
|
||
:relief 0
|
||
;;:margin inlimg-margins
|
||
))
|
||
(error (setq img (error-message-string err))))
|
||
(setq img (concat "Image not found: " src)))
|
||
(if (stringp img)
|
||
(insert img)
|
||
(insert-image img))
|
||
(insert (propertize "\n\nPlay for fun and maybe a somewhat happier brain"
|
||
'face 'n-back-welcome))
|
||
(when msg (insert "\n\n" msg))
|
||
))))
|
||
|
||
(defun n-back-setup-windows ()
|
||
"Setup game frame and windows."
|
||
(delete-other-windows)
|
||
;; Info
|
||
(split-window-horizontally)
|
||
(setq n-back-info-window (next-window (frame-first-window)))
|
||
(setq n-back-info-buffer (get-buffer-create "* n-back info *"))
|
||
(when (< 75 (window-width n-back-info-window))
|
||
(with-selected-window n-back-info-window
|
||
(enlarge-window (- 75 (window-width n-back-info-window)) t)))
|
||
(with-current-buffer n-back-info-buffer
|
||
(n-back-control-mode)
|
||
(setq wrap-prefix " "))
|
||
(n-back-update-info)
|
||
;; Control
|
||
(split-window-vertically)
|
||
(setq n-back-ctrl-window (next-window (frame-first-window)))
|
||
(setq n-back-ctrl-buffer (get-buffer-create "* n-back control *"))
|
||
(set-window-buffer n-back-ctrl-window n-back-ctrl-buffer)
|
||
(with-current-buffer n-back-ctrl-buffer (n-back-control-mode))
|
||
(n-back-update-control-buffer)
|
||
(fit-window-to-buffer n-back-ctrl-window)
|
||
(set-window-dedicated-p n-back-ctrl-window t)
|
||
;; Game
|
||
(setq n-back-game-window (frame-first-window))
|
||
(setq n-back-game-buffer (get-buffer-create "*n-back game*"))
|
||
(set-window-buffer n-back-game-window n-back-game-buffer)
|
||
(set-window-dedicated-p n-back-game-window t)
|
||
(with-current-buffer n-back-game-buffer (n-back-control-mode))
|
||
(n-back-show-welcome nil)
|
||
;; Position in control window
|
||
(select-window n-back-ctrl-window)
|
||
)
|
||
|
||
;;(n-back-display "str" 1 0 3 3 6)
|
||
(defun n-back-display (str x y cols rows max-strlen color)
|
||
"Display a trial.
|
||
Display item with text STR at column X in row Y using COLS
|
||
columns and ROWS rows. Strings to display have max length
|
||
MAX-STRLEN. Display item with background color COLOR."
|
||
(unless (< x cols) (error "n-back: Not x=%s < cols=%s" x cols))
|
||
(unless (< y rows) (error "Not y=%s < rows=%s" y rows))
|
||
(unless str (setq str ""))
|
||
(with-current-buffer n-back-game-buffer
|
||
(let* (buffer-read-only
|
||
(tot-str "")
|
||
;; Pad spaces left, two right, four between
|
||
(game-w (window-width n-back-game-window))
|
||
(pad-x 0)
|
||
(scale (if (not window-system)
|
||
1.0
|
||
(/ (* 1.0 game-w)
|
||
(+ (* 2 pad-x)
|
||
(* (1- cols) 4)
|
||
(* cols max-strlen)))))
|
||
(str-diff (- max-strlen (length str)))
|
||
(str-l-len (/ str-diff 2))
|
||
(str-r-len (- max-strlen (length str) str-l-len))
|
||
(face-spec (if window-system
|
||
(list :inherit 'n-back-game-word :background color :height scale)
|
||
(list :inherit 'n-back-game-word :background color)))
|
||
(str-disp (propertize
|
||
(concat (make-string str-l-len 32) str (make-string str-r-len 32))
|
||
'face face-spec))
|
||
(col-str (concat
|
||
(make-string pad-x ?p)
|
||
(make-string
|
||
(+ (* x (+ 4 max-strlen)))
|
||
32
|
||
;;?x
|
||
)))
|
||
;; Pad lines above and below, two between
|
||
(pad-y 0)
|
||
(game-h (window-body-height n-back-game-window))
|
||
(game-h-scaled (/ game-h scale))
|
||
(lines-between (/ (- game-h-scaled rows (* 2 pad-y))
|
||
(1- rows)))
|
||
(row-scaled (+ pad-y (* y (1+ lines-between)) (1- y)))
|
||
(row-num (if (= y 0)
|
||
pad-y
|
||
(round row-scaled)))
|
||
(row-str (make-string row-num ?\n)))
|
||
(setq show-trailing-whitespace nil)
|
||
;;(setq cursor-type nil)
|
||
(erase-buffer)
|
||
(setq tot-str row-str)
|
||
(setq tot-str (concat tot-str col-str))
|
||
(insert (propertize tot-str 'face (list :height scale)))
|
||
(insert str-disp)
|
||
)))
|
||
|
||
;; (setq timer-list nil)
|
||
;;(n-back-display-in-timer)
|
||
;; (setq n-back-trials-left 3)
|
||
|
||
(defun n-back-clear-game-window ()
|
||
"Erase game buffer."
|
||
(save-match-data ;; runs in timer
|
||
(with-current-buffer n-back-game-buffer
|
||
(let (buffer-read-only)
|
||
(erase-buffer)))))
|
||
|
||
(defun n-back-play ()
|
||
"Start playing."
|
||
(interactive)
|
||
(message " ") ;; For easier reading *Messages*
|
||
(n-back-update-info)
|
||
(if (not n-back-active-match-types)
|
||
(message (propertize "No active match types"
|
||
'face 'secondary-selection))
|
||
;;(setq n-back-result nil)
|
||
(n-back-init-control-status)
|
||
(n-back-init-this-result)
|
||
(n-back-cancel-timers)
|
||
(winsize-set-mode-line-colors t)
|
||
(setq n-back-ring (make-ring (1+ n-back-level)))
|
||
(n-back-clear-game-window)
|
||
(setq n-back-trials-left (+ n-back-trials n-back-level))
|
||
(random t)
|
||
(n-back-start-main-timer)
|
||
(n-back-update-control-buffer)))
|
||
|
||
(defun n-back-start-main-timer ()
|
||
"Start main game timer."
|
||
(setq n-back-timer
|
||
(run-with-timer
|
||
n-back-sec-per-trial
|
||
nil ;;n-back-sec-per-trial
|
||
'n-back-display-in-timer)))
|
||
|
||
(defun n-back-maybe-download-files (dir file-name-list)
|
||
(nxhtml-get-missing-files (file-relative-name dir nxhtml-install-dir) file-name-list))
|
||
|
||
(defun n-back-finish-game ()
|
||
"Finish the game."
|
||
(n-back-cancel-timers)
|
||
(fit-window-to-buffer n-back-ctrl-window)
|
||
(setq n-back-result n-back-this-result)
|
||
(n-back-compute-result-values n-back-result)
|
||
(when n-back-auto-challenge (n-back-set-next-challenge))
|
||
(n-back-update-info)
|
||
(n-back-init-control-status)
|
||
(n-back-clear-match-status)
|
||
(n-back-update-control-buffer)
|
||
(n-back-show-welcome "Game over")
|
||
(with-current-buffer n-back-game-buffer
|
||
;;(setq n-back-challenge-change 'up)
|
||
(let (buffer-read-only)
|
||
(insert
|
||
"\n\n"
|
||
(case n-back-challenge-change
|
||
(up "Congratulations! I see you need more challenge, raising difficulty!")
|
||
(down "Making it a bit easier for now to make your playing more fun.")
|
||
(otherwise "This game challenges seems the right way for you now.")))
|
||
(let* ((dir (when (boundp 'nxhtml-install-dir)
|
||
(expand-file-name "nxhtml/doc/img/" nxhtml-install-dir)))
|
||
(up-imgs '("rembrandt-self-portrait.jpg"
|
||
"bacchante2.jpg"
|
||
"giraffe.jpg"
|
||
"Las_Medulas.jpg"
|
||
))
|
||
(t-imgs '("continue-play.jpg"
|
||
"Toco_toucan.jpg"
|
||
"raindrops2.jpg"
|
||
"divine2.jpg"
|
||
;;"butterflies.png"
|
||
"volga.jpg"
|
||
"healthy_feet2.jpg"
|
||
))
|
||
;; (setq n-back-trials 1)
|
||
(pic (when dir (case n-back-challenge-change
|
||
(up (nth (random (length up-imgs)) up-imgs))
|
||
(otherwise (nth (random (length t-imgs)) t-imgs)))))
|
||
(src (when dir (expand-file-name pic dir)))
|
||
img)
|
||
(when (and src (not (file-exists-p src)))
|
||
;; Time to download?
|
||
(n-back-maybe-download-files (file-name-directory src) (append up-imgs t-imgs nil)))
|
||
(when (and src (file-exists-p src))
|
||
(condition-case err
|
||
(setq img (create-image src nil nil
|
||
:relief 0
|
||
))
|
||
(error (setq img (error-message-string err)))))
|
||
(if (stringp img)
|
||
img
|
||
(insert "\n\n")
|
||
(insert-image img)))))
|
||
(message "Game over"))
|
||
|
||
(defun n-back-display-random ()
|
||
"Display a random item."
|
||
(when (current-message) (message ""))
|
||
;;(message "here start display")
|
||
(let* ((use-position (memq 'position n-back-active-match-types))
|
||
(use-color (memq 'color n-back-active-match-types))
|
||
(use-sound (memq 'sound n-back-active-match-types))
|
||
(use-word (memq 'word n-back-active-match-types))
|
||
(old-rec (when (n-back-match-possible)
|
||
(ring-ref n-back-ring (1- n-back-level))))
|
||
(cols 3)
|
||
(rows 3)
|
||
(x (if use-position (random 3) 1))
|
||
(y (if use-position (random 3) 1))
|
||
(old-x (if use-position (nth 1 old-rec)))
|
||
(old-y (if use-position (nth 2 old-rec)))
|
||
(color (nth (if use-color (random (length n-back-colors)) 0) n-back-colors))
|
||
(old-color (if use-color (nth 3 old-rec)))
|
||
(sound (when use-sound (expand-file-name (nth (random (length n-back-sound-files))
|
||
n-back-sound-files)
|
||
(nth 0 n-back-sounds))))
|
||
(old-sound (if use-sound (nth 4 old-rec)))
|
||
(words (when use-word (split-string n-back-words)))
|
||
(word (when use-word (nth (random (length words)) words)))
|
||
(old-word (when use-word (nth 5 old-rec)))
|
||
(str (if word word "")) ;(format "%s" n-back-trials-left))
|
||
(max-strlen (if words
|
||
(+ 2 (apply 'max (mapcar (lambda (w) (length w)) words)))
|
||
5))
|
||
(compensate 24)
|
||
)
|
||
;; To get more targets make it more plausible that it is the same here.
|
||
;; (/ (- 6 (/ 20.0 8)) 20)
|
||
(when old-rec
|
||
(when (and use-position
|
||
(not (and (= x old-x)
|
||
(= y old-y)))
|
||
(< (random 100) compensate))
|
||
(setq x (nth 1 old-rec))
|
||
(setq y (nth 2 old-rec)))
|
||
(when (and use-color
|
||
(not (equal color old-color))
|
||
(< (random 100) compensate))
|
||
(setq color (nth 3 old-rec)))
|
||
(when (and use-sound
|
||
(not (equal sound old-sound))
|
||
(< (random 100) compensate))
|
||
(setq sound (nth 4 old-rec)))
|
||
(when (and use-word
|
||
(not (equal word old-word))
|
||
(< (random 100) compensate))
|
||
(setq word (nth 5 old-rec))))
|
||
(setq str word) ;; fix-me
|
||
(ring-insert n-back-ring (list str x y color sound word))
|
||
;;(message "here before display")
|
||
(n-back-display str x y cols rows max-strlen color)
|
||
;;(when sound (play-sound (list 'sound :file sound)))
|
||
;;(message "here before clear-m")
|
||
(n-back-clear-match-status)
|
||
;;(message "here before position")
|
||
(when (and use-position (n-back-matches 'position)) (n-back-set-match-status 'position 'miss))
|
||
;;(message "here before color")
|
||
(when (and use-color (n-back-matches 'color)) (n-back-set-match-status 'color 'miss))
|
||
;;(message "here before sound")
|
||
(when (and use-sound (n-back-matches 'sound)) (n-back-set-match-status 'sound 'miss))
|
||
;;(message "here before word")
|
||
(when (and use-word (n-back-matches 'word)) (n-back-set-match-status 'word 'miss))
|
||
(setq n-back-display-hint n-back-hint)
|
||
;;(message "here before control")
|
||
(n-back-update-control-buffer)
|
||
;;(message "here before clear timer")
|
||
(setq n-back-clear-timer (run-with-timer 0.5 nil 'n-back-clear-game-window))
|
||
;;(message "here before sound timer")
|
||
(when sound (run-with-timer 0.01 nil 'n-back-play-sound-in-timer sound))
|
||
;;(message "here exit display")
|
||
))
|
||
|
||
(defun n-back-display-in-timer ()
|
||
"Display a trial in a timer."
|
||
(condition-case err
|
||
(save-match-data ;; runs in timer
|
||
(n-back-add-result)
|
||
(if (>= 0 (setq n-back-trials-left (1- n-back-trials-left)))
|
||
(n-back-finish-game)
|
||
(n-back-display-random)
|
||
(n-back-start-main-timer)
|
||
;;(message "after start-main-timer")
|
||
))
|
||
(error (message "n-back-display: %s" (error-message-string err))
|
||
(n-back-cancel-timers))))
|
||
|
||
(defun n-back-play-sound-in-timer (sound-file)
|
||
"Play sound SOUND-FILE in a timer."
|
||
(condition-case err
|
||
(save-match-data ;; runs in timer
|
||
(play-sound (list 'sound :file sound-file :volume n-back-sound-volume)))
|
||
(error (message "n-back-sound: %s" (error-message-string err))
|
||
(n-back-cancel-timers))))
|
||
|
||
|
||
;;; Answers
|
||
|
||
;;(defvar n-back-answers nil)
|
||
|
||
(defun n-back-init-this-result ()
|
||
"Init `n-back-this-result'."
|
||
(setq n-back-this-result nil)
|
||
(dolist (sts-entry n-back-control-status)
|
||
(let* ((what (nth 0 sts-entry))
|
||
(res-entry (list what 0 0 0)))
|
||
(setq n-back-this-result (cons res-entry n-back-this-result)))))
|
||
|
||
(defun n-back-match-possible ()
|
||
"Return t if enouch entries have been shown to match."
|
||
(= (ring-length n-back-ring) (1+ n-back-level)))
|
||
|
||
(defun n-back-add-result ()
|
||
"Add result of last trial."
|
||
(when (n-back-match-possible)
|
||
(dolist (sts-entry n-back-control-status)
|
||
(let* ((what (nth 0 sts-entry))
|
||
(sts (nth 2 sts-entry))
|
||
(matches (n-back-matches what))
|
||
(num (cond
|
||
((eq sts 'ok) 1)
|
||
((eq sts 'bad) 2)
|
||
;;((eq sts nil) (when matches 3))
|
||
((eq sts 'miss) 3)
|
||
((not sts) nil)
|
||
(t (error "n-back: Bad status=%s" sts))))
|
||
(res-entry (when num (assoc what n-back-this-result)))
|
||
(lst (when num (nthcdr num res-entry))))
|
||
(when num
|
||
(if res-entry
|
||
(setcar lst (1+ (car lst)))
|
||
(setq res-entry (list what 0 0 0))
|
||
;;(setq lst (nthcdr num res-entry))
|
||
(setq n-back-this-result (cons res-entry n-back-this-result))))))))
|
||
|
||
(defun n-back-matches-position ()
|
||
"Return non-nil iff last trial position match."
|
||
(when (n-back-match-possible)
|
||
(let* ((comp-item (ring-ref n-back-ring n-back-level))
|
||
(curr-item (ring-ref n-back-ring 0))
|
||
(comp-x (nth 1 comp-item))
|
||
(curr-x (nth 1 curr-item))
|
||
(comp-y (nth 2 comp-item))
|
||
(curr-y (nth 2 curr-item)))
|
||
(and (= comp-y curr-y)
|
||
(= comp-x curr-x)))))
|
||
|
||
(defun n-back-matches-color ()
|
||
"Return non-nil iff last trial color match."
|
||
(when (n-back-match-possible)
|
||
(let* ((comp-item (ring-ref n-back-ring n-back-level))
|
||
(curr-item (ring-ref n-back-ring 0))
|
||
(comp-color (nth 3 comp-item))
|
||
(curr-color (nth 3 curr-item)))
|
||
(equal comp-color curr-color))))
|
||
|
||
(defun n-back-matches-sound ()
|
||
"Return non-nil iff last trial sound match."
|
||
(when (n-back-match-possible)
|
||
(let* ((comp-item (ring-ref n-back-ring n-back-level))
|
||
(curr-item (ring-ref n-back-ring 0))
|
||
(comp-sound (nth 4 comp-item))
|
||
(curr-sound (nth 4 curr-item)))
|
||
(equal comp-sound curr-sound))))
|
||
|
||
(defun n-back-matches-word ()
|
||
"Return non-nil iff last trial word match."
|
||
(when (n-back-match-possible)
|
||
(let* ((comp-item (ring-ref n-back-ring n-back-level))
|
||
(curr-item (ring-ref n-back-ring 0))
|
||
(comp-word (nth 5 comp-item))
|
||
(curr-word (nth 5 curr-item)))
|
||
(equal comp-word curr-word))))
|
||
|
||
(defun n-back-matches (what)
|
||
"Return non-nil iff last trial part WHAT match."
|
||
(cond
|
||
((eq what 'position) (n-back-matches-position))
|
||
((eq what 'color) (n-back-matches-color))
|
||
((eq what 'sound) (n-back-matches-sound))
|
||
((eq what 'word) (n-back-matches-word))
|
||
(t (error "n-back: Unknown match type: %s" what))))
|
||
|
||
(defun n-back-answer (what)
|
||
"Tell that you think WHAT matched."
|
||
(when (n-back-is-playing)
|
||
(if (memq what n-back-active-match-types)
|
||
(if (n-back-match-possible)
|
||
(let ((sts (if (n-back-matches what) 'ok 'bad)))
|
||
(n-back-set-match-status what sts)
|
||
(n-back-update-control-buffer))
|
||
(message "%s n-back items must be displayed before anything can match"
|
||
n-back-level))
|
||
(message "%s match is not active" what)
|
||
(ding t))))
|
||
|
||
(defun n-back-position-answer ()
|
||
"Tell that you think position matched."
|
||
(interactive)
|
||
(n-back-answer 'position))
|
||
|
||
(defun n-back-color-answer ()
|
||
"Tell that you think color matched."
|
||
(interactive)
|
||
(n-back-answer 'color))
|
||
|
||
(defun n-back-sound-answer ()
|
||
"Tell that you think sound matched."
|
||
(interactive)
|
||
(n-back-answer 'sound))
|
||
|
||
(defun n-back-word-answer ()
|
||
"Tell that you think word matched."
|
||
(interactive)
|
||
(n-back-answer 'word))
|
||
|
||
(defun n-back-stop ()
|
||
"Stop playing."
|
||
(interactive)
|
||
(n-back-cancel-timers)
|
||
(n-back-update-control-buffer)
|
||
(message "Stopped n-back game")
|
||
(n-back-show-welcome "Stopped"))
|
||
|
||
(defvar viper-emacs-state-mode-list) ;; silence compiler
|
||
(defvar viper-emacs-state-hook) ;; silence compiler
|
||
|
||
(define-derived-mode n-back-control-mode nil "N-back"
|
||
"Mode for controlling n-back game."
|
||
(setq cursor-type nil)
|
||
(setq buffer-read-only t)
|
||
(set (make-local-variable 'viper-emacs-state-mode-list) '(n-back-control-mode))
|
||
(set (make-local-variable 'viper-emacs-state-hook) nil) ;; in vis cursor
|
||
(abbrev-mode -1)
|
||
(setq show-trailing-whitespace nil)
|
||
(when (fboundp 'visual-line-mode) (visual-line-mode 1))
|
||
(n-back-make-keymap))
|
||
|
||
(defun n-back-cancel-timers ()
|
||
"Cancel game timers."
|
||
(when (timerp n-back-timer)
|
||
(cancel-timer n-back-timer))
|
||
(setq n-back-timer nil)
|
||
(when (timerp n-back-clear-timer)
|
||
(cancel-timer n-back-clear-timer))
|
||
(setq n-back-clear-timer nil)
|
||
(winsize-set-mode-line-colors nil))
|
||
|
||
(defvar n-back-game-settings-symbols
|
||
'(
|
||
;;n-back-keys
|
||
n-back-level
|
||
n-back-active-match-types
|
||
n-back-allowed-match-types
|
||
n-back-auto-challenge
|
||
;;n-back-colors
|
||
;;n-back-words
|
||
;;n-back-sound-volume
|
||
;;n-back-sounds
|
||
n-back-sec-per-trial
|
||
;;n-back-keybinding-color
|
||
;;n-back-trials
|
||
))
|
||
|
||
(defun n-back-save-game-settings ()
|
||
"Save game settings."
|
||
(interactive)
|
||
(dolist (var n-back-game-settings-symbols)
|
||
)
|
||
(custom-save-all))
|
||
|
||
(defun n-back-reset-game-to-saved ()
|
||
"Reset game playing options to saved values."
|
||
(interactive)
|
||
(dolist (pass '(1 2))
|
||
(dolist (var n-back-game-settings-symbols)
|
||
(if (= pass 1)
|
||
;; pass 1 is for my lousy programming:
|
||
(condition-case err
|
||
(custom-reevaluate-setting var)
|
||
(error nil))
|
||
(custom-reevaluate-setting var)))))
|
||
|
||
(provide 'n-back)
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;; n-back.el ends here
|