;;; Some graphics drawn in a SCIX window. Hakan Huss, KTH and Johan Ihren, KTH

;;; $Header: /nfs/deneb/src0/johani/scix-0.95/demo/RCS/graphic.sc,v 1.3 90/03/20 23:36:34 johani Exp $

(define (demo-graphic size method scr)
  (let ((cmap (scr 'default-colormap))
	(w (make-window size size (scr 'root-depth) 0 0 (scr 'root)
                        0 'CopyFromParent 'CopyFromParent scr))
	(gc (make-gc (make-gc-value-mask
		      `(line-width 1)
		      `(foreground ,(scr 'blackpixel))
		      `(background ,(scr 'whitepixel)) )
		     (scr 'root)))
	(terminate #f) )
    (w 'createwindow (make-window-value-mask
		      `(background-pixel ,(scr 'whitepixel))))
    (w 'changeproperty 'replace 'wm_name 'string 8 "SCIX Graphics")
    (w 'mapwindow)
    (scr 'flush!)
    (msg-handler 'mainloop
		 (lambda () terminate)
		 (list scr)
		 (lambda (event-handler) ; We really don't care about events.
		   (let oloop ((r 4))
		     (w 'cleararea  #t 0 0 size size)
		     (cond ((eq? method 'natural) (natural size w gc scr))
			   ((eq? method 'smart) (smart size w gc scr))
			   (else (format #t "Unknown method of drawing.~%")) )
;		     (draw size w gc scr)
		     (if (zero? r)
			 (begin
			   (gc 'freegc)
			   (w 'destroywindow)
			   (scr 'flush!) )
			 (oloop (- r 1)) ))))))

(define (draw size w gc scr)
  (let loop ((c size))
    (w 'draw (list (make-polysegment `((0 ,size ,c ,0)
				       (0 ,size ,size ,c)
				       (,size ,size 0 ,c)
				       (,size ,size ,c 0)
				       (0 0 ,size ,c)
				       (0 0 ,c ,size)
				       (,size 0 0 ,c)
				       (,size 0 ,c ,size) )))
       gc)
    (if (not (zero? c))
	(loop (- c 4))
	(scr 'flush!) )))

(define (natural size w gc scr)
  (let loop ((c size))
    (w 'draw (list (make-polyline 'origin `((0 ,c) (,c ,size)
						   (,size ,(- size c))
						   (,(- size c) 0)
						   (0 ,c) )))
       gc)
    (if (not (zero? c))
	(loop (- c 4))
	(scr 'flush!) )))

;;; Have to devise something to cope with too long point lists, though, ...
(define (smart size w gc scr)
  (let loop ((c size) (point-list '()))
    (if (positive? c)
	(loop (- c 4) (append point-list `((0 ,c) (,c ,size)
						  (,size ,(- size c))
						  (,(- size c) 0)
						  (0 ,c) )))
	(begin
	  (w 'draw (list (make-polyline 'origin point-list)) gc)
	  (scr 'flush!) ))))