;;; gEDA - GPL Electronic Design Automation
;;; gnetlist - gEDA Netlist
;;; Copyright (C) 1998-2010 Ales Hvezda
;;; Copyright (C) 1998-2010 gEDA Contributors (see ChangeLog for details)
;;;
;;; 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., 51 Franklin Street, Fifth Floor, Boston,
;;; MA 02111-1301 USA.


;; Allegro netlist format


(define allegro:write-device-files
   (lambda (packages done)
      (if (not (null? packages))
         (let ((device (get-device (car packages))))
            (if (contains? done device)
               (allegro:write-device-files (cdr packages) done)
               (begin
                  (allegro:write-device device (car packages))
                  (allegro:write-device-files (cdr packages) (cons device done))))))))

(define allegro:write-device
   (lambda (device package)

      ;; Check if the 'devfiles' directory exist.
      (if (not (access? "devfiles" F_OK))
	  (if (access? "." W_OK) 
	      ;; If the 'devfiles' directory doesn't exist, and 
	      ;; we have write access to the current directory, then create it.
	      (mkdir "devfiles")
	      ;; If we don't have write access to the current directory,
	      ;; end with an error message.
	      (begin
		(error (string-append
			"the device files are expected to be in the 'devfiles' directory.\n"
			"       However, can't create it!.\n"
			"       Check write permissions of the current directory.\n"))))
	  ;; If 'devfiles' exist, check if it is a directory.
	  (if (not (eq? (stat:type (stat "devfiles")) 'directory))
	      (begin
		;; 'devfiles' exists, but it is not a directory.
		;; End with an error message.
		(error (string-append 
			"the device files are expected to be in the 'devfiles' directory.\n"
			"       However, 'devfiles' exists and it is not a directory!.\n"))
		)))
      ;; 'devfiles' should exist now. Check if we have write access.
      (if (not (access? "devfiles" W_OK))
	  ;; We don't have write access to 'devfiles'. 
	  ;; End with an error message
	  (error (string-append
		  "the device files are expected to be in the 'devfiles' directory.\n"
		  "       However, can't access it for writing!.\n"
		  "       Check write permissions of the 'devfiles' directory.\n")))
   

      (let ((p (open-output-file (string-downcase! (string-append "devfiles/" (string-append device ".txt"))))))
         (display "(Device File generated by gEDA Allegro Netlister)\n" p)
         (display "PACKAGE " p)
         (display (gnetlist:get-package-attribute package "footprint" )p)
         (newline p)
         (display "CLASS " p)
         (display (gnetlist:get-package-attribute package "class" )p)
         (newline p)
         (display "PINCOUNT " p)
         (display (gnetlist:get-package-attribute package "pins" )p)
         (newline p)
         (let ((altfoot (gnetlist:get-package-attribute package "alt_foot")))
            (if (not (string=? altfoot "unknown"))
               (begin
                  (display "PACKAGEPROP   ALT_SYMBOLS\n" p)
                  (display "'(" p)
                  (display altfoot p)
                  (display ")'\n" p))))
         (display "END\n" p)
         (close-output-port p))))

(define allegro:components
   (lambda (port packages)
      (if (not (null? packages))
         (begin
            (let ((footprint (gnetlist:get-package-attribute (car packages) 
                                                           "footprint"))
                  (package (car packages)))
               (if (not (string=? footprint "unknown"))
                  (display footprint port))
               (display "! " port)
               (display (gnetlist:get-package-attribute package "device") port)
               (display "! " port)
               (display (get-component-text package) port)
               (display "; " port )
               (display package port)
               (newline port))
            (allegro:components port (cdr packages))))))

(define allegro:display-connections
   (lambda (port nets)
      (if (not (null? nets))
	 (begin
	    (write-char #\space port) 
	    (display (car (car nets)) port)
	    (write-char #\. port) 
	    (display (car (cdr (car nets))) port)
	    (if (null? (cdr nets))
	       (newline port)
               (begin
	   	  (write-char #\, port) 
	          (newline port)
	          (allegro:display-connections port (cdr nets))
		))))))

(define allegro:write-net
   (lambda (port netnames)
      (if (not (null? netnames))
         (let ((netname (car netnames)))
	    (display netname port)
	    (display ";" port)
            (allegro:display-connections port (gnetlist:get-all-connections netname))
	    (allegro:write-net port (cdr netnames)))))) 

(define allegro 
   (lambda (filename)
      (let ((port (open-output-file filename)))
         (display "(Allegro netlister by M. Ettus)\n" port)
         (display "$PACKAGES\n" port)
         (allegro:components port packages)
         (display "$NETS\n" port)
         (allegro:write-net port (gnetlist:get-all-unique-nets "dummy"))
         (display "$END\n" port)
         (close-output-port port)
	 (allegro:write-device-files packages '() ))))

