Clojure Какие интересные концепции есть в Лиспе?

defn f (i) (cond (< i 2) 1 (* i (f (- i 1))))
OK
defn g (i a) (cond (< i 2) a (g (- i 1) (* i a)))
OK
tray f 3
  1 <- (f 3)
    2 <- f
    2 -> (lambda (i) (cond (< i 2) 1 (* i (f (- i 1)))))
    2 <- (cond (< i 2) 1 (* i (f (- i 1))))
      3 <- (< i 2)
        4 <- i
        4 -> 3
      3 -> false
      3 <- (* i (f (- i 1)))
        4 <- i
        4 -> 3
        4 <- (f (- i 1))
          5 <- f
          5 -> (lambda (i) (cond (< i 2) 1 (* i (f (- i 1)))))
          5 <- (- i 1)
            6 <- i
            6 -> 3
          5 -> 2
          5 <- (cond (< i 2) 1 (* i (f (- i 1))))
            6 <- (< i 2)
              7 <- i
              7 -> 2
            6 -> false
            6 <- (* i (f (- i 1)))
              7 <- i
              7 -> 2
              7 <- (f (- i 1))
                8 <- f
                8 -> (lambda (i) (cond (< i 2) 1 (* i (f (- i 1)))))
                8 <- (- i 1)
                  9 <- i
                  9 -> 2
                8 -> 1
                8 <- (cond (< i 2) 1 (* i (f (- i 1))))
                  9 <- (< i 2)
                    10 <- i
                    10 -> 1
                  9 -> true
                8 -> 1
              7 -> 1
            6 -> 2
          5 -> 2
        4 -> 2
      3 -> 6
    2 -> 6
  1 -> 6
6
tray g 3 1
  1 <- (g 3 1)
    2 <- g
    2 -> (lambda (i a) (cond (< i 2) a (g (- i 1) (* i a))))
    2 <- (cond (< i 2) a (g (- i 1) (* i a)))
      3 <- (< i 2)
        4 <- i
        4 -> 3
      3 -> false
      3 <- (g (- i 1) (* i a))
        4 <- g
        4 -> (lambda (i a) (cond (< i 2) a (g (- i 1) (* i a))))
        4 <- (- i 1)
          5 <- i
          5 -> 3
        4 -> 2
        4 <- (* i a)
          5 <- i
          5 -> 3
          5 <- a
          5 -> 1
        4 -> 3
      3 -> FUNCALL: {a=3, i=2}
    2 -> FUNCALL: {a=3, i=2}
    2 <- (cond (< i 2) a (g (- i 1) (* i a)))
      3 <- (< i 2)
        4 <- i
        4 -> 2
      3 -> false
      3 <- (g (- i 1) (* i a))
        4 <- g
        4 -> (lambda (i a) (cond (< i 2) a (g (- i 1) (* i a))))
        4 <- (- i 1)
          5 <- i
          5 -> 2
        4 -> 1
        4 <- (* i a)
          5 <- i
          5 -> 2
          5 <- a
          5 -> 3
        4 -> 6
      3 -> FUNCALL: {a=6, i=1}
    2 -> FUNCALL: {a=6, i=1}
    2 <- (cond (< i 2) a (g (- i 1) (* i a)))
      3 <- (< i 2)
        4 <- i
        4 -> 1
      3 -> true
      3 <- a
      3 -> 6
    2 -> 6
  1 -> 6
6

(def window-size 500)
(def image (java (class "java.awt.image.BufferedImage") "new" window-size window-size 1))
(def imageGraphics (java image "getGraphics"))
 
(defmacro v-s () (java (* window-size (java (class "java.lang.Math") "random")) "intValue"))
(defn random-line (p)
    (def x (v-s) y (v-s))
    (java imageGraphics "drawLine" (car p) (cadr p) x y)
    (cons x y))
(ntimes 50 random-line (cons (v-s) (v-s)))
 
(def icon (java (class "javax.swing.ImageIcon") "new"))
(java icon "setImage" image)
(def label (java (class "javax.swing.JLabel") "new"))
(java label "setIcon" icon)
(def labelComponent (java label "castComponent"))
 
(def window (java (class "javax.swing.JFrame") "new"))
(java window "add" labelComponent)
(java window "setVisible" true)
(java window "pack")

