Plaster
New
List
Login
common-lisp
default
scymtym
2024.03.07 13:27:45
(cl:defpackage #:animation (:use #:clim-lisp #:clim)) (cl:in-package #:animation) (defun render-frame-content (stream width height time) (clim:draw-rectangle* stream 1/2 1/2 (- width 1/2) (- height 1/2) :filled nil :ink clim:+gray40+) (let* ((width (- width 2)) (height (- height 2)) (cx (/ width 2)) (cy (/ width 2)) (r1 (* 3/8 width)) (r2 (* 1/5 width))) (clim:draw-rectangle* stream 0 0 (1+ width) (1+ height) :ink clim:+gray40+) (clim:draw-circle* stream cx cy cx :ink clim:+gray60+) (clim:with-translation (stream cx cy) (loop :for i :from 0 :below 16 :for v = (mod (+ (/ i 16) time) 1.0) :for w = (+ (/ i 16) (/ (* -.03 time) (* -2 pi)) -1/4) :for color = (clim:make-ihs-color (sqrt 3) v 1) :do (clim:with-translation (stream (* r1 (cos (* w 2 pi))) (* r1 (sin (* w 2 pi)))) (if (zerop i) (clim:draw-point* stream 0 0 :line-thickness 5 :ink color) (clim:with-rotation (stream (* (+ w .25) 2 pi)) (clim:draw-text* stream "λ" 0 0 :text-size r2 :align-x :center :align-y :center :transform-glyphs t :ink color))))) (clim:with-rotation (stream (* .1 time)) (clim:draw-text* stream "()" 0 0 :text-size (/ width 2) :align-x :center :align-y :center :transform-glyphs t :ink clim:+white+))) (clim:with-translation (stream 0 (- height 10)) (let* ((r 5) (x (* (- (/ width 2) r) (cos (* 10 time))))) (clim:draw-circle* stream (+ cx x) 0 r :ink clim:+blue+))))) (defun render-frame (frame-number size) (format *trace-output* "; Rendering frame ~4,D~%" frame-number) (let ((time (* 1/60 frame-number)) (filename (format nil "/tmp/frame-~4,'0D.png" frame-number))) (mcclim-raster-image:with-output-to-raster-image-file (stream filename :width size :height size) (render-frame-content stream size size time)))) (defun render-animation (&key (size 400)) (loop :for i :below 1000 :do (render-frame i size)) (uiop:run-program '("ffmpeg" "-i" "/tmp/frame-%4d.png" "/tmp/animation.mp4")))
Raw
Annotate
Repaste