;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; MODULE      : graphics-markup.scm
;; DESCRIPTION : extra graphical macros
;; COPYRIGHT   : (C) 2012  Joris van der Hoeven
;;
;; This software falls under the GNU general public license version 3 or later.
;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(texmacs-module (graphics graphics-markup)
  (:use (graphics graphics-drd)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Definition of graphical macros
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (ca*r x) (if (pair? x) (ca*r (car x)) x))

(tm-define-macro (define-graphics head . l)
  (receive (opts body) (list-break l not-define-option?)
    `(begin
       (set! gr-tags-user (cons ',(ca*r head) gr-tags-user))
       (tm-define ,head ,@opts (:secure #t) ,@body))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Useful subroutines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(tm-define (tm-point? p) (tm-func? p 'point 2))
(tm-define (tm-x p) (tm-ref p 0))
(tm-define (tm-y p) (tm-ref p 1))

(tm-define (tm->number t)
  (if (tm-atomic? t) (string->number (tm->string t)) 0))

(tm-define (number->tm x)
  (number->string x))

(tm-define (point->complex p)
  (make-rectangular (tm->number (tm-x p)) (tm->number (tm-y p))))

(tm-define (complex->point z)
  `(point ,(number->tm (real-part z)) ,(number->tm (imag-part z))))

(tm-define (graphics-transform fun g)
  (cond ((tm-point? g) (fun g))
        ((tm-atomic? g) g)
        (else (cons (tm-car g)
                    (map (cut graphics-transform fun <>)
                         (tm-children g))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; fig-division for complexe numbers
(tm-define (fig-/ z1 z2)
  (let* ((a (real-part z1))
         (b (imag-part z1))
         (c (real-part z2))
         (d (imag-part z2))
         (e (/ (+ (* a c) (* b d)) (+ (* c c) (* d d))))
         (f (/ (- (* b c) (* a d)) (+ (* c c) (* d d)))))
  (make-rectangular e f)
  ))

;; "middle" of 2 numbers
(tm-define (fig-middle z1 z2) 
  (fig-/ (+ z1 z2) 2))
  
;; define pi
(tm-define (pi) (acos -1))  
  
;; transform an angle from degrees to radians
(tm-define (fig-deg->rad a)
  (/ (* (pi) a) 180))
  
;; transform an angle in [-pi;pi[ to an angle in [0;2pi[   (use with angle)
(tm-define (fig-posangle a)
  (if (< a 0)
      (+ a (* 2 (pi)))
      a))
  
;; give the rotation of z1 (center z and angle a)
(tm-define (fig-rotation z1 z a)
  (+ z (* (- z1 z) (make-polar 1 a))))

;; give the complex intersection of two lines of equations a1x+b1y=c1 '(a1 b1 c1) and a2x+b2y=c2 '(a2 b2 c2)
(tm-define (fig-inter-lines-list ls1 ls2)
  (let* ((a1 (list-ref ls1 0))
         (b1 (list-ref ls1 1))
         (c1 (list-ref ls1 2))
         (a2 (list-ref ls2 0))
         (b2 (list-ref ls2 1))
         (c2 (list-ref ls2 2))
         (x (/ (- (* b2 c1) (* b1 c2)) (- (* a1 b2) (* a2 b1))))
         (y (/ (- (* a1 c2) (* a2 c1)) (- (* a1 b2) (* a2 b1)))))
  (if (!= 0 (- (* a1 b2) (* a2 b1)))
      (make-rectangular x y))))
  
;; give the list of coeff '(a b c) of the equation of line (AB) (ax+by=c) knowing zA and zB
(tm-define (fig-equation-line z1 z2)
  (let ((x1 (real-part z1))
        (y1 (imag-part z1))
        (x2 (real-part z2))
        (y2 (imag-part z2)))
  (if (!= z1 z2)
      `(,(- y2 y1) ,(- x1 x2) ,(- (* x1 y2) (* x2 y1))))))

;; give the complex intersection of 2 lines (a b) and (c d)
(tm-define (fig-inter-lines a b c d)
  (fig-inter-lines-list (fig-equation-line a b) (fig-equation-line c d)))
  
;; give the complex intersection (with positive imaginary part) of the circle of center 0 and radius r1
;; and of the circle of center a and radius r2     ;;;; adapt for other cases
(tm-define (fig-inter-circles ls-circ1 ls-circ2)
  (let* ((z1 (list-ref ls-circ1 0))
         (r1 (list-ref ls-circ1 1))
         (z2 (list-ref ls-circ2 0))
         (r2 (list-ref ls-circ2 1))
         (x (+ (fig-/ z2 2) (fig-/ (- (* r1 r1) (* r2 r2)) (* 2 z2))))
         (y (sqrt (- (* r1 r1) (* x x)))))
  (make-rectangular x y)
  ))
      
;; give a complex point (at length len of z2) on the bisector of an angle defined by z1 z2 z3
(tm-define (fig-point-on-bisector z1 z2 z3 len)
  (+ z2 (* len (fig-unit (- (fig-rotation z1 z2 (fig-/ (fig-posangle (angle (fig-/ (- z3 z2) (- z1 z2)))) 2)) z2)))))
  
;; give the projection of z on line (ab) perpendicularly to line (ab)
(tm-define (fig-projection z a b)
  (let* ((c (+ z (fig-normal (- a b)))))   
  (fig-inter-lines a b c z)))

;; give the reflection of z in respect of line '(a b)
(tm-define (fig-line-reflection z ls-pts)
  (let* ((m (fig-projection z ls-pts)))
  (+ z (* 2 (- m z)))))

;; give a complex point (at length len of z2) on the bisector of an angle defined by z1 z2 z3
(tm-define (fig-point-on-bisector z1 z2 z3 len)
  (+ z2 (* len (fig-unit (- (fig-rotation z1 z2 (fig-/ (fig-posangle (angle (fig-/ (- z3 z2) (- z1 z2)))) 2)) z2)))))

;; unit vector of z
(tm-define (fig-unit z)
  (fig-/ z (magnitude z)))
  
;; normal vector of z
(tm-define (fig-normal z)
  (fig-unit (* z (make-polar 1 (/ (pi) 2)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Encodings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-graphics (rightangle p1 p2 p3)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (if (tm-point? p3) (point->complex p3) z2))
         (dz (- z1 z2))
         (l  (magnitude dz))
         (d1 (if (= dz 0) 0 (* l (imag-part (/ (- z3 z1) dz)))))
         (z4 (+ z2 (* (/ d1 2) dz)))
         (z5 (fig-rotation z2 z4 (* 3 (/ (pi) 2))))
         (z6 (fig-rotation z4 z2 (/ (pi) 2))))
    `(superpose
      (line ,(complex->point z4) ,(complex->point z5) ,(complex->point z6))
      (with "point-style" "none" ,p3))))

(define-graphics (angle1 p1 p2 p3)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (if (tm-point? p3) (point->complex p3) z2))
         (dza (- z3 z2))
         (dzb (- z1 z2))
         (l  (/ (magnitude dzb) (magnitude dza)))
         (t (if (= dzb 0) 0 (* l (imag-part (/ (- z3 z1) dz)))))
         (z4 (+ z2 (* (/ d1 2) dz)))
         (z5 (fig-rotation z2 z4 (* 3 (/ (pi) 2))))
         (z6 (fig-rotation z4 z2 (/ (pi) 2))))
    `(superpose
      (cline ,(complex->point z2) ,(complex->point z4) 
             ,(complex->point z5) ,(complex->point z6))
      (with "point-style" "none" ,p3))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Points
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-graphics (middle p1 p2)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (fig-/ (+ z1 z2) 2)))
    `(superpose 
      (with "point-style" "none" ,p1)
      (with "point-style" "none" ,p2)
      ,(complex->point z3))))                  ;; FIXME : problem to change the style of this point

(define-graphics (gravity p1 p2 p3)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (if (tm-point? p3) (point->complex p3) z2))
         (zm (fig-middle z1 z2) )
         (zg (+ zm (/ (- z3 zm) 3))))
    `(superpose 
      (with "point-style" "none" ,p1)
      (with "point-style" "none" ,p2)
      (with "point-style" "none" ,p3)
      ,(complex->point zg))))                  ;; FIXME : problem to change the style of this point

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Lines
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(tm-define (gen-perpendicular p1 p2 p3 p4 p5)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (if (tm-point? p3) (point->complex p3) z2))
         (z4 (if (tm-point? p4) (point->complex p4) z3))
         (z5 (if (tm-point? p5) (point->complex p5) z4))
         (dz (- z2 z1))
         (l  (magnitude dz))
         (d1 (if (= dz 0) 0 (* l (imag-part (fig-/ (- z4 z3) dz)))))
         (d2 (if (= dz 0) 0 (* l (imag-part (fig-/ (- z5 z3) dz)))))
         (z6 (+ z3 (* d1 (fig-normal dz))))
         (z7 (+ z3 (* d2 (fig-normal dz)))))
    `(superpose
      (with "point-style" "none" ,p1)
      (with "point-style" "none" ,p2)
      (with "point-style" "none" ,p3)
      (with "point-style" "none" ,p4)
      (with "point-style" "none" ,p5)
      (line ,(complex->point z6) ,(complex->point z7)))))

(define-graphics (perpendicular p1 p2 p3 p4 p5)
  (gen-perpendicular p1 p2 p3 p4 p5))

(define-graphics (mediator p1 p2 p4 p5)
  (gen-perpendicular p1 p2 (complex->point (fig-middle (point->complex p1) (point->complex p2))) p4 p5))

(define-graphics (parallel p1 p2 p3 p4 p5)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (if (tm-point? p3) (point->complex p3) z2))
         (z4 (if (tm-point? p4) (point->complex p4) z3))
         (z5 (if (tm-point? p5) (point->complex p5) z4))
         (dz (- z2 z1))
         (l  (magnitude dz))
         (d1 (if (= dz 0) 0 (* l (real-part (fig-/ (- z4 z3) dz)))))
         (d2 (if (= dz 0) 0 (* l (real-part (fig-/ (- z5 z3) dz)))))
         (z6 (+ z3 (* d1 (fig-unit dz))))
         (z7 (+ z3 (* d2 (fig-unit dz)))))
    `(superpose
      (with "point-style" "none" ,p1)
      (with "point-style" "none" ,p2)
      (with "point-style" "none" ,p3)
      (with "point-style" "none" ,p4)
      (with "point-style" "none" ,p5)
      (line ,(complex->point z6) ,(complex->point z7)))))

(define-graphics (bisector p1 p2 p3 p4 p5)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (if (tm-point? p3) (point->complex p3) z2))
         (z4 (if (tm-point? p4) (point->complex p4) z3))
         (z5 (if (tm-point? p5) (point->complex p5) z4))
         (z6 (if (= z2 (fig-middle z1 z3)) (+ z2 (fig-normal (- z1 z2))) (fig-middle z1 z3)))
         (dz (- z6 z2))
         (l  (magnitude dz))
         (d7 (if (= dz 0) 0 (* l (real-part (fig-/ (- z4 z2) dz)))))
         (d8 (if (= dz 0) 0 (* l (real-part (fig-/ (- z5 z2) dz)))))
         (z7 (+ z2 (* d7 (fig-unit dz))))
         (z8 (+ z2 (* d8 (fig-unit dz)))))
    `(superpose
      (with "point-style" "none" ,p1) (with "point-style" "none" ,p2)
      (with "point-style" "none" ,p3) (with "point-style" "none" ,p4)
      (with "point-style" "none" ,p5)
      (line ,(complex->point z7) ,(complex->point z8)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Triangles
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-graphics (equilateral P1 P2)
  (let* ((z1 (if (tm-point? P1) (point->complex P1) 0))
         (z2 (if (tm-point? P2) (point->complex P2) z1))
         (z3 (fig-rotation z1 z2 (* 5 (/ (pi) 3)))))
    `(cline ,(complex->point z1) ,(complex->point z2) ,(complex->point z3))))

(define-graphics (isosceles p1 p2 p3)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (if (tm-point? p3) (point->complex p3) z2))
         (dz (- z2 z1))
         (l  (magnitude dz))
         (d1 (if (= dz 0) 0 (* l (imag-part (/ (- z3 z1) dz)))))
         (vm (/ (+ z1 z2) 2))
         (z4 (+ vm (* d1 (fig-normal dz)))))
    `(superpose
      (cline ,(complex->point z1) ,(complex->point z2) ,(complex->point z4))
      (with "point-style" "none" ,p3))))

(define-graphics (isosceles2 p1 p2 p3)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (if (tm-point? p3) (point->complex p3) z2))
         (dz (- z2 z1))
         (l  (magnitude dz))
         (z4 (+ z2 (* l (fig-unit (- z3 z2))))))
    `(superpose
      (cline ,(complex->point z1) ,(complex->point z2) ,(complex->point z4))
      (with "point-style" "none" ,p3))))

(define-graphics (right-angled-triangle p1 p2 p3)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (if (tm-point? p3) (point->complex p3) z2))
         (dz (- z2 z1))
         (l  (magnitude dz))
         (d1 (if (= dz 0) 0 (* l (imag-part (/ (- z3 z1) dz)))))
         (z4 (+ z2 (* d1 (fig-normal dz)))))
    `(superpose
      (cline ,(complex->point z1) ,(complex->point z2) ,(complex->point z4))
      (with "point-style" "none" ,p3))))

(define-graphics (right-angled-triangle2 p1 p2 p3)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (if (tm-point? p3) (point->complex p3) z2))
         (z4 (fig-projection z1 z2 z3)))
    `(superpose
      (cline ,(complex->point z1) ,(complex->point z2) ,(complex->point z4))
      (with "point-style" "none" ,p3))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Quadrilaterals
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-graphics (square P1 P2)
  (let* ((z1 (if (tm-point? P1) (point->complex P1) 0))
         (z2 (if (tm-point? P2) (point->complex P2) z1))
         (z3 (fig-rotation z1 z2 (* 3 (/ (pi) 2))))
         (z4 (fig-rotation z2 z1 (/ (pi) 2))))
    `(cline ,(complex->point z1) ,(complex->point z2)
            ,(complex->point z3) ,(complex->point z4))))

