PasteRack.org
Paste # 62817
2018-04-18 17:04:13

Fork as a new paste.

Paste viewed 482 times.


Embed:

Usage example of DSL for creating gnuplot-based animations

  1. #lang racket
  2.  
  3. (require "lib/plot3.rkt")
  4. (require "lib/ec.rkt")
  5.  
  6. (define t:fade-in> '0s)
  7. (define t:<fade-in '1s)
  8. (define t:ecp-in> '3s)
  9. (define t:<ecp-in '4s)
  10. (define t:ecp-grey> '6s)
  11. (define t:<ecp-grey '7s)
  12. (define t:point-pre '(9s 19s 23s 29s 31s 33s 35s 39s))
  13. (define t:arrow-pre '(17s 21s 27s 29s 31s 33s 37s 47s))
  14. (define t:flash> '40s)
  15. (define t:flash>> '41s)
  16. (define t:<<flash '42s)
  17. (define t:<flash '43s)
  18. (define t:fade-out> '66s)
  19. (define t:<fade-out '67s)
  20. (define t:total '68s)
  21.  
  22. (define ecp-set-fname "ecp.data")
  23.  
  24. (gen-video
  25.  (#:name "video-mul2"
  26.   #:mencoder #t
  27.   #:create #t)
  28.  
  29.  (define torus (gen-torus-grid P))
  30.  (define EC/GFP (ec:weierstrass-simple A B (math:finite-field 23)))
  31.  
  32.  (define G (ec:point 5 5))
  33.  (define G-group (send EC/GFP generate G))
  34.  (define G-group+ (append G-group (list (car G-group))))
  35.  (define group
  36.    (for/list ((x G-group)
  37.               (y (cdr G-group+))
  38.               (i 8))
  39.      (define j (add1 i))
  40.      (define-values (xx yy)
  41.        (ec:point-pair->vec3-pair x y P))
  42.      (define startgap (ec:point-gap x))
  43.      (define endgap (ec:point-gap y))
  44.      (define startf (any->frame (list-ref t:point-pre i)))
  45.      (define arrstartf (any->frame (list-ref t:arrow-pre i)))
  46.      (list
  47.       xx ; 0
  48.       (ec:label-vec3 x) ; 1
  49.       (ec:point->label x j) ; 2
  50.  
  51.       ; 3
  52.       (make-arrow/uvw
  53.        xx yy
  54.        #:tag (~a "arr" j)
  55.        #:color (make-color tr-orange ((+ arrstartf 0) 0.0 (+ arrstartf 25) 1.0) t:alpha)
  56.        #:color/back (make-color tr-orange-soft ((+ arrstartf 0) 0.0 (+ arrstartf 25) 1.0) t:alpha)
  57.        #:start-frame (+ arrstartf 0)
  58.        #:end-frame (+ arrstartf 50)
  59.        #:hide-frame 2000
  60.        #:start-gap startgap
  61.        #:end-gap endgap
  62.        #:head-size 0.5)
  63.  
  64.       ; lbl-lc
  65.       (make-color tr-black (startf 0.0 (+ startf 25) 1.0 (+ startf 50) 0.5)
  66.                   t:alpha) ; 4
  67.  
  68.       ; pt-lc, pt-lc/back // 5,6
  69.       (make-color tr-orange
  70.                   (startf 0.0 (+ startf 25) 1.0)
  71.                   t:alpha)
  72.       (make-color tr-orange-soft
  73.                   (startf 0.0 (+ startf 25) 1.0)
  74.                   t:alpha)
  75.  
  76.       ; sign, 7
  77.       (if (> i 0)
  78.           (~a j "P")
  79.           " P")
  80.  
  81.       ; sign color, rect, 8, 9
  82.       (make-color tr-black (startf 0.0 (+ startf 25) 1.0) t:alpha)
  83.       (make-color ((+ startf 25) tr-orange (+ startf 50) tr-grey-soft)
  84.                   (startf 0.0 (+ startf 25) 1.0) t:alpha)
  85.  
  86.       ; pos, 10
  87.       (cons 155 (+ 670 (* 50 i)))
  88.       )))
  89.  
  90.  (gen-frames
  91.   (#:num-frames (any->frame t:total)
  92.    #:frame-offset 1000
  93.    #:force #f)
  94.  
  95.   (setup-3d
  96.    #:angle (λ (x) (+ 60 x))
  97.    #:slant 60)
  98.   (tr-rect)
  99.  
  100.   (invisible-torus)
  101.  
  102.   (splot-file ecp-set-fname #:pt 7 #:ps 2 #:lc t:ecp-lc
  103.               #:lc/back t:ecp-lc/back #:title "")
  104.  
  105.   (for ((ptdef group))
  106.     (define pt (car ptdef))
  107.     (define lpt (cadr ptdef))
  108.     (define lbl (caddr ptdef))
  109.     (define arr (cadddr ptdef))
  110.     (define lbl-lc (list-ref ptdef 4))
  111.     (define pt-lc (list-ref ptdef 5))
  112.     (define pt-lc/back (list-ref ptdef 6))
  113.     (define tx (list-ref ptdef 7))
  114.     (define tlblc (list-ref ptdef 8))
  115.     (define tlblr (list-ref ptdef 9))
  116.     (define pos (list-ref ptdef 10))
  117.     (point/uvw pt #:color pt-lc #:color/back pt-lc/back)
  118.     (label/uvw lpt lbl #:color lbl-lc)
  119.     (run-animator arr)
  120.     (label/screen pos
  121.                   tx "=[" (car pt) "," (cadr pt) "]"
  122.                   #:align 'left #:rect tlblr
  123.                   #:color tlblc))
  124.     (splot-list torus t:alpha)
  125.  
  126.     )
  127.  
  128.  )

=>