#lang scheme
;; primitives.ss
;; Primitives for bridging the COM methods
(require "base.ss")
(require "marshal.ss")
(require "com-utils.ss")

(define debug #f)

;; Definer for bridges between COM methods and Scheme functions
(define-syntax define-com-bridge
  (syntax-rules ()
    [(_ name com-method arg ...)
     (begin (provide name)
            (define (name arg ...)
              (invoke com-method
                      (acad-mspace)
                      (marshal arg) ...)))]))

;; Drawing methods bridging scheme and COM
(define-com-bridge prim:region AddRegion objects)

(define-com-bridge prim:line   AddLine   from to)
(define-com-bridge prim:circle AddCircle center radius)
(define-com-bridge prim:point  AddPoint  p)
(define-com-bridge prim:text   AddText   string
                           lower-left
                           height)

(define-com-bridge prim:box      AddBox      p width length height)
(define-com-bridge prim:cone     AddCone     p radius height)
(define-com-bridge prim:cylinder AddCylinder p radius height)
(define-com-bridge prim:ellipse  AddEllipse  p radius ratio)
(define-com-bridge prim:sphere   AddSphere   p radius)
(define-com-bridge prim:torus    AddTorus    p torus-radius tube-radius)

(define-com-bridge prim:wedge    AddWedge    p length width height)


(provide prim:command
         prim:command*
         command-join) ;; for cheating...

;; Primitive wrapper that wraps a command into an AutoLISP (command ...)
;; DEBUGGGGGGG!
(require "../../utils.ss")
(define (prim:command* . args)
  (let* ([cmd (map marshal->string* args)])
    (when debug
      (display* 'Sendcommand: (string-append "(command "
                                             (apply string-append cmd)
                                             ")")))
    (invoke SendCommand (acad-active-document)
            (string-append "(command "
                           (apply string-append cmd)
                           ") "))))


(define (prim:command . args)
  (set! prim:command command-prim)
  (start-backend #t)
  (apply command-prim args))

(define (command-join delimiter commands)
  (define (command-join commands acc)
    (let ((str (if (char=? #\return
                           (string-ref acc (sub1 (string-length acc))))
                   acc
                   (string-append acc delimiter))))
      (if (null? commands)
          str
          (command-join (rest commands)
                        (string-append str (first commands))))))
  (if (null? commands)
      ""
      (command-join (rest commands) (first commands))))

(define (command-prim . args)
  (let ([cmd (command-join " " (map marshal->string args))])
    (when debug
      (display* "Sending: " cmd))
    (invoke SendCommand (acad-active-document)
            cmd)))