PreviousUpNext

15.4.1328  src/lib/x-kit/tut/badbricks-game/badbricks-game-app.pkg

## badbricks-game-app.pkg
#
# See this directory's README for a description of the game.
#
# One way to run this app from the base-directory commandline is:
#
#     linux% my
#     eval: make "src/lib/x-kit/tut/badbricks-game/badbricks-game-app.lib";
#     eval: badbricks_game_app::do_it "";
#
# From this directory it may be run via:
#
#     linux% my
#     eval: make "badbricks-game-app.lib";
#     eval: badbricks_game_app::do_it "";

# 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 fil =  file__premicrothread;                # file__premicrothread                  is from   src/lib/std/src/posix/file--premicrothread.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 wg  =  widget;                              # widget                                is from   src/lib/x-kit/widget/basic/widget.pkg
    package dv  =  divider;                             # divider                               is from   src/lib/x-kit/widget/leaf/divider.pkg
    package low =  line_of_widgets;                     # line_of_widgets                       is from   src/lib/x-kit/widget/layout/line-of-widgets.pkg
    package sz  =  size_preference_wrapper;             # size_preference_wrapper               is from   src/lib/x-kit/widget/wrapper/size-preference-wrapper.pkg
    package pd  =  pulldown_menu_button;                # pulldown_menu_button                  is from   src/lib/x-kit/widget/menu/pulldown-menu-button.pkg
    package pu  =  popup_menu;                          # popup_menu                            is from   src/lib/x-kit/widget/menu/popup-menu.pkg
    package tw  =  topwindow;                           # topwindow                             is from   src/lib/x-kit/widget/menu/popup-menu.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
    package wl  =  wall;                                # wall                                  is from   src/lib/x-kit/tut/badbricks-game/wall.pkg
    #
    package xtr =  xlogger;                             # xlogger                               is from   src/lib/x-kit/xclient/src/stuff/xlogger.pkg
    #
    tracefile   =  "badbricks-game.trace.log";
    tracing     =  logger::make_logtree_leaf { parent => xlogger::xkit_logging, name => "badbricks_game_app::tracing", default => FALSE };
    trace       =  xtr::log_if  tracing 0;              # Conditionally write strings to tracing.log or whatever.
        #
        # To debug via tracelogging, annotate the code with lines like
        #
        #       trace .{ sprintf "foo/top: bar d=%d" bar; };
        #
        # and then set   write_tracelog = TRUE;   below.
