/src/line.sc

https://bitbucket.org/bunny351/ezd · Scala · 153 lines · 140 code · 13 blank · 0 comment · 3 complexity · 42ec6464e7fd53b0874fc1b513991b9c MD5 · raw file

  1. ;;; ezd - easy drawing for X11 displays.
  2. ;;;
  3. ;;; The procedures in this module generate the GRAPHIC objects representing
  4. ;;; lines and points.
  5. ;* Copyright 1990-1993 Digital Equipment Corporation
  6. ;* All Rights Reserved
  7. ;*
  8. ;* Permission to use, copy, and modify this software and its documentation is
  9. ;* hereby granted only under the following terms and conditions. Both the
  10. ;* above copyright notice and this permission notice must appear in all copies
  11. ;* of the software, derivative works or modified versions, and any portions
  12. ;* thereof, and both notices must appear in supporting documentation.
  13. ;*
  14. ;* Users of this software agree to the terms and conditions set forth herein,
  15. ;* and hereby grant back to Digital a non-exclusive, unrestricted, royalty-free
  16. ;* right and license under any changes, enhancements or extensions made to the
  17. ;* core functions of the software, including but not limited to those affording
  18. ;* compatibility with other hardware or software environments, but excluding
  19. ;* applications which incorporate this software. Users further agree to use
  20. ;* their best efforts to return to Digital any such changes, enhancements or
  21. ;* extensions that they make and inform Digital of noteworthy uses of this
  22. ;* software. Correspondence should be provided to Digital at:
  23. ;*
  24. ;* Director of Licensing
  25. ;* Western Research Laboratory
  26. ;* Digital Equipment Corporation
  27. ;* 250 University Avenue
  28. ;* Palo Alto, California 94301
  29. ;*
  30. ;* This software may be distributed (but not offered for sale or transferred
  31. ;* for compensation) to third parties, provided such third parties agree to
  32. ;* abide by the terms and conditions of this notice.
  33. ;*
  34. ;* THE SOFTWARE IS PROVIDED "AS IS" AND DIGITAL EQUIPMENT CORP. DISCLAIMS ALL
  35. ;* WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
  36. ;* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL DIGITAL EQUIPMENT
  37. ;* CORPORATION BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
  38. ;* DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
  39. ;* PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
  40. ;* ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
  41. ;* SOFTWARE.
  42. (module line)
  43. (include "struct.sch")
  44. (include "commands.sch")
  45. (include "ginfo.sch")
  46. (include "display.sch")
  47. (include "view.sch")
  48. (include "psdraw.sch")
  49. (include "graphic.sch")
  50. (include "xternal.sch")
  51. ;;; A line is generated by the following procedure.
  52. (define (LINE x1 y1 x2 y2 line-width color dash)
  53. (make-graphic
  54. #f
  55. (lambda ()
  56. (let ((ux1 (user->x x1))
  57. (ux2 (user->x x2))
  58. (uy1 (user->y y1))
  59. (uy2 (user->y y2))
  60. (lw (max 1 (user->lw line-width))))
  61. (list (- (min ux1 ux2) lw)
  62. (- (min uy1 uy2) lw)
  63. (+ (max ux1 ux2) lw)
  64. (+ (max uy1 uy2) lw))))
  65. (if (eq? color 'clear)
  66. draw-clear
  67. (lambda ()
  68. (xdrawline *dpy* *xwindow*
  69. (cv-gc (user->lw line-width) color #f dash #f #f)
  70. (user->x x1) (user->y y1)
  71. (user->x x2) (user->y y2))))
  72. (if (eq? color 'clear)
  73. draw-clear
  74. (lambda ()
  75. (pscolor color)
  76. (pscommand "newpath" x1 y1 "moveto" x2 y2 "lineto")
  77. (psstroke (user->lw line-width) dash)))
  78. (lambda (minx miny maxx maxy)
  79. (let* ((ux1 (user->x x1))
  80. (ux2 (user->x x2))
  81. (uy1 (user->y y1))
  82. (uy2 (user->y y2))
  83. (vertical (zero? (- ux2 ux1)))
  84. (bbx1 (user->x minx))
  85. (bbx2 (user->x maxx))
  86. (bby1 (user->y miny))
  87. (bby2 (user->y maxy))
  88. (dx/2 (abs (/ (- bbx1 bbx2) 2)))
  89. (dy/2 (abs (/ (- bby1 bby2) 2)))
  90. (mouse-x (/ (+ bbx1 bbx2) 2))
  91. (mouse-y (/ (+ bby1 bby2) 2))
  92. (lw/2 (/ (user->lw line-width) 2))
  93. (theta (if vertical (acos 0) (atan (/ (- uy2 uy1)
  94. (- ux2 ux1)))))
  95. (cos-theta (cos (- theta)))
  96. (sin-theta (sin (- theta))))
  97. (define (ROTATE-X x y)
  98. (- (* x cos-theta) (* y sin-theta)))
  99. (define (ROTATE-Y x y)
  100. (+ (* x sin-theta) (* y cos-theta)))
  101. (and (<= (- (min (rotate-x ux1 uy1) (rotate-x ux2 uy2))
  102. dx/2)
  103. (rotate-x mouse-x mouse-y)
  104. (+ (max (rotate-x ux1 uy1) (rotate-x ux2 uy2))
  105. dx/2))
  106. (<= (- (min (rotate-y ux1 uy1) (rotate-y ux2 uy2))
  107. dy/2 lw/2)
  108. (rotate-y mouse-x mouse-y)
  109. (+ (max (rotate-y ux1 uy1) (rotate-y ux2 uy2))
  110. dy/2 lw/2)))))))
  111. (define-ezd-command
  112. `(line ,number? ,number? ,number? ,number?
  113. (optional ,non-negative?) (optional ,color?) (optional ,dash?))
  114. "(line x1 y1 x2 y2 [<line-width>] [<color>] [dash])"
  115. line)
  116. ;;; A point is generated by the following procedure.
  117. (define (POINT x y color)
  118. (make-graphic
  119. #f
  120. (lambda ()
  121. (let ((ux (user->x x))
  122. (uy (user->y y)))
  123. (list ux uy (+ ux 1) (+ uy 1))))
  124. (if (eq? color 'clear)
  125. draw-clear
  126. (lambda ()
  127. (xdrawpoint *dpy* *xwindow* (cv-gc 0 color #f #f #f #f)
  128. (user->x x) (user->y y))))
  129. (if (eq? color 'clear)
  130. draw-clear
  131. (lambda ()
  132. (pscolor color)
  133. (pscommand "newpath" x y "moveto" 0 (psypixel 1) "rlineto"
  134. (psxpixel 1) 0 "rlineto" 0 (- (psypixel 1)) "rlineto"
  135. "closepath" "fill")))
  136. (lambda (minx miny maxx maxy) #t)))
  137. (define-ezd-command
  138. `(point ,number? ,number? (optional ,color?))
  139. "(point x y [<color>])"
  140. point)