## diver-pane.pkg
#
# Application pane which displays a stick-figure
# animation of a diver step-by-step climbing a
# pole and finally diving in response to
# successive correct user answers to arithmetic
# problems.
# Compiled by:
# src/lib/x-kit/tut/arithmetic-game/arithmetic-game-app.libstipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package g2d= geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg #
package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg #
package wg = widget;
#
package di = diver_images; # diver_images is from src/lib/x-kit/tut/arithmetic-game/diver-images.pkg package si = splash_images; # splash_images is from src/lib/x-kit/tut/arithmetic-game/splash-images.pkgherein
package diver_pane
: Diver_Pane # Diver_Pane is from src/lib/x-kit/tut/arithmetic-game/diver-pane.api {
Plea_Mail = START | UP | WAVE | DIVE;
Diver_Pane
=
DIVER_PANE
{ widget: wg::Widget,
plea_slot: Mailslot( Plea_Mail )
};
Position = GONE | TOP | STEP Int;
top_margin = 48;
bottom_margin = 48;
person_high = 32;
pole_wide = 4;
platform_width = 12;
platform_depth = 2;
climb_increment = 9;
land_data = ( 16,
[ [ "0x8888", "0x2222", "0x1111", "0x4444",
"0x8888", "0x2222", "0x1111", "0x4444",
"0x8888", "0x2222", "0x1111", "0x4444",
"0x8888", "0x2222", "0x1111", "0x4444"
] ]
);
water_data = ( 16,
[ [ "0x5555", "0xaaaa", "0x5555", "0xaaaa",
"0x5555", "0xaaaa", "0x5555", "0xaaaa",
"0x5555", "0xaaaa", "0x5555", "0xaaaa",
"0x5555", "0xaaaa", "0x5555", "0xaaaa"
] ]
);
fun make_diver_pane root_window steps
=
{ screen = wg::screen_of root_window;
plea_slot = make_mailslot ();
plea' = take_from_mailslot' plea_slot;
realize_oneshot
=
make_oneshot_maildrop ();
natural_height = top_margin + bottom_margin + platform_depth + (steps * person_high);
size_preferences
=
{ col_preference => wg::INT_PREFERENCE { start_at=>0, step_by=>1, min_steps=>80, best_steps=>180, max_steps=>NULL },
row_preference => wg::INT_PREFERENCE { start_at=>0, step_by=>1, min_steps=>natural_height, best_steps=>natural_height, max_steps=>NULL }
};
widget
=
wg::make_widget
{ root_window,
size_preference_thunk_of => \\ () = size_preferences,
realize_widget => \\ arg = threadkit::put_in_oneshot (realize_oneshot, arg),
# I added the following line, cribbed randomly
# from the other examples, to get this to
# compile. Apparently the 'args' element was
# added after this example was written and it
# was never updated (I checked the raw SML/NJ 110.58 source.)
# -- 2009-11-30 CrT
#
args => \\ () = { background => NULL }
};
diver_image_array = rw_vector::from_list (map (di::make_diver_image screen) di::images);
dive_image = rw_vector::get (diver_image_array, di::dive_index);
top_image = rw_vector::get (diver_image_array, di::top_index);
top2_image = rw_vector::get (diver_image_array, di::top_index+1);
top3_image = rw_vector::get (diver_image_array, di::top_index+2);
top4_image = rw_vector::get (diver_image_array, di::top_index+3);
wave_list = [top_image, top2_image, top3_image, top4_image, top3_image, top2_image];
climb1 = rw_vector::get (diver_image_array, di::climb_index);
climb2 = rw_vector::get (diver_image_array, di::climb_index+1);
climb3 = rw_vector::get (diver_image_array, di::climb_index+2);
climb4 = rw_vector::get (diver_image_array, di::climb_index+3);
my { high => climb_height, ... }
=
xc::size_of_ro_pixmap climb1.data;
climb_bound = top_margin + climb_increment + climb_height - 1;
stand_image = rw_vector::get (diver_image_array, di::stand_index);
land_ro_pixmap = xc::make_readonly_pixmap_from_ascii screen land_data;
water_ro_pixmap = xc::make_readonly_pixmap_from_ascii screen water_data;
tower_pen
=
xc::make_pen [ xc::p::FOREGROUND xc::rgb8_black,
xc::p::BACKGROUND xc::rgb8_white
];
image_pen = tower_pen;
water_pen = xc::clone_pen (tower_pen, [xc::p::FILL_STYLE_STIPPLED, xc::p::STIPPLE water_ro_pixmap]);
land_pen = xc::clone_pen (tower_pen, [xc::p::FILL_STYLE_STIPPLED, xc::p::STIPPLE land_ro_pixmap]);
splash_list = si::make_splashes (root_window, water_ro_pixmap);
fun pause ()
=
sleep_for 0.04;
fun realize { window, window_size, kidplug } position
=
init (window_size, position)
where
(xc::ignore_mouse_and_keyboard kidplug)
->
xc::KIDPLUG { from_other', ... };
drawwin = xc::drawable_of_window window;
auto_drawwin
=
xc::make_unbuffered_drawable
drawwin;
fun init ({ wide, high }, position)
=
{ midx = wide / 2;
#
land = { shape => xc::CONVEX_SHAPE,
verts => [ { col=>midx, row=>high-bottom_margin },
{ col=>wide - 1, row=>high-bottom_margin },
{ col=>wide - 1, row=>high - 1 },
{ col=>midx-bottom_margin, row=>high - 1 }
]
};
water = { shape => xc::CONVEX_SHAPE,
verts => [ { col=>midx, row=>high-bottom_margin },
{ col=>0, row=>high-bottom_margin },
{ col=>0, row=>high - 1 },
{ col=>midx-bottom_margin, row=>high - 1 }
]
};
pole_height = high-(bottom_margin+top_margin);
platform
=
{ col => midx-((platform_width - pole_wide) / 2),
row => top_margin,
high => platform_depth,
wide => platform_width
};
pole = { col => midx,
row => top_margin,
wide => pole_wide,
high => pole_height
};
top = { col => midx,
row => top_margin - 1
};
fun draw_tower ()
=
{ xc::fill_box drawwin tower_pen pole;
xc::fill_box drawwin tower_pen platform;
};
fun draw_landscape ()
=
{ xc::fill_polygon drawwin water_pen water;
xc::fill_polygon drawwin land_pen land;
};
stepx = midx+pole_wide;
stepy = high-(bottom_margin+1);
step = pole_height / steps;
fun step_pt i
=
{ col => stepx,
row => stepy-(step*i)
};
dive_point
=
{ col => stepy+1,
row => midx - 32
};
splash_pt
=
g2d::point::subtract (dive_point, { col=>0, row=>1 } );
fun put_top ()
=
di::set_diver_image
(auto_drawwin, image_pen)
(top_image, top);
fun clear_top ()
=
di::clear_diver_image
auto_drawwin
(top_image, top);
fun put_step 0 => di::set_diver_image (auto_drawwin, image_pen) (stand_image, step_pt 0);
put_step i => di::set_diver_image (auto_drawwin, image_pen) (climb1, step_pt i);
end;
fun clear_step 0 => di::clear_diver_image auto_drawwin (stand_image, step_pt 0);
clear_step i => di::clear_diver_image auto_drawwin (climb1, step_pt i);
end;
fun do_image (image, pt)
=
{ di::set_diver_image (auto_drawwin, image_pen) (image, pt);
pause();
di::clear_diver_image drawwin (image, pt);
};
fun wave ()
=
repeat 4
where
fun cycle _ = apply (\\ i = do_image (i, top))
wave_list;
fun repeat 0 => ();
repeat i => { cycle(); repeat (i - 1); };
end;
end;
fun splash ()
=
apply (\\ i = do_image (i, splash_pt))
splash_list;
fun make_dive i
=
{ dive_point -> { col=>dive_x, row=>dive_y };
init_x = midx - 2;
init_y = (stepy-(step*i)) + 16;
del_x = init_x - dive_x;
del_y = init_y - dive_y;
incr = 6;
fun x_of_y y
=
(y*del_x + init_x*del_y
- init_y*del_x
)
/
del_y;
fun dive (pt as { col=>x, row=>y } )
=
if (y < dive_y)
di::set_diver_image (auto_drawwin, image_pen) (dive_image, pt);
pause ();
di::clear_diver_image auto_drawwin (dive_image, pt);
dive ({ col => x_of_y (y+incr),
row => y+incr
}
);
fi;
dive ({ col=>init_x, row=>init_y } );
};
fun climb i
=
loop pt0
where
pt0 = step_pt i;
#
(step_pt (i+1)) -> { row=>y1, ... };
ybound = max (y1, climb_bound);
fun loop (pt as { col=>x, row=>y } )
=
if (y > ybound)
pt' = { col=>x, row=>y-climb_increment };
do_image (climb1, pt);
do_image (climb2, pt);
do_image (climb3, pt');
do_image (climb4, pt');
loop pt';
fi;
end;
fun redraw (_, position)
=
{ xc::clear_drawable drawwin;
draw_tower ();
draw_landscape ();
case position
#
GONE => ();
TOP => put_top ();
STEP i => put_step i;
esac;
};
fun do_mom (xc::ETC_REDRAW rlist, position)
=>
redraw (rlist, position);
do_mom (xc::ETC_RESIZE ({ wide, high, ... } ), position)
=>
init ({ wide, high }, position);
do_mom _
=>
();
end;
fun do_gone ()
=
{ fun do_plea START => climbing 0;
do_plea _ => do_gone ();
end;
do_one_mailop [
from_other'
==>
(\\ envelope = do_gone (do_mom (xc::get_contents_of_envelope envelope, GONE))),
plea'
==>
do_plea
];
}
also
fun do_top ()
=
{ wave ();
put_top ();
loop ();
}
where
fun loop ()
=
do_one_mailop [
from_other'
==>
(\\ mailop = loop (do_mom (xc::get_contents_of_envelope mailop, TOP))),
plea'
==>
(\\ req = loop (do_plea req))
]
where
fun do_plea START
=>
{ clear_top ();
climbing 0;
};
do_plea _
=>
();
end;
end;
end
also
fun climbing i
=
{ put_step i;
loop ();
}
where
fun loop ()
=
do_one_mailop [
from_other' ==> (\\ mailop = loop (do_mom (xc::get_contents_of_envelope mailop, STEP i))),
plea' ==> loop o do_plea
]
where
fun to_top ()
=
{ clear_step i;
climb i;
do_top();
};
fun do_climb s
=
{ clear_step i;
climb i;
climbing s;
};
fun do_plea START => if (i != 0) clear_step i; climbing 0; fi;
do_plea WAVE => to_top ();
do_plea DIVE => { clear_step i; do_dive i; };
do_plea UP => if (i+1 < steps) do_climb (i+1);
else to_top ();
fi;
end;
end;
end
also
fun do_dive i
=
{ make_dive i;
splash ();
do_gone ();
};
case position
#
GONE => do_gone ();
TOP => do_top ();
STEP i => climbing i;
esac;
}; # fun init
end; # fun realize
fun diver_pane position
=
{ fun do_plea (START, _) => STEP 0;
do_plea (DIVE, _) => GONE;
do_plea (WAVE, _) => TOP;
do_plea (UP, STEP i) => i+1 < steps ?? STEP (i+1) :: TOP;
do_plea (UP, p ) => p;
end;
do_one_mailop [
plea'
==>
(\\ msg = diver_pane (do_plea (msg, position))),
get_from_oneshot' realize_oneshot
==>
(\\ arg = realize arg position)
];
};
make_thread "diver_pane" {.
#
diver_pane (STEP 0);
};
DIVER_PANE { widget, plea_slot };
}; # fun make_diver_pane
fun as_widget (DIVER_PANE { widget, ... } )
=
widget;
fun start (DIVER_PANE { plea_slot, ... } ) = put_in_mailslot (plea_slot, START);
fun up (DIVER_PANE { plea_slot, ... } ) = put_in_mailslot (plea_slot, UP );
fun dive (DIVER_PANE { plea_slot, ... } ) = put_in_mailslot (plea_slot, DIVE );
fun wave (DIVER_PANE { plea_slot, ... } ) = put_in_mailslot (plea_slot, WAVE );
};
end;