| blob | a40464e5a7ba98db0c64f65a8ef41f4b160dde4a |
1 ;;; gEDA - GPL Electronic Design Automation
2 ;;; gnetlist - gEDA Netlist
3 ;;; Copyright (C) 1998-2010 Ales Hvezda
4 ;;; Copyright (C) 1998-2020 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.
21 (use-modules (ice-9 optargs))
23 ;; --------------------------------------------------------------------------
24 ;;
25 ;; protelII netlist format specific functions go here
26 ;;
27 ;; PROTEL NETLIST 2.0
28 ;; [ -- element for list of components
29 ;; DESIGNATOR
30 ;; REFDES attribute.
31 ;; FOOTPRINT
32 ;; FOOTPRINT attrbute.
33 ;; PARTTYPE
34 ;; Either:
35 ;; If VALUE attribute exists, output VALUE attribute.
36 ;; Otherwise, output DEVICE attrbute.
37 ;; (This covers the case of ICs, which usually carry their part no (e.g. uA741) in the DEVICE attribute.)
38 ;; DESCRIPTION
39 ;; DEVICE attribute
40 ;; Part Field 1
41 ;; *
42 ;; Part Field 2
43 ;; *
44 ;; Part Field 3
45 ;; *
46 ;; Part Field 4
47 ;; *
48 ;; Part Field 5
49 ;; *
50 ;; Part Field 6
51 ;; *
52 ;; Part Field 7
53 ;; *
54 ;; Part Field 8
55 ;; *
56 ;; Part Field 9
57 ;; *
58 ;; Part Field 10
59 ;; *
60 ;; Part Field 11
61 ;; *
62 ;; Part Field 12
63 ;; *
64 ;; Part Field 13
65 ;; *
66 ;; Part Field 14
67 ;; *
68 ;; Part Field 15
69 ;; *
70 ;; Part Field 16
71 ;; *
72 ;; LIBRARYFIELD1
73 ;; empty line
74 ;; LIBRARYFIELD2
75 ;; empty line
76 ;; LIBRARYFIELD3
77 ;; empty line
78 ;; LIBRARYFIELD4
79 ;; empty line
80 ;; LIBRARYFIELD5
81 ;; empty line
82 ;; LIBRARYFIELD6
83 ;; empty line
84 ;; LIBRARYFIELD7
85 ;; empty line
86 ;; LIBRARYFIELD8
87 ;; empty line
88 ;; ]
89 ;; [
90 ;; ... other components ...
91 ;; ]
92 ;; ( -- element for list of nets
93 ;; NETNAME
94 ;; PART-PIN# VALUE-PINNAME PINTYPE -- use PASSIVE for PINTYPE
95 ;; ...more connections...
96 ;; )
97 ;; (
98 ;; ...more nets...
99 ;; )
100 ;; { -- element for net option list
101 ;; NETNAME
102 ;; OPTION
103 ;; OPTIONVALUE
104 ;; TRACK
105 ;; 24
106 ;; VIA
107 ;; 40
108 ;; NET TOPOLOGY
109 ;; SHORTEST
110 ;; ROUTING PRIORITY
111 ;; MEDIUM
112 ;; LAYER
113 ;; UNDEFINED
114 ;; }
115 ;; {
116 ;; ...more net options...
117 ;; }
118 ;;
120 ;; We redefine the newline function, because this file format requires
121 ;; Windows-style "\r\n" line endings rather than Unix-style "\n"
122 ;; endings.
123 (define* (newline #:optional)
124 (display "\r\n" (or (current-output-port))))
126 ;;
127 ;; Top level header
128 ;;
129 (define (protelII:write-top-header)
130 (display "PROTEL NETLIST 2.0")
131 (newline))
133 ;;
134 ;; Top level component writing
135 ;;
136 (define protelII:components
137 (lambda (ls)
138 (if (not (null? ls))
139 (let ((package (car ls)))
140 (begin
141 (display "[")
142 (newline)
143 (display "DESIGNATOR")
144 (newline)
145 (display package)
146 (newline)
147 (display "FOOTPRINT")
148 (newline)
149 (display (gnetlist:get-package-attribute package "footprint"))
150 (newline)
151 (display "PARTTYPE")
152 (newline)
153 (let ((value (get-value package))) ;; This change by SDB on 10.12.2003.
154 (if (string-ci=? value "unknown")
155 (display (get-device package))
156 (display value)
157 )
158 )
159 (newline)
160 (display "DESCRIPTION")
161 (newline)
162 (display (get-device package))
163 (newline)
164 (display "Part Field 1")
165 (newline)
166 (display "*")
167 (newline)
168 (display "Part Field 2")
169 (newline)
170 (display "*")
171 (newline)
172 (display "Part Field 3")
173 (newline)
174 (display "*")
175 (newline)
176 (display "Part Field 4")
177 (newline)
178 (display "*")
179 (newline)
180 (display "Part Field 5")
181 (newline)
182 (display "*")
183 (newline)
184 (display "Part Field 6")
185 (newline)
186 (display "*")
187 (newline)
188 (display "Part Field 7")
189 (newline)
190 (display "*")
191 (newline)
192 (display "Part Field 8")
193 (newline)
194 (display "*")
195 (newline)
196 (display "Part Field 9")
197 (newline)
198 (display "*")
199 (newline)
200 (display "Part Field 10")
201 (newline)
202 (display "*")
203 (newline)
204 (display "Part Field 11")
205 (newline)
206 (display "*")
207 (newline)
208 (display "Part Field 12")
209 (newline)
210 (display "*")
211 (newline)
212 (display "Part Field 13")
213 (newline)
214 (display "*")
215 (newline)
216 (display "Part Field 14")
217 (newline)
218 (display "*")
219 (newline)
220 (display "Part Field 15")
221 (newline)
222 (display "*")
223 (newline)
224 (display "Part Field 16")
225 (newline)
226 (display "*")
227 (newline)
228 (display "LIBRARYFIELD1")
229 (newline)
230 (display "")
231 (newline)
232 (display "LIBRARYFIELD2")
233 (newline)
234 (display "")
235 (newline)
236 (display "LIBRARYFIELD3")
237 (newline)
238 (display "")
239 (newline)
240 (display "LIBRARYFIELD4")
241 (newline)
242 (display "")
243 (newline)
244 (display "LIBRARYFIELD5")
245 (newline)
246 (display "")
247 (newline)
248 (display "LIBRARYFIELD6")
249 (newline)
250 (display "")
251 (newline)
252 (display "LIBRARYFIELD7")
253 (newline)
254 (display "")
255 (newline)
256 (display "LIBRARYFIELD8")
257 (newline)
258 (display "")
259 (newline)
260 (display "]")
261 (newline)
262 (protelII:components (cdr ls)))))))
264 ;;
265 ;; Display the individual net connections
266 ;;
267 (define protelII:display-connections
268 (lambda (nets)
269 (if (not (null? nets))
270 (begin
271 (let ((package (car (car nets))))
272 (display package)
273 (write-char #\-)
274 (display (car (cdr (car nets))))
275 (display " ")
276 (display (get-device package))
277 (display "-")
278 (display (car (cdr (car nets))))
279 (display " PASSIVE"))
280 (if (not (null? (cdr nets)))
281 (begin
282 (newline)))
283 (protelII:display-connections (cdr nets))))))
285 ;;
286 ;; Display all nets
287 ;;
288 (define protelII:display-name-nets
289 (lambda (nets)
290 (begin
291 (protelII:display-connections nets)
292 (write-char #\space)
293 (newline))))
295 ;;
296 ;; Write netname : uref pin, uref pin, ...
297 ;;
298 (define protelII:write-net
299 (lambda (netnames)
300 (if (not (null? netnames))
301 (let ((netname (car netnames)))
302 (begin
303 (display "(")
304 (newline)
305 (display netname)
306 (newline)
307 (protelII:display-name-nets (gnetlist:get-all-connections netname))
308 (display ")")
309 (newline)
310 (protelII:write-net (cdr netnames)))))))
312 ;;
313 ;; Write the net part of the gEDA format
314 ;;
315 (define protelII:nets
316 (lambda ()
317 (let ((all-uniq-nets (gnetlist:get-all-unique-nets "dummy")))
318 (protelII:write-net all-uniq-nets))))
320 ;;; Highest level function
321 ;;; Write my special testing netlist format
322 ;;;
323 (define (protelII output-filename)
324 (set-current-output-port (gnetlist:output-port output-filename))
325 (begin
326 (protelII:write-top-header)
327 (protelII:components packages)
328 (protelII:nets))
329 (close-output-port (current-output-port)))
331 ;;
332 ;; gEDA's native test netlist format specific functions ends
333 ;;
334 ;; --------------------------------------------------------------------------