;;; -*-LISP-*-
;;;
;;; Copyright (C) 2003 Donald Fisk
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
;;; USA

;;; To run, load this file and call (jumpingBox).   To exit, click
;;; on the exit button.
;;; Each time you click on the box, your score increases by 1.
;;; Each time you miss, your score is reset to 0.

;;; This version takes advantage of improvements to the threading mechanism
;;; made since the 010 release of Emblem.

(defclass JumpingBox (Rectangle Agent))

(defun jumpingBox ()
  (let ((canvas (new 'Canvas 'title "Jumping Box")))
    (let ((scoreboard (new 'Text
			   'canvas canvas 'x 20 'y 20 'color BLUE
			   'string "0 hits!"
			   'font (makeFont 'helvetica 'medium 'r 20)))
	  (score 0)
	  (jb (new 'JumpingBox
		   'canvas canvas 'x 50 'y 50 'width 40 'height 40 'color RED))
	  (exitButton (new 'Button
			   'canvas canvas 'x 350 'y 5 'width 40 'height 20
			   'label "Exit")))
      (setBehavior canvas LEFT_CLICK_EVENT
		   (lambda ((c Canvas) (event Array))
		     (setf score 0)
		     (setf (getString scoreboard) (concat score " hits!"))))
      (setBehavior jb LEFT_CLICK_EVENT
		   (lambda ((jb JumpingBox) (event Array))
		     (setf score (add1 score))
		     (setf (getString scoreboard) (concat score " hits!"))))
      (setBehavior exitButton LEFT_CLICK_EVENT
		   (lambda ((b Button) (event Array))
		     (destroy canvas)
		     ;; We need to be able to check that canvas
		     ;; has been destroyed, so we set it to undefined (_).
		     (setq canvas _)))
      (do ((xRange (- (getWidth canvas) 40))
	   (yRange (- (getHeight canvas) 40)))
	  ((eq canvas _))		;Stop after canvas is destroyed.
	  (snoozeUntil (+ (getTime) (random 2.0)))
	  ;; Make sure it doesn't try to do anything on canvas if
	  ;; it's been destroyed.
	  (unless (eq canvas _)
	    (relocate jb (random xRange) (random yRange)))))))