private/image.ss
#lang typed/scheme
(provide (all-defined-out))

;;======================================================================
;; typed/2htdp/image

(require/typed 2htdp/image
               [opaque Image image?]
               [rectangle (Real Real Mode Color -> Image)]
               [square (Real Mode Color -> Image)]
               [circle (Real Mode Color -> Image)]
               [isosceles-triangle (Real Angle Mode Color -> Image)]
               [overlay (Image Image -> Image)]
               [overlay/align (X-Place Y-Place Image Image -> Image)]
               [overlay/xy (Image Real Real Image -> Image)]
               [above (Image Image Image * -> Image)]
               [beside (Image Image Image * -> Image)]
               [beside/align (Y-Place Image Image Image * -> Image)]
               [rotate (Angle Image -> Image)]
               [place-image (Image Real Real Image -> Image)]
               [text (String Integer Color -> Image)])

(define-type-alias Color Symbol) ; Could be more precise.
(define-type-alias Angle Real)

(define-type-alias Mode 
  (U 'solid 'outline "solid" "outline"))
(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"))

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