Adding upstream version 2.10.34.upstream/2.10.34upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 457 insertions, 0 deletions

diff --git a/plug-ins/script-fu/scripts/script-fu-compat.init b/plug-ins/script-fu/scripts/script-fu-compat.init
new file mode 100644
index 0000000..865cf80
--- /dev/null
+++ b/plug-ins/script-fu/scripts/script-fu-compat.init
@@ -0,0 +1,457 @@
+;The Scheme code in this file provides some compatibility with scripts that
+;were originally written for use with the older SIOD based Script-Fu plug-in
+;of GIMP.
+;
+;All items defined in this file except for the random number routines are
+;deprecated. Existing scripts should be updated to avoid the use of the
+;compatibility functions and define statements which follow the random number 
+;generator routines.
+;
+;The items marked as deprecated at the end of this file may be removed
+;at some later date.
+
+
+;The random number generator routines below have been slightly reformatted.
+;A couple of define blocks which are not needed have been commented out.
+;It has also been extended to enable it to generate numbers with exactly 31
+;bits or more.
+;The original file was called rand2.scm and can be found in:
+;http://www-2.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/scheme/code/math/random/
+
+; Minimal Standard Random Number Generator
+; Park & Miller, CACM 31(10), Oct 1988, 32 bit integer version.
+; better constants, as proposed by Park.
+; By Ozan Yigit
+
+;(define *seed* 1)
+
+(define (srand seed)
+  (set! *seed* seed)
+  *seed*
+)
+
+(define (msrg-rand)
+  (let (
+       (A 48271)
+       (M 2147483647)
+       (Q 44488)
+       (R 3399)
+       )
+    (let* (
+          (hi (quotient *seed* Q))
+          (lo (modulo *seed* Q))
+          (test (- (* A lo) (* R hi)))
+          )
+      (if (> test 0)
+        (set! *seed* test)
+        (set! *seed* (+ test M))
+      )
+    )
+  )
+  *seed*
+)
+
+; poker test
+; seed 1
+; cards 0-9 inclusive (random 10)
+; five cards per hand
+; 10000 hands
+;
+; Poker Hand     Example    Probability  Calculated
+; 5 of a kind    (aaaaa)      0.0001      0
+; 4 of a kind    (aaaab)      0.0045      0.0053
+; Full house     (aaabb)      0.009       0.0093
+; 3 of a kind    (aaabc)      0.072       0.0682
+; two pairs      (aabbc)      0.108       0.1104
+; Pair           (aabcd)      0.504       0.501
+; Bust           (abcde)      0.3024      0.3058
+
+(define (random n)
+  (define (internal-random n)
+    (let* (
+          (n (inexact->exact (truncate n)))
+          (M 2147483647)
+          (slop (modulo M (abs n)))
+          )
+      (let loop ((r (msrg-rand)))
+        (if (>= r slop)
+          (modulo r n)
+          (loop (msrg-rand))
+        )
+      )
+    )
+  )
+
+  ; Negative numbers have a bigger range in twos complement platforms
+  ; (nearly all platforms out there) than positive ones, so we deal with
+  ; the numbers in negative form.
+  (if (> n 0)
+    (+ n (random (- n)))
+
+    (if (>= n -2147483647)
+      (internal-random n)
+
+      ; 31-or-more-bits number requested - needs multiple extractions
+      ; because we don't generate enough random bits.
+      (if (>= n -1152921504606846975)
+        ; Up to 2^60-1, two extractions are enough
+        (let ((q (- (quotient (+ n 1) 1073741824) 1))) ; q=floor(n/2^30)
+          (let loop ()
+            (let ((big (+ (* (internal-random q) 1073741824)
+                          (internal-random -1073741824)
+                       )
+                 ))
+              (if (> big n)
+                big
+                (loop)
+              )
+            )
+          )
+        )
+
+        ; From 2^60 up, we do three extractions.
+        ; The code is better understood if seen as generating three
+        ; digits in base 2^30. q is the maximum value the first digit
+        ; can take. The other digits can take the full range.
+        ;
+        ; The strategy is to generate a random number digit by digit.
+        ; Here's an example in base 10. Say the input n is 348
+        ; (thus requesting a number between 0 and 347). Then the algorithm
+        ; first calls (internal-random 4) to get a digit between 0 and 3,
+        ; then (internal-random 10) twice to get two more digits between
+        ; 0 and 9. Say the result is 366: since it is greater than 347,
+        ; it's discarded and the process restarted. When the result is
+        ; <= 347, that's the returned value. The probability of it being
+        ; greater than the max is always strictly less than 1/2.
+        ;
+        ; This is the same idea but in base 2^30 (1073741824). The
+        ; first digit's weight is (2^30)^2 = 1152921504606846976,
+        ; similarly to how in our base 10 example, the first digit's
+        ; weight is 10^2 = 100. In the base 10 example we first divide
+        ; the target number 348 by 100, taking the ceiling, to get 4.
+        ; Here we divide by (2^30)^2 instead, taking the ceiling too.
+        ;
+        ; The math is a bit obscured by the fact that we generate
+        ; the digits as negative, so that the result is negative as
+        ; well, but it's really the same thing. Changing the sign of
+        ; every digit just changes the sign of the result.
+        ;
+        ; This method works for n up to (2^30)^2*(2^31-1) which is
+        ; 2475880077417839045191401472 (slightly under 91 bits). That
+        ; covers the 64-bit range comfortably, and some more. If larger
+        ; numbers are needed, they'll have to be composed with a
+        ; user-defined procedure.
+
+        (if (>= n -2475880077417839045191401472)
+          (let ((q (- (quotient (+ n 1) 1152921504606846976) 1))) ; q=floor(n/2^60)
+            (let loop ()
+              (let ((big (+ (* (internal-random q) 1152921504606846976)
+                            (* (internal-random -1073741824) 1073741824)
+                            (internal-random -1073741824)
+                         )
+                   ))
+                (if (> big n)
+                  big
+                  (loop)
+                )
+              )
+            )
+          )
+          (error "requested (random n) range too large")
+        )
+      )
+    )
+  )
+)
+
+;(define (rngtest)
+;  (display "implementation ")
+;  (srand 1)
+;  (do
+;    ( (n 0 (+ n 1)) )
+;    ( (>= n 10000) )
+;    (msrg-rand)
+;  )
+;  (if (= *seed* 399268537)
+;      (display "looks correct.")
+;      (begin
+;        (display "failed.")
+;        (newline)
+;        (display "   current seed ") (display *seed*)
+;        (newline)
+;        (display "   correct seed 399268537")
+;      )
+;  )
+;  (newline)
+;)
+
+
+;This macro defines a while loop which is needed by some older scripts.
+;This is here since it is not defined in R5RS and could be handy to have.
+
+;This while macro was found at:
+;http://www.aracnet.com/~briand/scheme_eval.html
+(define-macro (while test . body)
+  `(let loop ()
+     (cond
+       (,test
+         ,@body
+         (loop)
+       )
+     )
+   )
+)
+
+
+;The following define block(s) require the tsx extension to be loaded
+
+(define (realtime)
+  (car (gettimeofday))
+)
+
+
+;Items below this line are for compatibility with Script-Fu but
+;may be useful enough to keep around
+
+(define (delq item lis)
+  (let ((l '()))
+    (unless (null? lis)
+      (while (pair? lis)
+        (if (<> item (car lis))
+          (set! l (append l (list (car lis))))
+        )
+        (set! lis (cdr lis))
+      )
+    )
+
+    l
+  )
+)
+
+(define (make-list count fill)
+  (vector->list (make-vector count fill))
+)
+
+(define (strbreakup str sep)
+  (let* (
+        (seplen (string-length sep))
+        (start 0)
+        (end (string-length str))
+        (i start)
+        (l '())
+        )
+
+    (if (= seplen 0)
+      (set! l (list str))
+      (begin
+        (while (<= i (- end seplen))
+          (if (substring-equal? sep str i (+ i seplen))
+            (begin
+               (if (= start 0)
+                 (set! l (list (substring str start i)))
+                 (set! l (append l (list (substring str start i))))
+               )
+               (set! start (+ i seplen))
+               (set! i (+ i seplen -1))
+            )
+          )
+
+          (set! i (+ i 1))
+        )
+
+        (set! l (append l (list (substring str start end))))
+      )
+    )
+
+    l
+  )
+)
+
+(define (string-downcase str)
+  (list->string (map char-downcase (string->list str)))
+)
+
+(define (string-trim str)
+  (string-trim-right (string-trim-left str))
+)
+
+(define (string-trim-left str)
+  (let (
+       (strlen (string-length str))
+       (i 0)
+       )
+
+    (while (and (< i strlen)
+                (char-whitespace? (string-ref str i))
+           )
+      (set! i (+ i 1))
+    )
+
+    (substring str i (string-length str))
+  )
+)
+
+(define (string-trim-right str)
+  (let ((i (- (string-length str) 1)))
+
+    (while (and (>= i 0)
+                (char-whitespace? (string-ref str i))
+           )
+      (set! i (- i 1))
+    )
+
+    (substring str 0 (+ i 1))
+  )
+)
+
+(define (string-upcase str)
+  (list->string (map char-upcase (string->list str)))
+)
+
+(define (substring-equal? str str2 start end)
+  (string=? str (substring str2 start end))
+)
+
+(define (unbreakupstr stringlist sep)
+  (let ((str (car stringlist)))
+
+    (set! stringlist (cdr stringlist))
+    (while (not (null? stringlist))
+      (set! str (string-append str sep (car stringlist)))
+      (set! stringlist (cdr stringlist))
+    )
+
+    str
+  )
+)
+
+
+;Items below this line are deprecated and should not be used in new scripts.
+
+(define aset vector-set!)
+(define aref vector-ref)
+(define fopen open-input-file)
+(define mapcar map)
+(define nil '())
+(define nreverse reverse)
+(define pow expt)
+(define prin1 write)
+
+(define (print obj . port)
+  (apply write obj port)
+  (newline)
+)
+
+(define strcat string-append)
+(define string-lessp string<?)
+(define symbol-bound? defined?)
+(define the-environment current-environment)
+
+(define *pi*
+  (* 4 (atan 1.0))
+)
+
+(define (butlast x)
+  (if (= (length x) 1)
+    '()
+    (reverse (cdr (reverse x)))
+  )
+)
+
+(define (cons-array count type)
+  (case type
+    ((long)   (make-vector count 0))
+    ((short)  (make-vector count 0))
+    ((byte)   (make-vector count 0))
+    ((double) (make-vector count 0.0))
+    ((string) (vector->list (make-vector count "")))
+    (else type)
+  )
+)
+
+(define (fmod a b)
+  (- a (* (truncate (/ a b)) b))
+)
+
+(define (fread arg1 file)
+
+  (define (fread-get-chars count file)
+    (let (
+         (str "")
+         (c 0)
+         )
+
+      (while (> count 0)
+        (set! count (- count 1))
+        (set! c (read-char file))
+        (if (eof-object? c)
+            (set! count 0)
+            (set! str (string-append str (make-string 1 c)))
+        )
+      )
+
+      (if (eof-object? c)
+          ()
+          str
+      )
+    )
+  )
+
+  (if (number? arg1)
+      (begin
+        (set! arg1 (inexact->exact (truncate arg1)))
+        (fread-get-chars arg1 file)
+      )
+      (begin
+        (set! arg1 (fread-get-chars (string-length arg1) file))
+        (string-length arg1)
+      )
+  )
+)
+
+(define (last x)
+  (cons (car (reverse x)) '())
+)
+
+(define (nth k list)
+  (list-ref list k)
+)
+
+(define (prog1 form1 . form2)
+  (let ((a form1))
+    (if (not (null? form2))
+      form2
+    )
+    a
+  )
+)
+
+(define (rand . modulus)
+  (if (null? modulus)
+    (msrg-rand)
+    (apply random modulus)
+  )
+)
+
+(define (strcmp str1 str2)
+  (if (string<? str1 str2)
+      -1
+      (if (string>? str1 str2)
+          1
+          0
+      )
+  )
+)
+
+(define (trunc n)
+  (inexact->exact (truncate n))
+)
+
+(define verbose
+  (lambda n
+    (if (or (null? n) (not (number? (car n))))
+      0
+      (car n)
+    )
+  )
+)