This shows you the differences between two versions of the page.
Both sides previous revision Previous revision Next revision | Previous revision | ||
geda:guile_scripting [2015/07/14 04:21] vzh Added a link |
geda:guile_scripting [2016/02/09 11:56] (current) vzh Add a link to new page about REPL |
||
---|---|---|---|
Line 15: | Line 15: | ||
==== Reference documents ==== | ==== Reference documents ==== | ||
* [[gnetlist Scheme primitives]] | * [[gnetlist Scheme primitives]] | ||
+ | * [[gschem repl|Using REPL in gschem]] | ||
+ | ==== 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 === | ||
+ | For instance, let's remove all objects which are circles or arcs | ||
+ | with zero radius: | ||
+ | |||
+ | <file lisp remove-objects.scm> | ||
+ | (use-modules (geda page)) | ||
+ | |||
+ | ; Checks if the OBJECT is a circle or an arc with zero radius | ||
+ | (define (zero-radius-object? object) | ||
+ | (or | ||
+ | (and (circle? object) (= (circle-radius object) 0)) | ||
+ | (and (arc? object) (= (arc-radius object) 0)))) | ||
+ | |||
+ | (apply page-remove! (active-page) | ||
+ | (filter | ||
+ | zero-radius-object? | ||
+ | (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> | ||
+ | |||
+ | === 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> | ||