(define-graphics (rectangle P1 P2)
  (let* ((p1 (if (tm-point? P1) P1 '(point "0" "0")))
         (p2 (if (tm-point? P2) P2 p1)))
    `(cline ,p1 (point ,(tm-x p2) ,(tm-y p1))
            ,p2 (point ,(tm-x p1) ,(tm-y p2)))))

(define-graphics (rectangle2 p1 p2 p3)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (if (tm-point? p3) (point->complex p3) z2))
         (dz (- z2 z1))
         (l  (magnitude dz))
         (d1 (if (= dz 0) 0 (* l (imag-part (/ (- z3 z1) dz)))))
         (z4 (+ z2 (* d1 (fig-normal dz))))
         (z5 (+ z1 (* d1 (fig-normal dz)))))
    `(superpose
      (cline ,(complex->point z1) ,(complex->point z2) 
             ,(complex->point z4) ,(complex->point z5))
      (with "point-style" "none" ,p3))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Circles
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-graphics (circle C P)
  (let* ((c  (if (tm-point? C) C '(point "0" "0")))
         (p  (if (tm-point? P) P c))
         (cx (tm-x c)) (cy (tm-y c))
         (px (tm-x p)) (py (tm-y p))
         (dx `(minus ,px ,cx)) (dy `(minus ,py ,cy))
         (q1 `(point (minus ,cx ,dx) (minus ,cy ,dy)))
         (q2 `(point (minus ,cx ,dy) (plus ,cy ,dx))))
    `(superpose (with "point-style" "none" ,c) (carc ,p ,q1 ,q2))))

(define-graphics (circle2 P1 P2)
  (let* ((z1 (if (tm-point? P1) (point->complex P1) 0))
         (z2 (if (tm-point? P2) (point->complex P2) z1))
         (z3 (fig-rotation z1 (fig-middle z1 z2) (/ (pi) 2))))
    `(carc ,(complex->point z1) ,(complex->point z3) ,(complex->point z2))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Polygons
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-graphics (pentagon P1 P2)
  (let* ((z1 (if (tm-point? P1) (point->complex P1) 0))
         (z2 (if (tm-point? P2) (point->complex P2) z1))
         (z3 (fig-rotation z1 z2 (* 7 (/ (pi) 5))))
         (z4 (fig-rotation z2 z3 (* 7 (/ (pi) 5))))
         (z5 (fig-rotation z3 z4 (* 7 (/ (pi) 5)))))
    `(cline ,(complex->point z1) ,(complex->point z2)
            ,(complex->point z3) ,(complex->point z4) ,(complex->point z5))))

(define-graphics (hexagon P1 P2)
  (let* ((z1 (if (tm-point? P1) (point->complex P1) 0))
         (z2 (if (tm-point? P2) (point->complex P2) z1))
         (z3 (fig-rotation z1 z2 (* 4 (/ (pi) 3))))
         (z4 (fig-rotation z2 z3 (* 4 (/ (pi) 3))))
         (z5 (fig-rotation z3 z4 (* 4 (/ (pi) 3))))
         (z6 (fig-rotation z4 z5 (* 4 (/ (pi) 3)))))
    `(cline ,(complex->point z1) ,(complex->point z2)
            ,(complex->point z3) ,(complex->point z4) 
            ,(complex->point z5) ,(complex->point z6))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Other figures
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Electrical diagrams
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define ((rescale z0 dz) p)
  (complex->point (+ z0 (* dz (point->complex p)))))

(tm-define (electrical im scale p1 p2 p3)
  (let* ((z1 (if (tm-point? p1) (point->complex p1) 0))
         (z2 (if (tm-point? p2) (point->complex p2) z1))
         (z3 (if (tm-point? p3) (point->complex p3) z2))
         (dz (- z2 z1))
         (l  (magnitude dz))
         (d1 (if (= dz 0) 0 (abs (* l (imag-part (/ (- z3 z1) dz))))))
         (d2 (/ (min l (/ d1 scale)) 2))
         (u  (if (= dz 0) 0 (* d2 (/ dz l))))
         (vm (/ (+ z1 z2) 2))
         (v1 (- vm u))
         (v2 (+ vm u))
         (rescaler (rescale v1 (- v2 v1))))
    `(superpose
      (line ,p1 ,(complex->point v1))
      ,(graphics-transform rescaler im)
      (line ,(complex->point v2) ,p2)
      (with "point-style" "none" ,p3))))

(define (std-condensator)
  `(superpose
     (line (point "0" "-2") (point "0" "2"))
     (line (point "1" "-2") (point "1" "2"))))

(define-graphics (condensator p1 p2 p3)
  (electrical (std-condensator) 2 p1 p2 p3))

(define (std-diode)
  `(superpose
     (cline (point "0" "-0.5") (point "1" "0") (point "0" "0.5"))
     (line (point "1" "-0.5") (point "1" "0.5"))))

(define-graphics (diode p1 p2 p3)
  (electrical (std-diode) 0.5 p1 p2 p3))