gnetlist/scheme/gnet-eagle.scm

   1 ;;; gEDA - GPL Electronic Design Automation
   2 ;;; gnetlist - gEDA Netlist
   3 ;;; Copyright (C) 2004-2010 Braddock Gaskill (braddock@braddock.com,
   4 ;;;                                           adapted PCB code to Eagle)
   5 ;;; Copyright (C) 1998-2010 Ales Hvezda
   6 ;;; Copyright (C) 1998-2010 gEDA Contributors (see ChangeLog for details)
   7 ;;;
   8 ;;; This program is free software; you can redistribute it and/or modify
   9 ;;; it under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 2 of the License, or
  11 ;;; (at your option) any later version.
  12 ;;;
  13 ;;; This program is distributed in the hope that it will be useful,
  14 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with this program; if not, write to the Free Software
  20 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22 ;; EAGLE netlist format
  23
  24 ;; This procedure takes a net name as determined by gnetlist and
  25 ;; modifies it to be a valid eagle net name.
  26 ;;
  27 (define eagle:map-net-names
  28   (lambda (net-name)
  29     (let ((net-alias net-name)
  30           )
  31       ;; Convert to all upper case because Eagle seems
  32       ;; to do that internally anyway and we'd rather do
  33       ;; it here to catch shorts created by not preserving
  34       ;; case.  Plus we can eliminate lots of ECO changes
  35       ;; that will show up during backannotation.
  36       (string-upcase net-alias)
  37       )
  38     )
  39   )
  40
  41 (define eagle:components
  42    (lambda (port packages)
  43       (if (not (null? packages))
  44          (begin
  45             (let ((pattern (gnetlist:get-package-attribute (car packages)
  46                                                            "pattern"))
  47             ;; The above pattern should stay as "pattern" and not "footprint"
  48                   (package (car packages))
  49                   (lib (gnetlist:get-package-attribute (car packages) "lib"))
  50                   (value (gnetlist:get-package-attribute (car packages) "value"))
  51                   (device (gnetlist:get-package-attribute (car packages) "device"))
  52                   )
  53                (if (not (string=? pattern "unknown"))
  54                   (display pattern port))
  55                (display "ADD '" port)
  56                (display package port)
  57                (display "' " port)
  58 ;;             (display "' TQFP144@atmel (0 0)" port)
  59 ;;;            (write-char #\tab port)
  60                (display (gnetlist:get-package-attribute package "footprint") port)
  61                (display "@" port)
  62                (if (not (string=? lib "unknown"))
  63                    (display lib port)
  64                    (display "smd-ipc" port))
  65                (display " (1 1);" port)
  66                (newline port)
  67                (if (not (string=? value "unknown"))
  68                    (begin
  69                      (display "VALUE '" port)
  70                      (display package port)
  71                      (display "' '" port)
  72                      (display value port)
  73                      (display "';" port)
  74                      (newline port)
  75                      )
  76                    (if (not (string=? device "unknown"))
  77                        (begin
  78                          (display "VALUE '" port)
  79                          (display package port)
  80                          (display "' '" port)
  81                          (display device port)
  82                          (display "';" port)
  83                          (newline port)
  84                          )
  85                    ))
  86                )
  87             (eagle:components port (cdr packages))))))
  88
  89 (define (eagle:display-connections nets)
  90   (let ((k ""))
  91     (for-each (lambda (in-string)
  92                 (set! k (string-append k in-string)))
  93               (map (lambda (net)
  94                      (string-append "   '" (car net) "' '" (car (cdr net)) "'\r\n"))
  95                    nets))
  96     (string-append k ";\n")))
  97
  98
  99 ; This function is replaced with the above one. Due to non existent
 100 ; verification, this function is left commented out.
 101 ; /spe, 2002-01-08
 102 ;(define (eagle:display-connections nets)
 103 ;  (if (not (null? nets))
 104 ;      (string-append " " (car (car nets)) "." (car (cdr (car nets)))
 105 ;       (eagle:display-connections (cdr nets)))
 106 ;      "\n"))
 107
 108
 109
 110 (define eagle:write-net
 111    (lambda (port netnames)
 112       (if (not (null? netnames))
 113          (let ((netname (car netnames)))
 114             (display "SIGNAL '" port)
 115             (display (gnetlist:alias-net netname) port)
 116             (display "'" port)
 117             (newline port)
 118 ;            (display (gnetlist:wrap
 119 ;                     (eagle:display-connections
 120 ;                      (gnetlist:get-all-connections netname))
 121 ;                     78
 122 ;                     "")
 123 ;                    port)
 124             (display (eagle:display-connections
 125                        (gnetlist:get-all-connections netname))
 126                      port)
 127             (eagle:write-net port (cdr netnames))))))
 128
 129 (define eagle
 130    (lambda (filename)
 131       (let ((port (open-output-file filename)))
 132         ;; initialize the net-name aliasing
 133         (gnetlist:build-net-aliases eagle:map-net-names all-unique-nets)
 134
 135         ;; print out the header
 136 ;;;     (display "!EAGLE-POWERPCB-V3.0-MILS!\n" port)
 137 ;;;     (display "\n*PART*\n" port)
 138 ;;;     (display "/* CADSoft Eagle Scripted Netlist Format */\n" port)
 139         (display "   ;\n" port)
 140
 141         ;; print out the parts
 142         (eagle:components port packages)
 143
 144         ;; print out the net information
 145 ;;;     (display "\n*NET*\n" port)
 146         (eagle:write-net port (gnetlist:get-all-unique-nets "dummy"))
 147
 148         ;; print out the footer
 149 ;;;     (display "\n*END*\n" port)
 150         (close-output-port port))))
 151
 152