











open Compatibility;;
open Types;;
open Default;;
open Exceptions;;
open Basic_types;;
open Font;;
open Fonts;;
open Colors;;
open Vrml_objects_pre;;
open Calc_3D;;
open Vrml_objects_post;;
open Positionables;;
open Geometrics;;
open Geometric_properties;;

(* Map a function with a val on all positionables of a vrml_object *)

(* mapp : 'a list -> ('a -> 'b -> 'c) -> 'b -> 'c list *)
let mapp positionables f valx =
    let rec rmap l =
        match l with
          [] -> []
        | p::tail -> 
             try ((f p valx)::(rmap tail)) with
               Failure _ -> rmap tail
    in
       rmap positionables
;;

(* map_obj :
   vrml_object -> (vrml_positionable -> 'a -> vrml_positionable) -> 'a
-> vrml_object *)
let map_obj obj f valx =
    new_vrml_object
       (mapp obj.objects f valx) obj.children
       obj.position obj.rotation obj.scale
       obj.frame obj.unique obj.anchor
       obj.billboard obj.collision 
;;

(* map_all :
   vrml_object -> (vrml_positionable -> 'a -> vrml_positionable) -> 'a
-> vrml_object *)
let rec map_all obj f valx =
    let rec rmap l =
        match l with
          [] -> []

        | o::tail -> (map_all o f valx)::(rmap tail)
    in
       new_vrml_object
          (mapp obj.objects f valx) (rmap obj.children)
          obj.position obj.rotation obj.scale
          obj.frame obj.unique obj.anchor
          obj.billboard obj.collision 
;;

(* map_texture : vrml_object -> string -> vrml_object *)
let map_imageTexture_url obj url =
    map_obj obj setf_imageTexture_urls [ url ]
;;

let map_texture = map_imageTexture_url ;;

(* map_pixelTexture_image : vrml_object -> image -> vrml_object *)
let map_pixelTexture_image obj image =
    map_obj obj setf_pixelTexture_image image
;;

(* map_movieTexture_speed : vrml_object -> float -> vrml_object *)
let map_movieTexture_speed obj speed =
    map_obj obj setf_movieTexture_speed speed
;;

(* map_movieTexture_clip : vrml_object -> clip -> vrml_object *)
let map_movieTexture_clip obj clip =
    map_obj obj setf_movieTexture_clip clip
;;

(* map_diffuse_color : vrml_object -> color -> vrml_object *)
let map_diffuse_color obj color =
    map_obj obj setf_diffuse_color color
;;

let map_color = map_diffuse_color ;;

let map_all_color obj = map_all obj setf_diffuse_color ;;

let map_all_imageTexture_urls obj url =
    map_all obj setf_imageTexture_urls [ url ]
;;

let map_all_texture = map_all_imageTexture_urls ;;

let map_all_pixelTexture_image obj =
    map_all obj setf_pixelTexture_image
;;

let map_all_movieTexture_clip obj =
    map_all obj setf_movieTexture_clip
;;

let map_all_movieTexture_speed obj =
    map_all obj setf_movieTexture_speed 
;;
