;;; -*- Mode:Common-Lisp; Package:NEKO; Base:10 -*-

;;; This is an implimentation of ONEKO for the TI Explorer.  I have
;;; designed it to run under the KSL tool set, however it should run in
;;; the normal Explorer environment by changing the value of
;;; *neko-window*.
;;;
;;; Important variables to look at:
;;; *neko-window* 
;;; *interval-time*
;;;
;;; Important functions:
;;; start-neko
;;; stop-neko

;;; Original program written by: Masayuki Koba
;;; Oneko modified by Tatsuya Kato (kato@ntts.co.jp)
;;; Converted for use on the Explorer by John Knutson
;;;   (johnk@ccwf.cc.utexas.edu)

;;; Apologies if this code is unreadable, my Japanese isn't very good.

(export '(neko:stop-neko neko:start-neko))

(defvar *neko-window* w:*background*
  "Window for the cat to run around on")

(defvar *neko-process* ()
  "Neko process")

(defvar *bitmap-width* 32
  "Width of the cat \"bitmap\" in pixels")

(defvar *bitmap-height* 32
  "Height of the cat \"bitmap\" in pixels")

(defvar *window-x-pos* (multiple-value-bind (x y)
			   (send *neko-window* :position)
			 x)
  "X position of window in world coordinates")

(defvar *window-y-pos* (multiple-value-bind (x y)
			   (send *neko-window* :position)
			 y)
  "Y position of window in world coordinates")

(defvar *window-left* (+ *window-x-pos* (tv:sheet-inside-left *neko-window*))
  "Inside left corner of window in world coordinates")

(defvar *window-right* (+ *window-x-pos*
			  (tv:sheet-inside-right *neko-window*))
    "Inside right corner of window in world coordinates")

(defvar *window-top* (+ *window-y-pos* (tv:sheet-inside-top *neko-window*))
    "Inside top corner of window in world coordinates")

(defvar *window-bottom* (+ *window-y-pos*
			   (tv:sheet-inside-bottom *neko-window*))
    "Inside bottom corner of window in world coordinates")

(defvar *max-tick* 9999
  "Limit on state-counter, must be odd")

;;; neko-states, whatever "state" the cat is in
(defvar *neko-stop* 0)
(defvar *neko-jare* 1)
(defvar *neko-kaki* 2)
(defvar *neko-akubi* 3)
(defvar *neko-sleep* 4)
(defvar *neko-awake* 5)
(defvar *neko-up-move* 6)
(defvar *neko-down-move* 7)
(defvar *neko-left-move* 8)
(defvar *neko-right-move* 9)
(defvar *neko-up-left-move* 10)
(defvar *neko-up-right-move* 11)
(defvar *neko-down-left-move* 12)
(defvar *neko-down-right-move* 13)
(defvar *neko-up-togi* 14)
(defvar *neko-down-togi* 15)
(defvar *neko-left-togi* 16)
(defvar *neko-right-togi* 17)

(defvar *pi-per-8* (/ pi 8.0d0))
(defvar *sin-pi-per-8-times-3* (sin (* *pi-per-8* 3.0d0)))
(defvar *sin-pi-per-8* (sin *pi-per-8*))

(defvar *font-char*
	#1a(16 16				;stop
	       9 16				;jare
	       10 11				;kaki
	       17 17				;akubi
	       22 23				;sleep
	       0 0				;awake
	       25 26				;up
	       1 2				;down
	       12 13				;left
	       18 19				;right
	       27 28				;up left
	       29 30				;up right
	       5 6				;down left
	       7 8				;down right
	       31 32				;up togi
	       3 4				;down togi
	       14 15				;left togi
	       20 21				;right togi
	       )
  "Array of font character numbers for the xneko font")

;;; cat's position
(defparameter *neko-x* (round (+ *window-left* *window-right*) 2))
(defparameter *neko-y* (round (+ *window-top* *window-bottom*) 2))

;;; cat's delta-position
(defparameter *neko-move-dx* 0)
(defparameter *neko-move-dy* 0)

;;; last known mouse position
(defparameter *prev-mouse-x* 0)
(defparameter *prev-mouse-y* 0)

;;; delay between moves in microseconds
(defparameter *interval-time* 125000)

;;; maximum number of pixels at a time the cat will move
(defparameter *neko-speed* 16)

;;; maximum times for various states
(defparameter *idle-space* 6)
(defparameter *neko-stop-time* 4)
(defparameter *neko-jare-time* 10)
(defparameter *neko-kaki-time* 4)
(defparameter *neko-akubi-time* 6)
(defparameter *neko-awake-time* 3)
(defparameter *neko-togi-time* 10)

(defparameter *neko-state* *neko-stop*
  "Current state of the cat")
(defparameter *neko-state-count* 0
  "Counter to determine pixmap for cat")
(defparameter *neko-tick-count* 0)

(sys:load-if "fonts;xneko")

