PreviousUpNext

15.4.1382  src/lib/x-kit/tut/widget/label-slider.pkg

## label-slider.pkg

# Compiled by:
#     src/lib/x-kit/tut/widget/widgets.lib


###                    "The best measure of a man's honesty
###                     isn't his income tax return. It's the
###                     zero adjust on his bathroom scale."
###
###                                 -- Arthur C. Clarke


stipulate
    include package   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 lbl =  label;                       # label                 is from   src/lib/x-kit/widget/old/leaf/label.pkg
    package rx  =  run_in_x_window_old;         # run_in_x_window_old   is from   src/lib/x-kit/widget/old/lib/run-in-x-window-old.pkg
    package top =  hostwindow;                  # hostwindow            is from   src/lib/x-kit/widget/old/basic/hostwindow.pkg
    package wg  =  widget;                      # widget                is from   src/lib/x-kit/widget/old/basic/widget.pkg
    package wa  =  widget_attribute_old;        # widget_attribute_old  is from   src/lib/x-kit/widget/old/lib/widget-attribute-old.pkg
    package wy  =  widget_style_old;            # widget_style_old      is from   src/lib/x-kit/widget/old/lib/widget-style-old.pkg
    package wt  =  widget_types;                # widget_types          is from   src/lib/x-kit/widget/old/basic/widget-types.pkg
    #
    package sl  =  slider;
    package low =  line_of_widgets;             # line_of_widgets       is from   src/lib/x-kit/widget/old/layout/line-of-widgets.pkg
herein

    package label_slider: api {
                            do_it': (List(String), String) -> Void;
                            do_it:   Void -> Void;
                            main:   (List(String), X) -> Void;
                          }
    {

        resources
            =
            [ "*relief: raised",
              "*background: forestgreen\n"
            ];

        fun make_label_slider (root, view)
            =
            {   l_args = [ (wa::label,  wa::STRING_VAL "0"),
                           (wa::width,  wa::INT_VAL     4 ),
                           (wa::halign, wa::HALIGN_VAL  wt::HRIGHT)
                         ];

                label = lbl::make_label' (root, view, l_args);

                s_args = [ (wa::width,        wa::INT_VAL   20),
                           (wa::is_vertical,  wa::BOOL_VAL  FALSE)
                         ];

                slider = sl::make_slider (root, view, s_args);

                fun set l
                    =
                    lbl::set_label label (lbl::TEXT l);

                slider_motion' = sl::slider_motion'_of  slider;

                fun loop ()
                    =
                    for (;;) {
                        #
                        set (int::to_string (block_until_mailop_fires  slider_motion'));
                    };

                make_thread "label slider"  loop;

                low::as_widget
                    (low::line_of_widgets
                        (root, view,[])
                        (low::HZ_CENTER
                          [
                            #  SPACER { min_size=>0, best_size=>20, max_size=>NULL }, 
                            low::WIDGET (lbl::as_widget label), 
                            low::SPACER { min_size=>20,  best_size=>20, max_size=>THE 20 },
                            low::WIDGET (sl::as_widget slider)
                          ]
                        )
                    );
            };

        fun tester root
            =
            {   top::start_widgettree_running_in_hostwindow  hostwindow;
                loop ();
            }
            where
                fun quit ()
                    =
                    {   wg::delete_root_window root;
                        shut_down_thread_scheduler  winix__premicrothread::process::success;
                    };

                style = wg::style_from_strings (root, resources);

                name =  wy::make_view
                          { name    =>   wy::style_name [],
                            aliases => [ wy::style_name [] ]
                          };

                view = (name, style);

                lslider = make_label_slider (root, view);

                layout
                    =
                    low::line_of_widgets
                        (root, view, [])
                        (low::VT_CENTER
                          [ low::WIDGET lslider,
                            low::HZ_CENTER
                              [ low::SPACER { min_size=>0,  best_size=>300, max_size=>NULL } ]
                          ]
                        );

                hostwindow = top::hostwindow
                            (root, view,[])
                            (low::as_widget layout);

                fun loop ()
                    =
                    case (fil::read_line  fil::stdin)
                        #
                        THE string
                            =>
                            string ==  "quit\n"   ??   quit ()
                                                  ::   loop ();
                        NULL
                            =>
                            quit ();
                    esac;
            end;

        fun do_it' (debug_flags, server)
            =
            {   xlogger::init debug_flags;
                #
                rx::run_in_x_window_old'  tester  [ rx::DISPLAY server ];
            };

        fun do_it ()
            =
            rx::run_in_x_window_old  tester;

        fun main (program ! server ! _, _) =>  do_it'([], server);
            main _                         =>  do_it ();
        end;

    };                                          # package label_slider 
end;

## COPYRIGHT (c) 1991, 1995 by AT&T Bell Laboratories.  See SMLNJ-COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext