lisp: improvements and fixes

craftd.conf.dist.in

@@ -103,6 +103,8 @@ server: {
 
                 options: [];
 
+                shell: false;
+
                 scripts: ["joined"];
             },
 

plugins/survival/base/main.c

@@ -217,6 +217,8 @@ CD_PluginInitialize (CDPlugin* self)
     CD_EventRegister(self->server, "Client.kick", cdsurvival_ClientKick);
     CD_EventRegister(self->server, "Client.disconnect", (CDEventCallbackFunction) cdsurvival_ClientDisconnect);
 
+    CD_EventProvides(self->server, "Player.login", CD_CreateEventParameters("SVPlayer", "bool", NULL));
+
     return true;
 }
 

scripting/lisp/helpers.c

@@ -23,6 +23,8 @@
  * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
+#include <craftd/protocols/survival.h>
+
 static inline
 cl_object
 cdcl_str (const char* string)
@@ -55,13 +57,27 @@ cdcl_eval (const char* format, ...)
     CDString* code   = CD_CreateStringFromFormatList(format, ap);
     cl_object form   = c_string_to_object((char*) CD_StringContent(code));
     cl_object result = Cnil;
+    cl_object error  = cl_gensym(0);
+
+    #ifndef NDEBUG
+    printf("LISP: %s\n", CD_StringContent(code));
+    #endif
 
     if (form == OBJNULL) {
         errno = EILSEQ;
     }
     else {
         CL_CATCH_ALL_BEGIN(ecl_process_env()) {
+            #ifdef NDEBUG
+            result = cl_safe_eval(form, Cnil, error);
+            #else
             result = cl_eval(form);
+            #endif
+
+            if (result == error) {
+                errno  = EILSEQ;
+                result = Cnil;
+            }
         } CL_CATCH_ALL_IF_CAUGHT {
             errno = EILSEQ;
         } CL_CATCH_ALL_END;
@@ -128,9 +144,19 @@ cdcl_MakeParameters (CDList* parameters, va_list args)
     CD_LIST_FOREACH(parameters, it) {
         const char* type = (const char*) CD_ListIteratorValue(it);
 
-        if (CD_CStringIsEqual(type, "CDClient")) {
+        if (CD_CStringIsEqual(type, "bool")) {
+            code = CD_AppendStringAndClean(code, CD_CreateStringFromFormat(
+            " (not (= %d 0))", va_arg(args, int)));
+        }
+        else if (CD_CStringIsEqual(type, "CDClient")) {
+            code = CD_AppendStringAndClean(code, CD_CreateStringFromFormat(
+                " (craftd:wrap (uffi:make-pointer %ld 'craftd::client) 'craftd::client)",
+                (CDPointer) va_arg(args, void*)));
+        }
+        else if (CD_CStringIsEqual(type, "SVPlayer")) {
             code = CD_AppendStringAndClean(code, CD_CreateStringFromFormat(
-                "(craftd:wrap (uffi:make-pointer %ld 'craftd::client) 'craftd::client) ", (CDPointer) va_arg(args, void*)));
+                " (craftd:wrap (uffi:make-pointer %ld 'craftd::player) 'craftd::player)",
+                (CDPointer) va_arg(args, void*)));
         }
         else {
             CD_DestroyString(code);

scripting/lisp/lib/client.lisp

@@ -11,4 +11,4 @@
     (jobs    :char))
 
 (defun client-ip (client)
-  (uffi:convert-from-foreign-string (get-wrapped-slot client 'ip)))
+  (uffi:convert-from-foreign-string (get-wrapped-value client 'ip)))

scripting/lisp/lib/dynamic.lisp

@@ -13,12 +13,12 @@
 
 (defun dynamic-get (object name)
   (uffi:with-cstring (c-name name)
-    (c-hash-get (get-wrapped-slot object 'dynamic) name)))
+    (c-hash-get (get-wrapped-value object 'dynamic) name)))
 
 (defun dynamic-set (object name value)
   (uffi:with-cstring (c-name name)
-    (c-hash-set (get-wrapped-slot object 'dynamic) name value)))
+    (c-hash-set (get-wrapped-value object 'dynamic) name value)))
 
 (defun dynamic-delete (object name)
   (uffi:with-cstring (c-name name)
-    (c-hash-delete (get-wrapped-slot object 'dynamic) name)))
+    (c-hash-delete (get-wrapped-value object 'dynamic) name)))

scripting/lisp/lib/minecraft.lisp

@@ -32,3 +32,5 @@
     (id       entity-id)
     (type     entity-type)
     (position precise-position))
+
+(uffi:def-foreign-type error-type :int)

scripting/lisp/lib/player.lisp

@@ -1,6 +1,6 @@
 (in-package craftd)
 
-(export '(player-ip))
+(export '(player-ip player-username))
 
 (uffi:def-struct player
     (entity entity)
@@ -17,5 +17,7 @@
     (error   error-type))
 
 (defun player-ip (player)
-  (let ((player (wrap player 'player)))
-      (client-ip (get-wrapped-slot player 'client))))
+  (client-ip (wrap (get-wrapped-value player 'client) 'client)))
+
+(defun player-username (player)
+  (string-content (get-wrapped-value player 'username)))

scripting/lisp/lib/string.lisp

@@ -2,18 +2,31 @@
 
 (export '(create-string destroy-string string-content))
 
-(uffi:def-struct string (length :int))
+(uffi:def-function ("CD_CreateStringFromCStringCopy" c-create-string) ((data :cstring))
+    :returning (* :void))
 
-(uffi:def-function ("CD_CreateStringFromCStringCopy" c-create-string) ((data (* :char)))
-    :returning :pointer)
+(uffi:def-function ("CD_DestroyString" c-destroy-string) ((self (* :void))))
 
-(uffi:def-function ("CD_DestroyString" c-destroy-string) ((self :pointer)))
+(uffi:def-function ("CD_StringContent" c-string-content) ((self (* :void)))
+    :returning :cstring)
 
-(uffi:def-function ("CD_StringContent" c-string-content) ((self :pointer))
-    :returning (* :char))
+(uffi:def-function ("CD_StringLength" c-string-length) ((self (* :void)))
+  :returning :int)
 
-(defun create-string (data) (c-create-string data))
+(uffi:def-function ("CD_StringSize" c-string-size) ((self (* :void)))
+  :returning :int)
 
-(defun destroy-string (self) (c-destroy-string self))
+(defun create-string (data)
+  (c-create-string data))
 
-(defun string-content (self) (c-string-content self))
+(defun destroy-string (self)
+  (c-destroy-string self))
+
+(defun string-content (self)
+  (uffi:convert-from-cstring (c-string-content self)))
+
+(defun string-length (self)
+  (c-string-length self))
+
+(defun string-size (self)
+  (c-string-size self))

scripting/lisp/lib/wrap.lisp

@@ -1,6 +1,6 @@
 (in-package craftd)
 
-(export '(wrap get-wrapped-slot))
+(export '(wrap get-wrapped-value get-wrapped-pointer))
 
 (defun wrap (object struct)
   (if (equal (type-of object) 'cons)
@@ -10,5 +10,8 @@
 (defun get-wrapped-object (object)
   (first object))
 
-(defun get-wrapped-slot (object attribute)
+(defun get-wrapped-value (object attribute)
   (uffi:get-slot-value (first object) (second object) attribute))
+
+(defun get-wrapped-pointer (object attribute)
+  (uffi:get-slot-pointer (first object) (second object) attribute))

scripting/lisp/main.c

@@ -44,15 +44,15 @@ cdcl_EventDispatcher (CDServer* server, const char* event, va_list args)
         return true;
     }
 
-    CDMap* threads = (CDMap*) CD_DynamicGet(server, "LISP.threads");
+    CDList* threads = (CDList*) CD_DynamicGet(server, "LISP.threads");
 
-    if (!CD_MapHasKey(threads, pthread_self())) {
-        CD_MapPut(threads, pthread_self(), true);
+    if (!CD_ListContains(threads, pthread_self())) {
+        CD_ListPush(threads, pthread_self());
 
         ecl_import_current_thread(Cnil, Cnil);
     }
 
-    cdcl_eval("(craftd:fire :%s %s)", event, CD_StringContent(parameters));
+    cdcl_eval("(craftd:fire :%s%s)", event, CD_StringContent(parameters));
 
     CD_DestroyString(parameters);
 
@@ -65,7 +65,7 @@ CD_ScriptingEngineInitialize (CDScriptingEngine* self)
 {
     self->description = CD_CreateStringFromCString("Common LISP scripting");
 
-    CD_DynamicPut(self->server, "LISP.threads", (CDPointer) CD_CreateMap());
+    CD_DynamicPut(self->server, "LISP.threads", (CDPointer) CD_CreateList());
 
     int          argc = 1;
     const char** argv = CD_malloc(sizeof(char*));
@@ -100,7 +100,7 @@ CD_ScriptingEngineInitialize (CDScriptingEngine* self)
         }
         else {
             char tmp[FILENAME_MAX];
-            
+
             if (getcwd(tmp, FILENAME_MAX)) {
                 path = CD_PrependCString(path, "/");
                 path = CD_PrependCString(path, tmp);
@@ -129,14 +129,18 @@ CD_ScriptingEngineInitialize (CDScriptingEngine* self)
         return false;
     }
 
-    cdcl_eval("(defparameter craftd::*server* (uffi:make-pointer %ld :void))", (CDPointer) self->server);
+    cdcl_eval("(defparameter craftd::*server* (uffi:make-pointer %ld 'craftd::server))", (CDPointer) self->server);
 
     C_FOREACH(script, C_PATH(self->config, "scripts")) {
         cdcl_eval("(asdf:load-system \"%s\")", C_TO_STRING(script));
     }
 
     CD_EventRegister(self->server, "Event.dispatch:before", cdcl_EventDispatcher);
 
+    if (C_TO_BOOL(C_PATH(self->config, "shell"))) {
+        cdcl_eval("ashella");
+    }
+
     return true;
 }
 
@@ -146,6 +150,8 @@ CD_ScriptingEngineFinalize (CDScriptingEngine* self)
 {
     CD_EventUnregister(self->server, "Event.dispatch:before", cdcl_EventDispatcher);
 
+    CD_DestroyList((CDList*) CD_DynamicDelete(self->server, "LISP.threads"));
+
     cl_shutdown();
 
     return true;

scripting/lisp/scripts/joined.asd

@@ -1,8 +1,8 @@
 (defsystem :joined
   :version "0.1")
 
-(craftd:register :Server.start! #'(lambda ()
-  (format t "Server ~a started ;)~%" (craftd:server-name))))
-
 (craftd:register :Client.connect #'(lambda (client)
-  (format t "Client ~a connected :>~%" (craftd:client-ip client))))
+  (format t "~a connected~%" (craftd:client-ip client))))
+
+(craftd:register :Player.login #'(lambda (player status)
+  (format t "~a joined the game~%" (craftd:player-username player))))