#lang racket

; We just want to foward a few particular bindings,
; for bsl programs to use.
; (The student languages don't allow `only-in`,
; and requiring the entire library gives a conflict.)

(require (only-in racket/gui play-sound image-snip%)
         racket/draw)

(provide play-sound
         file-exists?
         let
         let*
         letrec
         ellipse/arc
         module+
         tweak
         struct     ; Allows inheritance:
                    ; When using this, include args `#:transparent` and possibly `#:consructor-name make-...` ).
                    ; WARNING: in student-level, (struct foo (...)) objects always print as `make-foo` even though
                    ;    the actual constructor-name is just `foo`.
         )




#| To use `ellipse/arc` from another file, put this file in the same directory,
   and in that file add `(require "student-extras.rkt")`.
   Note that you should *not* cut/paste this into a blank beginner-student tab;
   just download this file and put it into the same directory.
 |#

#| ; Usage example:
(require "student-extras.rkt")

(struct soup (a b) #:transparent)
(define make-soup soup) ; We can bind the traditional name to the *actual* constructor.

(make-soup 2 3)

(struct hotsoup soup (c d e) #:transparent)  ; inherit `soup`s fields.
(hotsoup 2 3 4 5 6) ; N.B. this prints as `make-hotsoup`, in beginner-student.

|#

; ellipse/arc : 
; Meant to complement `ellipse` from (lib 2htdp/image).
; Return the arc of an ellipse, from θ1 to θ2 (in degrees); 0 is 3o'clock, 90 is noon. 
;   w : (and/c real? (not/c negative?))
;   h : (and/c real? (not/c negative?))
;   θ1 : real?
;   θ2 : real?
;   mode : (or/c (one-of 'transparent "transparent" 'solid "solid") natural-number/c) 
;   color : (or/c string? symbol?)
; Report bugs to ibarland@radford.edu
; BUG: the bounding box of the image w x h, instead of its drawable size.
;      (But maybe not; this would put the "center" in a hard-to-predict place,
;       for other overlay operations.)
;
(define (ellipse/arc w h θ1 θ2 mode color)
  (define img (make-bitmap w h))
  (define img-dc (new bitmap-dc% [bitmap img]))

  (define color-str (tweak color symbol? symbol->string))
  (define the-color (make-object color% color-str))
  (define mode-sym  (tweak mode string? (compose string->symbol string-downcase)))
  (define mode-sym-num (tweak mode-sym 'solid 255)) ; any number represents a (faded) solid
  
  ; Now, set the brush or pen, depending on whether we are outline or solid:
  ;
  (cond [(eq? mode-sym-num 'outline) (send img-dc set-brush the-color 'transparent)
                                     (send img-dc set-pen the-color 0 'solid)]
        [(natural-number/c mode-sym-num)
         (define faded-color (make-color (send the-color red)
                                         (send the-color green) 
                                         (send the-color blue)
                                         (/ mode-sym-num 255)))
         (send img-dc set-brush faded-color 'solid)
         (send img-dc set-pen faded-color 0 'transparent)]
        [else (raise-type-error 'ellipse/arc "(or/c 'solid 'outline (in-range 256))" mode)])
  
  ; Finally, call the underling 'draw-arc', and turn the result into a snip:
  (send img-dc draw-arc 0 0 w h  (deg->rad θ1) (deg->rad θ2))
  (make-object image-snip% img))



; deg->rad : real -> real
; Convert an angle in degrees, to radians.
;
(define (deg->rad θ) (* θ RAD_PER_DEG)) 
(define RAD_PER_DEG (/ 1 (/ 360 2 pi)))

; tweak : α (or/f (α -> boolean) α) (or/f (α -> β) β) -> β
; val : α  The value to return, w/ possible tweaking.
; pred-or-val : (or/f (α -> boolean) α)  The predicate to evaluate on `val`, or
;   the value to compare `val` against.  True indicates it should be modified.
; modifier-or-val : (or/f (α -> β) β)  If `val` is to be tweaked,
;   return this function applied to `val`, or just return modifier-or-val.
;
(define (tweak val pred-or-target-val modifier-or-new-val)
  (define real-pred? (if (procedure? pred-or-target-val)
                         pred-or-target-val
                         (λ(v) (equal? v pred-or-target-val))))
  (if (real-pred? val)
      (if (procedure? modifier-or-new-val)
          (modifier-or-new-val val) 
          modifier-or-new-val)
      val))



(module+ test
  (require rackunit)
  (define tol 0.00000001)
  (check-= (deg->rad 180) pi tol)
  (check-= (deg->rad 180) pi tol)
  
  (check-equal? (tweak 7 even? sqr) 7)
  (check-equal? (tweak 6 even? sqr) 36)
  (check-equal? (tweak 7 even? 19) 7)
  (check-equal? (tweak 6 even? 19) 19)
  (check-equal? (tweak 7 6     19) 7)
  (check-equal? (tweak 6 6     19) 19)
  (check-equal? (tweak 7 6     sqr) 7)
  (check-equal? (tweak 6 6     sqr) 36)

  (define target (make-bitmap 300 100))

  (define the-dc (new bitmap-dc% [bitmap target]))
  (send the-dc set-pen "orange" 0 'transparent)
  (send the-dc set-brush "orange" 'solid)
  
  (send the-dc draw-arc
        0 0
        200 100
        0 pi)
  
  (define img (make-object image-snip% target))
  
  (require (only-in 2htdp/image frame scale image-width))
  ;(frame (make-object image-snip% target))
  (define k 100000)
  (define tiny (scale (/ 1 k) img))
  (define again (scale k tiny))
  
  ; img
  ;(image=? img (ellipse/arc 200 100 0 180 "solid" "orange"))
)