PasteRack.org
Paste # 30325
2017-10-09 01:43:25

Fork as a new paste.

Paste viewed 151 times.


Embed:

  1. #lang racket
  2. (require pict racket/draw)
  3.  
  4. (define ((pt->xform-obj width height angle) p)
  5.   (match p
  6.          [(list x y)
  7.           (define d (sqrt (+ (* x x) (* y y))))
  8.           (define a (atan y x))
  9.           (make-object point%
  10.                        (* d width 1/2 (cos (+ a angle)))
  11.                        (* d height 1/2 (- (sin (+ a angle)))))]))
  12.  
  13. (define (isoceles-triangle width height [angle 0])
  14.   (dc
  15.     (lambda (dc x y)
  16.       (let ([b (send dc get-brush)]
  17.             [p (send dc get-pen)])
  18.         (send dc set-pen (send the-pen-list
  19.                                find-or-create-pen
  20.                                (send p get-color)
  21.                                0
  22.                                'solid))
  23.         (send dc set-brush (send the-brush-list
  24.                                  find-or-create-brush
  25.                                  (send p get-color)
  26.                                  'solid))
  27.         (send dc draw-polygon
  28.               (map (pt->xform-obj width height angle)
  29.                    `((0 1)
  30.                      (-1 0)
  31.                      (1 0)))
  32.               (+ x (/ width 2)) (+ y (/ height 2)))
  33.         (send dc set-brush b)
  34.         (send dc set-pen p)))
  35.     width height))
  36.  
  37. (isoceles-triangle 50 80 (/ 3.14 6))

=>

image