;;-*-mode:common-lisp ; Package:DASH ; fonts: medfnt, medfnb ; base:10.-*- ; ;=============================================================================== ; ; Written by Nichael Lynn Cramer ; ;=============================================================================== ; ; This data and information is proprietary to, and a valuable trade secret of ; Texas Instruments, Incorporated, a Delaware corporation. It is given in ; confidence by Texas Instruments, and may not be used as the basis of ; manufacture, or be reproduced or copied, or be distributed to any other ; party, in whole or in part, without the prior written consent of Texas ; Instruments. ; ;=============================================================================== ; ; (c) Unpublished Copyright 1984 by Texas Instruments. All rights reserved. ; ;=============================================================================== ; ;1;***************************************************************** ;1; Flavor BASIC-DIAL contains the absolute bare essentials for a dial:* ;1; information about its position, stuff to get a CAPTION and information* ;1; for DECORATIONS.* ;1; Designers of new flavors for complete Dials need to supply four methods.* ;1; The first three have to do with drawing the Dial and take no * ;1; arguements: * ;1; :draw-background [draw the background 'face' of the dial that does not* ;1; change as the value of the Dial changes],* ;1; :draw-value [draw the Display showing the value of the Dial; e.g. the* ;1; hands of the Dials]* ;1; :undraw [used to remove the image of the Dial from its window]* ;1;* ;1; :inside-dial? accepts two arguements [an X and Y position given in * ;1; window coordinates] and returns t or nil depending on* ;1; whether the position is inside the Dial. Of course,* ;1; what being 'inside the Dial' means changes from Dial* ;1; to Dial.* ;1;*******************************************************NLC9APR84* (defflavor BASIC-DIAL ( (FONT-SCALE 1.) (X-CENTER 200.) ;1;CENTER OF DIAL IN WINDOW COORDINATES.* (Y-CENTER 200.) (CAPTION '(("TI Dial" -24. 80.))) ;1;CAPTIONS (DETAILED BELOW)* (DEFAULT-CAPTION-FONT fonts:cptfont) (DIAL-NAME "DUMMY") ;1;INTERNAL NAME OF DIAL (USEFUL IN DASHBOARDS)* (INVERSE-VIDEO-P nil) ;1;DRAW DIAL IN INVERSE VIDEO?* ;; (X-ARRAY (make-array 2.)) ;1;SCRATCH-PAD ARRAYS USED BY DRAWING* ;; (Y-ARRAY (make-array 2.)) ;1; ROUTINES* (DECORATIONS-LIST nil) ;1;DECORATIONS (DETAILED BELOW)* (UNDRAW-DECORATIONS-P t) ;1;UNDRAW THE DECORATIONS WHEN UNDRAWING* ;1;THE DIAL* ) ;; (easy-interface-mixin) () :initable-instance-variables :gettable-instance-variables :settable-instance-variables :special-instance-variables (:required-methods :draw-background :undraw :draw-value :inside-dial?) (:documentation "Base flavor for drawing dials and guages") ) (defmethod (basic-dial :draw) (WINDOW) "2Calls user defined :draw-background and :draw-value methods for specific Dial flavor*" (send self :draw-background WINDOW) (send self :draw-value WINDOW) ) (defmethod (basic-dial :draw-string-in-window) (WINDOW STRING WX WY &optional (PHONT fonts:cptfont) (AALU tv:alu-xor)) "2Draw STRING starting at window coordinates (WX,WY).*" (send WINDOW :draw-string PHONT STRING WX WY gwin:black 0. 8. FONT-SCALE AALU) ) (defmethod (basic-dial :draw-char-in-window) (WINDOW CHR WX WY &optional (PHONT nil) (AALU tv:alu-ior)) "2Draw CHR starting at window coordinates (WX,WY).*" (setq PHONT (or PHONT (send WINDOW :current-font))) (send WINDOW :draw-string PHONT CHR WX WY gwin:black 0. 8. FONT-SCALE AALU) ) (defmethod (basic-dial :REVERSE-VIDEO) () "2Toggle the display of the dial from black-on-white to white-on-black, and vice-versa.*" (setq INVERSE-VIDEO-P (not INVERSE-VIDEO-P)) ) ;;(defmethod (basic-dial :fill-x-y-arrays) (X0 Y0 X1 Y1) ;; "2Used to fill the DIAL's X-ARRAY and Y-ARRAY*" ;; (aset X0 X-ARRAY 0.) ;; (aset Y0 Y-ARRAY 0.) ;; (aset X1 X-ARRAY 1.) ;; (aset Y1 Y-ARRAY 1.) ;; ) ;1;***************************************************************** ;1; CAPTIONS are features that allow the palcing of an arbitrary string* ;1; anwhere in the Dial.* ;1; The variable *CAPTION1 contains a list of the individual CAPTIONS.* ;1; Each individual CAPTION is a list of the form:* ;1; ( )* ;1;*******************************************************NLC9APR84* (defmethod (basic-dial :draw-captions) (WINDOW &optional (AALU tv:alu-ior)) "2Draws all the individual captions in the caption list *CAPTION2.*" (when (listp CAPTION) (dolist (ONE-CAPTION CAPTION) (send self :draw-one-caption WINDOW ONE-CAPTION AALU))) ) (defmethod (basic-dial :draw-one-caption) (WINDOW ONE-CAPTION &optional (AALU tv:alu-ior)) "2Draws a single caption from the caption description ONE-CAPTION.*" (when (first ONE-CAPTION) ;1;SKIP IF STRING IS NIL. KLUDGE TO HELP IN * ;1;CAPTIONS FOR SIMPLE-EDITED SWITCHES* (send self :draw-string-in-window WINDOW (first ONE-CAPTION) (+ X-CENTER (second ONE-CAPTION)) (+ Y-CENTER (third ONE-CAPTION)) (or (fourth ONE-CAPTION) DEFAULT-CAPTION-FONT) AALU)) ) (defmethod (basic-dial :make-caption-list) (NEWSTRING NEWX NEWY NEW-FONT &optional OLDLIST) "2Builds a new caption-element for the caption-list where *OLDLIST2 is the old caption-list. I1f** OLDLIST2 is NIL then, caption list contains only the new element.*" (let* ((NEW-CAPTION (list NEWSTRING NEWX NEWY NEW-FONT))) (setq CAPTION (if OLDLIST (replace OLDLIST NEW-CAPTION CAPTION) (if (listp CAPTION) (cons NEW-CAPTION CAPTION) (list NEW-CAPTION )))) ) ) ;1;***************************************************************** ;1; FIGURES* ;1; FIGURES are arbitrary figures drawn on the dial. They can be rotated* ;1; by an angle (as in the case of ROTARY-HANDS) or remain fixed (as* ;1; in the case of DECORATIONS. Each FIGURE is stored as a list of two* ;1; elements. The first element is FIGURE-TYPE. The second is a list * ;1; FIGURE-INFO containing information about how the FIGURE should be drawn.* ;1; The currently supported TYPES are:* ;1; FIGURE-TYPE FIGURE-INFO form* ;1; *:1line ( X0 Y0 X1 Y1 )* ;1; *:1broad-line ( ( X0 Y0 X1 Y1 ) line-width )* ;1; *:1triangle ( X0 Y0 X1 Y1 X2 Y2)* ;1; *:1lines ( X0 Y0 X1 Y1 ... Xn Yn )* ;1; *:1char ( ( X0 Y0 ) character font )* ;1; *:1hollow-triangle ( X0 Y0 X1 Y1 X2 Y2)* ;1; *:1sector ( (Xcenter Ycenter) radius (THETA1 THETA2))* ;1; *:1hollow-sector ( (Xcenter Ycenter) radius (THETA1 THETA2))* ;1; *:1circular-arc ( (Xcenter Ycenter) radius (THETA1 THETA2))* ;1; *:1circle ( (Xcenter Ycenter) radius )* ;1; *:1filled-in-circle ( (Xcenter Ycenter) radius )* ;1; *:1hollow-rectangle ( (XLEFT YTOP) WIDTH HEIGHT )* ;1; *:1rectangle ( (XLEFT YTOP) WIDTH HEIGHT )* ;1; *:1string ( ( X0 Y0 ) string font )* ;1; *:1grey-filled-in-circle ( (Xcenter Ycenter) radius grey% )* ;1; *:1grey-rectangle ( (XLEFT YTOP) WIDTH HEIGHT grey% )* ;1; *:1grey-triangle ( X0 Y0 X1 Y1 X2 Y2)* ;1;* ;1; NOTE: In Rectangle and char figures only the upper left corner* ;1; actually 'rotates' about the center of the dial. The orientation of* ;1; the the rest of the figure remains fixed.* ;1;******************************************************NLC10APR84* (defmethod (basic-dial :draw-dial-figure) (FIGURE-TYPE FIGURE-INFO &optional (ANGLE 0.) (AALU tv:alu-xor)) "2Draws a single figure of type FIGURE-TYPE at angle ANGLE.*" (case FIGURE-TYPE (:line (zlc:lexpr-funcall WINDOW ':draw-line `(,@(rotate-x-y-list FIGURE-INFO (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,AALU))) (:broad-line (zlc:lexpr-send self ':fill-x-y-arrays (rotate-x-y-list (first FIGURE-INFO) (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER)) (send WINDOW ':draw-wide-curve X-ARRAY Y-ARRAY (second FIGURE-INFO) 2. aalu)) (:triangle (zlc:lexpr-funcall WINDOW ':draw-triangle `(,@(rotate-x-y-list FIGURE-INFO (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,AALU))) (:lines (zlc:lexpr-funcall WINDOW ':draw-lines `(,AALU ,@(rotate-x-y-list FIGURE-INFO (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER)))) (:char (let ((PHONT (or (third FIGURE-INFO) fonts:cptfont))) (zlc:lexpr-funcall WINDOW ':draw-char `(,PHONT ,(second FIGURE-INFO) ,@(rotate-x-y-list (first FIGURE-INFO) (sind ANGLE) (cosd ANGLE) (round (- X-CENTER (/ (tv:font-raster-width PhONT) 2.0))) (round (- Y-CENTER (/ (tv:font-baseline PHONT) 2.0)))) ,AALU)) )) (:hollow-triangle (zlc:lexpr-funcall WINDOW ':draw-hollow-triangle `(,@(rotate-x-y-list FIGURE-INFO (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,AALU))) (:sector (zlc:lexpr-funcall WINDOW ':draw-filled-in-sector `(,@(rotate-x-y-list (first FIGURE-INFO) (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,(second FIGURE-INFO) ,(degrees-to-radians (+ ANGLE (first (third FIGURE-INFO)))) ,(degrees-to-radians (+ ANGLE (second (third FIGURE-INFO)))) ,AALU))) (:hollow-sector (zlc:lexpr-funcall WINDOW ':draw-hollow-sector `(,@(rotate-x-y-list (first FIGURE-INFO) (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,(second FIGURE-INFO) ,(degrees-to-radians (+ ANGLE (first (THIRD FIGURE-INFO)))) ,(degrees-to-radians (+ ANGLE (second (third FIGURE-InFO)))) ,AALU))) (:circular-arc (zlc:lexpr-funcall WINDOW ':draw-circular-arc `(,@(rotate-x-y-list (first FIGURE-INFO) (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,(second FIGURE-INFO) ,(degrees-to-radians (+ ANGLE (first (third FIGURE-INFO)))) ,(degrees-to-radians (+ ANGLE (second (third FIGURE-INFO)))) ,AALU))) (:circle (zlc:lexpr-funcall WINDOW ':draw-circle `(,@(rotate-x-y-list (first FIGURE-INFO) (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,(second FIGURE-INFO) ,AALU))) (:filled-in-circle (zlc:lexpr-funcall WINDOW ':draw-filled-in-circle `(,@(rotate-x-y-list (first FIGURE-INFO) (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,(second FIGURE-INFO) ,AALU))) (:hollow-rectangle (zlc:lexpr-funcall WINDOW ':draw-hollow-rectangle `(,(second FIGURE-INFO) ,(third FIGUrE-INFO) ,@(rotate-x-y-list (first FIGURE-INFO) (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,AALU))) (:rectangle (zlc:lexpr-funcall WINDOW ':draw-rectangle `(,(second FIGURE-INFO) ,(third FIGURE-INFO) ,@(rotate-x-y-list (first FIGURE-INFO) (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,AALU))) (:string (let ((PHONT (or (third FIGURE-INFO) fonts:cptfont))) (zlc:lexpr-funcall WINDOW ':string-out-explicit `(,(second FIGURE-INFO) ,@(rotate-x-y-list (first FIGURE-INFO) (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) 2000. ,PHONT ,AALU 0.)) )) (:grey-filled-in-circle (zlc:lexpr-funcall WINDOW ':draw-grey-filled-in-circle `(,@(rotate-x-y-list (first FiGURE-INFO) (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,(second FIGURE-INFO) ,AALU ,(or (third FIGURE-INFO) 50.) )) ) (:grey-rectangle (zlc:lexpr-funcall WINDOW ':draw-grey-rectangle `(,(second FIGURE-INFO) ,(third FIGURE-INFO) ,@(rotate-x-y-list (first FIGURE-INFO) (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,AALU ,(or (fourth FIGURE-INFO) 50.)))) (:grey-triangle (zlc:lexpr-funcall WINDOW ':draw-grey-triangle `(,@(rotate-x-y-list FIGURE-INFO (sind ANGLE) (cosd ANGLE) X-CENTER Y-CENTER) ,AALU))) (otherwise (ferror nil "HA HA HA!! Attempt to Draw Non-existent Figure. TYPE : ~A INFO : ~A" FIGURE-TYPE FIGURE-INFO)) ) ) ;1;***************************************************************** ;1; DECORATIONS are FIGURES (see above) that are draw part of the background* ;1; of the DIAL and do not change as the value of the dial changes.* ;1; The list *DECORATIONS-LIST1 contains some number of FIGURE description* ;1; lists.* ;1;******************************************************NLC10APR84* (defmethod (basic-dial :draw-decoration) (&optional (AALU tv:alu-ior)) "2Draws all the background* 2decoration FIGURES for the DIAL.*" (mapc #'(lambda (ONE-DECORATION) (send self ':draw-dial-figure (first ONE-DECORATION) (second ONE-DECORATION) 0. AALU)) DECORATIONS-LIST) ) (defmethod (basic-dial :make-decorations-list) (NEW-TYPE NEW-INFO &optional OLDLIST) "2Can be used to add a single DECORATION item to *DECORATIONS-LIST2.*" (let ((NEW-DECORATION (list NEW-TYPE NEW-INFO))) (setq DECORATIONS-LIST (if OLDLIST (replace OLDLIST NEW-DECORATION DECORATIONS-LIST) (if DECORATIONS-LIST (cons NEW-DECORATION DECORATIONS-LIST) (list NEW-DECORATION)))) ) ) ;1;****************************************************************** ;1;* ;1; Flavor *dial-value-mixin1 is used to handle the *CURRENT-VALUE1 of the* ;1; Dial. This is value is the 'value' for the whole dial. It may* ;1; need to be 'decoded' into a form more appropriate for the various* ;1; displays using the 'valprep' function of the corresponding display.* ;1; As an example, the *CURRENT-VALUE1 for a Dial with several independent* ;1; hands may be a list of the values of each of the hands. The 'valprep'* ;1; function for the multiple hands extracts the value the value appropriate* ;1; for each hand.* ;1;* ;1; The designer of a new complete Dial flavor needs to include a * ;1; *:set-current-value1 method that is responsible for updating the* ;1; various displays of the Dial. * 1The Method should accept one arguement,* ;1; *NEW-VALUE1, the new value for the Dial to be set to. The method should * ;1; end with the lines* ;1;* ;1;* (setq CURRENT-VALUE ;1;* (if CURRENT-VALUE-VALPREP-FUNCTION ;1;* (funcall CURRENT-VALUE-VALPREP-FUNCTION NEW-VALUE) ;1;* NEW-VALUE)) ;1;* (when SET-CURRENT-VALUE-SIDE-EFFECT-FUNCTION ;1;* (funcall SET-CURRENT-VALUE-SIDE-EFFECT-FUNCTION CURRENT-VALUE)) ;1;* ;1; The function *CURRENT-VALUE-VALPREP-FUNCTION1 is an optional user defined* ;1; function. If it is defined, it is used to make any neccessary * ;1; conversions from the form in which a new value is received by the Dial* ;1; and the form in which it is finally stored.* ;1; The function *SET-CURRENT-VALUE-SIDE-EFFECT-FUNCTION ;1; is an optional user defined function of one arguement [the * ;1; *CURRENT-VALUE1] whose purpose is to allow the user to define side-effects* ;1; for setting the Dial. [For example, to set the value of some* ;1; variable by setting the value of the Dial.] * 1The returned value of the * ;1; function is ignored. * ;1; If these functions expects to access the instance varibles and * ;1; methods of the Dial, the function definition should include the * ;1; declaration *(declare (:self-flavor dash:dial-value-mixin)) ;1;* ;1; There are hooks for three user-defined 'mouse-sensitivity' functions.* ;1; There are three [one for each button] and these can be invoked by * ;1; calling the *:mouse-call-dial1 method and giving it the appropriate* ;1; arguemnent: 1=Left, 2=Middle, 4=Right. These functions take no* ;1; arguements and their returned value is ignored. * ;1; The intended use for these functions is to allow the user to define* ;1; various ways to use the mouse to set the value of the Dial; however* ;1; they are in no way restricted to this use. The function should call* ;1; the method *:set-current-value1 to set *CURRENT-VALUE1 as this method handles* ;1; updating the appropriate displays. The function definition should * ;1; include the decoration *(declare (:self-flavor dash:dial-value-mixin)). ;; ;1; *DIAL-MOUSE-DOCUSTRING 1is an optional string to be used in the* ;1; mouse-who-line to document the purpose of the mouse-sensitivity * ;1; functions.* ;1;* ;1;*******************************************************NLC10JUN84* (defflavor dial-value-mixin (CURRENT-VALUE ;1;PRESENT VALUE OF ENTIRE DIAL* (SET-CURRENT-VALUE-SIDE-EFFECT-FUNCTION nil) ;1;OPTIONAL USER-DEFINABLE FUNCTION * ;1;CALLED IN *:set-current-value1.* (CURRENT-VALUE-VALPREP-FUNCTION nil) LEFT-DIAL-MOUSE-FUNCTION ;1;OPTIONAL MOUSE-SENSITIVITY FUNCTIONS* (MIDDLE-DIAL-MOUSE-FUNCTION 'dash:default-middle-dial-mouse-function) RIGHT-DIAL-MOUSE-FUNCTION DIAL-MOUSE-STRING ) () :initable-instance-variables :gettable-instance-variables :settable-instance-variables :special-instance-variables (:required-methods :set-current-value) (:documentation "Mixin Flavor handling CURRENT-VALUE of the Dial, SET-CURRENT-VALUE-SIDE-EFFECT-FUNCTION [a user-definable function that can be called when the CURRENT-VALUE is set] and three user-definable functions that can be used to aid the mouse-sensitivity of the dial.") ) (defmethod (dial-value-mixin :mouse-call-dial) (WINDOW INDEX) "2Call the user defined mouse-sensitivity functions: 1=Left, 2=Middle, 4=Right.*" (case INDEX (1 (when LEFT-DIAL-MOUSE-FUNCTION (send self :funcall-inside-yourself LEFT-DIAL-MOUSE-FUNCTION WINDOW))) (2 (when MIDDLE-DIAL-MOUSE-FUNCTION (send self :funcall-inside-yourself MIDDLE-DIAL-MOUSE-FUNCTION WINDOW))) (4 (when RIGHT-DIAL-MOUSE-FUNCTION (send self :funcall-inside-yourself RIGHT-DIAL-MOUSE-FUNCTION WINDOW))) (otherwise (beep)) ) ) (defun dash:default-middle-dial-mouse-function (WINDOW) "1The default MIDDLE-DIAL-MOUSE-FUNCTION. It calls a menu to allow the CURRENT-VALUE to be keyboard set.*" ;1;* (declare (:self-flavor dash:dial-value-mixin)) (declare (special CURRENT-VALUE SELF)) (let ((TEMP CURRENT-VALUE)) (declare (special TEMP)) (tv:choose-variable-values '((TEMP "Current Value" :any))) (send self :set-current-value WINDOW TEMP) ) ) ;1;*********************************************************************** ;1;************************************************************NLC12FEB85