July 24, 2024
KALEIDOSCOPE is a small program demonstating real-time capabilities of PCSCHEME. It was originally written for PCSCHEME3.03 and used dirty graphics primitives that one should avoid at all costs. We hope this code sample will support the move toward a more humane graphics interface... (define (kald) (define accel-range nil) (define accel-adj nil) (define wh nil) (define mi nil) (define ycenter-offset 25) (define m1 nil) (define xv1 nil) (define xv2 nil) (define yv1 nil) (define yv2 nil)
(define (quit-kald) (close-graph) (gc) *the-non-printing-object*)
(define (loop a n color x1 y1 x2 y2) (define (ln dx1 dy1 dx2 dy2) (line (cons (+ wh dx1 dx1) (+ mi ycenter-offset dy1)) (cons (+ wh dx2 dx2) (+ mi ycenter-offset dy2)))) (cond ((positive? a) (set-color color) (ln x1 y1 x2 y2) (ln (- x1) y1 (- x2) y2) (ln x1 (- y1) x2 (- y2)) (ln (- x1) (- y1) (- x2) (- y2)) (ln y1 x1 y2 x2) (ln (- y1) x1 (- y2) x2) (ln y1 (- x1) y2 (- x2)) (ln (- y1) (- x1) (- y2) (- x2)) (if (positive? n) (loop (- a 1) (- n 1) color (remainder (+ x1 xv1) m1) (remainder (+ y1 yv1) m1) (remainder (+ x2 xv2) m1) (remainder (+ y2 yv2) m1)) (restart))) ((not (char-ready?)) (set! xv1 (- (random accel-range) accel-adj)) (set! yv1 (- (random accel-range) accel-adj)) (set! xv2 (- (random accel-range) accel-adj)) (set! yv2 (- (random accel-range) accel-adj)) (loop (random 10) n (+ (random (get-max-color)) 1) x1 y1 x2 y2)) ((eq? (char-upcase (read-char)) '#) (quit-kald)) (else (restart))))
(define (restart) (if (eqv? (get-driver-name) "") (init-graph) (clear-device)) (set! wh (quotient (car (get-max-xy)) 2)) (set! mi (- (quotient (cdr (get-max-xy)) 2) 50)) (set! m1 (1+ mi)) (set! accel-range (quotient wh 29)) (set! accel-adj (quotient wh 64)) (randomize 0) (loop 0 (+ 50 (random 200)) 1 (+ (random mi) 1) (+ (random mi) 1) (+ (random mi) 1) (+ (random mi) 1)))
(flush-input) (restart))
(display "Kaleidoskope loaded. Call (KALD) to start.") (newline) (display "Use then Q to quit or any key to recycle") (newline)