;; -*- Mode:Common-Lisp; Package:MACTOOLBOX; Base:10; Fonts:(CPTFONT HL10B HL12I CPTFONT CPTFONTB) -*-

;Ï1;; INSTRUCTIONS:Ï*
;Ï1;;     *  Compile and load this file.  For example, if you are reading this in a Zmacs buffer, then use META-Z.Ï*
;Ï1;;     *  Make sure the default TB Server is running, enter Ï*(tb:launch-default-tb-server t)Ï1 in aÏ*
;Ï1;;         listener.  (You will have to click on the microExplorer window to reselect it after the launch.)Ï*
;Ï1;;     * Shrink the microExplorer window until it occupies the lower half of the screen leaving the upper halfÏ*
;Ï1;;         free for the window we are about to create.Ï*
;Ï1;;     * Enter Ï*(tb:example-shell)Ï1 in a listenerÏ*
;Ï1;;     * Click on the "Play Window" to select the TB Server application, and play!Ï*
;Ï1;;     * This Play Window can do exactly three things:Ï*
;Ï1;;        -  It implements a "mouse pencil" (i.e., it draws a line on the window as long as you hold the mouseÏ*
;Ï1;;           button down); Ï*
;Ï1;;        -  It beeps at you if you click on the "About Example Shell..." item in the Apple menu of theÏ*
;Ï1;;           Menu Bar; and Ï*
;Ï1;;        -  It will quit gracefully if you click on the "Quit" item in the File menu of the Menu Bar.Ï*
;Ï1;;     * After you have "Quit" out of the Play Window, you will have to click on the microExplorer window toÏ*
;Ï1;;        reselect it.Ï*

(defvar *FileMenuID* 11)
(defvar FileMenu)
(defvar AppleMenu)
(defvar *AppleMenuID* 10)


