From 5145dd3aa0c02c9fc496d1432fc4410674206e1d Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:31 -0800 Subject: Import Upstream version 3a2 --- grapheps.scm | 34 +++++++++++++++++++++------------- 1 file changed, 21 insertions(+), 13 deletions(-) (limited to 'grapheps.scm') diff --git a/grapheps.scm b/grapheps.scm index 0f11a6d..677ae34 100644 --- a/grapheps.scm +++ b/grapheps.scm @@ -30,7 +30,7 @@ ;;@noindent ;;This is a graphing package creating encapsulated-PostScript files. ;;Its motivations and design choice are described in -;;@url{http://swissnet.ai.mit.edu/~jaffer/Docupage/grapheps} +;;@url{http://swiss.csail.mit.edu/~jaffer/Docupage/grapheps} ;; ;;@noindent ;;A dataset to be plotted is taken from a 2-dimensional array. @@ -91,6 +91,8 @@ (write-line "%!PS-Adobe-3.0 EPSF-3.0" oprt) (write-line (scheme->ps "%%BoundingBox: 0 0 " xsize " " ysize) oprt) (write-line (scheme->ps "%%Title: " (or *plot-title* filename)) oprt) + (write-line (scheme->ps "%%EndComments: ") oprt) + (write-line (scheme->ps "0 0 " xsize " " ysize) oprt) (call-with-input-file (in-vicinity (library-vicinity) "grapheps.ps") (lambda (iprt) (do ((line (read-line iprt) (read-line iprt))) @@ -107,7 +109,7 @@ (set! *plot-arrays* '()))) (define (write-array-def name array oprt) - (define row-length (+ 1 (cadadr (array-shape array)))) + (define row-length (cadr (array-dimensions array))) (define idx 0) (set! idx row-length) (write-line (scheme->ps "/" name) oprt) @@ -145,10 +147,10 @@ (define (whole-page) 'whole-page) ;;@menu -;;* Column Ranges:: -;;* Drawing the Graph:: -;;* Graphics Context:: -;;* Rectangles:: +;;* Column Ranges:: +;;* Drawing the Graph:: +;;* Graphics Context:: +;;* Rectangles:: ;;* Legending:: ;;* Legacy Plotting:: ;;* Example Graph:: @@ -264,9 +266,7 @@ ;;Saves the current graphics state, executes @1, then restores ;;to saved graphics state. (define (in-graphic-context . args) - (append '("gsave pointsize glyphsize") - args - '("/glyphsize exch def /pointsize exch def grestore"))) + (append '("gpush") args '("gpop"))) ;;@args color ;;@1 should be a string naming a Resene color, a saturate color, or a @@ -301,7 +301,7 @@ ;;@0 Changes the current PostScript font to @1 with height equal to ;;@2. The default font is Helvetica (12pt). (define (set-font name fontheight) - (scheme->ps "/pointsize " fontheight " def /" name " pointsize selectfont")) + (scheme->ps "/fontsize " fontheight " def /" name " fontsize selectfont")) ;;@noindent ;;The base set of PostScript fonts is: @@ -419,6 +419,14 @@ (define leftedge 'leftedge) (define rightedge 'rightedge) +;;@body +;;The margin-templates are strings whose displayed width is used to +;;reserve space for the left and right side numerical legends. +;;The default values are "-.0123456789". +(define (set-margin-templates left right) + (scheme->ps "/lmargin-template (" left ") def " + "/rmargin-template (" right ") def")) + ;;@body ;;Draws a vertical ruler with X coordinate @1 and labeled with string ;;@2. If @3 is positive, then the ticks are @3 long on the right side @@ -459,7 +467,7 @@ (set! histogram? (if (null? histogram?) #f (car histogram?))) (if (list? data) (let ((len (length data)) - (nra (create-array (Ar64) (length data) 2))) + (nra (make-array (A:floR64b) (length data) 2))) (do ((idx 0 (+ 1 idx)) (lst data (cdr lst))) ((>= idx len) @@ -478,7 +486,7 @@ (define (graph:plot-function tmp func vlo vhi . npts) (set! npts (if (null? npts) 200 (car npts))) - (let ((dats (create-array (Ar64) npts 2))) + (let ((dats (make-array (A:floR64b) npts 2))) (array-index-map! (make-shared-array dats (lambda (idx) (list idx 0)) npts) (lambda (idx) (+ vlo (* (- vhi vlo) (/ idx (+ -1 npts)))))) @@ -570,7 +578,7 @@ ;; (define lines '()) ;; (do ((line (read-line iprt) (read-line iprt))) ;; ((eof-object? line) -;; (let ((nra (create-array (Ar64) +;; (let ((nra (make-array (A:floR64b) ;; (length lines) ;; (length (car lines))))) ;; (do ((lns lines (cdr lns)) -- cgit v1.2.3