herein

    package   badbricks_game_app
    :         Badbricks_Game_App                        # Badbricks_Game_App            is from   src/lib/x-kit/tut/badbricks-game/badbricks-game-app.api
    {
        write_tracelog = FALSE;

        fun set_up_tracing ()
            =
            {   # Open tracelog file and select tracing level.
                # We don't need to truncate any existing file
                # because that is already done by the logic in
                #     src/lib/std/src/posix/winix-text-file-io-driver-for-posix--premicrothread.pkg
                #
                include logger;                         # logger                        is from   src/lib/src/lib/thread-kit/src/lib/logger.pkg
                #
                set_logger_to  (fil::LOG_TO_FILE tracefile);
#               enable fil::all_logging;                # Gross overkill.
            };

        stipulate
            selfcheck_tests_passed  =  REF 0;
            selfcheck_tests_failed  =  REF 0;
        herein
            run_selfcheck           =  REF FALSE;
            app_task                =  REF (NULL: Null_Or( Apptask   ));

            fun reset_global_mutable_state ()                                   # Reset above state variables to load-time values.
                =                                                                       # This will be needed if (say) we get run multiple times interactively without being reloaded.
                {   run_selfcheck                               :=  FALSE;
                    #
                    app_task                                    :=  NULL;
                    #
                    selfcheck_tests_passed                      :=  0;
                    selfcheck_tests_failed                      :=  0;
                };

            fun test_passed () =  selfcheck_tests_passed :=  *selfcheck_tests_passed + 1;
            fun test_failed () =  selfcheck_tests_failed :=  *selfcheck_tests_failed + 1;
            #
            fun assert bool    =  if bool   test_passed ();
                                  else      test_failed ();
                                  fi;                           
            #
            fun test_stats  ()
                =
                { passed => *selfcheck_tests_passed,
                  failed => *selfcheck_tests_failed
                };

            fun kill_badbricks_game_app ()
                =
                {
log::note .{ sprintf "%s\tkill_badbricks_game_app/TOP:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                    kill_task  { success => TRUE,  task => (the *app_task) };
log::note .{ sprintf "%s\tkill_badbricks_game_app/ZZZ:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                };

            fun wait_for_app_task_done ()
                =
                {
log::note .{ sprintf "%s\twait_for_app_task_done/TOP  -- badbricks-game-app.pkg"  (mps::thread_scheduler_statestring ()); };
                    task =  the  *app_task;
                    #
log::note .{ sprintf "%s\twait_for_app_task_done/BBB  -- badbricks-game-app.pkg"  (mps::thread_scheduler_statestring ()); };
                    task_finished' =  task_done__mailop  task;

log::note .{ sprintf "%s\twait_for_app_task_done/CCC  -- badbricks-game-app.pkg"  (mps::thread_scheduler_statestring ()); };
                    block_until_mailop_fires  task_finished';

log::note .{ sprintf "%s\twait_for_app_task_done/DDD  -- badbricks-game-app.pkg"  (mps::thread_scheduler_statestring ()); };
                    assert (get_task's_state  task  ==  state::SUCCESS);
log::note .{ sprintf "%s\twait_for_app_task_done/ZZZ  -- badbricks-game-app.pkg"  (mps::thread_scheduler_statestring ()); };
                };


        end;


        x_size = 10;
        y_size = 30;


        # Thread to exercise the app by simulating user
        # mouseclicks and verifying their effects:
        #
        fun make_selfcheck_thread
            {
              topwindow,
              widgettree,
              xsession,
              wall      
            }
            =
            xtr::make_thread "badbricks-game-app selfcheck" selfcheck'
            where
                # Figure midpoint of window and also
                # a small box centered on the midpoint:
                #
                fun midwindow window
                    =
                    {
                        # Get size of drawing window:
                        #
                        (xc::get_window_site  window)
                            ->
                            xg::BOX { row, col, high, wide };

                        # Define midpoint of drawing window,
                        # and a 9x9 box enclosing it:
                        #
                        stipulate
                            row =  high / 2;
                            col =  wide / 2;
                        herein
                            midpoint =  xg::POINT { row, col };
                            midbox   =  xg::BOX { row => row - 4, col => col - 4, high => 9, wide => 9 };
                        end;

                        (midpoint, midbox);
                    };

                # Convert coordinate from from
                # scale-independent 0.0 -> 1.0 space
                # coordinates to X pixel space:
                #
                fun convert_coordinate_from_abstract_to_pixel_space (window, x, y)
                    =
                    {
                        # Get size of window:
                        #
                        (xc::get_window_site  window)
                            ->
                            xg::BOX { row, col, high, wide };

                        xg::POINT
                          { col =>  f8b::round (f8b::from_int wide  *  x),
                            row =>  f8b::round (f8b::from_int high  *  y)
                          };
                    };

#               # Simulate a mouseclick in window.
#               # The (x,y) coordinates are in an
#               # abstract space in which window
#               # width and height both run 0.0 -> 1.0
#               #
#               fun click_in_window_at (window, x, y, dx, dy)
#                   =
#                   {   button = xc::MOUSEBUTTON 1;
#
#                       point1 = convert_coordinate_from_abstract_to_pixel_space (window, x, y);
#                       point1 -> xg::POINT { row, col };
#                       point2 =  xg::POINT { row => row+dx, col=>col+dy };
#
#                       xc::send_mousebutton_press_xevent   { window, button, point => point1 };
#                       sleep_for 0.1;
#                       xc::send_mousebutton_release_xevent { window, button, point => point2 };
#                   };  


                fun click_random_brick ()
                    =
                    {
log::note .{ sprintf "%s\tclick_random_brick/TOP:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        brick = wall::get_random_brick  wall;

log::note .{ sprintf "%s\tclick_random_brick/AAA:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        good =  bk::is_good  brick;

#                       shown = bk::is_shown brick;

#                       state = bk::state_of brick;

log::note .{ sprintf "%s\tclick_random_brick/DDD:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        widget = bk::as_widget brick;

log::note .{ sprintf "%s\tclick_random_brick/EEE:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        window = wg::window_of widget;

log::note .{ sprintf "%s\tclick_random_brick/FFF:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        if (not good)
                            #
log::note .{ sprintf "%s\tclick_random_brick/GGG:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                            xc::send_mousebutton_press_xevent
                              { window,
                                button =>  xc::MOUSEBUTTON 1,
                                point  =>  xg::POINT { row => 1, col => 1 }
                              };
                            #
log::note .{ sprintf "%s\tclick_random_brick/HHH:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                            sleep_for 0.05;             # X seems to dislike events which come too quickly.
log::note .{ sprintf "%s\tclick_random_brick/III:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                            xc::send_mousebutton_release_xevent
                              { window,
                                button =>  xc::MOUSEBUTTON 1,
                                point  =>  xg::POINT { row => 1, col => 1 }
                              };
log::note .{ sprintf "%s\tclick_random_brick/JJJ:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                            sleep_for 0.05;
log::note .{ sprintf "%s\tclick_random_brick/KKK:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        fi;

                        # This locks us up, I dunno why:       XXX BUGGO FIXME
                        # (I also dunno why the red bricks don't draw first time around.
                        # The colormixer has a similar problem.)
#                       (xc::get_window_site window)
#                           ->
#                           xg::BOX { row, col, high, wide };
                    };
        
                fun selfcheck' ()
                    =
                    {
log::note .{ sprintf "%s\tselfcheck'/TOP:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
        
                        # Wait until the widgettree is realized and running:
                        # 
                        take_from_oneshot (wg::get_''gui_startup_complete''_oneshot_of  widgettree);    # This idea doesn't seem to be working at present anyhow.

log::note .{ sprintf "%s\tselfcheck'/BBB:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        sleep_for 2.0;

log::note .{ sprintf "%s\tselfcheck'/CCC:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        window = wg::window_of  widgettree;

                        for (i = 0; i < 10; ++i) {
                            #
log::note .{ sprintf "%s\tselfcheck'/DDD: loop(%d):    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()) i; };
                            click_random_brick();
                        };

log::note .{ sprintf "%s\tselfcheck'/EEE:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        # Fetch from X server the center pixels
                        # over which we are about to draw:
                        #
                        (midwindow   window) ->  (_, window_midbox);
                        #
#                       antedraw_window_image
#                           =
#                           xc::make_clientside_pixmap_from_window (window_midbox, window);

                        # Re-fetch center pixels, verify
                        # that new result differs from original result.
                        #
                        # This is dreadfully sloppy, but seems to be
                        # good enough to verify that there is something
                        # happening in the window:
                        #
#                       postdraw_window_image
#                           =
#                           xc::make_clientside_pixmap_from_window (window_midbox, window);
                        #
#                       assert (not (xc::same_cs_pixmap (antedraw_window_image, postdraw_window_image)));

log::note .{ sprintf "%s\tselfcheck'/FFF:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        sleep_for 2.0;          # Just to let the user watch it.

                        # All done -- shut everything down:
                        #
log::note .{ sprintf "%s\tselfcheck'/GGG:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        xc::close_xsession  xsession;

log::note .{ sprintf "%s\tselfcheck'/HHH:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        sleep_for 0.2;                          # I think close_xsession returns before everything has shut down. Need something cleaner here. XXX SUCKO FIXME.

log::note .{ sprintf "%s\tselfcheck'/III:  calling kill_badbricks_game  -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        kill_badbricks_game_app ();

#                       shut_down_thread_scheduler  winix__premicrothread::process::success;                    # We did this prior to 6.3

                        ();
                    };
            end;                                                # fun make_selfcheck_thread

        fun bad_bricks (xdisplay, xauthentication)
            =
            for (;;) {
                #
log::note .{ sprintf "%s\tbadbricks/LUPTOP:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                (block_until_mailop_fires  game_menu_mailop)  ();
            }
            where
log::note .{ sprintf "%s\tbadbricks/AAA:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                root_window =  wg::make_root_window (xdisplay, xauthentication);
log::note .{ sprintf "%s\tbadbricks/BBB:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                screen      =  wg::screen_of  root_window;
log::note .{ sprintf "%s\tbadbricks/CCC:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                xsession    =  xc::xsession_of_screen  screen;  

log::note .{ sprintf "%s\tbadbricks/DDD: Making wall   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                wall = wl::make_wall root_window (x_size, y_size);
log::note .{ sprintf "%s\tbadbricks/DDD: Made   wall   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };

                #  fun clean_heap () = system::unsafe::mythryl_callable_c_library_interface::gc 2;

                fun quit_game ()
                    =
                    {
log::note .{ sprintf "%s\tquit_game/AAA:   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        wg::delete_root_window  root_window;

log::note .{ sprintf "%s\tquit_game/BBB:   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        sleep_for 0.2;                          # In the hope previous call will complete. Need something cleaner here. XXX SUCKO FIXME.

log::note .{ sprintf "%s\tquit_game/CCC: Calling kill_badbricks_game_app  -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        kill_badbricks_game_app ();

#                       shut_down_thread_scheduler  winix__premicrothread::process::success;                    # We did this prior to 6.3
                    };

                fun do_short_range ()
                    =
                    {
log::note .{ sprintf "%s\tdo_short_range/AAA:   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        wl::set_range (wall, bj::SHORT);
                    };

                fun do_long_range ()
                    =
                    {
log::note .{ sprintf "%s\tdo_long_range/AAA:   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        if (bj::cmp_difficulty (wl::difficulty_of wall, bj::HARD) > 0) 
                            #
log::note .{ sprintf "%s\tdo_long_range/BBB:   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                            wl::set_range (wall, bj::LONG);
                        fi;
                    };

                fun do_game difficulty
                    =
                    {
log::note .{ sprintf "%s\tdo_game/AAA: Calling wl::start_game  -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        wl::start_game (wall, difficulty);
                        #  if d > Hard then activate sensor_menu 
                        ();
                    };

                fun game_menu ()
                    =
                    {   fun make_item difficulty
                            =
                            {
log::note .{ sprintf "%s\tmake_item/AAA:   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                                pu::POPUP_MENU_ITEM (bj::difficulty_name difficulty, fn () = do_game difficulty);
                            };

                        #  pu::POPUP_MENU((map make_item bj::difficulty_list) @ [POPUP_MENU_ITEM("CLEANING", do_gc), POPUP_MENU_ITEM("Quit", quit_game)]) ;

log::note .{ sprintf "%s\tgame_menu/AAA:   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        pu::POPUP_MENU ( (map  make_item  bj::difficulty_list)
                               @
                               [pu::POPUP_MENU_ITEM ("Quit", quit_game)]
                             );
                    };

                fun sensor_menu ()
                    =
                    {
log::note .{ sprintf "%s\tsensor_menu/AAA:   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                        pu::POPUP_MENU [
                            pu::POPUP_MENU_ITEM("Short range", do_short_range),
                            pu::POPUP_MENU_ITEM("Long range",  do_long_range)
                          ];
                    };

log::note .{ sprintf "%s\tbadbricks/EEE: Making game menu button   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                my (game_menu_button, game_menu_mailop)
                    = 
                    pd::make_pulldown_menu_button
                        #
                        root_window
                        #
                        ("Game", game_menu());

log::note .{ sprintf "%s\tbadbricks/FFF: Making layout   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                layout
                    =
                    low::make_line_of_widgets  root_window
                      (low::VT_CENTER
                        [
                          low::HZ_TOP
                            [
                              low::WIDGET (sz::make_tight_size_preference_wrapper   game_menu_button), 
                              low::SPACER { min_size=>0,  ideal_size=>0, max_size=>NULL }
                            ],
                          low::WIDGET (dv::make_horizontal_divider  root_window  { color=>NULL, width=>1 } ),
                          low::WIDGET (wl::as_widget wall)
                        ]
                      );

log::note .{ sprintf "%s\tbadbricks/GGG: Making topwindow   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                topwindow
                    =
                    tw::make_topwindow
                      ( low::as_widget layout,
                        NULL,
                        { window_name => THE "Bad Bricks",
                          icon_name   => THE "Bad Bricks"
                        }
                      );

log::note .{ sprintf "%s\tbadbricks/HHH: Starting topwindow   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                tw::start  topwindow;

log::note .{ sprintf "%s\tbadbricks/III: Starting game   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                wl::start_game (wall, bj::NORMAL);

                if *run_selfcheck
                    #
log::note .{ sprintf "%s\tbadbricks/JJJ: Starting selfcheck thread   -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                    make_selfcheck_thread 
                      {
                        topwindow,
                        widgettree => low::as_widget layout,
                        xsession,
                        wall
                      };

                    ();
                fi;

            end;

        fun start_up_badbricks_game_app_threads  display_name
            =
            {   display_name' =     case display_name   "" =>  NULL;
                                                        _  =>  THE display_name;
                                    esac;

                (xc::get_xdisplay_string_and_xauthentication  display_name')
                    ->
                    ( xdisplay,                                                         # Typically from $DISPLAY environment variable.
                      xauthentication:  Null_Or(xc::Xauthentication)                    # Typically from ~/.Xauthority
                    );

                xlogger::make_thread  "bad_bricks"   .{   bad_bricks (xdisplay, xauthentication);   };

                ();
            };

        fun set_up_badbricks_game_app_task  display_name
            =
            # Here we arrange that all the threads
            # for the application run as a task "badbricks game app",
            # so that later we can shut them all down with
            # a simple kill_task().  We explicitly create one
            # root thread within the task; the rest then implicitly
            # inherit task membership:
            #
            {
                badbricks_game_app_task =   make_task  "badbricks game app"  [];
                app_task               :=   THE  badbricks_game_app_task;
                #
                xtr::make_thread' [ THREAD_NAME "badbricks game app",
                                    THREAD_TASK  badbricks_game_app_task
                                  ]
                                  start_up_badbricks_game_app_threads
                                  display_name;
                ();
            };

        fun do_it' (flgs, display_name)
            =
            {   xlogger::init flgs;
                #
                if write_tracelog       set_up_tracing ();      fi;

                set_up_badbricks_game_app_task  display_name;

                wait_for_app_task_done ();

                winix__premicrothread::process::success;
            };

        fun do_it s
            =
            do_it' ([], s);

        fun main (program, "-display" ! server ! _) => do_it  server;
            main _                                  => do_it  "";
        end;

        fun selfcheck ()
            =
            {
log::note .{ sprintf "%s\tselfcheck/TOP:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                reset_global_mutable_state ();                                          # Don't depend on load-time state initialization -- we might get run multiple times interactively, say.
                run_selfcheck :=  TRUE;
log::note .{ sprintf "%s\tselfcheck/MMM:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                do_it "";
log::note .{ sprintf "%s\tselfcheck/MMM:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
result =
                test_stats ();
log::note .{ sprintf "%s\tselfcheck/ZZZ:    -- badbricks-game-app.pkg" (mps::thread_scheduler_statestring ()); };
result;
            };  
    };                                          #  package bad_bricks_game_app
end;


## COPYRIGHT (c) 1996 AT&T Research.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext