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;; MAXASCII netlist format
22
23(define maxascii:components
24   (lambda (port packages)
25      (if (not (null? packages))
26         (begin
27            (let ((pattern (gnetlist:get-package-attribute (car packages)
28                                                           "footprint"))
29                  (package (car packages)))
30;               (if (not (string=? pattern "unknown"))
31;                  (display pattern port))
32               (display "*COMP " port)
33               (display package port)
34	       (write-char #\tab port)
35               (display "\"" port)
36               (display (gnetlist:get-package-attribute package "footprint") port)
37               (display "\"" port)
38               (newline port))
39            (maxascii:components port (cdr packages))))))
40
41(define (maxascii:display-connections nets)
42  (if (not (null? nets))
43      (string-append " " (car (car nets)) ".\"" (car (cdr (car nets))) "\""
44       (maxascii:display-connections (cdr nets)))
45      "\n"))
46
47
48;;
49;; Wrap a string into lines no longer than wrap-length
50;; (from Stefan Petersen)
51(define (maxascii:wrap string-to-wrap wrap-length netname)
52  (if (> wrap-length (string-length string-to-wrap))
53      string-to-wrap ; Last snippet of string
54      (let ((pos (string-rindex string-to-wrap #\space 0 wrap-length)))
55	(cond ((not pos)
56	       (display "Couldn't wrap string  at requested position\n")
57	       " Wrap error!")
58	      (else
59	       (string-append
60		(substring string-to-wrap 0 pos)
61		" \n*NET \"" netname "\" "
62		(maxascii:wrap (substring string-to-wrap (+ pos 1)) wrap-length netname)))))))
63
64
65
66(define maxascii:write-net
67   (lambda (port netnames)
68      (if (not (null? netnames))
69         (let ((netname (car netnames)))
70	    (display "*NET " port)
71            (display "\"" port)
72	    (display netname port)
73            (display "\"" port)
74	    (newline port)
75	    (display "*NET " port)
76            (display "\"" port)
77	    (display netname port)
78            (display "\"" port)
79            (display (maxascii:wrap
80		      (maxascii:display-connections
81		       (gnetlist:get-all-connections netname))
82		      490 netname)
83		     port)
84;;            (display (maxascii:display-connections
85;;		       (gnetlist:get-all-connections netname))
86;;		     port)
87	    (maxascii:write-net port (cdr netnames))))))
88
89(define maxascii
90   (lambda (filename)
91      (let ((port (open-output-file filename)))
92         (display "*OrCAD\n*START\n" port)
93
94         (maxascii:components port packages)
95
96
97         (maxascii:write-net port (gnetlist:get-all-unique-nets "dummy"))
98         (display "\n*END\n" port)
99         (close-output-port port))))
100
101