gnetlist/scheme/gnet-pads.scm

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