#lang racket
(provide 
 ;; pair
 point
 ;; color
 color
 ;; path
 path fullcircle
 ;; picture
 btex TEX
 new-picture
 ;;
 (rename-out (unknown-numeric whatever)))
(require "mpost-interface.rkt")
(require "mpost-variable.rkt")
(require "mpost-type-funs.rkt")
(require "mpost-utils.rkt")
(def-exp (point x y)
  ((type-> 'numeric 'numeric 'pair))
  (to-string (list "("  x  "," y ")")))
(def-exp (color x y z)
  ((type-> 'numeric 'numeric 'numeric 'color))
  (to-string (list "("  x  "," y  "," z ")")))
(def-exp (path . points)
  ((lambda l (list 'path))) ;; ignore type checking
  (to-string  points))
(def-exp (fullcircle . args)
  ((type-> 'path)
   (type-> 'numeric 'path)
   (type-> 'numeric 'pair 'path)
   (type-> 'numeric 'pair 'numeric 'path)
   (type-> 'numeric 'pair 'numeric 'numeric 'path))
  (define helper
    (case-lambda
      (() (list 'makepath 'pencircle))
      ((R) `(,(fullcircle) scaled ,R))
      ((R O) `(,(fullcircle R) shifted ,O))
      ((R O xs) `(,(fullcircle R) xscaled ,xs shifted ,O))
      ((R O xs ys) `(,(fullcircle R) xscaled ,xs yscaled ,ys shifted ,O))))
  (to-string (apply helper args)))
(def-exp (btex . p)
  ((lambda _ (list 'picture)))
  (to-string (list "btex" p  "etex")))
(def-exp (TEX . p)
  ((lambda _ (list 'picture)))
  (to-string (list "TEX " p)))
(define (new-picture f)
  (let ((old-current-picture (unknown-picture))
        (new-current-picture (unknown-picture)))
    (insert 
     (to-string
      (list old-current-picture ":=" "currentpicture;\n"
            "currentpicture := nullpicture;\n")))
    (f)
    (insert 
     (to-string
      (list
       new-current-picture ":=" "currentpicture;\n"
       "currentpicture := " old-current-picture ";\n")))
    new-current-picture))