Logo

#lang racket

;;
;; Implement the most basic of logo functionality for:
;;   http://programmingpraxis.com/2012/01/03/turtle-graphics/
;;

(require racket/gui
         racket/draw)

(struct pos (x y) #:prefab)
(struct context (pos heading canvas) #:prefab #:mutable)
(define *ctx* (context (pos 0 0) 0 #f))

(define no-pen (new pen% [style 'transparent]))
(define black-pen (new pen% [color "black"] [width 2]))


(define (penup)
  (send (send (context-canvas *ctx*) get-dc) set-pen no-pen))

(define (pendown)
  (send (send (context-dc *ctx*) get-dc) set-pen black-pen))

(define (setheading h)
  (set-context-heading! *ctx* h))

(define (setpos x y)
  (set-context-pos! *ctx* (pos x y)))

(define (clearscreen)
  (unless (context-frame *ctx*)
    (let* ([f (new frame% [label "Logo Output"])]
           [c (new canvas% [parent f] [min-width 400] [min-height 500]
                   [paint-callback (lambda (c dc)

                                     )])])
      (set-context-canvas! *ctx*)
      (send f show #t)))
  (send (context-dc *ctx*) clear)
  (penup)
  (setheading 0)
  (setpos (/ (send (context-frame *ctx*) get-width) 2)
          (/ (send (context-frame *ctx*) get-height) 2)))