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;