Updated copyright text/header in most source files.
[geda-gaf/peter-b.git] / gnetlist / scheme / gnet-protelII.scm
blob11e89ca2df52572118ac1d5fe3831dfe0e038980
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.
20 ;; --------------------------------------------------------------------------
22 ;; protelII netlist format specific functions go here 
24 ;; PROTEL NETLIST 2.0
25 ;; [   -- element for list of components
26 ;; DESIGNATOR
27 ;;   REFDES attribute.
28 ;; FOOTPRINT
29 ;;   FOOTPRINT attrbute.
30 ;; PARTTYPE
31 ;;   Either:
32 ;;     If VALUE attribute exists, output VALUE attribute.
33 ;;     Otherwise, output DEVICE attrbute.
34 ;;     (This covers the case of ICs, which usually carry their part no (e.g. uA741) in the DEVICE attribute.)
35 ;; DESCRIPTION
36 ;;   DEVICE attribute
37 ;; Part Field 1
38 ;; *
39 ;; Part Field 2
40 ;; *
41 ;; Part Field 3
42 ;; *
43 ;; Part Field 4
44 ;; *
45 ;; Part Field 5
46 ;; *
47 ;; Part Field 6
48 ;; *
49 ;; Part Field 7
50 ;; *
51 ;; Part Field 8
52 ;; *
53 ;; Part Field 9
54 ;; *
55 ;; Part Field 10
56 ;; *
57 ;; Part Field 11
58 ;; *
59 ;; Part Field 12
60 ;; *
61 ;; Part Field 13
62 ;; *
63 ;; Part Field 14
64 ;; *
65 ;; Part Field 15
66 ;; *
67 ;; Part Field 16
68 ;; *
69 ;; LIBRARYFIELD1
70 ;; empty line
71 ;; LIBRARYFIELD2
72 ;; empty line
73 ;; LIBRARYFIELD3
74 ;; empty line
75 ;; LIBRARYFIELD4
76 ;; empty line
77 ;; LIBRARYFIELD5
78 ;; empty line
79 ;; LIBRARYFIELD6
80 ;; empty line
81 ;; LIBRARYFIELD7
82 ;; empty line
83 ;; LIBRARYFIELD8
84 ;; empty line
85 ;; ]
86 ;; [
87 ;; ... other components ...
88 ;; ]
89 ;; (  -- element for list of nets
90 ;; NETNAME
91 ;; PART-PIN# VALUE-PINNAME PINTYPE  -- use PASSIVE for PINTYPE
92 ;; ...more connections...
93 ;; )
94 ;; (
95 ;; ...more nets...
96 ;; )
97 ;; { -- element for net option list
98 ;; NETNAME
99 ;; OPTION
100 ;; OPTIONVALUE
101 ;; TRACK
102 ;; 24
103 ;; VIA
104 ;; 40
105 ;; NET TOPOLOGY
106 ;; SHORTEST
107 ;; ROUTING PRIORITY
108 ;; MEDIUM
109 ;; LAYER
110 ;; UNDEFINED
111 ;; }
112 ;; {
113 ;; ...more net options...
114 ;; }
118 ;; Top level header
120 (define protelII:write-top-header
121    (lambda (p)
122       (display "PROTEL NETLIST 2.0" p) 
123       (newline p)))
124       
126 ;; header for components section
128 (define protelII:start-components
129    (lambda (p)
130       (display "" p)))
131 ;; no header for components   
134 ;; footer for components section
136 (define protelII:end-components
137    (lambda (p)
138       (display "" p)))
141 ;; header for renamed section
143 (define protelII:start-renamed-nets
144    (lambda (p)
145       (display "" p)))
148 ;; footer for renamed section
150 (define protelII:end-renamed-nets
151    (lambda (p)
152       (display "" p)))
155 ;; header for nets section
157 (define protelII:start-nets
158    (lambda (p)
159       (display "" p)))
162 ;; footer for net section
164 (define protelII:end-nets
165    (lambda (p)
166       (display "" p)))
167         
169 ;; Top level component writing 
171 (define protelII:components
172    (lambda (port ls)
173       (if (not (null? ls))
174          (let ((package (car ls)))
175             (begin
176                (display "[" port)
177                (newline port)
178                (display "DESIGNATOR" port)
179                (newline port)
180                (display package port)
181                (newline port)
182                (display "FOOTPRINT" port)
183                (newline port)
184                (display (gnetlist:get-package-attribute package  "footprint") port)
185                (newline port)
186                (display "PARTTYPE" port)
187                (newline port)
188                (let ((value (get-value package)))          ;; This change by SDB on 10.12.2003.
189                      (if (string-ci=? value "unknown")
190                          (display (get-device package) port)
191                          (display value port)
192                          )
193                )
194                (newline port)
195                (display "DESCRIPTION" port)
196                (newline port)
197                (display (get-device package) port)
198                (newline port)
199                (display "Part Field 1" port)
200                (newline port)
201                (display "*" port)
202                (newline port)
203                (display "Part Field 2" port)
204                (newline port)
205                (display "*" port)
206                (newline port)
207                (display "Part Field 3" port)
208                (newline port)
209                (display "*" port)
210                (newline port)
211                (display "Part Field 4" port)
212                (newline port)
213                (display "*" port)
214                (newline port)
215                (display "Part Field 5" port)
216                (newline port)
217                (display "*" port)
218                (newline port)
219                (display "Part Field 6" port)
220                (newline port)
221                (display "*" port)
222                (newline port)
223                (display "Part Field 7" port)
224                (newline port)
225                (display "*" port)
226                (newline port)
227                (display "Part Field 8" port)
228                (newline port)
229                (display "*" port)
230                (newline port)
231                (display "Part Field 9" port)
232                (newline port)
233                (display "*" port)
234                (newline port)
235                (display "Part Field 10" port)
236                (newline port)
237                (display "*" port)
238                (newline port)
239                (display "Part Field 11" port)
240                (newline port)
241                (display "*" port)
242                (newline port)
243                (display "Part Field 12" port)
244                (newline port)
245                (display "*" port)
246                (newline port)
247                (display "Part Field 13" port)
248                (newline port)
249                (display "*" port)
250                (newline port)
251                (display "Part Field 14" port)
252                (newline port)
253                (display "*" port)
254                (newline port)
255                (display "Part Field 15" port)
256                (newline port)
257                (display "*" port)
258                (newline port)
259                (display "Part Field 16" port)
260                (newline port)
261                (display "*" port)
262                (newline port)
263                (display "LIBRARYFIELD1" port)
264                (newline port)
265                (display "" port)
266                (newline port)
267                (display "LIBRARYFIELD2" port)
268                (newline port)
269                (display "" port)
270                (newline port)
271                (display "LIBRARYFIELD3" port)
272                (newline port)
273                (display "" port)
274                (newline port)
275                (display "LIBRARYFIELD4" port)
276                (newline port)
277                (display "" port)
278                (newline port)
279                (display "LIBRARYFIELD5" port)
280                (newline port)
281                (display "" port)
282                (newline port)
283                (display "LIBRARYFIELD6" port)
284                (newline port)
285                (display "" port)
286                (newline port)
287                (display "LIBRARYFIELD7" port)
288                (newline port)
289                (display "" port)
290                (newline port)
291                (display "LIBRARYFIELD8" port)
292                (newline port)
293                (display "" port)
294                (newline port)
295                (display "]" port)
296                (newline port)
297                (protelII:components port (cdr ls)))))))
300 ;; renamed nets writing 
302 (define protelII:renamed-nets
303    (lambda (port ls)
304       (if (not (null? ls))
305          (let ((renamed-pair (car ls)))
306             (begin
307 ;;;            (display renamed-pair) (newline)
308 ;;;            (display (car renamed-pair) port)
309 ;;;            (display " -> " port)
310 ;;;            (display (car (cdr renamed-pair)) port)
311 ;;;            (newline port)
312                (display "" port)
313                (protelII:renamed-nets port (cdr ls)))))))
316 ;; Display the individual net connections
318 (define protelII:display-connections
319    (lambda (nets port)
320       (if (not (null? nets))
321          (begin
322             (let ((package (car (car nets))))
323                (display package port)
324                (write-char #\- port) 
325                (display (car (cdr (car nets))) port)
326                (display " " port)
327                (display (get-device package) port)
328                (display "-" port)
329                (display (car (cdr (car nets))) port)
330                (display " PASSIVE" port))
331             (if (not (null? (cdr nets)))
332                (begin
333                   (newline port))) 
334             (protelII:display-connections (cdr nets) port)))))
337 ;; Display all nets 
339 (define protelII:display-name-nets
340    (lambda (port nets)
341       (begin
342          (protelII:display-connections nets port)
343          (write-char #\space port) 
344          (newline port))))
347 ;; Write netname : uref pin, uref pin, ...
349 (define protelII:write-net
350    (lambda (port netnames)
351       (if (not (null? netnames))
352          (let ((netname (car netnames)))
353             (begin
354                (display "(" port)
355                (newline port)
356                (display netname port)
357                (newline port)
358                (protelII:display-name-nets port (gnetlist:get-all-connections netname))
359                (display ")" port)
360                (newline port)
361                (protelII:write-net port (cdr netnames))))))) 
364 ;; Write the net part of the gEDA format
366 (define protelII:nets
367    (lambda (port)
368       (let ((all-uniq-nets (gnetlist:get-all-unique-nets "dummy")))
369          (protelII:write-net port all-uniq-nets))))
371 ;;; Highest level function
372 ;;; Write my special testing netlist format
374 (define protelII 
375    (lambda (output-filename)
376       (let ((port (open-output-file output-filename)))
377          (begin
378 ;;;         (gnetlist:set-netlist-mode "gEDA") No longer needed
379             (protelII:write-top-header port)
380             (protelII:start-components port)
381             (protelII:components port packages)
382             (protelII:end-components port)
383             (protelII:start-renamed-nets port)
384             (protelII:renamed-nets port (gnetlist:get-renamed-nets "dummy"))
385             (protelII:end-renamed-nets port)
386             (protelII:start-nets port)
387             (protelII:nets port)
388             (protelII:end-nets port))
389          (close-output-port port))))
392 ;; gEDA's native test netlist format specific functions ends 
394 ;; --------------------------------------------------------------------------