(defparameter *bit-save* (w:make-bitmap (tv:font-char-width fonts:xneko)
					(tv:font-char-width fonts:xneko))
  "Bit-array used to allow for more or less clean movement over a background")

;;; position of the saved bitmap on the *neko-window*
(defparameter *bit-save-x* -1)
(defparameter *bit-save-y* -1)

(defun clean-up (win)
  "Restore the last grabbed bitmap to the specified window"
  (when (>= *bit-save-x* 0)
    (send win :bitblt tv:alu-seta (tv:font-char-width fonts:xneko)
	  (tv:font-char-width fonts:xneko) *bit-save* 0 0
	  *bit-save-x* *bit-save-y*)
    (send (w:sheet-get-screen win) :screen-manage)))

(defun draw (char-num x y win)
  "Draw the character CHAR-NUM in font FONTS:XNEKO at position X,Y on
window WIN"
  (when (>= *bit-save-x* 0)
    (send win :bitblt tv:alu-seta (tv:font-char-width fonts:xneko)
	  (tv:font-char-width fonts:xneko) *bit-save* 0 0
	  *bit-save-x* *bit-save-y*))
  ;; save the bit-array
  (send win :bitblt-from-sheet w:alu-seta
	(tv:font-char-width fonts:xneko) (tv:font-char-width fonts:xneko)
	x y *bit-save* 0 0)
  (setq *bit-save-x* x
	*bit-save-y* y)
  (tv:prepare-sheet (win)
    (sys:%draw-char fonts:xneko (code-char (logior 64 char-num)) x y
		    tv:alu-transp win)
    (sys:%draw-char fonts:xneko (code-char (logior 64 char-num)) x y
		    tv:alu-xor win)
    (sys:%draw-char fonts:xneko (code-char char-num) x y tv:alu-transp win)
    (send (w:sheet-get-screen win) :screen-manage)))

(defun interval (&aux t1)
  "Wait *interval-time* microseconds"
  (setq t1 (time:microsecond-time))
  (do ()
      ((>= (time:microsecond-time-difference (time:microsecond-time) t1)
	   *interval-time*))
    ()))

(defun tick-count ()
  (incf *neko-tick-count*)
  (when (>= *neko-tick-count* *max-tick*) (setq *neko-tick-count* 0))
  (if (zerop (mod *neko-tick-count* 2))
      (if (< *neko-state-count* *max-tick*)
	  (incf *neko-state-count*))))

(defun set-neko-state (set-value)
  "Change the neko-state and set the counters to 0"
  (setq *neko-tick-count* 0
	*neko-state-count* 0
	*neko-state* set-value)
  nil)

(defun neko-direction (&aux new-state large-x large-y length sin-theta)
  "Update the cat's state by looking at the current mouse-cursor
position"
  (cond ((and (zerop *neko-move-dx*) (zerop *neko-move-dy*))
	 (setq new-state *neko-stop*))
	(t
	 (setq large-x *neko-move-dx*
	       large-y (- *neko-move-dy*)
	       length (sqrt (+ (* large-x large-x) (* large-y large-y)))
	       sin-theta (/ large-y length))
	 (if (plusp *neko-move-dx*)
	     (cond ((> sin-theta *sin-pi-per-8-times-3*)
		    (setq new-state *neko-up-move*))
		   ((and (<= sin-theta *sin-pi-per-8-times-3*)
			 (> sin-theta *sin-pi-per-8*))
		    (setq new-state *neko-up-right-move*))
		   ((and (<= sin-theta *sin-pi-per-8*)
			 (> sin-theta (- *sin-pi-per-8*)))
		    (setq new-state *neko-right-move*))
		   ((and (<= sin-theta (- *sin-pi-per-8*))
			 (> sin-theta (- *sin-pi-per-8-times-3*)))
		    (setq new-state *neko-down-right-move*))
		   (t
		    (setq new-state *neko-down-move*)))
	     (cond ((> sin-theta *sin-pi-per-8-times-3*)
		    (setq new-state *neko-up-move*))
		   ((and (<= sin-theta *sin-pi-per-8-times-3*)
			 (> sin-theta *sin-pi-per-8*))
		    (setq new-state *neko-up-left-move*))
		   ((and (<= sin-theta *sin-pi-per-8*)
			 (> sin-theta (- *sin-pi-per-8*)))
		    (setq new-state *neko-left-move*))
		   ((and (<= sin-theta (- *sin-pi-per-8*))
			 (> sin-theta (- *sin-pi-per-8-times-3*)))
		    (setq new-state *neko-down-left-move*))
		   (t
		    (setq new-state *neko-down-move*))))))
  (unless (= *neko-state* new-state) (set-neko-state new-state)))

(defun neko-move-start ()
  "Return true if the cat should start chasing the mouse again"
  (if (and (and (>= *prev-mouse-x* (- sys:mouse-x *idle-space*))
		(<= *prev-mouse-x* (+ sys:mouse-x *idle-space*)))
	   (and (>= *prev-mouse-y* (- sys:mouse-y *idle-space*))
		(<= *prev-mouse-y* (+ sys:mouse-y *idle-space*))))
      nil
      t))

