brv00

brv00

;; FF13-2 時の迷宮：時計盤の針のソルバ

(define (solve! vec)
  (define len (vector-length vec))
  (call/cc (lambda (k)
             (define (try cnt i ans)
               (if (<= cnt 0)
                   (k (reverse ans))
		   (let* ((di (vector-ref vec i))
			  (next1 (modulo (+ di i) len)) (next2 (modulo (- i di) len)))

brv00

;; Simple Scheme(http://bryanchadwick.com/simplescheme)でパスカルの三角形

(define (slide-double lis)
  (let ((x (cons 0 lis)) (y (append lis '(0))))
    (build-list (length x) (lambda (i) (+ (list-ref x i) (list-ref y i))))))

(define (mod-map lis n) (map (lambda (x) (% x n)) lis))

(define colors '("black" "white" "red" "green" "yellow" "blue" "brown" "purple"
                 "pink" "orange" "gray"))

brv00

(define max-ndigits 8)

(define (i/% x y)
  (let ((q (/ x y)) (r (% x y))) (if (< r 0) (list (-- q) (+ r y)) (list q r))))
(define (get-padding xs n) (build-list (max 0 (- n (length xs))) (lambda (_) 0)))
(define (trim xs n) (take (append xs (get-padding xs n)) n))
(define (drop0s xs) (if (and (cons? xs) (= (car xs) 0)) (drop0s (cdr xs)) xs))

(define-struct num (sign i f)) (define plus "") (define minus "-")
(define (mul-signs-of x y) (if (string=? (num-sign x) (num-sign y)) plus minus))

brv00

(define (i/% x y)
  (let ((q (/ x y)) (r (% x y))) (if (< r 0) (list (-- q) (+ r y)) (list q r))))

(define (map2 f l1 l2)
  (build-list (length l1) (lambda (i) (f (list-ref l1 i) (list-ref l2 i)))))

(define (lop op xs ys)
  (foldr (lambda (x ds) (append (i/% (+ x (car ds)) 10) (cdr ds)))
         '(0) (map2 op xs ys)))

brv00

; Calculator for Simple Scheme
(define (assoc k al) (car (filter (lambda (x) (string=? k (car x))) al)))

(define button-labels
  '("%"  "7" "8" "9" "÷" "MR"
    "√"  "4" "5" "6" "×" "M-"
    "C"  "1" "2" "3" "-" "M+"
    "AC" "0" "." "=" "+"))

(define width (image-width (empty-scene)))

brv00

最初のダンジョンの2つめの部屋 1
最初のダンジョンの長い上り階段の途中 2
マサンの村左上の列の真ん中の家  	3
ほこらの滝内アスラルの隣		4
ほこらの滝の入口近くの階段		5
マサンの村の像の頭に乗る		6
マサン、グミ、沼地の神殿の分かれ道	7
グミの村の青い布のかかった家のベッド	8
ファラ救出前の宝箱			9
グミの村の村長の家（沼地の神殿後）	10

brv00

(interpret
 '(define (generalized-fold knull1? kar1 kdr1 glist1 kons2 knil2)
    (define (lp glist1 glist2)
      (if (knull1? glist1) glist2
          (lp (kdr1 glist1) (kons2 (kar1 glist1) glist2))))
    (lp glist1 knil2)))

(interpret '(define next! #f))
(interpret '(define terminate! #f))
(interpret '(define %escape #f))

brv00

; JScheme でファイルの循環参照をCっぽく防ぐマクロ

(define-macro (ifdef tag . body)
  `(if (,.isDefined ',tag)
       (begin . ,body)))

(define-macro (ifndef tag . body)
  `(or (,.isDefined ',tag)
       (begin . ,body)))

brv00

; 平方根と立方根を任意の精度で近似する簡単な（FFT とか使わない）プログラム
;
; JScheme 用
; ただし使用している JScheme 固有の機能は整数リテラルの接尾辞の L のみ。

; srfi
(define (drop-while pred lis)
  (if (and (pair? lis) (pred (car lis))) (drop-while pred (cdr lis)) lis))

; 多倍長計算（比較と四則演算のうち必要なもの）