← Back to branch summary

~ubuntu-branches/ubuntu/jaunty/gimp/jaunty-security

« back to all changes in this revision

Viewing changes to plug-ins/script-fu/scripts/script-fu-compat.init

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Holbach
  • Date: 2007-05-02 16:33:03 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20070502163303-bvzhjzbpw8qglc4y
Tags: 2.3.16-1ubuntu1
* Resynchronized with Debian, remaining Ubuntu changes:
  - debian/rules: i18n magic.
* debian/control.in:
  - Maintainer: Ubuntu Core Developers <ubuntu-devel@lists.ubuntu.com>
* debian/patches/02_help-message.patch,
  debian/patches/03_gimp.desktop.in.in.patch,
  debian/patches/10_dont_show_wizard.patch: updated.
* debian/patches/04_composite-signedness.patch,
  debian/patches/05_add-letter-spacing.patch: dropped, used upstream.

Show diffs side-by-side

added added

removed removed

Lines of Context:
plug-ins/script-fu/scripts/script-fu-compat.init
 
1
;The Scheme code in this file provides some compatibility with scripts that
 
2
;were originally written for use with the older SIOD based Script-Fu plug-in
 
3
;of GIMP.
 
4
;
 
5
;All items defined in this file except for the random number routines are
 
6
;deprecated. Existing scripts should be updated to avoid the use of the
 
7
;compability functions and define statements which follow the random number 
 
8
;generator routines.
 
9
;
 
10
;The items marked as deprecated at the end of this file may be removed
 
11
;at some later date.
 
12
 
 
13
 
 
14
;The random number generator routines below have been slightly reformatted.
 
15
;A couple of define blocks which are not needed have been commented out.
 
16
;The original file was called rand2.scm and can be found in:
 
17
;http://www-2.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/scheme/code/math/random/
 
18
 
 
19
; Minimal Standard Random Number Generator
 
20
; Park & Miller, CACM 31(10), Oct 1988, 32 bit integer version.
 
21
; better constants, as proposed by Park.
 
22
; By Ozan Yigit
 
23
 
 
24
;(define *seed* 1)
 
25
 
 
26
(define (srand seed)
 
27
  (set! *seed* seed)
 
28
  *seed*
 
29
)
 
30
 
 
31
(define (msrg-rand)
 
32
  (let (
 
33
       (A 48271)
 
34
       (M 2147483647)
 
35
       (Q 44488)
 
36
       (R 3399)
 
37
       )
 
38
    (let* (
 
39
          (hi (quotient *seed* Q))
 
40
          (lo (modulo *seed* Q))
 
41
          (test (- (* A lo) (* R hi)))
 
42
          )
 
43
      (if (> test 0)
 
44
        (set! *seed* test)
 
45
        (set! *seed* (+ test M))
 
46
      )
 
47
    )
 
48
  )
 
49
  *seed*
 
50
)
 
51
 
 
52
; poker test
 
53
; seed 1
 
54
; cards 0-9 inclusive (random 10)
 
55
; five cards per hand
 
56
; 10000 hands
 
57
;
 
58
; Poker Hand     Example    Probability  Calculated
 
59
; 5 of a kind    (aaaaa)      0.0001      0
 
60
; 4 of a kind    (aaaab)      0.0045      0.0053
 
61
; Full house     (aaabb)      0.009       0.0093
 
62
; 3 of a kind    (aaabc)      0.072       0.0682
 
63
; two pairs      (aabbc)      0.108       0.1104
 
64
; Pair           (aabcd)      0.504       0.501
 
65
; Bust           (abcde)      0.3024      0.3058
 
66
 
 
67
(define (random n)
 
68
  (let* (
 
69
        (n (inexact->exact (truncate n)))
 
70
        (M 2147483647)
 
71
        (slop (modulo M n))
 
72
        )
 
73
    (let loop ((r (msrg-rand)))
 
74
      (if (> r slop)
 
75
        (modulo r n)
 
76
        (loop (msrg-rand))
 
77
      )
 
78
    )
 
79
  )
 
80
)
 
