diff --git a/clog-base.lisp b/clog-base.lisp index b07eed4..d863004 100644 --- a/clog-base.lisp +++ b/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)) - (set-event obj "resize" +(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)) - (set-event obj "click" +(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 ;; diff --git a/clog-connection.lisp b/clog-connection.lisp index 4781e3f..1f96253 100644 --- a/clog-connection.lisp +++ b/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))) diff --git a/tutorial/07-tutorial.lisp b/tutorial/07-tutorial.lisp index fdcfd38..91ca0bc 100644 --- a/tutorial/07-tutorial.lisp +++ b/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. @@ -17,24 +16,29 @@ (setf (hiddenp (prog1 (create-child body "

KILL Darth's Tie Fighter - Click on it!

") - (sleep 2))) t) - - (let* ((mover (create-child body "
(-o-)
")) - (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))) + (sleep 2))) t) + (let* ((mover (create-child body "
(-o-)
")) + bounds-x bounds-y mover-x mover-y) + + (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)) + (set-bounds)))) + (setf (positioning mover) :fixed) (set-on-click mover #'on-click) - (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)))) - (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."