(require (lib "math.ss")) ; for \scheme{pi}

;; Construct paths for a 630 x 630 logo

(define left-lambda-path
  (let ([p (new dc-path%)])
    (send p move-to 153 44)
    (send p line-to 161.5 60)
    (send p curve-to 202.5 49 230 42 245 61)
    (send p curve-to 280.06 105.41 287.5 141 296.5 186)
    (send p curve-to 301.12 209.08 299.11 223.38 293.96 244)
    (send p curve-to 281.34 294.54 259.18 331.61 233.5 375)
    (send p curve-to 198.21 434.63 164.68 505.6 125.5 564)
    (send p line-to 135 572)
    p))

(define left-logo-path
  (let ([p (new dc-path%)])
    (send p append left-lambda-path)
    (send p arc 0 0 630 630 (* 235/360 2 pi) (* 121/360 2 pi) #f)
    p))

(define bottom-lambda-path
  (let ([p (new dc-path%)])
    (send p move-to 135 572)
    (send p line-to 188.5 564)
    (send p curve-to 208.5 517 230.91 465.21 251 420)
    (send p curve-to 267 384 278.5 348 296.5 312)
    (send p curve-to 301.01 302.98 318 258 329 274)
    (send p curve-to 338.89 288.39 351 314 358 332)
    (send p curve-to 377.28 381.58 395.57 429.61 414 477)
    (send p curve-to 428 513 436.5 540 449.5 573)
    (send p line-to 465 580)
    (send p line-to 529 545)
    p))

(define bottom-logo-path
  (let ([p (new dc-path%)])
    (send p append bottom-lambda-path)
    (send p arc 0 0 630 630 (* 314/360 2 pi) (* 235/360 2 pi) #f)
    p))

(define right-lambda-path
  (let ([p (new dc-path%)])
    (send p move-to 153 44)
    (send p curve-to 192.21 30.69 233.21 14.23 275 20)
    (send p curve-to 328.6 27.4 350.23 103.08 364 151)
    (send p curve-to 378.75 202.32 400.5 244 418 294)
    (send p curve-to 446.56 375.6 494.5 456 530.5 537)
    (send p line-to 529 545)
    p))

(define right-logo-path
  (let ([p (new dc-path%)])
    (send p append right-lambda-path)
    (send p arc 0 0 630 630 (* 314/360 2 pi) (* 121/360 2 pi) #t)    
    p))

(define lambda-path
  (let ([p (new dc-path%)])
    (send p append left-lambda-path)
    (send p append bottom-lambda-path)
    (send p append right-lambda-path)
    p))

;; This function draws the paths with suitable colors:
(define (paint-plt dc)
  ;; Paint white lambda, no outline:
  (send dc set-pen "black" 0 'transparent)
  (send dc set-brush "white" 'solid)
  (send dc draw-path lambda-path)
  ;; Paint outline and colors...
  (send dc set-pen "black" 0 'solid)
  ;; Draw red regions
  (send dc set-brush "red" 'solid)
  (send dc draw-path left-logo-path)
  (send dc draw-path bottom-logo-path)
  ;; Draw blue region
  (send dc set-brush "blue" 'solid)
  (send dc draw-path right-logo-path))

;; Create a frame to display the logo on a light-purple background:
(define f (new frame% [label "PLT Logo"]))
(define c
  (new canvas% 
       [parent f]
       [paint-callback (lambda (c dc)
			 (send dc set-background (make-object color% 220 200 255))
			 (send dc clear)
			 (send dc set-smoothing 'smoothed)
			 (send dc set-origin 5 5)
			 (send dc set-scale 0.5 0.5)
			 (paint-plt dc))]))
(send c min-client-width (/ 650 2))
(send c min-client-height (/ 650 2))
(send f show #t)