PDA

Vollständige Version anzeigen : Nützliche String- und Filename-Utility-Proceduren - Code anbei


kumbbl
09.01.2009, 18:36
Hallo zusammen,

nachdem ich feststellen musste, dass die Serienausstattung von Proceduren zur String- und Filename-Behandung in Script-Fu/Scheme äußerst mager ist (IMHO zu mager), habe ich mal ein bischen recherchiert und folgende String-Filename-Utility-scm-Bibliothek gebaut.

Kommentare sind enthalten - möglicherweise gibts noch andere leute, die nach solche Proceduren suchen (einfach Code in ein File *.scm in das persönliche Scripte-verzeichnis von Gimp speichern und voila)

Getestet mit Gimp 2.6.3...

Anregungen für Verbesserungen sind natürlich willkommen! ;-)


; kumbbl-string-filename-utilities.scm
; by Klaus Berndl

; Description
;
; This implements a some utilitis for string- and filename-handling
; exports - see funtions below and the comments in front of them

; License:
;
; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation; either version 2 of the License, or
; (at your option) any later version.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
; GNU General Public License for more details.
;
; The GNU Public License is available at
; http://www.gnu.org/copyleft/gpl.html

; ---------- string-utilities -----------------

; Return the index of the first occurence of a-char in str, or #f
(define (string-index str a-char)
(let loop ((pos 0))
(cond
((>= pos (string-length str)) #f) ; whole string has been searched, in vain
((char=? a-char (string-ref str pos)) pos)
(else (loop (+ 1 pos))))))

; Return the index of the last occurence of a-char in str, or #f
(define (string-index-right str a-char)
(let loop ((pos (- (string-length str) 1)))
(cond
((negative? pos) #f) ; whole string has been searched, in vain
((char=? a-char (string-ref str pos)) pos)
(else (loop (- pos 1))))))
(define string-rindex string-index-right)


; string-contains s1 s2 [start1 end1 start2 end2] -> integer or false
; string-contains-ci s1 s2 [start1 end1 start2 end2] -> integer or false
; Does string s1 contain string s2?
; Return the index in s1 where s2 occurs as a substring, or false. The
; optional start/end indices restrict the operation to the indicated
; substrings.
; We do not support the optional arguments
(define (string-contains str pattern)
(let* ((pat-len (string-length pattern))
(search-span (- (string-length str) pat-len))
(c1 (if (zero? pat-len) #f (string-ref pattern 0)))
(c2 (if (<= pat-len 1) #f (string-ref pattern 1))))
(cond
((not c1) 0) ; empty pattern, matches upfront
((not c2) (string-index str c1)) ; one-char pattern
(else ; matching a pattern of at least two chars
(let outer ((pos 0))
(cond
((> pos search-span) #f) ; nothing was found thru the whole str
((not (char=? c1 (string-ref str pos)))
(outer (+ 1 pos))) ; keep looking for the right beginning
((not (char=? c2 (string-ref str (+ 1 pos))))
(outer (+ 1 pos))) ; could've done pos+2 if c1 == c2....
(else ; two char matched: high probability
; the rest will match too
(let inner ((i-pat 2) (i-str (+ 2 pos)))
(if (>= i-pat pat-len) pos ; whole pattern matched
(if (char=? (string-ref pattern i-pat)
(string-ref str i-str))
(inner (+ 1 i-pat) (+ 1 i-str))
(outer (+ 1 pos)))))))))))) ; mismatch after partial match

(define (substring? pattern str) (string-contains str pattern))


; Here are some specialized substring? functions
; checks to make sure that PATTERN is a prefix of STRING
;
; (string-prefix? "pir" "pirate") => #t
; (string-prefix? "rat" "outrage") => #f
; (string-prefix? "" any-string) => #t
; (string-prefix? any-string any-string) => #t
(define (string-prefix? pattern str)
(let loop ((i 0))
(cond
((>= i (string-length pattern)) #t)
((>= i (string-length str)) #f)
((char=? (string-ref pattern i) (string-ref str i))
(loop (inc i)))
(else #f))))

(define (string-prefix-ci? pattern str)
(let loop ((i 0))
(cond
((>= i (string-length pattern)) #t)
((>= i (string-length str)) #f)
((char-ci=? (string-ref pattern i) (string-ref str i))
(loop (inc i)))
(else #f))))

; checks to make sure that PATTERN is a suffix of STRING
;
; (string-suffix? "ate" "pirate") => #t
; (string-suffix? "rag" "outrage") => #f
; (string-suffix? "" any-string) => #t
; (string-suffix? any-string any-string) => #t
(define (string-suffix? pattern str)
(let loop ((i (dec (string-length pattern))) (j (dec (string-length str))))
(cond
((negative? i) #t)
((negative? j) #f)
((char=? (string-ref pattern i) (string-ref str j))
(loop (dec i) (dec j)))
(else #f))))

(define (string-suffix-ci? pattern str)
(let loop ((i (dec (string-length pattern))) (j (dec (string-length str))))
(cond
((negative? i) #t)
((negative? j) #f)
((char-ci=? (string-ref pattern i) (string-ref str j))
(loop (dec i) (dec j)))
(else #f))))

; ---------- filename-utilities -------------------

; return all parts of the full filename of an image as a list:
; (<directory> <directory-separator> <basename> <extension>)
; All parts of the result-list are strings
;
; examples:
; suppose <image> hat the full filename "C:\any\dir\at\my\drive\images\MyFirstImage.jpg".
; Then (kumbbl-image-get-parts-of-filename <image>) returns
; '("C:\\any\\dir\\at\\my\\drive\\images" "\\" "MyFirstImage" "jpg")
; TODO:
; make failure-save when called for an image without an extension-part
; in its filename - should be seldom but ........ ;-)

(define (kumbbl-image-get-parts-of-filename InImage)
(let* ((image-name (car (gimp-image-get-name InImage)))
(image-full-filename (car (gimp-image-get-filename InImage)))
(extension (substring image-name
(+ 1 (string-rindex image-name #\.))))
(basename (substring image-name 0 (string-rindex image-name #\.)))
(beginning-image-name (substring? image-name image-full-filename))
(dir-separator (substring image-full-filename
(- beginning-image-name 1)
beginning-image-name))
(directory (substring image-full-filename
0 (- beginning-image-name 1))))
(list directory dir-separator basename extension)))

; self explanating

(define (kumbbl-image-get-directory InImage)
(car (kumbbl-image-get-parts-of-filename InImage)))

(define (kumbbl-image-get-dir-separator InImage)
(car (cdr (kumbbl-image-get-parts-of-filename InImage))))

(define (kumbbl-image-get-basename InImage)
(car (cdr (cdr (kumbbl-image-get-parts-of-filename InImage)))))

(define (kumbbl-image-get-extension InImage)
(car (cdr (cdr (cdr (kumbbl-image-get-parts-of-filename InImage))))))

schumaml
09.01.2009, 18:59
An der Stelle ist es schade, dass Tinyscheme kein define-syntax hat, denn sonst könnte man vermutlich die Referenzimplementierung von SRFI 13 (http://srfi.schemers.org/srfi-13/srfi-13.html) (die auch Vorlage für die Prozeduren war?) - direkt verwenden.

Eine SRFI 13-Implementierung für Tinyscheme ohne die zusätzlichen Funktionen am Ende sollte am besten dem Tinyscheme-Entwickler geschickt werden, denn dann könnte diese in neuen Versionen gleich mitgeliefert werden.

kumbbl
09.01.2009, 19:08
exakt, die waren die Vorlage - ich hab auch probiert, die komplette Bibliothek zu laden - aber wie du sagst, mangels define-syntax klappt das nicht......

Apropos: was ist eigentlich TinyScheme? ist das der neue Scheme-Dialekt von Gimp? Wo gibts Infos dazu? Wie schicke ich dem Entwickler den Code?

Danke für die Infos!

schumaml
09.01.2009, 19:17
http://tinyscheme.sourceforge.net/

kumbbl
09.01.2009, 22:07
http://tinyscheme.sourceforge.net/

ok, hab ich angesehen, auch den Link, der auf Tiny-Fu verweist...

Bin jetzt aber etwas verwirrt, vielleicht aber auch nur zu doof, das ganze richtig zu verstehen: Ich habe bei mir Gimp 2.6.3 installiert und hier ein Menü "Script-Fu"... ist in dieser Gimp-Version nun Tiny-Fu bereits automatisch instaliert? Wenn ja, wieso heisst das Menü dann noch Script-Fu? verwende ich nun den TinyScheme-Interpreter, wenn ich die Script-Fu-Konsole in Gimp 2.6 aufrufe oder die alte SIOD-Implementierung? Fragen über Fragen, auf die ich hier keine rechte Antwort gefunden habe....

danke für ein wenig Aufklärung!

schumaml
09.01.2009, 22:26
SIOD ist schon lange nicht mehr in GIMP.

PKHG
18.02.2009, 13:46
ok, hab ich angesehen, auch den Link, der auf Tiny-Fu verweist...

Bin jetzt aber etwas verwirrt, vielleicht aber auch nur zu doof, das ganze richtig zu verstehen: Ich habe bei mir Gimp 2.6.3 installiert und hier ein Menü "Script-Fu"... ist in dieser Gimp-Version nun Tiny-Fu bereits automatisch instaliert? Wenn ja, wieso heisst das Menü dann noch Script-Fu? verwende ich nun den TinyScheme-Interpreter, wenn ich die Script-Fu-Konsole in Gimp 2.6 aufrufe oder die alte SIOD-Implementierung? Fragen über Fragen, auf die ich hier keine rechte Antwort gefunden habe....

danke für ein wenig Aufklärung!

Ich denke dass Script Fu immer dabei ist und Tiny Scheme benutzt. Sonst koennten *.scm plug-in's nicht funktionieren.
Bei mir ist in dieser directory C:\gimp2.6.5\lib\gimp\2.0\plug-ins> script-fu.exe zu finden, und das wird wohl das an Gimp gebundene 'Tiny Scheme' (kann beinahe nicht anders) sein (mit dll's dabei noetig?!).

PKHG
18.02.2009, 19:00
Hallo zusammen,

nachdem ich feststellen musste, dass die Serienausstattung von Proceduren zur String- und Filename-Behandung in Script-Fu/Scheme äußerst mager ist (IMHO zu mager), habe ich mal ein bischen recherchiert und folgende String-Filename-Utility-scm-Bibliothek gebaut.

Kommentare sind enthalten - möglicherweise gibts noch andere leute, die nach solche Proceduren suchen (einfach Code in ein File *.scm in das persönliche Scripte-verzeichnis von Gimp speichern und voila)

Getestet mit Gimp 2.6.3...

Anregungen für Verbesserungen sind natürlich willkommen! ;-)


<SNIP>
; Return the index of the first occurence of a-char in str, or #f
(define (string-index str a-char)
(let loop ((pos 0))
(cond
((>= pos (string-length str)) #f) ; whole string has been searched, in vain
((char=? a-char (string-ref str pos)) pos)
(else (loop (+ 1 pos))))))

<snip>


Das funktioniert nicht mehr im heutigen Tiny Scheme (Script Fu)
Das let hast du meiner Meinung nach nicht richtig benutzt.

Meine Version (in 2.6.4 überprüft) ist dies geworden


(define (first-char-in-string str char)
(let* ((pos 0)
(laenge (string-length str))
(result -1))
(while (< pos laenge)
(if (char=? char (string-ref str pos))
(begin (set! result pos)
(set! pos laenge)); fruehes Ende des whil-loops
(set! pos (+ 1 pos)))) ;damit while irgendwann mal stopt :lol:
result))


Misserfolg der Suche zeigt sich durch Resultat: -1.

PKHG
19.02.2009, 09:26
Schau mal hier:
http://wiki.gimpforum.de/wiki/String-search

So sieht mein Teilstringsuchen aus

schumaml
19.02.2009, 13:29
Ist das auch SRFI-13-konform?

PKHG
19.02.2009, 13:59
Keine Ahnung,
Es geht mir nur darum, dass es in Script Fu von >= Gimp 2.6.4 funktioniert ...

kumbbl
19.02.2009, 14:01
Das funktioniert nicht mehr im heutigen Tiny Scheme (Script Fu)
Das let hast du meiner Meinung nach nicht richtig benutzt.

Meine Version (in 2.6.4 überprüft) ist dies geworden


(define (first-char-in-string str char)
(let* ((pos 0)
(laenge (string-length str))
(result -1))
(while (< pos laenge)
(if (char=? char (string-ref str pos))
(begin (set! result pos)
(set! pos laenge)); fruehes Ende des whil-loops
(set! pos (+ 1 pos)))) ;damit while irgendwann mal stopt :lol:
result))
Misserfolg der Suche zeigt sich durch Resultat: -1.

meine Version mit "loop" funktionert hervorragend - wüßte nicht, was daran falsch sein sollte und was nicht funktionieren sollte - grad eben in Gimp 2.6.3 nochmal getestet...

PKHG
19.02.2009, 14:12
Noch eine Entschuldigung noetig ...

Hab anscheinend den Sprung von unten zum let noch nicht (wieder) kapiert ...

Hab an folgende Syntax von let gedacht

De syntax van de let expressie is de volgende:
(let ((var1 exp1)
(var2 exp2)
.
.
.
(varn expn))


stammt aus einem Tutorial (nicht von mir)

So sorry ... haette deinen code gleich ausprobieren muessen!

Peter
body)

kumbbl
19.02.2009, 14:15
Noch eine Entschuldigung noetig ...

Hab anscheinend den Sprung von unten zum let noch nicht (wieder) kapiert ...

Hab an folgende Syntax von let gedacht

De syntax van de let expressie is de volgende:
(let ((var1 exp1)
(var2 exp2)
.
.
.
(varn expn))
stammt aus einem Tutorial (nicht von mir)

So sorry ... haette deinen code gleich ausprobieren muessen!

Peter
body)

Nix zu entschuldigen, hab mich nicht angegriffen gefühlt - hab nur was klargestellt ;-)

No worries
Klaus

schumaml
19.02.2009, 14:16
Es ist ganz hilfreich, die Funktionen auf Korrektheit zu testen. Ich habe da schon mal http://community.schemewiki.org/?bunny-test eingesetzt, als ich die Pinselfunktionen testen wollte. Beispiel siehe http://registry.gimp.org/node/6