home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / games / volume14 / dunnet / part02 / dun-save.el < prev    next >
Lisp/Scheme  |  1992-08-31  |  4KB  |  158 lines
  1.  
  2. ;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ;
  5. ;  Save and restore
  6. ;
  7. ;
  8. ;;;;;;;;;;;;;;;;;;;
  9.  
  10. (defun save-game (filename)
  11.   (if (not (setq filename (car filename)))
  12.       (mprincl "You must supply a filename for the save.")
  13.     (if (file-exists-p filename)
  14.     (mprincl "File already exists.")
  15.       (setq numsaves (1+ numsaves))
  16.       (make-save-buffer)
  17.       (save-val "current-room")
  18.       (save-val "computer")
  19.       (save-val "door1")
  20.       (save-val "visited")
  21.       (save-val "diggables")
  22.       (save-val "key-level")
  23.       (save-val "numsaves")
  24.       (save-val "numcmds")
  25.       (save-val "logged-in")
  26.       (save-val "dungeon-mode")
  27.       (save-val "jar")
  28.       (save-val "lastdir")
  29.       (save-val "black")
  30.       (save-val "nomail")
  31.       (save-val "unix-verbs")
  32.       (save-val "hole")
  33.       (save-val "uncompressed")
  34.       (save-val "ethernet")
  35.       (save-val "sauna-level")
  36.       (save-val "room-objects")
  37.       (save-val "room-silents")
  38.       (save-val "inventory")
  39.       (save-val "endgame-question")
  40.       (save-val "endgame")
  41.       (save-val "endgame-questions")
  42.       (save-val "cdroom")
  43.       (save-val "cdpath")
  44.       (save-val "correct-answer")
  45.       (save-val "inbus")
  46.       (compile-save-out filename)
  47.       (do-logfile 'save nil)
  48.       (switch-to-buffer "*dungeon*")
  49.       (princ "")
  50.       (mprincl "Done."))))
  51.  
  52. (defun make-save-buffer ()
  53.   (switch-to-buffer (get-buffer-create "*save-dungeon*"))
  54.   (erase-buffer))
  55.  
  56. ;; If you don't have the crypt program, rename this function to
  57. ;; compile-save-out, and get rid of the next function.
  58.  
  59. (defun compile-save-out-nocrypt (filename)
  60.   (write-region 1 (point-max) filename nil 1)
  61.   (kill-buffer (current-buffer)))
  62.  
  63. (defun compile-save-out (filename)
  64.   (let (key dir ferror)
  65.     (setq ferror nil)
  66.     (if (< lastdir 10)
  67.     (setq dir (+ lastdir 10))
  68.       (setq dir lastdir))
  69.     (setq key (prin1-to-string dir))
  70.     (condition-case nil
  71.     (crypt-buffer key)
  72.       (error (setq ferror t)))
  73.     (if (not ferror)
  74.     (progn
  75.       (goto-char (point-min))
  76.       (insert key)))
  77.     (write-region 1 (point-max) filename nil 1)
  78.     (kill-buffer (current-buffer))))
  79.  
  80. (defun save-val (varname)
  81.   (let (value)
  82.     (setq varname (intern varname))
  83.     (setq value (eval varname))
  84.     (minsert "(setq ")
  85.     (minsert varname)
  86.     (minsert " ")
  87.     (if (or (listp value)
  88.         (symbolp value))
  89.     (minsert "'"))
  90.     (if (stringp value)
  91.     (minsert "\""))
  92.     (minsert value)
  93.     (if (stringp value)
  94.     (minsert "\""))
  95.     (minsertl ")")))
  96.  
  97.  
  98. ;; If you don't have the crypt program, rename this function to 'restore'
  99. ;; and get rid of the next function.
  100.  
  101. (defun restore-nocrypt (args)
  102.   (let (file ferrror)
  103.     (setq ferror nil)
  104.     (if (not (setq file (car args)))
  105.     (mprincl "You must supply a filename.")
  106.       (condition-case nil
  107.       (load-file file)
  108.     (error (setq ferror t)))
  109.       (if ferror
  110.       (mprinc "Could not load restore file.")
  111.     (mprincl "Done.")
  112.     (setq room 0)))))
  113.  
  114. (defun restore (args)
  115.   (let (file)
  116.     (if (not (setq file (car args)))
  117.     (mprincl "You must supply a filename.")
  118.       (if (not (load-d file))
  119.       (mprincl "Could not load restore file.")
  120.     (mprincl "Done.")
  121.     (setq room 0)))))
  122.  
  123.  
  124. (defun do-logfile (type how)
  125.   (let (ferror)
  126.     (setq ferror nil)
  127.     (switch-to-buffer (get-buffer-create "*score*"))
  128.     (erase-buffer)
  129.     (condition-case nil
  130.     (insert-file-contents log-file)
  131.       (error (setq ferror t)))
  132.     (unless ferror
  133.         (goto-char (point-max))
  134.         (minsert (user-login-name))
  135.         (minsert " ")
  136.         (if (eq type 'save)
  137.         (minsert "saved ")
  138.           (if (= (endgame-score) 110)
  139.           (minsert "won ")
  140.         (if (not how)
  141.             (minsert "quit ")
  142.           (minsert "killed by ")
  143.           (minsert how)
  144.           (minsert " "))))
  145.         (minsert "at ")
  146.         (minsert (cadr (nth (abs room) rooms)))
  147.         (minsert ". score: ")
  148.         (if (> (endgame-score) 0)
  149.         (minsert (setq newscore (+ 90 (endgame-score))))
  150.           (minsert (setq newscore (reg-score))))
  151.         (minsert " saves: ")
  152.         (minsert numsaves)
  153.         (minsert " commands: ")
  154.         (minsert numcmds)
  155.         (minsert "\n")
  156.         (write-region 1 (point-max) log-file nil 1))
  157.     (kill-buffer (current-buffer))))
  158.