;;-*- Mode:Common-Lisp; Package:MACTOOLBOX; Base:10; Fonts:(COURIER medfnb Medfnb) -*-

;Ï1;; For the puposes of the Texas Instruments/ ExperTelligence Contract, thisÏ*
;Ï1;; software is in TBI Category "A".Ï*

;Ï1/*                                                                       */Ï*
;Ï1/*                      RESTRICTED RIGHTS LEGEND                         */Ï*
;Ï1/*                                                                       */Ï*
;Ï1/* Use, duplication, or disclosure by the Government is subject to       */Ï*
;Ï1/* restrictions as set forth in subdivision (c)(1)(ii) of the Rights in  */Ï*
;Ï1/* Technical Data and Computer Software clause at 52.227-7013.           */Ï*
;Ï1/*                                                                       */Ï*
;Ï1/*                    TEXAS INSTRUMENTS INCORPORATED.                    */Ï*
;Ï1/*                            P.O. BOX 2909                              */Ï*
;Ï1/*                         AUSTIN, TEXAS 78769                           */Ï*
;Ï1/*                              MS 2151                                  */Ï*
;Ï1/*                                                                       */Ï*
;Ï1/*  Copyright (C) 1988, 1987, Texas Instruments Incorporated.            */Ï*
;Ï1/*  All rights reserved.                                                 */Ï*
;Ï1/*                                                                       */Ï*


;Ï1;;                              Toolbox-interface Qix. Ï*
;Ï1;;Ï*
;Ï1;; This is a version of the Explorer program Qix that has been modified to runÏ*
;Ï1;; through the toolbox interface instead of the Explorer window system. The mainÏ*
;Ï1;; modification to qix itself was removing the calls to %draw-line and adding callsÏ*
;Ï1;; to the appropriate QuickDrawing functions. This code also uses the menu bar andÏ*
;Ï1;; handles events.Ï*
;Ï1;;Ï*
;Ï1;; To compile and run this program:Ï*
;Ï1;;
;;; 1) Ensure that the Color-Qix application is under a :microExp folder in your system.
;;;    If it is not present you can create it by using MPW to make the color-qix
;;;    application in :microexp:macsys:toolbox-interface:sample-applications:.
;;; 2) Compile this buffer.Ï*
;Ï1;; 3) Launch the application by:Ï*
;Ï1;;    a) Double clicking on the icon for color-qix.  orÏ*
;Ï1;;    b) executing the form (launch-mac-application 'color-qix)Ï*
;Ï1;; 4) Quit color-qix by selecting the quit entry on the file menu or clicking in the go-away box.Ï*
;Ï1;;Ï*
;Ï1;; Notes:Ï*


;Ï1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Ï*
;Ï1;;Ï*
;Ï1;;  Variable definitionsÏ*
;Ï1;;Ï*
;Ï1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Ï*

(defvar qix-list nil)
(defvar qix-list-length nil)
(defvar *AppleMenu* nil)
(defvar *FileMenu* nil)
(defvar *ColorMenu* nil)
(defvar *ct* nil)
(defvar *restart* nil)
(defvar *done* nil)
(defvar *event* nil)
(defvar *screenrect* nil)
(defvar *maxrect* nil)
(defvar *event-mask* -1 "Ï2The event mask used by event-handler.Ï*")
(defvar *current-color* nil)


;Ï1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Ï*
;Ï1;;Ï*
;Ï1;;  Color qix definitionÏ*
;Ï1;;Ï*
;Ï1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Ï*


(define-mac-application color-qix (&optional length)
			(:lisp-function 'tb:tb-qix
					:server-name "color-qix"))

;Ï1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Ï*
;Ï1;;Ï*
;Ï1;; InitializationÏ*
;Ï1;;Ï*
;Ï1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Ï*

