#lang typed/scheme
;; 2htdp/image
(provide (all-defined-out)
         mode? Mode
         x-place? X-Place
         y-place? Y-Place
         pen-style? Pen-Style
         pen-cap? Pen-Cap
         pen-join? Pen-Join)

(require (planet cce/scheme:7/planet)
         (this-package-in 2htdp/private/type)) 
 
(require/typed mrlib/image-core 
               [opaque Pen pen?])
(require/typed lang/posn
               [opaque Posn posn?])
(require/typed 2htdp/image
               [opaque Image image?]
               [opaque Color color?]
                              
               ;; Given type cannot be converted to a contract.
               #;[circle (case-lambda (Real Mode Image-Color -> Image)
                                      (Real Outline-Mode (U Pen Image-Color) -> Image))]
               [circle (Real Mode (U Pen Image-Color) -> Image)]               
               [ellipse (Real Real Mode (U Pen Image-Color) -> Image)]
               [triangle (Real Mode (U Pen Image-Color) -> Image)]
               [right-triangle (Real Real Mode (U Pen Image-Color) -> Image)]
               [isosceles-triangle (Real Angle Mode (U Pen Image-Color) -> Image)]
               [square (Real Mode (U Pen Image-Color) -> Image)]
               [rectangle (Real Real Mode (U Pen Image-Color) -> Image)]
               [rhombus (Real Angle Mode (U Pen Image-Color) -> Image)]
               [regular-polygon (Real Nat Mode (U Pen Image-Color) -> Image)]
               [star (Real Mode (U Pen Image-Color) -> Image)]
               [star-polygon (Real Nat Nat Mode (U Pen Image-Color) -> Image)]
               [polygon ([Listof Posn] Mode (U Pen Image-Color) -> Image)]
               [line (Real Real Image-Color -> Image)]
               [add-line (Image Real Real Real Real (U Pen Image-Color) -> Image)]
               [add-curve (Image Real Real Angle Real Real Real Angle Real (U Pen Image-Color) -> Image)]
               [text (String Integer Image-Color -> Image)]
               [text/font (String Exact-Positive-Integer Image-Color (Option String) 
                                  (U 'default 'decorative 'roman 'script 'swiss 'modern 'symbol 'system)
                                  (U 'normal 'italic 'slant)
                                  (U 'normal 'bold 'light)
                                  Any
                                  -> Image)]
               #;[bitmap ...]
               [overlay (Image Image Image * -> Image)]
               [overlay/align (X-Place Y-Place Image Image Image * -> Image)]
               [overlay/xy (Image Real Real Image -> Image)]               
               [underlay (Image Image Image * -> Image)]
               [underlay/align (X-Place Y-Place Image Image Image * -> Image)]
               [underlay/xy (Image Real Real Image -> Image)]
               [beside (Image Image Image * -> Image)]
               [beside/align (Y-Place Image Image Image * -> Image)]
               [above (Image Image Image * -> Image)]
               [above/align (X-Place Image Image Image * -> Image)]
               [empty-scene (Real Real -> Image)]
               [place-image (Image Real Real Image -> Image)]
               [place-image/align (Image Real Real X-Place Y-Place Image -> Image)]
               [scene+line (Image Real Real Real Real (U Pen Image-Color) -> Image)]
               [scene+curve (Image Real Real Angle Real Real Real Angle Real (U Pen Image-Color) -> Image)]
               [rotate (Angle Image -> Image)]
               [scale (Real Image -> Image)]
               [scale/xy (Real Real Image -> Image)]
               [crop (Real Real Real Real Image -> Image)]
               [frame (Image -> Image)]
               [image-width (Image -> Nat)]
               [image-height (Image -> Nat)]
               [image-baseline (Image -> Nat)]               
               ;[mode? (Any -> Boolean)]
               ;; Some of these should be re-implemented so they work as predicates.
               #;[image-color? (Any -> Boolean)]
               [make-color (Nat Nat Nat -> Color)]
               [color-red (Color -> Nat)]
               [color-green (Color -> Nat)]
               [color-blue (Color -> Nat)]
               #;[y-place? (Any -> Boolean)]
               #;[x-place? (Any -> Boolean)]
               [angle? (Any -> Boolean)]
               [side-count? (Any -> Boolean)]
               [make-pen (Image-Color Real Pen-Style Pen-Cap Pen-Join -> Pen)]
               [pen-color (Pen -> Image-Color)]
               [pen-width (Pen -> Real)]
               [pen-style (Pen -> Pen-Style)]
               [pen-cap (Pen -> Pen-Cap)]
               [pen-join (Pen -> Pen-Join)]
               #;[pen-style? (Any -> Boolean)]
               #;[pen-cap? (Any -> Boolean)]
               #;[pen-join? (Any -> Boolean)]
               #;[save-image (Image String -> Boolean)])

(define-type-alias Nat Exact-Nonnegative-Integer)

(define-predicate image-color? Image-Color)
(define-type-alias Image-Color (U Color Symbol String)) 
; could be more precise than Symbol and String by enumerating.

(define-type-alias Angle Real)


  

;;======================================================================
;; Image utilities

;; Creates an image of 0 height and given width.
(: hspace (Real -> Image))
(define (hspace size)
  (rectangle size 0 'solid 'red))

;; Creates an image of 0 width and given height.
(: vspace (Real -> Image))
(define (vspace size)
  (rectangle 0 size 'solid 'red))

;; Image ... -> Image
;; Extension of above to zero- and un-ary case.
(: above0 (Image * -> Image))
(define (above0 . is)
  (cond [(empty? is) (hspace 0)]
        [(empty? (rest is)) (first is)]
        [else (apply above is)]))

;; Image ... -> Image
;; Extension of beside to zero- and un-ary case.
(: beside0 (Image * -> Image))
(define (beside0 . is)
  (cond [(empty? is) (hspace 0)]
        [(empty? (rest is)) (first is)]
        [else (apply beside is)]))

(: beside/align0 (Y-Place Image * -> Image))
(define (beside/align0 s . is)
  (cond [(empty? is) (hspace 0)]
        [(empty? (rest is)) (first is)]
        [else (apply beside/align s is)]))