teachpacks/first-order-image.rkt
#lang racket

#|

File: teachpack/image.rkt
Author: Bill Turtle (wrturtle)

Provide a wrapper to the image.ss teachpack used by htdp.

NOTE WELL: Structures that this teachpack defines (images, pens, etc)
           SHOULD support "dot-style" field lookup. This functionality
           is provided in semantics.rkt, via the `pyret-do-lookup' function.

|#

(require (prefix-in img: "image.rkt"))
(require "../semantics/first-order.rkt")

;; Basic images
(make-first-order-and-provide [circle img:circle circle]
                              [ellipse img:ellipse ellipse]
                              [line img:line line]
                              [add_line img:add_line add_line]
                              [add_curve img:add_curve add_curve]
                              [text img:text text]
                              [text_font img:text_font text_font])
(provide (rename-out [img:empty_image empty_image]))

;; Polygons
(make-first-order-and-provide [triangle img:triangle triangle]
                              [right_triangle img:right_triangle right_triangle]
                              [isosceles_triangle img:isosceles-triangle isosceles_triangle]
                              [triangle_sss img:triangle_sss triangle_sss]
                              [triangle_ass img:triangle_ass triangle_ass]
                              [triangle_sas img:triangle_sas triangle_sas]
                              [triangle_ssa img:triangle_ssa triangle_ssa]
                              [triangle_aas img:triangle_aas triangle_aas]
                              [triangle_asa img:triangle_asa triangle_asa]
                              [triangle_saa img:triangle_saa triangle_saa]
                              [square img:square square]
                              [rectangle img:rectangle rectangle]
                              [rhombus img:rhombus rhombus]
                              [star img:star star]
                              [star_polygon img:star_polygon star_polygon]
                              [radial_star img:radial_star radial-star]
                              [regular_polygon img:regular_polygon regular_polygon]
                              [polygon img:polygon polygon])

;; Overlaying images
(make-first-order-and-provide [overlay img:overlay overlay]
                              [overlay_align img:overlay_align overlay_align]
                              [overlay_offset img:overlay_offset overlay_offset]
                              [overlay_align_offset img:overlay_align_offset overlay_align_offset]
                              [overlay_xy img:overlay_xy overlay_xy]
                              [underlay img:underlay underlay]
                              [underlay_align img:underlay_align underlay_align]
                              [underlay_offset img:underlay_offset underlay_offset]
                              [underlay_align_offset img:underlay_align_offset underlay_align_offset]
                              [underlay_xy img:underlay_xy underlay_xy]
                              [beside img:beside beside]
                              [beside_align img:beside_align beside_align]
                              [above img:above above]
                              [above_align img:above_align above_align])
                              
;; Placing images & scenes
(make-first-order-and-provide [empty_scene img:empty_scene empty_scene]
                              [place_image img:place_image place_image]
                              [place_image_align img:place_image_align place_image_align]
                              [scene_plus_line img:scene_plus_line scene_plus_line]
                              [scene_plus_curve img:scene_plus_curve scene_plus_curve])

;; Rotating, scaling, flipping, cropping, and framing images
(make-first-order-and-provide [rotate img:rotate rotate]
                              [scale img:scale scale]
                              [scale_xy img:scale_xy scale_xy]
                              [flip_horizontal img:flip_horizontal flip_horizontal]
                              [flip_vertical img:flip_vertical flip_vertical]
                              [crop img:crop crop]
                              [frame img:frame frame])

;; Bitmaps
(make-first-order-and-provide [bitmap_url bitmap_url bitmap_url]
                              [bitmap_file bitmap_file bitmap_file]
                              [image_to_color_list image_to_color-list image_to_color_list]
                              [color_list_to_bitmap color_list_to_bitmap color_list_to_bitmap]
                              [freeze freeze freeze])

;; Image properties
(make-first-order-and-provide [image_height img:image_height image_height]
                              [image_width img:image_width image_width]
                              [image_baseline img:image_baseline image_baseline])


;; Image predicates
(make-first-order-and-provide [is_mode img:is_mode is_mode]
                              [is_image_color img:is_image_color is_image_color]
                              [color img:color color]
                              [is_color img:is_color is_color]
                              [is_y_place img:is_y_place is_y_place]
                              [is_x_place img:is_x_place is_x_place]
                              [is_angle img:is_angle is_angle]
                              [is_side_count img:is_side_count is_side_count]
                              [is_step_count img:is_step_count is_step_count]
                              [is_real_valued_posn img:is_real_valued_posn is_real_valued_posn]
                              [pen img:pen pen]
                              [is_pen img:is_pen is_pen]
                              [is_pen_style img:is_pen_style is_pen_style]
                              [is_pen_cap img:is_pen_cap is_pen_cap]
                              [is_pen_join img:is_pen_join is_pen_join]
                              [image_equal img:image_equal image_equal])
                              
;; Pinholes
(make-first-order-and-provide [put_pinhole put_pinhole put_pinhole]
                              [pinhole_x img:pinhole_x pinhole_x]
                              [pinhole_y img:pinhole_y pinhole_y]
                              [clear_pinhole img:clear_pinhole clear_pinhole]
                              [overlay_pinhole img:overlay_pinhole overlay_pinhole]
                              [underlay_pinhole img:underlay_pinhole underlay_pinhole])

 
;; Exporting images to disk
(make-first-order-and-provide [save_image img:save_image save_image]
                              [save_scaled_image img:save_scaled_image save_scaled_image]
                              [save_svg_image img:save_svg_image save_svg_image]
                              [same_scaled_svg_image img:save_scaled_svg_image save_scaled_svg_image])