(defun compute-dx-dy (&aux large-x large-y dbl-length length)
  "Compute the change in position for the cat"
  (setq *prev-mouse-x* sys:mouse-x
	*prev-mouse-y* sys:mouse-y
	
	large-x (- sys:mouse-x *neko-x* (round *bitmap-width* 2))
	large-y (- sys:mouse-y *neko-y* *bitmap-height*)
	
	dbl-length (+ (* large-x large-x) (* large-y large-y)))

  (cond ((not (zerop dbl-length))
	 (setq length (isqrt dbl-length))
	 (if (<= length *neko-speed*)
	     (setq *neko-move-dx* large-x
		   *neko-move-dy* large-y)
	     (setq *neko-move-dx* (round (* *neko-speed* large-x) length)
		   *neko-move-dy* (round (* *neko-speed* large-y) length))))
	(t
	 (setq *neko-move-dx* 0
	       *neko-move-dy* 0))))

(defun neko-think-draw ()
  "Draw the cat, etc"

  (compute-dx-dy)

  (if (/= *neko-state* *neko-sleep*)
      (draw (aref *font-char* (+ (* 2 *neko-state*)
				 (logand *neko-tick-count* #x1)))
	    *neko-x* *neko-y* *neko-window*)
      (draw (aref *font-char* (+ (* 2 *neko-state*)
				 (logand (lsh *neko-tick-count* -2) #x1)))
	    *neko-x* *neko-y* *neko-window*))

  (tick-count)

  (select *neko-state*
    (*neko-stop* (cond ((neko-move-start)
			(set-neko-state *neko-awake*))
		       ((< *neko-state-count* *neko-stop-time*)
			nil)
		       ((and (minusp *neko-move-dx*)
			     (<= *neko-x* (+ *window-left* *bitmap-width*)))
			(set-neko-state *neko-left-togi*))
		       ((and (plusp *neko-move-dx*)
			     (>= *neko-x* (- *window-right* *bitmap-width*)))
			(set-neko-state *neko-right-togi*))
		       ((and (minusp *neko-move-dy*)
			     (<= *neko-y* (+ *window-top* *bitmap-height*)))
			(set-neko-state *neko-up-togi*))
		       ((and (plusp *neko-move-dy*)
			     (>= *neko-y*
				 (- *window-bottom* *bitmap-height*)))
			(set-neko-state *neko-down-togi*))
		       (t (set-neko-state *neko-jare*))))
    (*neko-jare* (cond ((neko-move-start)
			(set-neko-state *neko-awake*))
		       ((< *neko-state-count* *neko-jare-time*) ())
		       (t (set-neko-state *neko-kaki*))))
    (*neko-kaki* (cond ((neko-move-start)
			(set-neko-state *neko-awake*))
		       ((< *neko-state-count* *neko-kaki-time*) ())
		       (t (set-neko-state *neko-akubi*))))
    (*neko-akubi* (cond ((neko-move-start)
			 (set-neko-state *neko-awake*))
			((< *neko-state-count* *neko-akubi-time*) ())
			(t (set-neko-state *neko-sleep*))))
    (*neko-sleep* (if (neko-move-start)
		      (set-neko-state *neko-awake*)))
    (*neko-awake* (if (< *neko-state-count* *neko-awake-time*)
		      ()
		      (neko-direction)))
    ((*neko-up-move* *neko-down-move* *neko-left-move* *neko-right-move*
      *neko-up-left-move* *neko-up-right-move* *neko-down-left-move*
      *neko-down-right-move*)
     (incf *neko-x* *neko-move-dx*)
     (incf *neko-y* *neko-move-dy*)
     (neko-direction))
    ((*neko-up-togi* *neko-down-togi* *neko-left-togi* *neko-right-togi*)
     (cond ((neko-move-start)
	    (set-neko-state *neko-awake*))
	   ((< *neko-state-count* *neko-togi-time*) ())
	   (t (set-neko-state *neko-kaki*))))
    (t (set-neko-state *neko-stop*)
       (send *neko-window* :beep)))
  (interval))

(defun process-neko ()
  "Process to be run to control the cat"

  (setq *neko-x* (- (round (+ *window-left* *window-right*) 2)
		    (round *bitmap-width* 2))
	*neko-y* (- (round (+ *window-top* *window-bottom*) 2)
		    (round *bitmap-height* 2))
	*bit-save-x* -1
	*bit-save-y* -1)

  (set-neko-state *neko-stop*)
  
  (do-forever
    (neko-think-draw)))

(defun start-neko (&key (priority -1))
  "Start the Neko process running in background with the specified priority"
  (when (null *neko-process*) 
    (setq *neko-process*
	  (process-run-function (list :name "Neko" :priority priority)
				'process-neko)))
  nil)

(defun stop-neko ()
  "Kill the Neko process and clean up the window"
  (send *neko-process* :kill t)
  (clean-up *neko-window*))