











open Compatibility;;
open Types;;
open Default;;
open Exceptions;;


(**************************************************************************)
(* $Id: basic_types.ml,v 1.3 1997/04/22 17:41:39 doub Exp $               *)
(* Creation and manipulation of basic types                               *)
(**************************************************************************)

(* 2D vector **************************************************************)

(* new_vect2D : float -> float -> vect2D *)
let new_vect2D x y =
    ((x , y) : vect2D)
;;


(* 3D vector **************************************************************)

(* new_vect3D : float -> float -> float -> vect3D *)
let new_vect3D x y z =
    ((x , y , z) : vect3D)
;;


(* Rotation ***************************************************************)

(* new_rotation : float -> float -> float -> float -> rotation *)
let new_rotation x y z t =
    (((new_vect3D x y z) , t) : rotation)
;;


(* Color ******************************************************************)

(* new_color : float -> float -> float -> color *)
let new_color r g b =
    test_color (r , g , b)
;;


(* Time *******************************************************************)

(* new_time : time -> time *)
let new_time = test_time ;;

(* let absolute_time t = ;; *)


(* Frame ******************************************************************)

(* new_frame : float -> float -> float -> float -> float -> float
-> frame *)
let new_frame x1 x2 y1 y2 z1 z2 =
    { height = y1 , y2 ;
      width  = x1 , x2 ;
      depth  = z1 , z2 }
;;


(* Point ******************************************************************)

(* new_point : color -> float -> float -> float -> point *)
let new_point color x y z =
    { point_color      = test_color color ;
      point_coordinate = x , y , z }
;;

(* setf_point_color : point -> color -> point *)
let setf_point_color point color =
    let x , y , z = point.point_coordinate
    in
       new_point color x y z
;;

(* setf_point_coordinate : point -> float -> float -> float -> point *)
let setf_point_coordinate point x y z =
    new_point point.point_color x y z
;;


(* Line *******************************************************************)

(* new_line : color -> vect3D -> vect3D -> line *)
let new_line color point1 point2 =
    { line_point1 = point1 ;
      line_point2 = point2 ;
      line_color  = test_color color }
;;

(* setf_line_point1 : line -> vect3D -> line *)
let setf_line_point1 line point =
    new_line line.line_color point line.line_point2
;;

(* setf_line_point2 : line -> vect3D -> line *)
let setf_line_point2 line point =
    new_line line.line_color line.line_point1 point
;;

(* setf_line_color : line -> color -> line *)
let setf_line_color line color =
    new_line color line.line_point1 line.line_point2
;;


(* Face *******************************************************************)

(* new_face : face -> face *)
let new_face point_list =  (point_list : face) ;;


(* Clip *******************************************************************)

(* new_complete_clip : bool -> time -> time -> string list -> clip *)
let new_complete_clip loop start stop urls =
    { clip_loop       = loop ;
      clip_start_time = test_time start ;
      clip_stop_time  = test_time stop ;
      clip_urls       = urls }
;;

(* new_clip : time -> time -> string -> clip *)
let new_clip start stop url =
    new_complete_clip (default_clip.clip_loop) start stop [ url ]
;;


(* setf_clip_loop : clip -> bool -> clip *)
let setf_clip_loop clip loop =
    new_complete_clip loop clip.clip_start_time
                      clip.clip_stop_time clip.clip_urls
;;

(* setf_clip_start_time : clip -> time -> clip *)
let setf_clip_start_time clip start =
    new_complete_clip clip.clip_loop start
                      clip.clip_stop_time clip.clip_urls
;;

(* setf_clip_stop_time : clip -> time -> clip *)
let setf_clip_stop_time clip stop =
    new_complete_clip clip.clip_loop clip.clip_start_time
                      stop clip.clip_urls
;;

(* setf_clip_urls : clip -> string list -> clip *)
let setf_clip_urls clip urls =
    new_complete_clip clip.clip_loop clip.clip_start_time
                      clip.clip_stop_time urls
;;


(* Image ******************************************************************)

(* new_image : int -> int -> int -> int list -> image *)
let new_image width height components pixel_list =
    { image_width      = width ;
      image_height     = height ;
      image_components = components ;
      image_pixels     = pixel_list }
;;

(* setf_image_width : image -> int -> image *)
let setf_image_width image width =
    new_image width image.image_height 
              image.image_components image.image_pixels
;;

(* setf_image_height : image -> int -> image *)
let setf_image_height image height =
    new_image image.image_width height 
              image.image_components image.image_pixels
;;

(* setf_image_components : image -> int -> image *)
let setf_image_components image components =
    new_image image.image_width image.image_height 
              components image.image_pixels
;;

(* setf_image_pixels : image -> int list -> image *)
let setf_image_pixels image pixel_list =
    new_image image.image_width image.image_height
              image.image_components pixel_list
;;


(* Basic collision box ****************************************************)

(* new_basic_collisionBox : bool -> vect3D -> vect3D -> collisionBox *)
let new_basic_collisionBox collide center size =
    { collide     = collide ;
      bbox_center = center ;
      bbox_size   = size }
;;
