summaryrefslogtreecommitdiffstats
path: root/emacs.d/nxhtml/util/n-back.el
diff options
context:
space:
mode:
Diffstat (limited to 'emacs.d/nxhtml/util/n-back.el')
-rw-r--r--emacs.d/nxhtml/util/n-back.el1296
1 files changed, 0 insertions, 1296 deletions
diff --git a/emacs.d/nxhtml/util/n-back.el b/emacs.d/nxhtml/util/n-back.el
deleted file mode 100644
index 024b8e6..0000000
--- a/emacs.d/nxhtml/util/n-back.el
+++ /dev/null
@@ -1,1296 +0,0 @@
-;;; 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
generated by cgit v1.2.3-54-g00ecf (git 2.39.0) at 2024-07-10 10:56:42 +0000