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
135