|
| 1 | +;;; Plot graphs into a PDF file |
| 2 | +;;; |
| 3 | +;;; This is a demo of library (lispkit draw). Function `plot` draws a function over |
| 4 | +;;; a given range using a number of interpolation points into a given rectangle. |
| 5 | +;;; It is used a number of times in function `plot-demo-page` which explains how to |
| 6 | +;;; compose drawings and save them in a PDF file. |
| 7 | +;;; |
| 8 | +;;; Usage: (plot-demo-page "graph-demo.pdf") |
| 9 | +;;; |
| 10 | +;;; Author: Matthias Zenger |
| 11 | +;;; Copyright © 2018 Matthias Zenger. All rights reserved. |
| 12 | +;;; |
| 13 | +;;; Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file |
| 14 | +;;; except in compliance with the License. You may obtain a copy of the License at |
| 15 | +;;; |
| 16 | +;;; http://www.apache.org/licenses/LICENSE-2.0 |
| 17 | +;;; |
| 18 | +;;; Unless required by applicable law or agreed to in writing, software distributed under the |
| 19 | +;;; License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, |
| 20 | +;;; either express or implied. See the License for the specific language governing permissions |
| 21 | +;;; and limitations under the License. |
| 22 | + |
| 23 | + |
| 24 | +(import (lispkit draw)) |
| 25 | + |
| 26 | +;; Plots a function `f` over range `[xmin; xmax]` using `n` interpolation points |
| 27 | +;; within rectangle `rect`. Prints `label` at the bottom of the graph. |
| 28 | +(define (plot f xmin xmax n rect label) |
| 29 | + (let* ((dx (/ (- xmax xmin) n)) |
| 30 | + (xs (tabulate (fx1+ n) (lambda (i) (+ xmin (* i dx))))) |
| 31 | + (ys (map f xs)) |
| 32 | + (ymin (apply min ys)) |
| 33 | + (ymax (apply max ys)) |
| 34 | + (xfac (/ (car (rect-size rect)) (- xmax xmin))) |
| 35 | + (yfac (/ (cdr (rect-size rect)) (- ymax ymin))) |
| 36 | + (ps (map (lambda (x y) (point (* xfac (- x xmin)) (* yfac (- y ymin)))) xs ys)) |
| 37 | + (shift (translate (car (rect-point rect)) (cdr (rect-point rect)))) |
| 38 | + (d (make-drawing))) |
| 39 | + ; Interpolate the points and flip the shape |
| 40 | + (define s (flip-shape (interpolate ps))) |
| 41 | + ; Draw a bounding box |
| 42 | + (define box (shape-bounds s)) |
| 43 | + (draw-shape d (make-rect (rect-point rect) (rect-size rect)) 0.5) |
| 44 | + ; Draw the graph and coordinate axis |
| 45 | + (enable-transformation d shift) |
| 46 | + (if (and (<= xmin 0.0) (>= xmax 0.0)) |
| 47 | + (draw-shape d (make-polygon (point (* xfac (- xmin)) 0) |
| 48 | + (point (* xfac (- xmin)) (cdr (rect-size rect)))) |
| 49 | + 0.3)) |
| 50 | + (if (and (<= ymin 0.0) (>= ymax 0.0)) |
| 51 | + (draw-shape d (make-polygon (point 0 |
| 52 | + (+ (cdr (rect-size rect)) (* yfac ymin))) |
| 53 | + (point (car (rect-size rect)) |
| 54 | + (+ (cdr (rect-size rect)) (* yfac ymin)))) |
| 55 | + 0.3)) |
| 56 | + (set-color d (make-color 0.0 0.0 1.0 1.0)) |
| 57 | + (draw-shape d s) |
| 58 | + ; Draw interpolation points |
| 59 | + (set-color d (make-color 0.0 0.0 0.0)) |
| 60 | + (set-fill-color d (make-color 0.0 0.0 0.0)) |
| 61 | + (for-each (lambda (p) (fill-shape d (flip-shape (make-arc p 1 0) box))) ps) |
| 62 | + ; Draw the label |
| 63 | + (draw-text d label (point 30 (- (cdr (rect-size rect)) 12)) |
| 64 | + (make-color 0.3 0.3 0.3) (font "Times-Italic" 7)) |
| 65 | + (disable-transformation d shift) |
| 66 | + d)) |
| 67 | + |
| 68 | +;; Creates a demo page consisting of a header and four graphs |
| 69 | +(define (plot-demo-page path) |
| 70 | + ; Create a new drawing |
| 71 | + (define page (make-drawing)) |
| 72 | + ; Draw a header in font "Helvetica" of size 8 |
| 73 | + (draw-text page "Demo of library (lispkit draw)" |
| 74 | + (point 160 8) (make-color 0.0 0.0 0.0) (font "Helvetica" 8)) |
| 75 | + ; Plot four graphs |
| 76 | + (draw-drawing page (plot sin -1 6.3 50 (rect 10 30 200 100) "sin(x)")) |
| 77 | + (draw-drawing page (plot cos -1 6.3 50 (rect 220 30 200 100) "cos(x)")) |
| 78 | + (draw-drawing page (plot (lambda (x) (* (sin (* x 2)) (cos (/ x 4)))) |
| 79 | + -1 6.3 50 (rect 10 140 200 100) "sin(x*2)*cos(x/4)")) |
| 80 | + (draw-drawing page (plot (lambda (x) (/ (* x x) 40)) -1 6.3 50 (rect 220 140 200 100) "x*x/40")) |
| 81 | + ; Save drawing in a PDF file |
| 82 | + (save-drawing page path (size 430 250))) |
| 83 | + |
0 commit comments