(defun Ï4EXAMPLE-SHELL Ï*()
  "Ï2This is a trivial Macintosh application  which creates a window labelled
'Play Window' which can do exactly three things:
   * It implements a 'mouse pencil' (i.e., it draws a line on the window as long
      as you hold the mouse button down); 
   *  It beeps at you if you click on the 'About Example Shell...Ï*'Ï2 item in the
      Apple menu of the Menu Bar; and
   *  It will quit gracefully if you click on the Ï*'Ï2QuitÏ*'Ï2 item in the File menu of
      the Menu Bar.Ï*"
  (declare (values ignore))

  ;Ï1; PROGRAMMING NOTE:  At this point in most Macintosh applications you will see a standard set of callsÏ*
  ;Ï1; to various initialization functions such as InitGraf, InitFonts, InitWindows, InitMenus, TEInit, andÏ*
  ;Ï1; InitDialogs.  You should Ï2NOT Ï* include calls to these traps in your Macintosh applications on theÏ*
  ;Ï1; microExplorer since they are done for you when the Toolbox Server is started up on the Macintosh Ï*
  ;Ï1; side.  As aÏ* Ï1reminder, there are comments in the manual to the effect that you don't have to executeÏ*
  ;Ï1; these traps since all basic initializations are done for you.Ï*

  (Setup-shell-menu-bar)
  ;Ï1; PROGRAMMING NOTE:  Many of the things you have come to take for granted about the MacintoshÏ*
  ;Ï1; environment appear only through the cooperation of the application writers.  For example, you--Ï*
  ;Ï1; the Macintosh application writer--must establish which menus go in the Menu Bar, in which order,Ï*
  ;Ï1; and with what names.  Furthermore, you must load up those menus.  For example, if you don'tÏ*
  ;Ï1; explicitly load the desk accessories into the Apple Menu, then your user won't have access to anyÏ*
  ;Ï1; accessory while running your application.  Therefore, some version of this SETUP-SHELL-MENU-BARÏ*
  ;Ï1; function is virtually a standard feature of all Macintosh applictions.Ï*
  
  (Initialize-Shell-Window)			  ;Ï1Show a default windowÏ*
  (!InitCursor)
  (let ((event (make-instance 'EventRecord)))	  ;Ï1 always the event being processedÏ*
    (unwind-protect
	;Ï1; PROGRAMMING NOTE:Ï* Ï1 Regardless of whether the exit is normal or abnormal, theÏ*
	;Ï1; UNWIND-PROTECT guarantees that aÏ* Ï1piece of cleanup code, the SHELL-CLEANUP functionÏ*
	;Ï1; in this case, will START executing...but the clean up code is NOT guaranteed to complete.  IfÏ*
	;Ï1; the cleanup code itself gets errors (or anÏ* Ï1impatient user presses CTRL-ABORT), then theÏ*
	;Ï1; cleanÏ* Ï1up code will not complete.Ï*

	(catch 'EVENT-LOOP-EXIT
	  ;Ï1; PROGRAMMING NOTE:Ï* Ï1The proper way to exit from the infinite Main Event Loop below is toÏ*
	  ;Ï1; throw to 'EVENT-LOOP-EXIT.Ï* Ï1The value expression of the THROW form will be returned asÏ*
	  ;Ï1; the value of the shell.Ï*

	  ;Ï1; MAIN EVENT LOOPÏ*
	  (!FlushEvents !everyEvent 0)		  ;Ï1Empty the event queue before we startÏ*
	  (select-application "Ï3tbserverÏ*")
	  (error-restart-loop (error "Ï3Restart Example Shell Main Event Loop.Ï*")
	    ;Ï1; IMPLEMENTATION NOTE:Ï* Ï1Things such as main event loop deserve extra consideration:Ï*
	    ;Ï1; You don't want them toÏ* Ï1halt unnecessarily and you want to get them restarted easily ifÏ*
	    ;Ï1; they do stop.Ï*
	    ;Ï1;Ï*
	    ;Ï1; Under normal circumstances ERROR-RESTART-LOOP acts as a LOOP form--a simpleÏ*
	    ;Ï1; infinite loop.  However, if one of the specified conditions (Ï*errorÏ1, in this case) is signaledÏ*
	    ;Ï1; within the loop, the user is presented with a proceed option to restart the loop at the top.Ï*
	    ;Ï1; The wording of the proceed option is the string argument to ERROR-RESTART-LOOP.Ï*
	    
	    (catch 'EVENT-LOOP-TOP
	      ;Ï1; PROGRAMMING NOTE:Ï* Ï1The proper way to abnormally terminate the processing of theÏ*

	      ;Ï1; to release any objectsÏ* Ï1created so far during the processing of the aborted event andÏ*
	      ;Ï1; then THROW toÏ* Ï1'EVENT-LOOP-TOP.Ï*

	      (when (!WaitNextEvent !everyEvent event 0 !nilrgn)
		;Ï1; then this is an event AND it is an event we are supposed to handleÏ*
	Ï1                  Ï*;Ï1; (it is possible to get events which we AREN'T supposed to process)Ï*
	      
	Ï1                  Ï*;Ï1; IMPLEMENTATION NOTE:Ï* Ï1The Ï2sleepÏ* argument to !WaitNextEvent (a Ï*0Ï1 in the aboveÏ*
		;Ï1; call) places an upper limitÏ* Ï1on how long !WaitNextEvent will wait before returning.  ItÏ*
		;Ï1; is measured in 1/60-ths ofÏ3 Ï*a second.  A value of zero says "Don't sleep, but returnÏ*
		;Ï1; to me as frequently as youÏ3 Ï*can."Ï*
		;Ï1;Ï*
	Ï1                  Ï*;Ï1; The Ï*regionÏ1 argument  can be used to avoid beingÏ* Ï1bother by uninteresting mouseÏ*
		;Ï1; events.  When defaulted to Ï*!nilRgnÏ1 as shownÏ* Ï1here, you see all mouse events.  IfÏ*
		;Ï1; a region is specified, then you will only seeÏ* Ï1mouse events when the mouse movesÏ*
		;Ï1; outside the specified region.Ï*

		(case (the fixnum (send event :what)) ;Ï1dispatch on event typeÏ*
		Ï1    Ï*;Ï1; IMPLEMENTATION NOTE:Ï* Ï1Explicitly declaring the event type to be a fixnumÏ*
		  ;Ï1; allows the compiler to use aÏ* Ï1microcoded DISPATCH instruction rather than aÏ*
		  ;Ï1; series of compare and branches.Ï* Ï1Of course, depending upon what else is goingÏ*
		  ;Ï1; on inside the CASE statement,this minor efficiency hack may be lost in the noise.Ï*
		Ï1    Ï*;Ï1;Ï*
		Ï1    Ï*;Ï1; Given that a DISPATCH instruction is going to be used to implement this CASEÏ*
		Ï1    Ï*;Ï1; statement anyway, there is no particular advantage or disadvantage inÏ*
		Ï1    Ï*;Ï1; enumerating all possible events as shown below.  If you want a more compactÏ*
		Ï1    Ï*;Ï1; notation, delete all ignored clauses AND the OTHERWISE clause so that ignoredÏ*
		Ï1    Ï*;Ï1; events merely fall though.Ï*
		Ï1    Ï*;Ï1;Ï*
		Ï1    Ï*;Ï1; Using (IGNORE) for the body of unused clauses is the same as using NIL.Ï*
		Ï1    Ï*;Ï1; However, (IGNORE) has the minor documentation characteristic that it assuresÏ*
		Ï1    Ï*;Ï1; reader that you did truly want to ignore the case and have not simply forgottenÏ*
		Ï1    Ï*;Ï1; about it.Ï*
		Ï1    Ï*;Ï1;Ï*
		Ï1    Ï*;Ï1; The Ï*#.Ï1 prefix in needed for each of the symbolic constants because CASE does Ï*
		Ï1    Ï*;Ï1; not evaluate its arguments.  It would see Ï*!nullEventÏ1 (i.e., no prefix) as a symbol Ï*
		Ï1    Ï*;Ï1; which obviously doesn't match the fixnum event code.  However,  it will seeÏ*
		Ï1    Ï*;Ï1; Ï*#.nullEventÏ1 as the number Ï*0Ï1 which is what we want.  Without the Ï*#.Ï1 prefix, weÏ*
		Ï1    Ï*;Ï1; would have had to use a COND statement where each claused looked likeÏ*
		Ï1    Ï*;Ï1; Ï*((= !nullEvent event-code) ...)Ï1...which is a lot more clumsy.Ï*
		
		  (#.!nullEvent   (ignore))
		  (#.!mouseDown   (Shell-mouseDown-Handler event))
		  (#.!mouseUp     (ignore))
		  ((#.!keyDown			  ;Ï1!autoKey event (key held down until itÏ*
		    #.!autoKey)   (ignore))	Ï1     Ï*;Ï1   repeats) is usually treated as !keyDownÏ*
		  (#.!keyUp       (ignore))
		  (#.!updateEvt   (ignore))	Ï1     Ï*;Ï1a window needs to be refeshedÏ*
		  (#.!diskEvt     (ignore))	  ;Ï1a disk was insertedÏ*
		  (#.!activateEvt (ignore))	  ;Ï1a window has been selectedÏ*
		  (#.!networkEvt  (ignore))
		  (#.!driverEvt   (ignore))
		  ((#.!app1Evt			  ;Ï1these events originate in the applicationÏ*
		    #.!app2Evt			  ;Ï1   rather than in system by application Ï*
		    #.!app3Evt)	  (ignore))	  ;Ï1   calls to !PostEvent.Ï*
		    ;Ï1; NOTE:  Ï*!app4EvtÏ1 is also defined, but it is reserved  for the MultiFinderÏ*
		  (otherwise (!Sysbeep 5))	  ;Ï1tell us if we've forgotten somethingÏ*
		Ï1     Ï*);Ï1;caseÏ*
		);Ï1;whenÏ*
	      );Ï1;catch EVENT-LOOP-TOPÏ*
	    
	    ;Ï1; A THROW to 'EVENT-LOOP-TOP will end up here, at the bottom of the main event loop.Ï*
	    ;Ï1; Also, choosing the proceed type of "Restart Example Shell Main Event Loop" from theÏ*
	    ;Ï1; error handler will end up here too.Ï*
	    );Ï1;error-restart-loopÏ*
	  );Ï1;catch EVENT-LOOP-EXITÏ*
      
Ï1             Ï*;Ï1; a THROW to 'EVENT-LOOP-EXIT will end up here, immediately outside the main event loopÏ*
      (Shell-Cleanup)
Ï1              Ï*);Ï1;unwind-protectÏ*
    );Ï1;letÏ*
  );Ï1;example-shellÏ*


;Ï1;;; Ï4AN ALTERNATIVE IMPLEMENTATIONÏ*Ï*

;Ï1;; The file SYS:PUBLIC-MX; TOOLBOX-MACROS contains the LOOP-ON-EVENT macro which subsumesÏ*
;Ï1;; all of the "Good Housekeeping" choses of the above version of EXAMPLE-SHELL (plus a few others)Ï*
;Ï1;; which surround the CASE statement clauses that do the dispatching on each event.  SeeÏ*
;Ï1;; LOOP-ON-EVENT's documentation string for details.Ï*
;Ï1;;Ï*
;Ï1;; As an example of how this macro can simplify your code, the function EXAMPLE-SHELL is reproducedÏ*
;Ï1;; below (without the voluminous comments and do-nothing clauses) using LOOP-ON-EVENT rather thanÏ*
;Ï1;; the discrete code:Ï*
;Ï1;;Ï*
;Ï1;;Ï*	(defun Ï4EXAMPLE-SHELL-2 Ï*()
;Ï1;;Ï*	  (declare (values ignore))
;Ï1;;Ï*	  (Setup-shell-menu-bar)
;Ï1;;Ï*	  (Initialize-Shell-Window)
;Ï1;;Ï*	  (!InitCursor)
;Ï1;;Ï*	  (loop-on-event ()
;Ï1;;Ï*	    (#.!mouseDown (Shell-mouseDown-Handler event))
;Ï1;;Ï*	    (otherwise    (ignore))
;Ï1;;Ï*	    (:cleanup     (Shell-Cleanup))))



(defun Ï4Initialize-Shell-Window Ï*()
  "Ï2make a windowÏ*"
  (make-instance 'tb:window :title "Play Window")
  );Ï1;Initialize-Shell-WindowÏ*


(defun Ï4SHELL-MENU-CREATE Ï*(ID title data)
  "Ï2makes a menu and returns a handle to itÏ*"
  (let ((new-menu (make-instance 'menuinfo)))
    (setf (send new-menu :handle) (send (!NewMenu ID title) :handle))
    (!AppendMenu new-Menu data)
    (!InsertMenu new-Menu 0)
    new-Menu)
  );Ï1;shell-menu-createÏ*


(defun Ï4SETUP-SHELL-MENU-BAR Ï*()
  "Ï2sets up Menu Bar for the Shell applicationÏ*"
  (!ClearMenuBar)				  ;Ï1start with a clean slate (so to speak)Ï*
  (setf AppleMenu				  ;Ï1start definition of the Apple MenuÏ*
	(Shell-menu-create *AppleMenuID* (string (code-char !appleMark))
		     "About Ï3ExampleÏ* Shell...;(-"))
  ;Ï1; IMPLEMENTATION NOTE:  The string in the above form is really the menu item list written in a smallÏ*
  ;Ï1; item-description language which is eventually used by !AppendMenu.Ï*
  ;Ï1;    * each menu item is separated by a semicolon or a return character (therefore, we have two itemsÏ*
  ;Ï1;       specified in the above string because there is one semicolon)Ï*
  ;Ï1;    * a hyphen causes a dotted line to be drawn across the width of the menu as a visual separatorÏ*
  ;Ï1;       (therefore, we will have the "About Example Shell..." item followed by a dotted line)Ï*
  ;Ï1;    * an open parnethesis "disables" the next item (therefore, our dotted line will not be mouseable...Ï*
  ;Ï1;       which is reasonable)Ï*
  ;Ï1;Ï*
  ;Ï1; Other features not used here include specifying an icon for the item, specifying a keyboardÏ*
  ;Ï1; equivalent for the item, placing a check mark by the item, and specifying special text styles for theÏ*
  ;Ï1; item such as bold, italic, underline, shadow, etc.  [see I-348 in Ï2Inside MacintoshÏ*]Ï*

  (!AddResMenu AppleMenu "DRVR")		Ï1     Ï*;Ï1 add Desk Accessories to Apple MenuÏ*
  ;Ï1; IMPLEMENTATION NOTE:  While you are responsible for establishing the Menu Bar and everythingÏ*
  ;Ï1; in it, that isn't to say that you can't get some help.  The above form takes the desk accessories whichÏ*
  ;Ï1; are predefined in the Ï*"DRVR"Ï1 resource and appends them to the menu (which was initialized aboveÏ*
  ;Ï1; to contain just the "About Example Shell..." item).Ï*
  
  (setf FileMenu (shell-menu-create *filemenuID* "File" "Quit")) ;Ï1add File menuÏ*
  ;Ï1; this form defines a menu named Ï*"File"Ï1 with one item, Ï*"Quit"Ï1.Ï*

  (!DrawMenuBar)				Ï1     Ï*;Ï1 Draw the complete Menu BarÏ*
  );Ï1;setup-shell-menu-barÏ*





(defun Ï4Shell-mouseDown-Handler Ï*(event)
  "Ï2Handles !mouseDown eventsÏ*"
  ;Ï1; PROGRAMMING NOTE:Ï* Ï1A mouse handler is most interested in the Ï2pointÏ* where the mouse was clickedÏ*
  ;Ï1; and which window thatÏ* Ï1point was in.  The location of the point is returned in the event record and canÏ*
  ;Ï1; be explicitly extractedÏ* Ï1as individual H and V coordinates.Ï*
  ;Ï1;Ï*
  ;Ï1; However, the Toolbox Interface flavor EVENTRECORD has the flavor POINT as a mixin.  Therefore,Ï*
  ;Ï1; we may simply use an eventrecord instance  whereever a point instance is needed.  In particular,Ï*
  ;Ï1; FINDWINDOW is nominally documented to take a point instance as an argument, but it is moreÏ*
  ;Ï1; convenient--and just as valid--to pass it the original event record which started everything off.Ï*
  
  (multiple-value-bind (partcode window)
      (FindWindow event)
      ;Ï1; given a point, Ï*eventÏ1, which in this case represents where the mouse was clicked, FindWindowÏ*
      ;Ï1;determines what part of what window the point is in and returns both pieces of informationÏ*
      ;Ï1; as Ï*partcodeÏ1 and Ï*windowÏ1.Ï*
    
    (case (the fixnum partcode)			  ;Ï1dispatch on where the mouse was clickedÏ*
      (#.!inDesk      (ignore))			  ;Ï1 somewhere on the background desktopÏ*
      (#.!inMenuBar   (shell-inmenubar-handler event))  ;Ï1bar across top of screenÏ*
      (#.!inSysWindow (!SystemClick event window))
      (#.!inContent   (!SysBeep 1)		  ;Ï1 somewhere inside the windowÏ*
		      (send event :lineto)	  ;Ï1 draw first line from upper left cornerÏ*
		      (let ((point (make-instance 'point)))
		        (loop
			  (when (not (!button)) (return)) ;Ï1loop until button releasedÏ*
			  ;Ï1; otherwise, button still down, so track itÏ*
			  (!getmouse point)
			  (send point :lineto)))) ;Ï1 "draw" with the mouse in real-timeÏ*
      (#.!inDrag      (ignore))			  ;Ï1 in bar across the top of a windowÏ*
      (#.!inGrow      (ignore))			  ;Ï1 in box in lower right cornerÏ*
      (#.!inGoAway    (ignore))			  ;Ï1 in box in upper left cornerÏ*
      ((#.!inZoomIn				  ;Ï1 in box in upper right cornerÏ*
	#.!inZoomOut) (ignore))
      (otherwise      (!sysbeep 1))		  ;Ï1 beep if we've forgotten anythingÏ*
      );Ï1;caseÏ*			       
    );Ï1;multiple-value-bindÏ*
  );Ï1;mouse-down-handlerÏ*
  

(defun Ï4SHELL-INMENUBAR-HANDLER Ï*(event)
  "Ï2Handles mousedown in menubar eventsÏ*"
  (declare (values ignore))
  (multiple-value-bind (menu-id item-id)
      (!MenuSelect event)
      ;Ï1; given a point, Ï*eventÏ1, which in this case represents where the mouse was clicked, !MenuSelectÏ*
      ;Ï1; determines the integer menu ID and the integer item ID within that menu where the point lies andÏ*
      ;Ï1; returns both pieces of information as Ï*menu-idÏ1 and Ï*item-idÏ1.  You specified those menus so youÏ*
      ;Ï1; are responsible for remembering what the menu IDs and item IDs mean.Ï*
    
    (!hilitemenu 0)				  ;Ï1we've seen it, so turn off highlightingÏ*
    (cond ((= menu-id *applemenuid*)		  ;Ï1dispatch on the menu IDÏ*
	Ï1       Ï*;Ï1; case of apple in the menu barÏ*
	   (shell-applemenu-handler item-ID))
	  
	  ((= menu-id *filemenuid*)
	Ï1       Ï*;Ï1; case of File in the menu barÏ*
	   (Shell-FileMenu-Handler item-ID))
	  
	Ï1     Ï*(t ;Ï1;case of anything else in menu barÏ*
	    (ignore))
	Ï1     Ï*);Ï1;condÏ*
    );Ï1; multiple-value-bindÏ*
  );Ï1;shell-inmenubar-handlerÏ*

 
(defun Ï4SHELL-APPLEMENU-HANDLER Ï*(item-ID)
  "Ï2handles mousedown in apple menu of menu bar eventÏ*"
  (cond ((= item-id 1)
	 ;Ï1; case of clicked on "About Simple Shell..."Ï*
         (about-shell))
	
	;Ï1; NOTE:  ITEM-ID = 2 is the unselectable line separating the "About Simple Shell..." entry fromÏ*
	;Ï1; everything that follows (which happens to be all those desk accessories we added from aÏ*
	;Ï1; resource.Ï*

        ((>= item-ID 3)
	 ;Ï1; case of clicked on some desk accessoryÏ*
	 (!opendeskacc (getitem applemenu item-id)))	  ;Ï1 get its name and open itÏ*

	(t (warn "Ï3~%SHELL-APPLEMENU-HANDLER received an illegal item-id of ~s.Ï*"
		 item-id)
	   (throw 'EVENT-TOOP-TOP nil))
	;Ï1; IMPLEMENTATION NOTE:Ï* Ï1This sort of error isn't really a big enough problem to warrant aÏ*
	;Ï1; THROW to 'EVENT-LOOP-TOPÏ* Ï1because, in this particular case, quietly returning from thisÏ*
	;Ï1; functionÏ* Ï1would have done theÏ* Ï1same thing.  You would usually use a THROW in cases where itÏ*
	;Ï1; isÏ* Ï1impossible or unsafe toÏ* Ï1continue with the current processing so that you must deliberatelyÏ*
	;Ï1; skip everything elseÏ* Ï1that would normally have gone into completeing the current event.Ï*
	
	);Ï1;condÏ*
  );Ï1;shell-applemenu-handlerÏ*


(defun Ï4SHELL-FILEMENU-HANDLER Ï*(itemID)
  "Ï2Handle menu items like NEW, CLOSE & QUITÏ*"
  (when (= itemID 1)
    (throw 'EVENT-LOOP-EXIT 'QUIT)))


(defun Ï@ABOUTÏ4-Ï*SHELL Ï*()
  "Ï2The About... Apple Menu entry for this simple shellÏ*"
  (!sysbeep 1))


(defun Ï4SHELL-CLEANUP Ï*()
  (loop
    (when (not (!frontwindow)) (return))	  ;Ï1 loop until no front windowÏ*
    (send (!frontwindow) :dispose))		  ;Ï1   disposing of each window we findÏ*
  (!clearmenubar)
  (!drawmenubar)
  (select-application)
  );Ï1;Shell-Cleanup











