;; Logo Turtle Graphics implementation for Impromptu
;; Andrew R. Brown 2006 
;;
;; Users will need to use a hybrid Scheme/Logo syntax. All Impromptu Turtle Graphics
;; commands start with tg: In particular,
;; a) scheme's bracket syntax and basic function structures and style remain
;;    (even when using "tg:to" and "tg:make" rather than "define")
;;    (functions conclude with closing brackets, rather than with "end")
;; b) keywords with two parts are written with a hyturtle:pen, e.g., tg:pen-up
;; c) the "tg:repeat" syntax uses separate body statements rather than a list of them
;; d) math functions are still done with prefix notation
;; e) color commands, "tg:set-pc" and "tg:set-bg" take a list of r g b a values between 0 and 1
;; f) you can't use "tg:make" inside proceedures, use set! instead to update a variable's value 
;;
;; Other significant differences include:
;; a) there is no visible turtle
;; b) "tg:set-bg" does not change tg:background colour until "tg:clear-screen"  or "tg:clear" is called 


(define canvas-width 600)
(define canvas-height 600)
(define turtle:canvas (gfx:make-canvas canvas-width canvas-height))

(define turtle:position (cons (/ canvas-width 2) (/ canvas-height 2)))
(define turtle:direction 90)
(define turtle:pen #t)
(define turtle:pen-color '(0 0 0 1))
(define turtle:bg-color '(1 1 1 1))

(gfx:clear-canvas (now) turtle:canvas turtle:bg-color)

(define tg:forward
   (lambda (distance)
      (let* ((ang (* (/ turtle:direction 360) (acos -1) 2))
             (x (+ (car turtle:position) (* (cos ang) distance)))
             (y (+ (cdr turtle:position) (* (sin ang) distance))))
         (if turtle:pen (gfx:draw-path (now) turtle:canvas (gfx:make-line (car turtle:position) (cdr turtle:position) x y) turtle:pen-color '()))
         (set-car! turtle:position x)
         (set-cdr! turtle:position y))
      turtle:position))

(define tg:back
   (lambda (distance)
      (set! turtle:direction (- turtle:direction 180))
      (tg:forward distance)
      (set! turtle:direction (+ turtle:direction 180))
      turtle:position))

(define tg:right
   (lambda (degrees)
      (set! turtle:direction (- turtle:direction degrees))
      turtle:direction))

(define tg:left
   (lambda (degrees)
      (set! turtle:direction (+ turtle:direction degrees))
      turtle:direction))

(define tg:pen-up
   (lambda ()
      (set! turtle:pen #f)))

(define tg:pen-down
   (lambda ()
      (set! turtle:pen #t)))

(define tg:home
   (lambda ()
      (if turtle:pen (begin (gfx:draw-path (now) 
                                turtle:canvas 
                                (gfx:make-line (car turtle:position) (cdr turtle:position)
                                             (/ canvas-width 2) (/ canvas-height 2))
                                turtle:pen-color '())
                     (set-car! turtle:position (/ canvas-width 2))
                     (set-cdr! turtle:position (/ canvas-height 2))))))

(define tg:clear
   (lambda ()
      (gfx:clear-canvas (now) turtle:canvas turtle:bg-color)))
   

(define tg:clear-screen
   (lambda ()
      (gfx:clear-canvas (now) turtle:canvas turtle:bg-color)
      (set-car! turtle:position (/ canvas-width 2))
      (set-cdr! turtle:position (/ canvas-height 2))
      (set! turtle:direction 90)))

(define tg:set-pc
   (lambda (red green blue alpha)
      (set! turtle:pen-color (list red green blue alpha))))

(define tg:set-bg
   (lambda (red green blue alpha)
      (set! turtle:bg-color (list red green blue alpha))))

(define tg:set-x
   (lambda (distance)
      (if turtle:pen (gfx:draw-path (now) turtle:canvas 
                         (gfx:make-line (car turtle:position) (cdr turtle:position)
                                      (+ (car turtle:position) distance) (cdr turtle:position))
                         turtle:pen-color '()))
      (set-car! turtle:position (+ (car turtle:position) distance))))

(define tg:get-x
   (lambda ()
      (car turtle:position)))

(define tg:set-y
   (lambda (distance)
      (if turtle:pen (gfx:draw-path (now) turtle:canvas 
                         (gfx:make-line (car turtle:position) (cdr turtle:position)
                                      (car turtle:position) (+ (cdr turtle:position) distance))
                         turtle:pen-color '()))
      (set-cdr! turtle:position (+ (cdr turtle:position) distance))))

(define tg:get-y
   (lambda ()
      (cdr turtle:position)))

(define tg:set-pos
   (lambda (x-distance y-distance)
      (if turtle:pen (gfx:draw-path (now) turtle:canvas 
                         (gfx:make-line (car turtle:position) (cdr turtle:position)
                                      (+ (car turtle:position) x-distance) (+ (cdr turtle:position) y-distance))
                         turtle:pen-color '()))
      (set-car! turtle:position (+ (car turtle:position) x-distance))
      (set-cdr! turtle:position (+ (cdr turtle:position) y-distance))))

(macro (tg:repeat args)
   `(let loop ((i ,(cadr args)))
       ,@(cddr args)
       (if (> i 1) (loop (- i 1)))))

(macro (tg:make args)
   `(define ,@(cdr args)))

(macro (tg:to args)
   `(define ,@(cdr args)))

(define tg:first car)

(define tg:but-first cdr)

(define tg:last
   (lambda (lst)
      (car (reverse lst))))

(define tg:but-last
   (lambda (lst)
      (reverse (cdr (reverse lst)))))

(define tg:count length)

(define tg:item
   (lambda (index lst)
      (list-ref lst (- index 1))))

(define tg:l-put
   (lambda (obj lst)
      (reverse (cons obj (reverse lst)))))