File: SIOD-compat.scm

package info (click to toggle)
gimp 3.2.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky
  • size: 222,880 kB
  • sloc: ansic: 870,914; python: 10,965; lisp: 10,857; cpp: 7,355; perl: 4,536; sh: 1,753; xml: 972; yacc: 609; lex: 348; javascript: 150; makefile: 42
file content (139 lines) | stat: -rw-r--r-- 2,803 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
; Deprecated and should not be used in new scripts.
; GIMP developers strongly recommend you not use this file
; in scripts that you will distribute to other users.

; Mostly definitions from the ancient SIOD dialect of Scheme.

; These were deprecated in GIMP 2 and obsoleted in GIMP 3
; ScriptFu since v3 does not automatically load these definitions.

; This file is NOT automatically loaded by ScriptFu.
; A script can load this file at runtime like this:
;
; (define my-plug-in-run-func
;     (load (string-append
;              script-fu-sys-init-directory
;              DIR-SEPARATOR
;              "SIOD-compat.scm"))
;     ...
; )
;
; Note this puts the definitions in execution-scope, not global scope.
; They will affect all functions called.
; They can affect ScriptFu plugin scripts called.
; They will go out of scope when the run-func completes.

; *pi*, butlast, and cons-array symbols were deprecated in v2.
; They remain in v3, still deprecated.

; See also the companion file PDB-compat-v2.scm
; which defines aliases for obsolete PDB procedure names, from GIMP 2.


(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 (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)
    )
  )
)