1;;; gEDA - GPL Electronic Design Automation
2;;; gnetlist - gEDA Netlist
3;;; Copyright (C) 2004-2010 Braddock Gaskill (braddock@braddock.com,
4;;;                                           adapted PCB code to Eagle)
5;;; Copyright (C) 1998-2010 Ales Hvezda
6;;; Copyright (C) 1998-2010 gEDA Contributors (see ChangeLog for details)
7;;;
8;;; This program is free software; you can redistribute it and/or modify
9;;; it under the terms of the GNU General Public License as published by
10;;; the Free Software Foundation; either version 2 of the License, or
11;;; (at your option) any later version.
12;;;
13;;; This program is distributed in the hope that it will be useful,
14;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16;;; GNU General Public License for more details.
17;;;
18;;; You should have received a copy of the GNU General Public License
19;;; along with this program; if not, write to the Free Software
20;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
21;;; MA 02111-1301 USA.
22
23;; EAGLE netlist format
24
25;; This procedure takes a net name as determined by gnetlist and
26;; modifies it to be a valid eagle net name.
27;;
28(define eagle:map-net-names
29  (lambda (net-name)
30    (let ((net-alias net-name)
31          )
32      ;; Convert to all upper case because Eagle seems
33      ;; to do that internally anyway and we'd rather do
34      ;; it here to catch shorts created by not preserving
35      ;; case.  Plus we can eliminate lots of ECO changes
36      ;; that will show up during backannotation.
37      (string-upcase net-alias)
38      )
39    )
40  )
41
42(define eagle:components
43   (lambda (port packages)
44      (if (not (null? packages))
45         (begin
46            (let ((pattern (gnetlist:get-package-attribute (car packages)
47                                                           "pattern"))
48	    ;; The above pattern should stay as "pattern" and not "footprint"
49                  (package (car packages))
50		  (lib (gnetlist:get-package-attribute (car packages) "lib"))
51		  (value (gnetlist:get-package-attribute (car packages) "value"))
52		  (device (gnetlist:get-package-attribute (car packages) "device"))
53		  )
54               (if (not (string=? pattern "unknown"))
55                  (display pattern port))
56	       (display "ADD '" port)
57               (display package port)
58	       (display "' " port)
59;;	       (display "' TQFP144@atmel (0 0)" port)
60;;;	       (write-char #\tab port)
61               (display (gnetlist:get-package-attribute package "footprint") port)
62	       (display "@" port)
63	       (if (not (string=? lib "unknown"))
64		   (display lib port)
65		   (display "smd-ipc" port))
66	       (display " (1 1);" port)
67	       (newline port)
68               (if (not (string=? value "unknown"))
69		   (begin
70		     (display "VALUE '" port)
71		     (display package port)
72		     (display "' '" port)
73		     (display value port)
74		     (display "';" port)
75		     (newline port)
76		     )
77		   (if (not (string=? device "unknown"))
78		       (begin
79			 (display "VALUE '" port)
80			 (display package port)
81			 (display "' '" port)
82			 (display device port)
83			 (display "';" port)
84			 (newline port)
85			 )
86		   ))
87	       )
88            (eagle:components port (cdr packages))))))
89
90(define (eagle:display-connections nets)
91  (let ((k ""))
92    (for-each (lambda (in-string)
93                (set! k (string-append k in-string)))
94              (map (lambda (net)
95                     (string-append "   '" (car net) "' '" (car (cdr net)) "'\r\n"))
96                   nets))
97    (string-append k ";\n")))
98
99
100; This function is replaced with the above one. Due to non existent
101; verification, this function is left commented out.
102; /spe, 2002-01-08
103;(define (eagle:display-connections nets)
104;  (if (not (null? nets))
105;      (string-append " " (car (car nets)) "." (car (cdr (car nets)))
106;       (eagle:display-connections (cdr nets)))
107;      "\n"))
108
109
110
111(define eagle:write-net
112   (lambda (port netnames)
113      (if (not (null? netnames))
114         (let ((netname (car netnames)))
115	    (display "SIGNAL '" port)
116	    (display (gnetlist:alias-net netname) port)
117	    (display "'" port)
118	    (newline port)
119;            (display (gnetlist:wrap
120;		      (eagle:display-connections
121;		       (gnetlist:get-all-connections netname))
122;		      78
123;		      "")
124;		     port)
125            (display (eagle:display-connections
126		       (gnetlist:get-all-connections netname))
127		     port)
128	    (eagle:write-net port (cdr netnames))))))
129
130(define eagle
131   (lambda (filename)
132      (let ((port (open-output-file filename)))
133	;; initialize the net-name aliasing
134	(gnetlist:build-net-aliases eagle:map-net-names all-unique-nets)
135
136	;; print out the header
137;;;	(display "!EAGLE-POWERPCB-V3.0-MILS!\n" port)
138;;;	(display "\n*PART*\n" port)
139;;;	(display "/* CADSoft Eagle Scripted Netlist Format */\n" port)
140	(display "   ;\n" port)
141
142	;; print out the parts
143	(eagle:components port packages)
144
145	;; print out the net information
146;;;	(display "\n*NET*\n" port)
147	(eagle:write-net port (gnetlist:get-all-unique-nets "dummy"))
148
149	;; print out the footer
150;;;	(display "\n*END*\n" port)
151	(close-output-port port))))
152
153
154