PreviousUpNext

15.4.1323  src/lib/x-kit/tut/arithmetic-game/arithmetic-game-app.pkg

## arithmetic-game-app.pkg
#
# A simple arithmetic-game demo app.
#
# Its window displays in its left pane a series of arithmetic problems,
# in its right pane a stick figure which climbs incrementally
# up a pole in response to correct answers, and at bottom a
# set of control buttons and a games-won count.
#
# One way to run this app from the base-directory commandline is:
#
#     linux% my
#     eval: make "src/lib/x-kit/tut/arithmetic-game/arithmetic-game-app.lib";
#     eval: arithmetic_game_app::do_it "";

# Compiled by:
#     src/lib/x-kit/tut/arithmetic-game/arithmetic-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 xtr =  xlogger;                             # xlogger                               is from   src/lib/x-kit/xclient/src/stuff/xlogger.pkg
    #
    package xc  =  xclient;                             # xclient                               is from   src/lib/x-kit/xclient/xclient.pkg
    #
    package dv  =  divider;                             # divider                               is from   src/lib/x-kit/widget/leaf/divider.pkg
    package lbl =  label;                               # label                                 is from   src/lib/x-kit/widget/leaf/label.pkg
    package lw  =  line_of_widgets;                     # line_of_widgets                       is from   src/lib/x-kit/widget/layout/line-of-widgets.pkg
    package pb  =  pushbuttons;                         # pushbuttons                           is from   src/lib/x-kit/widget/leaf/pushbuttons.pkg
    package ri  =  runtime_internals;                   # runtime_internals                     is from   src/lib/std/src/nj/runtime-internals.pkg
    package sz  =  size_preference_wrapper;             # size_preference_wrapper               is from   src/lib/x-kit/widget/wrapper/size-preference-wrapper.pkg
    package tl  =  textlist;                            # textlist                              is from   src/lib/x-kit/widget/leaf/textlist.pkg
    package tw  =  topwindow;                           # topwindow                             is from   src/lib/x-kit/widget/basic/topwindow.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 wy  =  widget_style;                        # widget_style                          is from   src/lib/x-kit/widget/lib/widget-style.pkg
    package rw  =  root_window;                         # root_window                           is from   src/lib/x-kit/widget/basic/root-window.pkg
    #
    package ca  =  calculation_pane;                    # calculation_pane                      is from   src/lib/x-kit/tut/arithmetic-game/calculation-pane.pkg
    package dvr =  diver_pane;                          # diver_pane                            is from   src/lib/x-kit/tut/arithmetic-game/diver-pane.pkg
    #
    tracefile   =  "arithmetic-game-app.trace.log";
    tracing     =  logger::make_logtree_leaf { parent => xlogger::xkit_logging, name => "arithmetic_game_app::tracing", default => FALSE };  # Change to TRUE or call  (logger::enable tracing)   to enable logging in this file.
    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   arithmetic_game_app
    :         Arithmetic_Game_App                               # Arithmetic_Game_App           is from   src/lib/x-kit/tut/arithmetic-game/arithmetic-game-app.pkg
    {
        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.
            };

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

            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_arithmetic_game_app ()
                =
                {
log::note .{ sprintf "%s\tkill_arithmetic_game_app/TOP:    -- arithmetic-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                    kill_task  { success => TRUE,  task => (the *app_task) };
log::note .{ sprintf "%s\tkill_arithmetic_game_app/ZZZ:    -- arithmetic-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                };

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

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

log::note .{ sprintf "%s\twait_for_app_task_done/DDD  -- arithmetic-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  -- arithmetic-game-app.pkg"  (mps::thread_scheduler_statestring ()); };
                };


        end;

        Game_Reconfigure_Command
            #
            = SET_GAME_DIFFICULTY ca::Difficulty
            | SET_MATH_OP   ca::Math_Op
            ;

        fun counter (slot, set_label)
            =
            loop 1
            where
                fun loop count
                    =
                    {   take_from_mailslot slot;
                        set_label (lbl::TEXT (sprintf "%d" count));
                        loop (count+1);
                    };
            end;

        # Thread to exercise the app by simulating user
        # mouseclicks and verifying their effects:
        #
        fun make_selfcheck_thread
            {
              topwindow,
              widgettree,       
              xsession,
              correct_answer_slot,
              right_or_wrong_slot
            }
            =
            xtr::make_thread "arithmetic-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 int_to_ascii i
                    =
                    0x30 + i;                                                                   # An ascii table may be found at   http://www.asciitable.com/

                fun ascii_to_keysym a
                    =
                    xc::KEYSYM  a;                                              # The X keysym encoding is designed so that we have keysym==ascii for simple cases like this.

                fun keysym_to_null_or_keycode keysym
                    =
                    xc::keysym_to_keycode (xsession, keysym);

                # Simulate a keystroke in window.
                # The (x,y) coordinates are in an
                # abstract space in which window
                # width and height both run 0.0 -> 1.0
                #
                fun keystroke_in_window_at (window, x, y, a)
                    =
                    {
                        case (keysym_to_null_or_keycode (ascii_to_keysym a))
                            #
                            NULL =>
                                {
                                    test_failed ();
                                };
                            #
                            THE keycode
                                =>
                                {
                                    test_passed ();

                                    point = convert_coordinate_from_abstract_to_pixel_space (window, x, y);
                                    point -> xg::POINT { row, col };

                                    xc::send_keyboard_key_press_xevent   { window, keycode, point };
                                    sleep_for 0.1;

                                    xc::send_keyboard_key_release_xevent { window, keycode, point };
                                };
                        esac;
                    };  


                fun selfcheck ()
                    =
                    {
                        # 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.

                        window = wg::window_of  widgettree;


                        # 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);

                        enter_key_keysym = 255*256 + 13;                                # Documented on p108 of http://mythryl.org/pub/exene/X-protocol-R6.pdf

                        fun send_correct_answer  correct_answer
                            =
                            {
                                if (correct_answer == 0)
                                    #
                                    keystroke_in_window_at (window, 0.50, 0.50,  0);
                                else
                                    loop  correct_answer
                                    where
                                        fun loop 0 => ();
                                            loop a => { keystroke_in_window_at (window, 0.50, 0.50, int_to_ascii (a % 10));  loop (a / 10); };
                                        end;
                                    end;
                                fi;

                                keystroke_in_window_at (window, 0.50, 0.50,  enter_key_keysym); # Simulate hitting 'Enter' key.
                            };

                        fun verify_success  right_or_wrong_slot
                            =
                            case (take_from_mailslot  right_or_wrong_slot)
                                #
                                ca::RIGHT =>  test_passed ();
                                ca::WRONG =>  test_failed ();
                            esac;


                        for (i = 0;  i < 3;  ++i) {
                            #   
                            correct_answer =  take_from_mailslot  correct_answer_slot;                          # From calculation_pane.
                            send_correct_answer  correct_answer;
                            verify_success  right_or_wrong_slot;
                        };

                        # 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)));

                        sleep_for 2.0;                                                          # Just to let the user watch it.

                        # All done -- shut everything down:
                        #
                        xc::close_xsession  xsession;

                        sleep_for 0.2;                                                          # I think close_xsession returns before everything has shut down. Need something cleaner here. XXX SUCKO FIXME.

                        kill_arithmetic_game_app ();

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

                        ();
                    };
            end;                                                # fun make_selfcheck_thread

                                                            # make_root_window  def in    src/lib/x-kit/widget/basic/root-window.pkg
                                                            # screen_of         def in    src/lib/x-kit/widget/basic/root-window.pkg
        fun start_up_arithmetic_game_app_threads (xdisplay, xauthentication)
            = 
            {   root_window =  wg::make_root_window  (xdisplay, xauthentication);

                screen      =  wg::screen_of  root_window;
                xsession    =  xc::xsession_of_screen  screen;  

                fun clean_heap ()
                    =
                    ri::hc::clean_heap 7;

                null_or_correct_answer_slot
                    =
                    *run_selfcheck   ??  THE (make_mailslot ())
                                     ::  NULL;

                null_or_''right_or_wrong''_slot
                    =
                    *run_selfcheck   ??  THE (make_mailslot ())
                                     ::  NULL;

                calc_pane
                    =
                    ca::make_calculation_pane  (root_window, null_or_correct_answer_slot);

                right_or_wrong'  =  ca::right_or_wrong'_of     calc_pane;

                rounds = 3;

                diver_pane = dvr::make_diver_pane  root_window  rounds;

                fun quit_game ()
                    =
                    {   wg::delete_root_window  root_window;
                        #
                        sleep_for 0.2;                                  # Give previous a fair chance to take effect. Need something cleaner here. XXX SUCKO FIXME.

                        kill_arithmetic_game_app ();

#                       shut_down_thread_scheduler 0;                   # We did this prior to 6.3
                    };

                quit_button
                    =
                    pb::make_text_pushbutton_with_click_callback
                        root_window
                        { click_callback =>  quit_game,
                          rounded        =>  FALSE,
                          label          =>  "Quit",
                          #     
                          foreground     =>  NULL,
                          background     =>  NULL
                        };

                won_slot = make_mailslot ();

                fun game_won ()
                    =
                    put_in_mailslot (won_slot, ());

                game_control_slot  =  make_mailslot ();
                new_game' =  take_from_mailslot' game_control_slot;

                games_won_label
                    =
                    lbl::make_label  root_window
                      {
                        label => "Games won :",
                        font  => NULL,
                        #       
                        foreground => NULL,
                        background => NULL,
                        #       
                        align      => wt::HRIGHT
                      };

                games_won_count
                    =
                    lbl::make_label  root_window
                      {
                        label => "    0",
                        font  => NULL,
                        align => wt::HRIGHT,
                        #
                        foreground => NULL,
                        background => NULL
                      };

                # Clicking this button results in
                # arithmetic problems with single-digit
                # numbers:
                #
                single_button
                    =
                    pb::make_text_pushbutton_with_click_callback  root_window
                      {
                        click_callback =>  fn () = put_in_mailslot (game_control_slot, SET_GAME_DIFFICULTY ca::SINGLE),
                        rounded        =>  FALSE,
                        label          =>  "Single",
                        #
                        foreground     =>  NULL,
                        background     =>  NULL
                      };

                # Clicking this button results in
                # arithmetic problems with two-digit
                # numbers:
                #
                easy_button
                    =
                    pb::make_text_pushbutton_with_click_callback  root_window
                      {
                        click_callback =>  fn () = put_in_mailslot (game_control_slot, SET_GAME_DIFFICULTY ca::EASY),
                        rounded        =>  FALSE,
                        label          => "Easy",
                        #
                        foreground     =>  NULL,
                        background     =>  NULL
                      };

                # Clicking this button results in
                # arithmetic problems with three-digit
                # numbers:
                #
                medium_button
                    =
                    pb::make_text_pushbutton_with_click_callback  root_window
                      {
                        click_callback =>  fn () = put_in_mailslot (game_control_slot, SET_GAME_DIFFICULTY ca::MEDIUM),
                        rounded        =>  FALSE,
                        label          => "Medium",
                        #
                        foreground     =>  NULL,
                        background     =>  NULL
                      };

                # Clicking this button results in
                # arithmetic problems with four-digit
                # numbers:
                #
                hard_button
                    =
                    pb::make_text_pushbutton_with_click_callback  root_window
                      {
                        click_callback =>  fn () = put_in_mailslot (game_control_slot, SET_GAME_DIFFICULTY ca::HARD),
                        rounded        =>  FALSE,
                        label          =>  "Hard",
                        #
                        foreground     =>  NULL,
                        background     =>  NULL
                      };

                                                                                                # ACTIVE         def in    src/lib/x-kit/widget/basic/widget-base.pkg
                                                                                                # ACTIVE is of type Button_State.
                my  op_items:   List( tl::Textlist_Item( ca::Math_Op ))
                    = 
                    map (fn (f, is_active)
                            =
                            tl::make_textlist_item
                                (ca::math_op_to_string f, f, wt::ACTIVE is_active)      # fn generates Textlist_Item(Math_Op).
                        )
                        ca::math_ops;

                                                                                                # text_list             is from   src/lib/x-kit/widget/leaf/textlist.pkg
                                                                                                # widget_style_g        is from   src/lib/x-kit/style/widget-style-g.pkg
                                                                                                # style                 is from   src/lib/x-kit/style/style.pkg
                                                                                                # root_window           is from   src/lib/x-kit/widget/basic/root-window.pkg
                                                                                                # style_of              def in    src/lib/x-kit/widget/basic/root-window.pkg
                op_list
                    =
                    tl::make_textlist
                      ( root_window,

                        # Invented this to make code compile.
                        # Apparently text_list was rewritten without
                        # updating this example. (And no other code
                        # seems to use it...)
                        # test-list.pkg documents this arg as
                        # needing to be of type
                        #     widget::View
                        # which is defined in
                        #     src/lib/x-kit/widget/basic/widget-attributes.pkg
                        # as
                        #     View  = (wy::Style_View, wy::Style);
                        #     Style =  STYLE
                        #                    { context:          av::Context,
                        #                      plea_slot:  Mailslot( Request_Message )
                        #                    };
                        #
                        #  2009-11-30 CrT
                        #       
                        ( wy::make_view { name => wy::style_name ["text_list"],
                                          aliases => []
                                        },
                          #
                          wg::style_of  root_window
                        ),      

                        # Invented this to make code compile.
                        # It is supposed to be of type  
                        #     List (widget::Arg)
                        # where Arg is defined in
                        #     src/lib/x-kit/widget/basic/widget-attributes.pkg
                        # as
                        #     Arg            = (attribute::Name, attribute::Value);
                        # 2009-11-30 CrT
                        #       
                        [ ]
                      )
                      op_items;

                fun op_listen ()
                    =
                    loop ()
                    where

                        textlist_change'
                            =
                            tl::textlist_change'_of  op_list;

                        fun loop ()
                            =
                            for (;;) {
                                #
                                case (block_until_mailop_fires  textlist_change')
                                    #
                                    tl::SET f =>  put_in_mailslot (game_control_slot, SET_MATH_OP f);
                                    _         =>  ();
                                esac;
                            };
                    end;

                buttons
                    =
                    lw::as_widget
                        (lw::make_line_of_widgets  root_window
                            (lw::VT_CENTER
                              [
                                lw::SPACER { min_size => 5, ideal_size => 5, max_size => THE 5 },

                                (lw::HZ_CENTER
                                  [
                                                                                                                                lw::SPACER { min_size=>5, ideal_size=>10, max_size=>THE 20 },
                                    lw::WIDGET (sz::make_tight_size_preference_wrapper (pb::as_widget   quit_button)),          lw::SPACER { min_size=>5, ideal_size=>10, max_size=>THE 10 },
                                    lw::WIDGET (sz::make_tight_size_preference_wrapper (pb::as_widget single_button)),          lw::SPACER { min_size=>5, ideal_size=>10, max_size=>THE 10 },
                                    lw::WIDGET (sz::make_tight_size_preference_wrapper (pb::as_widget   easy_button)),          lw::SPACER { min_size=>5, ideal_size=>10, max_size=>THE 10 },
                                    lw::WIDGET (sz::make_tight_size_preference_wrapper (pb::as_widget medium_button)),          lw::SPACER { min_size=>5, ideal_size=>10, max_size=>THE 10 },
                                    lw::WIDGET (sz::make_tight_size_preference_wrapper (pb::as_widget   hard_button)),          lw::SPACER { min_size=>5, ideal_size=>10, max_size=>THE 10 },

                                    lw::WIDGET
                                        (sz::make_tight_size_preference_wrapper
                                            (border::as_widget
                                                (border::make_border
                                                  {
                                                    color =>  THE xc::black,
                                                    width =>  1,
                                                    child =>  tl::as_widget  op_list
                                                  }
                                        )   )   ),                                                                              lw::SPACER { min_size=>5, ideal_size=>10, max_size=>THE 10 },

                                    lw::WIDGET (sz::make_tight_size_preference_wrapper (lbl::as_widget games_won_label)),
                                    lw::WIDGET (sz::make_tight_size_preference_wrapper (lbl::as_widget games_won_count)),       lw::SPACER { min_size=>5, ideal_size=>10, max_size=>NULL }
                                  ]
                                ),

                                lw::SPACER { min_size => 5, ideal_size => 5, max_size => THE 5 }
                              ]
                            )
                        );

                # Grab control of the keystroke eventstream for the calculation_panel:
                #
                my (calc_widget, calc_keyboard_eventstream_filtering_hook')
                    = 
                    wg::filter_keyboard (sz::make_tight_sized_preference_wrapper (ca::as_widget calc_pane, xg::SIZE { wide=>300, high=>400 } ));

                # Lay out the toplevel window:
                #
                #    Left:   Calculation pane.
                #    Right:  Diver-animation pane.
                #    Bottom: Control Buttons.
                #
                layout
                    =
                    lw::as_widget
                        (lw::make_line_of_widgets  root_window
                            (lw::VT_CENTER
                              [
                                lw::HZ_CENTER
                                  [
                                    lw::WIDGET  calc_widget,
                                    lw::WIDGET (dv::make_vertical_divider root_window { color=>NULL, width=>1 } ),
                                    lw::WIDGET (dvr::as_widget diver_pane)
                                  ],

                                lw::WIDGET (dv::make_horizontal_divider root_window { color=>NULL, width=>1 } ),
                                lw::WIDGET buttons
                              ]
                            )
                        );

                # Grab control of the keystroke eventstream for the complete layout:
                #
                (wg::filter_keyboard  layout)
                    ->
                    (layout, layout_keyboard_eventstream_filtering_hook');

                topwindow
                    =
                    tw::make_topwindow
                      ( layout,
                        NULL,
                        { window_name => THE "Arith",
                          icon_name   => THE "Arith"
                        }
                      );

                fun main' op_fn
                    =
                    start_game (ca::EASY, op_fn)
                    where
                        fun start_game (d, op_fn)
                            =
                            {   ca::start_game calc_pane (d, op_fn);
                                dvr::start diver_pane;
                                loop (rounds, op_fn, d);
                            }

                        also
                        fun loop (0, op_fn, d)
                                =>
                                {   game_won ();
                                    ca::reset calc_pane;
                                    dvr::wave;
                                    idle op_fn;
                                };

                            loop (i, op_fn, d)
                                =>
                                {
                                    fun do_right_or_wrong  right_or_wrong
                                        =
                                        {
                                            case null_or_''right_or_wrong''_slot
                                                #
                                                NULL     =>  ();
                                                THE slot =>  put_in_mailslot (slot, right_or_wrong);
                                            esac;       

                                            case right_or_wrong
                                                #
                                                ca::RIGHT
                                                    =>
                                                    {   dvr::up diver_pane;
                                                        loop (i - 1, op_fn, d);
                                                    };

                                                ca::WRONG
                                                    =>
                                                    {   dvr::dive  diver_pane;
                                                        ca::reset calc_pane;
                                                        idle op_fn;
                                                    };
                                            esac;
                                        };

                                    fun do_new_game (SET_GAME_DIFFICULTY d')   =>  start_game (d', op_fn );
                                        do_new_game (SET_MATH_OP op_fn') =>  start_game (d,  op_fn');
                                    end;

                                    do_one_mailop [
                                        right_or_wrong' ==>  do_right_or_wrong,
                                        new_game'       ==>  do_new_game
                                    ];
                                };
                        end

                        also
                        fun idle op_fn
                            = 
                            case (block_until_mailop_fires  new_game')
                                #
                                SET_GAME_DIFFICULTY d    =>  start_game (d, op_fn);
                                SET_MATH_OP op_fn' =>  idle op_fn';
                            esac;
                    end;


                # Read one result each from the given list of mailops.
                # Return list of results:
                #
                fun read_all_mailops []
                        =>
                        [];

                    read_all_mailops  mailops
                        =>
                        read_all (make_triples mailops)
                        where
                        
                            # This expression converts
                            #     [ mailop0, mailop1, ... mailopn ]
                            # into
                            #     [ (0,  NULL,  mailop0 ==>  fn v = (v, 0)),
                            #       (1,  NULL,  mailop0 ==>  fn v = (v, 1)),
                            #       ...
                            #       (n,  NULL,  mailop0 ==>  fn v = (v, n)),
                            #     ]
                            # Here the first column just numbers the list elements,
                            # the second column will eventully hold the values
                            # read from the mailops, and the third column holds
                            # the relevant mailop wrapped so as to remember its
                            # id number.
                            #   
                            fun make_triples  mailops
                                =
                                (reverse
                                    (#1 (fold_forward
                                            (fn (mailop, (triples, i)) = (make_triple (mailop, i) ! triples, i+1))
                                            ([], 0)
                                            mailops
                                        )
                                    )
                                )
                                where
                                    fun make_triple (mailop, i)
                                        =
                                        ( i,                                    # Small int identifying this triple.
                                          NULL,                                 # We change this to (THE result) once the mailop yields a result.
                                          mailop ==> (fn v = (v, i))            # Wrap the mailop to remember 'i'.
                                        );
                                end;


                            # Record value returned by i'th mailop.
                            #           
                            # First arg is a list of triples as above.
                            #
                            # Second argument (mailop_result, i) contains the mailop value
                            # and the int identifying which triple to update.
                            #
                            fun note_mailop_result ([], _)
                                    =>
                                    [];

                                note_mailop_result ((item as (j, _, mailop)) ! rest, (mailop_result, i))
                                    =>
                                    if (i == j)   (j, THE mailop_result, mailop) ! rest;
                                    else          item ! (note_mailop_result (rest, (mailop_result, i)));
                                    fi;
                            end;

                            # Search triplet list for ones where middle entry is
                            #     THE value
                            # and return those values:
                            #
                            fun get_mailop_results ([],                       results) =>  results;
                                get_mailop_results ((_, THE value, _) ! rest, results) =>  get_mailop_results (rest, value ! results);
                                get_mailop_results (               _  ! rest, results) =>  get_mailop_results (rest, results);
                            end;

                            # Search triplet list for ones where middle entry is
                            #     NULL
                            # and return the corresponding mailops (third triplet entry):
                            #
                            fun get_unread_mailops ([],                       results) =>  results;
                                get_unread_mailops ((_, NULL, mailop) ! rest, results) =>  get_unread_mailops (rest, mailop ! results);
                                get_unread_mailops (               _  ! rest, results) =>  get_unread_mailops (rest, results);
                            end;

                            # Read one result each from the given list of mailop triples.
                            # Return list of results:
                            #
                            fun read_all  mailop_triples
                                =
                                case (get_unread_mailops (mailop_triples, []))
                                    #
                                    []      =>  reverse (get_mailop_results (mailop_triples, []));
                                    mailops =>  read_all (note_mailop_result (mailop_triples, block_until_mailop_fires (cat_mailops mailops)));
                                esac;
                        end;
                end;                                    # fun read_all_mailops


                fun key_listen (layout_keyboard_eventstream_filtering_hook', calc_keyboard_eventstream_filtering_hook')
                    =
                    {   make_thread "add" sink;
                        loop ();
                    }
                    where
                        evtl = read_all_mailops [layout_keyboard_eventstream_filtering_hook', calc_keyboard_eventstream_filtering_hook'];

                        my (keyevt, _)
                            =
                            head evtl;

                        my (ckeyevt, keyslot)
                            =
                            head (tail evtl);

                        stipulate
                            to_ascii
                                =
                                xc::map_keysym_to_ascii
                                    xc::default_keysym_to_ascii_mapping;
                        herein
                            fun trans_key (xc::KEY_PRESS key) =>  THE (to_ascii key)  except _ = NULL;
                                trans_key _                   =>  NULL;
                            end;
                        end;

                        fun handled c
                            =
                            {
                                case (string::to_lower c)
                                    #
                                    "s" =>  { put_in_mailslot (game_control_slot, SET_GAME_DIFFICULTY ca::SINGLE);   TRUE; };
                                    "e" =>  { put_in_mailslot (game_control_slot, SET_GAME_DIFFICULTY ca::EASY  );   TRUE; };
                                    "m" =>  { put_in_mailslot (game_control_slot, SET_GAME_DIFFICULTY ca::MEDIUM);   TRUE; };
                                    "h" =>  { put_in_mailslot (game_control_slot, SET_GAME_DIFFICULTY ca::HARD  );   TRUE; };
                                    "q" =>  { quit_game();                                     TRUE; };
                                    "+" =>  { tl::set_textlist_selections op_list [(0, TRUE)]; TRUE; };
                                    "-" =>  { tl::set_textlist_selections op_list [(1, TRUE)]; TRUE; };
                                    "*" =>  { tl::set_textlist_selections op_list [(2, TRUE)]; TRUE; };
                                    "x" =>  { tl::set_textlist_selections op_list [(2, TRUE)]; TRUE; };
                                     _  =>  FALSE;
                                esac;
                            };

                        fun sink ()
                            =
                            for (;;) {
                                #
                                block_until_mailop_fires  ckeyevt;
                            };

                        fun loop ()
                            =
                            for (;;) {

                                keymsg = block_until_mailop_fires  keyevt;

                                case (trans_key (xc::envelope_contents  keymsg))
                                    #
                                    THE c
                                        =>
                                        if (not (handled c))
                                            put_in_mailslot (keyslot, keymsg);
                                        fi;

                                    NULL => ();
                                esac;

                            };

                    end;


                make_thread "add II"  .{
                    #
                    counter
                      ( won_slot,
                        lbl::set_label  games_won_count
                      );
                };

                make_thread "add III" .{
                    #
                    key_listen (layout_keyboard_eventstream_filtering_hook', calc_keyboard_eventstream_filtering_hook');
                };

                tw::start  topwindow;

                make_thread "add IV" op_listen;

                if *run_selfcheck
                    #
                    correct_answer_slot =   the  null_or_correct_answer_slot;
                    right_or_wrong_slot =   the  null_or_''right_or_wrong''_slot;

                    make_selfcheck_thread 
                      {
                        topwindow,
                        widgettree => layout,
                        xsession,
                        correct_answer_slot,
                        right_or_wrong_slot
                      };

                    ();
                fi;

                main'  ca::ADD; 
            };


        fun get_xdisplay_string_and_xauthentication_then_start_up_arithmetic_game_app_threads  display_name
            =
            {
                (xc::get_xdisplay_string_and_xauthentication
                    #
                    case display_name
                        #
                        "" =>  NULL;
                        _  =>  THE display_name;
                    esac
                )
                    ->
                    ( xdisplay,                                                         # Typically from $DISPLAY environment variable.
                      xauthentication:  Null_Or(xc::Xauthentication)                    # Typically from ~/.Xauthority
                    );

                start_up_arithmetic_game_app_threads (xdisplay, xauthentication);
            };

        fun set_up_arithmetic_game_app_task  display_name
            =
            # Here we arrange that all the threads
            # for the application run as a task "arithmetic 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:
            #
            {   arithmetic_game_app_task =   make_task  "arithmetic game app"  [];
                app_task                :=   THE  arithmetic_game_app_task;

                xtr::make_thread' [ THREAD_NAME "arithmetic game app",
                                    THREAD_TASK  arithmetic_game_app_task
                                  ]
                                  get_xdisplay_string_and_xauthentication_then_start_up_arithmetic_game_app_threads
                                  display_name;

                wait_for_app_task_done ();
            };

        fun do_it  display_name
            =
            {   xlogger::init [];
                #
                if write_tracelog   set_up_tracing ();   fi;

                set_up_arithmetic_game_app_task  display_name;
            };


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

        fun selfcheck ()
            =
            {
log::note .{ sprintf "%s\tselfcheck/TOP:    -- arithmetic-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                reset_global_mutable_state ();
                run_selfcheck :=  TRUE;
log::note .{ sprintf "%s\tselfcheck/MMM:    -- arithmetic-game-app.pkg" (mps::thread_scheduler_statestring ()); };
                do_it "";
log::note .{ sprintf "%s\tselfcheck/NNN:    -- arithmetic-game-app.pkg" (mps::thread_scheduler_statestring ()); };
result =
                test_stats ();
log::note .{ sprintf "%s\tselfcheck/ZZZ:    -- arithmetic-game-app.pkg" (mps::thread_scheduler_statestring ()); };
result;
            };  
    };

end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext