scheme – Jakub T. Jankiewicz

How to add vignette in GIMP ScriptFu

Besides wrting code I’m also amateur photographer (you can see my photos on flickr most of them released under creative commons attribution share alike license) and start adding Vignette in GIMP (the only option because I’m working on GNU/Linux).

To add vignette you can do this steps:

Add ellipse selection
Feather it by 1000 pixels (I have 24MP camera) for your case it may be larger or smaller
Inverse the Mask
Add new black layer
Add layer mask from selection
Make it 50% opacity
remove the selection

And now you have vignette on the image. It was fine but I needed to repeat those steps on each image, and since GIMP have support for scripting using script-fu (variant of scheme), I thought that I add simple script for the steps, here is result:

(define (make-vignette size opacity img)
  (let* ((width (car (gimp-image-width img)))
         (height (car (gimp-image-height img)))
         (layer (car (gimp-layer-new img width height 0 "vignette" 100 DARKEN-ONLY-MODE))))
    (gimp-selection-clear img)
    (gimp-image-select-ellipse img 0 0 0 width height)
    (gimp-selection-feather img size)
    (gimp-selection-invert img)
    (gimp-layer-set-opacity layer opacity)
    (gimp-layer-add-mask layer (car (gimp-layer-create-mask layer ADD-SELECTION-MASK)))
    (gimp-selection-clear img)
    (gimp-image-insert-layer img layer 0 -1)))

(script-fu-register
  "make-vignette"
  "Vignette"
  "Create Vignette for the image"
  "Jakub Jankiewicz"
  "Copyright (c) 2017 Jakub Jankiewicz <http://jcubic.pl/me>"
  "May 20, 2017"
  RGB
  SF-VALUE "Size" "1000"
  SF-VALUE "Opacity" "50"
  SF-IMAGE "image" 0
)
(script-fu-menu-register "make-vignette" "<Image>/Filters/Light and Shadow")

I’ve save it in ~/gimp-2.8/scripts/vignette.scm and it added menu item Vignette to menu Light and Shadow in Filters menu

and after I’ve executed the script I’ve get the same vignette layer with mask like this:

Reading GET, POST and Cookie values in guile scheme

I’ve start playing with cgi in guile scheme and I came up with the functions to read GET, POST and Cookie values that I want to share. here is the code:

(use-modules (web uri)) ;; includes uri-decode procedure

