mirror of
https://github.com/rabbibotton/clog.git
synced 2026-01-04 00:02:57 -08:00
Stability improvements of CLOG
This commit is contained in:
parent
12ae791696
commit
c596ad7ad4
3 changed files with 34 additions and 26 deletions
|
|
@ -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 ;;
|
||||||
|
|
|
||||||
|
|
@ -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)))
|
||||||
|
|
|
||||||
|
|
@ -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."
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue