;; 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)))))