;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; triggers:
(defvar nanvaent-modifer-map 
  '((te . -4) (vp . -3) (po . -2)
    (ba . -1) (av .  0) (aa .  1)
    (go .  2) (vg .  3) (ex .  4)))

(defvar nanvaent-guilds 
  '("cleric"  "thief"        "necromancer"  "wizard" 
    "fighter" "barbarian"    "forester"     "knight"
    "bard"    "n'thydarak"   "elementalist" "wolfpack"))

(defvar nanvaent-race-modifiers
  '(
    ("banshee"     po aa ba go aa vg (* * * * * - - - - - - -))
    ("calacorm"    vg vp aa ba aa vp (* * * * * - - - - - - -))
    ("centaur"     aa vp aa ba vg ba (* * * * * - - - * - - -))
    ("dark elf"    po ex po aa aa ex (* * * * * - - - * * * -))
    ("dwarf"       go vp go ba aa go (* * * * * - - - - - - -))
    ("ent"         go ba vg te ex go (* * - * * - - - - - - -))
    ("faery"       ba ex po aa po aa (* * * * * - * - * - - -))
    ("giant"       ex te ex po po vp (* * * * * * - - * - - -))
    ("gnome"       aa aa vp po vg vg (* * * * * - - - * - * -))
    ("goblin"      ba po aa vg ba go (* * * * * - - - - - - -))
    ("grey wolf"   ba av aa vg ba vg (* * - * * - - - - - - *))
    ("half elf"    po aa po aa go go (* * * * * - * - * - * -))
    ("half orc"    go ba av aa po aa (* * * * * - - * * - - -))
    ("halfling"    po aa av vg po aa (* * * * * - * - * - - -))
    ("hamakei"     ba go ba aa ba vg (* * * * * - - - - - - -))
    ("high elf"    vp ex po aa av vg (* * * * * - - - * - * -))
    ("hobgoblin"   go vp aa av aa aa (* * * * * - - - - - - -))
    ("human"       av av av av av po (* * * * * * * * * * * -))
    ("kobold"      av po aa vg po aa (* * * * * - - - - - - -))
    ("liche"       go vg ba aa te vg (* * * * * - - - - * - -))
    ("minotaur"    go vp aa ba go vg (* * * * * - - - - * - -))
    ("morokai"     aa go av av vp vg (* * * * * - - - - * - -))
    ("nekojin"     go po av aa ba vg (* * * * * - - - - - - -))
    ("ogre"        vg po go po ba ba (* * * * * * - - - - - -))
    ("orc"         go po go av po vg (* * * * * * - - - * - -))
    ("pegasus"     aa aa av po aa aa (* * - * * - - - - - - -))
    ("sasquatch"   av vp aa ba vg po (* * * * * - * - - - - -))
    ("satyr"       po aa ba av aa po (* * * * * - - - * - - -))
    ("skaven"      av aa po vg po vg (* * * * * - - - - * - -))
    ("slann"       aa aa po po vg po (* * * * * - - - - - - -))
    ("troll"       ex po vg ba te go (* * * * * * - - - * - -))
    ("wight"       aa te po ex go vg (* * * * * - - - - * - -))
    ("wood elf"    po vg ba aa aa vg (* * * * * - * - * - * -))
    ("wuzzie"      ba aa po go av aa (* * * * * - * - * - - -))

    ("wolf"        ba av aa vg ba vg (* * - * * - - - - - - *))
    ("red wolf"    ba ba aa ex ba ex (- - - - - - - - - - - *))
    ("arctic wolf" ba ba go vg ba ex (- - - - - - - - - - - *))
    ("timber wolf" av av aa go po ex (- - - - - - - - - - - *)) ))

(defvar nanvaent-guilds 
  '("cleric"  "thief"        "necromancer"  "wizard" 
    "fighter" "barbarian"    "forester"     "knight"
    "bard"    "n'thydarak"   "elementalist" "wolfpack"))

