;; Turtle-Grafik

(require-library "gui.ss" "gui")

(define make-type
  (lambda (name)
    name))

(define typed-value-packer
  (lambda (type)
    (lambda (value)
      (cons type value))))

(define typed-value-unpacker
  (lambda (type)
    (lambda (value)
      (if (equal? type (car value))
          (cdr value)
          (error "type mismatch")))))

(define turtle-type (make-type 'turtle))

(define make-turtle
  (let ((construct (typed-value-packer turtle-type)))
    (lambda (canvas x y)
      (construct (cons (cons canvas (cons 0.0 (cons x y)))
		       (cons #t black))))))

(define turtle-data (typed-value-unpacker turtle-type))

(define turtle-down?
  (lambda (turtle)
    (car (cdr (turtle-data turtle)))))

(define set-turtle-down?!
  (lambda (turtle down?)
    (set-car! (cdr (turtle-data turtle)) down?)))

(define turtle-angle
  (lambda (turtle)
    (car (cdr (car (turtle-data turtle))))))

(define turtle-set-angle!
  (lambda (turtle angle)
    (set-car! (cdr (car (turtle-data turtle))) angle)))

(define turtle-x
  (lambda (turtle)
    (car (cdr (cdr (car (turtle-data turtle)))))))

(define turtle-y
  (lambda (turtle)
    (cdr (cdr (cdr (car (turtle-data turtle)))))))

(define turtle-set-x!
  (lambda (turtle x)
    (set-car! (cdr (cdr (car (turtle-data turtle)))) x)))

(define turtle-set-y!
  (lambda (turtle y)
    (set-cdr! (cdr (cdr (car (turtle-data turtle)))) y)))

(define turtle-color
  (lambda (turtle)
    (cdr (cdr (turtle-data turtle)))))

(define set-turtle-color!
  (lambda (turtle color)
    (set-cdr! (cdr (turtle-data turtle)) color)))

(define turtle-down!
  (lambda (turtle)
    (set-turtle-down?! turtle #t)))

(define turtle-up!
  (lambda (turtle)
    (set-turtle-down?! turtle #f)))

(define turtle-forward!
  (lambda (turtle distance)
    (let ((old-x (turtle-x turtle))
	  (old-y (turtle-y turtle))
	  (angle (turtle-angle turtle)))
      (let ((new-x (+ old-x (* distance (cos angle))))
	    (new-y (+ old-y (* distance (sin angle)))))
	(turtle-set-x! turtle new-x)
	(turtle-set-y! turtle new-y)
	(if (turtle-down? turtle)
	    (draw-line canvas
                       old-x old-y
		       new-x new-y
		       (turtle-color turtle)))))))

(define turtle-backward!
  (lambda (turtle distance)
    (turtle-forward! turtle (- distance))))

(define turtle-turn-right!
  (lambda (turtle angle-offset)
    (turtle-set-angle! turtle
		       (+ (turtle-angle turtle)
			  angle-offset))))

(define turtle-turn-left!
  (lambda (turtle angle-offset)
    (turtle-turn-right! turtle (- angle-offset))))

(define pi 3.14159265)

(define degrees
  (lambda (degrees)
    (/ (* degrees 2 pi) 360.0)))