(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)