src/geomview_def.lisp

   1 ;; gnuplot.lisp: routines for Maxima's interface to gnuplot
   2 ;; Copyright (C) 2021 J. Villate
   3 ;;
   4 ;; This program is free software; you can redistribute it and/or
   5 ;; modify it under the terms of the GNU General Public License
   6 ;; as published by the Free Software Foundation; either version 2
   7 ;; of the License, or (at your option) any later version.
   8 ;;
   9 ;; This program is distributed in the hope that it will be useful,
  10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;; GNU General Public License for more details.
  13 ;;
  14 ;; You should have received a copy of the GNU General Public License
  15 ;; along with this program; if not, write to the Free Software
  16 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
  17 ;; MA  02110-1301, USA
  18
  19 (in-package :maxima)
  20
  21 (defmethod plot-preamble ((plot geomview-plot) options)
  22   (setf (slot-value plot 'data) (format nil "LIST~%"))
  23   (values))
  24
  25 (defmethod plot3d-command ((plot geomview-plot) functions options titles)
  26   (let ((i 0) fun xrange yrange lvars trans)
  27     (setf
  28      (slot-value plot 'data)
  29      (concatenate
  30       'string
  31       (slot-value plot 'data)
  32       (with-output-to-string ($pstream)
  33         ;; generate the mesh points for each surface in the functions stack
  34         (dolist (f functions)
  35           (setq i (+ 1 i))
  36           (setq fun (first f))
  37           (setq xrange (second f))
  38           (setq yrange (third f))
  39           (if ($listp fun)
  40               (progn
  41                 (setq trans
  42                       ($make_transform `((mlist) ,(second xrange)
  43                                          ,(second yrange) $z)
  44                                        (second fun) (third fun) (fourth fun)))
  45                 (setq fun '$zero_fun))
  46               (let*
  47                   ((x0 (third xrange))
  48                    (x1 (fourth xrange))
  49                    (y0 (third yrange))
  50                    (y1 (fourth yrange))
  51                    (xmid (+ x0 (/ (- x1 x0) 2)))
  52                    (ymid (+ y0 (/ (- y1 y0) 2))))
  53                 (setq lvars `((mlist) ,(second xrange) ,(second yrange)))
  54                 (setq fun (coerce-float-fun fun lvars))
  55                 ;; Evaluate FUN at the middle point of the range.
  56                 ;; Looking at a single point is somewhat unreliable.
  57                 ;; Call FUN with numerical arguments (symbolic arguments may
  58                 ;; fail due to trouble computing real/imaginary parts for
  59                 ;; complicated expressions, or it may be a numerical function)
  60                 (when (cdr ($listofvars (mfuncall fun xmid ymid)))
  61                   (mtell
  62                    (intl:gettext
  63                     "plot3d: expected <expr. of v1 and v2>, [v1,min,max], [v2,min,max]~%"))
  64                   (mtell
  65                    (intl:gettext
  66                     "plot3d: keep going and hope for the best.~%")))))
  67           (let* ((pl
  68                   (draw3d
  69                    fun (third xrange) (fourth xrange) (third yrange)
  70                    (fourth yrange) (first (getf options '$grid))
  71                    (second (getf options '$grid))))
  72                  (ar (polygon-pts pl)))
  73             (declare (type (cl:array t) ar))
  74             (when trans (mfuncall trans ar))
  75             (when (getf options '$transform_xy)
  76                 (mfuncall (getf options '$transform_xy) ar))
  77             (format $pstream "{ appearance { +smooth }~%MESH ~a ~a ~%"
  78                     (+ 1 (first (getf options '$grid)))
  79                     (+ 1 (second (getf options '$grid))))
  80             (output-points pl nil)
  81             (format $pstream "}~%"))))))))
  82
  83 (defmethod plot-shipout ((plot geomview-plot) options &optional output-file)
  84   (let ((file (plot-file-path (format nil "maxout~d.geomview" (getpid)))))
  85     (with-open-file (fl
  86                      #+sbcl (sb-ext:native-namestring file)
  87                      #-sbcl file
  88                      :direction :output :if-exists :supersede)
  89       (format fl "~a" (slot-value plot 'data)))
  90     ($system $geomview_command
  91              #-(or (and sbcl win32) (and sbcl win64) (and ccl windows))
  92              (format nil " ~s &" file)
  93              #+(or (and sbcl win32) (and sbcl win64) (and ccl windows))
  94              file)
  95     (cons '(mlist) (cons file output-file))))