src/visualize/plot.lisp

   1 ;;; -*- mode: lisp -*-
   2
   3 ;;; Time-stamp: <2009-04-23 08:05:57 tony>
   4 ;;; Creation:   <2009-03-10 16:59:37 tony>
   5 ;;; File:       plot.lisp
   6 ;;; Author:     AJ Rossini <blindglobe@gmail.com>
   7 ;;; Copyright:  (c)2009--, AJ Rossini.  BSD, LLGPL, or GPLv2, depending
   8 ;;;             on how it arrives.
   9 ;;; Purpose:    visualization and plotting generics and methods.
  10
  11 ;;; What is this talk of 'release'? Klingons do not make software
  12 ;;; 'releases'.  Our software 'escapes', leaving a bloody trail of
  13 ;;; designers and quality assurance people in its wake.
  14
  15 ;;; This organization and structure is new to the 21st Century
  16 ;;; version.
  17
  18 (in-package :cls-visualize)
  19
  20 ;;;; CL-PLPLOT experiments
  21
  22
  23 ;;; To solve - need to figure out how to keep the damn'd thing from
  24 ;;; mem-fault'ing.  otherwise, have most of what we need to make it
  25 ;;; all work for 2-d graphics.
  26
  27 (asdf:oos 'asdf:load-op 'cl-plplot)
  28
  29 (in-package :cls-visualize-plplot)
  30
  31 ;; set this to the appropriate plplot device for your system
  32 #|
  33  < 1> xwin       X-Window (Xlib)
  34  < 2> gcw        Gnome Canvas Widget
  35  < 3> ps         PostScript File (monochrome)
  36  < 4> psc        PostScript File (color)
  37  < 5> xfig       Fig file
  38  < 6> hp7470     HP 7470 Plotter File (HPGL Cartridge, Small Plotter)
  39  < 7> hp7580     HP 7580 Plotter File (Large Plotter)
  40  < 8> lj_hpgl    HP Laserjet III, HPGL emulation mode
  41  < 9> pbm        PDB (PPM) Driver
  42  <10> null       Null device
  43  <11> mem        User-supplied memory device
  44  <12> wxwidgets  wxWidgets Driver
  45  <13> svg        Scalable Vector Graphics (SVG 1.1)
  46  <14> xcairo     Cairo X Windows Driver
  47  <15> pdfcairo   Cairo PDF Driver
  48  <16> pscairo    Cairo PS Driver
  49  <17> svgcairo   Cairo SVG Driver
  50  <18> pngcairo   Cairo PNG Driver
  51 |#
  52
  53
  54 ;;(defparameter *gdev* "aqt")
  55 (defparameter *gdev* "xcairo")
  56 ;;(defparameter *gdev* "xwin")
  57 ;;(defparameter *gdev* "gnome")
  58 ;;(defparameter *gdev* "wxwidgets")
  59 (plsdev *gdev*)
  60
  61
  62 ;;; Helper functions
  63
  64 (defun my-make-array (dims)
  65   (make-array dims :initial-element 0.0 :element-type 'float))
  66
  67 (defun example-func-1 (x y)
  68   (- (* x x) (* y y) (* (sin (* 7 x)) (* (cos (* 7 y))))))
  69
  70 (defun example-func-2 (x y)
  71   (let ((z (+ (expt (1- x) 2) (* 100 (expt (- y (expt x 2)) 2)))))
  72     (if (> z 0)
  73         (log z)
  74         0.0)))
  75
  76 (defun example-matrix (sx sy fn)
  77   (let ((mat (my-make-array (list sx sy)))
  78         (dx (/ 2 sx))
  79         (dy (/ 2 sy)))
  80     (dotimes (x sx)
  81       (dotimes (y sy)
  82         (setf (aref mat x y) (funcall fn (1- (* dx x)) (1- (* dy y))))))
  83     mat))
  84
  85 (defun make-levels (levels min max)
  86   (let ((clevels (my-make-array levels)))
  87     (dotimes (i levels)
  88       (setf (aref clevels i) (+ min (/ (* (- max min) (+ 0.5 i)) levels))))
  89     clevels))
  90
  91 ;;; Examples
  92
  93 ;; A 2D plot
  94
  95 (defun plot-ex ()
  96   (plsdev *gdev*)
  97   (plinit)
  98   (plcol0 1)
  99   (plwid 2)
 100   (plenv 0 6 0 36 0 0)
 101   (plcol0 2)
 102   (pllab "(x)" "(y)" "y = x#u2")
 103   (let ((xs (my-make-array 6))
 104         (ys (my-make-array 6))
 105         (x (my-make-array 60))
 106         (y (my-make-array 60)))
 107     (dotimes (i 6)
 108       (setf (aref xs i) i)
 109       (setf (aref ys i) (* i i)))
 110     (plcol0 4)
 111     (plpoin xs ys 9)
 112     (dotimes (i 60)
 113       (let ((tmp (* 0.1 i)))
 114         (setf (aref x i) tmp)
 115         (setf (aref y i) (* tmp tmp))))
 116     (plcol0 3)
 117     (plline x y))
 118   (plend))
 119
 120 ;; (plot-ex)
 121
 122 ;; Contour plot of data
 123
 124 (defun contour-plot-ex ()
 125   (plsdev *gdev*)
 126   (plinit)
 127   (plenv 0 34 0 44 0 0)
 128   (plcont (example-matrix 35 45 #'example-func-1) 1 35 1 45 (make-levels 20 -1.0 1.0))
 129   (plcol0 1)
 130   (plbox "bcnst" 0 0 "bcnstv" 0 0)
 131   (plcol0 2)
 132   (pllab "x" "y" "Contour Plot (Data)")
 133   (plend))
 134
 135 #+nil
 136 (progn
 137   (contour-plot-ex))
 138
 139 ;; Contour plot of a function
 140
 141 (defun fn-contour-plot-ex ()
 142   (plsdev *gdev*)
 143   (plinit)
 144   (plenv 0 34 0 44 0 0)
 145   (pl-set-feval-fn
 146    #'(lambda (x y p)
 147        (declare (ignore p))
 148        (coerce (example-func-1 (1- (/ x 17))
 149                                (1- (/ y 22)))
 150                'double-float)))
 151   (plfcont (pl-null-pointer) 35 45 1 35 1 45 (make-levels 20 -1.0 1.0))
 152   (pl-reset-feval-fn)
 153   (plcol0 1)
 154   (plbox "bcnst" 0 0 "bcnstv" 0 0)
 155   (plcol0 2)
 156   (pllab "x" "y" "Contour Plot (Function)")
 157   (plend))
 158
 159 #+nil(fn-contour-plot-ex)
 160 ;; Shade plot
 161
 162 (defun shade-plot-ex ()
 163   (plsdev *gdev*)
 164   (plinit)
 165   (plenv -1 1 -1 1 0 0)
 166   (plshades (example-matrix 35 45 #'example-func-1) -1 1 -1 1 (make-levels 20 -1.0 1.0) 2 1 1 nil)
 167   (plcol0 1)
 168   (plbox "bcnst" 0 0 "bcnstv" 0 0)
 169   (plcol0 2)
 170   (pllab "x" "y" "Shade Plot")
 171   (plend))
 172
 173 #+nil(shade-plot-ex)
 174
 175
 176 ;; 3D surface plot. Also demonstrates 3D text labeling.
 177
 178 (defun 3D-plot-ex ()
 179   (plsdev *gdev*)
 180   (plinit)
 181   (pladv 0)
 182   (plvpor 0 1 0 0.9)
 183   (plwind -1 1 -0.9 1.1)
 184   (plscmap1n 256)
 185   (plscmap1l 1 (vector 0.0 1.0) (vector 0.2 1) (vector 0.2 1) (vector 0.2 1) (vector nil nil))
 186   (plw3d 1 1 1 -1.5 1.5 -0.5 1.5 -5 6.5 60 30)
 187   (plmtex "t" 1 0.5 0.5 "3D plot example")
 188   (plbox3 "bnstu" "x axis" 0 0 "bnstu" "y axis" 0 0 "bcdmnst" "" 0 0)
 189   (plmtex3 "zpv" 3.0 0.5 0.5 "z axis")
 190   (plptex3 0.0 -0.4 -0.5 1.0 0.0 0.0 0.0 0.0 1.0 0.5 "Surface")
 191   (plsurf3d (make-levels 40 -1.5 1.5) (make-levels 40 -1.5 1.5) (example-matrix 40 40 #'example-func-2) 0 (make-levels 2 -1 1))
 192   (plend))
 193
 194 #+nil(3d-plot-ex)
 195
 196 ;; Unicode labels, a nice feature of plplot.
 197 ;;
 198 ;; The escape sequence #[..] tells plplot to expect a unicode character
 199 ;; code point. You can also pass in a utf-8 encoded string, but depending
 200 ;; on how your lisp deals with the arrays of type 'character this may
 201 ;; or may not work.
 202 ;;
 203 ;; YMMV depending on the capabilities of the driver itself and of the
 204 ;; fonts that are available to the driver.
 205
 206 (defun unicode ()
 207   (plsdev *gdev*)
 208   (plinit)
 209   (pladv 0)
 210   (plvpor 0 1 0 1)
 211   (plwind 0 1 0 1)
 212   (plschr 0 4)
 213   (plptex 0.5 0.5 1.0 0.0 0.5 "Has#[238]t#[238]")
 214   (plend))
 215
 216 #+nil(unicode)
 217
 218
 219 ;;; ---- High level interface
 220
 221
 222
 223
 224 ;;; Helper functions
 225
 226 (defun my-make-vector (dim init-fn)
 227   (let ((vec (make-array dim :initial-element 0.0 :element-type 'float)))
 228     (dotimes (i dim)
 229       (setf (aref vec i) (funcall init-fn i)))
 230     vec))
 231
 232 (defun my-make-matrix (dim1 dim2 init-fn)
 233   (let ((mat (make-array (list dim1 dim2) :initial-element 0.0 :element-type 'float)))
 234     (dotimes (x dim1)
 235       (dotimes (y dim2)
 236         (setf (aref mat x y) (funcall init-fn x y))))
 237     mat))
 238
 239 (defun my-make-bar-graph-data (rows cols)
 240   (let ((data (make-array (list rows cols) :initial-element 0.0 :element-type 'float)))
 241     (dotimes (i rows)
 242       (dotimes (j cols)
 243         (setf (aref data i j) (+ i j))))
 244     data))
 245
 246 (defun my-contour-plot-fn (x y)
 247   (let ((tx (- (* 0.02 x) 0.5))
 248         (ty (- (* 0.02 y) 0.5)))
 249     (- (* tx tx) (* ty ty)
 250        (* (sin (* 7 tx)) (* (cos (* 7 ty)))))))
 251
 252
 253 ;; You may need to change these to reflect the plplot drivers available on your system
 254 ;; If the Slime REPL hangs when you run one of these examples, it may be because the device
 255 ;; was not available. When this happens you should be able to specify a different device
 256 ;; in the inferior lisp buffer.
 257
 258 (defparameter g-dev "xwin")
 259
 260 ;;; X-Y-Plots
 261
 262 ;; The simplest plot
 263
 264 (defun basic-plot-1 ()
 265   (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x))))
 266          (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x) (* 0.1 x)))))
 267          (p (new-x-y-plot x y))
 268          (w (basic-window)))
 269     (add-plot-to-window w p)
 270     (render w g-dev)))
 271
 272 #+nil(basic-plot-1)
 273
 274 ;; The same plot with a user defined y-axis range
 275
 276 (defun basic-plot-1.1 ()
 277   (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x))))
 278          (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x) (* 0.1 x)))))
 279          (p (new-x-y-plot x y))
 280          (w (basic-window :y-axis-min -5.0 :y-axis-max 50.0)))
 281     (add-plot-to-window w p)
 282     (render w g-dev)))
 283
 284 ;; Here we add our own labels to the plot, change the size & add another piece of data with
 285 ;; a heavier red line.
 286
 287 (defun basic-plot-2 ()
 288   (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x))))
 289          (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x) (* 0.1 x)))))
 290          (p1 (new-x-y-plot x y))
 291          (p2 (new-x-y-plot x x :color :red :line-width 2))
 292          (w (basic-window :x-label "x" :y-label "y" :title "my graph")))
 293     (add-plot-to-window w p1)
 294     (add-plot-to-window w p2)
 295     (render w g-dev :size-x 400 :size-y 300)))
 296 ;    (render w "png" :filename "/Users/hbabcock/test.png" :size-x 400 :size-y 300)))
 297
 298
 299 ;; Here we change the background and foreground colors & the x axis ticks & the
 300 ;; y axis format and the x axis font size.
 301
 302 (defun basic-plot-3 ()
 303   (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x))))
 304          (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x) (* 0.1 x)))))
 305          (p1 (new-x-y-plot x y :color :blue))
 306          (w (basic-window :title "" :foreground-color :red :background-color :black)))
 307     (edit-window-axis w :x :major-tick-interval 0.5 :minor-tick-number 10
 308                       :properties '(:draw-bottom/left :major-tick-grid :invert-ticks :major-tick-labels-above/right :major-ticks :minor-ticks))
 309     (add-plot-to-window w p1)
 310     (render w g-dev)))
 311
 312
 313 ;; Here we demonstrate some of the text capabilities.
 314
 315 (defun basic-plot-4 ()
 316   (let ((w (basic-window))
 317         (l1 (new-text-label (new-text-item (roman-font "x" (superscript "2") "!") :font-size 2.0 :text-color :blue) 0.5 0.2))
 318         (l2 (new-text-label (new-text-item (roman-font "test1 " (italic-font "test2 ") "test3") :font-size 2.0 :text-color :red) 0.5 0.4))
 319         (l3 (new-text-label (new-text-item (roman-font (unicode-char "967") (unicode-char "968")) :font-size 2.0 :text-color :green) 0.5 0.6)))
 320     (add-text-label-to-window w l1)
 321     (add-text-label-to-window w l2)
 322     (add-text-label-to-window w l3)
 323     (render w g-dev)))
 324
 325
 326 ;; Here we plot one set of data as points & the other as a dashed blue line.
 327
 328 (defun basic-plot-5 ()
 329   (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x))))
 330          (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x) (* 0.1 x)))))
 331          (p1 (new-x-y-plot x y :line-width 0 :symbol-size 6.0 :symbol-type 1))
 332          (p2 (new-x-y-plot x x :color :blue :line-style 2))
 333          (w (basic-window)))
 334     (add-plot-to-window w p1)
 335     (add-plot-to-window w p2)
 336     (render w g-dev)))
 337
 338
 339 ;; Here we make a simple plot & then get the x-y coordinates of the next mouse
 340 ;; click (on the plot). Note that the coordinate scale for the mouse click location
 341 ;; is the same as those on the axises of the graph. Once we have the mouse
 342 ;; location we generate a new graph with the line going through this point
 343 ;; by taking advantage of the fact that by setting copy to :nil we have told
 344 ;; x-y-plot to store a reference to the vectors x & y rather then copying x & y.
 345
 346 (defun basic-plot-6 ()
 347   (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x))))
 348          (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x) (* 0.1 x)))))
 349          (p (new-x-y-plot x y :copy nil))
 350          (w (basic-window)))
 351     (add-plot-to-window w p)
 352     (multiple-value-bind (mx my) (get-cursor w g-dev)
 353       (format t "You clicked : <~,2f, ~,2f>~%" mx my)
 354       (setf (aref x 20) mx)
 355       (setf (aref y 20) my))
 356     (render w g-dev)))
 357
 358
 359 ;; Here we make a plot with some error bars in x & y
 360 ;; Note that error bar is drawn with the total length given by the error bar
 361 ;; vector & centered on the data point.
 362
 363 (defun basic-plot-7 ()
 364   (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x))))
 365          (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x) (* 0.1 x)))))
 366          (x-err (my-make-vector 40 #'(lambda(x) (declare (ignore x)) 0.06)))
 367          (y-err (my-make-vector 40 #'(lambda(x) (declare (ignore x)) 1.0)))
 368          (p (new-x-y-plot x y :x-error x-err :y-error y-err))
 369          (w (basic-window)))
 370     (add-plot-to-window w p)
 371     (render w g-dev)))
 372
 373
 374 ;; Here we make our own color table with 2-3 colors, set window to use our new
 375 ;; color table instead of the default & then change the foreground color in
 376 ;; the color table.
 377 ;;
 378 ;; See also: src/window/color-table.lisp for a brief introduction of color handling.
 379
 380 (defun basic-plot-8 ()
 381   (let* ((c (new-color-table (vector 0 0 0 :color1)))
 382          (x (my-make-vector 40 #'(lambda(x) (* 0.1 x))))
 383          (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x) (* 0.1 x)))))
 384          (p (new-x-y-plot x y))
 385          (w (basic-window)))
 386     (add-plot-to-window w p)
 387     (add-color-to-color-table c (vector 255 0 0 :color2))
 388     (set-color-table w c)
 389     (render w g-dev)
 390     (add-color-to-color-table c (vector 255 255 255 :color3))
 391     (edit-x-y-plot p :color :color3)
 392     (edit-window w :foreground-color :color1 :background-color :color2)
 393     (render w g-dev)
 394     (remove-color-from-color-table c :color2)
 395     nil))
 396
 397
 398 ;;; Bar graphs
 399
 400 ;; Here we make a simple bar graph
 401
 402 (defun bar-graph-1 ()
 403   (let* ((y (my-make-vector 10 #'(lambda(x) (* (* 0.2 x) (* 0.2 x)))))
 404          (b (new-bar-graph nil y :fill-colors (vector :grey)))
 405          (w (basic-window)))
 406     (add-plot-to-window w b)
 407     (render w g-dev)))
 408
 409
 410 ;; Stacked bar graph
 411
 412 (defun bar-graph-2 ()
 413   (let* ((y (my-make-bar-graph-data 10 3))
 414          (b (new-bar-graph nil y :line-colors (vector :black :black :black)))
 415          (w (basic-window)))
 416     (add-plot-to-window w b)
 417     (render w g-dev)))
 418
 419
 420 ;; A Side by side bar graph
 421
 422 (defun bar-graph-3 ()
 423   (let* ((y (my-make-bar-graph-data 10 3))
 424          (b (new-bar-graph nil y :side-by-side t :line-colors (vector :black :black :black)))
 425          (w (basic-window)))
 426     (add-plot-to-window w b)
 427     (render w g-dev)))
 428
 429
 430 ;; Bar graph with custom spacing & widths
 431
 432 (defun bar-graph-4 ()
 433   (let* ((x (my-make-vector 10 #'(lambda(x) (* 0.1 x))))
 434          (y (my-make-vector 10 #'(lambda(x) (- (* (* 0.2 x) (* 0.2 x)) 1))))
 435          (s (my-make-vector 10 #'(lambda(x) (+ 0.05 (* 0.005 x)))))
 436          (b (new-bar-graph x y :bar-widths s :fill-colors (vector :grey)))
 437          (w (basic-window)))
 438     (add-plot-to-window w b)
 439     (render w g-dev)))
 440
 441
 442 ;; A side by side bar graph with custom widths
 443
 444 (defun bar-graph-5 ()
 445   (let* ((y (my-make-bar-graph-data 10 3))
 446          (s (my-make-vector 10 #'(lambda(x) (+ 0.1 (* 0.05 (sqrt x))))))
 447          (b (new-bar-graph nil y :bar-widths s :side-by-side t :line-colors (vector :black :black :black)))
 448          (w (basic-window)))
 449     (add-plot-to-window w b)
 450     (render w g-dev)))
 451
 452
 453 ;;; Contour Plots
 454
 455
 456 ;; A simple contour plot
 457
 458 (defun contour-plot-1 ()
 459   (let ((c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
 460                              :line-color :blue :line-width 2))
 461         (w (basic-window)))
 462     (add-plot-to-window w c)
 463     (render w g-dev)))
 464
 465
 466 ;; The same plot rescaled with filled contours
 467
 468 (defun contour-plot-2 ()
 469   (let ((c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
 470                              :x-min 0.0 :x-max 1.0 :y-min 0.0 :y-max 1.0 :fill-type :block
 471                              :fill-colors (vector :red :grey :blue :yellow :green)))
 472         (w (basic-window)))
 473     (add-plot-to-window w c)
 474     (render w g-dev)))
 475
 476
 477 ;; Plotted on a user defined simple grid with smooth shading between contours
 478
 479 (defun contour-plot-3 ()
 480   (let* ((xp (my-make-vector 50 #'(lambda(x) (+ (* 0.1 x) (* 0.01 x x)))))
 481          (yp (my-make-vector 50 #'(lambda(y) (+ (* 0.1 y) (* 0.001 y y)))))
 482          (c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
 483                               :x-mapping xp :y-mapping yp :fill-type :smooth))
 484          (w (basic-window)))
 485     (add-plot-to-window w c)
 486     (render w g-dev)))
 487
 488
 489 ;; Plotted on a more complex user defined grid
 490
 491 (defun contour-plot-4 ()
 492   (let* ((xp (my-make-matrix 51 51 #'(lambda(x y)
 493                                        (+ (* 0.02 (- x 25) (* 0.01 (+ y 50)))))))
 494          (yp (my-make-matrix 51 51 #'(lambda(x y)
 495                                        (declare (ignore x))
 496                                        (* 0.02 y))))
 497          (cl (my-make-vector 20 #'(lambda(x) (- (* 0.12 x) 1.0))))
 498          (c (new-contour-plot (my-make-matrix 51 51 #'(lambda (x y) (my-contour-plot-fn x y)))
 499                               :x-mapping xp :y-mapping yp :contour-levels cl))
 500          (w (basic-window)))
 501     (add-plot-to-window w c)
 502     (render w g-dev)))
 503
 504
 505 ;; The same as contour-plot-3, but with a gray scale color table.
 506
 507 (defun contour-plot-5 ()
 508   (let* ((ct (new-extended-color-table :control-points (vector #(0.0 0 0 0) #(1.0 255 255 255))))
 509          (xp (my-make-vector 50 #'(lambda(x) (+ (* 0.1 x) (* 0.01 x x)))))
 510          (yp (my-make-vector 50 #'(lambda(y) (+ (* 0.1 y) (* 0.001 y y)))))
 511          (c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
 512                               :x-mapping xp :y-mapping yp :fill-type :smooth))
 513          (w (basic-window)))
 514     (add-plot-to-window w c)
 515     (set-color-table w ct)
 516     (render w g-dev)))
 517
 518
 519 ;; Use PLplot's ability to grid data to convert your (x,y,z) data into a
 520 ;; plottable 2D grid.
 521
 522 (defun contour-plot-6 ()
 523   (let* ((x (my-make-vector 1000 #'(lambda(x)
 524                                     (declare (ignore x))
 525                                     (- (random 4.0) 2.0))))
 526          (y (my-make-vector 1000 #'(lambda(y)
 527                                     (declare (ignore y))
 528                                     (- (random 4.0) 2.0))))
 529          (z (make-array 1000 :initial-element 0.0 :element-type 'float))
 530          (xgrid (my-make-vector 21 #'(lambda(x) (- (* 0.2 x) 2.0))))
 531          (ygrid (my-make-vector 21 #'(lambda(x) (- (* 0.2 x) 2.0))))
 532          (p (new-x-y-plot x y :line-width 0 :symbol-type 2 :symbol-size 0.75))
 533          (w (basic-window)))
 534     (dotimes (i (length z))
 535       (let ((tx (aref x i))
 536             (ty (aref y i)))
 537         (setf (aref z i) (- (* tx tx) (* ty ty) (* (sin tx) (* (cos ty)))))))
 538     (let* ((d (x-y-z-data-to-grid (list x y z) xgrid ygrid :algorithm :grid-nnli))
 539            (c (new-contour-plot d :x-mapping xgrid :y-mapping ygrid :fill-type :block)))
 540       (add-plot-to-window w c)
 541       (add-plot-to-window w p)
 542       (render w g-dev))))
 543
 544
 545 ;; Mixing different plot types is also possible, though care must be taken
 546 ;; to draw them in the right order.
 547
 548 (defun mixed-plot-1 ()
 549   (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x))))
 550          (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x) (* 0.1 x)))))
 551          (p (new-x-y-plot x y :line-width 2))
 552          (c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
 553                               :x-min 0.0 :x-max 4.0 :y-min 0.0 :y-max 15.0 :fill-type :block
 554                               :fill-colors (vector :red :grey :blue :yellow :green)))
 555          (title (new-text-item "..." :font-size 1.5)) ; create a text object for the title
 556          (l (new-axis-label title :top 1.5))          ; create an axis label containing the title object
 557          (w (basic-window)))
 558     (add-plot-to-window w p)
 559     (add-plot-to-window w c)
 560     (edit-window w :title l)  ; replace the default title object with our own title object
 561     (edit-text-item title :the-text "Wrong Order?") ; change the text in the title object
 562     (render w g-dev)
 563     (bring-to-front w p)
 564     (edit-text-item title :the-text "Right Order?")
 565     (render w g-dev)))
 566
 567
 568 ;; Roll your own custom plot type & have it get drawn like any other plot type
 569
 570 (defun custom-plot-type-1 ()
 571   (let ((cp (new-custom-plot-object
 572              #'(lambda ()
 573                  (vector 0.0 4.0 0.0 4.0))
 574              #'(lambda (plot-number)
 575                  (declare (ignore plot-number))
 576                  (set-foreground-color :red)
 577                  (cl-plplot-system:plfill (vector 1.0 1.2 2.8 3.0)
 578                                           (vector 1.0 3.0 3.0 1.0)))))
 579         (w (basic-window)))
 580     (add-plot-to-window w cp)
 581     (render w g-dev)))
 582
 583
 584 ;;; 3D mesh plots
 585
 586 ;; A simple 3D mesh plot
 587
 588 (defun 3d-plot-1 ()
 589   (let ((c (new-3d-mesh nil nil (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
 590                         :line-color :blue))
 591         (w (basic-3d-window :altitude 30 :azimuth 60)))
 592     (add-plot-to-window w c)
 593     (render w g-dev)))
 594
 595 ;; The same plot with a custom z axis range
 596
 597 (defun 3d-plot-1.1 ()
 598   (let ((c (new-3d-mesh nil nil (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
 599                         :line-color :blue))
 600         (w (basic-3d-window :z-axis-min -2.0 :z-axis-max 2.0 :altitude 30 :azimuth 60)))
 601     (add-plot-to-window w c)
 602     (render w g-dev)))
 603
 604 ;; The same plot with (default) cantours drawn in the x-y plane
 605
 606 (defun 3d-plot-2 ()
 607   (let ((c (new-3d-mesh nil nil (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
 608                         :line-color :blue :contour-options :base-contour))
 609         (w (basic-3d-window :altitude 30 :azimuth 60)))
 610     (add-plot-to-window w c)
 611     (render w g-dev)))
 612
 613
 614 ;; The same plot with (default) cantours drawn in the x-y plane and magnitude
 615 ;; coloring on the plot. Additionally, only draw lines in between points in
 616 ;; the x direction.
 617
 618 (defun 3d-plot-3 ()
 619   (let ((c (new-3d-mesh nil nil (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
 620                         :grid-type :grid-x :contour-options :both))
 621         (w (basic-3d-window :altitude 30 :azimuth 60)))
 622     (add-plot-to-window w c)
 623     (render w g-dev)))
 624
 625
 626 ;; The same plot with magnitude coloring on the plot. Additionally a "curtain"
 627 ;; is drawn around the plot.
 628
 629 (defun 3d-plot-4 ()
 630   (let ((c (new-3d-mesh nil nil (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
 631                         :contour-options :magnitude-contour :curtain t))
 632         (w (basic-3d-window :altitude 30 :azimuth 60)))
 633     (add-plot-to-window w c)
 634     (render w g-dev)))
 635
 636
 637 ;; A simple demonstration 3D text labels.
 638
 639 (defun 3d-plot-5 ()
 640   (let ((l1 (new-3D-text-label (new-text-item (roman-font "Label1") :font-size 2.0 :text-color :blue) 0.5 1.0 0.1
 641                                :text-dy -1.0))
 642         (l2 (new-3D-text-label (new-text-item (roman-font "Label2") :font-size 2.0 :text-color :red) 1.5 1.0 0.1
 643                                :text-dx 1.0
 644                                :text-sz 1.0))
 645         (w (basic-3d-window :altitude 30 :azimuth 60
 646                             :x-axis-min 0 :x-axis-max 2.0
 647                             :y-axis-min 0 :y-axis-max 2.0
 648                             :z-axis-min 0 :z-axis-max 2.0)))
 649     (add-text-label-to-window w l1)
 650     (add-text-label-to-window w l2)
 651     (render w g-dev)))
 652
 653
 654 ;;; Surface plots
 655
 656 ;; A simple surface plot
 657
 658 (defun surface-plot-1 ()
 659   (let ((c (new-surface-plot nil nil (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
 660                         :line-color :blue))
 661         (w (basic-3d-window :altitude 30 :azimuth 60)))
 662     (add-plot-to-window w c)
 663     (render w g-dev)))
 664
 665 ;; The same plot with a curtain and coloring according to the magnitude in z
 666
 667 (defun surface-plot-2 ()
 668   (let ((c (new-surface-plot nil nil (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
 669                              :surface-options '(:curtain :magnitude-coloring)))
 670         (w (basic-3d-window :altitude 30 :azimuth 60)))
 671     (add-plot-to-window w c)
 672     (render w g-dev)))
 673
 674
 675 ;;;;
 676 ;;;; Copyright (c) 2006 Hazen P. Babcock
 677 ;;;;
 678 ;;;; Permission is hereby granted, free of charge, to any person obtaining a copy
 679 ;;;; of this software and associated documentation files (the "Software"), to
 680 ;;;; deal in the Software without restriction, including without limitation the
 681 ;;;; rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
 682 ;;;; sell copies of the Software, and to permit persons to whom the Software is
 683 ;;;; furnished to do so, subject to the following conditions:
 684 ;;;;
 685 ;;;; The above copyright notice and this permission notice shall be included in
 686 ;;;; all copies or substantial portions of the Software.
 687 ;;;;
 688 ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 689 ;;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 690 ;;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 691 ;;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 692 ;;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 693 ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
 694 ;;;; IN THE SOFTWARE.
 695 ;;;;
 696
 697 ;;;;
 698 ;;;; Copyright (c) 2006 Hazen P. Babcock
 699 ;;;;
 700 ;;;; Permission is hereby granted, free of charge, to any person obtaining a copy
 701 ;;;; of this software and associated documentation files (the "Software"), to
 702 ;;;; deal in the Software without restriction, including without limitation the
 703 ;;;; rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
 704 ;;;; sell copies of the Software, and to permit persons to whom the Software is
 705 ;;;; furnished to do so, subject to the following conditions:
 706 ;;;;
 707 ;;;; The above copyright notice and this permission notice shall be included in
 708 ;;;; all copies or substantial portions of the Software.
 709 ;;;;
 710 ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 711 ;;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 712 ;;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 713 ;;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 714 ;;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 715 ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
 716 ;;;; IN THE SOFTWARE.
 717 ;;;;
 718
 719