This is the mail archive of the guile@cygnus.com mailing list for the guile project.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Serena Del Bianco writes:
> I'm anxiously waiting to play Naos, is it available anywhere??
>
> Serena Del Bianco.
Not unless i send it to you.
This is for example the emacs-based user frontend for Naos.
Of course it is worthless without Naos itself.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; naos.el --- Naos User Frontend for GNU Emacs
;; Copyright (C) 1999 Klaus Schilling
;; Author: Klaus Schilling <Klaus.Schilling@home.ivm.de>
;; Created: 2 Feb 1999
;; Version: 0.0.1
;; Keywords: games roleplay
;; This file is not part of GNU Emacs
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; This is a user frontend for the role play game Naos based on the Emacs
;; Widget package by P. Abrahamsen.
;;; Code:
(defvar gamedriver "/home/klaus/naos/naos.scm")
;; loads P. Abrahamsen's Widget Package
(require 'widget)
;; string functions from elib
(require 'string)
(eval-when-compile
(require 'wid-edit))
;; submit button
(defun naos-submit-button ()
"Create the button which triggers the result of the current page to be submitted to the gamedriver, as regular answer to the gamedriver's query."
(widget-create 'push-button
:notify (lambda (&rest ignore)
(let ((res (apply 'concat (append answer '("\n")))))
(process-send-string process res))
(catch 'done
(progn
(save-excursion
(set-buffer process-buffer)
(naos-parse-output
process
(naos-read-output process))))
))
"Submit"))
;;Launching a new page in Naos
(defun naos-new-page ()
"Let a new page show up"
(switch-to-buffer "*naos-client*")
(setq answerl '())
(let ((inhibit-read-only t))
(erase-buffer))
(let ((all (overlay-lists)))
;; Delete all the overlays.
(mapcar 'delete-overlay (car all))
(mapcar 'delete-overlay (cdr all))))
;;Completes a Page and sets it up
(defun naos-page-setup ()
(widget-insert "\n\n")
(setq answer
(let* ((l answerl)(ll (length l))(j ll)(ans (make-vector ll " ")))
(while (> j 0)
(aset ans (- j 1) (car l))
(setq l (cdr l))
(setq j (- j 1)))
ans))
(naos-submit-button)
(use-local-map widget-keymap)
(widget-setup))
;;Info Link
(defun naos-info-link (addr)
"Links to the indicated node in the Naos Online Help Facility."
(widget-create
'info-link
:value (format ("(naos)%s" addr))))
;;Checkbox
(defun naos-checkbox (index val item)
"Lets the player select or deselect some option."
(setq answerl (cons (format " %s" val) answerl))
(widget-create
'checkbox
:format "%[%v%] %d"
:doc item
:tag (format "%d" index)
:value (not (string= val "0"))
:notify (lambda (widget &rest ignore)
(aset
answer
(string-to-number (widget-get widget ':tag))
(if (widget-value widget) " 1" " 0")))))
;;Radiolist
(defun naos-radiolist (index pre-chosen items)
"Let's the player choose exactly one of the given options."
(if (null items)
(setq answerl (cons " -1" answerl))
(progn
(setq answerl (cons (format " %s" pre-chosen) answerl))
(let ((i 0)
(it items)
(widget
(widget-create 'radio-button-choice
:tag (format "%d" index)
:value (format " %s" pre-chosen)
:notify (lambda (widget &rest ignore)
(aset
answer
(string-to-number (widget-get widget ':tag))
(widget-value widget))))))
(while (not (null it))
(widget-radio-add-item
widget
(list
'item
:format "%d"
:doc (car it)
:value (format " %d" i)))
(setq i (+ 1 i))
(setq it (cdr it)))))))
(defun naos-read-output (process)
(goto-char (point-min))
(while (not (search-forward "\r\n" nil t))
(accept-process-output process)
(goto-char (point-min)))
(goto-char (point-min))
(buffer-substring (point) (- (point-max) 2)))
(defun naos-parse-output (proc string)
(let* ((content string)(index 0))
(erase-buffer)
(naos-new-page)
(while (not (string= content ""))
(cond
((equal (string-match "/quit .*" content) 0) (throw 'done nil))
((equal (string-match "/info .*" content) 0)
(setq arg (substring (match-string 0 content) 6))
(naos-info-link arg))
((equal (string-match "/radio [0-9]+.*" content) 0)
(setq args (cdr (string-split "[ \t]+" (match-string 0 content))))
(naos-radiolist index (car args) (cdr args))
(setq index (+ 1 index)))
((equal (string-match "/check .*" content) 0)
(setq args (cdr (string-split "[ \t]+" (match-string 0 content))))
(naos-checkbox index (car args) (car (cdr args)))
(setq index (+ 1 index)))
((equal (string-match ".*\n" content) 0)
(widget-insert (match-string 0 content)))
(t (widget-insert content)))
(setq content (substring content (+ 1 (or (string-match "\n" content) (- (length content) 1))))))
(setq answer (make-vector index " "))
(naos-page-setup)) )
(defun naos-sentinel (proc event)
(message (format "%s received %s" proc event))
(cond ((string= event "finished\n") (kill-buffer "*naos-client*"))
((string-match "exited abnormally" event)
(kill-buffer "*naos-client*")
(switch-to-buffer "*naos*")
(message (buffer-string))
(kill-buffer "*naos*"))))
(defun naos ()
"Start the Naos program."
(interactive)
(setq process-buffer (get-buffer-create "*naos*"))
(setq process-connection-type t)
(make-local-variable 'answer)
(save-excursion
(set-buffer process-buffer)
(buffer-disable-undo process-buffer)
(erase-buffer))
(setq process (start-process "naos" process-buffer gamedriver))
(process-kill-without-query process)
(set-process-sentinel process 'naos-sentinel)
(save-excursion
(set-buffer process-buffer)
(naos-parse-output process (naos-read-output process))))
(provide 'naos)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Klaus Schilling