brv00

brv00

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; IFSによるドラゴンカーブの描画。 (Simple Scheme)

(define top 2.0) (define bottom -1.0) (define left -1.0) (define right 2.0)

(define center-x (/ (image-width (empty-scene)) 2))
(define center-y (/ (* (image-height (empty-scene)) 65) 148))

(define mag
  (* 2 (min (/ center-x (- right left)) (/ center-y (- top bottom)))))

brv00

brv00

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Simple Scheme 用 Bézier 曲線描画手続き

(define (binomial-coefficients n)
  (if (= 0 n) '(1)
    (let* ((d1 (append (binomial-coefficients (-- n)) '(0))) (d2 (cons 0 d1)))
      (build-list (++ n) (lambda (i) (+ (list-ref d1 i) (list-ref d2 i)))))))

(define (add-bezier-curve scn xs ys color)
  (let* ((n (length xs)) (n-1 (-- n)) (cs (binomial-coefficients n-1))

brv00

;
; IFS (Simple Scheme 用)
;

;; C-曲線
(define top 1.2) (define bottom -1.0) (define left -1.5) (define right 1.5)
(define affine-transformations
  '(((1/2  1/2 -1/2 1/2) (-1/2 0))
    ((1/2 -1/2  1/2 1/2) ( 1/2 0))))

brv00

;
; swap (JScheme)
;

(use-module "elf/iterate.scm")

(define (%drf-h ptr)
  (values (lambda () (car ptr)) (lambda (val) (set-car! ptr val))))
(define (%drf-t ptr)
  (values (lambda () (cdr ptr)) (lambda (val) (set-cdr! ptr val))))

brv00

;; ファイステルネットワーク (JScheme)

(define-method (swap (x Long))
  (+ (>>> x 32) (<< x 32)))

(define-method (round (plain Long) f subkey)
  (^ plain (<< (f (& plain Integer.MAX_VALUE$) subkey) 32)))

(define-method (feistel (plain Long) f subkeys)
  (let lp ((p (round plain f (car subkeys))) (subkeys (cdr subkeys)))

brv00

;;; list constructors

(use-module "elf/iterate.scm")

(define (scanL xs how so-far)
  (foldL xs (lambda (x so-far)
              `(,(how x (car so-far)) . ,so-far))
         `(,so-far)))

brv00

(use-module "elf/util.scm") ; dotimes

(define (vector-swap! vec i1 i2) ; srfi-133
  (let ((t (vector-ref vec i1)))
    (vector-set! vec i1 (vector-ref vec i2))
    (vector-set! vec i2 t)))

;; ベクターをシャッフルする。
(define-method (random-shuffle! vec (r Random))
  (dotimes (i (vector-length vec)) (vector-swap! vec i (.nextInt r (+ i 1))))

brv00

(use-module "elf/util.scm")    ; dotimes
(use-module "elf/iterate.scm") ; map*
(use-module "https://gist.githubusercontent.com/brv00/0175bdf47dc70cf9e10d02e3c067cced/raw/035e31c0b28c3e75a3a052035d668488a43e8d7c/vector-util.scm")
;; またはこの URL をダウンロードして
;; この式を(use-module "/storage/emulated/0/Download/vector-util.scm")
;; のような式に置き換える。または、vector-copy の定義をコピペする。


(define (make-plug-board vec)
  (let* ((len (vector-length vec))