Stability improvements of CLOG

clog-base.lisp

@@ -324,12 +324,12 @@ are stored in this string based hash in the format of:
   (:documentation "Set the ON-RESIZE-HANDLER for CLOG-OBJ. If ON-RESIZE-HANDLER
 is nil unbind the event."))
 
-(defmethod set-on-resize ((obj clog-obj) on-resize-handler)
-  (let ((on-resize on-resize-handler))
+(defmethod set-on-resize ((obj clog-obj) handler)
   (set-event obj "resize"
+	     (when handler
 	       (lambda (data)
 		 (declare (ignore data))
-		 (funcall on-resize obj)))))
+		 (funcall handler obj)))))
 
 ;;;;;;;;;;;;;;;;;;
 ;; set-on-focus ;;
@@ -493,12 +493,12 @@ on-mouse-right-click will replace this handler."))
 is nil unbind the event. Setting this event will replace an on-mouse click if
 set."))
 
-(defmethod set-on-click ((obj clog-obj) on-click-handler)
-  (let ((on-click on-click-handler))      
+(defmethod set-on-click ((obj clog-obj) handler)
   (set-event obj "click"
+	     (when handler
 	       (lambda (data)
 		 (declare (ignore data))
-		 (funcall on-click obj)))))
+		 (funcall handler obj)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-double-click ;;

clog-connection.lisp

@@ -169,7 +169,10 @@ the default answer. (Private)"
 		       id (first em) (second em)))
 	     (bordeaux-threads:make-thread
 	      (lambda ()
-		(funcall (gethash (first em) (get-connection-data id)) (second em))))))
+		(let* ((event-hash (get-connection-data id))
+		       (event      (when event-hash
+				     (gethash (first em) event-hash))))
+		  (when event (funcall event (second em))))))))
 	  (t
 	   (when *verbose-output*
 	     (format t "~A ~A = ~A~%" id (first ml) (second ml)))

tutorial/07-tutorial.lisp

@@ -7,8 +7,7 @@
 (defun on-click (obj)
   (setf (text obj) "DEAD")
   (setf (connection-data-item obj "done") t)
-  (set-on-click obj nil)
-)
+  (set-on-click obj nil))
 
 (defun on-new-window (body)
   (handler-case   ; Disconnects from the browser can be handled gracefully using the condition system.
@@ -20,21 +19,26 @@
 			 (sleep 2))) t)		 
 
 	(let* ((mover (create-child body "<div>(-o-)</div>"))
-	       (bounds-x (parse-integer (width (window body)) :junk-allowed t))
-	       (bounds-y (parse-integer (height (window body)) :junk-allowed t))
-	       (mover-x (random bounds-x))
-	       (mover-y (random bounds-y)))
+	       bounds-x bounds-y mover-x mover-y)
 	  
-	  (setf (positioning mover) :fixed)
-	  (set-on-click mover #'on-click)
+	  (flet ((set-bounds ()
+		   (setf bounds-x (parse-integer (width (window body)) :junk-allowed t))
+		   (setf bounds-y (parse-integer (height (window body)) :junk-allowed t))))
+	    (set-bounds)
+	    (setf mover-x (random bounds-x))
+	    (setf mover-y (random bounds-y))
 	    
 	    (set-on-resize (window body)
 			   (lambda (obj)
 			     (declare (ignore obj))
-			   (setf bounds-x (parse-integer (width (window body)) :junk-allowed t))
-			   (setf bounds-y (parse-integer (height (window body)) :junk-allowed t))))
+			     (set-bounds))))
+	  
+	  (setf (positioning mover) :fixed)
+	  (set-on-click mover #'on-click)
 	  
 	  (loop
+	    (unless (validp body)
+	      (return))
 	    (when (connection-data-item body "done")
 	      (return))
 	    
@@ -59,8 +63,9 @@
 	      (setf mover-y bounds-y))
 	    
 	    (sleep .02)))
-	) (error ()
-	    (format t "Lost connection.~&"))))
+	(format t "GAME OVER"))
+    (error (c)
+      (format t "Lost connection.~%~%~A" c))))
 
 (defun start-tutorial ()
   "Start turtorial."