Schemeon.jsを作ったのもずいぶん前

なんと7年前になってしまいました。
JavaScriptだけで動作するSCHEMEインタプリタ、SCHEMEON.js
Javascriptで動くSchemeインタプリタですが、
ウェブページ内にJavascriptの代わりにSchemeでスクリプトをかけるところがミソだったりします。
この時以来、何かプログラムとか組んだかなぁと思い返してみると、
何も作ってないんですよね。
作る気力もなかったというか。

それはそうと

Schemeスクリプトでマインスイーパが動くページがあります。
SCHEMEON.js : mine sweeper
ソースを見ていただければわかりますが、マインスイーパをSchemeで書いています。
個人的にはお気に入りだったりします。
以下ソース。

	(define Math (javascript "Math"))
	
	(define rows (document.getElementById "rows"))
	(define cols (document.getElementById "cols"))
	(define norows 0)
	(define nocols 0)
	
	(define bombs 0)
	(define bombs-opened 0)
	(define count-opened 0)
	(define count-flagged 0)
	
	(define (read-bombs vec r c d)
		(if (and (<= 0 r) (<= 0 c) (< r norows) (< c nocols))
			(vector-ref (vector-ref vec r) c)
			d))

	(define (count-bombs r c)
		(+ (read-bombs bombs (- r 1) (- c 1) 0) (read-bombs bombs (- r 1) c 0) (read-bombs bombs (- r 1) (+ c 1) 0)
		   (read-bombs bombs r (- c 1) 0) (read-bombs bombs r (+ c 1) 0)
		   (read-bombs bombs (+ r 1) (- c 1) 0) (read-bombs bombs (+ r 1) c 0) (read-bombs bombs (+ r 1) (+ c 1) 0)))
	
	(define (set-bombs vec r c t)
		(let ((cols (vector-ref vec r)))
			(vector-set! cols c t)))

	(define (set-specified-bombs)
		(let* ((b (document.getElementById "bombs"))
		       (n (read-string b.value)))
		    (if (or (< n 0) (> n (* norows nocols)))
		    	(window.alert "爆弾の数が不正ですよ")
				(do ((i 0 (+ i 1)))
					((= i n) 0)
					(let loop ((row (Math.floor (* (Math.random) norows))) (col (Math.floor (* (Math.random) nocols))))
						(if (= (read-bombs bombs row col 0) 1) 
						    (loop (Math.floor (* (Math.random) norows)) (Math.floor (* (Math.random) nocols)))
						    (set-bombs bombs row col 1)))))))
	
	(define (refresh-table e)
		(let ((tbl 0) (table 0) (tbody 0) (tr 0) (td 0) (str 0) (btn 0))
			(set! count-opened 0)
			(set! count-flagged 0)
			(set! norows (string->number rows.value))
			(set! nocols (string->number cols.value))
			(set! bombs (make-vector norows 0))
			(set! bombs-opened (make-vector norows 0))
			(set! tbl (document.getElementById "tbl"))
			(if (tbl.hasChildNodes) (tbl.removeChild tbl.firstChild))
			(set! table (document.createElement "table"))
			(set! tbody (document.createElement "tbody"))
			(do ((i 0 (+ i 1)))
			    ((= i norows))
		        (vector-set! bombs i (make-vector nocols 0))
		        (vector-set! bombs-opened i (make-vector nocols #f))
			    (set! tr (document.createElement "tr"))
			    (do ((j 0 (+ j 1)))
			        ((= j nocols))
			        (set! str (string-append (->string i) "," (->string j)))
			        (set! btn (document.createElement "input"))
			        (btn.setAttribute "type" "button")
			        (btn.setAttribute "value" "")
			        (btn.setAttribute "id" str)
			        (set! btn.style.width "20px")
			        (set! btn.style.height "20px")
			        (let* ((btnid str) (row i) (col j)
			               (push (lambda (e) (push-main btnid row col))))
			              (add-event btn "click" push))
			        (set! td (document.createElement "td"))
			        (set! td.style.borderStyle "solid")
			        (set! td.style.borderWidth "1px")
			        (set! td.style.width "30px")
			        (set! td.style.height "30px")
			        (set! td.style.textAlign "center")
			        (set! td.style.verticalAlign "middle")
			        (td.setAttribute "id" (string-append "d" str))
			        (td.appendChild btn)
			        (tr.appendChild td))
			    (tbody.appendChild tr))
			(table.appendChild tbody)
			(tbl.appendChild table))
			(set-specified-bombs))
	
	
	(define (push-main btnid row col)
		(let ((btn (document.getElementById btnid))
		      (str 0))
			(if flag.checked
				(if (string=? btn.value "")
					(begin
						(set! btn.value "♪")
						(set! count-flagged (+ count-flagged 1))
						(check-all-flagged))
					(begin 
						(set! btn.value "")
						(set! count-flagged (- count-flagged 1))))
			    (let ((td (document.getElementById (string-append "d" btnid))))
			    	(if (not (read-bombs bombs-opened row col #f))
			    	    (let ((bombq (read-bombs bombs row col 0)))
			    	    	(if (= bombq 1)
			    	    		(let ((txt (document.createTextNode "●")))
			    	    			(td.removeChild td.firstChild)
			    	    			(td.appendChild txt)
			    	    			(bombed)
			    	    			(window.alert "BOMB!"))
			    	    		(open row col))))))))
	(define (open r c)
		(if (and (<= 0 r) (<= 0 c) (< r norows) (< c nocols))
			(if (and (eq? (read-bombs bombs-opened r c #f) #f) (= (read-bombs bombs r c 0) 0))
				(let ((txt (document.createTextNode (->string (count-bombs r c))))
					(td (document.getElementById (string-append "d" (->string r) "," (->string c)))))
					(td.removeChild td.firstChild)
					(td.appendChild txt)
					(set-bombs bombs-opened r c #t)
					(set! count-opened (+ count-opened 1))
					(open r (- c 1)) (open r (+ c 1)) (open (- r 1) c) (open r (+ c 1))
					(check-all-flagged)))))
			
	(define (bombed)
		(do ((r 0 (+ r 1)))
			((= r norows))
			(do ((c 0 (+ c 1)))
				((= c nocols))
				(let ((b (read-bombs bombs r c 0)))
					(if (= b 1)
						(let ((td (document.getElementById (string-append "d" (->string r) "," (->string c))))
							  (txt (document.createTextNode "●")))
							(td.removeChild td.firstChild)
							(td.appendChild txt)))))))

	(define (check-all-flagged)
		(if (= (+ count-flagged count-opened) (* norows nocols))
			(window.alert "All Mines Swept!! Congratulations!!")))

	(define r (document.getElementById "r"))

	(add-event r "click" refresh-table)
	
	(define flag (document.getElementById "flag"))

	(refresh-table '())