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