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., 675 Mass Ave, Cambridge, MA 02139, USA.
  19
  20 ;; PADS netlist format
  21
  22 ;; This procedure takes a net name as determined by gnetlist and
  23 ;; modifies it to be a valid pads net name.
  24 ;;
  25 (define pads:map-net-names
  26   (lambda (net-name)
  27     (let ((net-alias net-name)
  28           )
  29       ;; Convert to all upper case because Pads seems
  30       ;; to do that internally anyway and we'd rather do
  31       ;; it here to catch shorts created by not preserving
  32       ;; case.  Plus we can eliminate lots of ECO changes
  33       ;; that will show up during backannotation.
  34       (string-upcase net-alias)
  35       )
  36     )
  37   )
  38
  39 ;; This procedure takes a refdes as determined by gnetlist and
  40 ;; modifies it to be a valid pads refdes.
  41 ;;
  42 (define pads:map-refdes
  43   (lambda (refdes)
  44     (let ((refdes-alias refdes)
  45           )
  46       ;; Convert to all upper case because Pads seems
  47       ;; to do that internally anyway and we'd rather do
  48       ;; it here to catch name clashes created by not preserving
  49       ;; case.
  50       (string-upcase refdes-alias)
  51       )
  52     )
  53   )
  54
  55 (define pads:components
  56    (lambda (port packages)
  57       (if (not (null? packages))
  58          (begin
  59             (let ((pattern (gnetlist:get-package-attribute (car packages)
  60                                                            "pattern"))
  61             ;; The above pattern should stay as "pattern" and not "footprint"
  62                   (package (car packages)))
  63                (if (not (string=? pattern "unknown"))
  64                   (display pattern port))
  65
  66                ;; print out the refdes with aliasing
  67                (display (gnetlist:alias-refdes package) port)
  68
  69                (write-char #\tab port)
  70                (display (gnetlist:get-package-attribute package "footprint") port)
  71                (display "\r\n" port))
  72             (pads:components port (cdr packages))))))
  73
  74 (define (pads:display-connections nets)
  75   (let ((k ""))
  76     (for-each (lambda (in-string)
  77                 (set! k (string-append k in-string)))
  78               (map (lambda (net)
  79                      (string-append " " (gnetlist:alias-refdes (car net)) "." (car (cdr net))))
  80                    nets))
  81     (string-append k "\r\n")))
  82
  83
  84 ; This function is replaced with the above one. Due to non existent
  85 ; verification, this function is left commented out.
  86 ; /spe, 2002-01-08
  87 ;(define (pads:display-connections nets)
  88 ;  (if (not (null? nets))
  89 ;      (string-append " " (car (car nets)) "." (car (cdr (car nets)))
  90 ;       (pads:display-connections (cdr nets)))
  91 ;      "\r\n"))
  92
  93
  94
  95 (define pads:write-net
  96    (lambda (port netnames)
  97       (if (not (null? netnames))
  98          (let ((netname (car netnames)))
  99             (display "*SIGNAL* " port)
 100             (display (gnetlist:alias-net netname) port)
 101             (display "\r\n" port)
 102             (display (gnetlist:wrap
 103                       (pads:display-connections
 104                        (gnetlist:get-all-connections netname))
 105                       78
 106                       "")
 107                      port)
 108             (pads:write-net port (cdr netnames))))))
 109
 110 (define pads
 111    (lambda (filename)
 112       (let ((port (open-output-file filename)))
 113         ;; initialize the net-name aliasing
 114         (gnetlist:build-net-aliases pads:map-net-names all-unique-nets)
 115
 116         ;; initialize the refdes aliasing
 117         (gnetlist:build-refdes-aliases pads:map-refdes packages)
 118
 119         ;; print out the header
 120         (display "!PADS-POWERPCB-V3.0-MILS!\r\n" port)
 121         (display "\r\n*PART*\r\n" port)
 122
 123         ;; print out the parts
 124         (pads:components port packages)
 125
 126         ;; print out the net information
 127         (display "\r\n*NET*\r\n" port)
 128         (pads:write-net port (gnetlist:get-all-unique-nets "dummy"))
 129
 130         ;; print out the footer
 131         (display "\r\n*END*\r\n" port)
 132         (close-output-port port))))
 133