/src/line.sc
Scala | 153 lines | 140 code | 13 blank | 0 comment | 3 complexity | 42ec6464e7fd53b0874fc1b513991b9c MD5 | raw file
- ;;; ezd - easy drawing for X11 displays.
- ;;;
- ;;; The procedures in this module generate the GRAPHIC objects representing
- ;;; lines and points.
- ;* Copyright 1990-1993 Digital Equipment Corporation
- ;* All Rights Reserved
- ;*
- ;* Permission to use, copy, and modify this software and its documentation is
- ;* hereby granted only under the following terms and conditions. Both the
- ;* above copyright notice and this permission notice must appear in all copies
- ;* of the software, derivative works or modified versions, and any portions
- ;* thereof, and both notices must appear in supporting documentation.
- ;*
- ;* Users of this software agree to the terms and conditions set forth herein,
- ;* and hereby grant back to Digital a non-exclusive, unrestricted, royalty-free
- ;* right and license under any changes, enhancements or extensions made to the
- ;* core functions of the software, including but not limited to those affording
- ;* compatibility with other hardware or software environments, but excluding
- ;* applications which incorporate this software. Users further agree to use
- ;* their best efforts to return to Digital any such changes, enhancements or
- ;* extensions that they make and inform Digital of noteworthy uses of this
- ;* software. Correspondence should be provided to Digital at:
- ;*
- ;* Director of Licensing
- ;* Western Research Laboratory
- ;* Digital Equipment Corporation
- ;* 250 University Avenue
- ;* Palo Alto, California 94301
- ;*
- ;* This software may be distributed (but not offered for sale or transferred
- ;* for compensation) to third parties, provided such third parties agree to
- ;* abide by the terms and conditions of this notice.
- ;*
- ;* THE SOFTWARE IS PROVIDED "AS IS" AND DIGITAL EQUIPMENT CORP. DISCLAIMS ALL
- ;* WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
- ;* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL DIGITAL EQUIPMENT
- ;* CORPORATION BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
- ;* DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
- ;* PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
- ;* ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
- ;* SOFTWARE.
- (module line)
- (include "struct.sch")
- (include "commands.sch")
- (include "ginfo.sch")
- (include "display.sch")
- (include "view.sch")
- (include "psdraw.sch")
- (include "graphic.sch")
- (include "xternal.sch")
- ;;; A line is generated by the following procedure.
- (define (LINE x1 y1 x2 y2 line-width color dash)
- (make-graphic
- #f
- (lambda ()
- (let ((ux1 (user->x x1))
- (ux2 (user->x x2))
- (uy1 (user->y y1))
- (uy2 (user->y y2))
- (lw (max 1 (user->lw line-width))))
- (list (- (min ux1 ux2) lw)
- (- (min uy1 uy2) lw)
- (+ (max ux1 ux2) lw)
- (+ (max uy1 uy2) lw))))
- (if (eq? color 'clear)
- draw-clear
- (lambda ()
- (xdrawline *dpy* *xwindow*
- (cv-gc (user->lw line-width) color #f dash #f #f)
- (user->x x1) (user->y y1)
- (user->x x2) (user->y y2))))
- (if (eq? color 'clear)
- draw-clear
- (lambda ()
- (pscolor color)
- (pscommand "newpath" x1 y1 "moveto" x2 y2 "lineto")
- (psstroke (user->lw line-width) dash)))
- (lambda (minx miny maxx maxy)
- (let* ((ux1 (user->x x1))
- (ux2 (user->x x2))
- (uy1 (user->y y1))
- (uy2 (user->y y2))
- (vertical (zero? (- ux2 ux1)))
- (bbx1 (user->x minx))
- (bbx2 (user->x maxx))
- (bby1 (user->y miny))
- (bby2 (user->y maxy))
- (dx/2 (abs (/ (- bbx1 bbx2) 2)))
- (dy/2 (abs (/ (- bby1 bby2) 2)))
- (mouse-x (/ (+ bbx1 bbx2) 2))
- (mouse-y (/ (+ bby1 bby2) 2))
- (lw/2 (/ (user->lw line-width) 2))
- (theta (if vertical (acos 0) (atan (/ (- uy2 uy1)
- (- ux2 ux1)))))
- (cos-theta (cos (- theta)))
- (sin-theta (sin (- theta))))
- (define (ROTATE-X x y)
- (- (* x cos-theta) (* y sin-theta)))
- (define (ROTATE-Y x y)
- (+ (* x sin-theta) (* y cos-theta)))
- (and (<= (- (min (rotate-x ux1 uy1) (rotate-x ux2 uy2))
- dx/2)
- (rotate-x mouse-x mouse-y)
- (+ (max (rotate-x ux1 uy1) (rotate-x ux2 uy2))
- dx/2))
- (<= (- (min (rotate-y ux1 uy1) (rotate-y ux2 uy2))
- dy/2 lw/2)
- (rotate-y mouse-x mouse-y)
- (+ (max (rotate-y ux1 uy1) (rotate-y ux2 uy2))
- dy/2 lw/2)))))))
- (define-ezd-command
- `(line ,number? ,number? ,number? ,number?
- (optional ,non-negative?) (optional ,color?) (optional ,dash?))
- "(line x1 y1 x2 y2 [<line-width>] [<color>] [dash])"
- line)
- ;;; A point is generated by the following procedure.
- (define (POINT x y color)
- (make-graphic
- #f
- (lambda ()
- (let ((ux (user->x x))
- (uy (user->y y)))
- (list ux uy (+ ux 1) (+ uy 1))))
- (if (eq? color 'clear)
- draw-clear
- (lambda ()
- (xdrawpoint *dpy* *xwindow* (cv-gc 0 color #f #f #f #f)
- (user->x x) (user->y y))))
- (if (eq? color 'clear)
- draw-clear
- (lambda ()
- (pscolor color)
- (pscommand "newpath" x y "moveto" 0 (psypixel 1) "rlineto"
- (psxpixel 1) 0 "rlineto" 0 (- (psypixel 1)) "rlineto"
- "closepath" "fill")))
- (lambda (minx miny maxx maxy) #t)))
- (define-ezd-command
- `(point ,number? ,number? (optional ,color?))
- "(point x y [<color>])"
- point)