.gitignore - octans - Octans is a program to solve Algot's Wordplay (Wordsearch) puzzles

about summary refs log blame commit diff stats

path: root/.gitignore

blob: 4a5e4c71b9b7caac555d37111720a3101d4d85f0 (plain) (tree)

5bb0f22 ^

lib/.precomp

/ .highlight .k { color: #008800; font-weight: bold } /* Keyword */ .highlight .ch { color: #888888 } /* Comment.Hashbang */ .highlight .cm { color: #888888 } /* Comment.Multiline */ .highlight .cp { color: #cc0000; font-weight: bold } /* Comment.Preproc */ .highlight .cpf { color: #888888 } /* Comment.PreprocFile */ .highlight .c1 { color: #888888 } /* Comment.Single */ .highlight .cs { color: #cc0000; font-weight: bold; background-color: #fff0f0 } /* Comment.Special */ .highlight .gd { color: #000000; background-color: #ffdddd } /* Generic.Deleted */ .highlight .ge { font-style: italic } /* Generic.Emph */ .highlight .ges { font-weight: bold; font-style: italic } /* Generic.EmphStrong */ .highlight .gr { color: #aa0000 } /* Generic.Error */ .highlight .gh { color: #333333 } /* Generic.Heading */ .highlight .gi { color: #000000; background-color: #ddffdd } /* Generic.Inserted */ .highlight .go { color: #888888 } /* Generic.Output */ .highlight .gp { color: #555555 } /* Generic.Prompt */ .highlight .gs { font-weight: bold } /* Generic.Strong */ .highlight .gu { color: #666666 } /* Generic.Subheading */ .highlight .gt { color: #aa0000 } /* Generic.Traceback */ .highlight .kc { color: #008800; font-weight: bold } /* Keyword.Constant */ .highlight .kd { color: #008800; font-weight: bold } /* Keyword.Declaration */ .highlight .kn { color: #008800; font-weight: bold } /* Keyword.Namespace */ .highlight .kp { color: #008800 } /* Keyword.Pseudo */ .highlight .kr { color: #008800; font-weight: bold } /* Keyword.Reserved */ .highlight .kt { color: #888888; font-weight: bold } /* Keyword.Type */ .highlight .m { color: #0000DD; font-weight: bold } /* Literal.Number */ .highlight .s { color: #dd2200; background-color: #fff0f0 } /* Literal.String */ .highlight .na { color: #336699 } /* Name.Attribute */ .highlight .nb { color: #003388 } /* Name.Builtin */ .highlight .nc { color: #bb0066; font-weight: bold } /* Name.Class */ .highlight .no { color: #003366; font-weight: bold } /* Name.Constant */ .highlight .nd { color: #555555 } /* Name.Decorator */ .highlight .ne { color: #bb0066; font-weight: bold } /* Name.Exception */ .highlight .nf { color: #0066bb; font-weight: bold } /* Name.Function */ .highlight .nl { color: #336699; font-style: italic } /* Name.Label */ .highlight .nn { color: #bb0066; font-weight: bold } /* Name.Namespace */ .highlight .py { color: #336699; font-weight: bold } /* Name.Property */ .highlight .nt { color: #bb0066; font-weight: bold } /* Name.Tag */ .highlight .nv { color: #336699 } /* Name.Variable */ .highlight .ow { color: #008800 } /* Operator.Word */ .highlight .w { color: #bbbbbb } /* Text.Whitespace */ .highlight .mb { color: #0000DD; font-weight: bold } /* Literal.Number.Bin */ .highlight .mf { color: #0000DD; font-weight: bold } /* Literal.Number.Float */ .highlight .mh { color: #0000DD; font-weight: bold } /* Literal.Number.Hex */ .highlight .mi { color: #0000DD; font-weight: bold } /* Literal.Number.Integer */ .highlight .mo { color: #0000DD; font-weight: bold } /* Literal.Number.Oct */ .highlight .sa { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Affix */ .highlight .sb { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Backtick */ .highlight .sc { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Char */ .highlight .dl { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Delimiter */ .highlight .sd { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Doc */ .highlight .s2 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Double */ .highlight .se { color: #0044dd; background-color: #fff0f0 } /* Literal.String.Escape */ .highlight .sh { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Heredoc */ .highlight .si { color: #3333bb; background-color: #fff0f0 } /* Literal.String.Interpol */ .highlight .sx { color: #22bb22; background-color: #f0fff0 } /* Literal.String.Other */ .highlight .sr { color: #008800; background-color: #fff0ff } /* Literal.String.Regex */ .highlight .s1 { color: #dd2200; background-color: #fff0f0 } /* Literal.String.Single */ .highlight .ss { color: #aa6600; background-color: #fff0f0 } /* Literal.String.Symbol */ .highlight .bp { color: #003388 } /* Name.Builtin.Pseudo */ .highlight .fm { color: #0066bb; font-weight: bold } /* Name.Function.Magic */ .highlight .vc { color: #336699 } /* Name.Variable.Class */ .highlight .vg { color: #dd7700 } /* Name.Variable.Global */ .highlight .vi { color: #3333bb } /* Name.Variable.Instance */ .highlight .vm { color: #336699 } /* Name.Variable.Magic */ .highlight .il { color: #0000DD; font-weight: bold } /* Literal.Number.Integer.Long */

(require "split-sequence")              ; TODO: really used?
(defpackage #:ccap-muck
  (:use #:common-lisp #:split-sequence)
  (:export
   #:main)
  )
(in-package #:ccap-muck)

(defvar *terminate-program* nil)

(defvar +bold+ "#\esc[1m")    ; TODO: (alexandria:define-constant ...)
(defvar +unbold+ "#\esc[0m")
(defconstant +q+ #\")

(defclass <avatar> () ((name :accessor name)
                       (playing :reader playing :initform nil)
                       (password :accessor password)))
(defvar *avatars* '())

(defvar *write-avatars* nil)

(defclass <connection> () ((g :reader g)
                           (socket :reader socket)
                           (parser :reader parser)
                           (avatar :reader avatar)
                           (curr-room :reader curr-room)))
(defvar *connections* '())

(defconstant +port-number+ 6565)

(defvar +vd-type+ #(n s e w u d))  ; TODO: alexandria again

(defclass <room> () ((name :reader name)
                     (desc :reader desc)
                     (exits :reader exits)))
(defvar *rooms* '())

(defvar *write-rooms* nil)

(defconstant +command-type+ #(say help quit look
                              rooms make-room make-door teleport
                              n s e w
                              u d password shutdown))

(defconstant +name-prompt+ "Please enter your character name:")

(defconstant +rdb+ "room.tam")
(defconstant +adb+ "avatar.tam")

(defun first-substr (s)
  "Return the first substring of s (delimited by a space)."
  (block result-first-substr
    (do ((i 0 (+ i 1)))
        ((>= i (length s)) s)
      (if (char= (elt s i) #\space)
          (return-from result-first-substr (subseq s 0 i))))))

(defun rest-substr (s)
  "Return the second part of s."
  (block result-rest-substr
    (let ((b nil))
      (do ((i 0 (+ i 1)))
          ((>= i (length s)) "")
        (if (char= (elt s i) #\space)
            (setq b t)
            (if b
                (return-from result-rest-substr (subseq s i (length s)))))))))

(defun command (s)
  (block result-command
    (do ((i 0 (+ i 1)))
        ((>= i (length +command-type+)) 'say)
      (let ((c (elt +command-type+ i)))
        (if (string= s (symbol-name c))
            (return-from result-command c))))))

(defun format-name (c)
  (concatenate 'string +bold+ (name (avatar c)) +unbold+))

(defun say (c s)
  (if (g c)
      (format (socket c) "~A~%" s)))

(defun broadcast (s)
  (do ((cs *connections* (cdr cs)))
      ((null cs))
    (let ((c (car cs)))
      (say c s))))

(defun say (r s)
  (do ((cs *connections* (cdr cs)))
      ((null cs))
    (let ((c (car cs)))
      (if (eq (curr-room c) r)
          (say c s)))))

(defun look (c)
  (say c (concatenate 'string "Room: " (name (curr-room c))))
  (do ((ds (desc (curr-room c)) (cdr ds)))
      ((null ds))
    (let ((d (car ds)))
      (say c (line d))))
  (say c "")
  (say c "Exits:")
  (do ((i 0 (+ i 1)))
      ((>= i (length +vd-type+)))
    (let ((e (elt (exits (curr-room c)) i)))
      (if (not (null e))
          (say c (concatenate 'string " " (symbol-name (elt +vd-type+ i)) " " (name e))))))
  (say c "Avatars:")
  ())

;; TODO: Use the reader, for prototype at least?
;;       Can switch to postmodern for production.
(defun read-room-database ()
  (setq *rooms* '())
  (with-open-file (file +rdb+ :direction :input)
    (flet ((read-desc ()
             (let ((ls '()))
               (do ((l (read-line file) (read-line file)))
                   ((string= l ".") ls)
                 (setq ls (cons l ls)))))
           (skip-lines (n)
             (do ((i 0 (+ i 1)))
                 ((> i n))
               (read-line file))))
      (do ((name (read-line file nil nil))
           (desc (read-desc)))
          ((or (null name) (null desc)))
        (skip-lines (length +vd-type+))
        (let ((r (make-instance (find-class '<room>))))
          (setf (name r) name)
          (setf (desc r) desc)
          (setq *rooms* (cons r *rooms*))))
      (file-position file 0)
      ())))

(defmethod print-object ((obj <room>) stream)
  (flet ((write-desc (ds)
           (mapcar (lambda (l)
                     (format stream "~A~%" l))
                   ds))
         (write-exits (es)
           (do ((i 0 (+ i 1)))
               ((> i (length +vd-type+)))
             (if (null (elt es) i)
                 (format stream "nil~%")
                 (format stream "~A~%" (name (elt es i)))))))
    (format stream "~A~%" (name r))
    (write-desc (desc r))
    (format stream ".~%")
    (write-exits (exits r))))

(defun write-room-database ()
  (with-open-file (file +rdb+ :direction output)
    (mapcar (lambda (r) (print-object r file)) *rooms*))
  (setq *write-rooms* nil))

(defun read-avatar-database ()
  (setq *avatars* '())
  (with-open-file (file +adb+ :direction :input)
    (do ((name (read-line file nil nil))
         (password (read-line file nil nil)))
        ((or (null name) (null password)))
      (let ((a (make-instance (find-class '<avatar>))))
        (setf (name a) name)
        (setf (password a) password)
        (setq *avatars* (cons a *avatars*)))))
  (setq *write-avatars* nil))

(defmethod print-object ((obj <avatar>) stream)
  (format stream "~A~%~A~%" (name a) (password a)))

(defun write-avatar-database ()
  (with-open-file (file +adb+ :direction output)
    (mapcar (lambda (a) (print-object a file)) *avatars*)))

(defun main ()
  (read-avatar-database)
  (read-room-database)
  (while (not *terminate-program*)
         (check-for-inputs)))
(provide "ccap-muck")