#lang racket
(provide polar rotate-around buildcycle
         pic-top pic-bottom pic-left pic-right)
(require "mpost-op-v.rkt")
(require "mpost-op-1.rkt")
(require "mpost-op-2.rkt")
(require "mpost-op-s.rkt")
(define (polar r1 alpha)
  (op* r1 (dir alpha)))
(define ((rotate-around a-point alpha) obj)
  (shift a-point (rotate alpha (shift (op* -1 a-point) obj))))
(define rotate-about rotate-around)
(define (buildcycle . args1)
  (define (rotate-list args1)
    (let ((r-args1 (reverse args1)))
      (cons (car r-args1) (reverse (cdr r-args1)))))
  (let* ((t-a-b (for/list ((v1 (in-list args1))
                           (v2 (in-list (rotate-list args1))))
                          (intersectiontimes v1 v2)))
         (ta (map xpart t-a-b))
         (tb1 (map ypart t-a-b))
         (tb `(,@(cdr tb1) ,(car tb1)))
         (points `(,@(for/list ((a (in-list ta))
                                (b (in-list tb))
                                (v1 (in-list args1)))
                               (subpath-of a b v1)) cycle)))
    (apply op.. points)))
(define (pic-position2 p1 p2 pic)
  (mediation 0.5 (p1 pic) (p2 pic)))
(define (pic-top pic)
  (pic-position2 ulcorner urcorner pic))
(define (pic-bottom pic)
  (pic-position2 llcorner lrcorner pic))
(define (pic-left pic)
  (pic-position2 llcorner ulcorner pic))
(define (pic-right pic)
  (pic-position2 lrcorner urcorner pic))