## wall.pkg
# Compiled by:
# src/lib/x-kit/tut/badbricks-game/badbricks-game-app.libstipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package mps = microthread_preemptive_scheduler; # microthread_preemptive_scheduler is from src/lib/src/lib/thread-kit/src/core-thread-kit/microthread-preemptive-scheduler.pkg package f8b = eight_byte_float; # eight_byte_float is from src/lib/std/eight-byte-float.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 bg = background; # background is from src/lib/x-kit/widget/old/wrapper/background.pkg package lbl = label; # label is from src/lib/x-kit/widget/old/leaf/label.pkg package low = line_of_widgets; # line_of_widgets is from src/lib/x-kit/widget/old/layout/line-of-widgets.pkg package wg = widget; # widget is from src/lib/x-kit/widget/old/basic/widget.pkg package wt = widget_types; # widget_types is from src/lib/x-kit/widget/old/basic/widget-types.pkg #
package bj = brick_junk; # brick_junk is from src/lib/x-kit/tut/badbricks-game/brick-junk.pkg package bk = brick; # brick is from src/lib/x-kit/tut/badbricks-game/brick.pkgherein
package wall
: Wall # Wall is from src/lib/x-kit/tut/badbricks-game/wall.api {
safe_zone = 3;
fun float_to_rgb (red, green, blue)
=
{ fun scale v
=
unt::from_int (f8b::truncate (65535.0 * v));
xc::CMS_RGB { red => scale red,
green => scale green,
blue => scale blue
};
};
brick_red = float_to_rgb (0.970077, 0.291340, 0.066498);
yellow = float_to_rgb (1.0, 1.0, 0.0);
light_grey = float_to_rgb (0.8, 0.8, 0.8);
dark_grey = float_to_rgb (0.2, 0.2, 0.2);
medium_grey = float_to_rgb (0.7, 0.7, 0.7);
cyan = float_to_rgb (0.0, 1.0, 1.0);
fun left_mouse (xc::MOUSEBUTTON b) = b == 1;
fun right_mouse (xc::MOUSEBUTTON b) = b >= 3;
fun middle_mouse (xc::MOUSEBUTTON b) = b == 2;
Plea_Mail = START bj::Difficulty
| SET_RANGE bj::Range
| GET_DIFFICULTY Mailslot( bj::Difficulty )
| GET_RANDOM_BRICK Mailslot( bk::Brick )
;
Wall = WALL { plea_slot: Mailslot( Plea_Mail ),
widget: wg::Widget
};
fun make_wall_widget (root_window, color, msgwin, bricks)
=
{
end_spacer = low::SPACER { min_size=>0, best_size=>0, max_size=>NULL };
half_brick = bj::brick_size_wide / 2;
start_spacer
=
low::SPACER
{ min_size => half_brick,
best_size => half_brick,
max_size => THE half_brick
};
fun box_col [] => [ end_spacer ];
box_col (b ! rest) => (low::WIDGET (bk::as_widget b)) ! (box_col rest);
end;
fun box_row (_, [])
=>
[];
box_row (y, r ! rest)
=>
if (y % 2 == 0) (low::HZ_CENTER (box_col r)) ! (box_row (y+1, rest));
else (low::HZ_CENTER (start_spacer ! (box_col r))) ! (box_row (y+1, rest));
fi;
end;
wall_view
=
low::make_line_of_widgets root_window
( low::VT_CENTER
(low::WIDGET msgwin ! ((box_row (0, bricks)) @ [ end_spacer ]))
);
bg::make_background
{
widget => low::as_widget wall_view,
color => THE color
};
};
fun make_wall root_window (x_size, y_size)
=
{ screen = wg::screen_of root_window;
plea_slot = make_mailslot ();
brick_slot = make_mailslot ();
cvt_color = xc::get_color;
palette = { brick => cvt_color brick_red,
mark => cvt_color yellow,
concrete => cvt_color light_grey,
#
dark_lines => cvt_color dark_grey,
light_lines => cvt_color medium_grey,
highlight_lines => cvt_color cyan
};
no_brick = bk::make_no_brick root_window palette;
main_msg
=
"ClickLeft: remove bad bricks. "
+
"ClickRight or ShiftClickLeft: mark/unmark bricks.";
msg_area
=
lbl::make_label root_window
{
label => "",
font => THE bj::brick_font,
align => wt::HCENTER,
#
foreground => NULL,
background => NULL
};
fun set_msg text
=
lbl::set_label msg_area (lbl::TEXT text);
fun make_row y
=
{ fun make_col x
=
if (x == x_size) [];
else (bk::make_brick root_window ({ col=>x, row=>y }, brick_slot, palette)) ! (make_col (x+1));
fi;
if (y == y_size) [];
else (make_col 0) ! (make_row (y+1));
fi;
};
bricklist = make_row 0;
brick = rw_vector::from_list (map rw_vector::from_list bricklist);
fun brick_at ({ col, row } )
=
rw_vector::get (rw_vector::get (brick, row), col)
except
_ = no_brick;
widget
=
make_wall_widget
(
root_window,
palette.concrete,
lbl::as_widget msg_area,
bricklist
);
stipulate
random = rand::make_random 0u1;
herein
fun randx () = rand::range (0, x_size - 1) (random());
fun randy () = rand::range (0, y_size - 1) (random());
end;
fun get_random_brick ()
=
brick_at ({ col => randx(), row => randy() });
fun set_up_game diff
=
{ range = if (bj::cmp_difficulty (diff, bj::DESPERATE) >= 0) bj::LONG;
else bj::SHORT;
fi;
fun choose_good ()
=
{
good_count
=
f8b::truncate (float (x_size*y_size*(bj::difficulty_probability diff))/100.0);
fun loop (0, count)
=>
count;
loop (i, count)
=>
{ rx = randx ();
ry = randy ();
b = brick_at ({ col=>rx, row=>ry } );
if ( ( rx >= safe_zone
or ry >= safe_zone
)
and (not (bk::is_good b))
)
bk::set_good b;
loop (i - 1, count+1);
else
loop (i - 1, count);
fi;
};
end;
rw_vector::apply
(\\ row = rw_vector::apply bk::reset row)
brick;
loop (good_count, 0);
};
good_count = choose_good ();
bad_count = x_size*y_size - good_count;
delta = bk::show_and_flood (brick_at g2d::point::zero, brick_at);
set_msg main_msg;
(range, bad_count-delta);
};
fun game_lost ()
=
{
rw_vector::apply (\\ row = rw_vector::apply (\\ b = bk::end_show (b, brick_at)) row) brick;
set_msg("OOPS! That was a perfectly good brick!");
end_game (bj::NORMAL, bj::SHORT);
}
also
fun game_won ()
=
{
set_msg("NO BAD BRICKS LEFT! Skateboarding is now safe.");
end_game (bj::NORMAL, bj::SHORT);
}
also
fun start_game difficulty
=
{ mainloop (range, bad_bricks)
except
GAME_WON => game_won ();
GAME_LOST => game_lost ();
end;
}
where
my (range, bad_bricks)
=
set_up_game difficulty;
exception GAME_LOST;
exception GAME_WON;
stipulate
diff_name = bj::difficulty_name difficulty;
herein
fun game_status (good, unknown, bad)
=
if (good == unknown)
#
set_msg (sprintf "%s Game: %d bad bricks left" diff_name bad);
else
set_msg (sprintf "%s Game: %d out of %d unknown neighbors are good; %d bad bricks left"
diff_name good unknown bad
);
fi;
end;
fun mark_bfn brick # "bfn" may be "bad_fn".
=
{
if (bk::state_of brick == bj::UNKNOWN_STATE)
#
if (bk::is_good brick) raise exception GAME_LOST;
else bk::show_and_flood (brick, brick_at);
fi;
else
0;
fi;
};
mark_bad = bk::neighbor_count mark_bfn;
fun mark_gfn brick # "gfn" may be "good_fn".
=
if (bk::state_of brick == bj::UNKNOWN_STATE)
#
bk::toggle_marking brick;
fi;
mark_good
=
bk::enumerate_neighbors mark_gfn;
fun auto_brick (brick, range)
=
{
bad = bk::neighbor_bad_count (brick, range, brick_at);
ok = bk::neighbor_ok_count (brick, range, brick_at);
my (unknown, good)
=
case range
#
bj::SHORT => ( 6 - (bad + ok), bj::state_val (bk::state_of brick));
_ => (18 - (bad + ok), bk::neighbor_good_count (brick, bj::LONG, brick_at));
esac;
if (unknown == 0) 0;
elif (good <= ok) mark_bad (brick, range, brick_at);
elif (unknown == good - ok) mark_good (brick, range, brick_at); 0;
else 0;
fi;
};
fun brick_action (mbttn, brick, me as (range, badcnt))
=
{
if (right_mouse mbttn)
#
bk::toggle_marking brick;
me;
elif (bk::state_of brick != bj::OK_STATE)
if (bk::is_good brick)
#
raise exception GAME_LOST;
else
delta = if (bk::state_of brick == bj::UNKNOWN_STATE)
#
bk::show_and_flood (brick, brick_at);
#
elif (left_mouse mbttn or bj::cmp_difficulty (difficulty, bj::HARD) < 0)
#
auto_brick (brick, bj::SHORT);
else auto_brick (brick, bj::LONG );
fi;
badcnt' = badcnt - delta;
game_status (0, 0, badcnt');
if (badcnt' == 0) raise exception GAME_WON;
else (range, badcnt');
fi;
fi;
else
me;
fi;
};
fun adjust_range (m, me as (_, badcnt))
=
{
if (bj::cmp_difficulty (difficulty, bj::DESPERATE) < 0
or left_mouse m
) (bj::SHORT, badcnt);
elif (middle_mouse m) (bj::LONG, badcnt);
else me;
fi;
};
fun brick_highlight_on (b, me as (range, badcnt))
=
{
if (bk::is_shown b)
#
bk::enumerate_neighbors
bk::highlight_on
(b, range, brick_at);
if (range == bj::LONG)
#
bk::set_text (b, int::to_string (bk::neighbor_good_count (b, bj::LONG, brick_at)));
fi;
bad = bk::neighbor_bad_count (b, range, brick_at);
ok = bk::neighbor_ok_count (b, range, brick_at);
my (unknown, good)
=
case range
#
bj::SHORT => ( 6 - (bad + ok), bj::state_val (bk::state_of b));
_ => (18 - (bad + ok), bk::neighbor_good_count (b, bj::LONG, brick_at));
esac;
game_status (good - ok, unknown, badcnt);
me;
else
me;
fi;
};
fun brick_highlight_off (b, me as (range, _))
=
{
if (bk::is_shown b)
#
bk::enumerate_neighbors
bk::highlight_off
(b, range, brick_at);
if (range == bj::LONG)
#
bk::set_text (b, int::to_string (bk::neighbor_good_count (b, bj::SHORT, brick_at)));
fi;
me;
else
me;
fi;
};
fun do_brick x
=
{
do_brick' x;
}
where
fun do_brick' (bj::DOWN (m, b), me)
=>
brick_highlight_on (brick_at b, adjust_range (m, me));
do_brick' (bj::UP (m, b), me)
=>
{ brick = brick_at b;
brick_action (m, brick, brick_highlight_off (brick, me));
};
do_brick' (bj::CANCEL b, me)
=>
brick_highlight_off (brick_at b, me);
end;
end;
fun do_plea x
=
{
do_plea' x;
}
where
fun do_plea' (START d, _) => start_game d;
do_plea' (SET_RANGE r', (_, b)) => (r', b);
do_plea' (GET_DIFFICULTY slot, s) => { put_in_mailslot (slot, difficulty); s; };
do_plea' (GET_RANDOM_BRICK slot, s) => { put_in_mailslot (slot, get_random_brick()); s; };
end;
end;
fun mainloop me # 'me' == (r, bad)
=
mainloop (
#
do_one_mailop [
#
take_from_mailslot' plea_slot
==>
(\\ msg = do_plea (msg, me)),
take_from_mailslot' brick_slot
==>
(\\ msg = do_brick (msg, me))
]
);
end # fun start_game
also
fun end_game (me as (d, r))
=
{ fun do_plea (START d', _) => start_game d';
do_plea (SET_RANGE r', (d, _)) => end_game (d, r');
do_plea (GET_DIFFICULTY c, s) => { put_in_mailslot (c, d); end_game s; };
do_plea (GET_RANDOM_BRICK slot, s) => { put_in_mailslot (slot, get_random_brick()); end_game s; };
end;
do_one_mailop [
#
take_from_mailslot' plea_slot
==>
(\\ msg = do_plea (msg, me)),
take_from_mailslot' brick_slot
==>
(\\ _ = end_game me)
];
};
make_thread "wall" {.
#
end_game (bj::NORMAL, bj::SHORT);
();
};
WALL { widget, plea_slot };
};
fun as_widget (WALL { widget, ... } )
=
widget;
fun start_game (WALL { plea_slot, ... }, difficulty)
=
put_in_mailslot (plea_slot, START difficulty);
fun difficulty_of (WALL { plea_slot, ... } )
=
{ reply_slot = make_mailslot ();
put_in_mailslot (plea_slot, GET_DIFFICULTY reply_slot);
take_from_mailslot reply_slot;
};
fun get_random_brick (WALL { plea_slot, ... } )
=
{
reply_slot = make_mailslot ();
put_in_mailslot (plea_slot, GET_RANDOM_BRICK reply_slot);
take_from_mailslot reply_slot;
};
fun set_range (WALL { plea_slot, ... }, range)
=
put_in_mailslot (plea_slot, SET_RANGE range);
}; # package wall
end;