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;; --------------------------------------------------------------------------
22;;
23;; Bartels Format
24;; Layout board;
25;; PARTS
26;;   part : footprint;
27;; CONNECT
28;;   /net1/ uref.pin=uref.pin=uref.pin=...uref.pin;
29;;   /net2/ PRIORITY(1..100) MINDIST(mm) ROUTWIDTH(mm) uref.pin(width_mm)=...;
30;; END.
31;;
32
33;;
34;; Top level header
35;;
36(define bae:write-top-header
37   (lambda (p)
38      (display "LAYOUT board;" p)
39      (newline p)))
40
41;;
42;; header for components section
43;;
44(define bae:start-components
45   (lambda (p)
46      (display "PARTS" p)
47      (newline p)))
48;; no header for components
49
50;;
51;; footer for components section
52;;
53(define bae:end-components
54   (lambda (p)
55      (display "" p)))
56
57;;
58;; header for renamed section
59;;
60(define bae:start-renamed-nets
61   (lambda (p)
62      (display "" p)))
63
64;;
65;; footer for renamed section
66;;
67(define bae:end-renamed-nets
68   (lambda (p)
69      (display "" p)))
70
71;;
72;; header for nets section
73;;
74(define bae:start-nets
75   (lambda (p)
76      (display "CONNECT" p)
77      (newline p)))
78
79;;
80;; footer for net section
81;;
82(define bae:end-nets
83   (lambda (p)
84      (display "END." p)
85      (newline p)))
86
87;;
88;; Top level component writing
89;;
90(define bae:components
91   (lambda (port ls)
92      (if (not (null? ls))
93         (let ((package (car ls)))
94            (begin
95	       (display "    " port)
96               (display package port)
97	       (display " : " port)
98	       (display (gnetlist:get-package-attribute package  "footprint") port)
99	       (display ";" port)
100	       (newline port)
101               (bae:components port (cdr ls)))))))
102
103;;
104;; renamed nets writing
105;;
106(define bae:renamed-nets
107   (lambda (port ls)
108      (if (not (null? ls))
109         (let ((renamed-pair (car ls)))
110            (begin
111;;;	       (display renamed-pair) (newline)
112;;;            (display (car renamed-pair) port)
113;;;            (display " -> " port)
114;;;            (display (car (cdr renamed-pair)) port)
115;;;            (newline port)
116               (display "" port)
117               (bae:renamed-nets port (cdr ls)))))))
118
119;;
120;; Display the individual net connections
121;;
122(define bae:display-connections
123   (lambda (nets port)
124      (if (not (null? nets))
125  	 (begin
126	    (let ((package (car (car nets))))
127	       (display package port)
128	       (write-char #\. port)
129	       (display (car (cdr (car nets))) port))
130	    (if (not (null? (cdr nets)))
131	       (begin
132	          (display #\= port)))
133	    (bae:display-connections (cdr nets) port)))))
134
135;;
136;; Display all nets
137;;
138(define bae:display-name-nets
139   (lambda (port nets)
140      (begin
141         (bae:display-connections nets port)
142         (write-char #\; port))))
143
144;;
145;; Write netname : uref pin, uref pin, ...
146;;
147(define bae:write-net
148   (lambda (port netnames)
149      (if (not (null? netnames))
150         (let ((netname (car netnames)))
151	    (begin
152	       (display "    " port)
153	       (display "/'" port)
154	       (display netname port)
155	       (display "'/ " port)
156               (bae:display-name-nets port (gnetlist:get-all-connections netname))
157	       (newline port)
158	       (bae:write-net port (cdr netnames)))))))
159
160;;
161;; Write the net part of the gEDA format
162;;
163(define bae:nets
164   (lambda (port)
165      (let ((all-uniq-nets (gnetlist:get-all-unique-nets "dummy")))
166         (bae:write-net port all-uniq-nets))))
167
168;;; Highest level function
169;;; Write my special testing netlist format
170;;;
171(define bae
172   (lambda (output-filename)
173      (let ((port (open-output-file output-filename)))
174         (begin
175;;;         (gnetlist:set-netlist-mode "gEDA") No longer needed
176            (bae:write-top-header port)
177            (bae:start-components port)
178            (bae:components port packages)
179            (bae:end-components port)
180            (bae:start-renamed-nets port)
181            (bae:renamed-nets port (gnetlist:get-renamed-nets "dummy"))
182            (bae:end-renamed-nets port)
183            (bae:start-nets port)
184            (bae:nets port)
185            (bae:end-nets port))
186         (close-output-port port))))
187
188;;
189;; gEDA's native test netlist format specific functions ends
190;;
191;; --------------------------------------------------------------------------
192