Differences

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

--- geda:guile_scripting [2015/09/11 13:34]
vzh Added one more example
+++ geda:guile_scripting [2015/12/07 11:42]
vzh Fix highlighting
@@ Line 18: / Line 18: @@
 ==== Scripting examples ====
 You can download each script example and load it in **gschem**:
-  * just hit <key>:</key> and enter <code>(load "filename.scm")</code>
+  * 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 ===
@@ Line 66: / Line 71: @@
 After loading the file, hit <key>:</key> and enter, for example,
-<code>
+<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