#lang racket
(provide point-of direction-of subpath-of 
         dir-spec mediation
         addto 
         draw drawarrow drawdblarrow fill dashpattern 
         mpost-assert)
;;---------------------------------------
(require "mpost-variable.rkt")
(require "mpost-utils.rkt")
(require "mpost-type-funs.rkt")
(require "mpost-interface.rkt")
(define-syntax-rule (def-x-of-path x name type)
  (def-exp (name n) type
    (lambda () (to-string (list x n 'of p)))))
(def-exp (point-of n p)
  ((type-> 'numeric 'path 'pair))
  (to-string (list 'point n 'of p)))
(def-exp (direction-of n p)
  ((type-> 'numeric 'path 'pair))
  (to-string (list 'direction n 'of p)))
(def-exp (subpath-of p1 p2 p)
  ((type-> 'numeric 'numeric 'path 'path))
  (to-string (list 'subpath "(" p1 #\, p2 ")" 'of  p)))
(define (dir-spec z)
  (to-string (list "{" z "}")))
(def-exp (mediation m a b)
  ((type-> 'numeric 'pair 'pair 'pair)
   (type-> 'numeric 'color 'color 'color))
  (to-string (list "(" m ")" "["  a "," b "]")))
(define (with-exp keyword value) 
  (if value (to-string (list keyword value)) ""))
(define (def-fun-with-options f)
  (lambda  ( #:withcolor [color #f]
             #:withpen   [pen #f]
             #:dashed    [dash #f] . args )
    (insert (to-string (list 
                        (apply f args)
                        (with-exp 'withcolor color)
                        (with-exp 'withpen pen)
                        (with-exp 'dashed dash) ";\n")))))
(define (def-draw-fun op)
  (def-fun-with-options
    (lambda (obj) (to-string (list op obj)))))
(define (check-action action)
  (if (null? (member action '(contour doublepath also)))
      (error "action must be 'contour doublepath also'" action)
      action))
(define addto (def-fun-with-options 
                 (lambda (pic action obj)
                   (to-string
                    (list
                     'addto pic 
                     (check-action action)
                     obj)))))
(define draw (def-draw-fun 'draw))
(define drawarrow  (def-draw-fun 'drawarrow))
(define drawdblarrow (def-draw-fun 'drawdblarrow))
(define fill (def-draw-fun 'fill))
(def-exp (dashpattern a)
  ((lambda _ (list 'picture)))
  (to-string (list "dashpattern(" a ")")))
(define (mpost-assert boolean msg)
  ((compose insert to-string list)
   'if boolean ":" 
   'errmessage "(" msg ");\n" 
   'fi))