Skip to content

Commit

Permalink
Implement canvas size management
Browse files Browse the repository at this point in the history
  • Loading branch information
jnavila committed Oct 28, 2017
1 parent d190390 commit 68e0452
Show file tree
Hide file tree
Showing 3 changed files with 31 additions and 22 deletions.
4 changes: 4 additions & 0 deletions src/kicadSch_sigs.ml
Original file line number Diff line number Diff line change
Expand Up @@ -61,6 +61,10 @@ module type Painter = sig
[canvas]. @return the modified canvas *)
val paint_arc: ?fill:kolor -> coord -> coord -> int -> t -> t

(** [set_canevas x y canvas] set the size of the canevas
@return the modified canvas *)
val set_canevas_size: int -> int -> t -> t

(** [get_context ()] @return a new canvas *)
val get_context: unit -> t

Expand Down
2 changes: 1 addition & 1 deletion src/kicadsch.ml
Original file line number Diff line number Diff line change
Expand Up @@ -484,7 +484,7 @@ struct
line
~onerror: (fun () -> BodyContext, canevas)
~process: (fun (_, (Coord (x,y) as f_left)) ->
DescrContext (Coord ((x - 4000), (y - 100))), (plot_page_frame f_left canevas))
DescrContext (Coord ((x - 4000), (y - 100))), (plot_page_frame f_left (P.set_canevas_size x y canevas)))
else if (starts_with line "Wire") || (starts_with line "Entry") then
(parse_wire_wire
line
Expand Down
47 changes: 26 additions & 21 deletions src/svgPainter.ml
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,8 @@ open Tyxml.Svg
open KicadSch_sigs

type content = [ `Polyline | `Text | `Svg | `Rect | `Circle |`Path | `Image ]
type t = content elt list
type dim = int*int
type t = { d: dim ; c : content elt list}

let style_attr_of_style = function
| Italic -> [a_font_style "italic"]
Expand Down Expand Up @@ -32,7 +33,7 @@ let color_of_kolor k =
(** SVG coord type conversion from int **)
let coord_of_int x = float_of_int x, None

let paint_text ?(kolor=Black) t (o:orientation) (Coord (x,y)) (Size size) justif styl c =
let paint_text ?(kolor=Black) t (o:orientation) (Coord (x,y)) (Size size) justif styl ({c; _} as ctxt) =
let size_in = Printf.sprintf "%f" (float_of_int size) and
j = anchor_attr_of_justify justif and
s = style_attr_of_style styl and
Expand All @@ -43,39 +44,43 @@ let paint_text ?(kolor=Black) t (o:orientation) (Coord (x,y)) (Size size) justif
| Orient_V -> (-90.) in
let orient = (angle,None), Some(x_c,y_c)
in
let color = color_of_kolor kolor in
(text ~a:([a_x_list [coord_of_int x] ; a_y_list [coord_of_int y] ; a_font_size size_in; j; a_transform[`Rotate orient]; a_fill color]@s) [pcdata t]) :: c
let color = color_of_kolor kolor in { ctxt with c =
(text ~a:([a_x_list [coord_of_int x] ; a_y_list [coord_of_int y] ; a_font_size size_in; j; a_transform[`Rotate orient]; a_fill color]@s) [pcdata t]) :: c}

let paint_line ?(kolor=Black) ?(width=(Size 2)) (Coord (x1, y1)) (Coord (x2, y2)) c =
let paint_line ?(kolor=Black) ?(width=(Size 2)) (Coord (x1, y1)) (Coord (x2, y2)) ({c; _} as ctxt) =
let x1_in = float_of_int x1 in
let y1_in = float_of_int y1 in
let x2_in = float_of_int x2 in
let y2_in = float_of_int y2 in
let Size width = width in
let fwidth = float_of_int width in
(polyline ~a:([a_points [(x1_in, y1_in); (x2_in, y2_in) ]; a_stroke_width (fwidth, Some `Px); a_stroke ( color_of_kolor kolor) ]) []) :: c
let fwidth = float_of_int width in { ctxt with c =
(polyline ~a:([a_points [(x1_in, y1_in); (x2_in, y2_in) ]; a_stroke_width (fwidth, Some `Px); a_stroke ( color_of_kolor kolor) ]) []) :: c}

let paint_rect ?(fill=NoColor) (Coord(x, y)) (Coord (dim_x, dim_y)) c =
(rect ~a:[ a_x (coord_of_int x); a_y (coord_of_int y); a_width (coord_of_int dim_x); a_height (coord_of_int dim_y);a_fill (color_of_kolor fill); a_stroke_width (1., Some `Px); a_stroke (color_of_kolor Black)] []) :: c
let paint_rect ?(fill=NoColor) (Coord(x, y)) (Coord (dim_x, dim_y)) ({c;_ } as ctxt) = {ctxt with c =
(rect ~a:[ a_x (coord_of_int x); a_y (coord_of_int y); a_width (coord_of_int dim_x); a_height (coord_of_int dim_y);a_fill (color_of_kolor fill); a_stroke_width (1., Some `Px); a_stroke (color_of_kolor Black)] []) :: c}

let paint_circle ?(fill=NoColor) (Coord(x, y)) radius c =
(circle ~a:[a_r (coord_of_int radius); a_cx (coord_of_int x); a_cy (coord_of_int y); a_fill (color_of_kolor fill); a_stroke_width (1., Some `Px); a_stroke (color_of_kolor Black) ] []) :: c
let paint_circle ?(fill=NoColor) (Coord(x, y)) radius ({c; _ } as ctxt) ={ctxt with c =
(circle ~a:[a_r (coord_of_int radius); a_cx (coord_of_int x); a_cy (coord_of_int y); a_fill (color_of_kolor fill); a_stroke_width (1., Some `Px); a_stroke (color_of_kolor Black) ] []) :: c}

let paint_arc ?(fill=NoColor) (Coord(x1, y1)) (Coord (x2, y2)) radius c =
let paint_arc ?(fill=NoColor) (Coord(x1, y1)) (Coord (x2, y2)) radius ({c; _} as ctxt) =
(* not sure how this thing behaves. This setup seems to work *)
let sweepflag = if y1>=y2 then 0 else 1 in
let sweepflag = if y1>=y2 then 0 else 1 in {ctxt with c =
( path ~a:[a_d (Printf.sprintf "M%d,%d A%d,%d 0 0,%d %d,%d" x1 y1 radius radius sweepflag x2 y2); a_fill (color_of_kolor fill); a_stroke_width (1., Some`Px); a_stroke (color_of_kolor Black)] []
) :: c
) :: c}

let paint_image (Coord (x,y)) scale b c =
Printf.printf "painting image! %f %d %d" scale x y;
(image ~a:[a_x (coord_of_int x); a_y (coord_of_int y); a_height ((100. *. scale), Some `Percent); a_width ((100. *. scale), Some `Percent); a_xlink_href @@ "data:image/png;base64," ^ (B64.encode (Buffer.contents b)) ] [])
:: c
let paint_image (Coord (x,y)) scale b ({c; _} as ctxt) =
Printf.printf "painting image! %f %d %d\n" scale x y;
{ctxt with c = (image ~a:[ a_height ((100.), Some `Percent); a_width ((100.), Some `Percent); a_xlink_href @@ "data:image/png;base64," ^ (B64.encode (Buffer.contents b));a_transform [ `Scale (scale /. 4., None) ] ] [])
:: c }

let get_context () = []
let get_context () = {d=(0,0) ; c=[]}

let write oc c =
let svg_doc = svg ~a:[a_width (29.7, Some `Cm); a_height (21., Some `Cm); a_viewBox (0.,0., 11693., 8268.)] c in
let set_canevas_size x y ctxt = {ctxt with d = (x,y)}

let write oc {d= (x,y); c} =
let fx = float x in
let fy = float y in
let svg_doc = svg ~a:[a_width (fx *. 0.00254, Some `Cm); a_height (fy *. 0.00254, Some `Cm); a_viewBox (0.,0., float x, float y)] c in
let s = Format.asprintf "%a" (Tyxml.Svg.pp ()) svg_doc in
(* let fmt = Format.formatter_of_out_channel oc in
Tyxml.Svg.pp () fmt svg_doc *)
Expand Down

0 comments on commit 68e0452

Please sign in to comment.