81
 
 
82
;(define (rngtest)
 
83
;  (display "implementation ")
 
84
;  (srand 1)
 
85
;  (do
 
86
;    ( (n 0 (+ n 1)) )
 
87
;    ( (>= n 10000) )
 
88
;    (msrg-rand)
 
89
;  )
 
90
;  (if (= *seed* 399268537)
 
91
;      (display "looks correct.")
 
92
;      (begin
 
93
;        (display "failed.")
 
94
;        (newline)
 
95
;        (display "   current seed ") (display *seed*)
 
96
;        (newline)
 
97
;        (display "   correct seed 399268537")
 
98
;      )
 
99
;  )
 
100
;  (newline)
 
101
;)
 
102
 
 
103
 
 
104
;This macro defines a while loop which is needed by some older scripts.
 
105
;This is here since it is not defined in R5RS and could be handy to have.
 
106
 
 
107
;This while macro was found at:
 
108
;http://www.aracnet.com/~briand/scheme_eval.html
 
109
(define-macro (while test . body)
 
110
  `(let loop ()
 
111
     (cond
 
112
       (,test
 
113
         ,@body
 
114
         (loop)
 
115
       )
 
116
     )
 
117
   )
 
118
)
 
119
 
 
120
 
 
121
;The following define block(s) require the tsx extension to be loaded
 
122
 
 
123
(define (realtime)
 
124
  (car (gettimeofday))
 
125
)
 
126
 
 
127
 
 
128
;Items below this line are for compatability with Script-Fu but
 
129
;may be useful enough to keep around
 
130
 
 
131
(define (delq item lis)
 
132
  (let ((l))
 
133
    (if (null? lis)
 
134
      (set! l '())
 
135
      (begin
 
136
        (set! l (car lis))
 
137
        (set! lis (cdr lis))
 
138
        (while (not (null? lis))
 
139
          (if (not (= item (car lis)))
 
140
            (set! l (append l (list (car lis))))
 
141
          )
 
142
          (set! lis (cdr lis))
 
143
        )
 
144
      )
 
145
    )
 
146
 
 
147
    l
 
148
  )
 
149
)
 
150
 
 
151
(define (make-list count fill)
 
152
  (vector->list (make-vector count fill))
 
153
)
 
154
 
 
155
(define (strbreakup str sep)
 
156
  (let* (
 
157
        (seplen (string-length sep))
 
158
        (start 0)
 
159
        (end (string-length str))
 
160
        (i start)
 
161
        (l)
 
162
        )
 
163
 
 
164
    (if (= seplen 0)
 
165
      (set! l (list str))
 
166
      (begin
 
167
        (while (<= i (- end seplen))
 
168
          (if (substring-equal? sep str i (+ i seplen))
 
169
            (begin
 
170
               (if (= start 0)
 
171
                 (set! l (list (substring str start i)))
 
172
                 (set! l (append l (list (substring str start i))))
 
173
               )
 
174
               (set! start (+ i seplen))
 
175
               (set! i (+ i seplen -1))
 
176
            )
 
177
          )
 
178
 
 
179
          (set! i (+ i 1))
 
180
        )
 
181
 
 
182
        (set! l (append l (list (substring str start end))))
 
183
      )
 
184
    )
 
185
 
 
186
    l
 
187
  )
 
188
)
 
189
 
 
190
(define (substring-equal? str str2 start end)
 
191
  (string=? str (substring str2 start end))
 
192
)
 
193
 
 
194
(define (string-trim str)
 
195
  (string-trim-right (string-trim-left str))
 
196
)
 
197
 
 
198
(define (string-trim-left str)
 
199
  (let (
 
200
       (strlen (string-length str))
 
201
       (i 0)
 
202
       )
 
203
 
 
204
    (while (and (< i strlen)
 
205
                (char-whitespace? (string-ref str i))
 
206
           )
 
207
      (set! i (+ i 1))
 
208
    )
 
209
 
 
210
    (substring str i (string-length str))
 
211
  )
 
212
)
 
213
 
 
214
(define (string-trim-right str)
 
215
  (let ((i (- (string-length str) 1)))
 
216
 
 
217
    (while (and (>= i 0)
 
218
                (char-whitespace? (string-ref str i))
 
219
           )
 
220
      (set! i (- i 1))
 
221
    )
 
222
 
 
223
    (substring str 0 (+ i 1))
 
224
  )
 
225
)
 
226
 
 
227
(define (unbreakupstr stringlist sep)
 
228
  (let ((str (car stringlist)))
 
229
 
 
230
    (set! stringlist (cdr stringlist))
 
231
    (while (not (null? stringlist))
 
232
      (set! str (string-append str sep (car stringlist)))
 
233
      (set! stringlist (cdr stringlist))
 
234
    )
 
235
 
 
236
    str
 
237
  )
 
238
)
 
239
 
 
240
 
 
241
;Items below this line are deprecated and should not be used in new scripts.
 
242
 
 
243
(define aset vector-set!)
 
244
(define aref vector-ref)
 
245
(define fopen open-input-file)
 
246
(define mapcar map)
 
247
(define nil '())
 
248
(define nreverse reverse)
 
249
(define pow expt)
 
250
(define prin1 write)
 
251
 
 
252
(define (print obj . port)
 
253
  (apply write obj port)
 
254
  (newline)
 
255
)
 
256
 
 
257
(define strcat string-append)
 
258
(define string-lessp string<?)
 
259
(define symbol-bound? defined?)
 
260
(define the-environment current-environment)
 
261
 
 
262
(define *pi*
 
263
  (* 4 (atan 1.0))
 
264
)
 
265
 
 
266
(define (butlast x)
 
267
  (if (= (length x) 1)
 
268
    '()
 
269
    (reverse (cdr (reverse x)))
 
270
  )
 
271
)
 
272
 
 
273
(define (cons-array count type)
 
274
  (case type
 
275
    ((long)   (make-vector count 0))
 
276
    ((short)  (make-vector count 0))
 
277
    ((byte)   (make-vector count 0))
 
278
    ((double) (make-vector count 0.0))
 
279
    ((string) (make-vector count ""))
 
280
    (else type)
 
281
  )
 
282
)
 
283
 
 
284
(define (fmod a b)
 
285
  (- a (* (truncate (/ a b)) b))
 
286
)
 
287
 
 
288
(define (fread arg1 file)
 
289
 
 
290
  (define (fread-get-chars count file)
 
291
    (let (
 
292
         (str "")
 
293
         (c)
 
294
         )
 
295
 
 
296
      (while (> count 0)
 
297
        (set! count (- count 1))
 
298
        (set! c (read-char file))
 
299
        (if (eof-object? c)
 
300
            (set! count 0)
 
301
            (set! str (string-append str (make-string 1 c)))
 
302
        )
 
303
      )
 
304
 
 
305
      (if (eof-object? c)
 
306
          ()
 
307
          str
 
308
      )
 
309
    )
 
310
  )
 
311
 
 
312
  (if (number? arg1)
 
313
      (begin
 
314
        (set! arg1 (inexact->exact (truncate arg1)))
 
315
        (fread-get-chars arg1 file)
 
316
      )
 
317
      (begin
 
318
        (set! arg1 (fread-get-chars (string-length arg1) file))
 
319
        (string-length arg1)
 
320
      )
 
321
  )
 
322
)
 
323
 
 
324
(define (last x)
 
325
  (cons (car (reverse x)) '())
 
326
)
 
327
 
 
328
(define (nth k list)
 
329
  (list-ref list k)
 
330
)
 
331
 
 
332
(define (prog1 form1 . form2)
 
333
  (let ((a))
 
334
    (set! a form1)
 
335
    (if (not (null? form2))
 
336
      form2
 
337
    )
 
338
    a
 
339
  )
 
340
)
 
341
 
 
342
(define (rand . modulus)
 
343
  (if (null? modulus)
 
344
    (msrg-rand)
 
345
    (apply random modulus)
 
346
  )
 
347
)
 
348
 
 
349
(define (strcmp str1 str2)
 
350
  (if (string<? str1 str2)
 
351
      -1
 
352
      (if (string>? str1 str2)
 
353
          1
 
354
          0
 
355
      )
 
356
  )
 
357
)
 
358
 
 
359
(define (trunc n)
 
360
  (inexact->exact (truncate n))
 
361
)
 
362
 
 
363
(define verbose
 
364
  (lambda n
 
365
    (if (or (null? n) (not (number? (car n))))
 
366
      0
 
367
      (car n)
 
368
    )
 
369
  )
 
370
)