PreviousUpNext

15.4.1332  src/lib/x-kit/tut/badbricks-game/wall.pkg

## wall.pkg

# Compiled by:
#     src/lib/x-kit/tut/badbricks-game/badbricks-game-app.lib


stipulate
    include 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 xg  =  xgeometry;                           # xgeometry                             is from   src/lib/std/2d/xgeometry.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/wrapper/background.pkg
    package lbl =  label;                               # label                                 is from   src/lib/x-kit/widget/leaf/label.pkg
    package low =  line_of_widgets;                     # line_of_widgets                       is from   src/lib/x-kit/widget/layout/line-of-widgets.pkg
    package wg  =  widget;                              # widget                                is from   src/lib/x-kit/widget/basic/widget.pkg
    package wt  =  widget_types;                        # widget_types                          is from   src/lib/x-kit/widget/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.pkg
herein

    package   wall
    :         Wall                                      # Wall                                  is from   src/lib/x-kit/tut/badbricks-game/wall.api
    {
        safe_zone = 3;

        fun real_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   = real_to_rgb (0.970077, 0.291340, 0.066498);
        yellow      = real_to_rgb (1.0, 1.0, 0.0);
        light_grey  = real_to_rgb (0.8, 0.8, 0.8);
        dark_grey   = real_to_rgb (0.2, 0.2, 0.2);
        medium_grey = real_to_rgb (0.7, 0.7, 0.7);
        cyan        = real_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)
            =
            {
log::note .{ sprintf "%s\tmake_wall_widget/TOP:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
                end_spacer =  low::SPACER { min_size=>0,  ideal_size=>0, max_size=>NULL };

                half_brick =  bj::brick_size_wide / 2;

                start_spacer
                    =
                    low::SPACER
                      { min_size   =>     half_brick,
                        ideal_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 ]))
                      );

result =
                bg::make_background
                  {
                    widget =>  low::as_widget  wall_view,
                    color  =>  THE color
                  };
log::note .{ sprintf "%s\tmake_wall_widget/ZZZ:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result;
            };

        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  (xg::POINT { 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 (xg::POINT { 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 (xg::POINT { 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 (real (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 (xg::POINT { 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
                                      (fn 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  xg::point::zero,  brick_at);

                        set_msg  main_msg;

                        (range, bad_count-delta);
                    };

                fun game_lost ()
                    =
                    {
log::note .{ sprintf "%s\tgame_lost/TOP:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
                        rw_vector::apply (fn row = rw_vector::apply (fn b = bk::end_show (b, brick_at)) row) brick;
                        set_msg("OOPS! That was a perfectly good brick!");
result =
                        end_game (bj::NORMAL, bj::SHORT);
log::note .{ sprintf "%s\tgame_lost/ZZZ:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result;
                    }

                also
                fun game_won ()
                    =
                    {
log::note .{ sprintf "%s\tgame_won/TOP:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
                        set_msg("NO BAD BRICKS LEFT! Skateboarding is now safe.");
result =
                        end_game (bj::NORMAL, bj::SHORT);
log::note .{ sprintf "%s\tgame_won/ZZZ:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result;
                    }


                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".
                            = 
                            {
log::note .{ sprintf "%s\tmark_bfn/TOP:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result =
                                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; 
log::note .{ sprintf "%s\tmark_bfn/ZZZ:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result;
                            };

                        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)
                            =
                            {
log::note .{ sprintf "%s\tauto_brick/TOP:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
                                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;

result =
                                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;
log::note .{ sprintf "%s\tauto_brick/ZZZ:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result;
                            };

                        fun brick_action (mbttn, brick, me as (range, badcnt))
                            =
                            {
log::note .{ sprintf "%s\tbrick_action/TOP:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result =
                                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;
log::note .{ sprintf "%s\tbrick_action/ZZZ:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result;
                            };

                        fun adjust_range (m, me as (_, badcnt))
                            =
                            {   
log::note .{ sprintf "%s\tadjust_range/TOP:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result =
                                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;
log::note .{ sprintf "%s\tadjust_range/ZZZ:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result;
                            };

                        fun brick_highlight_on (b, me as (range, badcnt))
                            =
                            {
log::note .{ sprintf "%s\tbrick_highlight_on/TOP:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result =
                                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;
log::note .{ sprintf "%s\tbrick_highlight_on/ZZZ:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result;
                            };

                        fun brick_highlight_off (b, me as (range, _))
                            =
                            {
log::note .{ sprintf "%s\tbrick_highlight_off/TOP:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result =
                                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;
log::note .{ sprintf "%s\tbrick_highlight_off/BOTTOM:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result;
                            };

                        fun do_brick x
                            =
                            {
log::note .{ sprintf "%s\tstart_game/mainloop/do_brick/TOP:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result =
                                do_brick' x;
log::note .{ sprintf "%s\tstart_game/mainloop/do_brick/ZZZ:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result;
                            }
                            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
                            =
                            {
log::note .{ sprintf "%s\tstart_game/mainloop/do_plea:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
                                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
                                        ==>
                                        (fn msg = do_plea (msg, me)),

                                    take_from_mailslot' brick_slot
                                        ==>
                                        (fn 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
                                ==>
                                (fn msg = do_plea (msg, me)),

                            take_from_mailslot' brick_slot
                                ==>
                                (fn _ = 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, ... } )
            =
            {
log::note .{ sprintf "%s\tget_random_brick/TOP:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
                reply_slot = make_mailslot ();

                put_in_mailslot (plea_slot, GET_RANDOM_BRICK reply_slot);

result =
                take_from_mailslot  reply_slot;
log::note .{ sprintf "%s\tget_random_brick/BOT:    -- wall.pkg" (mps::thread_scheduler_statestring ()); };
result;
            };

        fun set_range (WALL { plea_slot, ... }, range)
            =
            put_in_mailslot (plea_slot, SET_RANGE range);

    };                                  #  package wall 

end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext