gnetlist/scheme/gnet-maxascii.scm

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