Differences

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

--- geda:guile_scripting [2012/02/20 15:14]
127.0.0.1 external edit
+++ geda:guile_scripting [2016/02/09 11:56] (current)
vzh Add a link to new page about REPL
@@ Line 1: / Line 1: @@
+//Translations of this page are also available in the following languages:// [[guile_scripting.ru|Русский]].
 ===== Guile scripting =====
@@ Line 9: / Line 11: @@
   * [[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:gschem_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]]//.
+==== Reference documents ====
+  * [[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>

gEDA Project Wiki

User Tools

Site Tools

Differences

Page Tools