;;; -*-scheme-*-
;;;

;;; gEDA - GPL Electronic Design Automation
;;; gnetlist - gEDA Netlist
;;; Copyright (C) 1998-2010 Ales Hvezda
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;  gsch2pcb format  (based on PCBboard format by JM Routoure & Stefan Petersen)
;;  Bill Wilson    billw@wt.net
;;  6/17/2003


;;
;;
(define gsch2pcb:write-top-header
  (lambda (port)
    (display "# release: pcb 1.99x\n" port)
    (display "# To read pcb files, the pcb version (or the" port)
    (display " cvs source date) must be >= the file version\n" port)
    (display "FileVersion[20070407]\n" port)
    (display "PCB[\"\" 600000 500000]\n" port)
    (display "Grid[10000.000000 0 0 0]\n" port)
    (display "Cursor[0 0 0.000000]\n" port)
    (display "PolyArea[200000000.000000]\n" port)
    (display "Thermal[0.500000]\n" port)
    (display "DRC[1000 1000 1000 1000 1500 1000]\n" port)
    (display "Flags(\"nameonpcb,uniquename,clearnew,snappin\")\n" port)
    (display "Groups(\"1,c:2,s:3:4:5:6:7:8\")\n" port)
    (display "Styles[\"Signal,1000,3600,2000,1000:" port)
    (display "Power,2500,6000,3500,1000:" port)
    (display "Fat,4000,6000,3500,1000:" port)
    (display "Skinny,600,2402,1181,600\"]\n" port)
))

;;
;;
(define gsch2pcb:write-bottom-footer
  (lambda (port)
    (display "Layer(1 \"component\")\n(\n)\n" port)
    (display "Layer(2 \"solder\")\n(\n)\n" port)
    (display "Layer(3 \"outline\")\n(\n)\n" port)
    (display "Layer(4 \"GND\")\n(\n)\n" port)
    (display "Layer(5 \"power\")\n(\n)\n" port)
    (display "Layer(6 \"signal1\")\n(\n)\n" port)
    (display "Layer(7 \"signal2\")\n(\n)\n" port)
    (display "Layer(8 \"signal3\")\n(\n)\n" port)
    (display "Layer(9 \"silk\")\n(\n)\n" port)
    (display "Layer(10 \"silk\")\n(\n)" port)
    (newline port)))

;;
;;

