User Tools

Site Tools


geda:guile_scripting

Differences

This shows you the differences between two versions of the page.

Link to this comparison view

Both sides previous revision Previous revision
Next revision
Previous revision
geda:guile_scripting [2015/09/11 12:56]
vzh Add examples section and a first example
geda:guile_scripting [2016/02/09 11:56] (current)
vzh Add a link to new page about REPL
Line 10: Line 10:
  
   * [[gnetlist scheme tutorial|Scripting a gnetlist backend in scheme]] (John Doty)   * [[gnetlist scheme tutorial|Scripting a gnetlist backend in scheme]] (John Doty)
-  * 
  
 See also the [[geda:​gschem_ug:​extensions|Extending gschem]] section of the //​[[geda:​gschem_ug|gEDA gschem User Guide]]//, and [[geda:​gnetlist_ug#​scheme_backend_api|Scheme Backend API]] section of the //​[[geda:​gnetlist_ug|gEDA gnetlist User Guide]]//. See also the [[geda:​gschem_ug:​extensions|Extending gschem]] section of the //​[[geda:​gschem_ug|gEDA gschem User Guide]]//, and [[geda:​gnetlist_ug#​scheme_backend_api|Scheme Backend API]] section of the //​[[geda:​gnetlist_ug|gEDA gnetlist User Guide]]//.
Line 16: Line 15:
 ==== Reference documents ==== ==== Reference documents ====
   * [[gnetlist Scheme primitives]]   * [[gnetlist Scheme primitives]]
 +  * [[gschem repl|Using REPL in gschem]]
  
 ==== Scripting examples ==== ==== Scripting examples ====
 +You can download each script example and load it in **gschem**:
 +  * just hit <​key>:</​key>​ and enter <code lisp>​(load "​filename.scm"​)</​code>​
 +  * then hit <​key>​Enter</​key>​
 +
 +You can install them as well if you don't want to load them every time:
 +  * copy the script you want into your //''​~/​.gEDA''//​ directory
 +  * put the line <code lisp>​(load "​filename.scm"​)</​code>​ into your //''​~/​.gEDA/​gschemrc''//​ (replace //​filename.scm//​ with the real name of the script)
 +
 +
 === Removing objects with specific properties === === Removing objects with specific properties ===
 For instance, let's remove all objects which are circles or arcs For instance, let's remove all objects which are circles or arcs
 with zero radius: with zero radius:
  
-<code lisp>+<file lisp remove-objects.scm>
 (use-modules (geda page)) (use-modules (geda page))
  
