open Printf;; let pi = (asin 1.)*.2.;; type draw_state = {point: float * float; theta: float; points: (float * float) list};; type draw_action = Move of float | Rotate of float | PlacePoint | SetPoint of (float * float) | SetTheta of float | PlacePolyline let print_polyline points = printf " printf "%f,%f " x y) (List.rev (List.tl rpoints)); let (x,y)=(List.hd rpoints) in printf "%f,%f" x y; printf "\" style=\"fill:none\"/>";; let displace_point theta length point = let (x,y) = point in (x+.(length*.(cos theta)),y+.(length*.(sin theta)));; let draw_act action state = let {point=(x,y); theta=theta; points=points}=state in match action with Move length -> let new_point = displace_point theta length (x,y) in {point=new_point; theta=theta; points=points} | Rotate d_theta -> {point=(x,y); theta=theta+.d_theta; points=points} | SetPoint (nx,ny) -> {point=(nx,ny); theta=theta; points=points} | SetTheta ntheta -> {point=(x,y); theta=ntheta; points=points} | PlacePoint -> {point=(x,y); theta=theta; points=points@[(x,y)]} | PlacePolyline -> print_polyline points; {point=(x,y); theta=theta; points=[]};; let print_drawing actions initial_state = (List.fold_right draw_act (List.rev actions) initial_state);; (*Specific geometries: *) let width = 36.0 and height = 18.0;; let slot t_champher_angle t_champher_length b_champher_angle b_champher_length full_length full_width = let main_width=full_width -. 2.*.(b_champher_length*.(sin b_champher_angle)+.t_champher_length*.(sin t_champher_angle)) in let main_length = full_length -. (b_champher_length*.(cos b_champher_angle)+.t_champher_length*.(cos t_champher_angle)) in [Move (-.(full_width/.2.)); PlacePoint; Rotate (t_champher_angle); Move t_champher_length; PlacePoint; Rotate ((pi/.2.)-.t_champher_angle); Move main_length; PlacePoint; Rotate (-.b_champher_angle); Move b_champher_length; PlacePoint; Rotate (b_champher_angle-.(pi/.2.)); Move main_width; PlacePoint; Rotate (b_champher_angle-.(pi/.2.)); Move b_champher_length; PlacePoint; Rotate (-.b_champher_angle); Move main_length; PlacePoint; Rotate (t_champher_angle); Move t_champher_length; PlacePoint; Rotate ((pi/.2.)-.t_champher_angle); Move (-.(full_width/.2.))];; let flip actions = List.map (fun action -> match action with Rotate z -> Rotate (-.z) | a -> a) actions;; let trapezoid acute base edge base_slot edge_slot top_slot base_slot_sep edge_slot_sep top_slot_sep = let top = base -. (2.*.(edge*.(cos acute))) in let line_with_slots length slot sep = [PlacePoint; Move (length/.2.); Move (-.(sep/.2.))]@slot@[Move sep]@slot@[Move (-.(sep/.2.)); Move (length/.2.)] in let edge_with_slots length slot sep angle = (*[PlacePoint; Move (length/.2.); Move (-.(sep/.2.)); Rotate (-.angle)]@slot@[Rotate angle; Move sep; Rotate (-.angle)]@slot@[Rotate angle; Move (-.(sep/.2.)); Move (length/.2.)] in*) line_with_slots length slot sep in (line_with_slots base base_slot base_slot_sep)@[Rotate (pi-.acute)]@(edge_with_slots edge edge_slot edge_slot_sep (-.acute))@[Rotate acute]@(line_with_slots top top_slot top_slot_sep)@[Rotate acute]@(edge_with_slots edge edge_slot edge_slot_sep acute)@[PlacePoint;PlacePolyline];; let fastener slot short_length width angle = let length = short_length +. (width/.(tan ((pi-.angle)/.2.))) in [PlacePoint; Rotate (pi/.2.); Move length; PlacePoint; Rotate (-.angle); Move length; PlacePoint; Rotate (-.pi/.2.); Move (width/.2.)]@(flip slot)@[Move (width/.2.);PlacePoint;Rotate (-.pi/.2.);Move short_length; PlacePoint; Rotate angle; Move short_length; PlacePoint; Rotate (-.pi/.2.); Move (width/.2.)]@(flip slot)@[Move (width/.2.);PlacePoint;PlacePolyline];; printf "" width height width height;; (*print_drawing [PlacePoint; Rotate (0.+.(pi/.2.)); Move (1.); PlacePoint; Rotate (-.(2./.3.)*.pi); Move (1.); PlacePoint;Rotate (-.((2./.3.)*.pi)); Move (1.); PlacePoint; PlacePolyline] {point=(0.,0.); theta=0.; points=[]};;*) let my_slot = (slot (pi/.4.) 0.05 0. 0. 0.3 0.21);; (*print_drawing ([SetPoint (0.,0.); SetTheta 0.]@(trapezoid (pi/.3.) 6. 4. my_slot my_slot my_slot 2. 2. 1.)@[SetPoint (5.,2.5); SetTheta 0.]@(fastener my_slot 0.6 0.6 (pi/.3.))@[SetPoint (5.8,1.3); SetTheta 0.]@(fastener my_slot 0.6 0.6 (pi/.3.))) {point=(0.,0.); theta=0.; points=[]};;*) let base_length = 16.;; let top_length = 1.;; let height = 72.;; let stages = 30;; let width_step = ((base_length -. top_length)/.(float_of_int stages));; let height_step = (height/.(float_of_int stages));; let acute = atan (height_step/.(width_step/.2.));; let edge_length = height_step *. (sin acute);; let stage_base_length stage = base_length -. ((float_of_int stage)*.(width_step));; let stage_top_length stage = stage_base_length (stage+1);; let trapezoid2 stage = let this_base_length = stage_base_length stage in let this_top_length = stage_top_length stage in trapezoid acute this_base_length edge_length my_slot my_slot my_slot (this_base_length/.3.) (edge_length/.3.) (this_top_length/.3.);; let horiz_fastener = fastener my_slot 0.6 0.6 (2.*.pi/.3.);; let vert_fastener = fastener my_slot 0.6 0.6 0.;; let ix = ref 1;; let iy = ref 1;; let repeat_with_floats f = for i = 0 to (!ix)-1 do for j = 0 to (!iy)-1 do let x = (float_of_int i) in let y = (float_of_int j) in f (x,y) (i,j) done done;; let horiz_fasteners () = repeat_with_floats (fun (x,y) _ -> print_drawing horiz_fastener {point=(x*.1.5,y*.1.65); theta=0.; points=[]});; let vert_fasteners () = repeat_with_floats (fun (x,y) _ -> print_drawing vert_fastener {point=(x*.0.7,y*.1.3); theta=0.; points=[]});; let trapezoids stage = let average_length = ((stage_base_length stage) +. (stage_top_length stage))/.2. in repeat_with_floats (fun (x,y) (i,j) -> match (i+j) mod 2 with 0 -> print_drawing (trapezoid2 stage) {point=(x*.(average_length+.0.05),y*.(height_step+.0.05)); theta=0.; points=[]} | 1 -> print_drawing (trapezoid2 stage) {point=(x*.(average_length+.0.05)+.(stage_base_length stage),(y+.1.)*.(height_step+.0.05)-.0.1); theta=pi; points=[]});; Arg.parse [("-x",Arg.Set_int ix,"x repetitions"); ("-y",Arg.Set_int iy,"y repetitions"); ("-t",Arg.Int trapezoids,"Trapezoid stage"); ("-h",Arg.Unit horiz_fasteners,"Horizontal (bent) fasteners"); ("-v",Arg.Unit vert_fasteners,"Vertical (straight) fasteners")] (fun _ -> ()) "";; printf "";;