(defun InitilizeVars (&aux gp ch)
  (setq *restart* nil)
  (setq *done* nil)
  (setq *event* (make-instance 'tb:eventRecord))
  (!flushevents -1 0)
  (setq *current-color*  (make-instance 'tb:rgbcolor))
  
  ;Ï1; Find the screenbytes.bounds by getting the grafport of the entire Mac screenÏ*
  ;Ï1; and asking for its portrect then set the left & top to below menubarÏ*
  (setq gp (make-instance 'tb:cgrafport))   
  (setf gp (GetPort))
  (send gp :portrecttop 23)             
  (send gp :portrectleft 3)    
  (setq *screenrect* (make-instance 'rect))
  (send *screenrect* :set (send gp :portrect))
  
  (setq *maxrect* (make-instance 'rect))
  (send *maxrect* :set-left 100)		       ;Ï1minimum horizontal on a windowÏ*
  (send *maxrect* :set-top 40)			       ;Ï1minimum vertical on a windowÏ*
  (send *maxrect* :set-right (send gp :portrectright)) ;Ï1max horizÏ*
  (send *maxrect* :set-bottom (send gp :portrectbottom))       ;Ï1max vertÏ*
  (setq ch (getresource "wctb" 20))
  (setq *ct* (make-instance-no-init 'tb:winctab))
  (send *ct* :set-handle (send ch :handle)))


;Ï1;Makes a menuÏ*
(defun menu-create (ID title data &aux newMenu)
  (setq newMenu (make-instance 'tb:menuinfo))
  (send newmenu :set-handle (send (!NewMenu ID title) :handle))
  (!AppendMenu newMenu data)
  (!InsertMenu newMenu 0)
  newMenu)

;Ï1;This sets up the menubar for Shell application.Ï*
(defun setupmenubar ()
  
  (!ClearMenuBar)

  ;Ï1; Create the Apple menu and add the desk Accessories to it.Ï*
  (setq *AppleMenu* (Menu-Create 10 (string (character 20)) "About Qix...;(-"))
  (!AddResMenu *AppleMenu* "DRVR")

  ;Ï1; Create the file menu.Ï*
  (setq *FileMenu* (Menu-Create 13 "File" "Quit Qix"))

  ;Ï1; Create the color menuÏ*
  (setq *ColorMenu* (Menu-Create 15 "Color" "Content;Frame;Text;Hilite;Title;Line"))
  
  (!DrawMenuBar))


;Ï1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Ï*
;Ï1;;Ï*
;Ï1;; Event HandlingÏ*
;Ï1;;Ï*
;Ï1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Ï*


(defun event-handler ()
  (when (!WaitNextEvent *event-mask* *event* 0 nilRgn)
    (let ((what (send *event* :what)))
      (cond
	;Ï1; Mouse down Ï*
	((= what 1)
	 (mousedownhandler))
	
	;Ï1; Mouse upÏ*
	((= what 2) nil)
	
	;Ï1; Key downÏ*
	((= what 3)
	 (!SysBeep 1))
	
	;Ï1; Key upÏ*
	((= what 4) nil)
	
	;Ï1; AutoKeyÏ*
	((= what 5) nil)
	
	;Ï1; UpdateÏ*
	((= what 6)
	 ;Ï1; Since we are drawing directly into the window just clear it and start over.Ï*
	 (let ((window (make-instance-no-init 'window)))

	   ;Ï1; This is a crock. We need to be able to pass an int or mac-pointer as a window also.Ï*
	   (send window :eval-inside-yourself `(setf pointer (send ,*event* :message)))
	   
	   (!BeginUpdate window)
	   (!eraserect  (send window :portrect))
	   (setf *restart* t)
	   (!EndUpdate window)))
	
	;Ï1; Disk InsertionÏ*
	((= what 7) nil)
	
	;Ï1; ActivateÏ*
	((= what 8) nil)
	
	;Ï1; NetworkÏ*
	((= what 10) nil)
	
	;Ï1; ioDriverÏ*
	((= what 11) nil)))))

;Ï1; When a mouse click occursÏ*
(defun mouseDownHandler (&aux partcode win theH theV)

  ;Ï1; Find out what part of the window the user clicked in.Ï*
  (setf (values partcode win) (FindWindow *event*))
  
  (cond 

    ;Ï1; NULL event Ï*
    ((= partcode 0) nil)
    
    ;Ï1; In MenuBar?Ï*			Ï1      Ï*
    ((= partcode 1)
     (inMenuBarHandler *event*))
    
    ;Ï1; In SystemWindow?  Ï*
    ((= partcode 2)
     (!SystemClick *event* Win))
    
    ;Ï1; In Content Region of Window?Ï*	Ï1       Ï*
    ((= partcode 3) nil)
    
    ;Ï1; In Drag Region of Window?Ï*
    ((= partcode 4)
     (!DragWindow Win *event* *screenrect*)) 
    
    ;Ï1; In Grow Region of Window?Ï*
    ((= partcode 5)
     (multiple-value-setq (theV theH) 
       (!GrowWindow Win *event* *maxrect*))
     
     (when (/= 0 theV theH)
       (!SizeWindow Win theH theV t)
       (setq *restart* t)))

    ;Ï1; In GoAway Region of Window?             Ï*
    ((= partcode 6)
     (if (!TrackGoAway win *event*)
	 (setq *done* t)))
    
    ;Ï1; In the ZoomBox?Ï*	Ï1 Ï*
    ((or (= partcode 7)
	 (= partcode 8))
     
     (!TrackBox win *event* partcode)
     (!SetPort win)
     (!ZoomWindow win partcode t)
     (setq *restart* t))
    
    ;Ï1;beep otherwiseÏ*	Ï1 Ï*
    (t (!sysbeep 1)))			       
  )

;Ï1;Dispatches to the correct menu handlerÏ*
(defun inMenuBarHandler (mousePosition &aux menuID itemID)
  
  ;Ï1;Get the menu and item selectionÏ*
  (setf (values menuID itemID) (!MenuSelect mousePosition))
  
  (!HiLiteMenu 0)
  
  (cond
    
    ;Ï1; Apple Menu?Ï*
    ((= menuID 10)				       
     (AppleMenuHandler itemID))

    ;Ï1; File Menu?Ï*
    ((= menuID 13)
     (FileMenuHandler itemID))

    ;Ï1; Option menu?Ï*
    ((= menuID 15)
     (OptionMenuHandler itemID))))

(defun FileMenuHandler (itemID)
  (cond
    ;Ï1; Quit?Ï*
    ((= itemID 1)
     (send (!frontwindow) :dispose)
     (setq *done* t))))

(defun OptionMenuHandler (itemID)
  (cond ((= itemID 6)
	 (wheel))
	(t (otherwheel (- itemid 1)))))

(defun AppleMenuHandler (itemID &aux accRefNum accName)
  
  (cond
    ;Ï1; About me?Ï*
    ((= itemID 1)
     (display-about-me-window))

    ;Ï1; Desk accessory?Ï*
    ((>= itemID 3)

     ;Ï1; Get the name.Ï*
     (setf accName (GetItem *AppleMenu* itemID))

     ;Ï1; Run it.Ï*
     (setq accRefNum (!OpenDeskAcc accName)))))

;Ï1; Not implemented yet.Ï*
(defun display-about-me-window ()
  (!SysBeep 1))


;Ï1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Ï*
;Ï1;;Ï*
;Ï1;;  Color wheelÏ*
;Ï1;;Ï*
;Ï1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Ï*


(defun otherwheel (id &aux (out (make-instance 'tb:rgbcolor))
		   (in (make-instance 'tb:rgbcolor))
		   (wh (point 'new)))
  (cond ((= id 0)
	 (send in :red (send *ct* :content.red))
	 (send in :green (send *ct* :content.green))
	 (send in :blue (send *ct* :content.blue)))
	((= id 1)
	 (send in :red (send *ct* :frame.red))
	 (send in :green (send *ct* :frame.green))
	 (send in :blue (send *ct* :frame.blue)))	 
	((= id 2)
	 (send in :red (send *ct* :text.red))
	 (send in :green (send *ct* :text.green))
	 (send in :blue (send *ct* :text.blue)))	 
 	((= id 3)
	 (send in :red (send *ct* :hilite.red))
	 (send in :green (send *ct* :hilite.green))
	 (send in :blue (send *ct* :hilite.blue)))	 
 	((= id 4)
	 (send in :red (send *ct* :titlebar.red))
	 (send in :green (send *ct* :titlebar.green))
	 (send in :blue (send *ct* :titlebar.blue)))
	)
  
  (cond ((!GetColor wh "Pick" in out)
	 (cond ((= id 0)
		(send *ct* :content.value 0)
		(send *ct* :content.red (send out :red))
		(send *ct* :content.green (send out :green))
		(send *ct* :content.blue (send out :blue)))
	       ((= id 1)
		(send *ct* :frame.value 1)
		(send *ct* :frame.red (send out :red))
		(send *ct* :frame.green (send out :green))
		(send *ct* :frame.blue (send out :blue)))
	       ((= id 2)
		(send *ct* :text.value 2)
		(send *ct* :text.red (send out :red))
		(send *ct* :text.green (send out :green))
		(send *ct* :text.blue (send out :blue)))
	       ((= id 3)
		(send *ct* :hilite.value 3)
		(send *ct* :hilite.red (send out :red))
		(send *ct* :hilite.green (send out :green))
		(send *ct* :hilite.blue (send out :blue)))
	       ((= id 4)
		(send *ct* :titlebar.value 4)
		(send *ct* :titlebar.red (send out :red))
		(send *ct* :titlebar.green (send out :green))
		(send *ct* :titlebar.blue (send out :blue)))
	       )
	 (!SetWinColor (!frontwindow) *ct*)
	 (!Setport (!FrontWindow)))
	)
  (setq *restart* t)
  )


(defun wheel (&aux (out (make-instance 'tb:rgbcolor))
	      (wh (point 'new))
	      h)
  (cond ((!GetColor wh "Pick" *current-color* out)
	 (!setport (!frontwindow))
	 (setq *current-color* out)
	 (setq h (!NewPixPat))
	 (!makergbPat h out)
	 (!PenPixPat h)
	 ))
  (setq *restart* t))


;Ï1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Ï*
;Ï1;;Ï*
;Ï1;;  Qix itselfÏ*
;Ï1;;Ï*
;Ï1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Ï*

(defun tb-qix (&optional (length 100) 
	       &aux
	       (tmp-rect (send (tb:rect 'tb:new *screen-rect*) :inset 10 50))
	       (window (make-instance 'tb:window :boundsrect tmp-rect
				      :title "ExperTelligence QIX"))
	       (times-n NIL)
	       h)
  "Ï2Non-consing QIX.Ï*"

  ;Ï1; Toolbox setup codeÏ*
  (InitilizeVars)				       ;Ï1 Initialize Global VariablesÏ*
  (SetUpMenuBar)				       ;Ï1 Set up our menu barÏ*
  (!SetWinColor window *ct*)
  (!setport window)
  (!PenMode patxor)
  (setq h (!NewPixPat))  
  (!makergbpat h *current-color*)
  (!pensize 1 1)

  (prog ()
     restart
	(!eraserect  (send (!frontwindow) :portrect))
	
	(let* ((list (if (and qix-list (<= (1+ length) qix-list-length))
			 qix-list
			 (progn
			   (setq qix-list-length length
				 qix-list (make-list (1+ qix-list-length)))
			   ;Ï1; Make history a circular list.Ï*
			   (si:%p-store-cdr-code (cdr (nthcdr (1- length) qix-list)) cdr-error)
			   (si:%p-store-cdr-code (nthcdr (1- length) qix-list) cdr-normal)
			   (rplacd (nthcdr (1- length) qix-list) qix-list)
			   (loop repeat length
				 for h =(nthcdr (1- length) qix-list) then (cdr h)
				 do (setf (car h) (make-list 4)))
			   qix-list)))	       
	       (history (nthcdr (1- length) list))
	       (xlim (send window :width))
	       (ylim (send window :height)))
	  
	  (loop with x1 = (random xlim)
		and y1 = (random ylim)
		and x2 = (random xlim)
		and y2 = (random ylim)
		and dx1 = 5
		and dy1 = 12
		and dx2 = 12
		and dy2 = 5
		with tem and tem1 = 0
		until (if times-n (= (setf times-n (1- times-n)) 0) NIL)
		when (caar history)
		do   
		
		;Ï1; QuickDraw commandsÏ*
		(tb:!moveto (first (car history)) (second (car history)))
		(tb:!lineto (third (car history)) (fourth (car history)))
		
		do
		(WHEN (ZEROP (MOD (INCF tem1) 50))
		  (PROCESS-ALLOW-SCHEDULE)
		  (event-handler))
		(if *done* (return-from tb-qix))
		(cond (*restart*
		       (setq *restart* nil)
		       (go restart)))
		
		(setf (first (car history)) x1)
		(setf (second (car history)) y1)
		(setf (third (car history)) x2)
		(setf (fourth (car history)) y2)
		(setf history (cdr history))
		
		;Ï1; QuickDraw CommandsÏ*
		(Tb:!moveto x1 y1)
		(tb:!lineto x2 y2)
		
		(setf dx1 (1- (+ dx1 (random 3)))
		      dy1 (1- (+ dy1 (random 3)))
		      dx2 (1- (+ dx2 (random 3)))
		      dy2 (1- (+ dy2 (random 3))))
		(cond ((> dx1 12) (setf dx1 12))
		      ((< dx1 -12) (setf dx1 -12)))
		(cond ((> dy1 12) (setf dy1 12))
		      ((< dy1 -12) (setf dy1 -12)))
		(cond ((> dx2 12) (setf dx2 12))	
		      ((< dx2 -12) (setf dx2 -12)))
		(cond ((> dy2 12) (setf dy2 12))
		      ((< dy2 -12) (setf dy2 -12)))
		(cond ((or (>= (setf tem (+ x1 dx1)) xlim)
			   (minusp tem))
		       (setf dx1 (- dx1))))
		(cond ((or (>= (setf tem (+ x2 dx2)) xlim)
			   (minusp tem))
		       (setf dx2 (- dx2))))
		(cond ((or (>= (setf tem (+ y1 dy1)) ylim)
			   (minusp tem))
		       (setf dy1 (- dy1))))
		(cond ((or (>= (setf tem (+ y2 dy2)) ylim)
			   (minusp tem))
		       (setf dy2 (- dy2))))
		(setf x1 (+ x1 dx1)
		      y1 (+ y1 dy1)
		      x2 (+ x2 dx2)
		      y2 (+ y2 dy2))
		
		finally (loop repeat length
			      when (caar history)
			      do
			      ;Ï1; QuickDraw commandsÏ*
			      (tb:!moveto (first (car history)) (second (car history)))
			      (tb:!lineto (third (car history)) (fourth (car history)))
			      
			      do (setf history (cdr history)))))))

