;;; -*- Mode:Common-Lisp; Package:PICTURE; Base:10; Fonts:(MEDFNB HL12B HL12BI) -*- ;;; This software was developed at the Texas Instruments Corporation ;;; and is provided "as-is". Texas Instruments Corporation and the ;;; author disclaim all warranties on the software, including without ;;; limitation, all implied warranties of merchantability and fitness. ;;; ;;; This software does not contain any technical data or information ;;; that is proprietary in nature. It may be copied, modified, and ;;; distributed on a non-profit basis and with the inclusion of this ;;; notice. ;;; ;;; Copyright (C) 1989, Texas Instruments Incorporated. ;;; Change history: ;;; ;;; Date Author Description ;;; ------------------------------------------------------------------------------------- ;;; 3/22/89 TWE Changed the MicroExplorer menu fraction from .67 to .69. ;;; 3/20/89 TWE Added support for splines. ;;; 11/03/88 TWE Added the function COMMAND-CHARACTER-LIST which accumulates all ;;; of the command characters. Changed the MAKE-PICTURE function to ;;; use that function instead of the constant. ;;; 10/17/88 TWE Added a keystroke to toggle read-only mode. ;;; 10/13/88 TWE Updated to be able to handle both the Explorer and microExplorer ;;; screen sizes. ;;; 10/11/88 TWE Added the Non-bordered box command and an option to Write TeX ;;; file to not texify text. ;;; 9/22/88 TWE Hacked up MAKE-PICTURE to get around the (QUOTE HELP) problem ;;; where an extraneous quote character gets inserted before a ;;; command name. This fix detects and replaces the (QUOTE HELP) ;;; with just HELP. ;;; 9/20/88 TWE Made the name of the top-level window apparent from the system ;;; menu `select' option. ;;; 6/15/88 TWE Added the interface to allow one to turn off the margin. ;;; 5/16/88 TWE Added support for a default font and line thicknesses. ;;; 10/08/87 TWE For menu items, put the keystroke equivalent into the mouse ;;; documentation string. ;;; 10/01/87 TWE Fixed a bug creation bug. If one had earlier killed off a ;;; picture window which was in landscape mode and then create a new ;;; picture window, the new one would have its margin size values ;;; reflect those of the landscape mode, instead of portrait mode. ;;; This code updates the margin sizes to reflect the default ;;; orientation (i.e. portrait). ;;; 9/10/87 TWE Added support for landscape mode. ;;; 6/29/87 TWE Added the support for MINIMUM-X/Y to make the picture only as big ;;; as the user makes it. ;;; 6/23/87 TWE Added support for fonts. ;;; 6/22/87 TWE Set up terminal-io to be the interaction pane. This makes login ;;; prompts go there instead of bringing up a background window. ;;; 6/18/87 TWE Simplified the layout a lot by removing the gray panes and making ;;; the picture window as big as possible. All of that strange ;;; refresh code and label placement is no longer needed. Also ;;; rearranged the other panes so the picture window's height could ;;; be maximized. The main reason for doing this was to make the ;;; default font size to box size ratio be the same as that for ;;; LaTeX. Previously, the font size was about 20% too small, making ;;; the WYSIWYG not quite accurate enough. Now it is about 10% too ;;; narrow which makes it much less noticeable. The height of the ;;; default font is very close to being right on target. Also added ;;; more keystrokes so that this program would be more compatible ;;; with the GED. ;;; 5/26/87 TWE Added a menu item for the `move' operation. ;;; 5/21/87 TWE Set up code so that the picture program could be invoked from ;;; the system menu. ;;; 5/20/87 TWE Fixed up the refresh again so that the grid gets displayed ;;; upon entry. ;;; 5/19/87 TWE Fixed up the command menu item and the way the item is extracted ;;; from it. Also fixed up the displaying of the command. ;;; 5/05/87 TWE Added margins. Allow the user to draw a vector by typing V. ;;; 4/30/87 TWE Fixed up the refresh so that it works. ;;; 4/20/87 TWE Changed the defwindow resource to have a single initial copy. ;;; This should make the initial instantiation a little faster. ;;; 4/16/87 TWE Changed TV package prefixes to W. Fixed up picture-window border ;;; drawing hack to use the :draw-filled-rectangle method. ;;; 12/31/86 TWE Changed the layout of the frame to make the picture window be ;;; associated with a normal piece of paper. ;;; 12/29/86 TWE Initial creation. #| This file defines the user interface and the top-level flavor pictures. |# (DEFCONSTANT COMMAND-CHARACTER-LIST '((#\CLEAR-SCREEN REFRESH-PICTURE "Refresh the picture window") (#\HELP DISPLAY-HELP-INFORMATION "Print this text") (#\C DRAW-CIRCLE "Draw a circle") (#\D DRAW-DASHED-BOX "Draw a dashed box") (#\F DRAW-FILLED-CIRCLE "Draw a filled in circle") (#\H DRAW-HOLLOW-BOX "Draw a hollow box") (#\L DRAW-LINE "Draw a line") (#\N DRAW-EMPTY-BOX "Draw a box with no borders") (#\O DRAW-OVAL "Draw an oval") (#\R DRAW-ROUNDED-CORNER "Draw a rounded corner") (#\S DRAW-SPLINE "Draw a spline") (#\T DRAW-TEXT-STACK "Draw a text stack") (#\V DRAW-VECTOR "Draw a vector") ;; The following are what the GED uses. (#\CLEAR-INPUT DELETE-ALL-OBJECTS "Delete all objects") (#\CONTROL-G GRID-STATE-TOGGLE "Toggle grid state") (#\META-C DRAW-CIRCLE "Circle") (#\META-D DELETE-OBJECT "Delete") (#\META-E EDIT-OBJECT "Edit parameters") (#\META-L DRAW-LINE "Line") (#\META-R DRAW-HOLLOW-BOX "Rectangle") (#\META-S DRAW-SLINE "Spline") (#\META-W DRAW-TEXT-STACK "Text") (#\META-CONTROL-C DELETE-ALL-OBJECTS "Delete all objects") (#\META-CONTROL-E COPY-OBJECT "Copy") (#\META-CONTROL-F READ-PICTURE-FILE "Find picture") (#\META-CONTROL-M MOVE-OBJECT "Move") (#\META-CONTROL-R TOGGLE-READ-ONLY-PICTURE "Toggle read-only mode") (#\META-CONTROL-W WRITE-TEX-FILE "Write picture") (#\STATUS GRID-SPECIFY-VALUES "Change grid points")) "Parallel command table with the command menus. This one specifies what characters correspond to what commands. Note that the first component is a character, the second component is the function and the third component is documentation to print when displaying help. To allow one to add new commands to this table, the :ADDITIONAL-COMMAND-CHARACTERS property is defined. These new commands are of the same format and are appended after this predefined list.") (DEFUN COMMAND-CHARACTER-LIST () "Return a list of the current command characters, their functionos and associated documentation." (DECLARE (VALUES LIST)) (APPEND COMMAND-CHARACTER-LIST (GET 'COMMAND-CHARACTER-LIST :ADDITIONAL-COMMAND-CHARACTERS))) (DEFUN GENERATE-MENU-ITEM (ITEM "E COMMAND DOCUMENTATION) "2Generate a single menu item.*" (LET ((KEYSTROKE (CAAR (MEMBER COMMAND COMMAND-CHARACTER-LIST :TEST #'(LAMBDA (X Y) (EQ X (CADR Y))))))) (IF KEYSTROKE (LIST ITEM :VALUE COMMAND :DOCUMENTATION (LIST :DOCUMENTATION DOCUMENTATION :KEYSTROKE KEYSTROKE)) (LIST ITEM :VALUE COMMAND :DOCUMENTATION DOCUMENTATION)))) ;;; The following two constants are item lists for the command menus. (DEFCONSTANT GRAPHIC-EDIT-COMMAND-MENU-LIST `(("Graphics operations" :NO-SELECT NIL :FONT MEDFNB) ,(GENERATE-MENU-ITEM "Hollow Box" DRAW-HOLLOW-BOX "Draw a hollow box. ") ,(GENERATE-MENU-ITEM "Dashed Box" DRAW-DASHED-BOX "Draw a box made from dashed lines. ") ,(GENERATE-MENU-ITEM "Line" DRAW-LINE "Draw straight line. ") ,(GENERATE-MENU-ITEM "Vector" DRAW-VECTOR "Draw a line with an arrowhead at one end. ") ,(GENERATE-MENU-ITEM "Spline" DRAW-SPLINE "Draw a spline. ") ,(GENERATE-MENU-ITEM "Text Stack" DRAW-TEXT-STACK "Draw text lines stacked upon one another. ") ,(GENERATE-MENU-ITEM "Circle" DRAW-CIRCLE "Draw a hollow circle. ") ,(GENERATE-MENU-ITEM "Filled Circle" DRAW-FILLED-CIRCLE "Draw a filled circle. ") ,(GENERATE-MENU-ITEM "Oval" DRAW-OVAL "Draw oval. ") ,(GENERATE-MENU-ITEM "Rounded corner" DRAW-ROUNDED-CORNER "Draw a rounded corner - a quarter of an oval. ") ,(GENERATE-MENU-ITEM "Non-bordered box" DRAW-EMPTY-BOX "The same as a hollow box but without the borders. ") ("" :NO-SELECT NIL) ,(GENERATE-MENU-ITEM "Edit object" EDIT-OBJECT "Use the mouse to point to an object to be edited. ") ,(GENERATE-MENU-ITEM "Copy object" COPY-OBJECT "Use the mouse to point to an object to be copied. ") ,(GENERATE-MENU-ITEM "Move object" MOVE-OBJECT "Use the mouse to point to an object to be moved. ") ,(GENERATE-MENU-ITEM "Delete object" DELETE-OBJECT "Use the mouse to point to an object to be deleted. ") ,(GENERATE-MENU-ITEM "Delete all objects" DELETE-ALL-OBJECTS "Delete all objects. "))) (DEFCONSTANT FILE-GLOBAL-HELP-COMMAND-MENU-LIST `(("File Operations" :NO-SELECT NIL :FONT MEDFNB) ("Write TeX file" :BUTTONS ((NIL (WRITE-TEX-FILE T)) (NIL (WRITE-TEX-FILE T)) (NIL (WRITE-TEX-FILE NIL))) :DOCUMENTATION (:MOUSE-L-1 "" :MOUSE-M-1 "WYSIWYG write" :MOUSE-R-1 "Write LaTeX commands as is" :DOCUMENTATION "Write the TeX file which represents this picture to a file.")) ,(GENERATE-MENU-ITEM "Read Picture file" READ-PICTURE-FILE "Read the PIC file which represents a picture. ") ("" :NO-SELECT NIL) ("Change Global State" :NO-SELECT NIL :FONT MEDFNB) ("Change Line Thickness" :BUTTONS ((NIL (CHANGE-LINE-THICKNESS :THICK)) (NIL (SPECIFY-NEW-THICKNESS-DEFAULT)) (NIL (CHANGE-LINE-THICKNESS :THIN))) :DOCUMENTATION (:MOUSE-L-1 "Draw with thick lines" :MOUSE-M-1 "Specify line thickness numerically" :MOUSE-R-1 "Draw with thin lines" :DOCUMENTATION "Change the state of the line thickness.")) ,(GENERATE-MENU-ITEM "Change Units" GET-NEW-UNIT "Get a new linear unit of measure. ") ("Specify margins" :BUTTONS ((NIL (SPECIFY-MARGINS)) (NIL (SPECIFY-MARGINS)) (NIL (TURN-OFF-MARGINS))) :DOCUMENTATION (:MOUSE-L-1 "" :MOUSE-M-1 "Define new margins for the page" :MOUSE-R-1 "Turn off the margins")) ("Toggle Grid State" :BUTTONS ((NIL GRID-STATE-ON) (NIL GRID-SPECIFY-VALUES) (NIL GRID-STATE-OFF)) :DOCUMENTATION (:MOUSE-L-1 "Turn on" :MOUSE-M-1 "Specify new grid values" :MOUSE-R-1 "Turn off" :DOCUMENTATION "Change the state of the grid pattern.")) ,(GENERATE-MENU-ITEM "Orientation" TOGGLE-ORIENTATION "Toggle portrait/landscape orientation. ") ("Scale" :BUTTONS ((NIL (SCALE-PICTURE :UPPER-LEFT)) (NIL (SCALE-PICTURE :MIDDLE)) (NIL (SCALE-PICTURE :POINT))) :DOCUMENTATION (:MOUSE-L-1 "Scale to the upper left corner" :MOUSE-M-1 "Scale to the middle of the page" :MOUSE-R-1 "Scale to a specific point" :DOCUMENTATION "Scale the entire picture relative to a particular location.")) ,(GENERATE-MENU-ITEM "Default Font" NEW-DEFAULT-FONT "Change default text font. ") ("" :NO-SELECT NIL) ,(GENERATE-MENU-ITEM "Help" DISPLAY-HELP-INFORMATION "Display help information. "))) ;;; Here is where we deal with landscape/portrait issues. (DEFCONSTANT LANDSCAPE-STATUS-PANE-BORDERS '(1 2 0 1)) (DEFCONSTANT PORTRAIT-STATUS-PANE-BORDERS '(2 1 1 1)) (DEFCONSTANT LANDSCAPE-INTERACTION-PANE-BORDERS '(1 2 1 1)) (DEFCONSTANT PORTRAIT-INTERACTION-PANE-BORDERS '(2 1 1 0)) (DEFUN TOGGLE-ORIENTATION () "2Toggle portrait/landscape orientation.*" (DECLARE (SELF-FLAVOR PICTURE-WINDOW)) (IF (EQ *CURRENT-ORIENTATION* :PORTRAIT) (SET-ORIENTATION-LANDSCAPE W:SUPERIOR) (SET-ORIENTATION-PORTRAIT W:SUPERIOR))) (DEFUN SET-ORIENTATION-LANDSCAPE (PICTURE-FRAME) "2Set the current portrait/landscape orientation to landscape.*" (LET ((PICTURE-PANE (SEND PICTURE-FRAME :GET-PANE 'PICTURE-PANE)) (STATUS-PANE (SEND PICTURE-FRAME :GET-PANE 'STATUS-PANE))) (W:DELAYING-SCREEN-MANAGEMENT (SETQ *CURRENT-ORIENTATION* :LANDSCAPE) (SEND (GET-INTERACTION-PANE PICTURE-PANE) :SET-BORDERS LANDSCAPE-INTERACTION-PANE-BORDERS) (SEND STATUS-PANE :SET-BORDERS LANDSCAPE-STATUS-PANE-BORDERS) (SEND PICTURE-PANE :SET-RIGHT-MARGIN (MAX-PAGE-WIDTH)) (SEND PICTURE-PANE :SET-BOTTOM-MARGIN (MAX-PAGE-HEIGHT)) (SEND PICTURE-FRAME :SET-CONFIGURATION 'LANDSCAPE)) (SEND PICTURE-PANE :SET-Y-PIXEL-ORIGIN (TRANSLATE-UNIT-TO-PIXEL-INTERNAL (MAX-PAGE-HEIGHT) :INCH)) (SEND PICTURE-PANE :REFRESH))) (DEFUN SET-ORIENTATION-PORTRAIT (PICTURE-FRAME) "2Set the current portrait/landscape orientation to portrait.*" (LET ((PICTURE-PANE (SEND PICTURE-FRAME :GET-PANE 'PICTURE-PANE)) (STATUS-PANE (SEND PICTURE-FRAME :GET-PANE 'STATUS-PANE))) (W:DELAYING-SCREEN-MANAGEMENT (SETQ *CURRENT-ORIENTATION* :PORTRAIT) (SEND (GET-INTERACTION-PANE PICTURE-PANE) :SET-BORDERS PORTRAIT-INTERACTION-PANE-BORDERS) (SEND STATUS-PANE :SET-BORDERS PORTRAIT-STATUS-PANE-BORDERS) (SEND PICTURE-PANE :SET-RIGHT-MARGIN (MAX-PAGE-WIDTH)) (SEND PICTURE-PANE :SET-BOTTOM-MARGIN (MAX-PAGE-HEIGHT)) (SEND PICTURE-FRAME :SET-CONFIGURATION 'PORTRAIT)) (SEND PICTURE-PANE :SET-Y-PIXEL-ORIGIN (TRANSLATE-UNIT-TO-PIXEL-INTERNAL (MAX-PAGE-HEIGHT) :INCH)) (SEND PICTURE-PANE :REFRESH))) (DEFUN GET-INTERACTION-PANE (PICTURE-WINDOW) (SEND (SEND PICTURE-WINDOW :SUPERIOR) :GET-PANE 'INTERACTION-PANE)) (DEFPARAMETER PORTRAIT-MENU-FRACTION (IF EXPLORER-P 0.37 ;;ELSE we need more room on the microExplorer 0.69)) (DEFPARAMETER PORTRAIT-STATUS-PANE-FRACTION (IF EXPLORER-P 0.12 ;;ELSE 0.20)) (DEFFLAVOR PICTURE-FRAME () (W:INFERIORS-NOT-IN-SELECT-MENU-MIXIN W:PROCESS-MIXIN W:BORDERED-CONSTRAINT-FRAME) (:DEFAULT-INIT-PLIST :PROCESS '(TOP-LEVEL ; Function to be run by the process. ;; Ensure the PDL stack isn't overflown :REGULAR-PDL-SIZE 3000) :WIDTH SCREEN-WIDTH :HEIGHT SCREEN-HEIGHT :DEEXPOSED-TYPEOUT-ACTION :PERMIT :SAVE-BITS :DELAYED ; Don't create a bit-save array until we need it. :PANES `( (ALL-MENUS W:MENU :ITEM-LIST ,(CONCATENATE 'LIST GRAPHIC-EDIT-COMMAND-MENU-LIST '(("" :NO-SELECT NIL)) FILE-GLOBAL-HELP-COMMAND-MENU-LIST) :BORDERS (2 1 1 0) :COMMAND-MENU T) (BOTTOM-LABEL W:WINDOW :LABEL "Picture Window" :BLINKER-P NIL :BORDER-MARGIN-WIDTH 0 :BORDERS (0 0 0 0)) (GRAPHIC-EDIT-MENU W:MENU :ITEM-LIST ,GRAPHIC-EDIT-COMMAND-MENU-LIST :BORDERS (2 1 1 1) :COMMAND-MENU T) (FILE-GLOBAL-HELP-MENU W:MENU :ITEM-LIST ,FILE-GLOBAL-HELP-COMMAND-MENU-LIST :BORDERS (1 1 1 1) :COMMAND-MENU T) ;; Define the picture window so that inside-width = outside-width. ;; In this way the constraint calculation is easy. (PICTURE-PANE PICTURE-WINDOW :BORDERS NIL :BORDER-MARGIN-WIDTH 0 :FONT-MAP ,(CONS :DEFAULT *ALL-FONTS*) :BLINKER-P NIL :LABEL NIL) (STATUS-PANE W:WINDOW :LABEL "Status Window" :MORE-P NIL :BORDERS ,PORTRAIT-STATUS-PANE-BORDERS) (INTERACTION-PANE INTERACTION-WINDOW :LABEL "Interaction Window" :MORE-P NIL :BORDERS ,PORTRAIT-INTERACTION-PANE-BORDERS) ) :CONSTRAINTS `((PORTRAIT (DUMMY1) ((DUMMY1 :HORIZONTAL (:EVEN) (DUMMY-LEFT DUMMY-RIGHT) ((DUMMY-LEFT :VERTICAL (,PORTRAIT-WIDTH) (PICTURE-PANE BOTTOM-LABEL) ((PICTURE-PANE ,PORTRAIT-HEIGHT)) ((BOTTOM-LABEL :EVEN)))) ((DUMMY-RIGHT :VERTICAL (:EVEN) (STATUS-PANE DUMMY8 INTERACTION-PANE) ((STATUS-PANE ,PORTRAIT-STATUS-PANE-FRACTION) (DUMMY8 :HORIZONTAL (,PORTRAIT-MENU-FRACTION) (GRAPHIC-EDIT-MENU FILE-GLOBAL-HELP-MENU) ((GRAPHIC-EDIT-MENU 0.5)) ((FILE-GLOBAL-HELP-MENU :EVEN)))) ((INTERACTION-PANE :EVEN))))))) (LANDSCAPE (DUMMY-TOP DUMMY-BOTTOM) ;; Dummy-top is the picture window, label window and menus window. Its ;; height is the height of the picture window + height of the label window. ((DUMMY-TOP :HORIZONTAL (,(+ LABEL-WINDOW-HEIGHT LANDSCAPE-HEIGHT)) (DUMMY-LEFT ALL-MENUS) ((DUMMY-LEFT :VERTICAL (,LANDSCAPE-WIDTH) (PICTURE-PANE BOTTOM-LABEL) ((PICTURE-PANE ,LANDSCAPE-HEIGHT)) ((BOTTOM-LABEL :EVEN)))) ((ALL-MENUS :ASK :PANE-SIZE)))) ((DUMMY-BOTTOM :HORIZONTAL (:EVEN) (INTERACTION-PANE STATUS-PANE) ((INTERACTION-PANE 0.5)) ((STATUS-PANE :EVEN))))))) (:DOCUMENTATION "High level frame to create LaTeX pictures.")) (DEFMETHOD (PICTURE-FRAME :NAME-FOR-SELECTION) () "Picture Window") ;;; All of the refresh code is here. (DEFUN REFRESH-PICTURE () (DECLARE (SELF-FLAVOR PICTURE-WINDOW)) (SEND SELF :SET-CURSORPOS 0 0) (SEND SELF :CLEAR-EOF) (DOLIST (OBJECT DISPLAY-LIST) (SEND OBJECT :DRAW SELF)) (SEND SELF :DRAW-GRID)) (DEFMETHOD (PICTURE-WINDOW :AFTER :REFRESH) (&OPTIONAL TYPE) (DECLARE (IGNORE TYPE)) (REFRESH-PICTURE)) ;;; The following function is called when the process associated with the picture ;;; frame starts up. (DEFUN TOP-LEVEL (WINDOW) (MAKE-PICTURE :CALLED-FROM-PROCESS WINDOW)) ;;; Note that this function can either be invoked via the system menu or can ;;; be invoked from a Lisp Listener. If one invokes it from a listener then ;;; pressing the END key will cause it to not work properly from the system ;;; menu, since the process exits. When invoking it from the system menu, ;;; one can still press the END key since the process will wait around for ;;; the window to be selected again. In this way, one can invoke it from a ;;; listener and reinvoke it there and get consistent behavior. The same is ;;; true when invoked from the system menu. (DEFUN MAKE-PICTURE (&OPTIONAL (REENTER NIL) (WINDOW NIL)) "2Top level function to make pictures for LaTeX. Specify REENTER as T when you want to edit what is already there.*" (LET (PICTURE-FRAME-INSTANCE (CALLED-FROM-PROCESS NIL)) (IF WINDOW (SETQ PICTURE-FRAME-INSTANCE WINDOW) ;;1ELSE* (SETQ PICTURE-FRAME-INSTANCE (W:FIND-WINDOW-OF-FLAVOR 'PICTURE-FRAME))) (WHEN (EQ REENTER :CALLED-FROM-PROCESS) (SETQ CALLED-FROM-PROCESS T)) (WHEN PICTURE-FRAME-INSTANCE (LET ((PICTURE-PANE (SEND PICTURE-FRAME-INSTANCE :GET-PANE 'PICTURE-PANE)) (GRAPHIC-EDIT-MENU (SEND PICTURE-FRAME-INSTANCE :GET-PANE 'GRAPHIC-EDIT-MENU)) (FILE-GLOBAL-HELP-MENU (SEND PICTURE-FRAME-INSTANCE :GET-PANE 'FILE-GLOBAL-HELP-MENU)) (INTERACTION-PANE (SEND PICTURE-FRAME-INSTANCE :GET-PANE 'INTERACTION-PANE)) (ALL-MENUS (SEND PICTURE-FRAME-INSTANCE :GET-PANE 'ALL-MENUS)) (IO-BUFFER (W:MAKE-DEFAULT-IO-BUFFER))) (SEND PICTURE-PANE :SET-IO-BUFFER IO-BUFFER) (SEND GRAPHIC-EDIT-MENU :SET-IO-BUFFER IO-BUFFER) (SEND FILE-GLOBAL-HELP-MENU :SET-IO-BUFFER IO-BUFFER) (SEND INTERACTION-PANE :SET-IO-BUFFER IO-BUFFER) (SEND ALL-MENUS :SET-IO-BUFFER IO-BUFFER) (SEND PICTURE-PANE :SET-MOUSING-STATUS NIL) (SETQ *CURRENT-ORIENTATION* :PORTRAIT) (SEND PICTURE-PANE :SET-RIGHT-MARGIN (MAX-PAGE-WIDTH)) (SEND PICTURE-PANE :SET-BOTTOM-MARGIN (MAX-PAGE-HEIGHT)) (SEND PICTURE-PANE :SET-SELECTION-SUBSTITUTE (GET-INTERACTION-PANE PICTURE-PANE)) (SEND PICTURE-PANE :SET-STATUS-PANE (SEND PICTURE-FRAME-INSTANCE :GET-PANE 'STATUS-PANE)) (WHEN (NULL REENTER) (SEND PICTURE-PANE :SET-MAXIMUM-X-UNIT 0.0) (SEND PICTURE-PANE :SET-MAXIMUM-Y-UNIT 0.0) (SEND PICTURE-PANE :SET-MINIMUM-X-UNIT MOST-POSITIVE-SHORT-FLOAT) (SEND PICTURE-PANE :SET-MINIMUM-Y-UNIT MOST-POSITIVE-SHORT-FLOAT) (SEND PICTURE-PANE :SET-MARGIN-OBJECT NIL) (SEND PICTURE-PANE :SET-LEFT-MARGIN 0.0) (SEND PICTURE-PANE :SET-TOP-MARGIN 0.0) (SEND PICTURE-PANE :SET-RIGHT-MARGIN (MAX-PAGE-WIDTH)) (SEND PICTURE-PANE :SET-BOTTOM-MARGIN (MAX-PAGE-HEIGHT)) (SEND PICTURE-PANE :SET-DISPLAY-LIST NIL)) (SEND PICTURE-FRAME-INSTANCE :EXPOSE) (SEND INTERACTION-PANE :SELECT) (SETQ *TERMINAL-IO* INTERACTION-PANE) (WHEN (NULL REENTER) (SEND PICTURE-PANE :CLEAR-EOF) (SEND INTERACTION-PANE :SET-CURSORPOS 0 0) (SEND INTERACTION-PANE :CLEAR-EOF) (SEND GRAPHIC-EDIT-MENU :REFRESH) (SEND FILE-GLOBAL-HELP-MENU :REFRESH)) (SEND PICTURE-PANE :SETUP-INSTANCE-ENVIRONMENT 'REFRESH-PICTURE) (LOOP DO (PROGN (PROCESS-WAIT "Wait for Select" #'(LAMBDA (WINDOW) (SEND WINDOW :SELF-OR-SUBSTITUTE-SELECTED-P)) PICTURE-FRAME-INSTANCE) (LOOP WITH THIS-COMMAND = NIL FOR INPUT = (SEND PICTURE-PANE :ANY-TYI) UNTIL (AND (OR (INTEGERP INPUT) (CHARACTERP INPUT)) (SETQ INPUT (INT-CHAR INPUT)) (CHAR= INPUT #\END)) DO (PROGN (IF (LISTP INPUT) (COND ((EQ (CAR INPUT) :MENU) ;; Hack alert. For some reason we have a QUOTE ;; inserted into the input and I don't know how ;; this is happening. This is a 1REAL* hack that ;; papers over this bug. (WHEN (AND (LISTP (THIRD (SECOND INPUT))) (EQ (CAR (THIRD (SECOND INPUT))) 'QUOTE)) ;; Replace the list (QUOTE SYMBOL) with just SYMBOL. (SETF (THIRD (SECOND INPUT)) (CADR (THIRD (SECOND INPUT))))) (SETQ THIS-COMMAND (SEND (FOURTH INPUT) :EXECUTE (SECOND INPUT))) (FORMAT (GET-INTERACTION-PANE PICTURE-PANE) "~A~%" THIS-COMMAND) (SEND PICTURE-PANE :SETUP-INSTANCE-ENVIRONMENT THIS-COMMAND)) ((EQ (CAR INPUT) :MOUSE-BUTTON) (SEND PICTURE-PANE :SETUP-INSTANCE-ENVIRONMENT `(DESCRIBE-OBJECT ,(FOURTH INPUT) ,(FIFTH INPUT)))) (T (FORMAT (GET-INTERACTION-PANE PICTURE-PANE) "Unknown~%"))) ;;1ELSE* (WHEN (AND (CHARACTERP INPUT) (SETQ INPUT (CADR (ASSOC (CHAR-UPCASE INPUT) (COMMAND-CHARACTER-LIST) :TEST #'CHAR=)))) (SETQ THIS-COMMAND INPUT) (FORMAT (GET-INTERACTION-PANE PICTURE-PANE) "~A~%" THIS-COMMAND) (SEND PICTURE-PANE :SETUP-INSTANCE-ENVIRONMENT INPUT))))) (SEND PICTURE-FRAME-INSTANCE :BURY) (WHEN (NOT CALLED-FROM-PROCESS) (RETURN NIL)))))))) ;;; Put an entry into the system menu. (TV:ADD-TO-SYSTEM-MENU-COLUMN :PROGRAMS "Picture" '(TV:SELECT-OR-CREATE-WINDOW-OF-FLAVOR 'PICTURE:PICTURE-FRAME) "Generate pictures suitable for input into LaTeX.")