Welcome to the CHICKEN Scheme pasting service

(import (scheme base)
        (scheme write)
        (scheme cxr)
        (scheme inexact)
        (srfi 1)
        (srfi 27)
        (srfi 132)) 
        

(define (point-x pt) (car pt))
(define (point-y pt) (cadr pt))

(define (point= pt1 pt2)
   (and (= (point-x pt1) (point-x pt2))
        (= (point-y pt1) (point-y pt2))))

(define (point< pt1 pt2)
  (cond ((< (point-y pt1) (point-y pt2))
         #t)
        ((= (point-y pt1) (point-y pt2))
         (< (point-x pt1) (point-x pt2)))
        (else #f)))

(define (angle< pt0 pt1 pt2)
   (let* ((dx1 (- (point-x pt1) (point-x pt0)))
          (dy1 (- (point-y pt1) (point-y pt0)))
          (dx2 (- (point-x pt2) (point-x pt0)))
          (dy2 (- (point-y pt2) (point-y pt0)))
          (a1 (sqrt (+ (* dx1 dx1) (* dy1 dy1)))) 
          (a2 (sqrt (+ (* dx2 dx2) (* dy2 dy2)))) 
          (ca1 (/ dx1 a1))
          (ca2 (/ dx2 a2))) 
      (> ca1 ca2)))
          

(define (random-points n max-x max-y)
  (let loop ((i n)
             (res (list)))
      (if (<= i 0)
          res
	  (loop (- i 1) 
                (let ((new-point (list (random-integer max-x)
                                       (random-integer max-y))))
                   (cons new-point res))))))

(define (find-lowest-y pts)
  (if (null? pts)
      #f 
      (foldl (lambda (pt1 pt2) (if (point< pt1 pt2) pt1 pt2))
             (car pts)
             (cdr pts))))

(define (point-orientation pt1 pt2 pt3)
  (let* ((dx21 (- (point-x pt2) (point-x pt1))) 
         (dy21 (- (point-y pt2) (point-y pt1))) 
         (dx31 (- (point-x pt3) (point-x pt1))) 
         (dy31 (- (point-y pt3) (point-y pt1))) 
         (t (- (* dx21 dy31) (* dx31 dy21))))
     (cond ((negative? t) 'right)
           ((zero? t) 'collinear)
           (else 'left))))

(define (graham-scan pts1)
  (if (< (length pts1) 4)
      #f
      (let* ((pt0 (find-lowest-y pts1))
             (pts (list-sort (lambda (pt1 pt2) (angle< pt0 pt1 pt2))
                             (filter (lambda (pt) (not (point= pt pt0)))
                                     pts1))))
         (let sloop ((hull (list (car pts) pt0))
                     (pts2 (cdr pts)))
             (cond ((null? pts2)
                    hull)
                   ((< (length hull) 2)
                    (sloop (cons (car pts2) hull)
                           (cdr pts2)))
                   (else
                    (let ((o (point-orientation (cadr hull) 
                                                (car hull) 
                                                (car pts2))))
                      (if (eq? o 'left)
                          (sloop (cons (car pts2) hull)
                                 (cdr pts2))
                          (sloop (cdr hull) pts2)))))))))


(define (main)
  (random-source-randomize! default-random-source)
  (let* ((pts1 (random-points 200 320 200)) 
         (ch (graham-scan pts1))
         (header "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>
<svg xmlns=\"http://www.w3.org/2000/svg\"
  version=\"1.1\" baseProfile=\"full\"
  width=\"420px\" height=\"300px\"
  viewBox=\"0 0 420 300\">")
         (trailer "</svg>"))
      (display header) (newline)
      (for-each (lambda (pt)
                   (display "<circle cx=\"")
                   (display (point-x pt))
                   (display "\" cy=\"")
                   (display (point-y pt))
                   (display "\" r=\"5\" />")
                   (newline))
                pts1)
      (display "<polyline points=\"")
      (for-each (lambda (pt)
                   (display (point-x pt))
                   (display ",")
                   (display (point-y pt))
                   (display " "))
                (append ch (list (car ch))))
      (display "\" stroke=\"black\" fill=\"none\" />")
      (newline)
      (display trailer)
      (newline)))
                
(main)