(use goo)

(use demos/archogen/matrix)

;; ldraw colors

(dv lcdb (tup 
          (tup "black" 0)
          (tup "blue" 1)
          (tup "green" 2)
          (tup "teal" 3)
          (tup "red" 4)
          (tup "d-pink" 5)
          (tup "brown" 6)
          (tup "l-gray" 7)
          (tup "d-gray" 8)
          (tup "l-blue" 9)
          (tup "l-green" 10)
          (tup "turqoise" 11)
          (tup "l-red" 12)
          (tup "pink" 13)
          (tup "yellow" 14)
          (tup "white" 15)
          (tup "mint-gren" 17)
          (tup "l-yellow" 18)
          (tup "tan" 19)
          (tup "l-purple" 20)
          (tup "glow-in-the-dark" 21)
          (tup "purple" 22)
          (tup "violet-blue" 23)
          (tup "orange" 25)
          (tup "d-trans-blue" 33)
          (tup "trans-green" 34)
          (tup "trans-red" 36)
          (tup "trans-gray" 39)
          (tup "l-trans-blue" 41)
          (tup "trans-neon-green" 42)
          (tup "trans-yellow" 46)
          (tup "clear" 47)
          (tup "trans-orange" 57)
          )
  )

(dm find-lcolor (name|<str> => <int>)
  (esc found-it
    (do (fun (x) 
          (when (= (1st x) name)
            (found-it (2nd x))))
        lcdb)
    )
  )

;; limited parts db

(dv lpdb (tup
          (tup 1 1 1 3005 'rect)
          (tup 1 1 1 3062 'round)
          (tup 1 2 1 3004 'rect)
          (tup 1 3 1 3622 'rect)
          (tup 1 4 1 3010 'rect)
          (tup 1 6 1 3009 'rect)
          (tup 1 8 1 3008 'rect)
          (tup 1 10 1 6111 'rect)
          (tup 1 12 1 6112 'rect)
          (tup 1 16 1 2465 'rect)
          (tup 2 2 1 3003 'rect)
          (tup 2 2 1 2357 'corner)
          (tup 2 2 1 3063 'corner-round)
          (tup 2 2 1 3941 'round)
          (tup 2 3 1 3002 'rect)
          (tup 2 4 1 3001 'rect)
          (tup 2 6 1 2456 'rect)
          (tup 2 8 1 3007 'rect)
          (tup 2 10 1 3006 'rect)
          )
  )

(dm find-part (width|<int> length|<int> height|<int> attr|<sym>)
  (esc found-it
    (do (fun (x)
          (if (and (and (and (= (1st x) width)
                             (= (2nd x) length))
                        (= (3rd x) height))
                   (= (elt x 4) attr))
              (found-it (elt x 3)))
          )
        lpdb)
    )
  )

(dc <ldraw-line> (<any>))

(dg write-out (obj|<ldraw-line> port))

(dc <ldraw-file> (<any>))
(dp lines (<ldraw-file> => <col>) (vec))

(dm new-ldraw-file (=> <ldraw-file>)
  (new <ldraw-file>)
  )

(dm save-file (file|<ldraw-file> name|<str>)
  (with-port (ldraw-out-port (open <file-out-port> (cat name ".dat")))
             (do (fun (x) (write-out x ldraw-out-port))
                 (lines file))
             (force-out ldraw-out-port)
             )
  )

(dc <ldraw-meta-command> (<ldraw-line>))

(dp command-text (<ldraw-meta-command> => <str>))

(dm write-out (meta|<ldraw-meta-command> port)
  (msg port "0 %=\n" (command-text meta))
  )

(dc <ldraw-part-ref> (<ldraw-line>))

(dp part-color (<ldraw-part-ref> => <int>))
(dp part-x (<ldraw-part-ref> => <int>))
(dp part-y (<ldraw-part-ref> => <int>))
(dp part-z (<ldraw-part-ref> => <int>))
(dp part-matrix (<ldraw-part-ref> => <matrix>))
(dp part-number (<ldraw-part-ref> => <int>))

(dm render-part (file|<ldraw-file> width|<int> length|<int> x|<int> y|<int> z|<int> rot|<int> color|<int>)
  (def part-ref 
    (new <ldraw-part-ref>))
  (set (part-color part-ref) color)
  (set (part-x part-ref) x)
  (set (part-y part-ref) y)
  (set (part-z part-ref) z)
  (set (part-matrix part-ref) (fab-matrix 3 3))
  (set (part-number part-ref) (find-part width length 1 'rect))
  (matrix-rot-y (part-matrix part-ref) rot)
  (add! (lines file) part-ref)
  )

(dm write-out (part|<ldraw-part-ref> port)
  (msg port "1 %= %= %= %= %= %= %= %= %= %= %= %= %= %=.dat\n"
       (part-color part) (part-x part) (part-y part) (part-z part)
       (matrix-elt (part-matrix part) 0)
       (matrix-elt (part-matrix part) 1)
       (matrix-elt (part-matrix part) 2)
       (matrix-elt (part-matrix part) 3)
       (matrix-elt (part-matrix part) 4)
       (matrix-elt (part-matrix part) 5)
       (matrix-elt (part-matrix part) 6)
       (matrix-elt (part-matrix part) 7)
       (matrix-elt (part-matrix part) 8)
       (part-number part)
       )
  )

(export
  find-part
  find-lcolor
  new-ldraw-file
  save-file
  render-part
  )