#lang typed/scheme
;; 2htdp/image
(provide (all-defined-out))

(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-type-alias Image-Color (U Color Symbol String)) 
; could be more precise than Symbol and String by enumerating.
(define-type-alias Angle Real)

(define-type-alias Outline-Mode
  (U 'outline "outline"))
(define-type-alias Mode 
  (U 'solid "solid" Outline-Mode))
(define-type-alias X-Place 
  (U 'left 'right 'middle 'center 
     "left" "right" "middle" "center"))
(define-type-alias Y-Place 
  (U 'top 'bottom 'middle 'center 'baseline 
     "top" "bottom" "middle" "center" "baseline"))

(define-type-alias Pen-Style
  (U "solid" 'solid "dot" 'dot "long-dash" 'long-dash
     "short-dash" 'short-dash "dot-dash" 'dot-dash))
(define-type-alias Pen-Cap
  (U "round" 'round "projecting" 'projecting "butt" 'butt))
(define-type-alias Pen-Join
  (U "round" 'round "bevel" 'bevel "miter" 'miter))
  

;;======================================================================
;; 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)]))