procgen  Artifact [26ba00c622]

Artifact 26ba00c622886c50e8d99e16d4bb461569e90c7a8198b5a9e387a2af2693701f:


; prep the random number generator
(import (chicken random))
(set-pseudo-random-seed! (random-bytes))

; generates a (case) structure that randomly returns
; one of its branches at equal probability
(define-for-syntax (@one-of case-fn strs)
  ; attach a unique integer value to every item in the
  ; list, descending from (length strs) to 0
  (define (zip lst)
	; inefficient but fun(ctional) way
	(define (long-cons acc new)
	  (cons (cons (length acc) new) acc))
	(foldl long-cons '() lst)) 

  ; return the following list structure
  `(case (pseudo-random-integer ,(length strs))
	 ,@(map case-fn (zip strs))))

; create the case structure for rule expansion
(define-for-syntax (@rewrite-patterns patterns)
  (define (nest-case pair)
	(cons (list (car pair))
		  (cdr pair)))

  (define (wrap pat) 
	(if (eq? (cdr pat) '()) ;then
		pat
		; else
		(list (cons 'string-append pat))))

  (let ([branches (map wrap patterns)])
	(@one-of nest-case branches)))


; exports

	; randomly select and return one of its arguments at runtime
	(define-macro (one-of . strs)
				  (define (flat-case pair)
					(list (list (car pair))
						  (cdr pair)))
				  (@one-of flat-case strs))

	; generates a function that picks and applies one of the
	; patterns passed to it. inner patterns can be expanded
	; with the inner macro (@)
	(define-macro (rule . body)
				  (let ([decl (car body)]
						[patterns (cdr body)])
					`(define ,decl
					   (define-macro (@ . tree) (@rewrite-patterns tree)) ;choice point
					   (define-macro (: . tree) (@rewrite-patterns (cons (list "") tree))) ;optional choice
					   (define-macro (? . tree) (@rewrite-patterns (cons (list "") (list tree)))) ;optional - TODO: rewrite
					   ,(@rewrite-patterns patterns))))
	; generate simple word-banks
	(define-macro (bank . body)
				  (let ([decl (car body)]
						[patterns (cdr body)])
					`(define (,decl)
							 (one-of ,@patterns))))
	(define (pick ar)
		(vector-ref ar (pseudo-random-integer (vector-length ar))))