(define (read-port port)
    (let iter ((result '()) (chr (read-char port)))
        (if (eof-object? chr)
            (list->string result)
            (iter (append result (list chr)) (read-char port)))))

(define (params->alist string fn sep)
  (map (lambda (pair)
          (let* ((list (string-split pair #\=))
                 (key (fn (string-trim (car list))))
                 (value (fn (string-trim (string-join (cdr list) "=")))))
             (cons key value)))
       (string-split string sep)))

(define (create-param-proc string fn sep)
   (if (or (equal? string #f) (equal? string ""))
       (lambda (var) "")
       (let ((query (params->alist string fn sep)))
          (lambda (var)
             (let ((pair (assoc var query)))
               (if (null? pair)
                   ""
                   (cdr pair)))))))



(define GET (create-param-proc (getenv "QUERY_STRING") uri-decode #\&))
(define POST (create-param-proc (read-port (current-input-port)) uri-decode #\&))
(define COOKIE (create-param-proc (getenv "HTTP_COOKIE") identity #\;))

And to get the values you just execute one of GET, POST, COOKIE procedures:

(display (string-append "foo: " (GET "foo")))
(newline)

(display (string-append "foo: " (POST "foo")))
(newline)
(display (string-append "foo: " (COOKIE "foo")))
(newline)

Using exceptions to simulate tail recursion in JavaScript

JavaScript is very powerful language but it don’t have tail call elimination. But it turn out that you can simulate it using exception system. Here is very simple recursive function that calculate factorial:

function factorial(n) {
    function recur(n, result) {
        if (n == 0) {
            throw result;
        } else {
            recur(n-1, result*n);
        }
    }
    try {
        recur(n, 1);
    } catch(e) {
        return e;
    }
}

It turn out that in JavaScript (I read that in Douglas Crockford book JavaScript: The Good Parts) you can use any expression in throw and it will be send to variable in catch statement.

So what the above code does it simple exit from the recursive loop and pass result to catch statement. And this is exactly what tail recursion is, in language scheme this happen by default when inner function (you also need to create inner function in scheme) have recursive call as last expression. Here is scheme version of tail recursive factorial:

(define (factorial n)
  (let recur ((n n) (result 1))
     (if (= n 0)
        result
        (recur (- n 1) (* result n)))))

the code use named let but it can be rewriten with inner function and invocation. (this kind of trick is needed in script-fu – Gimp extension based on scheme).

Matrix manipulation in scheme

Here’s the code I wrote for matrix manipulation in scheme. It use lists.

If you want to play with the code online you can use LIPS: Scheme based lisp interpreter in JavaScript. On the website you can find bookmark, that create Scheme REPL on any website, including this one.

Procedure that creates new square identity matrix:

(define (make-matrix n)
  (let outter ((i n) (result '()))
    (if (= i 0)
        result
        (outter (- i 1) 
                (cons 
                 (let inner ((j n) (row '()))
                   (if (= j 0)
                       row
                       (inner (- j 1) (cons (if (= i j) 1 0) row))))
                 result)))))

Procedure that return nth element of the list, which is the same as nth row of the matrix:

(define (nth list n)
  (let iter ((n n) (result list))
    (if (= n 0)
        (car result)
        (iter (- n 1)
              (cdr result)))))

(define matrix-row nth)

Procedure that return nth column of the matrix:

(define (matrix-col M n)
  (let iter ((i (length M)) (result '()))
    (if (= i 0)
        result
        (iter (- i 1)
              (cons (nth (nth M (- i 1)) n) result)))))

Procedure for multiplication of two matrices:

(define (matrix-mul N M)
  (let rows ((i (length N)) (result '()))
    (if (= i 0)
        result
        (rows (- i 1)
              (cons
               (let cols ((j (length (car M))) (row '()))
                 (if (= j 0)
                     row
                     (cols
                      (- j 1)
                      (cons (reduce + (map *
                                           (matrix-row N (- i 1))
                                           (matrix-col M (- j 1))))
                            row))))
               result)))))

For above procedure you will need reduce procedure:

(define (reduce fun lst)
  (let iter ((result (car lst)) (lst (cdr lst)))
    (if (null? lst)
        result
        (iter (fun result (car lst)) (cdr lst)))))

Procedure for multiplication of vector and matrix:

(define (matrix-vector-mul v M)
  (car (matrix-mul (list v) M)))

Procedure for transpose the matrix:

(define (matrix-transpose M)
  (if (null? (car M))
      '()
      (cons (map car M)
            (matrix-transpose (map cdr M)))))

Tail recursive procedure for transpose the matrix:

(define (matrix-transpose M)
  (let iter ((M M) (result '()))
    (if (null? (car M))
        result
        (iter (map cdr M) (append result (list (map car M)))))))

Procedure that calculate the sum of two matrices:

(define (matrix-sum N M)
  (let iter ((N N) (M M) (result '()))
    (if (or (null? N) (null? M))
        (reverse result)
        (iter (cdr N) 
              (cdr M)
              (cons (map + (car N) (car M)) result)))))

Shorter version of the above:

(define (matrix-sum N M)
  (map (lambda (nrow mrow) (map + nrow mrow)) N M))

Usage:

You can use those procedures like this:

(define M1 '((1 2 3) (2 3 4) (3 2 1)))
(define M2 (make-matrix 3))

(write (matrix-mul M1 M2))
(newline)
(write (matrix-mul M1 '((2 3 1) (1 2 1) (1 3 1))))
(newline)
(write (matrix-sum M1 M2))
(newline)
(write (matrix-vector-mul '(2 3 1) M1))

Abelson & Sussman video lectures mirror download

Structure and Interpretation of Computer Programs If you have trouble find all Abelson & Sussman SICP video lectures from MIT, here are direct downloads from archive.org (mp4 256kb).

http://ia361309.us.archive.org/3/items/halmit1a/Lecture-1a_256kb.mp4
http://ia361301.us.archive.org/22/items/halmit1b/Lecture-1b_256kb.mp4
http://ia361301.us.archive.org/19/items/halmit2a/Lecture-2a_256kb.mp4
http://ia361301.us.archive.org/18/items/halmit2b/Lecture-2b_256kb.mp4
http://ia361301.us.archive.org/20/items/halmit3a/Lecture-3a_256kb.mp4
http://ia361301.us.archive.org/17/items/halmit3b/Lecture-3b_256kb.mp4
http://ia361301.us.archive.org/11/items/halmit4a/Lecture-4a_256kb.mp4
http://ia361300.us.archive.org/3/items/halmit4b/Lecture-4b_256kb.mp4
http://ia361300.us.archive.org/11/items/halmit5a/Lecture-5a_256kb.mp4
http://ia361301.us.archive.org/8/items/halmit5b/Lecture-5b_256kb.mp4
http://ia361300.us.archive.org/4/items/halmit6a/Lecture-6a_256kb.mp4
http://ia361301.us.archive.org/7/items/halmit6b/Lecture-6b_256kb.mp4
http://ia361301.us.archive.org/10/items/halmit7a/Lecture-7a_256kb.mp4
http://ia361300.us.archive.org/12/items/halmit7b/Lecture-7b_256kb.mp4
http://ia361308.us.archive.org/3/items/halmit8a/Lecture-8a_256kb.mp4
http://ia361301.us.archive.org/14/items/halmit8b/Lecture-8b_256kb.mp4
http://ia361300.us.archive.org/4/items/halmit9a/Lecture-9a_256kb.mp4
http://ia361300.us.archive.org/16/items/halmit9b/Lecture-9b_256kb.mp4
http://ia361300.us.archive.org/6/items/halmit10a/Lecture-10a_256kb.mp4
http://ia361300.us.archive.org/15/items/halmit10b/Lecture-10b_256kb.mp4

Lisp Macro for Lisp like Structures in Guile Scheme Interpreter

Guile has ugly structure implementaion. Here are sructure implementation for guile (using lisp like macros) which look more like common lisp structures.

(define (make-name name)
  "create struct constructor name."
  (string->symbol (string-append "make-" (symbol->string name))))


(define (make-getter name field)
  "create filed acess function name."
  (string->symbol (string-append (symbol->string name) "-"
				 (symbol->string field))))


(define (make-setter name field)
  "create field setter function name."
  (string->symbol (string-append "set-" 
				 (symbol->string name) "-"
				 (symbol->string field) "!")))


(define (make-predicate name)
  "create predicate function name."
  (string->symbol (string-append (symbol->string name) "?")))


(define-macro (defstruct name . fields)
  "Macro implementing structures in guile based on assoc list."
  (let ((names (map (lambda (symbol) (gensym)) fields))
        (struct (gensym))
        (field-arg (gensym)))
    `(if (not (every-unique ',fields))
        (error 'defstruct "Fields must be unique")
        (begin
          (define (,(make-name name) ,@names)
        (map cons ',fields (list ,@names)))
          ,@(map (lambda (field)
               `(define (,(make-getter name field) ,struct)
              (cdr (assq ',field ,struct)))) fields)
          ,@(map (lambda (field)
               `(define (,(make-setter name field) ,struct ,field-arg)
                    (assq-set! ,struct ',field ,field-arg)
              ,field-arg)) fields)
          (define (,(make-predicate name) ,struct)
            (and (struct? ,struct) (equal? ',fields (map car ,struct))))))))


(define (unique item list)
  "check if item ocour only once."
  (= (length (filter (lambda (i) (eq? item i)) list)) 1))


(define (every predicate list)
  "check if every element in list return true for a given predicate."
  (let ((result #t))
    (for-each (lambda (x)
		(if (not (predicate x)) (set! result #f))) list)
    result))


(define (every-unique list)
  "check if every element ocour only once."
  (every (lambda (item) (unique item list)) list))

(define (struct? struct)
  "check if argument is structure (actualy it check if struct is alist with keys are symbols)."
  (and (list? struct) (every pair? struct) (every symbol? (map car struct))))


(define (last list)
  "return last element from the list."
  (let iter ((list list))
    (if (null? (cdr list))
	(car list)
	(iter (cdr list)))))


(define (write-struct struct)
  "print structure."
  (if (struct? struct)
      (begin
	(display "#<")
	(for-each (lambda (field)
		    (let ((first (car field)))
		      (if (struct? first)
			  (write-struct first)
			  (display first)))
		    (display ":")
		    (let ((rest (cdr field)))
		      (if (struct? rest)
			  (write-struct rest)
			  (write rest)))
		    (if (not (eq? field (last struct)))
			(display " "))) struct)
	(display ">"))))

(define (print-struct struct)
  (write-struct struct)
  (newline))

This implementation use alist as structure. If you use defstruct macro it will define couple of function: constructor make-<struct name>, geters for every field <struct name>-<field name> seters for every field set-<struct name>-<field name>! and predicate <struct name>? which check if structure are of specific type.

You can use it like this

(defstruct point x y)
(define point (make-point 10 20))
(set-point-x! point 1)
(display (string-append "x: " (point-x point)))
(newline)
(display (string-append "is struct?: " (if (struct? point) "true" "false")))
(newline)
(display (string-append "is point?: " (if (point? point) "true" "false")))
(newline)
(print-struct point)

You could download code here.

How to use and extend BiwaScheme

BiwaScheme is scheme implementation in Javascript.

Here you can find scheme interpeter using BiwaScheme (using JQuery Terminal Emulator inside JQuery UI Dialog). If you want to download BiwaScheme package click here.

BiwaScheme use ~~prototype~~ jQuery javascript library.

If you want to use interpreter in your own code you must:

add this to head tag
```
http://src/development_loader.js
```
or if you want to make distribution you must have make and YUI Compressor which require java
Uncomress package and type make in biwascheme directory it will create lib/biwascheme.js file which is compressed library. You must put it in head of your html file:
```
lib/biwascheme.js
```

Create instance of Interpreter class

var intepreter = new BiwaScheme.Interpreter();

You can also put function for error handling to the constructor

var biwascheme = new BiwaScheme.Interpreter(function(e, state) {
    $('output')[0].innerHTML += e.message;
});

If you want to result be proper displayed you must overwrite puts function

var output = $('ouptut');
function puts(str, no_newline) {
    if (no_newline) {
        output[0].innerHTML += str;
    } else {
        output[0].innerHTML += str + "<br />";
    }
}

Evaluating funtion should look like this:

var input = $('input');
var output = $('output');
function scheme_eval(e) {
    try {
        var code = input.html();
        // show trace messages
        if (trace) {
            var opc = interpreter.compile(code);
            var dump_opc = (new BiwaScheme.Dumper()).dump_opc(opc);
            output[0].innerHTML += dump_opc;
        }
        interpreter.evaluate(code, function(result) {
            if (result != undefined) {
                result = BiwaScheme.to_write(result);
                output[0].innerHTML += '> ' + result + "\n";
            }
        });
    } catch(e) {
         //this will never be evaluated because all errors are
         //pased to function pased to Interpreter constructor
         output[0].innerHTML += e.message;
         throw(e);
    }
}

You could bind this function with onclick event
```
$('eval_btn').click(scheme_eval);
```

If you want to define new function which will be accessable in your scheme interpreter you should use define_libfunc function from global object BiwaScheme. First parametr is scheme name of the function, second and third are minimum and maximum of parameters and fourth is the anonimus function with one argument which is array of parameters pased to scheme procedure.

BiwaScheme.define_libfunc('env', 0, 0, function(args) {
        var result = new Array();
        for(fun in window.BiwaScheme.CoreEnv) {
            result[result.length] = fun;
        }
        // result should be converted from array to scheme list
        return result.to_list();
    });

This function will return list of all function and variables in scheme global Environment.
The following scheme function will display that list:

(define (show-env)
  (let iter ((list (env)))
    (if (not  (null? list))
        (begin
           (display (car list))
           (newline)
           (iter (cdr list))))))

or simplier.

(define (show-env)
  (display (string-join (env) "\n"))
  (newline))

If you want to define some variable you must put it in BiwaScheme.CoreEnv array.

If you want to define (in javascript) function with scheme code use BiwaScheme.define_scmfunc. First parameter is scheme name, second and third are minimum and maximum of parameters (BiwaScheme check this before function are evaluated) and the fourth one is string containing your scheme code (should be lambda expresion).

BiwaScheme.define_scmfunc('**', 1, 1,
        "(lambda (x y) \
             (cond \
                 ((= y 0) 1) \
                 ((< y 0) (** (/ 1. x) (- y))) \
                 (else \
                    (let iter ((i 1) (result x)) \
                       (if (= i y) \
                           result \
                           (iter (+ i 1) (* result x)))))))");

Former function define power with tail recursion.

You could also create scheme macro in javascript with BiwaScheme.define_syntax function. This function must return BiwaScheme.Pair object which will be evaluated. It accept single parameter which is scheme expression (tree build from BiwaScheme.Pair objects). This is example of using macros from javascript:

//this is helper Array method which traverse a tree build with arrays 
//and create tree of Symbols
// it use to_list function wich is defined by BiwaScheme
Array.prototype.to_tree = function() {
    for(var i in this) {
        if (this[i] instanceof Array) {
            return this[i].to_tree();
        }
    }
    return this.to_list();
};

BiwaScheme.define_syntax('foo', function(expr) {
    return [BiwaScheme.Sym("display"),
            [BiwaScheme.Sym("quote"), expr.cdr.to_array().to_tree()]
           ].to_tree();
});

This code create new macro foo which simply display expression passed as parameters. Note that the whole expression is in expr.cdr filed.

In interpeter you could also define macros (like common lisp macros) with define-macro expresion.

(define-macro (for params . body)
    `(let iter ((,(car params) ,(cadr params)))
        (if (< ,(car params) ,(caddr params))
            (begin
                ,@body
                (iter (+ ,(car params) ,(if (= (length params) 4)
                                            (cadddr params)
                                            1)))))))

The former code define for loop (which use tail recursion), you could use it with (for (variable init end step) code):

(for (i 1 10)
  (display i)
  (newline))

(for (i 10 100 10) (display i) (newline))

Which display numers: 10 20 30 40 50 60 70 80 90 100.

Update: Check also Extending Scheme interpreter in BiwaScheme wiki on GitHub.

Rate this:

Share this:

Rate this:

Share this:

Rate this:

Share this:

Procedure that creates new square identity matrix:

Procedure that return nth element of the list, which is the same as nth row of the matrix:

Procedure that return nth column of the matrix:

Procedure for multiplication of two matrices:

For above procedure you will need reduce procedure:

Procedure for multiplication of vector and matrix:

Procedure for transpose the matrix:

Tail recursive procedure for transpose the matrix:

Procedure that calculate the sum of two matrices:

Shorter version of the above:

Usage:

Rate this:

Share this:

Rate this:

Share this:

Rate this:

Share this:

Rate this:

Share this: