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