95 lines
2.0 KiB
Plaintext
Executable File
95 lines
2.0 KiB
Plaintext
Executable File
#!/usr/bin/newlisp
|
|
|
|
(println)
|
|
(println "Testing FOOP")
|
|
|
|
; changed for v10.2 (v10.1.8 and after)
|
|
; oroginally by Cormullion and Michael (Froum)
|
|
|
|
(define (complex:complex (r 0) (i 0))
|
|
(list complex r i))
|
|
|
|
(define (complex:rad)
|
|
(let (re (self 1) im (self 2))
|
|
(sqrt (add (mul re re) (mul im im)))))
|
|
|
|
(define (complex:theta)
|
|
(atan (div (self 1) (self 2))))
|
|
|
|
(define (complex:add b)
|
|
(complex (add (self 1) (b 1)) (add (self 2) (b 2))))
|
|
|
|
(define (complex:mul b)
|
|
(let (a.re (self 1) a.im (self 2)
|
|
b.re (b 1) b.im (b 2))
|
|
(complex
|
|
(sub (mul a.re b.re) (mul a.im b.im))
|
|
(add (mul a.re b.im) (mul a.im b.re)) )))
|
|
|
|
(define (complex:square)
|
|
(:mul (self) (self)))
|
|
|
|
|
|
(define (draw)
|
|
(for (y -1 1.1 0.07)
|
|
(for (x -2 1 0.03)
|
|
(set 'z (complex x y) 'c 126 'a z )
|
|
(while (and (< (abs (:rad (set 'z (:add (:mul z z) a)))) 2) (> (dec c) 32)) )
|
|
(print (char c))
|
|
)
|
|
(println)))
|
|
|
|
(println (time (draw) ) "ms")
|
|
|
|
;;;;;;;;;;;;;;;;;;; check FOOP self in nested FOOP functions ;;;;;;;;;;;;
|
|
|
|
|
|
(new Class 'A)
|
|
(new Class 'B)
|
|
|
|
(setq a (A 0 (B 0)))
|
|
|
|
(define (B:m str)
|
|
(inc (self 1)) )
|
|
|
|
(define (A:m str)
|
|
(inc (self 1)))
|
|
|
|
(define (A:qa1)
|
|
(:m (self) (:m (self 2) " hello"))
|
|
(self))
|
|
|
|
(define (A:qa2)
|
|
(:m (self 2) (:m (self) " hello"))
|
|
(self))
|
|
|
|
(if (and
|
|
(= (:qa1 a) '(A 1 (B 1)))
|
|
(= (:qa2 a) '(A 2 (B 2))))
|
|
(println ">>>>> FOOP nested 'self' tested SUCCCESSFUL")
|
|
(println ">>>>> PROBLEM in nested 'self'")
|
|
)
|
|
|
|
; make sure a FOOP object contained in a protected symbol,
|
|
; cannot be modified
|
|
|
|
(new Class 'Circle)
|
|
|
|
(define (Circle:move dx)
|
|
(inc (self 1) dx) )
|
|
|
|
;(set 'myc (Circle 1 2))
|
|
;(:move myc 10)
|
|
|
|
(constant 'myc (list (Circle 1 2) (Circle 4 5)))
|
|
|
|
(if (catch (:move (myc 0) 10 ) 'result)
|
|
(println ">>>>> ERROR in FOOP symbol protection")
|
|
(if (starts-with result "ERR: symbol is protected : MAIN:container of (self)")
|
|
(println ">>>>> FOOP symbol protection SUCCESSFUL")
|
|
(println ">>>>> ERROR in FOOP symbol protection")))
|
|
|
|
(exit)
|
|
|
|
;; eof
|