program test; -- -- polygon construction utility -- In polygon-edit mode, this displays a polygon with its sides, and drag handles. -- option-dragging a handle puts a new handle on the target side of the drag. -- command-clicking drops the handle. Auxiliary radio buttons let the polygon be -- simultaneously displayed in its smooth version, and filled or not, with a selectable -- fill color and width. The code to create a polygon becomes available in an auxiliary -- window when a capture button is clicked. -- In animation-edit mode, we manipulate a list of keyframes and a list 'frames_between' -- of the number of micro-steps to be inserted between these keyframes. An auxiliary slider -- allows adjustment of the 'frames_between' components (mode A), and selective examination of -- the inbetweened configurations (mode B). Clicking on a keyframe icon brings up that state. -- Command-clicking on a keyframe icon deletes that keyframe. Clicking the Add Keyframe -- button when in mode B inserts a new keyframe which contains the current configuration. -- In motion-edit mode, we manipulate a set of motions, each of which is a vector of keyframes -- tied to it specified sequence of frame numbers. These can be conjoined with an offset to -- create a longer sequence, or we can take their n-fold interpolated Cartesian product to create -- a puppet of 2 * n - 1 parameters. A function mapping into the domain of this multiparameter -- puppet can create puppets of fewer parameters, including simple motions. -- rollover a blob icon without pressing it identifies the corresponding object by changing -- its foreground to yellow. click on the icon or drag of it moves the corresponding graphic -- to the front, and selects it for editing use tkw,string_utility_pak,drag_pak,image; -- use the main widget class var debug_count := 0; --utility switch for debugging var first_print := OM; -- strange bug workaround var just_deleted := false; -- flag to prevent second action var output_was; -- prior drag output for debugging var menub,curve_kind := Polygon,color_was := []; -- kind of curve to be constructed; prior outline colors var Tk; var dot_objs := []; -- ordered list of corners var name_to_loc := {}; -- maps dot name to position in dot_objs list var cur_poly_curve,cur_spline_curve; -- the polygon and spline curve var new_dot := OM; -- most recently created dot var new_dot_dragging; -- most recently created dot, while dragging var ca; -- the canvas on which this all happens var mouse_x,mouse_y; -- mouse coordinates during drag var spline_fill_color := "red"; var poly_fill_color := "green"; var show_poly := true,show_spline := true,fill_poly,fill_spline; -- the control checkboxes var keyframes_fr,slider_fr; -- the frame containing the keyframe icons; the frame containing the slider var keyframe_icons := []; -- the list of keyframe icons var tempo := 30; -- current tempo in frames/sec. var showing_tempo := false; -- is tempo currently being shown var captured_states := []; -- list of key states captured for animation var level_data := []; -- list of polygons, splines, and aux data, per graphic level var frames_between := [10]; -- number of steps between key states var frame_now_data,key_step,vect_of_deltas,between_step,first_keyf_being_inbetweened; -- control variables for animation var lab_editing := OM,cap_editing := OM; var n_betweens; -- total number of inbetweened steps between the two current frames var current_keyframe := 1,display_msg,star_but; -- control variables for animation editing var displaying_inbetween := false; -- if true, this prohibits editing var the_slider; -- slider for animation edit var were_spaced_out := false; -- were keyframe icons placed to the left? var help_win := OM; -- help window -- variables for multi-blob control var cab,captions,place_of_caption,labs_and_caps := OM; -- var test_colors := "#ff0000,#00ff00,#0000ff,#ffaaaa,#aaffaa,#aaaaff,#ff00ff,#ffff00,#00ffff,#ffaaff,#ffffaa,#aaffff"; var cbb; var level_being_edited; -- the index of the element being edited var unused_lets := { }; -- collection of unused letters var text_edit_window := OM; -- supplementary window for editing canvas text var text_field,font_field; -- entry fields in supplementary window const offscreen := "-10000,-10000,-10000,-10000,-10000,-10000"; -- position of poly and spline when offscreen const offrect := "-10000,-10000,-10000,-10000"; -- position of rectangle when offscreen const canvas_size := "480,320",canvas_width := 480.0; -- size of canvas Tk := tkw(); Tk(OM) := "Polygon Animator"; -- create the Tk interpreter make_controls(); -- make the standard controls make_blob_controls(); -- make the third group of controls, for multiple blobs -- ca := Tk("canvas","740,480"); ca("side") := "top"; -- create the master canvas ca := Tk("canvas",canvas_size); ca("side") := "top"; -- create the master canvas dot_data := [[150.0,150.0],[200.0,150.0],[150.0,200.0]]; [lev_dat,koords] := make_blob(); -- make a first initialized blob levels_at_keyframe := [koords]; -- there is just 1 level captured_states := [levels_at_keyframe]; -- there is just 1 keyframe level_data := [lev_dat]; -- there is just 1 level [cur_poly_curve,cur_spline_curve,-] := lev_dat; level_being_edited := 1; -- when created, this is being edited frames_between with:= 10; -- save the info on the current graphics --print("frames_between: ",frames_between," ",current_keyframe); current_keyframe := #captured_states; -- we go on to edit the new state reflect_captured_states(false); -- reflect the captured states in the captured states indication area,and create a new keyframe button the_slider(OM) := 10; -- position the slider to show the inter-keyframe gap star_but("state") := "normal"; -- enable the 'star' button display_msg("text") := str(current_keyframe); -- note that slider controls number of inbetween steps displaying_inbetween := false; -- if true, this prohibits editing place_of_caption("A") := 1; --print("labs_and_caps: ",labs_and_caps); for [x,y] = dot_data(j) loop dot_objs with:= dot_obj := ca("oval",dot_stg(x,y) + if j = #dot_data then "" else "," end if); dot_obj("fill") := "yellow"; name_to_loc(dot_obj.Tk_id()) := j; -- note dot position n dots list attach_actions(dot_obj); end loop; Tk.mainloop(); -- enter the main Tk loop procedure make_blob(); -- makes a new initialized blob -- save the aux data and the cur_poly_curve if #captured_states > 0 then -- we are not at the very beginning aux_data := [spline_fill_color,poly_fill_color,show_poly("selected"), show_spline("selected"),fill_poly("selected"),fill_spline("selected")]; graphics := captured_states(current_keyframe); graphics(level_being_edited) := coord_list_from_poly(cur_poly_curve); captured_states(current_keyframe) := graphics; level_data(level_being_edited)(3) := aux_data; end if; case curve_kind -- now make the appropriate kind of new curve when "Poly" => pol := ca("polygon","150.0,150.0,200.0,150.0,150.0,200.0"); pol("fill,width,outline") := "{},1,red"; splin := ca("polygon","150.0,150.0,200.0,150.0,150.0,200.0"); splin("fill,smooth,width,outline") := "{},true,1,blue"; fill_poly("selected,state") := "0,normal"; -- enable the fill buttons fill_spline("selected,state") := "0,normal"; when "Rect" => pol := ca("rectangle","150.0,150.0,,200.0,200.0"); pol("fill,width,outline") := "{},1,red"; splin := ca("oval","150.0,150.0,200.0,200.0"); splin("fill,smooth,width,outline") := "{},true,1,blue"; fill_poly("selected,state") := "0,normal"; -- enable the fill buttons fill_spline("selected,state") := "0,normal"; when "Line" => pol := ca("line","150.0,150.0,200.0,150.0"); pol("fill,width") := "green,1"; splin := ca("line","150.0,150.0,200.0,150.0"); splin("fill,smooth,width") := "red,true,1"; fill_poly("selected,state") := "0,disabled"; -- disable the fill buttons fill_spline("selected,state") := "0,disabled"; when "Text" => open_text_edit(); -- open a supplementary edit window for the canvas item type current_text := "Text.."; -- use default text if none supplied pol := ca("text",current_text); pol("coords") := "150,150"; pol("anchor,font,fill") := "nw,{Times 54 bold}"; splin := pol; splin := ca("line","150.0,150.0,200.0,150.0"); splin("fill,smooth,width") := "red,true,1"; fill_poly("selected,state") := "0,disabled"; -- disable the fill buttons fill_spline("selected,state") := "0,disabled"; show_spline("selected,state") := "0,disabled"; -- for text items, the spline_fill_color is actually the text return [[pol,splin,[current_text,"black","1","0","0","0"]],coord_list_from_poly(pol)]; otherwise => pol := ca("polygon","150.0,150.0,200.0,150.0,150.0,200.0"); pol("fill,width,outline") := "{},1,red"; splin := ca("polygon","150.0,150.0,200.0,150.0,150.0,200.0"); splin("fill,smooth,width,outline") := "{},true,1,blue"; fill_poly("selected,state") := "0,normal"; -- enable the fill buttons fill_spline("selected,state") := "0,normal"; end case; --print("make_blob: ",pol,splin); return [[pol,splin,["red","green","1","1","0","0"]],coord_list_from_poly(pol)]; end make_blob; procedure make_blob_controls(); -- make the third group of controls, for multiple blobs captions := "A"; -- BCDEFGHIJKLMNOPQRSTUVWXYZ unused_lets := {c: c in "BCDEFGHIJKLMN"}; place_of_caption := {[c,j]: c = captions(j)}; -- maps each label into its place blbfr := Tk("frame","540,20"); blbfr("side") := "top"; -- create a frame add_button:= blbfr("button","+"); add_button("side") := "left"; add_button{OM} := add_graphic; not_edit_button:= blbfr("button","@"); not_edit_button("side") := "left"; not_edit_button{OM} := drop_edit; cab := blbfr("canvas","500,20"); cab("side") := "left"; -- create a canvas cab("background") := "#aaaaaa"; labs_and_caps := [make_lab(let,j): let = captions(j)]; end make_blob_controls; procedure attach_actions(dot_obj); -- attach actions to the polygon-corner dot object dot_obj{"B1-Motion:xy"} := drag_dot(dot_obj); dot_obj{"ButtonRelease-1"} := note_dot_places; dot_obj{"Option-B1-Motion:xy"} := drag_new_dot(); dot_obj{"Option-ButtonPress-1:xy"} := create_new_dot(dot_obj); dot_obj{"Command-ButtonRelease-1"} := delete_dot(dot_obj); dot_obj{"Shift-ButtonPress-1:xy"} := start_drag; dot_obj{"Shift-B1-Motion:xy"} := drag_all; dot_obj{"Option-Shift-ButtonPress-1:xy"} := copy_and_start_drag; end attach_actions; procedure note_dot_places(); -- end of dot drag action - note the dot places captured_states(current_keyframe)(level_being_edited) := get_dots(); end note_dot_places; procedure drag_dot(dot_obj); -- dot drag action - just move the dot return lambda(xy); if displaying_inbetween then Tk.beeper(); return; end if; [x,y] := decode_xy(xy); dot_obj("coords") := dot_stg(x,y); render(); -- render the polygons and the splines end lambda; end drag_dot; procedure create_new_dot(dot_obj); -- dot option buttonpress action - drag out a new dot return lambda(xy); if displaying_inbetween or level_data(level_being_edited)(1).tk_kind() = "rectangle" then Tk.beeper(); -- issue warning beep new_dot_dragging := dot_obj; -- the following drag will affect the existing dot return; end if; [x,y] := decode_xy(xy); -- get the click point new_dot_dragging := ca("oval",dot_stg(x,y)); -- create a new dot new_dot_dragging("fill") := "yellow"; -- make it yellow attach_actions(new_dot_dragging); -- attach actions to the dot object dot_obj_ix := name_to_loc(dot_obj.Tk_id()); -- get the index of the dot dragged on dot_objs(dot_obj_ix + 1..dot_obj_ix) := [new_dot_dragging]; -- insert the new dot name_to_loc(new_dot_dragging.Tk_id()) := dot_obj_ix; -- update the name_to_loc map csc := captured_states; -- make copy of captured states for gr = csc(j) loop -- loop over all frames -- but current -- | j /= current_keyframe control_points := gr(level_being_edited); control_points(2 * dot_obj_ix + 1..2 * dot_obj_ix) := -- insert control-point copy control_points(2 * dot_obj_ix - 1..2 * dot_obj_ix); gr(level_being_edited) := control_points; captured_states(j) := gr; end loop; for j in [dot_obj_ix + 1..#dot_objs] loop name_to_loc((dot_objs(j)).Tk_id()) +:= 1; -- push back in sequence end loop; --print("create_new_dot: ",captured_states," ",dot_obj_ix," ",level_being_edited," ",name_to_loc); end lambda; end create_new_dot; procedure drag_new_dot(); -- dot option drag action - drag out a new dot return lambda(xy); if displaying_inbetween then Tk.beeper(); return; end if; [x,y] := decode_xy(xy); new_dot_dragging("coords") := dot_stg(x,y); render(); -- render the polygons and the splines end lambda; end drag_new_dot; procedure delete_dot(dot_obj); -- dot command-click action - delete the dot clicked return lambda(); if displaying_inbetween or ((typ := cur_poly_curve.tk_kind()) = "polygon" and (ndt := #dot_objs) < 4) or ((typ = "line" or typ = "rectangle" or typ = "oval") and (ndt := #dot_objs) < 3) then -- change in number of dots is illegal Tk.beeper(); return; -- never go below a triangle or pair of points end if; dot_obj_ix := name_to_loc(dot_obj.Tk_id()); -- find the dot to be deleted dot_objs(dot_obj_ix..dot_obj_ix) := []; -- delete it for j in [dot_obj_ix..ndt - 1] loop name_to_loc((dot_objs(j)).Tk_id()) -:= 1; -- move forward in sequence end loop; -- now we must remove the deleted dot from the canvas dot_obj("coords") := OM; -- remove the deleted dot -- remove the data corresponding to the deleted dot cs_copy := captured_states; --print("delete_dot: ",captured_states); for gra = cs_copy(keyf) loop -- at its level, in all keyframes dat := gra(level_being_edited); dat(2 * dot_obj_ix - 1..2 * dot_obj_ix) := [ ]; -- remove the data corresponding to the deleted dot gra(level_being_edited) := dat; -- and reinstall captured_states(keyf) := gra; -- and reinstall, and reinstall end loop; render(); -- render the polygons and the splines end lambda; end delete_dot; procedure copy_and_start_drag(xy); -- dot option-shift drag action - copy graphic, and prepare to move all the dots if displaying_inbetween then Tk.beeper(); return; end if; -- illegal if displaying inbetween if #unused_lets = 0 then Tk.beeper(); return; end if; -- no space if captured_states = [] then -- the same graphic must be added to all the captured states add_keyframe_cmd(); -- make an initial keyframe end if; -- get the least unused letter let := arb(unused_lets); for c in unused_lets | c < let loop let := c; end loop; unused_lets less:= let; labs_and_caps with:= (lab_and_cap := make_lab(let,nlcp1 := #labs_and_caps + 1)); place_of_caption(let) := nlcp1; graphics := captured_states(current_keyframe); -- we must adjust the graphics for the current keyframe aux_data := [spline_fill_color,poly_fill_color,show_poly("selected"), -- collect the auxiliary data show_spline("selected"),fill_poly("selected"),fill_spline("selected")]; graphics(level_being_edited) := dat := get_dots(); -- save the element that was being edited captured_states(current_keyframe) := graphics; level_data(level_being_edited)(3) := aux_data; pol_kind := level_data(level_being_edited)(1).tk_kind(); -- get the kind of object addressed [sfc,pfc,shp,shs,fip,fis] := aux_data; dat := join([str(x): x in dat],","); -- force components to string case pol_kind when "polygon" => pol := ca("polygon",if shp = "1" then dat else offscreen end if); -- create a new polygon pol("fill,width,outline") := if fip = "1" then pfc else "{}" end if + ",1,red"; splin := ca("polygon",if shs = "1" then dat else offscreen end if); -- create a new spline splin("fill,smooth,width,outline") := if fis = "1" then sfc else "{}" end if + ",true,1,blue"; when "line" => pol := ca("line",if shp = "1" then dat else offscreen end if); -- create a new polygon pol("fill,width") := pfc + ",1"; splin := ca("line",if shs = "1" then dat else offscreen end if); -- create a new spline splin("fill,smooth,width") := sfc + ",true,1"; when "rectangle" => pol := ca("rectangle",if shp = "1" then dat else offrect end if); -- create a new rectangle pol("fill,width,outline") := if fip = "1" then pfc else "{}" end if + ",1,red"; splin := ca("oval",if shs = "1" then dat else offrect end if); -- create a new oval splin("fill,smooth,width,outline") := if fis = "1" then sfc else "{}" end if + ",true,1,blue"; end case; cur_poly_curve := pol; cur_spline_curve := splin; csc := captured_states; for gra = csc(keyf) loop -- copy the data for the level being edited, and gra with:= gra(level_being_edited); -- add a level for the new polygon and spline captured_states(keyf) := gra; -- write new graphics to the keyframe end loop; graphics := captured_states(current_keyframe); level_being_edited := #graphics; -- the new item, added at the end, is that currently being edited level_data(level_being_edited) := [pol,splin,aux_data]; place_dots(graphics(level_being_edited)); -- place the dots around the new image to be edited set_aux_data(aux_data); -- set the default blob data into the checkboxes and colors [mouse_x,mouse_y] := decode_xy(xy); -- capture the drag start in global vars end copy_and_start_drag; procedure start_drag(xy); -- dot shift drag action - prepare to move all the dots if displaying_inbetween then Tk.beeper(); return; end if; -- illegal if displaying inbetween [mouse_x,mouse_y] := decode_xy(xy); -- capture the drag start in global vars end start_drag; procedure drag_all(xy); -- dot shift drag action - move all the dots if displaying_inbetween then Tk.beeper(); return; end if; [x,y] := decode_xy(xy); delta_x := x - mouse_x; delta_y := y - mouse_y; mouse_x := x; mouse_y := y; for dot_obj in dot_objs loop [x,y] := get_center_float((dot_obj("coords"))); [x,y] := [unstr(x) + delta_x,unstr(y) + delta_y]; dot_obj("coords") := dot_stg(x,y); end loop; graphics := captured_states(current_keyframe); graphics(level_being_edited) := get_dots(); captured_states(current_keyframe) := graphics; -- install new position in captured_states render(); -- render the polygons and the splines end drag_all; procedure render(); -- render the polygons and the splines, if desired (Otherwise they are offstage) -- if visible, the polygon and spline are rendered from the dot centers dot_centers := join([get_center(dot_obj("coords")): dot_obj in dot_objs],","); --print("render: ",show_poly("selected") = "1"); if show_poly("selected") = "1" then cur_poly_curve("coords") := dot_centers; end if; if show_spline("selected") = "1" then cur_spline_curve("coords") := dot_centers; end if; end render; procedure decode_xy(xy); -- decode pair of strings to floating format [x,y] := xy; return [float(unstr(x)),float(unstr(y))]; end decode_xy; procedure tempo_cmd(); -- use the slider to set the tempo showing_tempo := true; -- note that we are currently showing tempo the_slider("to") := 100; -- tempos up to 100 frames/sec. the_slider(OM) := tempo; star_but("state") := "normal"; -- enable the 'star' button display_msg("text") := str(tempo); -- note that slider controls number of inbetween steps end tempo_cmd; procedure edit_cmd(); -- open a supplementary edit window for the canvas item type end edit_cmd; procedure open_text_edit(); -- open a supplementary edit window for the canvas item type if text_edit_window = OM then -- open a new toplevel window text_edit_window := Tk("toplevel","10,10"); text_edit_window(OM) := "Text Adjustment"; but_frame := text_edit_window("frame","10,10"); but_frame("side") := "top"; font_label := but_frame("label"," Font: "); font_label("side") := "left"; font_field := but_frame("entry",40); font_field("side") := "left"; font_field(OM) := "{Times 54 bold}"; ok_button := but_frame("button","OK"); ok_button("side") := "left"; ok_button{OM} := lambda(); set_current_text(text_field(OM)); end lambda; cancel_button := but_frame("button","Cancel"); cancel_button("side") := "left"; cancel_button{OM} := lambda(); text_edit_window("coords") := OM; text_edit_window := OM; end lambda; text_field := text_edit_window("text","60,20"); text_field("side") := "top"; text_field(OM) := "Enter text here"; text_field("background") := "#ffdddd"; text_edit_window{"Destroy"} := lambda(); text_edit_window := OM; end lambda; end if; end open_text_edit; procedure set_current_text(txt); -- set text of current object if it has the right type if cur_poly_curve.tk_kind() = "canvas_text" then cur_poly_curve("1"..str(#cur_poly_curve)) := txt; end if; end set_current_text; procedure add_keyframe_cmd(); -- add a new keyframe at the end or in-between, -- or insert a new keyframe at this point, if displaying_inbetween if displaying_inbetween then return insert_action(); end if; -- otherwise insert new keyframe at the end save_current_keyframe(); -- save the current frame info graphics := captured_states(current_keyframe); captured_states with:= graphics; -- put this info into the current keyframe frames_between with:= 10; -- save the info on the current graphics current_keyframe := #captured_states; -- we go on to edit the new state reflect_captured_states(false); -- reflect the captured states in the captured states indication area,and create a new keyframe button the_slider(OM) := 10; -- position the slider to show the inter-keyframe gap star_but("state") := "normal"; -- enable the 'star' button display_msg("text") := str(current_keyframe); -- note that slider controls number of inbetween steps displaying_inbetween := false; -- if true, this prohibits editing end add_keyframe_cmd; procedure hide_dots(); -- temporarily hide all the dot objects if #dot_objs = 0 or unstr(dot_objs(1)("coords")(1)) > 25000.0 then return; end if; for dot_obj_j in dot_objs loop [doj_coordx,doj_coordy,doj_coordx2,doj_coordy2] := dot_obj_j("coords"); doj_coordx := str(unstr(doj_coordx) + 50000.0); doj_coordx2 := str(unstr(doj_coordx2) + 50000.0); dot_obj_j("coords") := doj_coordx + "," + doj_coordy + "," + doj_coordx2 + "," + doj_coordy2; end loop; end hide_dots; procedure show_dots(); -- show all the hidden dot objects if #dot_objs = 0 or unstr(dot_objs(1)("coords")(1)) < 25000.0 then return; end if; for dot_obj_j in dot_objs loop [doj_coordx,doj_coordy,doj_coordx2,doj_coordy2] := dot_obj_j("coords"); doj_coordx := str(unstr(doj_coordx) - 50000.0); doj_coordx2 := str(unstr(doj_coordx2) - 50000.0); dot_obj_j("coords") := doj_coordx + "," + doj_coordy + "," + doj_coordx2 + "," + doj_coordy2; end loop; end show_dots; procedure play_animation_cmd(); -- play the animation, by in-betweening -- this initializes the animation and starts a timer, which keeps calling back to advance the -- animation step until it has all played if (ncs := #captured_states) < 2 then Tk.beeper(); return; end if; between_step := 0; key_step := 0; -- initialize the animation step counters n_betweens := 0; drop_edit(); -- put the currently edited element back into place hide_dots(); -- hide all the dots animation_step(); -- first call to callback routine for the the animation timer end play_animation_cmd; procedure clear_animation_cmd(); -- clear the animation; or if it is clear drop all but -- the first polygon; or if thre is just one, initialize it if #captured_states > 1 then -- clear the animation, keeping only the initial frame displaying_inbetween := were_spaced_out := false; current_keyframe := 1; -- update the current_keyframe variable graphics := captured_states(1); -- get the graphics for the new current keyframe render_graphics(graphics); -- change display to the new graphics captured_states := captured_states(1..1); frames_between := frames_between(1..1); reflect_captured_states(false); -- reflect the captured states in the captured states indication area elseif #level_data > 1 then -- drop all the labs, caps, and polygons but the first. for [lab,cap] = labs_and_caps(j) | j > 1 loop unused_lets with:= (letter := cap("text")(2)); letix := place_of_caption(letter); -- find the location of the letter cap("coords") := lab("coords") := OM; -- delete the label and caption poc := place_of_caption(letter); place_of_caption(letter) := OM; -- delete the polygon and the spline corresponding to the letter being deleted [pol,spl,-] := level_data(poc); pol("coords") := OM;spl("coords") := OM; end loop; -- place the dots at the first level being edited level_being_edited := 1; -- the level being edited goes to 1 place_dots_from(captured_states(1)(level_being_edited)); level_data := level_data(1..1); [cur_poly_curve,cur_spline_curve,aux] := level_data(1); [spline_fill_color,poly_fill_color,show_poly("selected"), show_spline("selected"),fill_poly("selected"),fill_spline("selected")] := aux; if cur_poly_curve.tk_kind() = "line" then fill_poly("selected,state") := "0,disabled"; fill_spline("selected,state") := "0,disabled"; else fill_poly("state") := "normal"; fill_spline("state") := "normal"; end if; labs_and_caps := [first_lc := labs_and_caps(1)]; [labl,cap] := first_lc; labl("fill") := "green"; -- the first level becomes editable else -- clear the first frame, reducing it to a single polygon captured_states := [dot_data := ["150.0,150.0","200.0,150.0","150.0,200.0"]]; -- erase the surplus dots for j in [4..#dot_objs] loop dot_obj := dot_objs(j); dot_obj("coords") := OM; end loop; dot_objs := dot_objs(1..3); for dot_obj = dot_objs(j) loop [x,y] := breakup(dot_data(j),","); dot_obj("coords") := dot_stg(unstr(x),unstr(y)); end loop; [spline_fill_color,poly_fill_color,show_poly("selected"), show_spline("selected"),fill_poly("selected"),fill_spline("selected")] := ["red","green","1","1","0","0"]; cur_poly_curve("fill") := "{}"; cur_spline_curve("fill") := "{}"; render(); -- render the polygons and the splines end if; display_msg("text") := "*"; star_but("state") := "disabled"; the_slider(OM) := 1; -- position the slider at its start reflect_captured_states(false); end clear_animation_cmd; procedure place_dots_from(data); -- place the dots to reflect specified data n_dots_wanted := #data/2; -- find number of desired dots n_dots_have := #dot_objs; -- find number of available dots if n_dots_wanted > n_dots_have then -- make more dots for j in [n_dots_have + 1.. n_dots_wanted] loop dot_objs with:= dot_obj := ca("oval",dot_stg(0.0,0.0)); dot_obj("fill") := "yellow"; name_to_loc(dot_obj.Tk_id()) := j; -- note dot position n dots list attach_actions(dot_obj); end loop; elseif n_dots_wanted < n_dots_have then -- delete surplus dots for j in [n_dots_wanted + 1.. n_dots_have] loop dobj := dot_objs(j); dobj("coords") := OM; dot_objs(j) := OM; end loop; end if; for j in [1,3..#data] loop dobj := dot_objs((j + 1)/2); dobj("coords") := dot_stg(data(j),data(j + 1)); end loop; end place_dots_from; procedure reflect_captured_states(space_out); -- reflect the captured states in the captured states indication area nki := #keyframe_icons; ns := #captured_states; --print("reflect_captured_states: "); for j in [nki + 1..ns] loop -- make new buttons if there is a shortage but := keyframes_fr("button",str(j)); but{OM} := but_action(but); -- attach the standard button actions to the new button but{"Command-ButtonRelease-1"} := delete_keyframe_action(but); but{"Option-ButtonRelease-1"} := insert_after_action(but); keyframe_icons with:= but; end loop; --print("deleting keyframe_icons from: ",ns + 1," to ",nki); for j in [ns + 1..nki] loop -- delete surplus buttons but := keyframe_icons(j); but("place") := OM; keyframe_icons(j) := OM; end loop; position_keyframe_icons(space_out); -- put the keyframe icons into position end reflect_captured_states; procedure animation_step(); -- callback routine for the the animation timer if advance_animation() then timer := Tk.createtimer(1000/tempo,animation_step); -- start a Tk timer (rings once) end if; -- otherwise we just return; the timer has expired end animation_step; procedure advance_animation(); -- advances the animation and returns true, or false if finished -- The captured_states vector consists of a sequence of control_points vectors, one for each keyframe. -- Each graphics vector consists of one entry for each level of the multi-level graphic involved -- in an animation. We also use a level_data vector, whose entries have the form -- [polygon_object_of_level,spline_object_of_level,aux_data]; -- where aux_data is -- [spline_fill_color,poly_fill_color,show_poly_flag,show_spline_flag,fill_poly_flag,fill_spline_flag] if (between_step +:= 1) >= n_betweens then -- we have finished inbetweening of prior keyframes; -- try to advance the keyframe first_keyf_being_inbetweened := captured_states((key_step +:= 1)); -- go on to next keyframe if (next_keyf := captured_states(ksp1 := key_step + 1)) = OM then -- Nothing follows: That's all, Folks! --print("next_keyf: ",next_keyf); graphics := captured_states(current_keyframe := #captured_states); -- the last keyframe becomes current the_slider(OM) := frames_between(#frames_between); -- set the slider to the last frame's number of following frames display_msg("text") := str(current_keyframe); displaying_inbetween := false; -- set flag indicating that display is of keystate --print("captured_states: ",current_keyframe," ",captured_states); level_1_data := captured_states(current_keyframe)(1); -- get data for level 1 of the final keyframe place_dots(level_1_data); -- place dots for final keyframe, level 1 level_being_edited := 1; -- note that we are editing level 1 [cur_poly_curve,cur_spline_curve,l1_aux] := level_data(1); -- get data for level 1 [sfc,pfc,spf,ssf,fpf,fsf] := l1_aux; -- set the aux data flags appropriately -- get the aux data for level 1 (final keyframe but same for all) spline_fill_color := sfc; poly_fill_color := pfc; show_poly("selected") := spf; show_spline("selected") := ssf; fill_poly("selected") := fpf; fill_spline("selected") := fsf; if cur_poly_curve.tk_kind() = "line" then fill_poly("selected,state") := "0,disabled"; fill_spline("selected,state") := "0,disabled"; else fill_poly("state") := "normal"; fill_spline("state") := "normal"; end if; if lab_editing /= OM then lab_editing("fill") := "yellow"; end if; [lab_editing,cap_editing] := labs_and_caps(1); lab_editing("fill") := "green"; show_dots(); -- show all the hidden dots --show_posns("anim end"); return false; -- flag indicating end of animation end if; between_step := 0; -- restart the intermediate counter stepsize := 1.0/float(n_betweens := frames_between(key_step)); -- stepsize for this in-betweening cycle vect_of_deltas := [ ]; -- we will collect the vector of keyframe deltas, one component -- for each of the graphic layers involved in our animation frame_now_data := [ ]; -- we will collect the vector of dot positions, for each of the graphic layers for keyf_data = first_keyf_being_inbetweened(lev) loop -- this must be done for every graphic level [-,-,show_poly_flag,show_spline_flag] := level_data(lev)(3); -- determine if spline and/or poly should be shown -- get the position data from the new first keyframe of the pair being inbetweened frame_now_data with:= keyf_data; -- get the dots vectors for the lev-th level next_keyf_data := next_keyf(lev); -- of each of the two keyframes vect_of_deltas with:= [(next_keyf_data(j) - x) * stepsize: x = keyf_data(j)]; -- vector delta for in-betweening cycle keyf_data_stg := [str(x): x in keyf_data]; if show_spline_flag = "1" then -- animate the spline cur_spline_curve := level_data(lev)(2); -- get the spline object for this level cur_spline_curve("coords") := join(keyf_data_stg,","); -- draw this level of the configuration end if; if show_poly_flag = "1" then -- animate the poly cur_poly_curve := level_data(lev)(1); -- get the poly object for this level cur_poly_curve("coords") := join(keyf_data_stg,","); -- draw this level of the configuration end if; end loop; --print("vect_of_deltas: ",vect_of_deltas," ",stepsize); if ksp1 >= #captured_states then n_betweens +:= 1; end if; -- add very last step else -- advance to the next in-between step for keyf_level = first_keyf_being_inbetweened(lev) loop -- this must be done for every graphic level [-,-,show_poly_flag,show_spline_flag] := level_data(lev)(3); -- determine if spline and/or poly should be shown keyf_delta := vect_of_deltas(lev); fndk := frame_now_data(lev); --print("animation cycle: ",lev," ",frame_now_data," ",fndk); frame_now_data(lev) := fndk := [x + keyf_delta(j): x = fndk(j)]; -- calculate next inbetweened position fndk_stg := [str(x): x in fndk]; if show_spline_flag = "1" then -- animate the spline cur_spline_curve := level_data(lev)(2); -- get the spline object for this level cur_spline_curve("coords") := join(fndk_stg,","); -- draw this level of the configuration end if; if show_poly_flag = "1" then -- animate the poly cur_poly_curve := level_data(lev)(1); -- get the poly object for this level cur_poly_curve("coords") := join(fndk_stg,","); -- draw this level of the configuration end if; end loop; end if; return true; -- flag indicating that more is coming end advance_animation; procedure show_posns(capt); -- debugging routine; show positions print("\nPosition dump -- ",capt); for graphics = captured_states(k), graphic_for_lev = graphics(j) loop print("keyframe ",k,", level: ",j," " +/ [str(fix(x)) + " ": x in graphic_for_lev]); end loop; end show_posns; procedure make_controls(); -- make the standard controls fr := Tk("frame","540,30"); fr("side") := "top"; fr("background") := "#ffaaaa"; -- create an auxiliary frame fr2 := Tk("frame","540,30"); fr2("side") := "top"; fr2("background") := "#ffaaaa"; -- create a second auxiliary frame menub := fr("menubutton","Poly"); menub("side") := "left"; -- create a menubutton menub("width") := "4"; choices := "b:Poly,b:Line,b:Rect,b:Arc ,b:Text,b:Widg"; -- rect represents both rect and oval the_menu := menub("menu","normal"); the_menu(1..0) := choyces := choices; -- add items to the menu choyces := breakup(choyces,","); -- set command for Menu item for choice = choyces(k) loop the_menu{k,OM} := store_pick(choice); end loop; menub("menu") := the_menu; show_poly := fr("checkbutton","Polygon"); show_poly("side") := "left"; show_poly("width,anchor") := "8,w"; show_poly{OM} := show_poly_cmd; show_poly("selected") := "1"; show_spline := fr("checkbutton","Curve"); show_spline("side") := "left"; show_spline("width,anchor") := "7,w"; show_spline{OM} := show_spline_cmd; show_spline("selected") := "1"; fill_poly := fr("checkbutton","Fill P"); fill_poly("side") := "left"; fill_poly("width,anchor") := "6,w"; fill_poly{OM} := fill_poly_cmd; fill_spline := fr("checkbutton","Fill C"); fill_spline("side") := "left"; fill_spline("width,anchor") := "6,w"; fill_spline{OM} := fill_spline_cmd; help_but := fr("button","?"); help_but("side") := "left"; help_but{OM} := help_cmd; poly_color := fr("button","P-Color"); poly_color("side") := "left"; poly_color{OM} := color_poly_cmd; spline_color := fr("button","C-Color"); spline_color("side") := "left"; spline_color{OM} := color_spline_cmd; tempo_but := fr2("button","Tempo"); tempo_but("side") := "left"; tempo_but{OM} := tempo_cmd; edit_but := fr2("button","Edit"); edit_but("side") := "left"; edit_but{OM} := edit_cmd; add_key_but := fr2("button","+ Keyframe"); add_key_but("side") := "left"; add_key_but{OM} := add_keyframe_cmd; play_animation := fr2("button","Play"); play_animation("side") := "left"; play_animation{OM} := play_animation_cmd; clear_animation := fr2("button","Clear"); clear_animation("side") := "left"; clear_animation{OM} := clear_animation_cmd; capture := fr2("button","Capture"); capture("side") := "left"; capture{OM} := save_current_keyframe; save := fr2("button","Save"); save("side") := "left"; save{OM} := save_cmd; load := fr2("button","Load"); load("side") := "left"; load{OM} := load_cmd; code := fr2("button","Code"); code("side") := "left"; code{OM} := code_cmd; photo := fr2("button","Photo"); photo("side") := "left"; photo{OM} := photo_cmd; -- create a third auxiliary frame for the keyframes icons keyframes_fr := Tk("frame","540,22"); keyframes_fr("side,fill") := "top,x"; keyframes_fr("background") := "#cccccc"; star_but := keyframes_fr("button","*"); star_but("place,x,y,anchor") := "0,0,nw"; star_but("state") := "disabled"; star_but{OM} := star_but_action; star_but("foreground") := "blue"; -- create a slider for adjusting the inter-keyframe distances slider_fr := Tk("frame","540,30"); slider_fr("side,fill") := "top,x"; slider_fr("background") := "#ffaaaa"; display_msg := slider_fr("message","*"); display_msg("side") := "left"; display_msg("foreground") := "black"; display_msg("background") := "#ffaaaa"; the_slider := slider_fr("scale","0,100"); the_slider("side") := "left"; -- create a slider the_slider("orient,variable") := "horizontal,slider_val"; -- the attribute name is used as the slider's associated variable the_slider("length,width,from,to,sliderlength,showvalue,background") := "500,8,1," + str(100) + ",12,true,#ffaaaa"; the_slider{"B1-Motion"} := reflect_slider; end make_controls; procedure help_cmd(); -- open a help window -- if help_win = OM then -- create the help window help_win := Tk("toplevel","440,200"); help_win(OM) := "How to use this Polygon and Animation Editor"; data := "This curve-and-animation editor " + "allows display and editing of multiple splines and/or polygons, and manipulation of their " + "back-to-front order. It can be used in one of several ways.\n\n" + "In polygon-edit mode, polygons, including one polygon with drag handles, are displayed. " + "Option-dragging a handle adds a new handle. Command-clicking drops the handle. " + "Shift-dragging a handle moves the graphic object to which the handle is attached. " + "Shift-Option-dragging a handle copies the graphic object to which the handle is attached. " + "Auxiliary checkboxes allow or suppress display of the smoothed (spline) polygon, with fill or not. " + "The spline and polygon fill colors are selectable. Polygons (and animations) " + "can be saved and reloaded. The code to create a polygon appears in an auxiliary " + "window when the 'Code' button is clicked.\n\n" + "To construct or edit an animation, we manipulate a list of keyframes, a list of curves, " + "and, implicitly, the number of frames interpolated between the keyframes, " + "to create smooth motions. When editing begins, a single default polygon is displayed. This " + "can be edited using the operations described in the next paragraph, or additional " + "polygons can be added to the set being edited. If this is done, any one of these polygons can " + "be selected for editing and edited in the same way. The basic operations supported are therefore: \n\n" + "(1) Curve editing, including addition and deletion of control points;\n\n" + "(2) Addition and deletion of keyframes;\n\n" + "(3) Addition and deletion of curves.\n\n" + "To add a polygon to the animation, either Shift-Option drag the polygon (or spline) or one of the " + "edit handles attached to it, or click the "+" button at the left of the second row of controls " + "(which adds a new default triangle to the animation). Each polygon added in this way is reprented " + "by one of the lettered 'polygon select' boxes seen in the second row of controls. Clicking on any " + "of these boxes selects the corresponding polygon and brings it to the front of the rendering order for " + "editing. After editing, the polygon can then be put back into its proper rendering-order position " + "by clicking the '@' button seen next to the '+' button.\n\n" + "A polygon can be deleted from all frames of the animation by command-clicking either it or the " + "lettered 'polygon select' box correxponding to it. The rendering order can be modified by dragging the " + "lettered 'polygon select' boxes left and right.\n\n" + "To record the current set of polygons in a new keyframe, click the " + "'+ Keyframe' button. This adds the curves to the keyframe list and causes an additional keyframe icon " + "to appear. The curves can then be edited, and their re-edited form either added " + "as the next keyframe (by clicking '+ Keyframe' again), or captured as the new state of the " + "current keyframe by clicking the 'Capture' button. This can be done repeatedly, to build up " + "an animation. Once at least two keyframes have been constructed, the animation can be played " + "by clicking the 'Play' button. Clicking the 'Save' button saves the current animation to a file. " + "Clicking 'Load' opens a dialog which allows such a saved file to be loaded. Clicking 'Code' " + "puts the code for the current keyframe K into an auxiliary window, and writes it to the SETL console.\n\n" + "Clicking 'Clear' once thows away the animation, " + "leaving just its initial keyframe. Clicking 'Clear' again reduces the remaining frame to a " + "single polygon; clicking a third time reduces this to the default triangle.\n\n" + "Animations can be edited in the following way. Clicking a keyframe icon jumps you to that " + "keyframe, which can then be edited by dragging the handles of any of its polygons. The edit becomes " + "final, and is entered into the keyframe list, when the keyframe icon, or any other, is clicked again. " + "Option-clicking a keyframe icon inserts a second, separately editable, copy of the keyframe " + "immediately after it. Shift-Option-clicking a keyframe icon inserts a second, separately editable, copy " + "of the keyframe at the very end of the keyframes list. Command-clicking a keyframe icon deletes the " + "keyframe.\n\nBy default, 10 frames are interpolated between keyframes. This number can be changed by " + "jumping to a keyframe K and then moving the control slider, which sets the number of frames " + "interpolated between K and the next keyframe.\n\n" + "Animation editing can also be operated in a second 'display interpolated frames' mode, " + "which is entered by clicking on the '*'-button. In this mode, the keyframe icons are " + "spaced out to reflect the number of frames interpolated between them, and moving the control " + "slider scans frame-by-frame over the whole animation. Clicking the Add Keyframe" + "Clicking 'Code' puts the code for F into an auxiliary window. " + "To exit this edit mode, just click any keyframe icon."; -- help_msg := help_win("message",data); help_msg("side") := "top"; -- help_msg("width,font") := "500,{Monaco 9}"; tex := help_win("text","80,40"); tex("side") := "left"; -- create a text area tex("wrap,font") := "word,{Monaco 9}"; tex(OM) := data; sbv := help_win("scrollbar","v,16"); -- create a vertical scrollbar sbv("side,fill") := "left,y"; tex("yscroller") := sbv; -- else -- simply re-open -- help_win.win_open(); -- end if; end help_cmd; procedure star_but_action(); -- action for star button display_msg("text") := "*"; -- note that slider controls display of inbetweened state star_but("state"):= "disabled"; displaying_inbetween := true; -- set flag indicating this frames_between := frames_between(1..#frames_between min #captured_states); -- throw out extras tot_number_frames := 0 +/ frames_between; -- get total number of frames showing_tempo := false; -- not showing tempo the_slider("from") := 0; the_slider("to") := str(tot_number_frames - frames_between(#frames_between)); the_slider(OM) := "0"; -- set the slider to its start position_keyframe_icons(true); -- position buttons by placing them reflect_slider(); -- and adjust the display end star_but_action; procedure but_action(but); -- binds action to keyframe selection button return lambda(); -- put the text of this button into the display button, and into 'current_keyframe' if just_deleted then just_deleted := false; return; end if; if not displaying_inbetween then save_current_keyframe(); -- save info for the keyframe currently being edited --print("saved current_keyframe: ",current_keyframe); end if; star_but("state"):= "normal"; -- activate the star_but, which may have been disabled position_keyframe_icons(false); -- position buttons by packing them displaying_inbetween := false; -- set flag indicating that display is of keystate showing_tempo := false; -- not showing tempo the_slider("to") := "100"; -- reset the slider limits, which may have been changed the_slider("from") := "1"; display_msg("text") := (bt := but("text")); -- now start to move to the new frame current_keyframe := unstr(bt); -- update the current_keyframe variable the_slider(OM) := frames_between(current_keyframe); -- position the slider to show the inter-keyframe gap graphics := captured_states(current_keyframe); -- get the graphics for the new current keyframe --print("#captured_states",#captured_states," ",current_keyframe," ",graphics); render_graphics(graphics); -- change display to the new graphics place_dots(graphics(level_being_edited)); -- place dots around the image being edited -- [spline_fill_color,poly_fill_color,show_poly("selected"), -- adjust the checkboxes and color info -- show_spline("selected"),fill_poly("selected"),fill_spline("selected")] -- := level_data(level_being_edited)(3); end lambda; end but_action; --->documentation procedure render_graphics(graphics); -- render the full graphical configuration -- Each graphics vector consists of one entry for each level of the multi-level graphic involved -- in an animation. Each such entry is a vector of control points. The level_data tuple has the form -- [polygon_object_of_level,spline_object_of_level,control_points,aux_data]; -- where aux_data is -- [spline_fill_color,poly_fill_color,show_poly_flag,show_spline_flag,fill_poly_flag,fill_spline_flag] --print("----"); for data = graphics(lev) loop -- iterate over the graphic elements at all levels, positioning them [pol,splin,aux_data] := level_data(lev); [splin_fill_color,pol_fill_color,show_pol,show_splin,fill_pol,fill_splin] := aux_data; --print("render_graphics-splin_fill_color: ",splin_fill_color); if (ptk := pol.tk_kind()) = "line" then -- line case pol("fill") := pol_fill_color; splin("fill") := splin_fill_color; else -- line case; use the fill unconditionally pol("fill") := if fill_pol = "1" then pol_fill_color else "{}" end if; splin("fill") := if fill_splin = "1" then splin_fill_color else "{}" end if; end if; pol("coords") := if show_pol = "1" then data else if ptk = "rectangle" then offrect else offscreen end if end if; splin("coords") := if show_splin = "1" then data else if ptk = "rectangle" then offrect else offscreen end if end if; --print("pol('coords'): ",pol("coords"),"\n\t\t",pol); end loop; end render_graphics; -- there are two kinds of insert actions: one triggered by clicking the Add Keyframe button -- when displaying_inbetween; the other by option-clicking a keyframe icon when not displaying_inbetween procedure insert_action(); -- insert a new keyframe at this point, if displaying_inbetween -- first find the current keyframe numbers and the desired intermediate frame number frames_between := frames_between(1..#frames_between min #captured_states); -- throw out extras slider_val := the_slider(OM); -- get the indicated number of frames if exists j in [1..nsb := #frames_between] | (sb := 0 +/ frames_between(1..j)) >= slider_val then steps_before := sb - frames_between(j); -- will display an inbetweened step if j = nsb then -- insertion is after the final image place_dots(captured_states(nsb)(1)); -- display the final image with dots at level 1 render(); -- re-render, to show new configuration interm_state := captured_states(insert_after := nsb); -- duplicate the final image steps_after_insert := 10; steps_before_insert := frames_between(nsb); else -- display step slider_val - steps_before in range of key j insert_after := j; -- insertion is made after this position tot_steps := frames_between(j) + 1; -- get the total number of steps in the range part := float(steps_before_insert := slider_val + 1 - steps_before)/float(tot_steps); -- and the fraction to the end csj := captured_states(j); -- get the two steps we are interpolating between csjp := captured_states(j + 1); interm_state := []; -- will collect the intermediate state to capture for gr_at_lev = csj(lev) loop next_gr_at_lev := csjp(lev); -- get the next graphic at this level state_j := gr_at_lev; state_jp := next_gr_at_lev; interm_gr_at_lev := [sjk + (state_jp(k) - sjk) * part: sjk = state_j(k)]; -- display the image corresponding to this state interm_gr_at_lev_stg := [str(x): x in interm_state]; [-,-,show_poly_flag,show_spline_flag] := aux_stuff := level_data(lev)(3); polobj := level_data(lev)(1); splobj := level_data(lev)(2); interm_state with:= interm_gr_at_lev; -- determine if spline and/or poly should be shown if show_spline_flag = "1" then -- draw the spline splobj("coords") := join(interm_gr_at_lev_stg,","); -- draw this level of the configuration end if; if show_poly_flag = "1" then -- draw the poly polobj("coords") := join(interm_gr_at_lev_stg,","); -- draw this level of the configuration end if; if lev = 1 then place_dots(interm_gr_at_lev_stg); end if; -- dots are placed in level 1 end loop; -- and the fraction to the end steps_after_insert := tot_steps - steps_before_insert; end if; else -- insertion is after the final image interm_state := captured_states(insert_after := nsb); -- duplicate the final image steps_after_insert := 10; steps_before_insert := frames_between(nsb); end if; captured_states(insert_after + 1..insert_after) := [interm_state]; -- make the insertion current_keyframe := insert_after + 1; -- the inserted state counts as that being edited frames_between(insert_after..insert_after) := [steps_before_insert,steps_after_insert]; reflect_captured_states(true); -- now redisplay the keyframe icons were_spaced_out := false; -- pretend that the icons were not spaced out --print("adding keyframe: "); dump_captured_states(); end insert_action; procedure dump_captured_states(); for gr = captured_states(keyf), dat = gr(lev) loop print(keyf," ",lev," ",dat); end loop; end dump_captured_states; procedure insert_after_action(but); -- insert a new keyframe after this keyframe, if not displaying_inbetween return lambda(); -- insert a new keyframe if displaying_inbetween then Tk.beeper(); return; end if; -- we are inbetweening; refuse the deletion current_keyframe := (but_num := unstr(but("text"))) + 1; -- get the number of the button clicked state_to_copy := captured_states(but_num); captured_states(current_keyframe..but_num) := [state_to_copy]; -- double the captured state place_dots(state_to_copy(level_being_edited)); -- this becomes the state at the inserted keyframe frames_between(current_keyframe..but_num) := [frames_between(but_num)]; -- double the step between --print("but_num: ",but_num," ",current_keyframe," ",state_to_copy," ",captured_states); display_msg("text") := str(current_keyframe); reflect_captured_states(false); -- add the extra button -- reflect the captured states in the captured states indication area end lambda; -- delete the selected keyframe end insert_after_action; procedure delete_keyframe_action(but); -- delete the selected keyframe return lambda(); -- delete the selected keyframe -- if displaying_inbetween then Tk.beeper(); return; end if; -- we are inbetweening; refuse the deletion -- else we are not inbetweening just_deleted := true; -- flag to prevent second action if #captured_states = 1 then Tk.beeper(); return; end if; -- refuse deletion of last keyframe but_num := unstr(but("text")); -- get the number of the button being deleted last_but := keyframe_icons(nlb := #keyframe_icons); last_but("place") := OM; -- delete the final button keyframe_icons(nlb) := OM; captured_states(but_num..but_num) := []; -- do the deletion if but_num > 1 then -- add the frames for the deleted node to those for the prior frames_between(but_num - 1..but_num - 1) := [frames_between(but_num - 1) + frames_between(but_num)]; end if; if but_num = current_keyframe then -- move to the next state if possible, otherwise backwards if but_num <= (ncs := #captured_states) then graphics := captured_states(current_keyframe); place_dots(graphics(level_being_edited)); -- place dots around the new image to be edited render_graphics(graphics); -- render the full graphical configuration elseif but_num > 1 then -- move backwards current_keyframe -:= 1; display_msg("text") := str(current_keyframe); graphics := captured_states(current_keyframe); place_dots(graphics(level_being_edited)); -- place dots around the new image to be edited render_graphics(graphics); -- render the full graphical configuration end if; end if; -- now we must position the keyframe icons properly reflect_captured_states(false); -- reflect the captured states in the captured states indication area end lambda; end delete_keyframe_action; procedure position_keyframe_icons(space_out); -- position the key_frame icons within their frame if (nfb := #frames_between) = 1 then return; end if; if space_out then -- position the icons by spacing them out -- work out the desired positions of the icons frames_till := [total_frames := 0]; -- will be partial sums of frames_between(j) for j in [1.. nfb - 1] loop total_frames +:= frames_between(j); frames_till with:= total_frames; end loop; total_frames := float(total_frames); frame_locs := [str(fix(float(ft) * canvas_width/ total_frames + 20.0)): ft = frames_till(j)]; --print("total_frames: ",total_frames," ",frames_till," ",frame_locs); for icon = keyframe_icons(j) loop icon("place,x,y,anchor") := frame_locs(j) + ",0,nw"; -- position at calculated place end loop; else -- position the icons by placing them tightly to the left nki := #keyframe_icons; for j in [1..nki] loop -- place the buttons tot_width := if j < 10 then j * 20 else 227 + (j - 11) * 27 end if; but := keyframe_icons(j); but("place,x,y,anchor") := str(tot_width) + ",0,nw"; end loop; end if; end position_keyframe_icons; procedure place_dots(dot_data); -- writes dots from given data --print("place_dots: ",dot_data); if (ndo := 2 * #dot_objs) /= (ndd := #dot_data) then if ndo > ndd then -- must drop the surplus dots for j in [ndd/2 + 1..ndo/2] loop doj := dot_objs(j); name_to_loc(doj.Tk_id()) := OM; doj("coords") := OM; end loop; end if; dot_objs := dot_objs(1..#dot_objs min (ndd/2)); -- throw away surplus dots for j in [ndo + 1,ndo + 3..ndd - 1] loop -- make any new dots needed x := dot_data(j); y := dot_data(j + 1); new_dot := ca("oval",dot_stg(x,y)); new_dot("fill") := "yellow"; attach_actions(new_dot); -- attach actions to the dot object dot_objs(j/2 + 1) := new_dot; name_to_loc(new_dot.Tk_id()) := j/2 + 1; end loop; end if; --print("place_dots2: ",dot_data," ",ndd," ",ndo," ",name_to_loc); for j in [1,3..(ndd min ndo) - 1] loop doj := dot_objs(j/2 + 1); -- access and position the dot objects, which must be in the top level doj.raise(OM); doj("coords") := dot_stg(dot_data(j),dot_data(j + 1)); end loop; end place_dots; procedure get_dots(); -- get current position of dots stg_pairs := [breakup(get_center(dot_obj("coords")),","): dot_obj in dot_objs]; return [ ] +/ [[unstr(x),unstr(y)]: [x,y] in stg_pairs]; end get_dots; procedure reflect_slider(); -- uses slider, either to set number of steps between a given frame and the next -- or to choose an intermediate configuration slider_val := the_slider(OM); -- get the indicated number of frames if showing_tempo then -- slider controls the tempo tempo := slider_val; return; -- done with this case elseif displaying_inbetween then -- display the appropriate inbetweened frame if exists j in [1..nsb := #frames_between] | (sb := 0 +/ frames_between(1..j)) >= slider_val then steps_before := sb - frames_between(j); -- will display an inbetweened step if j = nsb then -- display the final image place_dots(captured_states(#frames_between)(1)); -- display the final image with dots at level 1 render(); -- re-render, to show new configuration else -- display step slider_val - steps_before in range of key j tot_steps := frames_between(j) + 1; -- get the total number of steps in the range part := float(slider_val + 1 - steps_before)/float(tot_steps); -- and the fraction to the end csj := captured_states(j); -- get the two steps we are interpolating between csjp := captured_states(j + 1); for gr_at_lev = csj(lev) loop next_gr_at_lev := csjp(lev); -- get the next graphic at this level state_j := gr_at_lev; state_jp := next_gr_at_lev; interm_state := [sjk + (state_jp(k) - sjk) * part: sjk = state_j(k)]; -- display the image corresponding to this state interm_state_stg := [str(x): x in interm_state]; [-,-,show_poly_flag,show_spline_flag] := level_data(lev)(3); -- determine if spline and/or poly should be shown if show_spline_flag = "1" then -- draw the spline csplcurv := level_data(lev)(2); -- get the spline object for this level csplcurv("coords") := join(interm_state_stg,","); -- draw this level of the configuration end if; if show_poly_flag = "1" then -- draw the poly cpolcurv := level_data(lev)(1); -- get the poly object for this level cpolcurv("coords") := join(interm_state_stg,","); -- draw this level of the configuration end if; if lev = 1 then place_dots(interm_state_stg); end if; -- dots are placed in level 1 end loop; end if; else -- display the final image place_dots(captured_states(nsb)(1)); -- display the final image render(); -- re-render, to show new configuration end if; else -- adjust the number of inbetweened steps frames_between(current_keyframe) := slider_val; end if; end reflect_slider; procedure code_cmd; -- capture code command for a polygon save_current_keyframe(); -- update the current graphic txt := ""; -- code text will be collected graphics := captured_states(current_keyframe); for data = graphics(lev) loop aux_d := (ld := level_data(lev))(3); g_kind := ld(1).tk_kind(); -- get the kind of the graphic slev := str(lev); [spline_f_color,poly_f_color,showe_poly,showe_spline,fil_poly,fil_spline] := aux_d; showe_poly := showe_poly = "1"; showe_spline := showe_spline = "1"; fil_poly := fil_poly = "1"; fil_spline := fil_spline = "1"; ndd := #data; polygon_data := "" +/ [str(x) + if j = ndd then "" else "," end if: x = data(j)]; txt +:= "\nthe_data" + slev + " := \"" + polygon_data + "\";\n"; if showe_poly then case g_kind when "polygon" => txt +:= "the_polygon" + slev + " := the_canvas(\"polygon\",the_data" + slev + ");\n"; txt +:= "the_polygon" + slev + "(\"width,outline\") := \"1,black\";\n"; txt +:= "the_polygon" + slev + "(\"fill\") := \"" + if fil_poly then poly_f_color else "{}" end if + "\";\n"; when "line" => txt +:= "the_line" + slev + " := the_canvas(\"line\",the_data" + slev + ");\n"; txt +:= "the_line" + slev + "(\"width,outline\") := \"1,black\";\n"; txt +:= "the_line" + slev + "(\"fill\") := \"" + poly_f_color + "\";\n"; when "rectangle" => txt +:= "the_rect" + slev + " := the_canvas(\"rectangle\",the_data" + slev + ");\n"; txt +:= "the_rect" + slev + "(\"width,outline\") := \"1,black\";\n"; txt +:= "the_rect" + slev + "(\"fill\") := \"" + if fil_poly then poly_f_color else "{}" end if + "\";\n"; end case; end if; if showe_spline then case g_kind when "polygon" => txt +:= "the_spline" + slev + " := the_canvas(\"polygon\",the_data" + slev + ");\n"; txt +:= "the_spline" + slev + "(\"smooth,width,outline\") := \"true,1,black\";\n"; txt +:= "the_spline" + slev + "(\"fill\") := \"" + if fil_spline then spline_f_color else "{}" end if + "\";\n"; when "line" => txt +:= "the_curve" + slev + " := the_canvas(\"line\",the_data" + slev + ");\n"; txt +:= "the_curve" + slev + "(\"smooth,width,outline\") := \"true,1,black\";\n"; txt +:= "the_curve" + slev + "(\"fill\") := \"" + spline_f_color + "\";\n"; when "rectangle" => txt +:= "the_oval" + slev + " := the_canvas(\"oval\",the_data" + slev + ");\n"; txt +:= "the_oval" + slev + "(\"width,outline\") := \"1,black\";\n"; txt +:= "the_oval" + slev + "(\"fill\") := \"" + if fil_spline then spline_f_color else "{}" end if + "\";\n"; end case; end if; end loop; code_window := Tk("toplevel","100,100"); code_window(OM) := "Code for the polygons"; code_area := code_window("text","80,40"); code_area("side") := "top"; code_area(OM) := txt; print(txt); end code_cmd; procedure photo_cmd; -- photograph the canvas hide_dots(); -- image_of_canvas := image(ca.gr_image_of()); -- capture the contents of the canvas, as a Grlib mimage -- print(type(ca.gr_image_of()),image_of_canvas); -- write_captioned_image(image_of_canvas,"Canvas contents"); -- display it image_of_canvas := ca.image_of([unstr(x): x in breakup("0,0," + canvas_size,",")]); -- capture the contents of the canvas, as a Tk image show_dots(); ntop := Tk("toplevel",canvas_size); -- create a toplevel, and put a canvas into it ntopca := ntop("canvas",canvas_size); ntopca("side") := "top"; imaje := ntopca("image",image_of_canvas); -- create and place image imaje("coords,anchor") := "0,0;nw"; end photo_cmd; procedure write_captioned_image(an_image,cap); -- write image to a Tk window [height,width,num_planes,image_type] := #an_image; -- image type is 1 for floating image, 2 for discrete ('grayscale') print("Writing image = ", cap); toplev := Tk("toplevel","10,10"); newca := toplev("canvas",str(height) + "," + str(width)); newca("side") := "top"; -- create canvas -- use the Grlib image to create a Tk image if num_planes = 1 then -- pad out the image with additional planes extended_image := image([[0.0,0.0,0.0],[height,width]]); -- set up a black image of 3 planes ai1 := an_image(1..1); for j in [1..3] loop extended_image(j..j) := ai1; end loop; tk_abs_image := Tk("image",(extended_image.to_int()).native_im()); elseif num_planes < 3 then -- pad out the image with additional planes extended_image := image([[0.0,0.0,0.0],[height,width]]); -- set up a black image of 3 planes for j in [1..num_planes] loop extended_image(j..j) := an_image(j..j); end loop; tk_abs_image := Tk("image",(extended_image.to_int()).native_im()); elseif num_planes > 3 then -- drop the extra planes tk_abs_image := Tk("image",(an_image(1..3).to_int()).native_im()); else tk_abs_image := Tk("image",(an_image.to_int()).native_im()); end if; toplev(OM) := cap; -- enter the window title canv_image := newca("image",tk_abs_image); -- create as canvas image and place it canv_image("coords,anchor") := "0,0;nw"; -- place to make the image visible end write_captioned_image; procedure save_cmd; -- save polygon or animation Tk("ask_save_file","initialfile") := "my_anim.ani"; -- get name of file to save if dialog_response /= "" then -- if not canceled, do actual save handle := open(dialog_response,"TEXT-OUT"); -- open the save file red_level_data := [levdat(3) with (levdat(1)).tk_kind(): levdat in level_data]; data := ["anim",captured_states,red_level_data,frames_between]; printa(handle,data); close(handle); end if; end save_cmd; procedure re_initialize(); -- re-initalize variables, preparatory to read of new data new_dot := OM; -- most recently created dot current_keyframe := 1; -- keyframe currently being edited displaying_inbetween := false; -- if true, this prohibits editing were_spaced_out := false; -- were keyframe icons placed to the left? unused_lets := {c: c in "BCDEFGHIJKLMN"}; place_of_caption := {[c,j]: c = captions(j)}; -- maps each label into its place the_slider(OM) := 1; -- position the slider back to the left for [pol,spl,-] = level_data(lev) loop -- clear the polygon and spline objects pol("coords") := OM; spl("coords") := OM; end loop; for dot_obj in dot_objs loop dot_obj("coords") := OM; end loop; -- clear the dot objects name_to_loc := {}; -- clear the dot object name_to_loc map for [lab,cap] in labs_and_caps loop lab("coords") := OM; cap("coords") := OM; end loop; -- clear the lab and caption objects labs_and_caps := [make_lab("A",1)]; -- and make one label, namely an "A" unused_lets less:= "A"; place_of_caption("A") := 1; level_data := []; -- clear the level data end re_initialize; procedure load_cmd; -- load animation Tk("ask_file","") := ""; -- get name of file to read if dialog_response = "" then return; end if; -- if canceled, give up handle := open(dialog_response,"TEXT-IN"); -- open for input re_initialize(); -- re_initialize environment reada(handle,file_data); -- read the file close(handle); -- close it --print("file_data: ",file_data); [-,captured_states,red_level_data,frames_between] := file_data; -- get reduced captured states, level data, and frames_between level_data := []; -- first we restore the level_data in its proper format for aux = red_level_data(lev) loop -- loop over saved graphic levels [splin_fill_color,pol_fill_color,show_pol,show_splin,fill_pol,fill_splin,obj_kind] := aux; koords := captured_states(1)(lev); -- get the polygon coordinates for the first frame case obj_kind when "polygon" => pol := ca("polygon",jkoords := join([str(x): x in koords],",")); -- make poly splin := ca("polygon",jkoords); -- make spline when "rectangle" => pol := ca("rectangle",jkoords := join([str(x): x in koords],",")); -- make poly splin := ca("oval",jkoords); -- make oval when "line" => pol := ca("line",jkoords := join([str(x): x in koords],",")); -- make poly splin := ca("line",jkoords); -- make spline otherwise => -- treat as spline pol := ca("polygon",jkoords := join([str(x): x in koords],",")); -- make poly splin := ca("polygon",jkoords); -- make spline end case; level_data with:= [pol,splin,aux(1..6)]; if not (show_pol = "1") then pol("coords") := offscreen; end if; if not (show_splin = "1") then splin("coords") := offscreen; end if; pfc := if fill_pol = "1" or obj_kind = "line" then pol_fill_color else "{}" end if; pol("fill,width,outline") := pfc + ",1,red"; sfc := if fill_splin = "1" or obj_kind = "line" then splin_fill_color else "{}" end if; splin("fill,smooth,width,outline") := sfc + ",true,1,blue"; if lev = 1 then -- first level of first keyframe; make and position the dots cur_poly_curve := pol; cur_spline_curve := splin; level_being_edited := 1; -- start with curve 1, level 1 dot_objs := []; -- will build for j in [1,3..#koords] loop new_dot := ca("oval",dot_stg(koords(j),koords(j + 1))); -- create a new dot new_dot("fill") := "yellow"; -- make it yellow attach_actions(new_dot); -- attach actions to the dot object dot_objs with:= new_dot; -- insert the new dot name_to_loc(new_dot.Tk_id()) := #dot_objs; -- update the name_to_loc map end loop; -- now we must set the checkboxes correctly show_poly("selected") := show_pol; show_spline("selected") := show_splin; fill_poly("selected") := fill_pol; fill_spline("selected") := fill_splin; if cur_poly_curve.tk_kind() = "line" then fill_poly("selected,state") := "0,disabled"; fill_spline("selected,state") := "0,disabled"; else fill_poly("state") := "normal"; fill_spline("state") := "normal"; end if; else -- levels other than first; make extra graphic buttons let := arb(unused_lets); for c in unused_lets | c < let loop let := c; end loop; unused_lets less:= let; labs_and_caps with:= (lab_and_cap := make_lab(let,nlcp1 := #labs_and_caps + 1)); place_of_caption(let) := nlcp1; [lab,cap] := lab_and_cap; lab("fill") := "yellow"; end if; end loop; -- end of iteration over graphic levels [lab_editing,cap] := labs_and_caps(1); lab_editing("fill") := "green"; show_poly_cmd_rev; show_spline_cmd_rev; reflect_captured_states(false); -- reflect the captured states in the captured states indication area the_slider(OM) := frames_between(1); -- position the slider appropriately for the first frame star_but("state") := "normal"; -- enable the star_but display_msg("text") := "1"; -- set the star_but text to "1" end load_cmd; procedure store_pick(picked); -- closure generator for menu picks return lambda(); match(picked,"b:"); menub("text") := (curve_kind := picked); end lambda; end store_pick; procedure show_poly_cmd; -- turn the polygon-show flag on and off; then re-render poly_kind := level_data(level_being_edited)(1).tk_kind(); offs := if poly_kind = "rectangle" then offrect else offscreen end if; if show_poly("selected") = "1" then dot_centers := join([get_center(dot_obj("coords")): dot_obj in dot_objs],","); cur_poly_curve("coords") := dot_centers; else cur_poly_curve("coords") := offs; -- place the poly offscreen, but leave it in the rendering order end if; aux_data := level_data(level_being_edited)(3); -- aux_data is [spline_fill_color,poly_fill_color,show_poly,show_spline,fill_poly,fill_spline] aux_data(3) := show_poly("selected"); level_data(level_being_edited)(3) := aux_data; end show_poly_cmd; procedure show_spline_cmd; -- turn the spline-show flag on and off; then re-render poly_kind := level_data(level_being_edited)(1).tk_kind(); offs := if poly_kind = "rectangle" then offrect else offscreen end if; if show_spline("selected") = "1" then dot_centers := join([get_center(dot_obj("coords")): dot_obj in dot_objs],","); cur_spline_curve("coords") := dot_centers; else cur_spline_curve("coords") := offs; -- place the cur_spline_curve offscreen, but leave it in the rendering order end if; aux_data := level_data(level_being_edited)(3); -- aux_data is [spline_fill_color,poly_fill_color,show_poly,show_spline,fill_poly,fill_spline] aux_data(4) := show_spline("selected"); level_data(level_being_edited)(3) := aux_data; end show_spline_cmd; procedure show_poly_cmd_rev; -- reversed version for use during load if show_poly("selected") = "1" then dot_centers := join([get_center(dot_obj("coords")): dot_obj in dot_objs],","); --print("show_poly_cmd_rev: ",dot_centers,cur_poly_curve); cur_poly_curve("coords") := dot_centers; else cur_poly_curve("coords") := offscreen; -- place the poly offscreen, but leave it in the rendering order end if; end show_poly_cmd_rev; procedure show_spline_cmd_rev; -- reversed version for use during load if show_spline("selected") = "1" then dot_centers := join([get_center(dot_obj("coords")): dot_obj in dot_objs],","); cur_spline_curve("coords") := dot_centers; else cur_spline_curve("coords") := offscreen; -- place the spline offscreen, but leave it in the rendering order end if; end show_spline_cmd_rev; procedure fill_poly_cmd; -- turn the polygon fill on and off; then re-render cur_poly_curve("fill") := if fill_poly("selected") = "1" then poly_fill_color else "{}" end if; aux_data := level_data(level_being_edited)(3); -- aux_data is [spline_fill_color,poly_fill_color,show_poly,show_spline,fill_poly,fill_spline] aux_data(5) := fill_poly("selected"); level_data(level_being_edited)(3) := aux_data; end fill_poly_cmd; procedure fill_spline_cmd; -- turn the spline-show fill on and off; then re-render cur_spline_curve("fill") := if fill_spline("selected") = "1" then spline_fill_color else "{}" end if; aux_data := level_data(level_being_edited)(3); -- aux_data is [spline_fill_color,poly_fill_color,show_poly,show_spline,fill_poly,fill_spline] aux_data(6) := fill_spline("selected"); level_data(level_being_edited)(3) := aux_data; end fill_spline_cmd; -- procedure join(tup,stg); -- standard join operation -- nt := #tup; return "" +/ [str(item) + if j = nt then "" else stg end if: item = tup(j)]; -- end join; procedure dot_stg(x,y); -- construct a dot with given center if is_string(x) then x := unstr(x); end if; if is_string(y) then y := unstr(y); end if; return str(x - 3.0) + "," + str(y - 3.0) + "," + str(x + 3.0) + "," + str(y + 3.0); end dot_stg; procedure get_center(coords); -- get the centerpoint of a polygon x := 0.0 +/ [unstr(c): c = coords(j) | odd(j)]; y := 0.0 +/ [unstr(c): c = coords(j) | even(j)]; return str(x / float(#coords / 2)) + "," + str(y / float(#coords / 2)); end get_center; procedure get_center_float(coords); -- get the centerpoint of a polygon x := 0.0 +/ [unstr(c): c = coords(j) | odd(j)]; y := 0.0 +/ [unstr(c): c = coords(j) | even(j)]; return [str(x / float(#coords / 2)),str(y / float(#coords / 2))]; end get_center_float; procedure color_poly_cmd(); -- open a color dialog and capture its output Tk("ask_color","initialcolor,title") := poly_fill_color + ",Pick a Color"; if dialog_response = "" then return; end if; poly_fill_color := dialog_response; if fill_poly("selected") = "1" or (knd := cur_poly_curve.tk_kind()) = "line" or knd = "canvas_text" then cur_poly_curve("fill") := poly_fill_color; end if; end color_poly_cmd; procedure color_spline_cmd(); -- open a color dialog and capture its output Tk("ask_color","initialcolor,title") := spline_fill_color + ",Pick a Color"; if dialog_response = "" then return; end if; spline_fill_color := dialog_response; if fill_spline("selected") = "1" or cur_spline_curve.tk_kind() = "line" then cur_spline_curve("fill") := spline_fill_color; end if; end color_spline_cmd; procedure drag_end_proc(objs,xy); -- drag-end process for label-and-caption --if exists gr = captured_states(keyf), dat = gr(lev) | #dat /= #captured_states(1)(lev) then print("bad input: ",output_was); dump_captured_states(); return; end if; [x,-] := xy; new_place := if x < 10 then 0 else ((x - 10) max -10)/50 + 1 end if; caption_moved := objs(2)("text")(2); old_place := place_of_caption(caption_moved); if new_place = old_place then return; end if; -- no real motion if new_place < old_place then new_place +:= 1; end if; graphics := captured_states(current_keyframe); new_place min:= #graphics; for [let,place] in place_of_caption | place > old_place loop place_of_caption(let) -:= 1; end loop; for [let,place] in place_of_caption | place >= new_place loop place_of_caption(let) +:= 1; end loop; --print("drag_end_proc: ",old_place," to ",new_place," ",#graphics," ",place_of_caption); place_of_caption(caption_moved) := new_place; lc_moved := labs_and_caps(old_place); labs_and_caps(old_place..old_place) := []; labs_and_caps(new_place..new_place - 1) := [lc_moved]; for place = place_of_caption(let) loop [lab,cap] := labs_and_caps(place); -- get the associated canvas objects lab("coords") := coord_of_lab(place); lab("fill") := "yellow"; cap("coords") := coord_of_cap(place); end loop; blob_moved := level_data(old_place); -- put the graphic corresponding to the moved caption into its proper position if new_place > old_place then -- moving forward: put in position just after present occupant of new_place just_before := level_data(new_place); [pol,splin,-] := blob_moved; pol.raise(just_before(2)); splin.raise(pol); elseif new_place < old_place then -- lower to position just before 'just_after' if new_place > 1 then -- put following present occupant of new_place - 1 just_before := level_data(new_place - 1); [pol,splin,-] := blob_moved; pol.raise(just_before(2)); splin.raise(pol); else -- put at start [pol,splin,-] := blob_moved; splin.lower(OM); pol.lower(OM); end if; end if; capstats := captured_states; for graphics = capstats(keyf) loop data_moved := graphics(old_place); graphics(old_place..old_place) := []; graphics(new_place..new_place - 1) := [data_moved]; captured_states(keyf) := graphics; end loop; level_data(old_place..old_place) := []; level_data(new_place..new_place - 1) := [blob_moved]; [cur_poly_curve,cur_spline_curve,aux] := level_data(level_being_edited); [spline_fill_color,poly_fill_color,show_poly("selected"), show_spline("selected"),fill_poly("selected"),fill_spline("selected")] := aux; if cur_poly_curve.tk_kind() = "line" then fill_poly("selected,state") := "0,disabled"; fill_spline("selected,state") := "0,disabled"; else fill_poly("state") := "normal"; fill_spline("state") := "normal"; end if; place_dots_from(captured_states(current_keyframe)(level_being_edited)); -- place the dots, which might be examined on a subsequent drag [lab,cap] := labs_and_caps(level_being_edited); lab("fill") := "green"; end drag_end_proc; procedure make_lab(letter,place); -- create a label 'lab' and its caption 'cap' lab := cab("rectangle",coord_of_lab(place)); lab("fill") := "yellow"; first_label ?:= unstr((lab.TK_id())(2..)); lab{"Enter"} := hilite(letter); -- entering the label hilites the corresponding graphic lab{"Leave"} := de_hilite(letter); -- leaving the label de-hilites the corresponding graphic cap := cab("text",letter); -- create a draggable label cap("anchor,font") := "nw,{Times 12 bold}"; cap("coords") := coord_of_cap(place); lab{"Command-ButtonRelease-1"} := erase([lab,cap]); -- command clicking on label or caption erases both cap{"Command-ButtonRelease-1"} := erase([lab,cap]); make_horiz_draggable([lab,cap],make_editable,OM,drag_end_proc); -- make the label-and-caption draggable if lab_editing /= OM then lab_editing("fill") := "yellow"; end if; lab_editing := lab; cap_editing := cap; lab_editing("fill") := "green"; return [lab,cap]; -- and set up their and drag_start (mousedown) and drag-end (mouseup) actions end make_lab; procedure coord_of_lab(j); -- calculate position of box j return str(50 * j - 40) + ",3," + str(50 * j - 40 + 22) + ",23"; end coord_of_lab; procedure coord_of_cap(j); -- calculate position of caption j return str(50 * j - 40 + 6) + ",8"; end coord_of_cap; procedure hilite(letter); -- hilite the graphic corresponding to a letter return lambda(); blob := level_data(place_of_caption(letter)); --print("hilite: ",letix," ",blob); for x = blob(1..2)(j) loop to_hilite := if (xk := x.tk_kind()) = "line" then "fill" else "outline" end if; color_was(j) := x(to_hilite); x(to_hilite) := "yellow"; end loop; end lambda; end hilite; procedure de_hilite(letter); -- hilite the graphic corresponding to a letter return lambda(); blob := level_data(place_of_caption(letter)); for x = blob(1..2)(j) loop to_hilite := if (xk := x.tk_kind()) = "line" then "fill" else "outline" end if; x(to_hilite) := color_was(j); end loop; end lambda; end de_hilite; procedure erase(lab_and_cap); -- erase a letter and its corresponding graphic return lambda(); --print("erasing: ",labs_and_caps); if (nlc := #labs_and_caps) = 1 then Tk.beeper(); return; end if; -- don't allow deletion of last level [lab,cap] := lab_and_cap; unused_lets with:= (letter := cap("text")(2)); letix := place_of_caption(letter); -- find the location of the letter if level_being_edited = letix then level_being_edited := (level_being_edited - 1) max 1; end if; -- the level being edited must move off the erased level cap("coords") := lab("coords") := OM; -- delete the label and caption poc := place_of_caption(letter); place_of_caption(letter) := OM; -- delete the polygon and the spline corresponding to the letter being deleted [pol,spl,-] := level_data(poc); pol("coords") := OM; spl("coords") := OM; --print("\nerasing: ",poc," ",nlc," ",pol,"\n",spl,"\n",level_data); for lev in [poc..nlc - 1] loop --print("in loop from: ",poc); labs_and_caps(lev) := labs_and_caps(lev + 1); [labj,capj] := labs_and_caps(lev); labj("coords") := coord_of_lab(lev); capj("coords") := coord_of_cap(lev); letj := capj("text")(2); place_of_caption(letj) := lev; csc := captured_states; for gra = csc(keyf) loop gra(lev) := gra(lev + 1); -- shift the graphic in every keyframe captured_states(keyf) := gra; -- and install end loop; level_data(lev) := level_data(lev + 1); end loop; [cur_poly_curve,cur_spline_curve,aux] := level_data(level_being_edited); [spline_fill_color,poly_fill_color,show_poly("selected"), show_spline("selected"),fill_poly("selected"),fill_spline("selected")] := aux; labs_and_caps(nlc) := OM; -- shorten the labs_and_caps vector level_data(nlc) := OM; -- shorten the level_data vector --print("labs_and_caps: ",level_data); if cur_poly_curve.tk_kind() = "line" then fill_poly("selected,state") := "0,disabled"; fill_spline("selected,state") := "0,disabled"; else fill_poly("state") := "normal"; fill_spline("state") := "normal"; end if; csc := captured_states; for gra = csc(keyf) loop gra(nlc) := OM; -- shorten the graphic vector in every keyframe captured_states(keyf) := gra; -- and install end loop; graphics := captured_states(current_keyframe); -- post the revised current graphics dat_lbe := graphics(level_being_edited); -- get the data for the level being edited --print("dat_lbe: ",level_being_edited," ",dat_lbe); place_dots_from(dat_lbe); lab_and_cap := labs_and_caps(level_being_edited); -- get the label and caption of the element being edited make_editable(lab_and_cap,OM); end lambda; end erase; -- the elements of the graphics list are [poly,spline,dot_data,aux_data] procedure add_graphic(); -- add a new graphic if there is space if #unused_lets = 0 then Tk.beeper(); return; end if; -- no space save_current_keyframe(); -- save info for the graphic currently being edited -- get the least unused letter let := arb(unused_lets); for c in unused_lets | c < let loop let := c; end loop; unused_lets less:= let; labs_and_caps with:= (lab_and_cap := make_lab(let,nlcp1 := #labs_and_caps + 1)); place_of_caption(let) := nlcp1; [lev_dat,koords] := make_blob(); -- make a new initialized blob level_data with:= lev_dat; -- add to the polygons and aux data list for csn in [1..#captured_states] loop -- add the new blob to all the keyframes graphicz := captured_states(csn); -- the_blob has the format [poly,spline,dot_data,aux_data], graphicz with:= koords; -- so this also defines the aux dat for the new level captured_states(csn) := graphicz; -- write the data for the keyframe end loop; [cur_poly_curve,cur_spline_curve,aux_data] := lev_dat; level_being_edited := #graphicz; -- the new blob, added at the end, is that currently being edited place_dots(koords); -- place the dots around the new image to be edited -- set_aux_data(aux_data); -- set the default blob data into the checkboxes and colors end add_graphic; procedure save_current_keyframe(); -- save info for the graphic currently being edited graphics := captured_states(current_keyframe); -- we must adjust the graphics for the current keyframe graphics(level_being_edited) := get_dots(); -- save the element that was being edited captured_states(current_keyframe) := graphics; aux_data := [spline_fill_color,poly_fill_color,show_poly("selected"), -- collect the auxiliary data show_spline("selected"),fill_poly("selected"),fill_spline("selected")]; level_data(level_being_edited) := [cur_poly_curve,cur_spline_curve,aux_data]; end save_current_keyframe; procedure set_aux_data(aux_data); -- set the auxiliary data indicators and items [spline_fill_color,poly_fill_color,show_poly("selected"), show_spline("selected"),fill_poly("selected"),fill_spline("selected")] := aux_data; if cur_poly_curve.tk_kind() = "line" then fill_poly("selected,state") := "0,disabled"; fill_spline("selected,state") := "0,disabled"; else fill_poly("state") := "normal"; fill_spline("state") := "normal"; end if; end set_aux_data; procedure coord_list_from_poly(the_poly); -- get dot position from polygon data := the_poly("coords"); return [unstr(x): x in data]; end coord_list_from_poly; procedure make_editable(lab_and_cap,xy); -- drag-start routine -- this is called on mousedown on a label or caption. It is passed [lab,caption] and xy -- it should move the corresponding graphic to the display foreground, and select it for editing save_current_keyframe(); -- save info for the graphic currently being edited blob_editing := level_data(level_being_edited); if level_being_edited > 1 then blob_before := level_data(level_being_edited - 1); [pol,splin,-] := blob_editing; pol.raise(blob_before(2)); splin.raise(pol); else -- goes back at start of display list [pol,splin,-] := blob_editing; splin.lower(OM); pol.lower(OM); end if; if lab_editing /= OM then lab_editing("fill") := "yellow"; end if; [lab_editing,cap_editing] := lab_and_cap; lab_editing("fill") := "green"; but_let := cap_editing("text")(2); -- find the graphic corresponding to the button clicked graphics := captured_states(current_keyframe); dot_data := graphics(level_being_edited := place_of_caption(but_let)); -- keep the index of the element being edited place_dots(dot_data); -- place the dots around the image to be edited [cur_poly_curve,cur_spline_curve,aux_data] := level_data(level_being_edited); set_aux_data(aux_data); -- set the auxiliary data indicators and items --print("level_data(level_being_edited): ",level_data(level_being_edited)); cur_poly_curve.raise(OM); cur_spline_curve.raise(cur_poly_curve); for doj in dot_objs loop doj.raise(OM); end loop; end make_editable; procedure drop_edit(); -- put the item being edited back into place graphics := level_data(current_keyframe); blob_editing := level_data(level_being_edited); [pol,splin,-] := blob_editing; if level_being_edited > 1 then blob_before := level_data(level_being_edited - 1); pol.raise(blob_before(2)); splin.raise(pol); else -- goes back at start of display list splin.lower(OM); pol.lower(OM); end if; end drop_edit; end test;