about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorDarren Bane <dbane@tilde.institute>2020-05-09 07:46:43 -0400
committerDarren Bane <dbane@tilde.institute>2020-05-09 07:46:43 -0400
commit5eba13b70414e1a40ef2418978082c6e4ac37c19 (patch)
treeb8aa2703d575ba1ef573c198410991c80330d57b
parent8dc0f67a0d97f0c21fd039f348a73bac9f6f1afc (diff)
parenta124a431df948e6a1c8bd670a7ae0d65ec9fa2af (diff)
downloadlsp-5eba13b70414e1a40ef2418978082c6e4ac37c19.tar.gz
Merge branch 'master' of /home/dbane/public_repos/lsp
-rwxr-xr-xcrpg.lisp31
-rwxr-xr-xecho.lsp65
-rw-r--r--jsonrpc.el8
3 files changed, 89 insertions, 15 deletions
diff --git a/crpg.lisp b/crpg.lisp
index 23e87e4..7674b6b 100755
--- a/crpg.lisp
+++ b/crpg.lisp
@@ -63,15 +63,15 @@
   (make-instance (find-class c) 'n n 'v v))
 (defconstant +items+
   (vector
-   (create-item "apple" '<food> 1)
-   (create-item "bread" '<food> 2)
-   (create-item "chicken" '<food> 3)
-   (create-item "dagger" '<weapon> 2)
-   (create-item "sword" '<weapon> 3)
-   (create-item "halberd" '<weapon> 4)
-   (create-item "smoke" '<trap> 1)
+   (create-item "apple     " '<food> 1)
+   (create-item "bread     " '<food> 2)
+   (create-item "chicken   " '<food> 3)
+   (create-item "dagger    " '<weapon> 2)
+   (create-item "sword     " '<weapon> 3)
+   (create-item "halberd   " '<weapon> 4)
+   (create-item "smoke     " '<trap> 1)
    (create-item "noose trap" '<trap> 2)
-   (create-item "pit trap" '<trap> 3)))
+   (create-item "pit trap  " '<trap> 3)))
 (defgeneric copy (obj))
 (defmethod copy ((obj <monster>))
   (create-monster (name obj) (attack obj) (health obj)))
@@ -143,7 +143,7 @@
 		     (setf (health *the-player*) (- (health *the-player*) 1))))
 		   (my-print +press-key+)
 		   (read-line)))
-	   (cursor 10 1)
+	   (cursor 10 1) (clrtoeol)
 	   (if (> (health *the-player*) 0)
 	       (progn (clrtoeol)
 		      (my-print "You won the fight!")
@@ -223,15 +223,16 @@
    (clrtoeol)
    (let ((monster-type (monster (aref *map* (row *curr-coord*) (col *curr-coord*)))))
      (if (null monster-type)
-	 (progn (setq *curr-monster* nil)
-		(setq *monster-gold* 0))
-       (progn (setq *curr-monster* (copy (elt +monsters+ monster-type)))
-	      (format *standard-output* "Monster: ~A~%" *curr-monster*)
-	      (setq *monster-gold* (* monster-type (random 6))))))
+         (progn (setq *curr-monster* nil)
+                (format *standard-output* "Monster: nothing~%")
+                (setq *monster-gold* 0))
+         (progn (setq *curr-monster* (copy (elt +monsters+ monster-type)))
+                (format *standard-output* "Monster: ~A~%" *curr-monster*)
+                (setq *monster-gold* (* monster-type (random 6))))))
    (let ((item-type (item (aref *map* (row *curr-coord*) (col *curr-coord*)))))
      (if (null item-type)
 	 (progn (cursor 15 41)
-		(my-print "nothing"))
+		(my-print "nothing   "))
        (progn (setq *curr-item* (elt +items+ item-type))
 	      (cursor 15 41)
 	      (my-print (name *curr-item*))
diff --git a/echo.lsp b/echo.lsp
new file mode 100755
index 0000000..20b5e7e
--- /dev/null
+++ b/echo.lsp
@@ -0,0 +1,65 @@
+#!/home/dbane/openlisp-10.9.0/uxlisp -shell
+(require "json")
+(defpackage #:echo
+  (:use #:openlisp #:json)
+  (:export
+   #:echo-server)
+  )
+(in-package #:echo)
+(defconstant +content-length+ "Content-Length: ")
+(defconstant +cr+ (convert 13 <character>))
+(defun println (x s)
+   (format s "~A~%" x))
+(defun read-chars (len)
+   (let ((s nil))
+        (for ((chars-left len (- chars-left 1)))
+             ((= chars-left 0) (apply #'string-append (mapcar (lambda (c)
+                                                                 (create-string 1 c))
+                                                              (reverse s))))
+             (setq s (cons (read-char) s)))))
+(defun subtract-proc (l r)
+   (- l r))
+(defun dispatch (params)
+   (let ((jsonrpc-ver (json-get-object params "jsonrpc")))
+        (if (not (string= jsonrpc-ver "2.0"))
+            (error "Bad JSON-RPC version -- ~S" jsonrpc-ver)))
+   (case-using #'string= (json-get-object params "method")
+               (("subtract") (subtract-proc (json-get-object params "params/l") (json-get-object params "params/r")))
+               (("quit") (progn (quit)
+                                0))))
+(defun marshal (parsed-json)
+  (let ((str (create-string-output-stream))
+         (content-length (create-string-output-stream)))
+    (format str "{\"jsonrpc\":\"2.0\",\"result\":~A,\"id\":~A}" (dispatch parsed-json) (json-get-object parsed-json "id"))
+    (let ((json (get-output-stream-string str))
+           (s (standard-output)))
+      (format content-length "Content-Length: ~A" (length json))
+      (mapc (lambda (v) (println v s))
+        (list (get-output-stream-string content-length)
+          "Content-Type: application/vscode-jsonrpc; charset=utf-8"
+          ""))
+      (format s "~A" json))))
+(defun echo-server ()
+   ;; Server side (server addr : 127.0.0.1)
+   (with-server-socket (server 8192 "tcp")
+        (let ((fds (create-vector 16 ()))
+              (fdr (create-vector 16 ()))
+              (fdw (create-vector 16 ())))
+             (select-clear fds)
+             (select-add server fds)
+             (while (eq (select 1 fds fdr fdw () 5.0) 0)
+                    (print "Waiting ...."))
+             (let ((client (accept server)))
+                  ;; Talk with client using standard I/O.
+                  (with-standard-input client
+                     (with-standard-output client
+                          (while t
+                                 (let* ((line1 (read-line))
+                                        (tag-len (length +content-length+))
+                                        (content-length (convert (subseq line1 (- tag-len 1) (length line1)) <integer>)))
+                                       (read-line)
+                                       (marshal (json-parse (read-chars content-length)))))))
+                  (close client))
+             (select-remove server fds))))
+(provide "echo")
+(echo-server)
diff --git a/jsonrpc.el b/jsonrpc.el
new file mode 100644
index 0000000..394af1e
--- /dev/null
+++ b/jsonrpc.el
@@ -0,0 +1,8 @@
+(require 'jsonrpc)
+(defvar *conn* (make-instance 'jsonrpc-process-connection
+			      :process (lambda ()
+					 (open-network-stream
+					  "JSONRPC" nil
+					  "localhost" 8192))))
+(jsonrpc-request *conn* :subtract '(:l 42 :r 12))
+(jsonrpc-notify *conn* :quit '())