#lang scheme
;; marshal.ss
;; Marshaling functions
(require mysterx)
(require "../../common/main.ss")
(require "../../utils.ss")
(require "com-utils.ss")

(provide marshal
         marshal->string
         marshal->string*

         point->com
         vector->com

         point->string
         vector->string
         number->acad-string)
;; For ActiveX
(define (marshal object)
  (case* object
    [com-object? => identity]
    [real? => exact->inexact]
    [point? => point->com]
    [gvector? => vector->com]
    [string? => identity]
    [vector?
     (vector-map marshal object)]

    [else (error "Can't marshal object " object)]))

;; For ActiveDocument.SendCommand
(define (marshal->string object)
  (case* object
    [real? => number->acad-string]
    [point? => point->string]
    [gvector? => vector->string]
;    [(lambda (x) (and (string? x)
;                      (string=? x "")))
;     "\r"]
    [string? => identity]
    [acad-entity? => entity-id]

    [else (error "Can't marshal object " object)]))

;; For ALISPs (command ...)
(define (marshal->string* object)
  (case* object
    [real? => number->acad-string]
    [point?
     (string-append "\"" (point->string object) "\"")]
    [gvector?
     (string-append "\"" (vector->string object) "\"")]
    ;[gvector? => vector->string]
    [(lambda (x) (and (string? x)
                      (string=? x "")))
     "\"\""]
    [string?
     (string-append "\"" object "\"")]
    [acad-entity? => entity-id]

    [else (error "Can't marshal object " object)]))



;; For COM bridging
(define (point->com point)
  (cond [(point-3d? point)
         (vector (exact->inexact (point-2d-x point))
                 (exact->inexact (point-2d-y point))
                 (exact->inexact (point-3d-z point)))]
        [(point-2d? point)
         (vector (exact->inexact (point-2d-x point))
                 (exact->inexact (point-2d-y point)))]
        [else (error "~s is not a point" point)]))

(define (vector->com vect)
  (cond [(vector-3d? vect)
         (vector (exact->inexact (vector-2d-x vect))
                 (exact->inexact (vector-2d-y vect))
                 (exact->inexact (vector-3d-z vect)))]
        [(vector-2d? vect)
         (vector (exact->inexact (vector-2d-x vect))
                 (exact->inexact (vector-2d-y vect)))]
        [else (error "~s is not a vector" vect)]))


;; For command, if needed:
(define (point->string p)
  (case* p
    [point-3d?
     (string-append (number->acad-string (point-2d-x p)) ","
                    (number->acad-string (point-2d-y p)) ","
                    (number->acad-string (point-3d-z p)))]
    [point-2d?
     (string-append (number->acad-string (point-2d-x p)) ","
                    (number->acad-string (point-2d-y p)))]))

(define (vector->string p)
  (case* p
    [vector-3d?
     (string-append (number->acad-string (vector-2d-x p)) ","
                    (number->acad-string (vector-2d-y p)) ","
                    (number->acad-string (vector-3d-z p)))]
    [vector-2d?
     (string-append (number->acad-string (vector-2d-x p)) ","
                    (number->acad-string ((vector-2d-y p))))]))

(define (number->acad-string n)
  (case* n
    [integer? => number->string]
    [rational? => (compose number->string exact->inexact)]
    [real? => number->string]
    [else (error "Can't use complex numbers!")])) ;; complex number

;; quick and dirty
(define (acad-entity? obj)
  (and (com-object? obj)
       (string=? (get-property (get-property obj Application) Name)
                 "AutoCAD")))

(define (entity-id ent)
  (string-append "(handent \""
                 (get-property ent Handle)
                 "\")"))