(module plt-scheme-create mzscheme
  
  (require (lib "class.ss")
           (lib "mred.ss" "mred")
           (lib "math.ss")) ; for pi
  
  ;; Construct paths for a 630 x 630 logo
  (define w-default (make-parameter 630))
  (define h-default (make-parameter 630))
  
  (define left-lambda-path ;; left side of the lambda
    (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 ;; left side of the lambda plus left part of circle
    (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 ;; the lambda by itself (no circle)
    (let ([p (new dc-path%)])
      (send p append left-lambda-path)
      (send p append bottom-lambda-path)
      (let ([t (make-object dc-path%)])
        (send t append right-lambda-path)
        (send t reverse)
        (send p append t))
      (send p close)
      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))
  
 
  ;; This generates a file in the given path with the specified w and h containing the PLT Logo in a white background.
  (define (generate-plt-scheme-logo path w h)
    (let ([ps-setup (new ps-setup%)]
          [scale-value-w (/ w (w-default))]
          [scale-value-h (/ h (h-default))])
      
      ;; Setup PS file
      (send ps-setup set-file (string->path path))
      (send ps-setup set-level-2 #t)
      (send ps-setup set-mode 'file)
      (current-ps-setup ps-setup)
      
      (let ([dc (new post-script-dc% (interactive #f))])
        ;; Setup drawing context
        (send dc start-doc "")
        (send dc start-page)
        (send dc set-background (make-object color% 255 255 255))
        (send dc clear)
        (send dc set-smoothing 'smoothed)
        (send dc set-origin 5 5)
        (send dc set-scale scale-value-w scale-value-h)
        (paint-plt dc)
        (send dc end-page)
        (send dc end-doc)))) 
  
  (provide generate-plt-scheme-logo))