(require 'diku-modes-common-defs "mud.el")
;; Mode specific stuff (beginning)
(defun install-wld-keybindings (map)
(define-key map "\C-ci" 'wld-insert-flags)
(define-key map "\C-cr" 'wld-reset-flags)
(define-key map "\C-cs" 'wld-set-flags)
(define-key map "\C-cl" 'wld-door-set-level))
(defvar wld-mode-map nil "The mode map used in wld-mode.")
(defvar
wld-room-flags
(list "FOG" "NOASTRAL" "NOSTAT" "NORELOCATE"
"NOFLEE" "COUNCIL_LAIR" "GODROOM" "SAFE"
"ARENA" "PRIVATE" "TUNNEL" "NO_MAGIC"
"CHAOTIC" "NEUTRAL" "LAWFUL" "INDOORS"
"NO_MOB" "DEATH" "DARK")
"This variable contains a list of flag names (strings) used by
wld-mode to determine the values of bits in room fields. If you alter
wld-room-flags' value, you should alter wld-formatted-room-flags
correspondingly.")
(defvar
wld-formatted-room-flags
(list " FOG: " " NOASTRAL: " " NOSTAT: " "\nNORELOCATE: " " NOFLEE: "
" COUNCIL_LAIR: " " GODROOM: " "\nSAFE: " " ARENA: "
" PRIVATE: " " TUNNEL: " "\nNO_MAGIC: " " CHAOTIC: " " NEUTRAL: "
" LAWFUL: " "\nINDOORS: " " NO_MOB: " " DEATH: " " DARK: ")
"This variable contains a list of flag names (formatted strings)
used by wld-mode to display room flags. If you alter
wld-formatted-room-flags' value, you should alter wld-room-flags
correspondingly.")
(defvar wld-mode-hooks nil "This variable contains hooks that are
executed after entering Diku wld mode.")
(defvar
wld-door-flags
(list "ANTI_EVIL" "ANTI_NEUTRAL" "ANTI_GOOD"
"SECRET" "NO_MAGIC" "NO_MOUNT" "LEVEL_32"
"LEVEL_16" "LEVEL_8" "LEVEL_4" "LEVEL_2"
"LEVEL_1" "MIN" "PICKPROOF" "RSLOCKED"
"RSCLOSED" "LOCKED" "CLOSED" "ISDOOR")
"This variable contains a list of flag names (strings) used by
wld-mode to determine the values of bits in door fields. If you alter
wld-door-flags' value, you should alter wld-formatted-door-flags
correspondingly.")
(defvar
wld-formatted-door-flags
(list " ANTI_EVIL: " " ANTI_NEUTRAL: " " ANTI_GOOD: "
"\nSECRET: " " NO_MAGIC: " " NO_MOUNT: " " LEVEL_32: "
"\nLEVEL_16: " " LEVEL_8: " " LEVEL_4: " " LEVEL_2: "
"\nLEVEL_1: " " MIN: " " PICKPROOF: " " RSLOCKED: "
"\nRSCLOSED: " " LOCKED: " " CLOSED: " " ISDOOR ")
"This variable contains a list of flag names (formatted strings)
used by wld-mode to display door fields. If you alter
wld-formatted-door-flags' value, you should alter wld-door-flags
correspondingly.")
(cond ((not wld-mode-map)
(setq wld-mode-map (make-sparse-keymap))
(install-wld-keybindings wld-mode-map)))
(defun wld-mode()
"
Major mode for editing Diku .wld-files. By Jan Garefelt,
d90-jga@nada.kth.se. Distributed under GPL.
Version: 1.0
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Check this mud out: burning.stacken.kth.se 4000
\\{wld-mode-map}
As you move the point in the file, an info-window will be updated. If
you place the point over a flag field, the following functions will be
useful:
wld-insert-flags ; Prompts for flag names or abbreviations
; of flag names and inserts the value at the
; point, replacing the old value (if any).
;
; Note that the point must be placed over a
; flag field for this function to work!
wld-set-flags ; Prompts for flag names or abbreviations
; of flag names, and sets the corresponding
; flags. Replaces the old value by setting
; named flags in old flags.
;
; Note that the point must be placed over a
; flag field for this function to work!
wld-reset-flags ; Prompts for flag names or abbreviations
; of flag names, and resets the corresponding
; flags. Replaces the old value by resetting
; named flags in old flags.
;
; Note that the point must be placed over a
; flag field for this function to work!
wld-set-door-level ; Prompts for a level, and changes the door's
; level accordingly.
; Note that the point must be placed over a
; door field for this function to work!
When you find bugs, please report them to me (d90-jga@nada.kth.se). If
you like this mode, please send me a postcard (by snail-mail).
Jan Garefelt
Sandelsgatan 42
S-115 33 Stockholm
SWEDEN
"
(interactive)
(kill-all-local-variables)
(use-local-map wld-mode-map)
(setq major-mode 'wld-mode)
(setq mode-name "Diku WLD")
(add-hook 'post-command-hook 'wld-describe-field)
(setq wld-previous-modified-tick (buffer-modified-tick))
(setq wld-previous-point (point))
(make-local-variable 'wld-previous-point)
(make-local-variable 'wld-previous-modified-tick)
(message "Diku WLD-mode. Type C-h m for information")
(run-hooks 'wld-mode-hooks))
;; Mode specific stuff (end)
;; User level wld-functions (beginning)
(defun wld-describe-field ()
(interactive)
(if (and (string-equal "Diku WLD" mode-name)
(or (not (= (buffer-modified-tick)
wld-previous-modified-tick))
(not (= wld-previous-point
(point)))))
(progn
(mud-display-string (wld-field-description))
(setq wld-previous-point (point))
(setq wld-previous-modified-tick (buffer-modified-tick)))))
(defun wld-field-description()
(let ((wld-field (wld-field)))
(cond
((or (string-equal "Direction" (car wld-field))
(string-equal "Door flags" (car wld-field))
(string-equal "Key" (car wld-field))
(string-equal "Sector type" (car wld-field))
(string-equal "Room flags" (car wld-field)))
(cdr wld-field))
(t (car wld-field)))))
(defun wld-insert-flags()
"Calling wld-insert-flags results in:
a) The user is prompted to enter a (space-separated) string of flag
names or flag-abbreviations.
b) The values of the flags are computed.
c) The values are combined by bitwise-or and the result is inserted in
the current buffer.
If many flag names match an abbreviation, the flag corresponding to
the lowest bit is selected unless otherwise stated. To select the
second lowest flag matching an abbreviation one writes:
.<flag abbreviation>"
(interactive)
(cond ((wld-at-room-flagsp) (wld-insert-room-flags))
((wld-at-door-flagsp) (wld-insert-door-flags))
(t (error "Place the cursor on room-flags or door-flags!"))))
(defun wld-set-flags()
"Calling wld-set-flags results in:
a) The user is prompted to enter a (space-separated) string of flag
names or flag-abbreviations.
b) The values of the flags are computed.
c) The corresponding flags are set in the field in the buffer.
If many flag names match an abbreviation, the flag corresponding to
the lowest bit is selected unless otherwise stated. To select the
second lowest flag matching an abbreviation one writes:
.<flag abbreviation>"
(interactive)
(cond ((wld-at-room-flagsp) (wld-set-room-flags))
((wld-at-door-flagsp) (wld-set-door-flags))
(t (error "Place the cursor on room-flags or door-flags!"))))
(defun wld-door-set-level()
(interactive)
(if (wld-at-door-flagsp)
(save-excursion
(mud-reset-flags-in-trodden-num
8064)
(mud-set-flags-in-trodden-num
(lsh (logand 63
(string-to-int (read-string "Level: ")))
7)))))
(defun wld-reset-flags()
"Calling wld-set-flags results in:
a) The user is prompted to enter a (space-separated) string of flag
names or flag-abbreviations.
b) The values of the flags are computed.
c) The corresponding flags are reset in the field in the buffer.
If many flag names match an abbreviation, the flag corresponding to
the lowest bit is selected unless otherwise stated. To select the
second lowest flag matching an abbreviation one writes:
.<flag abbreviation>"
(interactive)
(cond ((wld-at-room-flagsp) (wld-reset-room-flags))
((wld-at-door-flagsp) (wld-reset-door-flags))
(t (error "Place the cursor on room-flags or door-flags!"))))
(defun wld-insert-room-flags()
(interactive)
(mud-insert-flags "Insert room flags: "
wld-room-flags))
(defun wld-reset-room-flags()
(interactive)
(mud-reset-flags "Reset room flags:"
wld-room-flags)
(wld-describe-field))
(defun wld-set-room-flags ()
(interactive)
(mud-set-flags "Set room flags:"
wld-room-flags))
(defun wld-insert-door-flags()
(interactive)
(mud-insert-flags "Insert door flags: "
wld-door-flags))
(defun wld-reset-door-flags()
(interactive)
(mud-reset-flags "Reset door flags:"
wld-door-flags))
(defun wld-set-door-flags()
(interactive)
(mud-set-flags "Set door flags:"
wld-door-flags))
;; User level wld-functions (end)
;; Parsing wld-files (beginning)
(defun wld-field()
(interactive)
(save-excursion
(let ((point (point))
(virtual-number (virtual-number))
(room-name (room-name))
(room-description (room-description))
(zone-number (zone-number))
(room-flags (room-flags))
(sector-type (sector-type))
(direction-or-extra-description
(direction-or-extra-description)))
(cond
((and (>= point virtual-number)
(< point room-name))
(cons "Virtual number" nil))
((and (>= point room-name)
(< point room-description))
(cons "Room name" nil))
((and (>= point room-description)
(< point zone-number))
(cons "Room description" nil))
((and (>= point zone-number)
(< point room-flags))
(cons "Zone number" nil))
((and (>= point room-flags)
(< point sector-type))
(cons "Room flags" (wld-room-flags room-flags)))
((and (>= point sector-type)
(< point direction-or-extra-description))
(cons "Sector type" (determine-sector-type sector-type)))
(t (parse-direction-or-extra-description point))))))
(defun parse-direction-or-extra-description(point)
(progn
(let ((return-text nil))
(while (and (looking-at "D[0-5]*")
(eq return-text nil))
(let ((direction-clause-beginning (point))
(direction-general-description
(direction-general-description))
(direction-keyword-list (direction-keyword-list))
(direction-door-flag (direction-door-flag))
(direction-key-number (direction-key-number))
(direction-to-room (direction-to-room))
(direction-end-of (direction-end-of)))
(cond
((and (>= point direction-clause-beginning)
(< point direction-general-description))
(setq return-text (cons "Direction"
(determine-direction
direction-clause-beginning))))
((and (>= point direction-general-description)
(< point direction-keyword-list))
(setq return-text (cons "Direction general description"
nil)))
((and (>= point direction-keyword-list)
(< point direction-door-flag))
(setq return-text (cons "Keyword list"
nil)))
((and (>= point direction-door-flag)
(< point direction-key-number))
(setq return-text (cons "Door flags"
(wld-door-flags direction-door-flag))))
((and (>= point direction-key-number)
(< point direction-to-room))
(setq return-text (cons "Key"
(determine-key-number direction-key-number))))
((and (>= point direction-to-room)
(< point direction-end-of))
(setq return-text (cons "To room"
nil)))
((looking-at "S" ) (setq return-text (cons "End of room"
nil))))))
(while (and (looking-at "E")
(eq return-text nil))
(let ((extra-description-beginning
(point))
(extra-description-keyword-list
(extra-description-keyword-list))
(extra-description-general-description
(extra-description-general-description))
(extra-description-end
(extra-description-end)))
(cond
((and (>= point extra-description-beginning)
(< point extra-description-keyword-list))
(setq return-text (cons "Extra description" nil)))
((and (>= point extra-description-keyword-list)
(< point extra-description-general-description))
(setq return-text
(cons "Extra description keyword list" nil)))
((and (>= point extra-description-general-description)
(< point extra-description-end))
(setq return-text
(cons "Extra description general description" nil)))
((looking-at "S" )
(setq return-text (cons "End of room" nil))))))
(if (null return-text)
(cons "Bad end of room - try an S to end the room, D0-D5 for directions or E for extra description"
nil)
return-text))))
;; Parsing wld-files: helper functions for parsing direction fields
;; (beginning)
(defun direction-general-description()
(progn
(mud-safe-forward-char)
(mud-safe-forward-char)
(mud-safe-forward-char)))
(defun direction-keyword-list()
(progn (re-search-backward "D[0-5]
" nil t)
(re-search-forward "[^~]~" nil t)
(mud-safe-forward-char )
(point)))
(defun direction-door-flag()
(progn (re-search-forward "~
" nil t)
(point)))
(defun direction-key-number()
(progn (re-search-forward "-?[0-9]+" nil t)
(mud-safe-forward-char )
(point)))
(defun direction-to-room()
(progn (re-search-forward "-?[0-9]+" nil t)
(mud-safe-forward-char )
(point)))
(defun direction-end-of()
(progn (re-search-forward "
" nil t)
(point)))
;; Parsing wld-files: helper functions for parsing direction fields
;; (end)
;; Parsing wld-files: helper functions for parsing extra description
;; fields (beginning)
(defun extra-description-keyword-list()
(progn (re-search-forward "
" nil t)
(point)))
(defun extra-description-general-description()
(progn (re-search-forward "~
" nil t)
(point)))
(defun extra-description-end()
(progn (re-search-forward "~
" nil t)
(point)))
;; Parsing wld-files: helper functions for parsing extra description
;; fields (end)
;; Parsing wld-files: helper functions for field values (beginning)
(defun wld-room-flags (point)
(mud-flags-and-fields
point
wld-formatted-room-flags))
(defun determine-direction (point)
(save-excursion
(progn
(goto-char point)
(concat
(cond
((looking-at "D0") "NORTH.\n")
((looking-at "D1") "EAST.\n")
((looking-at "D2") "SOUTH.\n")
((looking-at "D3") "WEST.\n")
((looking-at "D4") "UP.\n")
((looking-at "D5") "DOWN.\n")
( t "INVALID DIRECTION! "))
"\n North: D0 Up: D4 \nWest: D3 East: D1 Down: D5\n South: D2"))))
(defun determine-sector-type (point)
(save-excursion
(progn
(goto-char point)
(concat (cond
((looking-at "0") "Walking indoors.\n")
((looking-at "1") "Walking in a city.\n")
((looking-at "2") "Walking in a field.\n")
((looking-at "3") "Walking in a forest.\n")
((looking-at "4") "Walking in hills.\n")
((looking-at "5") "Climbing in mountains.\n")
((looking-at "6") "Swimming.\n")
((looking-at "7") "Requires a boat.\n")
( t "Invalid sector type.\n"))
"\nIndoors: 0 City: 1 Field: 2 Forest: 3 \nHills: 4 Mountains: 5 Swim: 6 Boat: 7\n"))))
(defun wld-door-flags (point)
(concat
(concat
(mud-flags-and-fields
point
wld-formatted-door-flags)
(progn
(goto-char point)
(let ((wld-door-flag (logand (lsh 1 6)
(mud-get-trodden-num))))
(if (not (= 0 wld-door-flag))
" Minlevel: "
" Maxlevel: "))))
(progn
(goto-char point)
(int-to-string (logand (lsh (mud-get-trodden-num) -7) 63)))))
(defun determine-key-number (point)
(save-excursion
(progn
(goto-char point)
(concat
(cond
((looking-at "-1") "NO KEY HOLE.")
((looking-at "[0-9]+") "KEY NUMBER.")
(t "INVALID KEY."))
"\n\nNo keyhole =-1 \nPositive number = Key number."))))
;; Parsing wld-files: helper functions for field values (end)
;; Parsing wld-files: placing the point in fields (beginning)
(defun virtual-number()
(progn
(forward-line)
(re-search-backward "#[0-9]+" nil t)
(point)))
(defun room-name()
(progn
(re-search-forward "
" nil t)
(point)))
(defun room-description()
(progn
(re-search-forward "~" nil t)
(mud-safe-forward-char)
(point)))
(defun zone-number()
(progn
(re-search-forward "~" nil t)
(mud-safe-forward-char)
(point)))
(defun room-flags()
(progn
(re-search-forward "[0-9]+" nil t)
(mud-safe-forward-char)
(point)))
(defun wld-at-room-flagsp()
(interactive)
(string-equal (car (wld-field))
"Room flags"))
(defun wld-at-door-flagsp()
(interactive)
(string-equal (car (wld-field))
"Door flags"))
(defun sector-type()
(progn
(re-search-forward "[0-9]+" nil t)
(mud-safe-forward-char)))
(defun direction-or-extra-description()
(let ((wld-direction-old-point (point)))
(progn
(re-search-forward "[DE]+" nil t)
(backward-char)
(if (>= wld-direction-old-point (point))
0
(point)))))
(defun forward-direction()
(progn (re-search-forward "[^~]*~[^~]*~
[0-9]+ -?[0-9]+ -?[0-9]+
")
(point)))
(defun forward-extra-description()
(progn
(re-search-forward "[^~]*~[^~]*~
")
(point)))
;; Parsing wld-files: placing the point in fields (end)
;; Parsing wld-files (end)