scheme/parse-gerber.scm

   1
   2 ; gEDA - GNU Electronic Design Automation
   3 ; parse-gerber.scm
   4 ; Copyright (C) 2000-2001 Stefan Petersen (spe@stacken.kth.se)
   5 ;
   6 ; $Id$
   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., 59 Temple Place, Suite 330, Boston, MA 02111 USA
  21
  22
  23
  24 ; These are data that is the result of the parsing
  25
  26 ; *aperture-description* is a list with descriptions of all
  27 ; apertures used.  Each element of the list is a list with:
  28 ; (<aperture no> <aperture type> <apterture size(s)>)
  29 ; <aperture type> is one of circle, rectangle, oval or polygon.
  30 ; <apterture size(s)> is one value if circle and two if rectangle.
  31 (define *aperture-description* '())
  32
  33 ; *netlist* is the actual netlist. Each element of the list consist of
  34 ; (<X> <Y> (<aperture no> . <exposure type>))
  35 ; The elements in the list is 'backwards', the first element in the
  36 ; list is the last in the file. This is simply fixed by a
  37 ; (reverse *netlist*)
  38 (define *netlist* '())
  39
  40 ; Image parameters
  41 (define *image*
  42   (list (cons 'unit 'inches)
  43         (cons 'polarity 'positive)
  44         (cons 'omit-leading-zeros #t)
  45         (cons 'coordinates 'absolute)
  46         (cons 'x-integer 2)
  47         (cons 'x-decimal 3)
  48         (cons 'y-integer 2)
  49         (cons 'y-decimal 3)))
  50
  51 (define *current-x* #f)
  52 (define *current-y* #f)
  53
  54 (define (set-aperture-size aperture size)
  55   (if (number? size)
  56       (cons size (cdr aperture))
  57       (display "Wrong aperture number in set-aperture-size!\n")))
  58
  59 (define (set-aperture-state aperture state)
  60   (if (or (eq? state 'exposure-off)
  61           (eq? state 'exposure-on)
  62           (eq? state 'exposure-flash))
  63       (cons (car aperture) state)
  64       (display "Wrong state in set-aperture-state!\n")))
  65
  66 (define *current-aperture* (cons #f #f))
  67
  68 ; Main function. Call this one.
  69 (define (parse-gerber port)
  70   (let ((latest (read-char port)))
  71     (if (not (eof-object? latest))
  72         (case latest
  73           ((#\G)
  74            (parse-G-code port)
  75            (parse-gerber port))
  76           ((#\D)
  77            (set! *current-aperture* (parse-D-code port *current-aperture*))
  78            (parse-gerber port))
  79           ((#\M)
  80            (parse-M-code port)
  81            (parse-gerber port))
  82           ((#\X)
  83            (set! *current-x* (list->string (parse-pos-code port)))
  84            (parse-gerber port))
  85           ((#\Y)
  86            (set! *current-y* (list->string (parse-pos-code port)))
  87            (parse-gerber port))
  88           ((#\%)
  89            (parse-274X-code port)
  90            (parse-gerber port))
  91           ((#\*)
  92            (if (and *current-x*  ; If all these set
  93                     *current-y*
  94                     (car *current-aperture*)
  95                     (cdr *current-aperture*))
  96                (begin
  97 ;                (display *current-x*)
  98 ;                (display " : ")
  99 ;                (display *current-y*)
 100 ;                (display " A:")
 101 ;                (display *current-aperture*)
 102 ;                (newline)
 103                  (set! *netlist*
 104                        (cons (list *current-x* *current-y* *current-aperture*)
 105                              *netlist*))
 106                  (parse-gerber port))))
 107           (else  ; Eat dead meat
 108 ;Whitespaces keeps us away from using this
 109 ;          (display "Strange code : ")
 110 ;          (display latest)
 111 ;          (newline)
 112            (parse-gerber port))))))
 113
 114
 115 (define (parse-G-code port)
 116   (let* ((first (read-char port))
 117          (second (read-char port))
 118          (code (string first second)))
 119     (cond ((string=? code "00") ; Move
 120            ); Not implemented
 121           ((string=? code "01") ; Linear Interpolation (1X scale)
 122            ); Not implemented
 123           ((string=? code "02") ; Clockwise Linear Interpolation
 124            ); Not implemented
 125           ((string=? code "03") ; Counter Clockwise Linear Interpolation
 126            ); Not implemented
 127           ((string=? code "04") ; Ignore Data Block
 128            (eat-til-eob port)
 129            (parse-gerber port))
 130           ((string=? code "10") ; Linear Interpolation (10X scale)
 131            ); Not implemented
 132           ((string=? code "11") ; Linear Interpolation (0.1X scale)
 133            ); Not implemented
 134           ((string=? code "12") ; Linear Interpolation (0.01X scale)
 135            ); Not implemented
 136           ((string=? code "36") ; Turn on Polygon Area Fill
 137            ); Not implemented
 138           ((string=? code "37") ; Turn off Polygon Area Fill
 139            ); Not implemented
 140           ((string=? code "54") ; Tool prepare
 141            (if (char=? (read-char port) #\D)
 142                (set! *current-aperture* (parse-D-code port *current-aperture*)))
 143            (eat-til-eob port))
 144           ((string=? code "70") ; Specify inches
 145            ); Not implemented
 146           ((string=? code "71") ; Specify millimeters
 147            ); Not implemented
 148           ((string=? code "74") ; Disable 360 circular interpolation
 149            ); Not implemented
 150           ((string=? code "75") ; Enable 360 circular interpolation
 151            ); Not implemented
 152           ((string=? code "90") ; Specify absolut format
 153            ); Not implemented
 154           ((string=? code "91") ; Specify incremental format
 155            ); Not implemented
 156           (else
 157            (display "Strange G-code : ")
 158            (display code)
 159            (newline)))))
 160
 161
 162 (define (parse-M-code port)
 163   (let* ((first (read-char port))
 164          (second (read-char port))
 165          (code (string first second)))
 166     (cond ((string=? code "00") ; Program Stop
 167            ); The file ends anyhow
 168           ((string=? code "01") ; Optional Stop
 169            ); The file ends anyhow
 170           ((string=? code "02") ; End Of Program
 171            ); The file ends anyhow
 172           (else
 173            (display "Strange M code")
 174            (newline)))))
 175
 176
 177 (define (parse-D-code port current-aperture)
 178   (let ((aperture (list->string (parse-pos-code port))))
 179     (cond ((string=? aperture "1") ; Exposure on
 180            (set-aperture-state current-aperture 'exposure-on))
 181           ((string=? aperture "2") ; Exposure off
 182            (set-aperture-state aperture 'exposure-off))
 183           ((string=? aperture "3") ; Flash aperture
 184            (set-aperture-state current-aperture 'exposure-flash))
 185           ((string=? aperture "01") ; Exposure on
 186            (set-aperture-state current-aperture 'exposure-on))
 187           ((string=? aperture "02") ; Exposure off
 188            (set-aperture-state current-aperture 'exposure-off))
 189           ((string=? aperture "03") ; Flash aperture
 190            (set-aperture-state current-aperture 'exposure-flash))
 191           (else ; Select an aperture defined by an AD parameter
 192            (set-aperture-size current-aperture (string->number aperture))))))
 193
 194
 195 (define (parse-274X-code port)
 196   (let* ((first (read-char port))
 197          (second (read-char port))
 198          (code (string first second)))
 199           ; Directive parameters
 200     (cond ((string=? code "AS") ; Axis Select
 201            (display "AS")
 202            (eat-til-eop port))
 203           ((string=? code "FS") ; Format Statement
 204            (if (char=? (read-char port) #\L) ; or T
 205                (assoc-set! *image* 'omit-leading-zeros #t)
 206                (assoc-set! *image* 'omit-leading-zeros #f))
 207            (if (char=? (read-char port) #\A) ; or I
 208                (assoc-set! *image* 'coordinates 'absolut)
 209                (assoc-set! *image* 'coordinates 'incremental))
 210            (read-char port) ; eat X
 211            (assoc-set! *image* 'x-int (char->integer(read-char port)))
 212            (assoc-set! *image* 'x-dec (char->integer(read-char port)))
 213            (read-char port) ; eat Y
 214            (assoc-set! *image* 'y-int (char->integer(read-char port)))
 215            (assoc-set! *image* 'y-dec (char->integer(read-char port)))
 216            (eat-til-eop port))
 217           ((string=? code "MI") ; Mirror Image
 218            (display "MI")
 219            (eat-til-eop port))
 220           ((string=? code "MO") ; Mode of units
 221            (let ((unit (string (read-char port) (read-char port))))
 222              (cond ((string=? unit "IN")
 223                     (assoc-set! *image* 'unit 'inch))
 224                    ((string=? unit "MM")
 225                     (assoc-set! *image* 'unit 'mm))))
 226            (eat-til-eop port))
 227           ((string=? code "OF") ; Offset
 228            (display "OF")
 229            (eat-til-eop port))
 230           ((string=? code "SF") ; Scale Factor
 231            (display "SF")
 232            (eat-til-eop port))
 233           ; Image parameters
 234           ((string=? code "IJ") ; Image Justify
 235            (eat-til-eop port))
 236           ((string=? code "IN") ; Image Name
 237            (eat-til-eop port))
 238           ((string=? code "IO") ; Image Offset
 239            (eat-til-eop port))
 240           ((string=? code "IP") ; Image Polarity
 241            (let ((unit (string (read-char port) (read-char port) (read-char port))))
 242              (cond ((string=? unit "POS")
 243                     (assoc-set! *image* 'polarity 'positive))
 244                    ((string=? unit "NEG")
 245                     (assoc-set! *image* 'polarity 'negative))))
 246            (eat-til-eop port))
 247           ((string=? code "IR") ; Image Rotation
 248            (eat-til-eop port))
 249           ((string=? code "PF") ; Plotter Film
 250            (eat-til-eop port))
 251           ; Aperture Parameters
 252           ((string=? code "AD") ; Aperture Description
 253            (read-char port) ; Read the D. Should check that it really is a D.
 254            (set! *aperture-description*
 255                  (cons (cons (car (parse-D-code port '(#f .#f)))
 256                              (parse-aperture-definition port))
 257                        *aperture-description*))
 258            (eat-til-eop port))
 259           ((string=? code "AM") ; Aperture Macro
 260            (eat-til-eop port))
 261           (else
 262            (eat-til-eop port)))))
 263
 264
 265 (define (parse-aperture-definition port)
 266   (let ((aperture-type (read-char port))
 267         (read-comma (read-char port)))
 268      (case aperture-type
 269        ((#\C) ; Circle
 270         (cons 'circle (parse-modifier port)))
 271        ((#\R) ; Rectangle or Square
 272         (cons 'rectangle (parse-modifier port)))
 273        ((#\O) ; Oval
 274         (cons 'oval (parse-modifier port)))
 275        ((#\P) ; Polygon
 276         (cons 'polygon (parse-modifier port)))
 277        (else
 278         #f))))
 279
 280
 281 (define (parse-modifier port)
 282   (let ((dimension (list->string (parse-pos-code port)))
 283         (next (peek-char port)))
 284     (if (char=? next #\X)
 285         (begin
 286           (read-char port)
 287           (cons dimension (parse-modifier port)))
 288         (cons dimension '()))))
 289
 290
 291 (define (eat-til-eop port)
 292   (let ((latest (read-char port)))
 293       (if (not (char=? latest #\%))
 294           (eat-til-eop port))))
 295
 296
 297 (define (parse-pos-code port) ; Returns a list with all characters in position
 298   (let ((sneak (peek-char port)))
 299     (if (or (and (char>=? sneak #\0)
 300                  (char<=? sneak #\9))
 301             (char=? sneak #\.))
 302         (cons (read-char port) (parse-pos-code port))
 303         '())))
 304
 305
 306 (define (eat-til-eob port)
 307   (if (not (char=? #\* (read-char port)))
 308       (eat-til-eob port)))