;;; -*- Mode:Common-Lisp; Package:USER; Base:10; Fonts:(CPTFONT CPTFONTB) -*-
;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.

;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151

;;; Copyright (C) 1985-1990 Texas Instruments Incorporated. All rights reserved.
;	** (c) Copyright 1980 Massachusetts Institute of Technology **


Ï1; This file contains the lisp-side rpc client example,
; HOOKS, thatÏ* Ï1corresponds to the mac-side rpc server
; example, HOOKS, in theÏ* Ï1folderÏ* Ï1microexp:macsys:
; rpc-examples:hooks: The example provides a simpleÏ* Ï1four
; function calculator server on the mac-side, and an
; lisp-side client toÏ* Ï1demonstrate RPC. Ï* Ï1ThisÏ* Ï1fileÏ* Ï1alsoÏ* 
;Ï1 demonstrates howÏ* Ï1toÏ* Ï1launch and kill the mac-side Ï*
;Ï1 rpc serverÏ* Ï1fromÏ* Ï1lisp.
;
; This demonstration was built and tested under the following 
; configuration:
;
;    Finder 6.1, System 6.03, MPW 3.01
;    TBServer 6.3.01 and 7.3.01
;    microExplorer 6.0 with latest patches
;
;
; Note: Before using this lisp file you must use MPW 3.1 to Ï*
;Ï1 buildÏ* Ï1theÏ* Ï1application HOOKS, which must exist in the folder
; MICROEXP:MACSYS:RPC-EXAMPLES:HOOKS:Ï*
;
;
Ï1;To run this example execute theÏ* Ï1followingÏ* Ï1steps in the order
;specified.
;
;       build the applications HOOKS with MPW 3.1
;       meta-x compile buffer in zmacs
;       (launch-my-server) in lisp listener
;
;
; Have the lisp client call the mac server using a sample
; call such as one of the following:
;
;       (calc '+ 100 225)
;       (calc '- 100 225)
;       (calc '* 100 225)
;       (calc '/ 100 225)Ï*


(DEFCONSTANT  *hooks-program-number*     #x20118699)
(DEFCONSTANT  *hooks-version-number*              1)
(DEFCONSTANT  *hooks-procedure-number*            1)


Ï1; We need to pass CALLRPC three arguments, so we have to define Ï*
;Ï1 aÏ* Ï1filter (structure) because we can only pass one argument.Ï*
(defstruct mystruct
  (operator 0   :type integer)
  (operand1 0.0 :type single-float) 
  (operand2 0.0 :type single-float))


Ï1; We must also define a "serializing" function that knowsÏ*
;Ï1 how to encode our filter into the universal xdr language.Ï*
(defun xdr-mystruct (stream obj)
  (rpc:default-and-resolve obj mystruct make-mystruct)
  (send stream :xdr-integer
	(locf (mystruct-operator obj)))   ; operator
  (send stream :xdr-float
	(locf (mystruct-operand1 obj)))   ; operand 1
  (send stream :xdr-float
	(locf (mystruct-operand2 obj))))  ; operand 2


(defvar *mystruct* (make-mystruct))


Ï1; An Alist of operator symbol to integer representation.Ï*
(defconstant operations '((+ . 0) (- . 1) (* . 2) (/ . 3)))


(Defun calc (operator operand1 operand2)
  Ï1"An rpc calculator server.  Syntax is as follows:

    (calc '+ 100 225)
    (calc '- 100 225)
    (calc '* 100 225)
    (calc '/ 100 225)"Ï*

  (unless (assoc operator operations)
    (ferror "invalid operator" "~%Error in operator~a" operator))
  ;Ï1;setup the callrpc IN argument with the correct three valuesÏ*
  (setf (mystruct-operator *mystruct*) (cdr (assoc operator operations)))
  (setf (mystruct-operand1 *mystruct*) (coerce operand1 'single-float))
  (setf (mystruct-operand2 *mystruct*) (coerce operand2 'single-float))
  ;Ï1;call the calculator procedure running on the mac.Ï*
  (CALLRPC 'mac
	   *hooks-program-number*
	   *hooks-version-number*
	   *hooks-procedure-number*
	   'xdr-mystruct
	   *mystruct*
	   :xdr-float)
  )


Ï1; This form will create a hooks flavor that can talk to the mac
; applicationÏ* Ï1over a dedicated micronet channel. Ï* Ï1It allows you to
; startup the applicationÏ* Ï1from lisp or from the mac.  Of course, Ï*
;Ï1 it could also be used as a tbserver to make toolbox calls.Ï*

(tb:define-mac-application hooks nil
	       (:server-name "hooks"
		:lisp-function 'hooks-loop
		:directory ("microexp:macsys:rpc-examples:hooks:")))


(defvar *myserver* nil)

Ï1; This function will startup the mac application from lisp.Ï*
(defun launch-my-server ()
  Ï1"Launch the hooks server and allocate to it a micronet channel."Ï*
  (setf *myserver*
	(tb:launch-mac-application 'hooks)))


Ï1; This function will shutdown the mac application from lisp.
; It can also be shutdown on the mac by selecting Quit 
; from the application's file menu.Ï*

(defun quit-my-server ()
  Ï1"Shutdown the hooks server and deallocate its micronet channel."Ï*
  (when *myserver*
    (send *myserver* :kill-server)
    (send *myserver* :kill)
    (setf *myserver* nil)))


Ï1; Most tbserver applications are written using the lisp toolbox
; interface and have a lisp top-level main-event-loop. Ï* Ï1Although
; HOOKSÏ* Ï1is written in C and executes on the mac side, we still need
; a dummyÏ* Ï1top-level loop for the associated lisp process. Ï* Ï1This is
; what theÏ* Ï1function HOOKS-LOOP provides. Ï* Ï1When HOOKS starts up,
; HOOKS-LOOP will runÏ* Ï1in an loop basically doing nothing. Ï* Ï1When HOOKS
; is quit, the lispÏ* Ï1associated structures will be deallocated and
; the process killed.Ï*


(defvar *token* t)

;Ï1he never needs to run so give him a low priority.Ï*
;Ï1setting *token* to nil would also quit the server.Ï*

(defun hooks-loop()
  (setf (send si:current-process :priority) -5)	       
  (with-lock (*token* :whostate "just sleep")
  ()
  ))

