Stability improvements of CLOG

This commit is contained in:
David Botton 2021-01-07 15:18:01 -05:00
parent 12ae791696
commit c596ad7ad4
3 changed files with 34 additions and 26 deletions

View file

@ -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 (:documentation "Set the ON-RESIZE-HANDLER for CLOG-OBJ. If ON-RESIZE-HANDLER
is nil unbind the event.")) is nil unbind the event."))
(defmethod set-on-resize ((obj clog-obj) on-resize-handler) (defmethod set-on-resize ((obj clog-obj) handler)
(let ((on-resize on-resize-handler)) (set-event obj "resize"
(set-event obj "resize" (when handler
(lambda (data) (lambda (data)
(declare (ignore data)) (declare (ignore data))
(funcall on-resize obj))))) (funcall handler obj)))))
;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;
;; set-on-focus ;; ;; 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 is nil unbind the event. Setting this event will replace an on-mouse click if
set.")) set."))
(defmethod set-on-click ((obj clog-obj) on-click-handler) (defmethod set-on-click ((obj clog-obj) handler)
(let ((on-click on-click-handler)) (set-event obj "click"
(set-event obj "click" (when handler
(lambda (data) (lambda (data)
(declare (ignore data)) (declare (ignore data))
(funcall on-click obj))))) (funcall handler obj)))))
;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;
;; set-on-double-click ;; ;; set-on-double-click ;;

View file

@ -169,7 +169,10 @@ the default answer. (Private)"
id (first em) (second em))) id (first em) (second em)))
(bordeaux-threads:make-thread (bordeaux-threads:make-thread
(lambda () (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 (t
(when *verbose-output* (when *verbose-output*
(format t "~A ~A = ~A~%" id (first ml) (second ml))) (format t "~A ~A = ~A~%" id (first ml) (second ml)))

View file

@ -7,8 +7,7 @@
(defun on-click (obj) (defun on-click (obj)
(setf (text obj) "DEAD") (setf (text obj) "DEAD")
(setf (connection-data-item obj "done") t) (setf (connection-data-item obj "done") t)
(set-on-click obj nil) (set-on-click obj nil))
)
(defun on-new-window (body) (defun on-new-window (body)
(handler-case ; Disconnects from the browser can be handled gracefully using the condition system. (handler-case ; Disconnects from the browser can be handled gracefully using the condition system.
@ -17,24 +16,29 @@
(setf (hiddenp (prog1 (setf (hiddenp (prog1
(create-child body "<h2>KILL Darth's Tie Fighter - Click on it!</h2>") (create-child body "<h2>KILL Darth's Tie Fighter - Click on it!</h2>")
(sleep 2))) t) (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)))
(let* ((mover (create-child body "<div>(-o-)</div>"))
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) (setf (positioning mover) :fixed)
(set-on-click mover #'on-click) (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 (loop
(unless (validp body)
(return))
(when (connection-data-item body "done") (when (connection-data-item body "done")
(return)) (return))
@ -59,8 +63,9 @@
(setf mover-y bounds-y)) (setf mover-y bounds-y))
(sleep .02))) (sleep .02)))
) (error () (format t "GAME OVER"))
(format t "Lost connection.~&")))) (error (c)
(format t "Lost connection.~%~%~A" c))))
(defun start-tutorial () (defun start-tutorial ()
"Start turtorial." "Start turtorial."