(defn demo (delta a b phi)
    (def image (java (class "java.awt.image.BufferedImage") "new" w-s w-s 1))
    (def imageGraphics (java image "getGraphics"))
    (defmacro p-x (alpha) (norm (sin (+ (* a alpha) phi))))
    (defmacro p-y (alpha) (norm (cos (* b alpha))))
 
    (defn next-line (args)
        (match args '(alpha x0 y0))
        (def x (p-x alpha) y (p-y alpha))
        (java imageGraphics "drawLine" x0 y0 x y)
        (cons (+ alpha delta) x y))
 
    (ntimes 500 next-line (cons 0 (p-x 0) (p-y 0)))
    (add-image window image))
 
(def window (java (class "javax.swing.JFrame") "new"))
(java window "setLayout" (java (class "java.awt.FlowLayout") "new"))
(demo 2.5 1 1 0)
(demo 2   2 1 0)
(demo 2   1 2 0.3)
(demo 1   1 3 0.5)
(demo 1   3 1 0.5)
(demo 0.6 3 2 0.5)
(java window "setVisible" true)
(java window "pack")

(defun main ()
  (iter (for parms in (list (list 2.5 1.0 1.0 0.0 _RED)
                            (list 2.0 2.0 1.0 0.0 _GREEN) 
                            (list 2.0 1.0 2.0 0.3 _BLUE) 
                            (list 1.0 1.0 3.0 0.5 _YELLOW) 
                            (list 1.0 3.0 1.0 0.5 _SILVER) 
                            (list 0.6 3.0 2.0 0.5 _NAVY)))
         (apply 'make-pic parms))
   (grwShowAll -1))
    
(defun make-pic (delta a b phi color)
  (let ((w (gensym 'w))
        (x-0 0)
        (y-0 0)
        (x-1 0)
        (y-1 0)
        (alpha 0))  
   (grwCreate w 300 300 "" _WHITE)
   (grwScale w -1.1 1.1 -1.1 1.1)
   (iter (for i from 1 to 400)
     (setq x-1 (sin (+ (* a alpha) phi))
           y-1 (cos (* b alpha)))
     (when (> i 1) (grwLine w x-0 y-0 x-1 y-1 color))
     (setq alpha (+ alpha delta) x-0 x-1 y-0 y-1))))

(defn tree (graph n x y d d0 l v i)
    (def x1 (round (+ x (* l (cos d)))) y1 (round (+ y (* l (sin d)))))
    (def p (java (class "java.awt.Polygon") "new"))
    (java p "addPoint" x y)
    (java p "addPoint" x1 y1)
    (def kl (/ l 5))
    (def x0 (round (- x (* kl (cos d0)))) y0 (round (- y (* kl (sin d0)))))
    (java p "addPoint" x0 y0)
    (java graph "setColor" BROWN)
    (java graph "fillPolygon" p)
    (java graph "drawPolygon" p)
    (cond (> n 0)
             ((defmacro delta () (* v (rand (/ pi 20) (/ pi 4.5))))
              (tree graph (- n 1) x1 y1 (- d (delta)) d (/ l 1.2) (- 0 v) i)
              (tree graph (- n 2) x1 y1 (+ d (delta)) d (/ l 1.2) (- 0 v) i))
             ((java graph "setColor" RED)
              (java graph "fillOval" (- x1 10) (- y1 10) 20 20)
              (cond (< (rnd) 0.7)
                    ((java graph "setColor" BLACK)
                     (java graph "fillOval" (- x1 2) (- y1 6) 4 4))) )))

;; Главная функция
 
(defun main (&optional (x-start 0)  (y-start -100))
  (let ((w (gensym 'w)))
    (grwCreate w 500 500 "Дерево" _WHITE)
    (grwSetParm w 2 0 _WHITE)
    (grwScale w -100 100 -100 100)
    (grwShow w)
    (tree w 8 x-start y-start (* 0.5 _pi) (* 0.3 _pi) 40 0.6)))
 
;; Дать случайный элемент списка
    
(defun random-value (&rest lst)
  (nth (mod (rnd 1000) (length lst)) lst))
 
;; Нарисовать треугольник
    
(defun draw-triangle (w x1 y1 x2 y2 x3 y3 color)
    (grwLine w x1 y1 x2 y2 color)
    (grwLine w x2 y2 x3 y3 color)
    (grwLine w x1 y1 x3 y3 color)
    (let* ((bx (/ (+ x1 x2 x3) 3.0))
           (by (/ (+ y1 y2 y3) 3.0)))
       (grwFill w  bx  by color color)))
 
;; Изобразить дерево
 
(defun tree (w n x y d d0 l v)
  (let* ((x1 (+ x (* l (cos d))))
         (y1 (+ y (* l (sin d))))
         (kl (/ l 5.0))
         (x0 (- x (* kl (cos d0))))         
         (y0 (- y (* kl (sin d0))))
         (delta (* v (random-value (/ _pi 3.0) (/ _pi 4.5)))))
        (draw-triangle w x y x0 y0 x1 y1 _BROWN)
        (cond ((plusp n)
                (tree w (- n 1) x1 y1 (- d delta) d (/ l 1.2) (- v))
                (tree w (- n 2) x1 y1 (+ d delta) d (/ l 1.2) v))
              (t (grwCircle w x1 y1 5 _RED)
                 (grwFill w x1 y1 _RED _RED)
                 (grwPset w x1 y1 _BLACK)))))

(defmacro rnd () (java (class "java.lang.Math") "random"))
(defmacro color (r g b) (java (class "java.awt.Color") "new" r g b))
 
(def  item-vars (java (class "java.util.HashMap") "new"))
 
(java item-vars "put" 0 '((0 -1) (0 0) (-1 -1) (-1 0)))
(java item-vars "put" 1 '((0 -1) (0 0) (-1 -1) (-1 0)))
(java item-vars "put" 2 '((0 -1) (0 0) (-1 -1) (-1 0)))
(java item-vars "put" 3 '((0 -1) (0 0) (-1 -1) (-1 0)))
 
(java item-vars "put" 10 '((0 -2) (0 -1) (0 0) (0 1)))
(java item-vars "put" 11 '((1 0) (0 0) (-1 0) (-2 0)))
(java item-vars "put" 12 '((0 -2) (0 -1) (0 0) (0 1)))
(java item-vars "put" 13 '((1 0) (0 0) (-1 0) (-2 0)))
 
(java item-vars "put" 20 '((-1 -1) (-1 0) (0 0) (0 1)))
(java item-vars "put" 21 '((1 0) (0 0) (0 1) (-1 1)))
(java item-vars "put" 22 '((-1 -1) (-1 0) (0 0) (0 1)))
(java item-vars "put" 23 '((1 0) (0 0) (0 1) (-1 1)))
 
(java item-vars "put" 30 '((0 -1) (0 0) (-1 0) (-1 1)))
(java item-vars "put" 31 '((-1 0) (0 0) (0 1) (1 1)))
(java item-vars "put" 32 '((0 -1) (0 0) (-1 0) (-1 1)))
(java item-vars "put" 33 '((-1 0) (0 0) (0 1) (1 1)))
 
(java item-vars "put" 40 '((0 -1) (0 0) (0 1) (-1 -1)))
(java item-vars "put" 41 '((1 0) (0 0) (-1 0) (-1 1)))
(java item-vars "put" 42 '((0 -1) (0 0) (0 1) (1 1)))
(java item-vars "put" 43 '((1 0) (0 0) (-1 0) (1 -1)))
 
(java item-vars "put" 50 '((0 -1) (0 0) (0 1) (-1 1)))
(java item-vars "put" 51 '((1 0) (0 0) (-1 0) (1 1)))
(java item-vars "put" 52 '((0 -1) (0 0) (0 1) (1 -1)))
(java item-vars "put" 53 '((1 0) (0 0) (-1 0) (-1 -1)))
 
(java item-vars "put" 60 '((0 -1) (0 0) (0 1) (-1 0)))
(java item-vars "put" 61 '((1 0) (0 0) (-1 0) (0 1)))
(java item-vars "put" 62 '((0 -1) (0 0) (0 1) (1 0)))
(java item-vars "put" 63 '((1 0) (0 0) (-1 0) (0 -1)))
 
(def BLACK (color 0 0 0))
(def WHITE (color 255 255 255))
 
(def  item-colors (java (class "java.util.HashMap") "new"))
(java item-colors "put" 0 (color 240 240 0))
(java item-colors "put" 1 (color 0 240 240))
(java item-colors "put" 2 (color 0 240 0))
(java item-colors "put" 3 (color 240 0 0))
(java item-colors "put" 4 (color 240 160 0))
(java item-colors "put" 5 (color 0 0 240))
(java item-colors "put" 6 (color 160 0 240))
 
(defn coords (i)
    (match i '(t o r c))
    (def coords-basic (java item-vars "get" (+ (* 10 t) o) ))
    (map (lambda (p) (cons (+ r (car p)) (+ c (cadr p)))) coords-basic))
 
(defn draw-coord (r c cur-color)
    (java imageGraphics "setColor" cur-color)
    (java imageGraphics "fillRect"
        (* c sq-size) (* (- rows r 1) sq-size) (- sq-size 1) (- sq-size 1)))
 
(defn draw-item (cur-color)
    (foldl (lambda (p a) (draw-coord (car p) (cadr p) cur-color)) 0 (coords item)))
 
(defn draw-field ()
    (java imageGraphics "clearRect" 0 0 image-width image-height)
    (foldl (lambda (x a) (match x '(r c cur-color)) (draw-coord r c cur-color)) 0 field))
 
(defn try-move (i)
    (defn good-coord (p)
        (def r (car p) c (cadr p))
        (cond (< c 0) false (>= c cols) false (< r 0) false
              (any (lambda (x) (and (= r (car x)) (= c (cadr x)) )) field) false true))
    (cond (all good-coord (coords i)) (
              (draw-item WHITE)
              (set! item i)
              (draw-item (java item-colors "get" (car item)))
              (java window "revalidate")
              (java window "repaint")
              true)
          false))
 
(defn compress-field ()
    (defn collect (e a)
        (def r (car e))
        (cond (null? a) (cons (cons r 1) nil)
              (eq? r (car (car a))) (cons (cons r (+ 1 (car (cdr (car a))))) (cdr a))
              (cons (car a) (collect e (cdr a))) ))
 
    (def full-rows (foldl
        (lambda (x a) (cond (< (cadr x) cols) a (cons (car x) a) ))
        nil (foldl collect nil field)))
 
    (defn low-f-rs-cnt (r) (foldl (lambda (x a) (cond (< x r) (+ 1 a) a)) 0 full-rows))
 
    (defn go (f a)
        (def e (car f) r (car e))
        (cond (null? f) a
              (elem r full-rows) (go (cdr f) a)
                  (go (cdr f) (cons (cons (- r (low-f-rs-cnt r)) (cdr e)) a)) ))
 
    (cond (null? full-rows) false ((set! field (go field nil)) true) ))
 
(defn user-input ()
    (def cmd (read))
    (match item '(t o r c))
    (cond (eq? cmd 'a) (try-move (cons t o r (- c 1)))
          (eq? cmd 'd) (try-move (cons t o r (+ c 1)))
          (eq? cmd 'q) (try-move (cons t (mod (+ o 1) 4) r c))
          (eq? cmd 'e) (try-move (cons t (mod (+ o 3) 4) r c))
          (eq? cmd 's) (fall-down)
          (eq? cmd 'p) (set! game-run false)
          (set! game-run true))
    (user-input))
 
(defn fall-down ()
    (match item '(t o r c))
    (cond (try-move (cons t o (- r 1) c)) (fall-down)))
 
(defn timer-thread ()
    (java (class "java.lang.Thread") "sleep" 1000)
    (match item '(t o r c))
    (cond game-run
        (cond (not (try-move (cons t o (- r 1) c))) (
            (set! field (foldl
                (lambda (p a) (cons (append p (java item-colors "get" (car item))) a))
                field (coords item)))
            (cond (compress-field) (draw-field))
            (set! item (cons (java (* 7 (rnd)) "intValue") 0 (- rows 1) (/ cols 2)))
            (cond (not (try-move item)) (set! game-run false))
            )))
    (timer-thread))
 
; main program ;
 
(def cols 10 rows 20 sq-size 30 field nil game-run false)
(def image-width (+ 1 (* cols sq-size)) image-height (+ 1 (* rows sq-size)))
 
(def image (java (class "java.awt.image.BufferedImage") "new" image-width image-height 1))
(def imageGraphics (java image "createGraphics"))
(java imageGraphics "setBackground" WHITE)
(java imageGraphics "clearRect" 0 0 image-width image-height)
 
(def item (cons (java (* 7 (rnd)) "intValue") 0 (- rows 1) (/ cols 2)))
(draw-item (java item-colors "get" (car item)))
 
(def window (java (class "javax.swing.JFrame") "new"))
(def icon (java (class "javax.swing.ImageIcon") "new"))
(java icon "setImage" image)
(def label (java (class "javax.swing.JLabel") "new"))
(java label "setIcon" icon)
(java window "add" label)
(java window "setVisible" true)
(java window "setAlwaysOnTop" true)
(java window "pack")
 
(timer-thread)
;
call if another thread :
(user-input)
;
"Game over."

; Прыгающие шарики, анимация. ;
; Задаем ширину / высоту окна, количество и максимальный радиус шариков ;
(defn bouncing-balls (w-width w-height n-balls r-ball-max)
 
    ; макросы, которым место в стандартной библиотеке ;
    (defmacro rnd () java (class "java.lang.Math") "random")
    (defmacro round (x) java x "intValue")
 
    ; смещает координату / скорость шарика по одной оси ;
    (defn move-dir (ball ind-x ind-dx x-max)
        (def x (java ball "get" ind-x)
            dx (java ball "get" ind-dx)
             r (java ball "get" 5)
             x-new (+ x dx) m (- x-max r))
        (java ball "put" ind-x  (cond (< x-new r) r (> x-new m) m x-new))
        (java ball "put" ind-dx (cond (<= r x-new m) dx (- 0 dx))) )
 
    ; смещает и отрисовывает шарик ;
    (defn move-draw (ball)
        (move-dir ball 0 1 w-width)
        (move-dir ball 2 3 w-height)
        (def x (java ball "get" 0)
             y (java ball "get" 2)
             r (java ball "get" 5) d (* 2 r))
        (java img-gr "setColor" (java ball "get" 4))
        (java img-gr "fillOval" (- (round x) r) (- (round y) r) d d) )
 
    ; добавляет уникальный шарик со своими координатами, скоростью и цветом;
    (defn add-new-ball ()
        (defn rnd-dx () (def v (+ (* v-max (rnd)) 1)) (cond (< (rnd) 0.5) v (- 0 v)) )
        (defn rnd-rgb () (round (* 200 (rnd)) ))
        (def color (java (class "java.awt.Color") "new" (rnd-rgb) (rnd-rgb) (rnd-rgb)))
        (def ball (java (class "java.util.HashMap") "new"))
        (java ball "put" 0 (/ w-width 2))
        (java ball "put" 1 (rnd-dx))
        (java ball "put" 2 (/ w-height 2))
        (java ball "put" 3 (rnd-dx))
        (java ball "put" 4 color)
        (java ball "put" 5 (+ (round (* (- r-ball-max 5) (rnd))) 5))
        (java balls "put" (+ (java balls "size") 1) ball))
 
    ; анимация - очистка экрана, смещение и отрисовка шариков, обновление окна, пауза ;
    (defn go () while true 
        (java img-gr "clearRect" 0 0 w-width w-height)
        (def n n-balls)
        (while (> n 0) (move-draw (java balls "get" n)) (set! n (- n 1)))
        (java window "repaint")
        (java (class "java.lang.Thread") "sleep" 30))
 
    ; параметры окна и графики, вызываются макросы стандартной библиотеки ;
    (def image (new-image w-width w-height))
    (def img-gr (new-imageGraphics image))
    (java img-gr "setBackground" (java (class "java.awt.Color") "new" 255 255 200))
    (def window (new-window "FlowLayout"))
    (add-image window image)
    (java window "setLocationByPlatform" true)
    (java window "setVisible" true)
    (java window "setAlwaysOnTop" true)
    (java window "setTitle" (java "Bouncing balls" "toString"))
    (java window "pack")
 
    (def balls (java (class "java.util.HashMap") "new"))
    (def v-max 7 n n-balls)
    (while (> n 0) (add-new-ball) (set! n (- n 1)))
    (go))
 
(bouncing-balls 500 400 100 30)

(setq jvmObj (jvm-get-or-create-object)
 
      FrameObj  (jvm-CreateFrame jvmObj ... )
 
      CanvasObj (jvm-get-Canvas jvmObj)
 
      CircleObj (jvm-AddCircle CanvasObj '(100 100) 20))
 
(jvm-put-Color CircleObj (jvm-GetTrueColor jvmObj '( 127 255 0)))
 
(jvm-MoveTo CircleObj '(150 150))