SRRAT: use MRAT reader functions instead of CADDAR, etc.
[maxima.git] / archive / src / pltwin.lisp
blob46fd3f5db4624c12f176e4bca4d3146f0f047a04
1 ;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;; The data in this file contains enhancments. ;;;;;
4 ;;; ;;;;;
5 ;;; Copyright (c) 1984,1987 by William Schelter,University of Texas ;;;;;
6 ;;; All rights reserved ;;;;;
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9 (in-package "MAXIMA")
10 ;;; Window System Interface for the Macsyma Plot Package.
12 ;;; First define the high level structures, namely the constraint frames
13 ;;; which contain a plotting window, a menu, and (optionally) a Macsyma listener.
15 ;;; Some special variables needed below.
19 (DEFVAR PLOT-FONT-MAP 'FONTS:(CPTFONT MEDFNT BIGFNT)) ;fonts used on plot windows
21 (proclaim '(special plot-stream))
23 (DEFVAR PLOT-ITEM-LIST NIL)
25 (DEFMACRO DEFINE-PLOT-MODE (FUNCTION CHARACTER NAME DOCUMENTATION)
26 `(DEFINE-PLOT-MODE-1 ',FUNCTION ',CHARACTER ',NAME ',DOCUMENTATION))
28 (DEFUN DEFINE-PLOT-MODE-1 (FUNCTION CHARACTER NAME DOCUMENTATION)
29 (LET ((ELEM (zl-ASSOC NAME PLOT-ITEM-LIST)))
30 (IF ELEM (SETQ PLOT-ITEM-LIST (DELQ ELEM PLOT-ITEM-LIST))))
31 (SETQ PLOT-ITEM-LIST
32 (APPEND PLOT-ITEM-LIST ;use APPEND, not NCONC, so that it will look different!
33 (NCONS (LIST NAME
34 ':VALUE (LIST FUNCTION CHARACTER NAME DOCUMENTATION)
35 ':DOCUMENTATION DOCUMENTATION)))))
37 (DEFINE-PLOT-MODE Menu-plot #\M "Options"
38 "Menu of options for replotting")
40 (DEFINE-PLOT-MODE Replot-graph #\R "Replot"
41 "Replot after giving a menu to adjust")
43 (DEFINE-PLOT-MODE plot-graph #\P "Plot"
44 "Plot prompting for function in menu window.")
46 (DEFINE-PLOT-MODE Hardcopy-graph #\H "Hardcopy"
47 "Hardcopy if supported")
49 (DEFINE-PLOT-MODE End-graph #\E "Exit"
50 "Exit and return to Macsyma top level")
53 ;;;; Menu item lists for the plot menu.
54 ;(DEFVAR PLOT-MENU-ITEM-LIST
55 ; '(("Continue" :KBD #/C)
56 ; ("Options" :kbd #/V)
57 ; ("Name" :KBD #/N)
58 ; ("Hardcopy" :KBD #/H)
59 ; ("Other" :KBD #/O)))
60 ;(DEFVAR PLOT-MENU-ITEM-LIST
61 ; '(("Continue" :KBD #/C)
62 ; ("Options" :kbd #/V)
63 ; ("Name" :KBD #/N)
64 ; ("Hardcopy" :KBD #/H)
65 ; ("Other" :menu (send self :execute '("other" :kbd #/v)))))
66 ;;how to get the other to select the choices?
68 ;(DEFVAR PLOT-OTHER-MENU-ITEM-LIST ;invoked by OTHER-CMDS
69 ; '(("Store" . :STORE-PLOT)
70 ; ("Retrieve" . :RETRIEVE-PLOT)
71 ; ("Multiple Plots" . :REPLOT-MULTIPLE)
72 ; ("Options" . :CHANGE-OPTIONS)
73 ; ("Change Plot" . :CHANGE-PARAMETERS)))
75 ;;; Define a Macsyma plot frame.
77 (DEFFLAVOR MACSYMA-PLOT-FRAME ((MACSYMA-LISTENER-WINDOW NIL))
78 (tv:BORDERED-CONSTRAINT-FRAME)
79 (:DEFAULT-INIT-PLIST :SAVE-BITS T)
80 (:INITABLE-INSTANCE-VARIABLES MACSYMA-LISTENER-WINDOW)
83 (defmethod (macsyma-plot-frame :after :init) (ignore &aux menu)
84 (setq menu (car (send self :exposed-panes)))
85 #+obsolete ;;this is now done in $plot3d by the set-command... message.
86 (let ((win (car (send current-process :run-reasons))))
87 (cond ((symbolp win))
88 (t (send menu :set-io-buffer (send win :io-buffer)))))
91 (defmethod (macsyma-plot-frame :set-command-menu-io-buffer-to-plot-stream-buffer)
92 ( &aux menu)
93 (setq menu (car (send self :exposed-panes)))
95 ; (send menu :set-io-buffer (send (car (send current-process :run-reasons))
96 ; :io-buffer)))
98 (send menu :set-io-buffer (send plot-stream
99 :io-buffer)))
102 ;;; Defines the panes contained in the frame and the constaints they must satisfy.
103 ;;; Note, if MACSYMA-LISTENER-WINDOW is non-nil, it is assumed that the thus
104 ;;; specified MACSYMA-LISTENER is to be included at the bottom of the frame.
106 (DEFMETHOD (MACSYMA-PLOT-FRAME :BEFORE :INIT) (IGNORE &AUX LISTENER-ITEM
107 LISTENER-PANE-ITEM
108 LISTENER-CONSTRAINT
109 PLOT-PANE-CONSTRAINT)
110 (SETQ PLOT-PANE-CONSTRAINT '((PLOT-PANE :EVEN)))
111 (IF MACSYMA-LISTENER-WINDOW
112 (SETQ LISTENER-ITEM '(LISTENER-PANE)
113 LISTENER-PANE-ITEM '((LISTENER-PANE MACSYMA-LISTENER))
114 LISTENER-CONSTRAINT '(((LISTENER-PANE :EVEN)))
115 PLOT-PANE-CONSTRAINT '((PLOT-PANE 0.75s0))))
116 (setq win (global:format nil "Macsyma Plotting Window"))
117 (SETQ TV:PANES `((PLOT-PANE MACSYMA-PLOT-PANE :LABEL ,win
118 #-symbolics :FONT-MAP #-symbolics ,PLOT-FONT-MAP
120 (PLOT-MENU TV:COMMAND-MENU-PANE :ITEM-LIST ,PLOT-ITEM-LIST
121 #-symbolics :FONT-MAP #-symbolics (FONTS:MEDFNT)
123 .,LISTENER-PANE-ITEM)
124 TV:CONSTRAINTS `((MAIN . ((PLOT-PANE PLOT-MENU .,LISTENER-ITEM)
125 ((PLOT-MENU :ASK :PANE-SIZE))
126 ,PLOT-PANE-CONSTRAINT
127 .,LISTENER-CONSTRAINT)))))
129 ;;; Now define the MACSYMA-PLOT-PANE and MACSYMA-PLOT-MENU flavors.
130 (DEFFLAVOR MACSYMA-PLOT-PANE () (TV:PANE-MIXIN TV:WINDOW))
131 (DEFFLAVOR macsyma-plot-menu () (TV:pane-MIXIN tv:command-menu))
132 ;; Compute some global variables which the LGP, etc. needs
133 ;; to know about.
134 (DEFVAR PLOT-FONT (SEND tv:main-screen ':CURRENT-FONT))
135 (DEFVAR PLOT-WIDTH 762)
136 (DEFVAR PLOT-HEIGHT 854)
137 (DEFVAR CHAR-HEIGHT 12)
138 (DEFVAR CHAR-WIDTH 8)
140 (DEFMETHOD (MACSYMA-PLOT-PANE :UPDATE-VARIABLES) ()
141 (MULTIPLE-VALUE-SETQ (PLOT-WIDTH PLOT-HEIGHT) (send self ':INSIDE-SIZE))
142 (SETQ PLOT-FONT (send SELF ':CURRENT-FONT)
143 CHAR-WIDTH (FONT-CHAR-WIDTH PLOT-FONT)
144 CHAR-HEIGHT (FONT-CHAR-HEIGHT PLOT-FONT)))
146 ;;; Window of the plotting area
147 (DEFMETHOD (MACSYMA-PLOT-PANE :GET-PLOTTING-RANGE) ()
148 (SEND SELF ':UPDATE-VARIABLES)
149 (LIST 10 10 (f- (f1- PLOT-WIDTH) 10) (f- (f1- PLOT-HEIGHT) 10)))
151 ;;; Clear the plot pane, make sure it has the same IO-BUFFER as
152 ;;; the Macsyma listener (TERMINAL-IO), select the plotting pane,
153 ;;; and expose the whole plotting frame.
154 ;;; (It is unclear if TERMINAL-IO is the right thing here, but...)
157 (DEFMETHOD (MACSYMA-PLOT-PANE :INIT-FOR-PLOTTING)
158 (&AUX (IO-BUFFER (FUNCALL *terminal-io* ':IO-BUFFER))
159 (MENU (FUNCALL TV:SUPERIOR ':GET-PANE 'PLOT-MENU)))
160 ;; (SEND SELF ':CLEAR-SCREEN) ;clear the plot pane before exposing
161 (SETQ TV:IO-BUFFER IO-BUFFER) ;plot pane's io-buffer
162 #-genera (SET-IN-INSTANCE MENU 'TV:IO-BUFFER IO-BUFFER)
163 #+genera (send menu :set-io-buffer io-buffer)
164 ;;plot menu's io-buffer
165 (SEND SELF ':EXPOSE-PLOT))
167 ;(DEFMETHOD (MACSYMA-PLOT-PANE :INIT-FOR-PLOTTING) ()
168 ;; (&AUX (IO-BUFFER (FUNCALL TERMINAL-IO ':IO-BUFFER))
169 ;; (MENU (FUNCALL TV:SUPERIOR ':GET-PANE 'PLOT-MENU)))
170 ;;; (SEND SELF ':CLEAR-SCREEN) ;clear the plot pane before exposing
171 ;; (SETQ TV:IO-BUFFER IO-BUFFER) ;plot pane's io-buffer
172 ;; (SET-IN-INSTANCE MENU 'TV:IO-BUFFER IO-BUFFER) ;plot menu's io-buffer
173 ; (SEND SELF ':EXPOSE-PLOT))
175 ;;; Select the original Macsyma listener (TERMINAL-IO) and bury
176 ;;; if necessary.
177 (defvar $replotting t)
178 (DEFMETHOD (MACSYMA-PLOT-PANE :END-PLOTTING) ()
179 (cond ((null $replotting) (TV:DESELECT-AND-MAYBE-BURY-WINDOW TV:SUPERIOR)
180 (FUNCALL *terminal-io* ':SELECT))))
182 ;; Define the primitive functions for drawing etc.
183 (DEFMETHOD (MACSYMA-PLOT-PANE :EXPOSE-PLOT) ()
184 (SEND SELF ':UPDATE-VARIABLES)
185 (FUNCALL TV:SUPERIOR ':EXPOSE) ;expose the whole frame
186 (SEND SELF ':SELECT)) ;and select the plot pane
188 (DEFMETHOD (MACSYMA-PLOT-PANE :PLOT-LINE) (X0 Y0 X1 Y1)
189 (SEND SELF ':DRAW-LINE X0 (f- PLOT-HEIGHT Y0 1) X1 (f- PLOT-HEIGHT Y1 1)))
191 (DEFMETHOD (MACSYMA-PLOT-PANE :PLOT-POINT) (X Y)
192 (LET ((X X) (Y (f- PLOT-HEIGHT Y 1)))
193 (SEND SELF ':DRAW-POINT X Y)
194 (SEND SELF ':DRAW-POINT (f1+ X) Y)
195 (SEND SELF ':DRAW-POINT (f1+ X) (f1+ Y))
196 (SEND SELF ':DRAW-POINT X (f1+ Y))))
198 (DEFMETHOD (MACSYMA-PLOT-PANE :PLOT-CHAR) (CHAR X Y)
199 (SEND SELF ':DRAW-CHAR #-symbolics PLOT-FONT
200 CHAR X (f- PLOT-HEIGHT (f+ Y CHAR-HEIGHT) 1)))
202 (DEFMETHOD (MACSYMA-PLOT-PANE :HARDCOPY) ()
203 (LET ((TV:SELECTED-WINDOW SELF))
204 (TV:KBD-ESC-Q 1)))
206 (DEFVAR PLOT-FRAME) ;handy for debugging
208 ;; generalize this to include a Macsyma Listener option
209 (DEFUN MAKE-PLOT-WINDOW-STREAM ()
210 (SETQ PLOT-FRAME (TV:MAKE-WINDOW 'MACSYMA-PLOT-FRAME ':SAVE-BITS T))
211 (FUNCALL PLOT-FRAME ':GET-PANE 'PLOT-PANE))
213 (DEFVAR SPLIT-SCREEN-PLOT-FRAME NIL)
215 ;;; Setup for plotting and Macsyma listening
216 (DEFUN $PLOT_SPLITSCREEN ()
217 (IF (NOT SPLIT-SCREEN-PLOT-FRAME)
218 (SETQ SPLIT-SCREEN-PLOT-FRAME
219 (TV:MAKE-WINDOW 'MACSYMA-PLOT-FRAME ':MACSYMA-LISTENER-WINDOW T)))
220 (SETQ PLOT-STREAM (FUNCALL SPLIT-SCREEN-PLOT-FRAME ':GET-PANE 'PLOT-PANE))
221 (FUNCALL SPLIT-SCREEN-PLOT-FRAME ':EXPOSE)
222 (FUNCALL (FUNCALL SPLIT-SCREEN-PLOT-FRAME ':GET-PANE 'LISTENER-PANE) ':SELECT)
223 '$DONE)
225 (DEFUN $PLOT_FULLSCREEN ()
226 (SETQ PLOT-STREAM (IF (NOT (BOUNDP 'PLOT-FRAME)) (MAKE-PLOT-WINDOW-STREAM)
227 (FUNCALL PLOT-FRAME ':GET-PANE 'PLOT-PANE)))
228 (FUNCALL MACSYMA-TOP-WINDOW ':EXPOSE)
229 (FUNCALL MACSYMA-TOP-WINDOW ':SELECT))
231 (COMPILE-FLAVOR-METHODS MACSYMA-PLOT-PANE MACSYMA-PLOT-FRAME)