(defvar nanvaent-stats '("st" "in" "co" "de" "wi"))

(defun nanvaent-race-guilds (race)
  (let (mods allowed guilds rval)
    (setq mods    (cdr (assoc race nanvaent-race-modifiers))
          guilds  nanvaent-guilds
          allowed (nth 6 mods))
    (while (and allowed guilds)
      (when (eq (car allowed) '*)
        (setq rval (cons (car guilds) rval)))
      (setq allowed (cdr allowed)
            guilds  (cdr guilds )))
    rval))


(defun nanvaent-race-stat (race stat target)
  (let (mods rval)
    (setq mods   (cdr (assoc race nanvaent-race-modifiers))
          stat   (substring (format "%s" stat) 0 2)
          offset nil
          adjust nil)
    (if mods
        (if (setq offset (member stat nanvaent-stats))
            (setq offset (- (length nanvaent-stats) (length offset))
                  adjust (cdr (assq (nth offset mods) nanvaent-modifer-map))
                  rval   (format "%s : raw %d; modifier %+d; final: %d;"
                                 stat (- target adjust) adjust target))
          (setq rval (format "unknown stat '%s'" stat)))
      (setq rval (format "unknown race '%s'" race)))
    rval))

(defun nanvaent-race-stat-trigger (&optional stripped)
  (setq stripped 
        (replace-regexp-in-string ansi-color-regexp "" ef-current-data))
  ;;(message "ef-current-data: %S" ef-current-data)
  (when (string-match (concat "\\(?:\\(\\S-+\\) tells you\\| says?\\):" "\\s-+"
                              "(stat \\(\\S-+\\)"                       "\\s-+" 
                              "\\(\\S-+\\)"                             "\\s-+"
                              "\\([0-9]+\\)"                            ")")
                      stripped)
    (let ((who   (match-string 1 stripped))
          (race  (replace-regexp-in-string "[^a-z]" " "
                                           (match-string 2 stripped)))
          (stat  (downcase (match-string 3 stripped)))
          (score (string-to-number (match-string 4 stripped)))
          response)
      (setq response (nanvaent-race-stat race stat score))
      (if who
          (progn ;; (message (format "t %s %s\n" (downcase who) response))
                 (ef-send-data (format "t %s %s\n" (downcase who) response)))
        (ef-send-data (format "say \"%s\"\n" response)))) ))

(defun nanvaent-delayed-command (buffer string)
  (with-current-buffer buffer
    (ef-send-data (concat string "\n"))))

(defvar nanvaent-target ".* robed bandit")
(defun nanvaent-follow-target ()
  (when (string-match
         (format "%s leaves \\([a-z]+\\)." nanvaent-target)
         ef-current-data)
    (message "follow: %s" (match-string 1 ef-current-data))
    (ef-send-data (format "%s\n" (match-string 1 ef-current-data))) ))

(defvar nanvaent-invisibility t)
(defun nanvaent-invis-trigger (&optional stripped)
  (when (and nanvaent-invisibility
             (setq stripped (replace-regexp-in-string ansi-color-regexp
                                                      "" ef-current-data))
             (string-match "^You suddenly realise that you are visible again"
                           stripped))
    (ef-send-data "cvi\n")
    (run-with-timer 5 nil 'nanvaent-delayed-command (current-buffer) "mvi")))

(defun nanvaent-invis-trigger-on  (&optional stripped)
  (setq stripped
        (replace-regexp-in-string ansi-color-regexp "" ef-current-data))
  (when (string-match "^You begin to cast veil of invisibility\\." stripped)
    (setq nanvaent-invisibility t)))

(defun nanvaent-invis-trigger-off (&optional stripped)
  (setq stripped
        (replace-regexp-in-string ansi-color-regexp "" ef-current-data))
  (when (string-match "^You begin to glow with magical light\\." stripped)
    (setq nanvaent-invisibility nil)))

(defun nanvaent-shield-trigger ()
  (when (string-match ": (shield \\([^\n;]+\\))" ef-current-data)
    (ef-send-data (format "csop %s\n" (match-string 1 ef-current-data))) ))

(defun nanvaent-shield-trigger-2 ()
  (when (string-match "(memorise shield)" ef-current-data)
    (message "msop" (match-string 1 ef-current-data))
    (ef-send-data (format "msop\n" (match-string 1 ef-current-data))) ))

(defun nanvaent-password-trigger (&optional who pass)
  (let ((case-fold-search nil))
    (when (string-match
           "\\([A-Z][a-z]+\\) tells you: (zavier-password \\([a-z]+\\))"
           ef-current-data)
      (setq who  (downcase (match-string 1 ef-current-data))
            pass (match-string 2 ef-current-data)
            pass (zavier-militia-password-2 pass))
      (message "telling %s '%s'" who pass)
      (ef-send-data (format "tell %s '%s'\n" who pass))) ))

(defvar nanvaent-shield-check-target nil)

(defun nanvaent-shield-check-trigger-a ()
  (when (and (not nanvaent-shield-check-target)
             (string-match "(check-shield \\([^\n;]+\\))" ef-current-data))
    (setq nanvaent-shield-check-target (match-string 1 ef-current-data))
    (message "check %s" nanvaent-shield-check-target)
    (ef-send-data (format "css %s\n" nanvaent-shield-check-target)) ))

(defun nanvaent-shield-check-trigger-b ()
  (when (and nanvaent-shield-check-target
             (string-match "\\*\\*\\*? \\(.*\\) \\*\\*\\*?" ef-current-data))
    (ef-send-data (format "say %s: %s\nmss\n"
                          nanvaent-shield-check-target
                          (match-string 1 ef-current-data)))
    (setq nanvaent-shield-check-target nil) ))

(let ((trigger-list '(nanvaent-shield-trigger
                      nanvaent-shield-trigger-2
                      nanvaent-password-trigger
                      nanvaent-shield-check-trigger-a
                      nanvaent-shield-check-trigger-b)))
  (mapc
   (lambda (fun)
     (if (memq fun ef-input-filters)
         (remove-hook 'ef-input-filters fun)
       (message "+function: %S" fun)
       (add-hook 'ef-input-filters fun)))
   trigger-list)
  ef-input-filters)

(when nil
  (remove-hook 'ef-input-filters 'nanvaent-shield-trigger)
  (remove-hook 'ef-input-filters 'nanvaent-shield-trigger-2)
  (remove-hook 'ef-input-filters 'nanvaent-shield-check-trigger-a)
  (remove-hook 'ef-input-filters 'nanvaent-shield-check-trigger-b))

(when nil
  (add-hook 'ef-input-filters 'nanvaent-invis-trigger)
  (add-hook 'ef-input-filters 'nanvaent-follow-target)
  (add-hook 'ef-input-filters 'nanvaent-shield-trigger)
  (add-hook 'ef-input-filters 'nanvaent-shield-trigger-2)
  (add-hook 'ef-input-filters 'nanvaent-shield-check-trigger-a)
  (add-hook 'ef-input-filters 'nanvaent-shield-check-trigger-b))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mapping code:
(require 'ansi-color)

(defvar ef-last-direction nil)

(defvar ef-last-map-point nil)
(make-variable-buffer-local 'ef-last-map-point)

(defvar ef-last-move-sail-p nil)

(defun ef-output-capture-direction ()
  (cond ((and (stringp ef-current-data)
              (string-match "^\\s-*\\<\\([nsew]\\|n[ew]\\|s[ew]\\)\\>\\s-*$"
                            ef-current-data))
         ;;(message "moving %s" (match-string 1 ef-current-data))
         (setq ef-last-direction  (match-string 1 ef-current-data)
               ef-last-move-sail-p nil))
        ((and (stringp ef-current-data)
              (string-match "^sail \\s-*\\<\\([nsew]\\|n[ew]\\|s[ew]\\)\\>.*$"
                            ef-current-data))
         ;;(message "sailing %s" (match-string 1 ef-current-data))
         (setq ef-last-direction   (match-string 1 ef-current-data)
               ef-last-move-sail-p t))
        (t
         (setq ef-last-direction nil))))

(defvar ef-map-compass-to-xy
  '(("n"  -1 .  0)
    ("s"   1 .  0)
    ("e"   0 .  1)
    ("w"   0 . -1)
    ("ne" -1 .  1)
    ("se"  1 .  1)
    ("nw" -1 . -1)
    ("sw"  1 . -1)))

(defvar ef-map-compass-to-sigil
  '(("n"  . ?| )
    ("s"  . ?| )
    ("e"  . ?- )
    ("w"  . ?- )
    ("ne" . ?/ )
    ("se" . ?\\)
    ("nw" . ?\\)
    ("sw" . ?/ )
    (nil  . ?# )))

(defun ef-map-move (dir &optional reverse)
  (let (xy y x)
    (setq xy (cdr (assoc dir ef-map-compass-to-xy)))
    (when xy
      (setq x (cdr xy)
            y (car xy))
      (when reverse (setq x (* -1 x) y (* -1 y)))
      (let ((picture-vertical-step   y)
            (picture-horizontal-step x))
        (picture-move))
      t)
    nil))

(defun ef-map-insert-sigil (moved)
  (let (cc sigil)
    (setq cc    (char-after)
          sigil (cdr (assoc moved ef-map-compass-to-sigil)))
    (when (and ef-map-on-road (eq sigil ?#))
      (setq sigil ?=))
    (when (and ef-last-move-sail-p (eq sigil ?#))
      (setq sigil ?⌣))
    (when (and (not moved)
               (not (memq cc '(?\n ?\ ))))
      (setq sigil cc))
    (cond ((eq cc sigil) nil)
          ((eq cc ?\n  ) (insert sigil) (backward-char))
          ((eq cc ?\   ) (insert sigil) (delete-char 1) (backward-char))
          (t             (insert ?·   ) (delete-char 1) (backward-char)) )))

(defun ef-process-movement-to-map (moved &optional exits)
  (when (buffer-live-p ef-map-buffer)
    (with-current-buffer ef-map-buffer
      (when ef-last-map-point (goto-char ef-last-map-point))
      (ef-map-move moved)
      (ef-map-insert-sigil moved)
      (ef-map-move moved)
      (ef-map-insert-sigil nil)
      (mapc
       (lambda (exit)
         (ef-map-move exit)
         (ef-map-insert-sigil exit)
         (ef-map-move exit :undo))
       exits)
      (setq ef-last-map-point (point))
      (let ((bw (get-buffer-window ef-map-buffer 'visible)))
        ;;(message "bw: %S" bw)
        (when bw
          (set-window-point bw ef-last-map-point)))
      )))

(defvar ef-map-buffer  nil)
(defvar ef-map-on-road nil)

(defun ef-input-capture-directions ()
  ;;(message "%S" ef-last-direction)
  (when ef-last-direction
    (when (or (string-match "^.*?obvious exit.*?: \\(\\(?:.\\|\n\\)+\\)"
                            ef-current-data)
              (string-match "^.*You can sail: \\(\\(?:.\\|\n\\)+\\)"
                            ef-current-data))
      (let ((exits nil) (prompt (match-string 1 ef-current-data)))
        (when prompt
          (setq ef-map-on-road (string-match "\\[36m[nsew]" prompt))
          (setq prompt (replace-regexp-in-string ansi-color-regexp "" prompt))
          (mapc (lambda (C)
                  (when (string-match (car C) prompt)
                    (setq exits (cons (cdr C) exits))))
                '(("\\<north\\>"     . "n" )
                  ("\\<south\\>"     . "s" )
                  ("\\<west\\>"      . "w" )
                  ("\\<east\\>"      . "e" )
                  ("\\<northeast\\>" . "ne")
                  ("\\<northwest\\>" . "nw")
                  ("\\<southeast\\>" . "se")
                  ("\\<southwest\\>" . "sw")) ))
        ;;(message "exits: %S" exits)
        (ef-process-movement-to-map ef-last-direction exits))
      (setq ef-last-direction nil) )))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; militia code
(require 'assoc)

(defun zavier-militia-ramp (height gap safety-margin)
  (interactive "nheight: \nngap: \nnsafety margin: ")
  (setq safety-margin
        (+ (sqrt (apply '+ (mapcar (lambda (a) (expt a 2)) (list height gap))))
           (* 2 safety-margin)))
  (when (interactive-p) (insert (format "scrawl %d units" safety-margin)))
  safety-margin)

(defun nanvaent-check-word (word)
  (let ((sp (shell-command-to-string (format "echo '%s' | ispell -a" word))))
    (or (string-match "^*\\s-*$"      sp)
        (string-match "^&\\s-* \\S-+ 1 0: " sp)) ))

(defun zavier-militia-password (raw-string)
  (interactive "sencrypted: ")
  (let ((r 1) (rotated) (potential) (dict))
    (setq dict
          (with-temp-buffer
            (insert-file-contents "/usr/share/dict/words") (buffer-string)))
    (while (< r 27)
      (setq rotated
            (mapconcat
             (lambda (c)
               (cond ((and (>= c ?A ) (<= c ?Z))
                      (list (+ (mod (+ (- c ?A) r) 26) ?A)))
                     ((and (>= c ?a) (<= c ?z))
                      (list (+ (mod (+ (- c ?a) r) 26) ?a)))
                     (t (list c)))) raw-string ""))
      (when (or (string-match (concat "^" rotated "$") dict)
                (nanvaent-check-word rotated))
        (setq potential rotated))
      (setq r (1+ r)))
    (when (and (interactive-p) potential)
      (insert (format "t khatol %s" potential)))
    potential))

(defun zavier-militia-password-2 (raw-string)
  (interactive "sencrypted: ")
  (let ((r 1) (rotated) (rlist) (potential) (dict))
    (setq dict
          (with-temp-buffer
            (insert-file-contents "/usr/share/dict/words") (buffer-string)))
    (while (< r 27)
      (setq rotated
            (mapconcat
             (lambda (c)
               (cond ((and (>= c ?A ) (<= c ?Z))
                      (list (+ (mod (+ (- c ?A) r) 26) ?A)))
                     ((and (>= c ?a) (<= c ?z))
                      (list (+ (mod (+ (- c ?a) r) 26) ?a)))
                     (t (list c)))) raw-string ""))
      (setq rlist (cons rotated rlist))
      (setq r (1+ r)))

    (mapc
     (lambda (r)
       (when (string-match (concat "^" r "$") dict)
         (setq potential (cons r potential)))) rlist)

    (when (not potential)
      (mapc
       (lambda (r)
         (when (nanvaent-check-word r)
           (setq potential (cons r potential)))) rlist))

    (when (= (length potential) 1)
      (setq potential (car potential)))

    (when (and (interactive-p) potential)
      (insert (format "t khatol %s" potential)))
    potential))

(defun zavier-militia-read-colour ()
  (completing-read "colour: "
                   '("red" "orange" "yellow" "green" "blue" "indigo" "violet")
                   nil
                   :must-match))

(defun zavier-militia-read-shape ()
  (completing-read "shape: "
                   '("triangle" "square" "pentagon" "hexagon"
                     "heptagon" "octagon" "nonagon" "decagon")
                   nil
                   :must-match))

(defconst zavier-militia-safe-enum
  '(("red"      . 1)
    ("orange"   . 2)
    ("yellow"   . 3)
    ("green"    . 4)
    ("blue"     . 5)
    ("indigo"   . 6)
    ("violet"   . 7)
    ("triangle" . 3)
    ("square"   . 4)
    ("pentagon" . 5)
    ("hexagon"  . 6)
    ("heptagon" . 7)
    ("octagon"  . 8)
    ("nonagon"  . 9)
    ("decagon"  . 10)))

(defun zavier-militia-safe (c0 p0 c1 p1 c2 p2)
  (interactive
   (list (zavier-militia-read-colour) (zavier-militia-read-shape)
         (zavier-militia-read-colour) (zavier-militia-read-shape)
         (zavier-militia-read-colour) (zavier-militia-read-shape)))
  (let ((code
         (apply '+
                (mapcar (lambda (x)
                          (* (aget zavier-militia-safe-enum (car x))
                             (aget zavier-militia-safe-enum (cdr x))))
                        (list (cons c0 p0) (cons c1 p1) (cons c2 p2))))))
    (when (interactive-p)
      (insert (format "type in %d" code)))
    code))

(add-hook 'ef-output-filters 'ef-output-capture-direction)

(add-hook 'ef-input-filters  'ef-input-capture-directions)
(add-hook 'ef-input-filters  'nanvaent-follow-target)
(add-hook 'ef-input-filters  'nanvaent-race-stat-trigger)

(add-hook 'ef-input-filters  'nanvaent-invis-trigger-off)
(add-hook 'ef-input-filters  'nanvaent-invis-trigger-on)
(add-hook 'ef-input-filters  'nanvaent-invis-trigger :append)