(provide 'diku-modes-common-defs) ;; This file contains functions that useful for any mud-mode (I ;; assume). ;; ;; Flag insertion (beginning) (defun mud-reset-flags(mud-leading-text mud-flag-list) "Resets flags in trodden number. Flag values are computed according to their position in FLAG-LIST" (mud-reset-flags-in-trodden-num (string-to-int (mud-get-flags mud-leading-text mud-flag-list)))) (defun mud-set-flags(mud-leading-text mud-flag-list) "Sets flags in trodden number. Flag values are computed according to their position in FLAG-LIST" (mud-set-flags-in-trodden-num (string-to-int (mud-get-flags mud-leading-text mud-flag-list)))) (defun mud-get-flags(leading-text flag-list) "Prompts user for a space-separated string of flag names, flag name abbreviations or flag name abbreviations preceded by a number and a dot. Inserts the result of bitwise or-ing the values of the flags in the entered string." (int-to-string (mud-logior-flags (mud-string-to-list (read-string leading-text) nil) flag-list))) (defun mud-logior-flags(flags flag-list) "Returns the value of FLAGS, using bitwise-or to combine the values.. If any of the flags is not found in FLAG-LIST, an error is signaled." (if (car-safe flags) (logior (progn (if (null (mud-flag-value (car-safe flags) flag-list)) (error (concat "Unknown flag: " (car-safe flags))) (mud-flag-value (car-safe flags) flag-list))) (mud-logior-flags (cdr-safe flags) flag-list)) 0)) (defun mud-flag-value(flag-name flag-list) "Computes the value of FLAG-NAME using positions in flag-list to compute flag values." (cdr (assoc (mud-expand-flag-abbrev flag-name flag-list) (mud-build-binexp-alist (reverse flag-list) nil 0)))) (defun mud-build-binexp-alist (flag-list alist exponent) "Returns an alist where key-items come from flag-list and values are distinct powers of 2" (if (car-safe flag-list) (mud-build-binexp-alist (cdr flag-list) (cons (cons (car flag-list) (expt 2 exponent)) alist) (+ 1 exponent)) alist)) (defun mud-expand-flag-abbrev(flag-abbrev flag-list) "Returns an expansion of FLAG-ABBREV in FLAG-LIST, if any." (mud-select-word (mud-string-get-num flag-abbrev) (mud-word-candidate-list (mud-zap-until-dot flag-abbrev) flag-list 0))) (defun mud-string-get-num (string-get-num-string) "Returns nil if string does not begin with a number followed by a dot. Otherwise it returns the number as an integer" (if (string-match "[0-9]+\\." string-get-num-string) (if (= 0 (string-match "[0-9]+\\." string-get-num-string)) (string-to-int (substring string-get-num-string 0 (match-end 0))) nil))) (defun mud-select-word(word-number flag-name-list) "Returns word WORD-NUMBER in FLAG-NAME-LIST." (if (null word-number) (car flag-name-list) (nth (- word-number 1) flag-name-list))) (defun mud-word-candidate-list (candidate-word candidate-list character-number) "Returns words whose beginning matches candidate-word. If none is found, the function returns nil" (let ((next-candidate-list nil)) (if (< (length candidate-word) (+ character-number 1)) candidate-list (progn (while (not (null candidate-list)) (let ((test-word nil)) (progn (if (atom candidate-list) (progn (setq test-word candidate-list) (setq candidate-list nil)) (setq test-word (car candidate-list))) (if (>= (length test-word) (+ character-number 1)) (if (char-equal (string-to-char (substring candidate-word character-number (+ character-number 1))) (string-to-char (substring test-word character-number (+ character-number 1)))) (setq next-candidate-list (cons test-word next-candidate-list)))) (setq candidate-list (cdr candidate-list))))) (if (null next-candidate-list) nil (mud-word-candidate-list candidate-word next-candidate-list (+ 1 character-number))))))) (defun mud-string-to-list(string-to-list-string string-to-list-list) "Given a space separated string, this function returns a list of strings." (progn (if (string-match " " string-to-list-string) (mud-string-to-list (substring string-to-list-string (+ 1 (string-match " " string-to-list-string)) (length string-to-list-string)) (cons (substring string-to-list-string 0 (string-match " " string-to-list-string)) string-to-list-list)) (cons string-to-list-string string-to-list-list)))) (defun mud-zap-until-dot (strip-string) "If strip-string contains a dot, the function returns what is after the dot. Otherwise strip-string is returned." (if (string-match "\\." strip-string) (substring strip-string (+ 1 (string-match "\\." strip-string)) (length strip-string)) strip-string)) ;; flag insertion (end) ;; Flag and buffer manipulation (beginning) (defun mud-delete-trodden-num() (save-excursion (progn (re-search-backward "[^0-9]" nil t) (re-search-forward "[0-9]+" nil t) (let ((num (buffer-substring (match-beginning 0) (match-end 0)))) (progn (delete-region (match-beginning 0) (match-end 0)) (string-to-int num)))))) (defun mud-get-trodden-num() (save-excursion (progn (re-search-backward "[^0-9]" nil t) (re-search-forward "[0-9]+" nil t) (let ((num (buffer-substring (match-beginning 0) (match-end 0)))) (string-to-int num))))) (defun mud-set-flags-in-trodden-num(flag-values) (save-excursion (insert (int-to-string (logior (mud-delete-trodden-num) flag-values))))) (defun mud-reset-flags-in-trodden-num(flag-values) (save-excursion (insert (int-to-string (logand (mud-delete-trodden-num) (lognot flag-values)))))) ;; Flag and buffer manipulation (end) ;; Dec and bin string handling (beginning) (defun mud-insert-flags(mud-leading-text flag-list) (mud-delete-trodden-num) (insert (mud-get-flags mud-leading-text flag-list)) (wld-describe-field)) (defun mud-flags-and-fields (point flag-list) "This function returns a string suitable for output. The string consists of flag names concatenated with flag values. The flag values are computed from the number trodden on by the point POINT is a location in the buffer. FLAG LIST is a list of formatted string names." (save-excursion (progn (goto-char point) (if (looking-at "[0-9]+") (mud-interleave-string-and-list (mud-dec-to-bin (string-to-int (buffer-substring (car (match-data)) (car (cdr (match-data))))) (length flag-list)) (reverse flag-list) "") "Invalid room flag")))) (defun mud-interleave-string-and-list(string list result) (if (or (null list) (= 0 (length string))) result (mud-interleave-string-and-list (substring string 0 (- (length string) 1)) (cdr list) (concat (concat (car list) (substring string (- (length string) 1) (length string))) result)))) (defun mud-dec-to-bin(val no_bits) "This function converts VAL (an integer) to a binary string. The resulting string is padded to be NO_BITS long." (concat (make-string (- no_bits (length (mud-dec-to-bin-r val "" 0))) 48) (mud-dec-to-bin-r val "" 0))) (defun mud-dec-to-bin-r(val string exp) (if (= 0 val ) (if (string= "" string) "0" string) (if (not (= 0 (logand 1 val))) (mud-dec-to-bin-r (/ val 2) (concat 1 string ) (+ exp 1)) (mud-dec-to-bin-r (/ val 2) (concat 0 string ) (+ exp 1))))) ;; Dec and bin string handling (end) ;; Displaying things (beginning) (setq mud-output-window nil) (setq mud-buffer-window nil) (defun mud-create-output-window() (split-window-vertically (- (window-height) 6))) (defun mud-display-string(mud-text-string) (progn (setq mud-buffer-window (selected-window)) (if (or (not (window-live-p mud-output-window)) (eq mud-output-window mud-buffer-window)) (setq mud-output-window (mud-create-output-window))) (select-window mud-output-window) (set-window-buffer mud-output-window (get-buffer-create "mud-output")) (erase-buffer) (insert mud-text-string) (select-window mud-buffer-window))) ;; Displaying things (end) ;; Movement (beginning) (defun mud-safe-forward-char() (if (<= (1+ (point)) (point-max)) (forward-char)) (point)) ;; Movement (end)