56 lines
1.7 KiB
Scheme
56 lines
1.7 KiB
Scheme
(define (make-rectangle-polygon x y width height)
|
|
(list (cons x y)
|
|
(cons (+ x width) y)
|
|
(cons (+ x width) (+ y height))
|
|
(cons x (+ y height))))
|
|
|
|
(define (make-triangle-polygon x y width height)
|
|
(list (cons x y)
|
|
(cons (+ x (exact (round (/ width 2))))
|
|
(+ y height))
|
|
(cons (- x (exact (round (/ width 2))))
|
|
(+ y height))))
|
|
|
|
(define (draw-polygon polygon)
|
|
(let* ((first-point #f)
|
|
(previous-point #f))
|
|
(for-each
|
|
(lambda (point)
|
|
(when (not first-point)
|
|
(set! first-point point)
|
|
(set! previous-point first-point))
|
|
(draw-line previous-point point)
|
|
(set! previous-point point))
|
|
polygon)
|
|
(when first-point
|
|
(draw-line previous-point first-point))))
|
|
|
|
(define (draw-relative-polygon x y polygon)
|
|
(let* ((first-point #f)
|
|
(previous-point #f))
|
|
(for-each
|
|
(lambda (point)
|
|
(when (not first-point)
|
|
(set! first-point point)
|
|
(set! previous-point first-point))
|
|
(draw-line (cons (+ (car previous-point) x)
|
|
(+ (cdr previous-point) y))
|
|
(cons (+ (car point) x)
|
|
(+ (cdr point) y)))
|
|
(set! previous-point point))
|
|
polygon)
|
|
(when first-point
|
|
(draw-line (cons (+ (car previous-point) x)
|
|
(+ (cdr previous-point) y))
|
|
(cons (+ (car first-point) x)
|
|
(+ (cdr first-point) y))))))
|
|
|
|
(define (move-polygon polygon x y)
|
|
(map (lambda (point)
|
|
(cons (+ (car point) x)
|
|
(+ (cdr point) y)))
|
|
polygon))
|
|
|
|
(define (rotate-polygon polygon degrees)
|
|
(error "WIP"))
|