07-tutorial.lisp

(defpackage #:clog-tut-7
  (:use #:cl #:clog)
  (:export start-tutorial))

(in-package :clog-tut-7)

(defun on-click (obj)
  (setf (text obj) "DEAD")
  (setf (connection-data-item obj "done") t)
  (set-on-click obj nil))

(defun on-new-window (body)
  (handler-case   ; Disconnects from the browser can be handled gracefully using the condition system.
      (progn
        (format t "Starting Game~%")
        (setf (title (html-document body)) "Tutorial 07")
        ;; Show a "splash" screen
        (setf (hiddenp (prog1
                           (create-section body :h2
                                           :content "KILL Darth's Tie Fighter - Click on it!")
                         (sleep 2))) t)
        ;; Setup main game
        (let* ((mover (create-div body :content "(-o-)"))
               bounds-x bounds-y mover-x mover-y)
          (flet ((set-bounds ()
                   (setf bounds-x (width (window body)))
                   (setf bounds-y (height (window body)))))
            (set-bounds)
            (setf mover-x (random bounds-x))
            (setf mover-y (random bounds-y))
            ;; Capture browser size changes to adjust playing field
            (set-on-resize (window body)
                           (lambda (obj)
                             (declare (ignore obj))
                             (set-bounds))))
          ;; Setup our "mover". Darth
          (setf (positioning mover) :fixed)
          (set-on-click mover 'on-click)
          ;; Get Darth moving!
          (bordeaux-threads:make-thread    ; In addtion to the main task (the on-new-window)
           (lambda ()                      ; and the task created for each event like clicks
             (loop                         ; threads can be created as needed and used with
                   (unless (validp body)   ; CLOG.
                     (return))
                   (when (connection-data-item body "done")
                    (return))

                   (sleep .5)
                   (setf (text mover) ")-o-(")
                   (sleep .2)
                   (setf (text mover) "(-o-)"))
             (setf (inner-html mover) "<H1>GAME OVER</H1>"))
           :name "Darth event loop")
          ;; Check of browser still connected while running game loop
          (loop
            (unless (validp body)
              (return))
            (when (connection-data-item body "done")
              (return))
            (setf (top mover) (unit :px mover-y))
            (setf (left mover) (unit :px mover-x))
            (if (= (random 2) 0)
                (incf mover-y (random 10))
                (decf mover-y (random 10)))
            (if (= (random 2) 0)
                (incf mover-x (random 10))
                (decf mover-x (random 10)))
            (when (< mover-x 0)
              (setf mover-x 0))
            (when (> mover-x bounds-x)
              (setf mover-x bounds-x))
            (when (< mover-y 0)
              (setf mover-y 0))
            (when (> mover-y bounds-y)
              (setf mover-y bounds-y))
            (sleep .02)))
        (format t "Normal Disconnect~%"))
    (error (c)
      (format t "Lost connection.~%~%~A" c))))

(defun start-tutorial ()
  "Start tutorial."
  (initialize 'on-new-window)
  (open-browser))