;; Split string at current split-char and returns
;; a pair with substrings. If string is not splitable
;; it returns #f.
(define (gsch2pcb:string-split the-string split-char)
;;string-index is Guile specific
  (let ((split-index (string-index the-string split-char))
        (last-index (- (string-length the-string) 1)))
;;Check if split-char happens to be in the beginning or end of the string
    (cond ((not split-index)
           #f)
          ((= split-index 0)
           (gsch2pcb:string-split
            (substring the-string 1 (string-length the-string)) 
            split-char))
          ((= split-index last-index)
           #f)
          (split-index
           (cons (substring the-string 0 split-index)
                 (substring the-string (+ split-index 1) 
                            (string-length the-string))))
          (else
           #f))))

;; Splits a string with space separated words and returns a list
;; of the words (still as strings).
(define (gsch2pcb:split-to-list the-string)
  (let ((the-list (gsch2pcb:string-split the-string #\space)))
    (if the-list
        (cons (car the-list) (gsch2pcb:split-to-list (cdr the-list)))
        (list the-string))))

;; Joins the elements of a list of strings into a single string,
;; with each element prefixed by a given prefix string.
(define (gsch2pcb:list-join-with-prefixes the-list prefix)
  (if (null? the-list)
      ""
      (string-append prefix (car the-list)
                     (gsch2pcb:list-join-with-prefixes (cdr the-list) prefix))))


(define gsch2pcb:write-value-footprint
  (lambda (pipe ls)
    (if (not (null? ls))
;;       refdes contains the first element of ls        
        (let* ((refdes (car ls))
               (value (gnetlist:get-package-attribute refdes "value"))
               (footprint (gsch2pcb:split-to-list
                          (gnetlist:get-package-attribute refdes  "footprint") ) ) 
	       (lquote (if gsch2pcb:use-m4 "`" ""))
	       (rquote (if gsch2pcb:use-m4 "'" ""))

	       )

               (display (string-append "PKG_" (car footprint)) pipe)
               (display (string-append "(" lquote (car footprint)) pipe)
               (display (gsch2pcb:list-join-with-prefixes (cdr footprint) "-") pipe)
               (display (string-append rquote "," lquote refdes rquote "," lquote ) pipe)

               (display value pipe)
               (display (gsch2pcb:list-join-with-prefixes (cdr footprint) (string-append rquote "," lquote)) pipe)
               (display (string-append rquote ")") pipe)
               (newline pipe)
               (gsch2pcb:write-value-footprint pipe (cdr ls))) )))

;;
;;

(define gsch2pcb:use-m4 #f)


;; Let the user override the m4 command, the directory
;; where pcb stores its m4 files and the pcb config directory.
(if (not (defined? 'gsch2pcb:pcb-m4-command)) (define gsch2pcb:pcb-m4-command "/usr/bin/m4"))
(if (not (defined? 'gsch2pcb:pcb-m4-dir)) (define gsch2pcb:pcb-m4-dir "/usr/local/share/pcb/m4"))
(if (not (defined? 'gsch2pcb:pcb-m4-confdir)) (define gsch2pcb:pcb-m4-confdir "/usr/local/etc/pcb"))

;; Let the user override the m4 search path
(if (not (defined? 'gsch2pcb:pcb-m4-path))
    (define gsch2pcb:pcb-m4-path (list gsch2pcb:pcb-m4-dir gsch2pcb:pcb-m4-confdir "$HOME/.pcb" "."))
)

;; Build up the m4 command line

(define gsch2pcb:m4-command-line-tmp (string-append
				  gsch2pcb:pcb-m4-command " -d ") )
(define gsch2pcb:pcb-m4-path-str #f)
(for-each (lambda (d)
	    (set! gsch2pcb:m4-command-line-tmp (string-append
						gsch2pcb:m4-command-line-tmp
						" -I" d))
	    (if gsch2pcb:pcb-m4-path-str
		(set! gsch2pcb:pcb-m4-path-str (string-append
						gsch2pcb:pcb-m4-path-str
						"  " d) )
		(set! gsch2pcb:pcb-m4-path-str d)
		)
	    )
	  gsch2pcb:pcb-m4-path
	  )



(set! gsch2pcb:m4-command-line-tmp
      ( string-append gsch2pcb:m4-command-line-tmp
		      " " gsch2pcb:pcb-m4-dir "/common.m4 - >> "
		      )
      )

(if (not (defined? 'gsch2pcb:pcb-m4-command-line))
    (define gsch2pcb:pcb-m4-command-line
      gsch2pcb:m4-command-line-tmp)
    )

(use-modules (ice-9 popen))

(define (gsch2pcb output-filename)
  (let ((port (open-output-file output-filename)))
    (gsch2pcb:write-top-header port)
    (close-port port)
    )

  (set! gsch2pcb:pcb-m4-command-line (string-append
				  gsch2pcb:pcb-m4-command-line
				  output-filename))
  (display (string-append
	    "=====================================================\n"
	    "gsch2pcb backend configuration:\n"
	    "\n"
	    "   ----------------------------------------\n"
	    "   Variables which may be changed in gafrc:\n"
	    "   ----------------------------------------\n"
	    "   gsch2pcb:pcb-m4-command:    " gsch2pcb:pcb-m4-command "\n"
	    "   gsch2pcb:pcb-m4-dir:        " gsch2pcb:pcb-m4-dir "\n"
	    "   gsch2pcb:pcb-m4-confdir:    " gsch2pcb:pcb-m4-confdir "\n"
	    "   gsch2pcb:pcb-m4-path:       " gsch2pcb:pcb-m4-path-str "\n"
	    "   gsch2pcb:m4-command-line:   " gsch2pcb:pcb-m4-command-line  "\n"
	    "\n"
	    "   ---------------------------------------------------\n"
	    "   Variables which may be changed in the project file:\n"
	    "   ---------------------------------------------------\n"
	    "   gsch2pcb:use-m4:            " (if gsch2pcb:use-m4 "yes" "no") "\n"
	    "\n"
	    "=====================================================\n"
	    )
	   )

  ;; If we have defined gsch2pcb:use-m4 then run the footprints
  ;; through the pcb m4 setup.  Otherwise skip m4 entirely
  (if gsch2pcb:use-m4
      ;; pipe with the macro define in pcb program
      (let ((pipe (open-output-pipe gsch2pcb:pcb-m4-command-line))
	    )
	
	(display "Using the m4 processor for pcb footprints\n")
	;; packages is a list with the different refdes value
	(gsch2pcb:write-value-footprint pipe packages)
	(close-pipe pipe)
	)
      
      (let ((port  (open output-filename (logior O_WRONLY O_APPEND))))
	(display "Skipping the m4 processor for pcb footprints\n")
	(gsch2pcb:write-value-footprint port packages)
	(close-port port)
	)
      )

  (let ((port (open output-filename (logior O_WRONLY O_APPEND))))
    (gsch2pcb:write-bottom-footer port)
    close-port port)
  )

