home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d09xx / d0963.lha / SIOD / scm / demo.scm < prev    next >
Text File  |  1993-10-01  |  2KB  |  43 lines
  1. (define (locate x y p)
  2.         (display #\ p) (display #\[ p) (display x p) (display #\; p) 
  3.                                     (display y p) (display #\H p))
  4.  
  5. (define (demo . size)
  6.         (define p (open-port "CON:0/0/640/200/The snake. (Control-C to stop)" "w" 0))
  7.         (define mem (make-vector 4 nil))
  8.         (define pos (make-vector 4 (cons (random 23) (random 75))))
  9.         (define tmp nil)
  10.         (define tmpmem nil)
  11.         (define tmppos nil)
  12.         (if (null? size)
  13.             (set! size 8)
  14.             (set! size (car size)))
  15.         (for i 0 (1+ i) (eq? i 4)
  16.              (vector-set! mem i (make-vector (1+ size) (cons (random 23) (random 75)))))
  17.         (cycle
  18.               (for i 0 (1+ i) (eq? i 4)
  19.                    (set! tmpmem (vector-ref mem i))
  20.                    (set! tmppos (vector-ref pos i))
  21.                    (when (and (eq? (car tmppos) 
  22.                                       (car (vector-ref tmpmem size)))
  23.                             (eq? (cdr tmppos) 
  24.                                  (cdr (vector-ref tmpmem size))))
  25.                          (vector-set! pos i (cons (random 23) (random 75)))
  26.                          (set! tmppos (vector-ref pos i)))
  27.                    (locate (car (vector-ref tmpmem 0))
  28.                            (cdr (vector-ref tmpmem 0)) p)
  29.                    (display #\space p)
  30.                    (for j 0 (1+ j) (eq? j size)
  31.                         (vector-set! tmpmem
  32.                                      j 
  33.                                      (vector-ref tmpmem (1+ j))))
  34.               (set! tmp (copy (vector-ref tmpmem size)))
  35.               (cond ((< (car tmp) (car tmppos)) (set-car! tmp (1+ (car tmp))))
  36.                     ((> (car tmp) (car tmppos)) (set-car! tmp (-1+ (car tmp)))))
  37.               (cond ((< (cdr tmp) (cdr tmppos)) (set-cdr! tmp (1+ (cdr tmp))))
  38.                     ((> (cdr tmp) (cdr tmppos)) (set-cdr! tmp (-1+ (cdr tmp)))))
  39.               (locate (car tmp)
  40.                       (cdr tmp) p)
  41.               (display #\* p)
  42.               (vector-set! tmpmem size tmp))))
  43.