--- /dev/null
+; malyon.el --- mode to execute z code files version 3, 5, 8
+
+;; Maintainer: Peter Ilberg <peter.ilbergNOSPAMgmail.com>
+;; (I am unable to continue supporting malyon.el. Please send me an
+;; email if you are interested in taking over the project. Thanks.)
+
+;; Copyright (C) 1999-2011 Peter Ilberg
+
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;; DEALINGS IN THE SOFTWARE.
+
+;;; Credits:
+
+;; The author would like to thank the following people for reporting
+;; bugs, testing, suggesting and/or contributing improvements:
+;; Bernhard Barde, Jonathan Craven, Alberto Petrofsky, Alan Shutko
+
+;;; Commentary:
+
+;; This package provides a basic interpreter for version 3, 5, 8 z code
+;; story files as generated by Inform (C) Graham Nelson and Infocom.
+
+;; If you encounter a bug please send a report to Peter Ilberg at
+;; peter.ilbergNOSPAMgmail.com. Thank you!
+
+;; To play a story file simple type M-x malyon and enter the path to the
+;; story file. If anything goes wrong and you want to manually clean
+;; up type M-x malyon-quit. In addition, you can switch back to a game in
+;; progress by typing M-x malyon-restore.
+
+;; A note on the format of saved game states:
+
+;; As of version 1.0, Malyon supports the quetzal file format for saved
+;; games. Support for this format required changes to several internal
+;; data structures (stack frames and catch-throw) that are incompatible
+;; with the old implementation. Unfortunately, the old file format for
+;; saved games cannot be converted into quetzal.
+
+;; For backwards compatibility, however, Malyon still supports the old
+;; file format. And you can continue to play your old game states.
+
+;; Because of the incompatibility of the two file formats, Malyon now
+;; runs, as follows, in either of two modes: quetzal and compatibility.
+
+;; - in quetzal mode, game states are saved in quetzal format
+;; - in compatibility mode, games states are saved in the old format
+;; - loading a game state in quetzal format switches to quetzal mode
+;; - loading an old game state switches to compatibility mode
+;; - quetzal mode is the default setting
+
+;; In other words, Malyon will only use the old file format if you've
+;; restored a game state saved in the old file format.
+
+;; Enjoy!
+
+;;; Code:
+
+;; global variables - moved here to appease the byte-code compiler
+
+;; story file information
+
+(defvar malyon-story-file-name nil
+ "The name of the story file being executed.")
+
+(defvar malyon-story-file nil
+ "The story file which is currently being run.")
+
+(defvar malyon-story-version nil
+ "The story file version.")
+
+(defvar malyon-supported-versions '(3 5 8)
+ "A list of supported story file versions.")
+
+;; status and transcript buffers
+
+(defvar malyon-transcript-buffer nil
+ "The main transcript buffer of the story file execution.")
+
+(defvar malyon-transcript-buffer-buffered nil
+ "Is output in the transcript buffer buffered?")
+
+(defvar malyon-status-buffer nil
+ "The status bar buffer of the story file execution.")
+
+(defvar malyon-status-buffer-lines nil
+ "The number of lines in the status bar buffer.")
+
+(defvar malyon-status-buffer-delayed-split nil
+ "If the number of lines in the status buffer is reduced,
+the window configuration is not changed immediately. It
+is changed after the next turn (read or read_char).")
+
+(defvar malyon-status-buffer-point nil
+ "The point location in the status bar buffer.")
+
+(defvar malyon-max-column 72
+ "Maximum column for text display.")
+
+;; window management
+
+(defvar malyon-window-configuration nil
+ "The current window configuration of the malyon interpreter.")
+
+(defvar malyon-current-window nil
+ "The currently active window for text output.")
+
+;; z machine registers
+
+(defvar malyon-stack nil
+ "The stack of the z machine.")
+
+(defvar malyon-stack-pointer nil
+ "The stack pointer of the z machine.")
+
+(defvar malyon-frame-pointer nil
+ "The frame pointer of the z machine.")
+
+(defvar malyon-instruction-pointer nil
+ "The instruction pointer of the z machine.")
+
+;; game file related global variables
+
+(defvar malyon-score-game nil
+ "A flag indicating whether this story uses score or time.")
+
+(defvar malyon-packed-multiplier nil
+ "The amount by which packed addresses are multiplied to get byte
+addresses.")
+
+(defvar malyon-global-variables nil
+ "A pointer to the global variable section in the story file.")
+
+(defvar malyon-abbreviations nil
+ "A pointer to the abbreviations in the story file.")
+
+(defvar malyon-alphabet nil
+ "The z machine's text alphabet.")
+
+(defvar malyon-whitespace nil
+ "A string of whitespace characters recognized by the interpreter.")
+
+;; object tables
+
+(defvar malyon-object-table nil
+ "A pointer to the object table in the story file.")
+
+(defvar malyon-object-table-entry-size nil
+ "The size of one entry in the object table.")
+
+(defvar malyon-object-properties nil
+ "The number of properties per object minus one.")
+
+(defvar malyon-object-property-offset nil
+ "The byte offset of the properties table in the object.")
+
+;; dictionaries
+
+(defvar malyon-dictionary nil
+ "A pointer to the dictionary of the story file.")
+
+(defvar malyon-dictionary-entry-length nil
+ "The length of a dictionary entry.")
+
+(defvar malyon-dictionary-num-entries nil
+ "The number of dictionary entries.")
+
+(defvar malyon-dictionary-entries nil
+ "A pointer to the first dictionary entry.")
+
+(defvar malyon-dictionary-word-length nil
+ "The length of a dictionary word.")
+
+;; game state information
+
+(defvar malyon-game-state-restart nil
+ "The machine state for implementing restart.")
+
+(defvar malyon-game-state-undo nil
+ "The machine state for implementing undo.")
+
+(defvar malyon-game-state-quetzal t
+ "Store game state information for quetzal.")
+
+;; various
+
+(defvar malyon-current-face nil
+ "The current face in which to display text.")
+
+(defvar malyon-last-cursor-position-after-input nil
+ "The last cursor position after reading input from the keyboard.")
+
+;; interactive functions
+
+(defun malyon (file-name)
+ "Major mode for playing z3/5/8 story files.
+This mode allows execution of version 3, 5, 8 z code story files."
+ (interactive "fStory file name: ")
+ (if malyon-story-file
+ (message "You are already playing a game.")
+ (if (not (string-match ".*\.z[358]$" file-name))
+ (message "%s is not a version 3, 5, or 8 story file." file-name)
+ (condition-case nil
+ (malyon-load-story-file file-name)
+ (error
+ (malyon-fatal-error "loading of story file failed.")))
+ (setq malyon-story-version (aref malyon-story-file 0))
+ (cond ((memq malyon-story-version malyon-supported-versions)
+ (condition-case nil
+ (malyon-initialize)
+ (error
+ (malyon-fatal-error "initialization of interpreter failed.")))
+ (malyon-interpreter))
+ (t
+ (message "%s is not a version 3, 5, or 8 story file." file-name)
+ (malyon-cleanup))))))
+
+(defun malyon-restore ()
+ "Restore the save window configuration for the interpreter."
+ (interactive)
+ (condition-case nil
+ (progn
+ (malyon-restore-window-configuration)
+ (malyon-adjust-transcript))
+ (error
+ (malyon-fatal-error "restoring window configuration failed."))))
+
+(defun malyon-quit ()
+ "Exit the malyon interpreter."
+ (interactive)
+ (if malyon-story-file
+ (progn
+ (malyon-restore)
+ (if (malyon-yes-or-no-p-minibuf "Do you really want to quit? ")
+ (malyon-cleanup)))))
+
+(defun malyon-mode ()
+ "This mode provides a basic interpreter for version 3, 5, 8 z code
+story files as generated by Inform (C) Graham Nelson and Infocom.
+
+Note that this package is by no means complete and bug free.
+If you encounter a bug please send a report to Peter Ilberg at
+peter.ilbergNOSPAMnatinst.com. Thank you!
+
+To play a story file simple type M-x malyon and enter the path to the
+story file. If anything goes wrong and you want to manually clean
+up type M-x malyon-quit. In addition, you can switch back to a game in
+progress by typing M-x malyon-restore.
+
+The author would like to thank the following people for reporting
+bugs, testing, suggesting and/or contributing improvements:
+ Bernhard Barde, Jonathan Craven, Alberto Petrofsky, Alan Shutko"
+ (message "Use M-x malyon if you want to play a zcode game."))
+
+;; compatibility functions for GNU emacs
+
+(if (fboundp 'cadr)
+ (defalias 'malyon-cadr 'cadr)
+ (defun malyon-cadr (list)
+ "Take the cadr of the list."
+ (car (cdr list))))
+
+(if (fboundp 'caddr)
+ (defalias 'malyon-caddr 'caddr)
+ (defun malyon-caddr (list)
+ "Take the caddr of the list."
+ (car (cdr (cdr list)))))
+
+(if (fboundp 'cdddr)
+ (defalias 'malyon-cdddr 'cdddr)
+ (defun malyon-cdddr (list)
+ "Take the cdddr of the list."
+ (cdr (cdr (cdr list)))))
+
+(if (fboundp 'char-before)
+ (defalias 'malyon-char-before 'char-before)
+ (defun malyon-char-before ()
+ "Return the character before the point."
+ (char-after (- (point) 1))))
+
+(if (fboundp 'char-to-int)
+ (defalias 'malyon-char-to-int 'char-to-int)
+ (defun malyon-char-to-int (c)
+ "Convert a character into an integer."
+ c))
+
+(if (fboundp 'characterp)
+ (defalias 'malyon-characterp 'characterp)
+ (defun malyon-characterp (x)
+ "Test for a character."
+ (and (numberp x) (<= 0 x) (< x 256))))
+
+(defun malyon-disable-multibyte ()
+ "Disable multibyte support in the current buffer."
+ (condition-case nil (set-buffer-multibyte nil) (error)))
+
+(defun malyon-erase-buffer (&optional buffer)
+ "Erase the given buffer."
+ (save-excursion
+ (if buffer (set-buffer buffer))
+ (if (and buffer (eq buffer malyon-transcript-buffer))
+ (malyon-begin-section)
+ (erase-buffer))))
+
+(if (fboundp 'int-to-char)
+ (defalias 'malyon-int-to-char 'int-to-char)
+ (defun malyon-int-to-char (i)
+ "Convert an integer into a character."
+ i))
+
+(if (fboundp 'mapc)
+ (defalias 'malyon-mapc 'mapc)
+ (defun malyon-mapc (function list)
+ "Apply fun to every element of args ignoring the results."
+ (if (null list)
+ '()
+ (funcall function (car list))
+ (malyon-mapc function (cdr list)))))
+
+(if (fboundp 'mapcan)
+ (defalias 'malyon-mapcan 'mapcan)
+ (defun malyon-mapcan (function list)
+ "Apply fun to every element of args nconc'ing the result."
+ (if (null list)
+ '()
+ (nconc (funcall function (car list))
+ (malyon-mapcan function (cdr list))))))
+
+; Do not use the built-in conversion via 'multibyte-char-to-unibyte.
+(defun malyon-multibyte-char-to-unibyte (char)
+ "Convert a multibyte character to unibyte."
+ char)
+
+(defun malyon-point-max (&optional buffer)
+ "Get the point-max of the given buffer."
+ (save-excursion
+ (if buffer (set-buffer buffer))
+ (point-max)))
+
+(if (fboundp 'redisplay-frame)
+ (defalias 'malyon-redisplay-frame 'redisplay-frame)
+ (defun malyon-redisplay-frame (frame &rest ignore)
+ "Redisplay the given frame."))
+
+(if (fboundp 'remove)
+ (defalias 'malyon-remove 'remove)
+ (defun malyon-remove (element list)
+ "Remove the element from the list."
+ (cond ((null list)
+ '())
+ ((eq element (car list))
+ (malyon-remove element (cdr list)))
+ ((equal element (car list))
+ (malyon-remove element (cdr list)))
+ (t
+ (cons (car list)
+ (malyon-remove element (cdr list)))))))
+
+(if (fboundp 'set-keymap-name)
+ (defalias 'malyon-set-keymap-name 'set-keymap-name)
+ (defun malyon-set-keymap-name (keymap name)
+ "Set the name of the keymap."))
+
+(if (fboundp 'string-to-list)
+ (defalias 'malyon-string-to-list 'string-to-list)
+ (defun malyon-string-to-list (s)
+ "Convert a string into a list of characters."
+ (let ((i (- (length s) 1)) (l '()))
+ (while (<= 0 i)
+ (setq l (cons (aref s i) l)
+ i (- i 1)))
+ l)))
+
+(if (fboundp 'string-to-vector)
+ (defalias 'malyon-string-to-vector 'string-to-vector)
+ (defun malyon-string-to-vector (s)
+ "Convert a string into a vector of characters."
+ (let* ((i 0) (l (length s)) (v (make-vector l 0)))
+ (while (< i l)
+ (aset v i (aref s i))
+ (setq i (+ 1 i)))
+ v)))
+
+; Do not use the built-in conversion via 'unibyte-char-to-multibyte.
+(defun malyon-unibyte-char-to-multibyte (char)
+ "Convert a unibyte character to multibyte."
+ char)
+
+(defun malyon-vector-to-list (v begin end)
+ "Return a list of elements in v in the range [begin, end)."
+ (let ((result '()))
+ (while (< begin end)
+ (setq result (cons (aref v begin) result))
+ (setq begin (+ 1 begin)))
+ (reverse result)))
+
+(if (fboundp 'window-displayed-height)
+ (defalias 'malyon-window-displayed-height 'window-displayed-height)
+ (defun malyon-window-displayed-height (&optional window)
+ "Get the height of the window's displayed region."
+ (- (window-height) 1)))
+
+(if (fboundp 'yes-or-no-p-minibuf)
+ (defalias 'malyon-yes-or-no-p-minibuf 'yes-or-no-p-minibuf)
+ (defun malyon-yes-or-no-p-minibuf (prompt)
+ "Ask a yes or no question."
+ (yes-or-no-p prompt)))
+
+;; global variables for the malyon mode
+
+(defvar malyon-syntax-table nil
+ "Syntax table used while in malyon mode (same as in text-mode).")
+
+(if malyon-syntax-table
+ '()
+ (setq malyon-syntax-table (make-syntax-table))
+ (modify-syntax-entry ?\" ". " malyon-syntax-table)
+ (modify-syntax-entry ?\\ ". " malyon-syntax-table)
+ (modify-syntax-entry ?' "w " malyon-syntax-table))
+
+(defvar malyon-keymap-read nil
+ "Keymap for malyon mode for reading input into a buffer.")
+
+(defvar malyon-history-saved-up nil
+ "The saved binding for the up arrow key.")
+
+(defvar malyon-history-saved-down nil
+ "The saved binding for the down arrow key.")
+
+(if malyon-keymap-read
+ '()
+ (setq malyon-keymap-read (make-sparse-keymap))
+ (malyon-set-keymap-name malyon-keymap-read 'malyon-keymap-read)
+ (setq malyon-history-saved-up (global-key-binding [up]))
+ (setq malyon-history-saved-down (global-key-binding [down]))
+ (define-key malyon-keymap-read "\r" 'malyon-end-input)
+ (define-key malyon-keymap-read [up] 'malyon-history-previous-char)
+ (define-key malyon-keymap-read [down] 'malyon-history-next-char)
+ (define-key malyon-keymap-read "\M-p" 'malyon-history-previous-char)
+ (define-key malyon-keymap-read "\M-n" 'malyon-history-next-char)
+ (define-key malyon-keymap-read "\C-a" 'malyon-beginning-of-line)
+ (define-key malyon-keymap-read "\C-w" 'malyon-kill-region)
+ (define-key malyon-keymap-read "\C-k" 'malyon-kill-line)
+ (define-key malyon-keymap-read "\M-d" 'malyon-kill-word)
+ (define-key malyon-keymap-read "\C-y" 'malyon-yank)
+ (define-key malyon-keymap-read "\M-y" 'malyon-yank-pop)
+ (define-key malyon-keymap-read "\C-d" 'malyon-delete-char)
+ (define-key malyon-keymap-read "\d" 'malyon-backward-delete-char)
+ (define-key malyon-keymap-read [del] 'malyon-delete-char)
+ (define-key malyon-keymap-read [backspace] 'malyon-backward-delete-char)
+ (substitute-key-definition (lookup-key (current-global-map) "a")
+ 'malyon-self-insert-command
+ malyon-keymap-read (current-global-map)))
+
+(defvar malyon-keymap-readchar nil
+ "Keymap for malyon mode for waiting for input.")
+
+(if malyon-keymap-readchar
+ '()
+ (setq malyon-keymap-readchar (make-sparse-keymap))
+ (malyon-set-keymap-name malyon-keymap-readchar 'malyon-keymap-readchar)
+ (define-key malyon-keymap-readchar "\r" 'malyon-wait-char)
+ (substitute-key-definition (lookup-key (current-global-map) "a")
+ 'malyon-wait-char
+ malyon-keymap-readchar (current-global-map)))
+
+(defvar malyon-keymap-more nil
+ "Keymap for malyon mode for browsing through text.")
+
+(if malyon-keymap-more
+ '()
+ (setq malyon-keymap-more (make-sparse-keymap))
+ (malyon-set-keymap-name malyon-keymap-more 'malyon-keymap-more)
+ (define-key malyon-keymap-more "\r" 'malyon-more-char)
+ (substitute-key-definition (lookup-key (current-global-map) "a")
+ 'malyon-more-char
+ malyon-keymap-more (current-global-map)))
+
+(defvar malyon-keymap-more-status nil
+ "Keymap for malyon mode for browsing through the status buffer.")
+
+(if malyon-keymap-more-status
+ '()
+ (setq malyon-keymap-more-status (make-sparse-keymap))
+ (malyon-set-keymap-name malyon-keymap-more-status 'malyon-keymap-more-status)
+ (define-key malyon-keymap-more-status "\r" 'malyon-more-char-status)
+ (substitute-key-definition (lookup-key (current-global-map) "a")
+ 'malyon-more-char-status
+ malyon-keymap-more-status (current-global-map)))
+
+(defvar malyon-faces nil
+ "An association list of text faces used by the malyon mode.")
+
+(defun malyon-initialize-faces ()
+ (copy-face 'default 'malyon-face-plain)
+ (copy-face 'bold 'malyon-face-reverse)
+ (copy-face 'bold 'malyon-face-bold)
+ (copy-face 'italic 'malyon-face-italic)
+ (copy-face 'default 'malyon-face-error)
+ (set-face-foreground 'malyon-face-error "red")
+ (setq malyon-faces '((0 . malyon-face-plain)
+ (1 . malyon-face-reverse)
+ (2 . malyon-face-bold)
+ (4 . malyon-face-italic)
+ (8 . malyon-face-plain))))
+
+(defvar malyon-print-separator nil
+ "A flag indicating whether to print the * * * separator.")
+
+(defun malyon-begin-section ()
+ "Print a section divider and begin a new section."
+ (if malyon-print-separator
+ (progn
+ (malyon-mapc 'malyon-putchar-transcript '(?\n ?\n ?* ? ?* ? ?*))
+ (center-line)
+ (malyon-mapc 'malyon-putchar-transcript '(?\n ?\n))
+ (setq malyon-print-separator nil)))
+ (narrow-to-region (point-max) (point-max)))
+
+(if malyon-whitespace
+ '()
+ (setq malyon-whitespace (list (malyon-char-to-int ? )
+ (malyon-char-to-int ?\t)
+ (malyon-char-to-int ?\n)
+ (malyon-char-to-int ?\r))))
+
+;; memory utilities
+
+(defsubst malyon-read-byte (address)
+ "Read a byte at address in the story file."
+ (if (<= 0 address)
+ (aref malyon-story-file address)
+ (aref malyon-story-file (+ 65536 address))))
+
+(defsubst malyon-store-byte (address value)
+ "Store a byte at address in the story file."
+ (if (<= 0 address)
+ (aset malyon-story-file address (logand 255 value))
+ (aset malyon-story-file (+ 65536 address) (logand 255 value))))
+
+(defsubst malyon-read-word (address)
+ "Read a word at address in the story file."
+ (if (<= 0 address)
+ (logior (lsh (aref malyon-story-file address) 8)
+ (aref malyon-story-file (+ 1 address)))
+ (logior (lsh (aref malyon-story-file (+ 65536 address)) 8)
+ (aref malyon-story-file (+ 65537 address)))))
+
+(defsubst malyon-store-word (address value)
+ "Store a word at address in the story file."
+ (if (<= 0 address)
+ (progn
+ (aset malyon-story-file address (logand 255 (lsh value -8)))
+ (aset malyon-story-file (+ 1 address) (logand 255 value)))
+ (aset malyon-story-file (+ 65536 address) (logand 255 (lsh value -8)))
+ (aset malyon-story-file (+ 65537 address) (logand 255 value))))
+
+(defsubst malyon-read-code-byte ()
+ "Read the next byte at the program counter location."
+ (setq malyon-instruction-pointer (+ malyon-instruction-pointer 1))
+ (malyon-read-byte (- malyon-instruction-pointer 1)))
+
+(defsubst malyon-read-code-word ()
+ "Read the next word at the program counter location."
+ (setq malyon-instruction-pointer (+ malyon-instruction-pointer 2))
+ (malyon-read-word (- malyon-instruction-pointer 2)))
+
+(defsubst malyon-pop-stack ()
+ "Pop a value off the stack."
+ (if (> 0 malyon-stack-pointer)
+ (malyon-fatal-error "stack underflow."))
+ (setq malyon-stack-pointer (- malyon-stack-pointer 1))
+ (aref malyon-stack (+ malyon-stack-pointer 1)))
+
+(defsubst malyon-read-local-variable (variable)
+ "Read a local variable."
+ (aref malyon-stack (+ variable malyon-frame-pointer)))
+
+(defsubst malyon-read-global-variable (variable)
+ "Read a global variable."
+ (malyon-read-word (+ malyon-global-variables (* 2 variable))))
+
+(defsubst malyon-read-variable (variable)
+ "Read a variable."
+ (cond ((= variable 0) (malyon-pop-stack))
+ ((< variable 16) (malyon-read-local-variable variable))
+ (t (malyon-read-global-variable (- variable 16)))))
+
+(defsubst malyon-push-stack (value)
+ "Push a value onto the stack."
+ (setq malyon-stack-pointer (+ malyon-stack-pointer 1))
+ (aset malyon-stack malyon-stack-pointer value))
+
+(defsubst malyon-store-local-variable (variable value)
+ "Store a value in a local variable."
+ (aset malyon-stack (+ variable malyon-frame-pointer) value))
+
+(defsubst malyon-store-global-variable (variable value)
+ "Store a value in a global variable."
+ (malyon-store-word (+ malyon-global-variables (* 2 variable)) value))
+
+(defsubst malyon-store-variable (var value)
+ "Store the value in a variable."
+ (setq value (logand 65535 value))
+ (cond ((= var 0) (malyon-push-stack value))
+ ((< var 16) (malyon-store-local-variable var value))
+ (t (malyon-store-global-variable (- var 16) value))))
+
+;; list of opcodes
+
+(defvar malyon-opcodes
+ [malyon-opcode-nop
+ malyon-opcode-je malyon-opcode-jl
+ malyon-opcode-jg malyon-opcode-dec-chk
+ malyon-opcode-inc-chk malyon-opcode-jin
+ malyon-opcode-test malyon-opcode-or
+ malyon-opcode-and malyon-opcode-test-attr
+ malyon-opcode-set-attr malyon-opcode-clear-attr
+ malyon-opcode-store malyon-opcode-insert-obj
+ malyon-opcode-loadw malyon-opcode-loadb
+ malyon-opcode-get-prop malyon-opcode-get-prop-addr
+ malyon-opcode-get-next-prop malyon-opcode-add
+ malyon-opcode-sub malyon-opcode-mul
+ malyon-opcode-div malyon-opcode-mod
+ malyon-opcode-calls malyon-opcode-calln
+ malyon-opcode-set-color malyon-opcode-throw
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-je malyon-opcode-jl
+ malyon-opcode-jg malyon-opcode-dec-chk
+ malyon-opcode-inc-chk malyon-opcode-jin
+ malyon-opcode-test malyon-opcode-or
+ malyon-opcode-and malyon-opcode-test-attr
+ malyon-opcode-set-attr malyon-opcode-clear-attr
+ malyon-opcode-store malyon-opcode-insert-obj
+ malyon-opcode-loadw malyon-opcode-loadb
+ malyon-opcode-get-prop malyon-opcode-get-prop-addr
+ malyon-opcode-get-next-prop malyon-opcode-add
+ malyon-opcode-sub malyon-opcode-mul
+ malyon-opcode-div malyon-opcode-mod
+ malyon-opcode-calls malyon-opcode-calln
+ malyon-opcode-set-color malyon-opcode-throw
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-je malyon-opcode-jl
+ malyon-opcode-jg malyon-opcode-dec-chk
+ malyon-opcode-inc-chk malyon-opcode-jin
+ malyon-opcode-test malyon-opcode-or
+ malyon-opcode-and malyon-opcode-test-attr
+ malyon-opcode-set-attr malyon-opcode-clear-attr
+ malyon-opcode-store malyon-opcode-insert-obj
+ malyon-opcode-loadw malyon-opcode-loadb
+ malyon-opcode-get-prop malyon-opcode-get-prop-addr
+ malyon-opcode-get-next-prop malyon-opcode-add
+ malyon-opcode-sub malyon-opcode-mul
+ malyon-opcode-div malyon-opcode-mod
+ malyon-opcode-calls malyon-opcode-calln
+ malyon-opcode-set-color malyon-opcode-throw
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-je malyon-opcode-jl
+ malyon-opcode-jg malyon-opcode-dec-chk
+ malyon-opcode-inc-chk malyon-opcode-jin
+ malyon-opcode-test malyon-opcode-or
+ malyon-opcode-and malyon-opcode-test-attr
+ malyon-opcode-set-attr malyon-opcode-clear-attr
+ malyon-opcode-store malyon-opcode-insert-obj
+ malyon-opcode-loadw malyon-opcode-loadb
+ malyon-opcode-get-prop malyon-opcode-get-prop-addr
+ malyon-opcode-get-next-prop malyon-opcode-add
+ malyon-opcode-sub malyon-opcode-mul
+ malyon-opcode-div malyon-opcode-mod
+ malyon-opcode-calls malyon-opcode-calln
+ malyon-opcode-set-color malyon-opcode-throw
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-nop malyon-opcode-jz
+ malyon-opcode-get-sibling malyon-opcode-get-child
+ malyon-opcode-get-parent malyon-opcode-get-prop-len
+ malyon-opcode-inc malyon-opcode-dec
+ malyon-opcode-print-addr malyon-opcode-calls
+ malyon-opcode-remove-obj malyon-opcode-print-obj
+ malyon-opcode-ret malyon-opcode-jump
+ malyon-opcode-print-paddr malyon-opcode-load
+ malyon-opcode-calln malyon-opcode-jz
+ malyon-opcode-get-sibling malyon-opcode-get-child
+ malyon-opcode-get-parent malyon-opcode-get-prop-len
+ malyon-opcode-inc malyon-opcode-dec
+ malyon-opcode-print-addr malyon-opcode-calls
+ malyon-opcode-remove-obj malyon-opcode-print-obj
+ malyon-opcode-ret malyon-opcode-jump
+ malyon-opcode-print-paddr malyon-opcode-load
+ malyon-opcode-calln malyon-opcode-jz
+ malyon-opcode-get-sibling malyon-opcode-get-child
+ malyon-opcode-get-parent malyon-opcode-get-prop-len
+ malyon-opcode-inc malyon-opcode-dec
+ malyon-opcode-print-addr malyon-opcode-calls
+ malyon-opcode-remove-obj malyon-opcode-print-obj
+ malyon-opcode-ret malyon-opcode-jump
+ malyon-opcode-print-paddr malyon-opcode-load
+ malyon-opcode-calln malyon-opcode-rtrue
+ malyon-opcode-rfalse malyon-opcode-print
+ malyon-opcode-print-ret malyon-opcode-nop
+ malyon-opcode-illegal malyon-opcode-illegal
+ malyon-opcode-restart malyon-opcode-ret-popped
+ malyon-opcode-catch malyon-opcode-quit
+ malyon-opcode-new-line malyon-opcode-illegal
+ malyon-opcode-verify malyon-opcode-illegal
+ malyon-opcode-piracy malyon-opcode-nop
+ malyon-opcode-je malyon-opcode-jl
+ malyon-opcode-jg malyon-opcode-dec-chk
+ malyon-opcode-inc-chk malyon-opcode-jin
+ malyon-opcode-test malyon-opcode-or
+ malyon-opcode-and malyon-opcode-test-attr
+ malyon-opcode-set-attr malyon-opcode-clear-attr
+ malyon-opcode-store malyon-opcode-insert-obj
+ malyon-opcode-loadw malyon-opcode-loadb
+ malyon-opcode-get-prop malyon-opcode-get-prop-addr
+ malyon-opcode-get-next-prop malyon-opcode-add
+ malyon-opcode-sub malyon-opcode-mul
+ malyon-opcode-div malyon-opcode-mod
+ malyon-opcode-calls malyon-opcode-calln
+ malyon-opcode-set-color malyon-opcode-throw
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-nop malyon-opcode-calls
+ malyon-opcode-storew malyon-opcode-storeb
+ malyon-opcode-put-prop malyon-opcode-aread
+ malyon-opcode-print-char malyon-opcode-print-num
+ malyon-opcode-random malyon-opcode-push
+ malyon-opcode-pull malyon-opcode-split-window
+ malyon-opcode-set-window malyon-opcode-calls
+ malyon-opcode-erase-window malyon-opcode-erase-line
+ malyon-opcode-set-cursor malyon-opcode-get-cursor
+ malyon-opcode-set-text-style malyon-opcode-buffer-mode
+ malyon-opcode-output-stream malyon-opcode-input-stream
+ malyon-opcode-nop malyon-opcode-read-char
+ malyon-opcode-scan-table malyon-opcode-not
+ malyon-opcode-calln malyon-opcode-calln
+ malyon-opcode-tokenise malyon-opcode-encode-text
+ malyon-opcode-copy-table malyon-opcode-print-table
+ malyon-opcode-check-arg-count malyon-opcode-save
+ malyon-opcode-restore malyon-opcode-log-shift
+ malyon-opcode-art-shift malyon-opcode-set-font
+ malyon-opcode-illegal malyon-opcode-illegal
+ malyon-opcode-illegal malyon-opcode-illegal
+ malyon-opcode-save-undo malyon-opcode-restore-undo
+ malyon-opcode-print-unicode malyon-opcode-check-unicode
+ malyon-opcode-nop malyon-opcode-nop
+ malyon-opcode-nop]
+ "A vector of all known legal z code opcodes.")
+
+;; initialization
+
+(defun malyon-load-story-file (file-name)
+ "Load a z code story file into an internal vector."
+ (save-excursion
+ (set-buffer (create-file-buffer file-name))
+ (malyon-disable-multibyte)
+ (malyon-erase-buffer)
+ (let ((coding-system-for-read 'binary))
+ (insert-file-contents file-name))
+ (setq malyon-story-file-name file-name)
+ (setq malyon-story-file (buffer-substring-no-properties (point-min)
+ (point-max)))
+ (setq malyon-story-file (malyon-string-to-vector malyon-story-file))
+ (if (not (eq ?\^A 1))
+ (let ((i 0))
+ (while (< i (length malyon-story-file))
+ (aset malyon-story-file
+ i
+ (malyon-char-to-int (aref malyon-story-file i)))
+ (setq i (+ 1 i)))))
+ (kill-buffer nil)))
+
+(defun malyon-initialize ()
+ "Initialize the z code interpreter."
+; (malyon-trace-file)
+ (setq malyon-game-state-quetzal t)
+ (malyon-initialize-faces)
+ (malyon-initialize-status)
+ (malyon-initialize-transcript)
+ (malyon-initialize-windows)
+ (malyon-initialize-story-header)
+ (malyon-initialize-registers)
+ (malyon-initialize-opcodes)
+ (malyon-history-clear)
+ (setq malyon-game-state-restart (malyon-current-game-state))
+ (malyon-print-header))
+
+(defun malyon-initialize-status ()
+ "Initialize the status buffer."
+ (setq malyon-status-buffer (get-buffer-create "Malyon Status"))
+ (switch-to-buffer malyon-status-buffer)
+ (malyon-erase-buffer)
+ (kill-all-local-variables)
+ (setq malyon-status-buffer-point (point))
+ (setq malyon-status-buffer-lines 0)
+ (setq malyon-status-buffer-delayed-split nil)
+ (use-local-map malyon-keymap-read)
+ (set-syntax-table malyon-syntax-table)
+ (setq mode-name "Malyon")
+ (setq major-mode 'malyon-mode)
+ (run-hooks 'malyon-mode-hook))
+
+(defun malyon-initialize-transcript ()
+ "Initialize the transcript buffer."
+ (setq malyon-transcript-buffer (get-buffer-create "Malyon Transcript"))
+ (switch-to-buffer malyon-transcript-buffer)
+ (malyon-erase-buffer)
+ (kill-all-local-variables)
+ (setq malyon-last-cursor-position-after-input
+ (malyon-point-max malyon-transcript-buffer))
+ (use-local-map malyon-keymap-read)
+ (set-syntax-table malyon-syntax-table)
+ (setq fill-column malyon-max-column)
+ (auto-fill-mode 1)
+ (setq mode-name "Malyon")
+ (setq major-mode 'malyon-mode)
+ (run-hooks 'malyon-mode-hook))
+
+(defun malyon-initialize-windows ()
+ "Initialize the window configuration for the z machine."
+ (setq window-min-height 3)
+ (setq malyon-transcript-buffer-buffered t)
+ (malyon-set-window-configuration 0)
+ (malyon-opcode-set-window 0))
+
+(defun malyon-initialize-story-header ()
+ "Initializes the header section of the story file."
+ (malyon-store-byte 1
+ (if (>= malyon-story-version 5)
+ 28
+ (logior 48 (malyon-read-byte 1))))
+ (malyon-store-byte 16 (logand 440 (malyon-read-byte 16)))
+ (malyon-store-byte 30 1)
+ (malyon-store-byte 31 65)
+ (malyon-store-byte 32 255)
+ (malyon-store-byte 33 (- malyon-max-column 1))
+ (malyon-store-word 34 (- malyon-max-column 1))
+ (malyon-store-word 36 255)
+ (malyon-store-word 38 1)
+ (malyon-store-word 39 1)
+ (malyon-store-byte 44 0)
+ (malyon-store-byte 45 0)
+ (malyon-store-byte 50 1)
+ (malyon-store-byte 51 0))
+
+(defun malyon-initialize-registers ()
+ "Initialize the interpreter's internal registers."
+ (setq malyon-stack (make-vector 1024 0))
+ (setq malyon-stack-pointer -1)
+ (malyon-push-initial-frame)
+ (setq malyon-frame-pointer malyon-stack-pointer)
+ (setq malyon-instruction-pointer (malyon-read-word 6))
+ (setq malyon-global-variables (malyon-read-word 12))
+ (setq malyon-object-table (malyon-read-word 10))
+ (cond ((< malyon-story-version 5)
+ (setq malyon-object-table-entry-size 9)
+ (setq malyon-object-properties 31)
+ (setq malyon-object-property-offset 7))
+ (t
+ (setq malyon-object-table-entry-size 14)
+ (setq malyon-object-properties 63)
+ (setq malyon-object-property-offset 12)))
+ (setq malyon-abbreviations (malyon-read-word 24))
+ (if (< malyon-story-version 5)
+ (setq malyon-score-game (zerop (logand 2 (malyon-read-byte 1)))))
+ (setq malyon-packed-multiplier
+ (malyon-cadr (assq malyon-story-version '((3 2) (5 4) (8 8)))))
+ (if (or (< malyon-story-version 5) (zerop (malyon-read-word 52)))
+ (setq malyon-alphabet (concat "abcdefghijklmnopqrstuvwxyz"
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ " \n0123456789.,!?_#'\"/\\-:()"))
+ (setq malyon-alphabet (make-string 78 ? ))
+ (let ((i 0))
+ (while (< i 78)
+ (aset malyon-alphabet i
+ (malyon-read-byte (+ i (malyon-read-word 52))))
+ (setq i (+ 1 i)))))
+ (malyon-initialize-unicode-table)
+ (setq malyon-dictionary (malyon-read-word 8))
+ (setq malyon-dictionary-entry-length
+ (malyon-read-byte
+ (+ 1 malyon-dictionary (malyon-read-byte malyon-dictionary))))
+ (setq malyon-dictionary-num-entries
+ (malyon-read-word
+ (+ 2 malyon-dictionary (malyon-read-byte malyon-dictionary))))
+ (setq malyon-dictionary-entries
+ (+ 4 malyon-dictionary (malyon-read-byte malyon-dictionary)))
+ (setq malyon-dictionary-word-length (if (< malyon-story-version 5) 3 5))
+ (setq malyon-current-face 'malyon-face-plain)
+ (setq malyon-print-separator nil)
+ (malyon-initialize-output-streams))
+
+(defun malyon-initialize-opcodes ()
+ "Initialize the opcode table used by the story file."
+ (cond ((< malyon-story-version 5)
+ (aset malyon-opcodes 143 'malyon-opcode-not)
+ (aset malyon-opcodes 181 'malyon-opcode-save)
+ (aset malyon-opcodes 182 'malyon-opcode-restore)
+ (aset malyon-opcodes 185 'malyon-opcode-pop)
+ (aset malyon-opcodes 188 'malyon-opcode-show-status))
+ (t
+ (aset malyon-opcodes 143 'malyon-opcode-calln)
+ (aset malyon-opcodes 181 'malyon-opcode-illegal)
+ (aset malyon-opcodes 182 'malyon-opcode-illegal)
+ (aset malyon-opcodes 185 'malyon-opcode-catch)
+ (aset malyon-opcodes 188 'malyon-opcode-illegal))))
+
+(defun malyon-print-header ()
+ "Print malyon mode header information."
+ (malyon-opcode-set-text-style 2)
+ (malyon-print "Malyon V 1.0.3")
+ (malyon-opcode-set-text-style 0)
+ (malyon-newline)
+ (malyon-print "A z-code interpreter for version 3, 5, and 8 games.")
+ (malyon-newline)
+ (malyon-print "(c) 1999-2011 by Peter Ilberg <peter.ilbergNOSPAMgmail.com>")
+ (malyon-newline)
+ (malyon-newline))
+
+;; cleanup
+
+(defun malyon-cleanup ()
+ "Clean up the z code interpreter."
+ (condition-case nil
+ (progn
+ (setq malyon-story-file nil)
+ (setq malyon-window-configuration nil)
+ (setq malyon-game-state-restart nil)
+ (setq malyon-game-state-undo nil)
+ (if (get-buffer "Malyon Status")
+ (kill-buffer (get-buffer "Malyon Status")))
+ (if (get-buffer "Malyon Transcript")
+ (progn
+ (switch-to-buffer (get-buffer "Malyon Transcript"))
+ (malyon-redisplay-frame (selected-frame) t)
+ (delete-other-windows (get-buffer-window (current-buffer)))
+ (widen)
+ (text-mode)))
+ (setq malyon-status-buffer nil)
+ (setq malyon-transcript-buffer nil))
+ (error
+ (malyon-fatal-error "cleanup failed."))))
+
+;; error handling
+
+(defun malyon-fatal-error (message)
+ "Print error message and abort."
+ (setq message (concat "Malyon fatal error: " message))
+ (unwind-protect
+ (save-excursion
+ (set-buffer malyon-transcript-buffer)
+ (goto-char (point-max))
+ (newline)
+ (newline)
+ (put-text-property 0
+ (length message)
+ 'face
+ 'malyon-face-error
+ message)
+ (insert message)
+ (newline))
+ (malyon-cleanup)
+ (malyon-redisplay-frame (selected-frame) t)
+ (error message)))
+
+;; conversion of zscii to ascii
+
+(defvar malyon-unicode-table nil
+ "An array mapping zscii characters to latin-1 ones.")
+
+(defvar malyon-default-unicode-table nil
+ "The default array mapping zscii characters to latin-1 ones.")
+
+(if malyon-default-unicode-table
+ '()
+ (setq malyon-default-unicode-table
+ [32
+ 0 0 0 0 0 0 0 ; 1 - 7
+ 8 0 0 0 0 10 0 0 ; 8 - 15
+ 0 0 0 0 0 0 0 0 ; 16 - 23
+ 0 0 0 39 0 0 0 0 ; 24 - 31
+ 32 33 34 35 36 37 38 39 ; 32 - 39
+ 40 41 42 43 44 45 46 47 ; 40 - 47
+ 48 49 50 51 52 53 54 55 ; 48 - 55
+ 56 57 58 59 60 61 62 63 ; 56 - 63
+ 64 65 66 67 68 69 70 71 ; 64 - 71
+ 72 73 74 75 76 77 78 79 ; 72 - 79
+ 80 81 82 83 84 85 86 87 ; 80 - 87
+ 88 89 90 91 92 93 94 95 ; 88 - 95
+ 96 97 98 99 100 101 102 103 ; 96 - 103
+ 104 105 106 107 108 109 110 111 ; 104 - 111
+ 112 113 114 115 116 117 118 119 ; 112 - 119
+ 120 121 122 123 124 125 126 0 ; 120 - 127
+ 0 0 0 0 0 0 0 0 ; 128 - 135
+ 0 0 0 0 0 0 0 0 ; 136 - 143
+ 0 48 49 50 51 52 53 54 ; 144 - 151
+ 55 56 57 228 246 252 196 214 ; 152 - 159
+ 220 223 187 171 235 239 255 203 ; 160 - 167
+ 207 225 233 237 243 250 253 193 ; 168 - 175
+ 201 205 211 218 221 224 232 236 ; 176 - 183
+ 242 249 192 200 204 210 217 226 ; 184 - 191
+ 234 238 244 251 194 202 206 212 ; 192 - 199
+ 219 229 197 248 216 227 241 245 ; 200 - 207
+ 195 209 213 230 198 231 199 254 ; 208 - 215
+ 240 222 208 163 63 63 161 191 ; 216 - 223
+ 0 0 0 0 0 0 0 0 ; 224 - 231
+ 0 0 0 0 0 0 0 0 ; 232 - 239
+ 0 0 0 0 0 0 0 0 ; 240 - 247
+ 0 0 0 0 0 0 0 0 ; 248 - 255
+ ]))
+
+(defun malyon-initialize-unicode-table ()
+ "Initializes the zscii-to-unicode conversion table."
+ (setq malyon-unicode-table
+ (copy-sequence malyon-default-unicode-table))
+ (let* ((ext (malyon-read-word 54))
+ (len (if (zerop ext) 0 (malyon-read-word ext)))
+ (table (if (< len 3) 0 (malyon-read-word (+ ext 6)))))
+ (if (or (< malyon-story-version 5) (zerop table))
+ '()
+ (let ((i 0))
+ (while (< i 96)
+ (aset malyon-unicode-table (+ 155 i) (malyon-char-to-int ??))
+ (setq i (+ 1 i))))
+ (setq len (malyon-read-byte table))
+ (let ((i 0))
+ (while (< i len)
+ (aset malyon-unicode-table (+ 155 i)
+ (malyon-read-word (+ table 1 i)))
+ (setq i (+ 1 i)))))))
+
+(defsubst malyon-zscii-to-unicode (char)
+ "Converts a zscii character to unicode."
+ (if (or (< char 0) (> char 255))
+ ??
+ (let ((uni (aref malyon-unicode-table char)))
+ (if (zerop uni)
+ ??
+ (malyon-unibyte-char-to-multibyte (malyon-int-to-char uni))))))
+
+(defsubst malyon-unicode-to-zscii (char)
+ "Converts a unicode character to zscii."
+ (setq char (malyon-multibyte-char-to-unibyte char))
+ (setq char (if (malyon-characterp char) (malyon-char-to-int char) char))
+ (if (= 13 char)
+ ?\r
+ (let ((i 1) (found 0))
+ (while (and (< i 255) (zerop found))
+ (if (= char (aref malyon-unicode-table i))
+ (setq found i))
+ (setq i (+ i 1)))
+ (malyon-int-to-char found))))
+
+;; output streams
+
+(defvar malyon-output-streams nil
+ "Valid output streams for the interpreter.")
+
+(defvar malyon-output-streams-tables nil
+ "A list of active tables for stream 3.")
+
+(defun malyon-initialize-output-streams ()
+ "Initializes the output streams."
+ (setq malyon-output-streams '())
+ (setq malyon-output-streams-tables '())
+ (malyon-add-output-stream 1 0))
+
+(defun malyon-output-stream-function (stream)
+ "Returns the output function representing the given stream."
+ (cond ((= 1 stream) (if (zerop malyon-current-window)
+ 'malyon-putchar-transcript
+ 'malyon-putchar-status))
+ ((= 2 stream) 'malyon-putchar-printer)))
+
+(defun malyon-add-output-stream (stream table)
+ "Add a new output stream."
+ (if (= stream 3)
+ (progn
+ (setq malyon-output-streams-tables
+ (cons table malyon-output-streams-tables))
+ (malyon-store-word table 0))
+ (let ((function (malyon-output-stream-function stream)))
+ (setq malyon-output-streams
+ (if (member function malyon-output-streams)
+ malyon-output-streams
+ (cons function malyon-output-streams))))))
+
+(defun malyon-remove-output-stream (stream)
+ "Remove an output stream."
+ (if (= stream 3)
+ (setq malyon-output-streams-tables (cdr malyon-output-streams-tables))
+ (setq malyon-output-streams
+ (malyon-remove (malyon-output-stream-function stream)
+ malyon-output-streams))))
+
+(defun malyon-update-output-streams ()
+ "Update output streams when the output window has changed."
+ (let ((one (or (member 'malyon-putchar-transcript malyon-output-streams)
+ (member 'malyon-putchar-status malyon-output-streams))))
+ (setq malyon-output-streams
+ (malyon-remove 'malyon-putchar-transcript
+ (malyon-remove 'malyon-putchar-status
+ malyon-output-streams)))
+ (if one
+ (malyon-add-output-stream 1 0))))
+
+(defsubst malyon-output-character (char)
+ "Output a single character on all active streams."
+ (setq char (malyon-zscii-to-unicode char))
+ (if malyon-output-streams-tables
+ (malyon-putchar-table char (car malyon-output-streams-tables))
+ (malyon-mapc (lambda (s) (funcall s char)) malyon-output-streams)))
+
+;; printing text
+
+(defsubst malyon-abbrev (abbrev x)
+ "Print an abbreviation."
+ (malyon-print-ztext
+ (* 2 (malyon-read-word (+ malyon-abbreviations
+ (* 2 (+ x (* 32 (1- abbrev)))))))))
+
+(defun malyon-newline ()
+ "Print a newline."
+ (if (eq malyon-status-buffer (current-buffer))
+ (goto-char malyon-status-buffer-point)
+ (goto-char (point-max)))
+ (malyon-output-character ?\r)
+ (if (eq malyon-status-buffer (current-buffer))
+ (setq malyon-status-buffer-point (point))
+ (goto-char malyon-last-cursor-position-after-input))
+ (malyon-redisplay-frame (selected-frame) nil))
+
+(defun malyon-print (object)
+ "Print text."
+ (let ((text (if (malyon-characterp object) (char-to-string object) object))
+ (start))
+ (if (eq malyon-transcript-buffer (current-buffer))
+ (goto-char (point-max))
+ (goto-char malyon-status-buffer-point))
+ (setq start (point))
+ (malyon-print-characters (malyon-string-to-list text))
+ (put-text-property start (point) 'face malyon-current-face)
+ (if (eq malyon-status-buffer (current-buffer))
+ (setq malyon-status-buffer-point (point))
+ (goto-char malyon-last-cursor-position-after-input))))
+
+(defun malyon-print-characters (text)
+ "Print a list of characters."
+ (malyon-mapc 'malyon-output-character text))
+
+(defsubst malyon-print-state-new (char shift abbr zscii zcode)
+ "Generate a new print state."
+ (list char shift abbr zscii zcode))
+
+(defsubst malyon-print-state-initial ()
+ "Returns an initial state for the ztext decoder."
+ (malyon-print-state-new nil -6 0 0 0))
+
+(defsubst malyon-print-state-next (x ignore shift abbr zscii z)
+ "Print state transition function."
+ (cond ((= zscii 2)
+ (malyon-print-state-new (+ z x) -6 0 0 0))
+ ((= zscii 1)
+ (malyon-print-state-new nil -6 0 2 (* 32 x)))
+ ((> abbr 0)
+ (malyon-abbrev abbr x)
+ (malyon-print-state-initial))
+ ((= x 0)
+ (malyon-print-state-new ? -6 0 0 0))
+ ((< x 4)
+ (malyon-print-state-new nil -6 x 0 0))
+ ((= x 4)
+ (malyon-print-state-new nil 20 0 0 0))
+ ((= x 5)
+ (malyon-print-state-new nil 46 0 0 0))
+ ((and (= shift 46) (= x 6))
+ (malyon-print-state-new nil -6 0 1 0))
+ ((and (= shift 46) (= x 7))
+ (malyon-print-state-new ?\r -6 0 0 0))
+ (t
+ (malyon-print-state-new
+ (aref malyon-alphabet (+ shift x)) -6 0 0 0))))
+
+(defun malyon-print-text (address)
+ "Print text at address and return the address of the following byte."
+ (let ((start))
+ (if (eq malyon-transcript-buffer (current-buffer))
+ (goto-char (point-max))
+ (goto-char malyon-status-buffer-point))
+ (setq start (point))
+ (setq address (malyon-print-ztext address))
+ (put-text-property start (point) 'face malyon-current-face)
+ (if (eq malyon-status-buffer (current-buffer))
+ (setq malyon-status-buffer-point (point))
+ (goto-char malyon-last-cursor-position-after-input))
+ (malyon-redisplay-frame (selected-frame) nil)
+ address))
+
+(defun malyon-print-ztext (address)
+ "Print the ztext stored at the given address."
+ (let ((high 0) (low) (a) (b) (c) (state (malyon-print-state-initial)))
+ (while (zerop (logand 128 high))
+ (setq high (malyon-read-byte address))
+ (setq low (malyon-read-byte (+ 1 address)))
+ (setq a (logand 31 (lsh high -2)))
+ (setq b (logand 31 (logior (lsh high 3) (lsh low -5))))
+ (setq c (logand 31 low))
+ (setq state (apply 'malyon-print-state-next a state))
+ (if (car state) (malyon-output-character (car state)))
+ (setq state (apply 'malyon-print-state-next b state))
+ (if (car state) (malyon-output-character (car state)))
+ (setq state (apply 'malyon-print-state-next c state))
+ (if (car state) (malyon-output-character (car state)))
+ (setq address (+ 2 address)))
+ address))
+
+(defun malyon-putchar-transcript (char)
+ "Print a single character in the transcript window."
+ (if (char-equal char ?\n)
+ (newline 1)
+ (insert char)
+ (setq malyon-print-separator (null (member char malyon-whitespace))))
+ (if (and malyon-transcript-buffer-buffered
+ (> (current-column) (current-fill-column)))
+ (progn
+ (end-of-line)
+ (forward-word -1)
+ (if (< 0 (current-column))
+ (newline 1))
+ (end-of-line))))
+
+(defun malyon-putchar-status (char)
+ "Print a single character in the status window."
+ (if malyon-status-buffer-delayed-split
+ (progn
+ (malyon-split-buffer-windows malyon-status-buffer-delayed-split)
+ (other-window 1)))
+ (if (char-equal char ?\n)
+ (progn
+ (beginning-of-line)
+ (forward-line 1)
+ (if (= (point) (point-max))
+ (forward-line -1)))
+ (if (> (current-column) (current-fill-column))
+ '()
+ (insert char)
+ (delete-char 1))))
+
+(defun malyon-putchar-table (char table)
+ "Print a single character into a table."
+ (setq char (malyon-unicode-to-zscii char))
+ (malyon-store-byte (+ 2 table (malyon-read-word table)) char)
+ (malyon-store-word table (+ 1 (malyon-read-word table))))
+
+(defun malyon-putchar-printer (char)
+ "Print a single character onto a printer."); not yet implemented
+
+;; more
+
+(defvar malyon-more-continue-keymap nil
+ "The keymap with which to continue after More has finished.")
+
+(defun malyon-more (keymap)
+ "Enter More mode."
+ (if (eq malyon-status-buffer (current-buffer))
+ (use-local-map keymap)
+ (if (< malyon-story-version 5) (malyon-opcode-show-status))
+ (if (< (count-lines malyon-last-cursor-position-after-input (point-max))
+ (malyon-window-displayed-height))
+ (progn
+ (malyon-adjust-transcript)
+ (use-local-map keymap))
+ (goto-char malyon-last-cursor-position-after-input)
+ (beginning-of-line)
+ (recenter 1)
+ (setq malyon-more-continue-keymap keymap)
+ (use-local-map malyon-keymap-more)
+ (message "[More]"))))
+
+(defun malyon-more-status-buffer ()
+ "Enter More mode for the status buffer."
+ (setq malyon-more-continue-keymap (current-local-map))
+ (use-local-map malyon-keymap-more-status)
+ (message "[More]")
+ (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-input))
+
+;; input history
+
+(defvar malyon-history nil
+ "The input history.")
+
+(defun malyon-history-previous ()
+ "Move one entry up in the input history."
+ (let ((prev (aref malyon-history 0))
+ (curr (aref malyon-history 1))
+ (next (aref malyon-history 2)))
+ (if (null prev)
+ curr
+ (aset malyon-history 2 (if curr (cons curr next) next))
+ (aset malyon-history 0 (cdr prev))
+ (aset malyon-history 1 (car prev)))))
+
+(defun malyon-history-next ()
+ "Move one entry down in the input history."
+ (let ((prev (aref malyon-history 0))
+ (curr (aref malyon-history 1))
+ (next (aref malyon-history 2)))
+ (if (null next)
+ curr
+ (aset malyon-history 0 (if curr (cons curr prev) prev))
+ (aset malyon-history 2 (cdr next))
+ (aset malyon-history 1 (car next)))))
+
+(defun malyon-history-clear ()
+ "Clear the input history."
+ (setq malyon-history (vector '() nil '())))
+
+(defun malyon-history-insert (entry)
+ "Insert an entry into the input history."
+ (let* ((prev (aref malyon-history 0))
+ (curr (aref malyon-history 1))
+ (next (aref malyon-history 2))
+ (l (malyon-remove entry
+ (append (nreverse prev)
+ (if curr (cons curr next) next))))
+ (cut (- (length l) 19)))
+ (while (> cut 0)
+ (setq l (cdr l)
+ cut (- cut 1)))
+ (aset malyon-history 0
+ (malyon-remove nil (malyon-remove "" (cons entry (nreverse l)))))
+ (aset malyon-history 1 nil)
+ (aset malyon-history 2 '())))
+
+;; dictionary lookup
+
+(defun malyon-dictionary-word (chars)
+ "Convert a list of characters into a dictionary word."
+ (list (car (car chars))
+ (length chars)
+ (malyon-encode-dictionary-word (append (malyon-mapcan 'cdr chars)
+ '(5 5 5 5 5 5 5 5)))))
+
+(defsubst malyon-join-characters (stop list)
+ "Joins three ztext characters into two bytes."
+ (let ((a (car list))
+ (b (malyon-cadr list))
+ (c (malyon-caddr list))
+ (x (if (zerop stop) 0 128)))
+ (list (logior x (logand 255 (logior (lsh a 2) (lsh b -3))))
+ (logand 255 (logior (lsh b 5) c)))))
+
+(defun malyon-encode-dictionary-word (l)
+ "Converts a list of ztext characters into a dictionary word."
+ (let* ((first l)
+ (second (malyon-cdddr first))
+ (third (malyon-cdddr second)))
+ (apply 'vector
+ (if (< malyon-story-version 5)
+ (append (malyon-join-characters 0 first)
+ (malyon-join-characters 1 second))
+ (append (malyon-join-characters 0 first)
+ (malyon-join-characters 0 second)
+ (malyon-join-characters 1 third))))))
+
+(defun malyon-lookup (dict code)
+ "Look for the given code in the dictionary and return its address."
+ (cond ((not code) 0)
+ ((not dict) (malyon-binary-search code))
+ ((= dict malyon-dictionary) (malyon-binary-search code))
+ (t (malyon-linear-search dict code))))
+
+(defsubst malyon-compare-words (word address)
+ "Compares the given word to the word stored at address."
+ (let* ((i 0)
+ (j address)
+ (x (aref word i))
+ (y (malyon-read-byte j)))
+ (while (not (or (/= x y) (= i malyon-dictionary-word-length)))
+ (setq i (+ 1 i)
+ j (+ 1 j)
+ x (aref word i)
+ y (malyon-read-byte j)))
+ (- x y)))
+
+;; search functions
+
+(defun malyon-binary-search (code)
+ "Binary search through the main dictionary."
+ (let* ((lower 0)
+ (upper (- malyon-dictionary-num-entries 1))
+ (median (/ (+ lower upper) 2))
+ (entry (+ malyon-dictionary-entries
+ (* malyon-dictionary-entry-length median)))
+ (looking (malyon-compare-words code entry)))
+ (while (not (or (> lower upper) (zerop looking)))
+ (setq lower (if (< 0 looking) (+ median 1) lower)
+ upper (if (> 0 looking) (- median 1) upper)
+ median (/ (+ lower upper) 2)
+ entry (+ malyon-dictionary-entries
+ (* malyon-dictionary-entry-length median))
+ looking (malyon-compare-words code entry)))
+ (if (zerop looking) entry 0)))
+
+(defun malyon-linear-search (dictionary code)
+ "Linear search through the given dictionary."
+ (let* ((length (malyon-read-byte (+ dictionary 1
+ (malyon-read-byte dictionary))))
+ (number (malyon-read-word (+ dictionary 2
+ (malyon-read-byte dictionary))))
+ (entries (+ dictionary 4 (malyon-read-byte dictionary)))
+ (i 0)
+ (entry (+ entries (* length i)))
+ (looking (malyon-compare-words code entry)))
+ (while (not (or (>= i number) (zerop looking)))
+ (setq i (+ 1 i)
+ entry (+ entries (* length i))
+ looking (malyon-compare-words code entry)))
+ (if (zerop looking) entry 0)))
+
+;; encoding text and lexical analysis
+
+(defun malyon-split-list (sep list &optional x)
+ "Split a list into sublists as indicated by the separators."
+ (cond ((null list)
+ (list (nreverse x)))
+ ((eq sep (car list))
+ (cons (nreverse x) (malyon-split-list sep (cdr list) '())))
+ (t
+ (malyon-split-list sep (cdr list) (cons (car list) x)))))
+
+(defun malyon-characters-to-words (list)
+ "Turn the list of characters into a list of words."
+ (mapcar 'malyon-dictionary-word
+ (delete '() (malyon-split-list 'malyon-word-separator list))))
+
+(defsubst malyon-char-in-string (c s)
+ "Returns the index of c in s if found, or length of s."
+ (let ((i 0))
+ (while (not (or (= i (length s)) (= c (aref s i))))
+ (setq i (+ 1 i)))
+ i))
+
+(defsubst malyon-encode-into-ztext (c)
+ "Convert a character into ztext."
+ (let* ((index (malyon-char-in-string c malyon-alphabet))
+ (shift (floor index 26))
+ (char (+ 6 (mod index 26))))
+ (cond ((> shift 2) (list 5 6 (logand 31 (lsh c -5)) (logand 31 c)))
+ ((= shift 2) (list 5 char))
+ ((= shift 1) (list 4 char))
+ (t (list char)))))
+
+(defun malyon-encode-single-character (terminating-characters char)
+ "Encode a character into ztext."
+ (let ((pos (car char))
+ (c (cdr char)))
+ (cond ((member c malyon-whitespace)
+ (list 'malyon-word-separator))
+ ((member c terminating-characters)
+ (list 'malyon-word-separator
+ (cons pos (malyon-encode-into-ztext c))
+ 'malyon-word-separator))
+ (t (list (cons pos (malyon-encode-into-ztext c)))))))
+
+(defun malyon-encode-character-list (dict list)
+ "Encode the list of characters into ztext."
+ (let ((l '())
+ (i 0))
+ (while (< i (malyon-read-byte dict))
+ (setq l (cons (malyon-read-byte (+ dict 1 i)) l)
+ i (+ 1 i)))
+ (malyon-mapcan (lambda (x) (malyon-encode-single-character l x)) list)))
+
+(defun malyon-text-length (address)
+ "Return the length of the input text."
+ (if (>= malyon-story-version 5)
+ (malyon-read-byte (+ 1 address))
+ (let ((i 0))
+ (while (not (zerop (malyon-read-byte (+ i 1 address))))
+ (setq i (+ i 1)))
+ i)))
+
+(defun malyon-text-to-character-list (address)
+ "Convert the input text into a list of characters."
+ (let ((i (malyon-text-length address))
+ (text '()))
+ (while (< 0 i)
+ (setq text (cons
+ (cons (if (< malyon-story-version 5) i (+ 1 i))
+ (malyon-read-byte
+ (+ i address (if (< malyon-story-version 5) 0 1))))
+ text)
+ i (- i 1)))
+ text))
+
+(defun malyon-text-to-words (address dictionary)
+ "Turn ztext into a list of dictionary words."
+ (malyon-characters-to-words
+ (malyon-encode-character-list (if dictionary dictionary malyon-dictionary)
+ (malyon-text-to-character-list address))))
+
+;; window management
+
+(defvar malyon-status-buffer-grew-this-turn nil
+ "A flag signalling if the status buffer grew this turn.")
+
+(defun malyon-adjust-transcript ()
+ "Adjust the position of the transcript text."
+ (save-excursion
+ (setq malyon-status-buffer-grew-this-turn nil)
+ (set-buffer malyon-transcript-buffer)
+ (goto-char (point-max))
+ (recenter (- (malyon-window-displayed-height) 2))))
+
+(defun malyon-prepare-status-buffer (status)
+ "Fill the status buffer with empty lines."
+ (save-excursion
+ (set-buffer malyon-status-buffer)
+ (let ((lines (count-lines (point-min) (point-max)))
+ (new status))
+ (if (zerop lines)
+ (newline 1))
+ (goto-char (point-max))
+ (setq status (- status lines -1))
+ (while (> status 0)
+ (insert (make-string (+ 3 malyon-max-column) ? ))
+ (newline 1)
+ (setq status (- status 1)))
+ (goto-char (point-min))
+ (forward-line (+ 1 new))
+ (kill-region (point) (point-max))
+ (insert (make-string (+ 3 malyon-max-column) ? ))
+ (newline 1))))
+
+(defun malyon-restore-window-configuration ()
+ "Restore the saved window configuration."
+ (let ((buffer (window-buffer (selected-window))))
+ (if malyon-window-configuration
+ (set-window-configuration malyon-window-configuration))
+ (cond ((eq malyon-status-buffer buffer) (other-window 1))
+ ((eq malyon-transcript-buffer buffer) (goto-char (point-max))))))
+
+(defun malyon-set-window-configuration (status)
+ "Set up the new window configuration."
+ (cond ((< status malyon-status-buffer-lines)
+ (setq malyon-status-buffer-delayed-split status)
+ (if malyon-status-buffer-grew-this-turn
+ (malyon-more-status-buffer)))
+ ((> status malyon-status-buffer-lines)
+ (malyon-split-buffer-windows status)
+ (setq malyon-status-buffer-grew-this-turn t))
+ ((not malyon-window-configuration)
+ (malyon-split-buffer-windows status))))
+
+(defun malyon-split-buffer-windows (status)
+ "Split the buffer windows.
+The status buffer gets 'status' lines while the transcript buffer
+gets the remaining lines."
+ (delete-other-windows (get-buffer-window (current-buffer)))
+ (setq malyon-status-buffer-lines status)
+ (setq malyon-status-buffer-delayed-split nil)
+ (if (zerop status)
+ '()
+ (split-window (get-buffer-window (current-buffer)) (+ status 3))
+ (switch-to-buffer malyon-status-buffer)
+ (malyon-prepare-status-buffer status)
+ (malyon-opcode-set-cursor 1 1)
+ (other-window 1))
+ (switch-to-buffer malyon-transcript-buffer)
+ (setq malyon-window-configuration (current-window-configuration)))
+
+;; getting and setting the machine state
+
+(defun malyon-current-game-state ()
+ "Return the current state of the interpreter."
+ (vector malyon-instruction-pointer
+ malyon-stack-pointer
+ malyon-frame-pointer
+ (copy-sequence malyon-stack)
+ (copy-sequence malyon-story-file)
+ malyon-game-state-quetzal))
+
+(defun malyon-set-game-state (state)
+ "Installs the given state as the new state of the interpreter."
+ (setq malyon-instruction-pointer (aref state 0))
+ (setq malyon-stack-pointer (aref state 1))
+ (setq malyon-frame-pointer (aref state 2))
+ (setq malyon-stack (copy-sequence (aref state 3)))
+ (setq malyon-story-file (copy-sequence (aref state 4)))
+ (setq malyon-game-state-quetzal (aref state 5))
+ (save-excursion
+ (malyon-erase-buffer malyon-status-buffer)
+ (malyon-split-buffer-windows 0)
+ (setq malyon-last-cursor-position-after-input
+ (malyon-point-max malyon-transcript-buffer))))
+
+;; file utilities
+
+(defsubst malyon-write-byte-to-file (byte)
+ "Write a byte to a file."
+ (insert-char (logand 255 byte) 1))
+
+(defsubst malyon-write-word-to-file (word)
+ "Write a word to the last opened file."
+ (insert-char (logand 255 (lsh word -8)) 1)
+ (insert-char (logand 255 word) 1))
+
+(defsubst malyon-write-dword-to-file (dword)
+ "Write a dword to the last opened file."
+ (insert-char (logand 255 (lsh dword -24)) 1)
+ (insert-char (logand 255 (lsh dword -16)) 1)
+ (insert-char (logand 255 (lsh dword -8)) 1)
+ (insert-char (logand 255 dword) 1))
+
+(defsubst malyon-write-chunk-id-to-file (id)
+ "Write a quetzal chunk id to the last opened file."
+ (insert id))
+
+(defsubst malyon-read-byte-from-file ()
+ "Read the next byte from a file."
+ (if (= (point) (point-max))
+ 0
+ (forward-char 1)
+ (malyon-char-to-int (malyon-char-before))))
+
+(defsubst malyon-read-word-from-file ()
+ "Read the next word from the last opened file."
+ (logior (lsh (malyon-read-byte-from-file) 8) (malyon-read-byte-from-file)))
+
+(defsubst malyon-read-dword-from-file ()
+ "Read the next dword from the last opened file."
+ (logior (lsh (malyon-read-byte-from-file) 24)
+ (lsh (malyon-read-byte-from-file) 16)
+ (lsh (malyon-read-byte-from-file) 8)
+ (malyon-read-byte-from-file)))
+
+(defsubst malyon-read-chunk-id-from-file ()
+ "Read a quetzal chunk id from the last opened file."
+ (string (malyon-int-to-char (malyon-read-byte-from-file))
+ (malyon-int-to-char (malyon-read-byte-from-file))
+ (malyon-int-to-char (malyon-read-byte-from-file))
+ (malyon-int-to-char (malyon-read-byte-from-file))))
+
+(defun malyon-get-file-name (address)
+ "Retrieves the file name stored at address."
+ (let ((name (make-string (malyon-read-byte address) ? ))
+ (i 0))
+ (while (< i (length name))
+ (aset name i (malyon-read-byte (+ address 1 i)))
+ (setq i (+ 1 i)))
+ name))
+
+;; saving data to disk
+
+(defun malyon-save-file (file &optional table length)
+ "Save the current game state or a memory section to disk."
+ (interactive "FSave file: ")
+ (condition-case nil
+ (save-excursion
+ (set-buffer (create-file-buffer file))
+ (malyon-disable-multibyte)
+ (malyon-erase-buffer)
+ (cond (table (malyon-save-table table length))
+ (malyon-game-state-quetzal
+ (malyon-save-quetzal-state (malyon-current-game-state)))
+ (t
+ (malyon-save-game-state (malyon-current-game-state))))
+ (let ((coding-system-for-write 'binary))
+ (write-file file))
+ (kill-buffer nil)
+ 1)
+ (error 0)))
+
+(defun malyon-save-table (table length)
+ "Save the given section of memory to the file."
+ (let ((i 0)
+ (j table))
+ (while (< i length)
+ (malyon-write-byte-to-file (malyon-read-byte j))
+ (setq i (+ 1 i)
+ j (+ 1 j)))))
+
+(defun malyon-save-game-state (state)
+ "Saves the game state to disk."
+ (let ((ip (aref state 0))
+ (sp (aref state 1))
+ (fp (aref state 2))
+ (stack (aref state 3))
+ (mem (aref state 4))
+ (dyn (malyon-read-word 14))
+ (i 0))
+ (malyon-write-word-to-file (length malyon-story-file-name))
+ (while (< i (length malyon-story-file-name))
+ (malyon-write-byte-to-file (aref malyon-story-file-name i))
+ (setq i (+ 1 i)))
+ (malyon-write-dword-to-file ip)
+ (malyon-write-word-to-file sp)
+ (malyon-write-word-to-file fp)
+ (malyon-write-word-to-file dyn)
+ (setq i 0)
+ (while (<= i sp)
+ (malyon-write-dword-to-file (aref stack i))
+ (setq i (+ 1 i)))
+ (setq i 0)
+ (while (< i dyn)
+ (malyon-write-byte-to-file (aref mem i))
+ (setq i (+ 1 i)))))
+
+(defun malyon-save-quetzal-state (state)
+ "Saves the game state to disk in quetzal format."
+ (goto-char (point-min))
+ (malyon-save-quetzal-ifhd state)
+ (malyon-save-quetzal-cmem state)
+ (malyon-save-quetzal-stks state)
+ (goto-char (point-min))
+ (malyon-write-chunk-id-to-file "IFZS")
+ (goto-char (point-min))
+ (malyon-write-dword-to-file (- (point-max) (point-min)))
+ (goto-char (point-min))
+ (malyon-write-chunk-id-to-file "FORM"))
+
+(defun malyon-save-quetzal-ifhd (state)
+ "Saves the IFhd chunk of the quetzal format."
+ (malyon-write-chunk-id-to-file "IFhd")
+ (malyon-write-dword-to-file 13)
+ (malyon-write-word-to-file (malyon-read-word 2))
+ (malyon-write-word-to-file (malyon-read-word 18))
+ (malyon-write-word-to-file (malyon-read-word 20))
+ (malyon-write-word-to-file (malyon-read-word 22))
+ (malyon-write-word-to-file (malyon-read-word 28))
+ (malyon-write-byte-to-file (lsh (aref state 0) -16))
+ (malyon-write-byte-to-file (lsh (aref state 0) -8))
+ (malyon-write-byte-to-file (aref state 0))
+ (malyon-write-byte-to-file 0))
+
+(defun malyon-save-quetzal-cmem (state)
+ "Saves the CMem chunk of the quetzal format."
+ (let ((beginning (point-max))
+ (original (aref malyon-game-state-restart 4))
+ (current (aref state 4))
+ (size (malyon-read-word 14))
+ (byte 0)
+ (count 0)
+ (i 0))
+ (goto-char (point-max))
+ (while (< i size)
+ (setq byte (logxor (aref current i) (aref original i)))
+ (if (zerop byte)
+ (setq count (+ 1 count))
+ (while (> count 0)
+ (malyon-write-byte-to-file 0)
+ (setq count (- count 1))
+ (malyon-write-byte-to-file (min 255 count))
+ (setq count (- count (min 255 count))))
+ (malyon-write-byte-to-file byte))
+ (setq i (+ 1 i)))
+ (setq size (- (point-max) beginning))
+ (if (zerop (mod size 2)) '() (malyon-write-byte-to-file 0))
+ (goto-char beginning)
+ (malyon-write-chunk-id-to-file "CMem")
+ (malyon-write-dword-to-file size)))
+
+(defun malyon-save-quetzal-stks (state)
+ "Saves the Stks chunk of the quetzal format."
+ (let ((beginning (point-max))
+ (size 0))
+ (goto-char (point-max))
+ (malyon-save-quetzal-stack-frame (- (aref state 2) 4)
+ (aref state 1)
+ (aref state 3))
+ (setq size (- (point-max) beginning))
+ (if (zerop (mod size 2)) '() (malyon-write-byte-to-file 0))
+ (goto-char beginning)
+ (malyon-write-chunk-id-to-file "Stks")
+ (malyon-write-dword-to-file size)))
+
+(defun malyon-save-quetzal-stack-frame (fp sp stack)
+ "Saves the stack frames for the Stks chunk."
+ (let* ((frame (malyon-get-stack-frame fp sp stack))
+ (frame-id (aref frame 0))
+ (previous-fp (aref frame 1))
+ (previous-sp (aref frame 2))
+ (return-addr (aref frame 3))
+ (result-addr (aref frame 4))
+ (local-vars (aref frame 5))
+ (num-args (aref frame 6))
+ (eval-stack (aref frame 7)))
+ (if (> frame-id 0)
+ (malyon-save-quetzal-stack-frame previous-fp previous-sp stack))
+ (malyon-write-byte-to-file (lsh return-addr -16))
+ (malyon-write-byte-to-file (lsh return-addr -8))
+ (malyon-write-byte-to-file return-addr)
+ (if (zerop frame-id)
+ (malyon-write-byte-to-file 0)
+ (malyon-write-byte-to-file (logior (if result-addr 0 16)
+ (length local-vars))))
+ (malyon-write-byte-to-file (if result-addr result-addr 0))
+ (malyon-write-byte-to-file (- (lsh 1 num-args) 1))
+ (malyon-write-word-to-file (length eval-stack))
+ (while (not (null local-vars))
+ (malyon-write-word-to-file (car local-vars))
+ (setq local-vars (cdr local-vars)))
+ (while (not (null eval-stack))
+ (malyon-write-word-to-file (car eval-stack))
+ (setq eval-stack (cdr eval-stack)))))
+
+;; restoring data from disk
+
+(defvar malyon-restore-data-error nil
+ "An error message if restoring data from a file failed.")
+
+(defvar malyon-restore-quetzal-stack nil
+ "A temporary stack for restoring quetzal game states.")
+
+(defvar malyon-restore-quetzal-stack-pointer nil
+ "A temporary stack pointer for restoring quetzal game states.")
+
+(defvar malyon-restore-quetzal-frame-pointer nil
+ "A temporary frame-pointer for restoring quetzal game states.")
+
+(defun malyon-restore-file (file &optional table length)
+ "Restore a game state or a memory section from disk."
+ (interactive "fLoad file: ")
+ (if (not (and (file-exists-p file) (file-readable-p file)))
+ 0
+ (condition-case nil
+ (save-excursion
+ (setq malyon-restore-data-error nil)
+ (set-buffer (create-file-buffer file))
+ (malyon-disable-multibyte)
+ (malyon-erase-buffer)
+ (let ((coding-system-for-read 'binary))
+ (insert-file-contents file))
+ (goto-char (point-min))
+ (if table
+ (malyon-restore-table table length)
+ (let* ((first (malyon-read-chunk-id-from-file))
+ (second (malyon-read-dword-from-file))
+ (third (malyon-read-chunk-id-from-file)))
+ (if (and (string= "FORM" first) (string= "IFZS" third))
+ (malyon-restore-quetzal-state (+ 8 second))
+ (goto-char (point-min))
+ (malyon-restore-game-state))))
+ (kill-buffer nil)
+ (if (null malyon-restore-data-error)
+ 2
+ (message malyon-restore-data-error)
+ 0))
+ (error 0))))
+
+(defun malyon-restore-table (table length)
+ "Restore the given section of memory from a file."
+ (let ((i 0)
+ (j table))
+ (while (< i length)
+ (malyon-store-byte j (malyon-read-byte-from-file))
+ (setq i (+ 1 i)
+ j (+ 1 j)))))
+
+(defun malyon-restore-game-state ()
+ "Restore a saved game state from disk."
+ (let ((len 0)
+ (name 0)
+ (story 0)
+ (ip 0)
+ (sp 0)
+ (fp 0)
+ (dyn 0)
+ (stack (copy-sequence malyon-stack))
+ (mem (copy-sequence malyon-story-file))
+ (i 0))
+ (setq len (malyon-read-word-from-file))
+ (setq name (make-string len ? ))
+ (while (< i len)
+ (aset name i (malyon-read-byte-from-file))
+ (setq i (+ 1 i)))
+ (setq ip (malyon-read-dword-from-file))
+ (setq sp (malyon-read-word-from-file))
+ (setq fp (malyon-read-word-from-file))
+ (setq dyn (malyon-read-word-from-file))
+ (setq i 0)
+ (while (<= i sp)
+ (aset stack i (malyon-read-dword-from-file))
+ (setq i (+ 1 i)))
+ (setq i 0)
+ (while (< i dyn)
+ (aset mem i (malyon-read-byte-from-file))
+ (setq i (+ 1 i)))
+ (setq name (file-name-nondirectory name))
+ (setq story (file-name-nondirectory malyon-story-file-name))
+ (if (or (string-match name story) (string-match story name))
+ (malyon-set-game-state (vector ip sp fp stack mem nil))
+ (setq malyon-restore-data-error "Invalid save file."))))
+
+(defun malyon-restore-quetzal-state (size)
+ "Restore a saved quetzal game state from disk."
+ (let ((chunk-id nil)
+ (chunk-len 0)
+ (ip 0)
+ (memory nil)
+ (stack nil)
+ (beginning 0))
+ (while (< (point) size)
+ (setq chunk-id (malyon-read-chunk-id-from-file))
+ (setq chunk-len (malyon-read-dword-from-file))
+ (setq beginning (point))
+ (cond ((string= chunk-id "IFhd")
+ (setq ip (malyon-restore-quetzal-ifhd chunk-len)))
+ ((string= chunk-id "CMem")
+ (setq memory (malyon-restore-quetzal-cmem chunk-len)))
+ ((string= chunk-id "UMem")
+ (setq memory (malyon-restore-quetzal-umem chunk-len)))
+ ((string= chunk-id "Stks")
+ (setq stack (malyon-restore-quetzal-stks chunk-len))))
+ (if (zerop (mod chunk-len 2)) '() (setq chunk-len (+ 1 chunk-len)))
+ (goto-char (+ beginning chunk-len)))
+ (cond ((and ip memory stack)
+ (malyon-set-game-state (vector ip
+ (aref stack 0)
+ (aref stack 1)
+ (aref stack 2)
+ memory
+ t)))
+ ((null malyon-restore-data-error)
+ (setq malyon-restore-data-error "invalid quetzal file.")))))
+
+(defun malyon-restore-quetzal-ifhd (size)
+ "Restore an IFhd chunk from disk. Return the instruction pointer."
+ (if (and (= (malyon-read-word-from-file) (malyon-read-word 2))
+ (= (malyon-read-word-from-file) (malyon-read-word 18))
+ (= (malyon-read-word-from-file) (malyon-read-word 20))
+ (= (malyon-read-word-from-file) (malyon-read-word 22))
+ (= (malyon-read-word-from-file) (malyon-read-word 28)))
+ (logior (lsh (malyon-read-byte-from-file) 16)
+ (lsh (malyon-read-byte-from-file) 8)
+ (malyon-read-byte-from-file))
+ (setq malyon-restore-data-error "quetzal file doesn't belong to game.")
+ nil))
+
+(defun malyon-restore-quetzal-cmem (size)
+ "Restore a CMem chunk from disk. Return the entire memory layout."
+ (let ((memory (copy-sequence (aref malyon-game-state-restart 4)))
+ (max-size (+ (point) size))
+ (byte 0)
+ (i 0))
+ (while (< (point) max-size)
+ (setq byte (malyon-read-byte-from-file))
+ (if (zerop byte)
+ (setq i (+ 1 i (malyon-read-byte-from-file)))
+ (aset memory i (logxor byte (aref memory i)))
+ (setq i (+ 1 i))))
+ memory))
+
+(defun malyon-restore-quetzal-umem (size)
+ "Restore a UMem chunk from disk. Return the entire memory layout."
+ (let ((memory (copy-sequence (aref malyon-game-state-restart 4)))
+ (i 0))
+ (while (< i size)
+ (aset memory i (malyon-read-byte-from-file))
+ (setq i (+ 1 i)))
+ memory))
+
+(defun malyon-restore-quetzal-stks (size)
+ "Restore a Stks chunk from disk. Return a vector containing the
+stack pointer, the frame pointer, and the stack itself."
+ (let ((i 0) (frame-id 0))
+ (setq malyon-restore-quetzal-stack
+ (copy-sequence (aref malyon-game-state-restart 3)))
+ (setq malyon-restore-quetzal-stack-pointer -1)
+ (setq malyon-restore-quetzal-frame-pointer 2)
+ (while (< i size)
+ (let* ((beginning (point))
+ (return3 (malyon-read-byte-from-file))
+ (return2 (malyon-read-byte-from-file))
+ (return1 (malyon-read-byte-from-file))
+ (return-addr (logior (lsh return3 16) (lsh return2 8) return1))
+ (result-locals (malyon-read-byte-from-file))
+ (has-result (zerop (logand 16 result-locals)))
+ (num-locals (logand 15 result-locals))
+ (result-addr (malyon-read-byte-from-file))
+ (arg-flags (+ 1 (malyon-read-byte-from-file)))
+ (num-args 0)
+ (eval-size (malyon-read-word-from-file))
+ (local-vars '())
+ (eval-stack '()))
+ (while (> num-locals 0)
+ (setq local-vars (cons (malyon-read-word-from-file) local-vars))
+ (setq num-locals (- num-locals 1)))
+ (while (> eval-size 0)
+ (setq eval-stack (cons (malyon-read-word-from-file) eval-stack))
+ (setq eval-size (- eval-size 1)))
+ (while (> arg-flags 1)
+ (setq arg-flags (lsh arg-flags -1))
+ (setq num-args (+ num-args 1)))
+ (malyon-push-stack-frame frame-id
+ return-addr
+ (if (zerop frame-id)
+ nil
+ (if has-result result-addr nil))
+ (reverse local-vars)
+ num-args
+ (reverse eval-stack))
+ (setq frame-id (+ 1 frame-id))
+ (setq i (+ i (- (point) beginning)))))
+ (vector malyon-restore-quetzal-stack-pointer
+ malyon-restore-quetzal-frame-pointer
+ malyon-restore-quetzal-stack)))
+
+;; object table management
+
+(defsubst malyon-object-address (object)
+ "Compute the address at which the object is stored."
+ (+ malyon-object-table
+ (* 2 malyon-object-properties)
+ (* malyon-object-table-entry-size (- object 1))))
+
+(defsubst malyon-object-read-parent (address)
+ "Return the parent."
+ (if (< malyon-story-version 5)
+ (malyon-read-byte (+ 4 address))
+ (malyon-read-word (+ 6 address))))
+
+(defsubst malyon-object-read-sibling (address)
+ "Return the next sibling."
+ (if (< malyon-story-version 5)
+ (malyon-read-byte (+ 5 address))
+ (malyon-read-word (+ 8 address))))
+
+(defsubst malyon-object-read-child (address)
+ "Return the first child."
+ (if (< malyon-story-version 5)
+ (malyon-read-byte (+ 6 address))
+ (malyon-read-word (+ 10 address))))
+
+(defsubst malyon-object-store-parent (address value)
+ "Set the parent."
+ (if (< malyon-story-version 5)
+ (malyon-store-byte (+ 4 address) value)
+ (malyon-store-word (+ 6 address) value)))
+
+(defsubst malyon-object-store-sibling (address value)
+ "Set the next sibling."
+ (if (< malyon-story-version 5)
+ (malyon-store-byte (+ 5 address) value)
+ (malyon-store-word (+ 8 address) value)))
+
+(defsubst malyon-object-store-child (address value)
+ "Set the first child."
+ (if (< malyon-story-version 5)
+ (malyon-store-byte (+ 6 address) value)
+ (malyon-store-word (+ 10 address) value)))
+
+(defun malyon-find-property (object property)
+ "Return the address of the object's property, or 0 if it doesn't exist."
+ (let ((next (malyon-first-property object))
+ (number 0))
+ (setq number (logand (malyon-read-byte next) malyon-object-properties))
+ (while (> number property)
+ (setq next (malyon-next-property next))
+ (setq number (logand (malyon-read-byte next) malyon-object-properties)))
+ (if (= number property) next 0)))
+
+(defun malyon-first-property (object)
+ "Get the address of the object's first property."
+ (let ((header (malyon-read-word (+ malyon-object-property-offset
+ (malyon-object-address object)))))
+ (+ header 1 (* 2 (malyon-read-byte header)))))
+
+(defun malyon-next-property (property)
+ "Get the address of the following property."
+ (let ((size (malyon-read-byte property))
+ (addr (+ property 1)))
+ (+ 1 addr (cond ((< malyon-story-version 5) (lsh size -5))
+ ((zerop (logand 128 size)) (lsh size -6))
+ (t
+ (let ((second (logand 63 (malyon-read-byte addr))))
+ (if (= 0 second) 64 second)))))))
+
+(defun malyon-remove-object (object)
+ "Remove the object from the children list of its parent."
+ (let* ((address (malyon-object-address object))
+ (parent (malyon-object-read-parent address))
+ (sibling (malyon-object-read-sibling address)))
+ (malyon-object-store-parent address 0)
+ (malyon-object-store-sibling address 0)
+ (if (/= parent 0)
+ (let ((parent-addr (malyon-object-address parent)))
+ (let ((children (malyon-object-read-child parent-addr)))
+ (if (or (= children 0) (= children object))
+ (malyon-object-store-child parent-addr sibling)
+ (let ((this (malyon-object-address children)))
+ (let ((next (malyon-object-read-sibling this)))
+ (while (/= next object)
+ (setq this (malyon-object-address next))
+ (setq next (malyon-object-read-sibling this)))
+ (malyon-object-store-sibling this sibling)))))))))
+
+;; function calls and code branches
+
+(defun malyon-call-routine (routine arguments &optional result)
+ "Call a routine with the given arguments and return its result."
+ (if (= routine 0)
+ (if result (malyon-store-variable result 0) 0)
+ (malyon-push-stack (if result 0 1))
+ (malyon-push-stack (if result result 0))
+ (malyon-push-stack malyon-instruction-pointer)
+ (malyon-push-stack
+ (logior (lsh (- malyon-stack-pointer malyon-frame-pointer) 8)
+ (length arguments)))
+ (setq malyon-instruction-pointer (* malyon-packed-multiplier routine))
+ (let ((args (malyon-read-code-byte)) (value nil))
+ (if malyon-game-state-quetzal
+ (let ((id (lsh (aref malyon-stack malyon-frame-pointer) -8)))
+ (malyon-push-stack (logior (lsh (+ 1 id) 8) args))))
+ (setq malyon-frame-pointer malyon-stack-pointer)
+ (while (> args 0)
+ (setq value (if (< malyon-story-version 5) (malyon-read-code-word) 0))
+ (malyon-push-stack (if (null arguments) value (car arguments)))
+ (setq arguments (cdr arguments))
+ (setq args (- args 1))))))
+
+(defun malyon-jump-if (condition)
+ "Jump depending on the condition and the following jump data."
+ (let ((byte (malyon-read-code-byte))
+ (offset nil)
+ (iftrue nil))
+ (setq iftrue (/= 0 (logand byte 128)))
+ (setq offset (logand byte 63))
+ (if (= 0 (logand byte 64))
+ (progn
+ (setq offset (logior (lsh offset 8) (malyon-read-code-byte)))
+ (if (>= offset 8192) (setq offset (- offset 16384)))))
+ (if (or (and iftrue condition) (and (not iftrue) (not condition)))
+ (progn
+ (cond ((= offset 0) (malyon-opcode-rfalse))
+ ((= offset 1) (malyon-opcode-rtrue))
+ (t (setq
+ malyon-instruction-pointer
+ (+ malyon-instruction-pointer offset -2))))))))
+
+(defun malyon-return (value)
+ "Return from a routine."
+ (setq malyon-stack-pointer malyon-frame-pointer)
+ (if malyon-game-state-quetzal (malyon-pop-stack))
+ (setq malyon-frame-pointer
+ (- malyon-stack-pointer 1 (lsh (malyon-pop-stack) -8)))
+ (setq malyon-instruction-pointer (malyon-pop-stack))
+ (let ((result (malyon-pop-stack))
+ (store (malyon-pop-stack)))
+ (if (zerop store)
+ (malyon-return-store result value)
+ (malyon-return-ignore result value))))
+
+(defun malyon-return-ignore (where value)
+ "Return from a routine ignoring the result.")
+
+(defun malyon-return-store (where value)
+ "Return from a routine storing the result."
+ (malyon-store-variable where value))
+
+(defun malyon-push-initial-frame ()
+ "Push the initial stack frame required in quetzal mode."
+ (if malyon-game-state-quetzal
+ (progn
+ (malyon-push-stack 1)
+ (malyon-push-stack 0)
+ (malyon-push-stack 0)
+ (malyon-push-stack 0)
+ (malyon-push-stack 0))))
+
+(defun malyon-get-stack-frame (fp sp stack)
+ "Return a decoded stack frame in quetzal mode.
+The result is a vector containing the frame id, the fp of the
+previous frame, the sp of the previous frame, the return address,
+the result variable if any, a list of local variables, the number
+of arguments, and a list of the evaluation stack elements."
+ (let* ((has-result (zerop (aref stack fp)))
+ (result-addr (if has-result (aref stack (+ 1 fp)) nil))
+ (return-addr (aref stack (+ 2 fp)))
+ (offset (lsh (aref stack (+ 3 fp)) -8))
+ (num-args (logand 255 (aref stack (+ 3 fp))))
+ (frame-id (lsh (aref stack (+ 4 fp)) -8))
+ (num-locals (logand 255 (aref stack (+ 4 fp))))
+ (start-locals (+ 5 fp))
+ (start-eval (+ 5 fp num-locals))
+ (local-vars '())
+ (eval-stack '()))
+ (if (not (zerop num-locals))
+ (setq local-vars
+ (malyon-vector-to-list stack start-locals start-eval)))
+ (if (> sp start-eval)
+ (setq eval-stack
+ (malyon-vector-to-list stack start-eval (+ 1 sp))))
+ (vector frame-id
+ (- fp offset 2)
+ (- fp 1)
+ return-addr
+ result-addr
+ local-vars
+ num-args
+ eval-stack)))
+
+(defsubst malyon-restore-quetzal-push-stack (value)
+ "Push a value onto the restore quetzal stack."
+ (setq malyon-restore-quetzal-stack-pointer
+ (+ malyon-restore-quetzal-stack-pointer 1))
+ (aset malyon-restore-quetzal-stack
+ malyon-restore-quetzal-stack-pointer
+ value))
+
+(defun malyon-push-stack-frame
+ (frame-id return-addr result local-vars num-args eval-stack)
+ "Pushes a new stack frame in quetzal mode."
+ (malyon-restore-quetzal-push-stack (if result 0 1))
+ (malyon-restore-quetzal-push-stack (if result result 0))
+ (malyon-restore-quetzal-push-stack return-addr)
+ (malyon-restore-quetzal-push-stack
+ (logior (lsh (- malyon-restore-quetzal-stack-pointer
+ malyon-restore-quetzal-frame-pointer) 8)
+ num-args))
+ (malyon-restore-quetzal-push-stack
+ (logior (lsh frame-id 8) (length local-vars)))
+ (setq malyon-restore-quetzal-frame-pointer
+ malyon-restore-quetzal-stack-pointer)
+ (while (not (null local-vars))
+ (malyon-restore-quetzal-push-stack (car local-vars))
+ (setq local-vars (cdr local-vars)))
+ (while (not (null eval-stack))
+ (malyon-restore-quetzal-push-stack (car eval-stack))
+ (setq eval-stack (cdr eval-stack))))
+
+;; other stuff
+
+(defvar malyon-aread-text nil
+ "Text buffer for user input.")
+
+(defvar malyon-aread-parse nil
+ "Parse buffer for user input.")
+
+(defvar malyon-aread-beginning-of-line nil
+ "The beginning of the input line.")
+
+;; execution
+
+(defun malyon-interpreter ()
+ "Run the z code interpreter on the given story file."
+ (condition-case nil
+ (progn
+ (malyon-restore-window-configuration)
+ (if malyon-story-file
+ (catch 'malyon-end-of-interpreter-loop
+ (setq malyon-last-cursor-position-after-input
+ (malyon-point-max malyon-transcript-buffer))
+ (malyon-execute))))
+ (error
+ (malyon-fatal-error "unspecified internal runtime error."))))
+
+(defsubst malyon-fetch-variable-operands (specifier)
+ "Fetch a variable number of operands based on the specifier argument."
+ (let ((var (logand specifier 49152))
+ (op '()))
+ (setq specifier (logand 65535 specifier))
+ (while (/= 0 specifier)
+ (cond ((= var 0) (setq op (cons (malyon-read-code-word) op)))
+ ((= var 16384) (setq op (cons (malyon-read-code-byte) op)))
+ ((= var 32768) (setq op (cons (malyon-read-variable
+ (malyon-read-code-byte)) op)))
+ (t (setq specifier 0)))
+ (setq specifier (logand 65535 (lsh specifier 2)))
+ (setq var (logand specifier 49152)))
+ (nreverse op)))
+
+(defsubst malyon-fetch-extended (opcode)
+ "Fetch operands for an extended instruction."
+ (malyon-fetch-variable-operands
+ (logior (lsh (malyon-read-code-byte) 8) 255)))
+
+(defsubst malyon-fetch-variable (opcode)
+ "Fetch operands for a variable instruction."
+ (malyon-fetch-variable-operands
+ (if (or (= opcode 236) (= opcode 250))
+ (malyon-read-code-word)
+ (logior (lsh (malyon-read-code-byte) 8) 255))))
+
+(defsubst malyon-fetch-short (opcode)
+ "Fetch operands for a short instruction."
+ (let ((op (logand opcode 48)))
+ (cond ((= op 0) (list (malyon-read-code-word)))
+ ((= op 16) (list (malyon-read-code-byte)))
+ ((= op 32) (list (malyon-read-variable (malyon-read-code-byte)))))))
+
+(defsubst malyon-fetch-long (instr)
+ "Fetch operands for a long instruction."
+ (let ((byte1 (malyon-read-code-byte))
+ (byte2 (malyon-read-code-byte)))
+ (list (if (= (logand instr 64) 0) byte1 (malyon-read-variable byte1))
+ (if (= (logand instr 32) 0) byte2 (malyon-read-variable byte2)))))
+
+(defun malyon-execute ()
+ "Execute z code instructions.
+Load the next instruction opcode and its operands and execute it.
+Repeat ad infinitum."
+ (let ((opcode) (operands)); (pc))
+ (while t
+; (setq pc malyon-instruction-pointer)
+ (setq opcode (malyon-read-code-byte))
+ (setq operands (cond ((= opcode 190)
+ (setq opcode (+ 256 (malyon-read-code-byte)))
+ (malyon-fetch-extended opcode))
+ ((>= opcode 192)
+ (malyon-fetch-variable opcode))
+ ((>= opcode 128)
+ (malyon-fetch-short opcode))
+ (t
+ (malyon-fetch-long opcode))))
+; (malyon-trace-opcode pc opcode operands)
+ (apply (aref malyon-opcodes opcode) operands))))
+
+;; opcodes
+
+(defsubst malyon-number (n)
+ "Convert an unsigned number into a signed one."
+ (if (< n 32768) n (- n 65536)))
+
+(defun malyon-opcode-add (a b)
+ "Addition."
+ (malyon-store-variable (malyon-read-code-byte)
+ (+ (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-and (a b)
+ "Bitwise and."
+ (malyon-store-variable (malyon-read-code-byte) (logand a b)))
+
+(defun malyon-opcode-aread (text parse &optional time routine)
+ "Read input text."
+ (setq malyon-aread-text text)
+ (setq malyon-aread-parse parse)
+ (goto-char (point-max))
+ (setq malyon-aread-beginning-of-line (point))
+; Some games violate these assumptions for the "Quit" question.
+; (if (> 3 (malyon-read-byte text))
+; (malyon-fatal-error "text buffer less than 3 bytes."))
+; (if (and (not (zerop parse)) (> 2 (malyon-read-byte parse)))
+; (malyon-fatal-error "parse buffer less than 2 bytes."))
+ (malyon-more malyon-keymap-read)
+ (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-input))
+
+(defun malyon-opcode-art-shift (value places)
+ "Arithmetic shift."
+ (malyon-store-variable (malyon-read-code-byte) (ash value places)))
+
+(defun malyon-opcode-buffer-mode (mode)
+ "Toggles buffering of text in the transcript window."
+ (setq malyon-transcript-buffer-buffered (/= 0 mode)))
+
+(defun malyon-opcode-calln (routine &rest arguments)
+ "Call a routine and ignore the result."
+ (malyon-call-routine routine arguments))
+
+(defun malyon-opcode-calls (routine &rest arguments)
+ "Call a routine and store the result."
+ (malyon-call-routine routine arguments (malyon-read-code-byte)))
+
+(defun malyon-opcode-catch ()
+ "Return the current stack frame."
+ (malyon-store-variable
+ (malyon-read-code-byte)
+ (if malyon-game-state-quetzal
+ (lsh (aref malyon-stack malyon-frame-pointer) -8)
+ malyon-frame-pointer)))
+
+(defun malyon-opcode-check-arg-count (count)
+ "Tests the number of arguments passed to routine."
+ (malyon-jump-if
+ (<= count (logand 255 (aref malyon-stack
+ (if malyon-game-state-quetzal
+ (- malyon-frame-pointer 1)
+ malyon-frame-pointer))))))
+
+(defun malyon-opcode-check-unicode (char)
+ "Check whether the given character is valid for input/output."
+ (malyon-store-variable (malyon-read-code-byte) 0))
+
+(defun malyon-opcode-clear-attr (object attribute)
+ "Clear the given attribute in the given object."
+ (let ((attributes (malyon-object-address object))
+ (byte (lsh attribute -3)))
+ (malyon-store-byte (+ attributes byte)
+ (logand (malyon-read-byte (+ attributes byte))
+ (logxor (lsh 128 (- (logand attribute 7)))
+ 255)))))
+
+(defun malyon-opcode-copy-table (first second size)
+ "Copies first table onto second one."
+ (let* ((length (abs (malyon-number size)))
+ (zero (zerop second))
+ (forward (or (< (malyon-number size) 0) (> first second)))
+ (i 0)
+ (a (if forward first (+ first length -1)))
+ (b (if forward (if zero first second) (+ second length -1))))
+ (while (< i length)
+ (malyon-store-byte b (if zero 0 (malyon-read-byte a)))
+ (setq i (+ i 1)
+ a (if forward (+ a 1) (- a 1))
+ b (if forward (+ b 1) (- b 1))))))
+
+(defun malyon-opcode-dec (var)
+ "Decrement variable."
+ (malyon-store-variable var
+ (- (malyon-number (malyon-read-variable var)) 1)))
+
+(defun malyon-opcode-dec-chk (variable threshold)
+ "Decrement variable and jump if it's less than the given value."
+ (let ((value (malyon-number (malyon-read-variable variable))))
+ (malyon-store-variable variable (- value 1))
+ (malyon-jump-if (< (- value 1) (malyon-number threshold)))))
+
+(defun malyon-opcode-div (a b)
+ "Division."
+ (if (zerop b) (malyon-fatal-error "division by 0."))
+ (malyon-store-variable (malyon-read-code-byte)
+ (/ (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-encode-text (text length from encoded)
+ "Encode the zscii text starting at from with the given length.
+The result is stored at encoded."
+ (let* ((i length)
+ (j encoded)
+ (l '())
+ (word '()))
+ (while (< 0 i)
+ (setq l (cons (malyon-read-byte (+ text from i -1)) l)
+ i (- i 1)))
+ (setq word (malyon-encode-dictionary-word
+ (append (malyon-mapcan 'malyon-encode-into-ztext l)
+ '(5 5 5 5 5 5 5 5))))
+ (while (< i 6)
+ (malyon-store-byte j (car l))
+ (setq i (+ 1 i)
+ j (+ 1 j)
+ l (cdr word)))))
+
+(defun malyon-opcode-erase-line (value)
+ "Erases the rest of the line."
+ (if (= value 1)
+ (if (eq malyon-transcript-buffer (current-buffer))
+ (kill-line nil)
+ (save-excursion
+ (let ((i (current-column)))
+ (while (<= i malyon-max-column)
+ (insert ? )
+ (delete-char 1)
+ (setq i (+ 1 i))))))))
+
+(defun malyon-opcode-erase-window (window)
+ "Erase the contents of the given window."
+ (save-excursion
+ (let ((w (malyon-number window)))
+ (if (or (= w 0) (= w -1) (= w -2))
+ (malyon-erase-buffer malyon-transcript-buffer))
+ (if (or (= w 1) (= w -1) (= w -2))
+ (malyon-erase-buffer malyon-status-buffer))
+ (if (= w -1)
+ (malyon-split-buffer-windows 0)))
+ (setq malyon-last-cursor-position-after-input
+ (malyon-point-max malyon-transcript-buffer))))
+
+(defun malyon-opcode-get-child (object)
+ "Get the first child of the given object and jump."
+ (let ((child (malyon-object-read-child (malyon-object-address object))))
+ (malyon-store-variable (malyon-read-code-byte) child)
+ (malyon-jump-if (/= 0 child))))
+
+(defun malyon-opcode-get-cursor (array)
+ "Retrieves the current cursor position."
+ (save-excursion
+ (set-buffer malyon-status-buffer)
+ (malyon-store-word array (- (count-lines (point-min) (point)) 1))
+ (malyon-store-word (+ 2 array) (+ 1 (current-column)))))
+
+(defun malyon-opcode-get-next-prop (object property)
+ "Retrieve the first or next property id of object."
+ (let ((next (malyon-first-property object))
+ (number 0))
+ (if (zerop property)
+ '()
+ (setq number (logand (malyon-read-byte next)
+ malyon-object-properties))
+ (setq next (malyon-next-property next))
+ (while (> number property)
+ (setq number (logand (malyon-read-byte next)
+ malyon-object-properties))
+ (setq next (malyon-next-property next)))
+ (if (/= number property)
+ (malyon-fatal-error "property does not exist.")))
+ (setq number (logand (malyon-read-byte next) malyon-object-properties))
+ (malyon-store-variable (malyon-read-code-byte) number)))
+
+(defun malyon-opcode-get-parent (object)
+ "Get the parent of the given object."
+ (malyon-store-variable (malyon-read-code-byte)
+ (malyon-object-read-parent
+ (malyon-object-address object))))
+
+(defun malyon-opcode-get-prop (object property)
+ "Get the value of the object's property."
+ (let* ((address (malyon-find-property object property))
+ (size (malyon-read-byte address)))
+ (malyon-store-variable
+ (malyon-read-code-byte)
+ (cond ((zerop address)
+ (malyon-read-word (+ malyon-object-table (* 2 (- property 1)))))
+ ((and (< malyon-story-version 5) (zerop (lsh size -5)))
+ (malyon-read-byte (+ address 1)))
+ ((and (>= malyon-story-version 5) (zerop (logand 192 size)))
+ (malyon-read-byte (+ address 1)))
+ (t
+ (malyon-read-word (+ address 1)))))))
+
+(defun malyon-opcode-get-prop-addr (object property)
+ "Get the address of the object's property."
+ (let* ((address (malyon-find-property object property))
+ (size (malyon-read-byte address))
+ (offset (if (< malyon-story-version 5)
+ 1
+ (if (zerop (logand 128 size)) 1 2))))
+ (malyon-store-variable (malyon-read-code-byte)
+ (if (zerop address) 0 (+ address offset)))))
+
+(defun malyon-opcode-get-prop-len (property)
+ "Get the length of the object's property."
+ (let ((size (malyon-read-byte (- property 1))))
+ (malyon-store-variable
+ (malyon-read-code-byte)
+ (cond ((< malyon-story-version 5) (+ 1 (lsh size -5)))
+ ((zerop (logand 128 size)) (+ 1 (lsh size -6)))
+ ((zerop (logand 63 size)) 64)
+ (t (logand 63 size))))))
+
+(defun malyon-opcode-get-sibling (object)
+ "Get the next object in the tree and jump."
+ (let ((sibling (malyon-object-read-sibling (malyon-object-address object))))
+ (malyon-store-variable (malyon-read-code-byte) sibling)
+ (malyon-jump-if (/= 0 sibling))))
+
+(defun malyon-opcode-illegal (&rest ignore)
+ "Print an error message and exit the interpreter."
+ (malyon-fatal-error "illegal opcode."))
+
+(defun malyon-opcode-inc (var)
+ "Increment variable."
+ (malyon-store-variable var
+ (+ (malyon-number (malyon-read-variable var)) 1)))
+
+(defun malyon-opcode-inc-chk (variable threshold)
+ "Increment variable and jump if it's greater than the given value."
+ (let ((value (malyon-number (malyon-read-variable variable))))
+ (malyon-store-variable variable (+ value 1))
+ (malyon-jump-if (> (+ value 1) (malyon-number threshold)))))
+
+(defun malyon-opcode-input-stream (number)
+ "Select the given input stream. Only the keyboard is supported."
+ (if (zerop (malyon-number number))
+ '()
+ (message "Only the keyboard is supported as an input stream.")))
+
+(defun malyon-opcode-insert-obj (object destination)
+ "Insert an object into the children list of another."
+ (let ((child (malyon-object-address object))
+ (parent (malyon-object-address destination)))
+ (malyon-remove-object object)
+ (malyon-object-store-parent child destination)
+ (malyon-object-store-sibling child (malyon-object-read-child parent))
+ (malyon-object-store-child parent object)))
+
+(defun malyon-opcode-je (a &rest rest)
+ "Jump if first operand equals any of the following."
+ (malyon-jump-if (member (malyon-number a) (mapcar 'malyon-number rest))))
+
+(defun malyon-opcode-jg (a b)
+ "Jump if first operand > second operand."
+ (malyon-jump-if (> (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-jin (child parent)
+ "Jump if second object is parent of the first one."
+ (malyon-jump-if
+ (= parent (malyon-object-read-parent (malyon-object-address child)))))
+
+(defun malyon-opcode-jl (a b)
+ "Jump if first operand < second operand."
+ (malyon-jump-if (< (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-jump (offset)
+ "Jump unconditionally."
+ (setq malyon-instruction-pointer (+ malyon-instruction-pointer
+ (malyon-number offset) -2)))
+
+(defun malyon-opcode-jz (a)
+ "Jump if operand = 0."
+ (malyon-jump-if (zerop a)))
+
+(defun malyon-opcode-load (variable)
+ "Load a variable."
+ (malyon-store-variable (malyon-read-code-byte)
+ (malyon-read-variable variable)))
+
+(defun malyon-opcode-loadb (array index)
+ "Load an array element into a variable."
+ (malyon-store-variable (malyon-read-code-byte)
+ (malyon-read-byte (+ array index))))
+
+(defun malyon-opcode-loadw (array index)
+ "Load an array element into a variable."
+ (malyon-store-variable (malyon-read-code-byte)
+ (malyon-read-word (+ array (* 2 index)))))
+
+(defun malyon-opcode-log-shift (value places)
+ "Logical shift."
+ (malyon-store-variable (malyon-read-code-byte) (lsh value places)))
+
+(defun malyon-opcode-mod (a b)
+ "Modulo."
+ (malyon-store-variable (malyon-read-code-byte)
+ (mod (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-mul (a b)
+ "Multiplication."
+ (malyon-store-variable (malyon-read-code-byte)
+ (* (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-new-line ()
+ "Print a newline."
+ (malyon-newline))
+
+(defun malyon-opcode-nop (&rest ignore)
+ "Do nothing.")
+
+(defun malyon-opcode-not (a)
+ "Bitwise not."
+ (malyon-store-variable (malyon-read-code-byte) (logand 65535 (lognot a))))
+
+(defun malyon-opcode-or (a b)
+ "Bitwise or."
+ (malyon-store-variable (malyon-read-code-byte) (logior a b)))
+
+(defun malyon-opcode-output-stream (stream &optional table)
+ "Select an output stream."
+ (let ((stream (malyon-number stream)))
+ (cond ((< 0 stream) (malyon-add-output-stream stream table))
+ ((> 0 stream) (malyon-remove-output-stream (- stream))))))
+
+(defun malyon-opcode-piracy ()
+ "Piracy check, effectively an unconditional jump."
+ (malyon-jump-if 1))
+
+(defun malyon-opcode-pop ()
+ "Pop a value off the stack."
+ (malyon-pop-stack))
+
+(defun malyon-opcode-print ()
+ "Print a string."
+ (setq malyon-instruction-pointer
+ (malyon-print-text malyon-instruction-pointer)))
+
+(defun malyon-opcode-print-addr (address)
+ "Print a string."
+ (malyon-print-text address))
+
+(defun malyon-opcode-print-char (c)
+ "Print a character."
+ (malyon-print (char-to-string c)))
+
+(defun malyon-opcode-print-num (n)
+ "Print a number."
+ (malyon-print (number-to-string (malyon-number n))))
+
+(defun malyon-opcode-print-obj (obj)
+ "Print the short name of the object."
+ (malyon-print-text
+ (+ 1 (malyon-read-word (+ malyon-object-property-offset
+ (malyon-object-address obj))))))
+
+(defun malyon-opcode-print-paddr (address)
+ "Print a string."
+ (malyon-print-text (* malyon-packed-multiplier address)))
+
+(defun malyon-opcode-print-ret ()
+ "Print a string, print a newline, return true/1."
+ (setq malyon-instruction-pointer
+ (malyon-print-text malyon-instruction-pointer))
+ (malyon-newline)
+ (malyon-return 1))
+
+(defun malyon-opcode-print-table (text width &optional height skip)
+ "Print the given table."
+ (if (not height) (setq height 1))
+ (if (not skip) (setq skip 0))
+ (let ((column (current-column))
+ (address text)
+ (y 0)
+ (x 0))
+ (while (< y height)
+ (if (zerop y)
+ '()
+ (malyon-newline)
+ (malyon-print-characters (make-string column ? )))
+ (setq x 0)
+ (while (< x width)
+ (malyon-output-character (malyon-read-byte address))
+ (setq address (+ 1 address))
+ (setq x (+ 1 x)))
+ (setq address (+ skip address))
+ (setq y (+ 1 y)))))
+
+(defun malyon-opcode-print-unicode (char)
+ "Prints a unicode character.")
+
+(defun malyon-opcode-pull (variable)
+ "Pull value off stack."
+ (malyon-store-variable variable (malyon-pop-stack)))
+
+(defun malyon-opcode-push (value)
+ "Push value onto stack."
+ (malyon-push-stack value))
+
+(defun malyon-opcode-put-prop (object property value)
+ "Set the object's property to the given value."
+ (let* ((address (malyon-find-property object property))
+ (size (malyon-read-byte address)))
+ (cond ((= address 0)
+ (malyon-fatal-error "property does not exist."))
+ ((and (< malyon-story-version 5) (zerop (lsh size -5)))
+ (malyon-store-byte (+ 1 address) (logand 255 value)))
+ ((and (>= malyon-story-version 5) (zerop (logand size 192)))
+ (malyon-store-byte (+ 1 address) (logand 255 value)))
+ (t
+ (malyon-store-word (+ 1 address) value)))))
+
+(defun malyon-opcode-quit ()
+ "End the game immediately."
+ (malyon-adjust-transcript)
+ (malyon-cleanup)
+ (throw 'malyon-end-of-interpreter-loop 'malyon-opcode-quit))
+
+(defun malyon-opcode-random (limit)
+ "Generate a random number or set the seed value."
+ (malyon-store-variable (malyon-read-code-byte)
+ (if (>= 0 (malyon-number limit))
+ 0
+ (+ 1 (random (malyon-number limit))))))
+
+(defun malyon-opcode-read-char (&optional device &rest ignore)
+ "Read a character."
+ (if (and device (/= 1 device))
+ (malyon-fatal-error "illegal device specified in read_char."))
+ (if (eq malyon-transcript-buffer (current-buffer))
+ (goto-char (point-max)))
+ (message "[Press a key.]")
+ (malyon-more malyon-keymap-readchar)
+ (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-character))
+
+(defun malyon-opcode-remove-obj (object)
+ "Remove an object from its parent's children list."
+ (malyon-remove-object object))
+
+(defun malyon-opcode-restart ()
+ "Restart the game."
+ (malyon-set-game-state malyon-game-state-restart))
+
+(defun malyon-opcode-restore (&optional table bytes name)
+ "Restore a saved game state or a section of memory from a file."
+ (let ((result (if name
+ (malyon-restore-file
+ (malyon-get-file-name name) table bytes)
+ (call-interactively 'malyon-restore-file))))
+ (if (< malyon-story-version 5)
+ (malyon-jump-if (not (zerop result)))
+ (malyon-store-variable (malyon-read-code-byte) result))))
+
+(defun malyon-opcode-restore-undo ()
+ "Restore game state for undo."
+ (if malyon-game-state-undo
+ (malyon-set-game-state malyon-game-state-undo))
+ (malyon-store-variable (malyon-read-code-byte) 2))
+
+(defun malyon-opcode-ret (value)
+ "Return a value."
+ (malyon-return value))
+
+(defun malyon-opcode-ret-popped ()
+ "Return top of stack."
+ (malyon-return (malyon-pop-stack)))
+
+(defun malyon-opcode-rfalse ()
+ "Return false/0."
+ (malyon-return 0))
+
+(defun malyon-opcode-rtrue ()
+ "Return true/1."
+ (malyon-return 1))
+
+(defun malyon-opcode-save (&optional table bytes name)
+ "Save the current game state or a section of memory to a file."
+ (let ((result (if name
+ (malyon-save-file (malyon-get-file-name name) table bytes)
+ (call-interactively 'malyon-save-file))))
+ (if (< malyon-story-version 5)
+ (malyon-jump-if (not (zerop result)))
+ (malyon-store-variable (malyon-read-code-byte) result))))
+
+(defun malyon-opcode-save-undo ()
+ "Save game state for undo."
+ (setq malyon-game-state-undo (malyon-current-game-state))
+ (malyon-store-byte (malyon-read-code-byte) 1))
+
+(defun malyon-opcode-scan-table (x table len &optional form)
+ "Scan the given table for the first occurrence of x."
+ (if (not form) (setq form 130))
+ (let ((inc (logand 127 form))
+ (byte (zerop (logand 128 form)))
+ (addr table)
+ (found 0)
+ (index 0))
+ (while (and (zerop found) (< index len))
+ (setq found
+ (if byte
+ (if (= x (malyon-read-byte addr)) addr 0)
+ (if (= x (malyon-read-word addr)) addr 0)))
+ (setq addr (+ addr inc))
+ (setq index (+ index 1)))
+ (malyon-store-variable (malyon-read-code-byte) found)
+ (malyon-jump-if (not (zerop found)))))
+
+(defun malyon-opcode-set-attr (object attribute)
+ "Set the given attribute in the given object."
+ (let ((attributes (malyon-object-address object))
+ (byte (lsh attribute -3)))
+ (malyon-store-byte (+ attributes byte)
+ (logior (malyon-read-byte (+ attributes byte))
+ (lsh 128 (- (logand attribute 7)))))))
+
+(defun malyon-opcode-set-color (foreground background)
+ "Sets the fore- and background colors ie. does nothing.")
+
+(defun malyon-opcode-set-cursor (&optional line column)
+ "Set the cursor."
+ (if (eq malyon-transcript-buffer (current-buffer))
+ (goto-char (point-max))
+ (if malyon-status-buffer-delayed-split
+ (progn
+ (malyon-split-buffer-windows malyon-status-buffer-delayed-split)
+ (other-window 1)))
+ (if line '() (setq line (count-lines (point-min) (point))))
+ (if column '() (setq column (current-column)))
+ (if (> line malyon-status-buffer-lines)
+ (progn
+ (malyon-split-buffer-windows line)
+ (other-window 1)))
+ (goto-char (point-min))
+ (if (and (<= 1 line) (<= line malyon-status-buffer-lines))
+ (forward-line line)
+ (beginning-of-line))
+ (if (and (<= 1 column) (<= column malyon-max-column))
+ (forward-char (- column 1))
+ (beginning-of-line))
+ (setq malyon-status-buffer-point (point))))
+
+(defun malyon-opcode-set-font (font)
+ "Sets the font if available or 0 otherwise."
+ (malyon-store-variable (malyon-read-code-byte) 0))
+
+(defun malyon-opcode-set-text-style (style)
+ "Set the text style/face."
+ (let ((face (assq style malyon-faces)))
+ (setq malyon-current-face (if face (cdr face) 'malyon-face-plain))))
+
+(defun malyon-opcode-set-window (window)
+ "Set the current window."
+ (malyon-restore-window-configuration)
+ (setq malyon-current-window window)
+ (malyon-update-output-streams)
+ (if (zerop window)
+ (if (not (eq malyon-transcript-buffer (current-buffer)))
+ (other-window 1))
+ (if (not (eq malyon-status-buffer (current-buffer)))
+ (other-window 1))
+ (malyon-opcode-set-cursor 1 1)))
+
+(defun malyon-opcode-show-status ()
+ "Display the status line."
+ (save-excursion
+ (malyon-opcode-split-window 1)
+ (malyon-restore-window-configuration)
+ (malyon-opcode-set-window 1)
+ (malyon-prepare-status-buffer 1)
+ (malyon-opcode-set-cursor 1 1)
+ (malyon-opcode-print-obj (malyon-read-global-variable 0))
+ (if (<= (current-column) (- (current-fill-column) 10))
+ (let* ((x (malyon-read-global-variable 1))
+ (y (malyon-read-global-variable 2))
+ (hours (if (> x 12) (- x 12) x))
+ (ampm (if (> x 12) "PM" "AM"))
+ (score (format "%4d/%4d" x y))
+ (time (format "%02d:%02d%s" hours y ampm)))
+ (malyon-opcode-set-cursor 1 (- (current-fill-column) 10))
+ (malyon-print (if malyon-score-game score time))))
+ (malyon-opcode-set-window 0)
+ (malyon-adjust-transcript)))
+
+(defun malyon-opcode-split-window (size)
+ "Split upper and lower window."
+ (malyon-set-window-configuration size))
+
+(defun malyon-opcode-store (variable value)
+ "Store a value in a variable."
+ (malyon-store-variable variable value))
+
+(defun malyon-opcode-storeb (array index value)
+ "Store a value in an array at the given index."
+ (malyon-store-byte (+ array index) value))
+
+(defun malyon-opcode-storew (array index value)
+ "Store a value in an array at the given index."
+ (malyon-store-word (+ array (* 2 index)) value))
+
+(defun malyon-opcode-sub (a b)
+ "Subtraction."
+ (malyon-store-variable (malyon-read-code-byte)
+ (- (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-test (bitmap flags)
+ "Test if all of the flags are set in the bitmap."
+ (malyon-jump-if (= flags (logand bitmap flags))))
+
+(defun malyon-opcode-test-attr (object attribute)
+ "Jump depending on the given attribute in the given object."
+ (malyon-jump-if
+ (/= 0 (logand (malyon-read-byte (+ (malyon-object-address object)
+ (lsh attribute -3)))
+ (lsh 128 (- (logand attribute 7)))))))
+
+(defun malyon-opcode-throw (value frame)
+ "Return from the given stack frame."
+ (if malyon-game-state-quetzal
+ (let ((id (lsh (aref malyon-stack malyon-frame-pointer) -8)))
+ (while (/= frame id)
+ (setq malyon-stack-pointer malyon-frame-pointer)
+ (malyon-pop-stack)
+ (setq malyon-frame-pointer
+ (- malyon-stack-pointer 1 (lsh (malyon-pop-stack) -8)))
+ (malyon-pop-stack)
+ (malyon-pop-stack)
+ (setq id (lsh (aref malyon-stack malyon-frame-pointer) -8))))
+ (setq malyon-frame-pointer frame))
+ (malyon-return value))
+
+(defun malyon-opcode-tokenise (text parse &optional dict flag)
+ "Perform lexical analysis on the text buffer."
+ (let* ((words (malyon-text-to-words text dict))
+ (word (car words))
+ (start (car word))
+ (len (malyon-cadr word))
+ (code (malyon-caddr word))
+ (entry (malyon-lookup dict code))
+ (i 0))
+ (while (not (or (null words) (= i (malyon-read-byte parse))))
+ (if (and (zerop entry) flag (/= 0 flag))
+ '()
+ (malyon-store-word (+ 2 parse (* 4 i)) entry)
+ (malyon-store-byte (+ 4 parse (* 4 i)) len)
+ (malyon-store-byte (+ 5 parse (* 4 i)) start))
+ (setq words (cdr words)
+ word (car words)
+ start (car word)
+ len (malyon-cadr word)
+ code (malyon-caddr word)
+ entry (malyon-lookup dict code)
+ i (+ 1 i)))
+ (malyon-store-byte (+ 1 parse) i)))
+
+(defun malyon-opcode-verify ()
+ "Verify the correctness of the story file."
+ (let ((length (+ 1 (* malyon-packed-multiplier (malyon-read-word 26))))
+ (sum 0)
+ (i 64))
+ (while (< i length)
+ (setq sum (mod (+ sum (malyon-read-byte i)) 65536)
+ i (+ 1 i)))
+ (malyon-jump-if (= (malyon-read-word 28) sum))))
+
+;; keymap utilities
+
+(defun malyon-end-input ()
+ "Store the input line in a text buffer and perform lexical analysis."
+ (interactive)
+ (condition-case nil
+ (progn
+ (malyon-adjust-transcript)
+ (switch-to-buffer malyon-transcript-buffer)
+ (goto-char (point-max))
+ (let* ((input (downcase
+ (buffer-substring-no-properties
+ (if (< malyon-aread-beginning-of-line (point))
+ malyon-aread-beginning-of-line
+ (point))
+ (point))))
+ (vec (malyon-string-to-vector input))
+ (text (apply 'vector (mapcar 'malyon-unicode-to-zscii vec)))
+ (len (min (malyon-read-byte malyon-aread-text) (length text)))
+ (i 0))
+ (malyon-history-insert input)
+ (if (>= malyon-story-version 5)
+ (malyon-store-byte (+ malyon-aread-text 1) len))
+ (while (< i len)
+ (malyon-store-byte
+ (+ malyon-aread-text (if (< malyon-story-version 5) 1 2) i)
+ (malyon-char-to-int (aref text i)))
+ (setq i (+ 1 i)))
+ (if (< malyon-story-version 5)
+ (malyon-store-byte (+ malyon-aread-text 1 len) 0)))
+ (if (/= 0 malyon-aread-parse)
+ (malyon-opcode-tokenise malyon-aread-text malyon-aread-parse))
+ (newline)
+ (if (>= malyon-story-version 5)
+ (malyon-store-variable (malyon-read-code-byte) 10))
+ (malyon-interpreter))
+ (error
+ (malyon-fatal-error "unspecified internal runtime error."))))
+
+(defun malyon-more-char ()
+ "Page down in More mode."
+ (interactive)
+ (condition-case nil
+ (scroll-up)
+ (error))
+ (if (>= (count-lines (point) (point-max))
+ (malyon-window-displayed-height))
+ (message "[More]")
+ (goto-char (point-max))
+ (malyon-adjust-transcript)
+ (use-local-map malyon-more-continue-keymap)))
+
+(defun malyon-more-char-status ()
+ "Wait for a key then continue."
+ (interactive)
+ (condition-case nil
+ (progn
+ (malyon-adjust-transcript)
+ (use-local-map malyon-more-continue-keymap)
+ (malyon-interpreter))
+ (error
+ (malyon-fatal-error "unspecified internal runtime error."))))
+
+(defun malyon-wait-char ()
+ "Store the input character in a variable and resume execution."
+ (interactive)
+ (condition-case nil
+ (progn
+ (malyon-store-variable
+ (malyon-read-code-byte)
+ (malyon-char-to-int (malyon-unicode-to-zscii last-command-char)))
+ (use-local-map malyon-keymap-read)
+ (malyon-interpreter))
+ (error
+ (malyon-fatal-error "unspecified internal runtime error."))))
+
+(defun malyon-history-previous-char (arg)
+ "Display the previous item in the input history."
+ (interactive "p")
+ (let ((input (malyon-history-previous)))
+ (cond ((> malyon-aread-beginning-of-line (point))
+ (funcall malyon-history-saved-up arg))
+ (input
+ (save-excursion
+ (set-buffer malyon-transcript-buffer)
+ (delete-region malyon-aread-beginning-of-line (point-max)))
+ (goto-char (point-max))
+ (insert input)
+ (malyon-adjust-transcript)))))
+
+(defun malyon-history-next-char (arg)
+ "Display the next item in the input history."
+ (interactive "p")
+ (let ((input (malyon-history-next)))
+ (cond ((> malyon-aread-beginning-of-line (point))
+ (funcall malyon-history-saved-down arg))
+ (input
+ (save-excursion
+ (set-buffer malyon-transcript-buffer)
+ (delete-region malyon-aread-beginning-of-line (point-max)))
+ (goto-char (point-max))
+ (insert input)
+ (malyon-adjust-transcript)))))
+
+(defun malyon-beginning-of-line (arg)
+ "Go to the beginning of the line."
+ (interactive "p")
+ (if (> malyon-aread-beginning-of-line (point))
+ (beginning-of-line)
+ (goto-char malyon-aread-beginning-of-line)))
+
+(defun malyon-kill-region (arg)
+ "Kill region."
+ (interactive "p")
+ (if (<= malyon-aread-beginning-of-line (point))
+ (kill-region (point) (mark))
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-kill-line (arg)
+ "Kill rest of the current line."
+ (interactive "p")
+ (if (<= malyon-aread-beginning-of-line (point))
+ (kill-line)
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-kill-word (arg)
+ "Kill the current word."
+ (interactive "p")
+ (if (<= malyon-aread-beginning-of-line (point))
+ (kill-word 1)
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-yank (arg)
+ "Yank."
+ (interactive "p")
+ (if (<= malyon-aread-beginning-of-line (point))
+ (yank)
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-yank-pop (arg)
+ "Yank pop."
+ (interactive "p")
+ (if (<= malyon-aread-beginning-of-line (point))
+ (yank-pop 1)
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-delete-char (arg)
+ "Delete a character."
+ (interactive "p")
+ (if (<= malyon-aread-beginning-of-line (point))
+ (delete-char 1)
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-backward-delete-char (arg)
+ "Delete a character backwards."
+ (interactive "p")
+ (if (< malyon-aread-beginning-of-line (point))
+ (backward-delete-char-untabify 1)
+ (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-self-insert-command (arg)
+ "Insert a character."
+ (interactive "p")
+ (if (> malyon-aread-beginning-of-line (point))
+ (goto-char (point-max)))
+ (self-insert-command 1))
+
+;; tracing utility
+
+(defun malyon-trace-file ()
+ "Turn tracing on for a particular file."
+ (let ((trace
+ (get-buffer-create
+ (concat "Malyon Trace " malyon-story-file-name))))
+ (if trace
+ (save-excursion
+ (set-buffer trace)
+ (malyon-erase-buffer)
+ (insert (concat "Tracing " malyon-story-file-name "..."))
+ (newline)))))
+
+(defun malyon-trace-newline ()
+ "Output tracing newline."
+ (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
+ (if trace
+ (save-excursion
+ (set-buffer trace)
+ (goto-char (point-max))
+ (newline)))))
+
+(defun malyon-trace-opcode (pc opcode operands)
+ "Output a z code instruction."
+ (malyon-trace-string
+ (format "%8d %-3d %-25s %s\n"
+ pc
+ opcode
+ (symbol-name (aref malyon-opcodes opcode))
+ (apply 'concat (malyon-mapcan
+ (lambda (x)
+ (list " "
+ (number-to-string
+ (if (malyon-characterp x)
+ (malyon-char-to-int x)
+ x))))
+ operands)))))
+
+(defun malyon-trace-string (s)
+ "Output tracing string."
+ (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
+ (if (and trace s)
+ (save-excursion
+ (set-buffer trace)
+ (goto-char (point-max))
+ (insert s)))))
+
+(defun malyon-trace-object (o)
+ "Output tracing object."
+ (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
+ (if (and trace o)
+ (save-excursion
+ (set-buffer trace)
+ (goto-char (point-max))
+ (prin1 o trace)))))
+
+;;; announce malyon-mode
+
+(provide 'malyon-mode)
+(provide 'malyon)
+
+;;; malyon-mode.el ends here
projects / emacsconfig.git / commitdiff