Line 35: Line 44:
          ​zero-radius-object?​          ​zero-radius-object?​
          ​(page-contents (active-page))))          ​(page-contents (active-page))))
 +</​file>​
 +
 +Let's suppose we have a component with a known attribute to
 +remove, then we have to detach and remove all its attributes, too.
 +The function below does exactly this.
 +<file lisp remove-components-with-attribs.scm>​
 +(use-modules (geda page))
 +(use-modules (geda object))
 +(use-modules (geda attrib))
 +
 +; Removes all components having the attrib NAME=VALUE from PAGE
 +(define (delete-components-by-attrib! page name value)
 +  (for-each
 +    (lambda (obj)
 +      (if (component? obj)
 +        (for-each
 +          (lambda (attr)
 +            (and
 +              (string=? (attrib-name attr) name)
 +              (string=? (attrib-value attr) value)
 +              (let ((attached-attribs (object-attribs obj)))
 +                (apply detach-attribs! obj attached-attribs)
 +                (apply page-remove! page obj attached-attribs))))
 +          (object-attribs obj))))
 +    (page-contents page)))
 +</​file>​
 +
 +After loading the file, hit <​key>:</​key>​ and enter, for example,
 +<code lisp>
 +(delete-components-by-attrib! (active-page) "​refdes"​ "​R1"​)
 </​code>​ </​code>​
 +
 +=== Procedures for input-output ===
 +The following script defines two procedures that can be used in
 +**gaf shell** batch scripts:
 +  * ''​schematic-file->​page''​
 +  * ''​page->​schematic-file''​
 +
 +<file lisp geda-io.scm>​
 +(use-modules (ice-9 lineio))
 +(use-modules (geda page))
 +
 +; Input/​output procedures
 +; reads FILE and outputs string
 +(define (file->​string file)
 +  (let* ((port (make-line-buffering-input-port (open-file file "​r"​))))
 +    (do ((line ""​ (read-string port))
 +         (s ""​ (string-append s line)))
 +      ((eof-object?​ line) ; test
 +       ​(close-port port)  ; expression(s) to evaluate in the end
 +       ​s) ​                ; return value
 +      ; empty body
 +      )))
 +
 +; reads schematic FILE and outputs PAGE object
 +(define (schematic-file->​page file)
 +    (string->​page file (file->​string file)))
 +
 +; saves schematic PAGE to FILE
 +(define (page->​schematic-file page file)
 +  (with-output-to-file file
 +    (lambda () (display (page->​string page)))))
 +</​file>​
 +
 +
 +=== Copy, move, and rotate objects ===
 +<file lisp move-and-rotate.scm>​
 +; Scripting example by vzh per request of Kai-Martin Knaak :-)
 +; Use at your own risk.
 +
 +; The main procedure here is
 +; multiple-copy-move-and-rotate-selection which can be abbreviated
 +; as mcmars.
 +; Usage:
 +;   ​launch gschem so it can use this script, e.g.
 +;     ​gschem -s move-and-rotate.scm
 +;   ​select objects in gschem, then hit ':'​ (semicolon) and type
 +;     ​(mcmars '(1000 . 500) 90 10)
 +;   hit <​Enter>​
 +; Enjoy!
 +
 +
 +(use-modules (gschem selection))
 +
 +; align coords by ALIGN
 +(define (ceiling-coords vector align)
 +  (cons
 +    (* (ceiling-quotient (car vector) align) align)
 +    (* (ceiling-quotient (cdr vector) align) align)
 +    ))
 +
 +; Get minimum X and minimum Y of two pairs of coords
 +(define (min-coords coord1 coord2)
 +  (let ((x (min (car coord1) (car coord2)))
 +        (y (min (cdr coord1) (cdr coord2))))
 +    ; return value
 +    (cons x y)))
 +
 +; Copy, move and rotate current selection. The selected objects
 +; are first copied, then translated by VECTOR and finally rotated
 +; by ANGLE about center which is calculated as rounded by 100
 +; lower left coordinate of all objects in selection.
 +; If no objects are selected, opens gschem message dialog with
 +; warning.
 +; Returns the copied objects.
 +(define (copy-move-and-rotate-selection vector angle)
 +  (let ((objects (page-selection (active-page))))
 +    (if (null? objects)
 +      (gschem-msg "​Select something first!"​)
 +      ; else
 +      (let* ((copied-objects (map copy-object objects))
 +             ​(translated-objects (apply translate-objects! vector copied-objects))
 +             ​(bounds (apply object-bounds translated-objects))
 +             ​(rotation-center (ceiling-coords (min-coords (car bounds) (cdr bounds)) 100))
 +             ​(rotated-objects (apply rotate-objects! rotation-center angle translated-objects)))
 +        (apply page-append! (active-page) rotated-objects)
 +        rotated-objects)
 +      )))
 +
 +; Multiply VECTOR which must be a pair by NUMBER
 +(define (multiply-vector-by vector number)
 +  (cons (* number (car vector)) (* number (cdr vector))))
 +
 +; Copy, move and rotate current selection NUMBER times. Applies
 +; the copy-move-and-rotate-selection procedure multiple times
 +; increasing every time vector and angle by given values of VECTOR
 +; and ANGLE.
 +; If no objects are selected, opens gschem message dialog with
 +; warning.
 +; Return value is unspecified.
 +(define (multiple-copy-move-and-rotate-selection vector angle num)
 +  (if (null? (page-selection (active-page)))
 +    (gschem-msg "​Select something first!"​)
 +    ; else
 +    (do ((i num (1- i)))
 +      ((= i 0))
 +      (copy-move-and-rotate-selection
 +        (multiply-vector-by vector i) (* angle i)))
 +    ))
 +
 +; Abbreviated name for the multiple-copy-move-and-rotate-selection
 +; procedure
 +(define mcmars multiple-copy-move-and-rotate-selection)
 +</​file>​
 +
 +
 +=== Group attribute editing ===
 +Let's suppose you have selected several resistors'​ refdeses and
 +want to rename them at once, e.g., if they were copy from another
 +place.
 +<file lisp set-selected-attribs-value>​
 +(use-modules (gschem selection))
 +
 +(define (set-selected-attribs-value! value)
 +  (for-each
 +    (lambda (attrib)
 +      (set-attrib-value! attrib value))
 +    (page-selection (active-page))))
 +</​file>​
 +
 +Usage of the procedure in **gschem**:
 +<code lisp>
 +(set-selected-attribs-value! "​R100.?"​)
 +</​code>​
 +
 +Now, after renumbering them using <​key>​t</​key>​ <​key>​u</​key>,​ you
 +copy them all and want to rename those copied resistors appending a suffix:
 +<file lisp append-selected-attribs-suffix.scm>​
 +(use-modules (gschem selection))
 +
 +(define (append-selected-attribs-suffix! suffix)
 +  (for-each
 +    (lambda (attrib)
 +      (set-attrib-value!
 +        attrib
 +        (string-append (attrib-value attrib) suffix)))
 +    (page-selection (active-page))))
 +</​file>​
 +
 +Usage of the procedure in **gschem**:
 +<code lisp>
 +(append-selected-attribs-suffix! "​-top"​)
 +</​code>​
 +
 +Now, let's rename some other attributes by adding a prefix:
 +<file lisp append-selected-attribs-prefix.scm>​
 +(use-modules (gschem selection))
 +
 +(define (append-selected-attribs-prefix! prefix)
 +  (for-each
 +    (lambda (object)
 +      (and (attribute? object)
 +           ​(set-attrib-value!
 +             ​object
 +             ​(string-append prefix (attrib-value object)))))
 +    (page-selection (active-page))))
 +</​file>​
 +
 +Usage of the procedure in **gschem**:
 +<code lisp>
 +(append-selected-attribs-prefix! "​A1."​)
 +</​code>​
 +
 +Let's replace first letters of selected attribs with prefix:
 +<file lisp append-selected-attribs-prefix.scm>​
 +(use-modules (gschem selection))
 +
 +(define (replace-selected-attribs-prefix! prefix)
 +  (for-each
 +    (lambda (object)
 +      (and (attribute? object)
 +           ​(set-attrib-value!
 +             ​object
 +             ​(string-append
 +               ​prefix
 +               ​(string-copy (attrib-value object) 1)))))
 +    (page-selection (active-page))))
 +</​file>​
 +
 +Usage of the procedure in **gschem**:
 +<code lisp>
 +(replace-selected-attribs-prefix! "​C"​)
 +</​code>​
 +
 +Let's rename selected ''​netname=''​ attributes increasing them by a
 +fixed number:
 +<file lisp add-selected-attribs-number.scm>​
 +(use-modules (gschem selection))
 +
 +(define (add-selected-attribs-number! number)
 +  (for-each
 +    (lambda (object)
 +      (and (attribute? object)
 +           ​(set-attrib-value!
 +             ​object
 +             ​(number->​string
 +               (+ (string->​number (attrib-value object)) number)))))
 +    (page-selection (active-page))))
 +</​file>​
 +
 +Usage of the procedure in **gschem**:
 +<code lisp>
 +(add-selected-attribs-number! 100)
 +</​code>​
 +
 +We could set any function instead of "​+"​ on the net number in this procedure.
 +For instance:
 +<file lisp use-another-func.scm>​
 +(use-modules (gschem selection))
 +
 +(define (use-another-func! func)
 +  (for-each
 +    (lambda (object)
 +      (and (attribute? object)
 +           ​(set-attrib-value!
 +             ​object
 +             ​(number->​string
 +               (func (string->​number (attrib-value object)))))))
 +    (page-selection (active-page))))
 +</​file>​
 +
 +Usage of the procedure in **gschem**:
 +<code lisp>
 +(use-another-func! -)
 +(define (multiply-by-2 x)
 +  (* 2 x))
 +(use-another-func! multiply-by-2)
 +</​code>​
 +
 +=== Moving objects using arrows ===
 +Let's define actions to move selected objects using
 +<​key>​Shift</​key>​ + arrow keys.
 +
 +<file lisp arrow-move.scm>​
 +(use-modules (gschem selection))
 +
 +; Default offset to move
 +(define offset 100)
 +
 +; Get moving vector
 +(define (move-selection direction)
 +  (apply translate-objects!
 +    (case direction
 +      ((left ) (cons (- offset) 0))
 +      ((right) (cons (+ offset) 0))
 +      ((down ) (cons 0 (- offset)))
 +      ((up   ) (cons 0 (+ offset)))
 +      (else #f))
 +    (page-selection (active-page))))
 +
 +; Define actions
 +(define (&​move-selection-left ) (move-selection 'left ))
 +(define (&​move-selection-right) (move-selection '​right))
 +(define (&​move-selection-down ) (move-selection 'down ))
 +(define (&​move-selection-up ​  ) (move-selection '​up ​  ))
 +
 +; Define shortcuts
 +(global-set-key "<​Shift>​Left" ​ '&​move-selection-left)
 +(global-set-key "<​Shift>​Right"​ '&​move-selection-right)
 +(global-set-key "<​Shift>​Up" ​   '&​move-selection-up)
 +(global-set-key "<​Shift>​Down" ​ '&​move-selection-down)
 +</​file>​
 +
 +The following script redefines current shortcuts so that if
 +nothing is selected the canvas is moved with arrow keys (without
 +<​key>​Shift</​key>​ in this case), otherwise selected objects are
 +moved.
 +
 +<file lisp arrow-move2.scm>​
 +(use-modules (gschem selection))
 +
 +; Default offset to move
 +(define offset 100)
 +
 +; Get moving vector
 +(define (move-selection direction)
 +  (let ((selection (page-selection (active-page))))
 +    (if (null? selection)
 +      ; default behaviour
 +      (case direction
 +          ((left ) (&​view-pan-left))
 +          ((right) (&​view-pan-right))
 +          ((down ) (&​view-pan-down))
 +          ((up   ) (&​view-pan-up))
 +          (else #f))
 +      ; modified behaviour
 +      (apply translate-objects!
 +        (case direction
 +          ((left ) (cons (- offset) 0))
 +          ((right) (cons (+ offset) 0))
 +          ((down ) (cons 0 (- offset)))
 +          ((up   ) (cons 0 (+ offset)))
 +          (else #f))
 +        (page-selection (active-page))))
 +    ))
 +
 +; Define actions
 +(define (&​move-selection-left ) (move-selection 'left ))
 +(define (&​move-selection-right) (move-selection '​right))
 +(define (&​move-selection-down ) (move-selection 'down ))
 +(define (&​move-selection-up ​  ) (move-selection '​up ​  ))
 +
 +; Define shortcuts
 +(global-set-key "​Left" ​ '&​move-selection-left)
 +(global-set-key "​Right"​ '&​move-selection-right)
 +(global-set-key "​Up" ​   '&​move-selection-up)
 +(global-set-key "​Down" ​ '&​move-selection-down)
 +</​file>​
  
geda/guile_scripting.1441990577.txt.gz ยท Last modified: 2015/09/11 12:56 by vzh