## widget-unit-test.pkg
#
# For the big picture see the imp dataflow diagrams in
#
# src/lib/x-kit/xclient/src/window/xclient-ximps.pkg#
# NB: We must compile this locally via
# xclient-internals.sublib
# instead of globally via
# src/lib/test/unit-tests.lib# like most unit tests, in order to have
# access to required library internals.
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublib# Run by:
# src/lib/test/all-unit-tests.pkgstipulate
include package unit_test; # unit_test is from src/lib/src/unit-test.pkg include package makelib::scripting_globals;
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package ap = client_to_atom; # client_to_atom is from src/lib/x-kit/xclient/src/iccc/client-to-atom.pkg package au = authentication; # authentication is from src/lib/x-kit/xclient/src/stuff/authentication.pkg package awx = guishim_imp_for_x; # guishim_imp_for_x is from src/lib/x-kit/widget/xkit/app/guishim-imp-for-x.pkg package agx = app_to_guishim_xspecific; # app_to_guishim_xspecific is from src/lib/x-kit/widget/theme/app-to-guishim-xspecific.pkg package cpm = cs_pixmap; # cs_pixmap is from src/lib/x-kit/xclient/src/window/cs-pixmap.pkg package cpt = cs_pixmat; # cs_pixmat is from src/lib/x-kit/xclient/src/window/cs-pixmat.pkg #
package gd = gui_displaylist; # gui_displaylist is from src/lib/x-kit/widget/theme/gui-displaylist.pkg #
package dbx = sprite_theme_imp; # sprite_theme_imp is from src/lib/x-kit/widget/xkit/theme/sprite/default/sprite-theme-imp.pkg package dcx = object_theme_imp; # object_theme_imp is from src/lib/x-kit/widget/xkit/theme/object/default/object-theme-imp.pkg package dtx = widget_theme_imp; # widget_theme_imp is from src/lib/x-kit/widget/xkit/theme/widget/default/widget-theme-imp.pkg #
package dy = display; # display is from src/lib/x-kit/xclient/src/wire/display.pkg# package w2x = windowsystem_to_xserver; # windowsystem_to_xserver is from src/lib/x-kit/xclient/src/window/windowsystem-to-xserver.pkg package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package fti = font_index; # font_index is from src/lib/x-kit/xclient/src/window/font-index.pkg package gtg = guiboss_to_guishim; # guiboss_to_guishim is from src/lib/x-kit/widget/theme/guiboss-to-guishim.pkg package gq = guiboss_imp; # guiboss_imp is from src/lib/x-kit/widget/gui/guiboss-imp.pkg# package r2k = xevent_router_to_keymap; # xevent_router_to_keymap is from src/lib/x-kit/xclient/src/window/xevent-router-to-keymap.pkg package mtx = rw_matrix; # rw_matrix is from src/lib/std/src/rw-matrix.pkg package r8 = rgb8; # rgb8 is from src/lib/x-kit/xclient/src/color/rgb8.pkg package rgb = rgb; # rgb is from src/lib/x-kit/xclient/src/color/rgb.pkg package rop = ro_pixmap; # ro_pixmap is from src/lib/x-kit/xclient/src/window/ro-pixmap.pkg package rw = root_window; # root_window is from src/lib/x-kit/widget/lib/root-window.pkg package rwv = rw_vector; # rw_vector is from src/lib/std/src/rw-vector.pkg package sep = client_to_selection; # client_to_selection is from src/lib/x-kit/xclient/src/window/client-to-selection.pkg package shp = shade; # shade is from src/lib/x-kit/widget/lib/shade.pkg package sj = socket_junk; # socket_junk is from src/lib/internet/socket-junk.pkg# package x2s = xclient_to_sequencer; # xclient_to_sequencer is from src/lib/x-kit/xclient/src/wire/xclient-to-sequencer.pkg package ti = template_imp; # template_imp is from src/lib/x-kit/xclient/src/wire/template-imp.pkg package tem = template; # template is from src/lib/x-kit/xclient/src/wire/template.pkg package tr = logger; # logger is from src/lib/src/lib/thread-kit/src/lib/logger.pkg package tsr = thread_scheduler_is_running; # thread_scheduler_is_running is from src/lib/src/lib/thread-kit/src/core-thread-kit/thread-scheduler-is-running.pkg package u1 = one_byte_unt; # one_byte_unt is from src/lib/std/one-byte-unt.pkg package v1u = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg package v2w = value_to_wire; # value_to_wire is from src/lib/x-kit/xclient/src/wire/value-to-wire.pkg package wg = widget; # widget is from src/lib/x-kit/widget/old/basic/widget.pkg package wi = window; # window is from src/lib/x-kit/xclient/src/window/window.pkg package wme = window_map_event_sink; # window_map_event_sink is from src/lib/x-kit/xclient/src/window/window-map-event-sink.pkg package wpp = client_to_window_watcher; # client_to_window_watcher is from src/lib/x-kit/xclient/src/window/client-to-window-watcher.pkg package wy = widget_style; # widget_style is from src/lib/x-kit/widget/lib/widget-style.pkg package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package g2j = geometry2d_junk; # geometry2d_junk is from src/lib/std/2d/geometry2d-junk.pkg package xj = xsession_junk; # xsession_junk is from src/lib/x-kit/xclient/src/window/xsession-junk.pkg package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg package gtj = guiboss_types_junk; # guiboss_types_junk is from src/lib/x-kit/widget/gui/guiboss-types-junk.pkg package blk = blank; # blank is from src/lib/x-kit/widget/leaf/blank.pkg package frm = frame; # frame is from src/lib/x-kit/widget/leaf/frame.pkg package ab = arrowbutton; # arrowbutton is from src/lib/x-kit/widget/leaf/arrowbutton.pkg package bb = button; # button is from src/lib/x-kit/widget/leaf/button.pkg package cb = checkbox; # checkbox is from src/lib/x-kit/widget/leaf/checkbox.pkg package db = diamondbutton; # diamondbutton is from src/lib/x-kit/widget/leaf/diamondbutton.pkg package rb = roundbutton; # roundbutton is from src/lib/x-kit/widget/leaf/roundbutton.pkg# package sl = screenline; # screenline is from src/lib/x-kit/widget/edit/screenline.pkg package tpf = textpane; # textpane is from src/lib/x-kit/widget/edit/textpane.pkg package his = horizontal_int_slider; # horizontal_int_slider is from src/lib/x-kit/widget/leaf/horizontal-int-slider.pkg package hfs = horizontal_float_slider; # horizontal_float_slider is from src/lib/x-kit/widget/leaf/horizontal-float-slider.pkg package vis = vertical_int_slider; # vertical_int_slider is from src/lib/x-kit/widget/leaf/vertical-int-slider.pkg package vfs = vertical_float_slider; # vertical_float_slider is from src/lib/x-kit/widget/leaf/vertical-float-slider.pkg package ten = textentry; # textentry is from src/lib/x-kit/widget/leaf/textentry.pkg package ted = texteditor; # texteditor is from src/lib/x-kit/widget/edit/texteditor.pkg# package xet = xevent_types; # xevent_types is from src/lib/x-kit/xclient/src/wire/xevent-types.pkg# package e2s = xevent_to_string; # xevent_to_string is from src/lib/x-kit/xclient/src/to-string/xevent-to-string.pkg# package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg #
# The above three are the X-specific versions of the
# below two platform-independent packages. X events
# come to windowsystem-imp-for-x in xet:: encoding. It # For the big dataflow diagram see src/lib/x-kit/xclient/src/window/xclient-ximps.pkg # translates them to evt:: encoding and forward them to
# guiboss_imp, which forwards them to appropriate imps. # guiboss_imp is from src/lib/x-kit/widget/gui/guiboss-imp.pkg #
package gt = guiboss_types; # guiboss_types is from src/lib/x-kit/widget/gui/guiboss-types.pkg package wt = widget_theme; # widget_theme is from src/lib/x-kit/widget/theme/widget/widget-theme.pkg package evt = gui_event_types; # gui_event_types is from src/lib/x-kit/widget/gui/gui-event-types.pkg# package gts = gui_event_to_string; # gui_event_to_string is from src/lib/x-kit/widget/gui/gui-event-to-string.pkg #
# This one translates from the X to Gui versions:
# package x2g = xevent_to_gui_event; # xevent_to_gui_event is from src/lib/x-kit/widget/xkit/app/xevent-to-gui-event.pkg# package g2x = gui_event_to_xevent; # gui_event_to_xevent is from src/lib/x-kit/widget/xkit/app/gui-event-to-xevent.pkg package oim = object_imp; # object_imp is from src/lib/x-kit/widget/xkit/theme/widget/default/look/object-imp.pkg package sim = sprite_imp; # sprite_imp is from src/lib/x-kit/widget/xkit/theme/widget/default/look/sprite-imp.pkg package wim = widget_imp; # widget_imp is from src/lib/x-kit/widget/xkit/theme/widget/default/look/widget-imp.pkg package hslider = horizontal_int_slider; # horizontal_int_slider is from src/lib/x-kit/widget/leaf/horizontal-int-slider.pkg package hflider = horizontal_float_slider; # horizontal_float_slider is from src/lib/x-kit/widget/leaf/horizontal-float-slider.pkg package vslider = vertical_int_slider; # vertical_int_slider is from src/lib/x-kit/widget/leaf/vertical-int-slider.pkg package vflider = vertical_float_slider; # vertical_float_slider is from src/lib/x-kit/widget/leaf/vertical-float-slider.pkg tracefile = "widget-unit-test.trace.log";
# id = iui::issue_unique_id;
nb = log::note_on_stderr; # log is from src/lib/std/src/log.pkg# These are crude hacks to force these to compile:
#
Dummy1 = wim::Widget;
Dummy2 = oim::Object;
Dummy3 = sim::Sprite;
dummy4 = ab::with;
dummy6 = blk::with;
dummy7 = ten::with;
dummy8 = ted::with;
sample_text
=
"=====================================\t# This is a poem by\n\
\#\t\t\t\t\t# Samuel Taylor Coleridge\n\
\In Xanadu did Kubla Khan\n\
\A stately pleasure-dome decree:\n\
\Where Alph, the sacred river, ran\n\
\Through caverns measureless to man\n\
\\tDown to a sunless sea.\n\
\So twice five miles of fertile ground\n\
\With walls and towers were girdled round;\n\
\And there were gardens bright with sinuous rills,\n\
\Where blossomed many an incense-bearing tree;\n\
\And here were forests ancient as the hills,\n\
\Enfolding sunny spots of greenery.\n\
\\n\
\But oh! that deep romantic chasm which slanted\n\
\Down the green hill athwart a cedarn cover!\n\
\A savage place! as holy and enchanted\n\
\As e'er beneath a waning moon was haunted\n\
\By woman wailing for her demon-lover!\n\
\And from this chasm, with ceaseless turmoil seething,\n\
\As if this earth in fast thick pants were breathing,\n\
\A mighty fountain momently was forced:\n\
\Amid whose swift half-intermitted burst\n\
\Huge fragments vaulted like rebounding hail,\n\
\Or chaffy grain beneath the thresher's flail:\n\
\And 'mid these dancing rocks at once and ever\n\
\It flung up momently the sacred river.\n\
\Five miles meandering with a mazy motion\n\
\Through wood and dale the sacred river ran,\n\
\Then reached the caverns measureless to man,\n\
\And sank in tumult to a lifeless ocean;\n\
\And 'mid this tumult Kubla heard from far\n\
\Ancestral voices prophesying war!\n\
\ The shadow of the dome of pleasure\n\
\ Floated midway on the waves;\n\
\ Where was heard the mingled measure\n\
\ From the fountain and the caves.\n\
\It was a miracle of rare device,\n\
\A sunny pleasure-dome with caves of ice!\n\
\\n\
\ A damsel with a dulcimer\n\
\ In a vision once I saw:\n\
\ It was an Abyssinian maid\n\
\ And on her dulcimer she played,\n\
\ Singing of Mount Abora.\n\
\ Could I revive within me\n\
\ Her symphony and song,\n\
\ To such a deep delight 'twould win me,\n\
\That with music loud and long,\n\
\I would build that dome in air,\n\
\That sunny dome! those caves of ice!\n\
\And all who heard should see them there,\n\
\And all should cry, Beware! Beware!\n\
\His flashing eyes, his floating hair!\n\
\Weave a circle round him thrice,\n\
\And close your eyes with holy dread\n\
\For he on honey-dew hath fed,\n\
\And drunk the milk of Paradise.\n\
\\^A\^B\^C\^I\^K\n\
\And now for something completely different -- some test 16-bit UTF8 chars.\n\
\Depending on your font, you may see mostly boxes:\n\
\ĀāĂ㥹ĆćĈĉĊċČčĎďĐđĒēĔĕĖėĘęĚěĜĝĞğĠġĢģĤĥĦħĨĩĪīĬĭĮįİıIJijĴĵĶķĸĹĺĻļĽľĿŀŁłŃńŅņŇňʼnŊŋŌōŎŏŐőŒœŔŕŖŗŘřŚśŜŝŞşŠšŢţŤťŦŧŨũŪūŬŭŮůŰűŲųŴŵŶŷŸŹźŻżŽžſ\n\
\ƀƁƂƃƄƅƆƇƈƉƊƋƌƍƎƏƐƑƒƓƔƕƖƗƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁǂǃDŽDždžLJLjljNJNjnjǍǎǏǐǑǒǓǔǕǖǗǘǙǚǛǜǝǞǟǠǡǢǣǤǥǦǧǨǩǪǫǬǭǮǯǰDZDzdzǴǵǶǷǸǹǺǻǼǽǾǿȀȁȂȃȄȅȆȇȈȉȊȋȌȍȎȏȐȑȒȓȔȕȖȗȘșȚțȜȝȞȟȠȡȢȣȤȥȦȧȨȩȪȫȬȭȮȯȰȱȲȳȴȵȶȷȸȹȺȻȼȽȾȿɀɁɂɃɄɅɆɇɈɉɊɋɌɍɎɏ\n\
\ɐɑɒɓɔɕɖɗɘəɚɛɜɝɞɟɠɡɢɣɤɥɦɧɨɩɪɫɬɭɮɯɰɱɲɳɴɵɶɷɸɹɺɻɼɽɾɿʀʁʂʃʄʅʆʇʈʉʊʋʌʍʎʏʐʑʒʓʔʕʖʗʘʙʚʛʜʝʞʟʠʡʢʣʤʥʦʧʨʩʪʫʬʭʮʯ\n\
\ʰʱʲʳʴʵʶʷʸʹʺʻʼʽʾʿˀˁ˂˃˄˅ˆˇˈˉˊˋˌˍˎˏːˑ˒˓˔˕˖˗˘˙˚˛˜˝˞˟ˠˡˢˣˤ˥˦˧˨˩˪˫ˬ˭ˮ˯˰˱˲˳˴˵˶˷˸˹˺˻˼˽˾˿\n\
\ͰͱͲͳʹ͵Ͷͷͺͻͼͽ;Ϳ΄΅Ά·ΈΉΊΌΎΏΐΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩΪΫάέήίΰαβγδεζηθικλμνξοπρςστυφχψωϊϋόύώϏϐϑϒϓϔϕϖϗϘϙϚϛϜϝϞϟϠϡϢϣϤϥϦϧϨϩϪϫϬϭϮϯϰϱϲϳϴϵ϶ϷϸϹϺϻϼϽϾϿ\n\
\ЀЁЂЃЄЅІЇЈЉЊЋЌЍЎЏАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюяѐёђѓєѕіїјљњћќѝўџѠѡѢѣѤѥѦѧѨѩѪѫѬѭѮѯѰѱѲѳѴѵѶѷѸѹѺѻѼѽѾѿҀҁ҂҃҄҅҆҇҈҉ҊҋҌҍҎҏҐґҒғҔҕҖҗҘҙҚқҜҝҞҟҠҡҢңҤҥҦҧҨҩҪҫҬҭҮүҰұҲҳҴҵҶҷҸҹҺһҼҽҾҿӀӁӂӃӄӅӆӇӈӉӊӋӌӍӎӏӐӑӒӓӔӕӖӗӘәӚӛӜӝӞӟӠӡӢӣӤӥӦӧӨөӪӫӬӭӮӯӰӱӲӳӴӵӶӷӸӹӺӻӼӽӾӿ\\n\
\ԱԲԳԴԵԶԷԸԹԺԻԼԽԾԿՀՁՂՃՄՅՆՇՈՉՊՋՌՍՎՏՐՑՒՓՔՕՖՙ՚՛՜՝՞ ՟աբգդեզէըթժիլխծկհձղճմյնշոչպջռսվտրցւփքօֆև։֊֍֎֏\n\
\ֿ׀ׁׂ׃ׅׄ׆ׇאבגדהוזחטיךכלםמןנסעףפץצקרשתװױײ׳״\n\
\℀℁ℂ℃℄℅℆ℇ℈℉ℊℋℌℍℎℏℐℑℒℓ℔ℕ№℗℘ℙℚℛℜℝ℞℟℠℡™℣ℤ℥Ω℧ℨ℩KÅℬℭ℮ℯℰℱℲℳℴℵℶℷℸℹ℺℻ℼℽℾℿ⅀⅁⅂⅃⅄ⅅⅆⅇⅈⅉ⅊⅋⅌⅍ⅎ⅏\n\
\⟰⟱⟲⟳⟴⟵⟶⟷⟸⟹⟺⟻⟼⟽⟾⟿⤀⤁⤂⤃⤄⤅⤆⤇⤈⤉⤊⤋⤌⤍⤎⤏⤐⤑⤒⤓⤔⤕⤖⤗⤘⤙⤚⤛⤜⤝⤞⤟⤠⤡⤢⤣⤤⤥⤦⤧⤨⤩⤪⤫⤬⤭⤮⤯⤰⤱⤲⤳⤴⤵⤶⤷⤸⤹⤺⤻⤼⤽⤾⤿⥀⥁⥂⥃⥄⥅⥆⥇⥈⥉⥊⥋⥌⥍⥎⥏⥐⥑⥒⥓⥔⥕⥖⥗⥘⥙⥚⥛⥜⥝⥞⥟⥠⥡⥢⥣⥤⥥⥦⥧⥨⥩⥪⥫⥬⥭⥮⥯⥰⥱⥲⥳⥴⥵⥶⥷⥸⥹⥺⥻⥼⥽⥾⥿\n\
\✁✂✃✄✅✆✇✈✉✊✋✌✍✎✏✐✑✒✓✔✕✖✗✘✙✚✛✜✝✞✟✠✡✢✣✤✥✦✧✨✩✪✫✬✭✮✯✰✱✲✳✴✵✶✷✸✹✺✻✼✽✾✿❀❁❂❃❄❅❆❇❈❉❊❋❌❍❎❏❐❑❒❓❔❕❖❗❘❙❚❛❜❝❞❟❠❡❢❣❤❥❦❧❨❩❪❫❬❭❮❯❰❱❲❳❴❵❶❷❸❹❺❻❼❽❾❿➀➁➂➃➄➅➆➇➈➉➊➋➌➍➎➏➐➑➒➓➔➕➖➗➘➙➚➛➜➝➞➟➠➡➢➣➤➥➦➧➨➩➪➫➬➭➮➯➰➱➲➳➴➵➶➷➸➹➺➻➼➽➾➿\n\
\∑−∓∔∕∖∗∘∙√∛∜∝∞∟\n\
\";
herein
package widget_unit_test {
#
name = "src/lib/x-kit/widget/widget-unit-test.pkg";
trace = xtr::log_if xtr::io_logging 0; # Conditionally write strings to tracing.log or whatever.
fun exercise_convex_hull () # Probably should be in a separate geometry2d-unit-text.pkg, but at the moment I'm too lazy to take time to establish one.
=
{
points1 = [ { col => 100, row => 100 }, { col => 400, row => 100 }, { col => 400, row => 400 }, { col => 100, row => 400 } ];
points2 = [ { col => 200, row => 200 }, { col => 300, row => 200 }, { col => 300, row => 300 }, { col => 200, row => 300 } ];
points3 = points1 @ points2;
#
points1' = g2d::convex_hull points1;
points2' = g2d::convex_hull points2;
points4 = g2d::convex_hull points3;
#
assert (points1' == points1);
assert (points2' == points2);
assert (points4 == points1);
#
points1' = g2d::convex_hull (reverse points1);
points2' = g2d::convex_hull (reverse points2);
points4 = g2d::convex_hull (reverse points3);
#
assert (points1' == points1);
assert (points2' == points2);
assert (points4 == points1);
};
fun exercise_point_in_polygon () # Probably should be in a separate geometry2d-unit-text.pkg, but at the moment I'm too lazy to take time to establish one.
=
{
# Basic square, as above
#
points = [ { col => 100, row => 100 }, { col => 200, row => 100 }, { col => 200, row => 200 }, { col => 100, row => 200 } ];
#
p1 = { col => 0, row => 0 }; p4 = { col => 0, row => 150 }; p7 = { col => 0, row => 250 }; # Middles of the 9 squares of a tic-tac-toe pattern.
p2 = { col => 150, row => 0 }; p5 = { col => 150, row => 150 }; p8 = { col => 150, row => 250 };
p3 = { col => 250, row => 0 }; p6 = { col => 250, row => 150 }; p9 = { col => 250, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == TRUE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
assert (g2d::point_in_polygon(p9,points) == FALSE);
p1 = { col => 0, row => 100 }; # On the horizontal lines of the tic-tac-toe pattern.
p2 = { col => 250, row => 100 };
p3 = { col => 0, row => 200 };
p4 = { col => 250, row => 200 };
p5 = { col => 100, row => 0 }; # On the vertical lines of the tic-tac-toe pattern.
p7 = { col => 100, row => 250 };
p7 = { col => 200, row => 0 };
p8 = { col => 200, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == FALSE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
points = [ { col => 100, row => 200 }, { col => 200, row => 200 }, { col => 200, row => 100 }, { col => 100, row => 100 } ]; # Does vertex order matter?
p1 = { col => 0, row => 0 }; p4 = { col => 0, row => 150 }; p7 = { col => 0, row => 250 }; # Middles of the 9 squares of a tic-tac-toe pattern.
p2 = { col => 150, row => 0 }; p5 = { col => 150, row => 150 }; p8 = { col => 150, row => 250 };
p3 = { col => 250, row => 0 }; p6 = { col => 250, row => 150 }; p9 = { col => 250, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == TRUE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
assert (g2d::point_in_polygon(p9,points) == FALSE);
p1 = { col => 0, row => 100 }; # On the horizontal lines of the tic-tac-toe pattern.
p2 = { col => 250, row => 100 };
p3 = { col => 0, row => 200 };
p4 = { col => 250, row => 200 };
p5 = { col => 100, row => 0 }; # On the vertical lines of the tic-tac-toe pattern.
p7 = { col => 100, row => 250 };
p7 = { col => 200, row => 0 };
p8 = { col => 200, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == FALSE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
points = [ { col => 100, row => 100 }, { col => 100, row => 100 }, # Do duplicate vertices matter?
{ col => 200, row => 100 }, { col => 200, row => 100 },
{ col => 200, row => 200 }, { col => 200, row => 200 },
{ col => 100, row => 200 }, { col => 100, row => 200 }
];
p1 = { col => 0, row => 0 }; p4 = { col => 0, row => 150 }; p7 = { col => 0, row => 250 }; # Middles of the 9 squares of a tic-tac-toe pattern.
p2 = { col => 150, row => 0 }; p5 = { col => 150, row => 150 }; p8 = { col => 150, row => 250 };
p3 = { col => 250, row => 0 }; p6 = { col => 250, row => 150 }; p9 = { col => 250, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == TRUE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
assert (g2d::point_in_polygon(p9,points) == FALSE);
p1 = { col => 0, row => 100 }; # On the horizontal lines of the tic-tac-toe pattern.
p2 = { col => 250, row => 100 };
p3 = { col => 0, row => 200 };
p4 = { col => 250, row => 200 };
p5 = { col => 100, row => 0 }; # On the vertical lines of the tic-tac-toe pattern.
p7 = { col => 100, row => 250 };
p7 = { col => 200, row => 0 };
p8 = { col => 200, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == FALSE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
# Diamond instead of square:
#
points = [ { col => 100, row => 150 }, { col => 150, row => 200 }, { col => 200, row => 150 }, { col => 150, row => 100 } ];
#
p1 = { col => 0, row => 0 }; p4 = { col => 0, row => 150 }; p7 = { col => 0, row => 250 }; # Middles of the 9 squares of a tic-tac-toe pattern.
p2 = { col => 150, row => 0 }; p5 = { col => 150, row => 150 }; p8 = { col => 150, row => 250 };
p3 = { col => 250, row => 0 }; p6 = { col => 250, row => 150 }; p9 = { col => 250, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == TRUE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
assert (g2d::point_in_polygon(p9,points) == FALSE);
p1 = { col => 0, row => 100 }; # On the horizontal lines of the tic-tac-toe pattern.
p2 = { col => 250, row => 100 };
p3 = { col => 0, row => 200 };
p4 = { col => 250, row => 200 };
p5 = { col => 100, row => 0 }; # On the vertical lines of the tic-tac-toe pattern.
p7 = { col => 100, row => 250 };
p7 = { col => 200, row => 0 };
p8 = { col => 200, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == FALSE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
# Chevron shape concave down:
#
points = [ { col => 100, row => 150 }, { col => 150, row => 200 }, { col => 200, row => 150 }, { col => 150, row => 190 } ];
#
#
p1 = { col => 0, row => 0 }; p4 = { col => 0, row => 150 }; p7 = { col => 0, row => 250 }; # Middles of the 9 squares of a tic-tac-toe pattern.
p2 = { col => 150, row => 0 }; p5 = { col => 150, row => 150 }; p8 = { col => 150, row => 250 };
p3 = { col => 250, row => 0 }; p6 = { col => 250, row => 150 }; p9 = { col => 250, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == FALSE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
assert (g2d::point_in_polygon(p9,points) == FALSE);
p1 = { col => 0, row => 100 }; # On the horizontal lines of the tic-tac-toe pattern.
p2 = { col => 250, row => 100 };
p3 = { col => 0, row => 200 };
p4 = { col => 250, row => 200 };
p5 = { col => 100, row => 0 }; # On the vertical lines of the tic-tac-toe pattern.
p7 = { col => 100, row => 250 };
p7 = { col => 200, row => 0 };
p8 = { col => 200, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == FALSE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
# Chevron shape concave up:
#
points = [ { col => 100, row => 150 }, { col => 150, row => 110 }, { col => 200, row => 150 }, { col => 150, row => 100 } ];
#
#
p1 = { col => 0, row => 0 }; p4 = { col => 0, row => 150 }; p7 = { col => 0, row => 250 }; # Middles of the 9 squares of a tic-tac-toe pattern.
p2 = { col => 150, row => 0 }; p5 = { col => 150, row => 150 }; p8 = { col => 150, row => 250 };
p3 = { col => 250, row => 0 }; p6 = { col => 250, row => 150 }; p9 = { col => 250, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == FALSE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
assert (g2d::point_in_polygon(p9,points) == FALSE);
p1 = { col => 0, row => 100 }; # On the horizontal lines of the tic-tac-toe pattern.
p2 = { col => 250, row => 100 };
p3 = { col => 0, row => 200 };
p4 = { col => 250, row => 200 };
p5 = { col => 100, row => 0 }; # On the vertical lines of the tic-tac-toe pattern.
p7 = { col => 100, row => 250 };
p7 = { col => 200, row => 0 };
p8 = { col => 200, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == FALSE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
# Chevron shape concave left:
#
points = [ { col => 190, row => 150 }, { col => 150, row => 200 }, { col => 200, row => 150 }, { col => 150, row => 100 } ];
#
#
p1 = { col => 0, row => 0 }; p4 = { col => 0, row => 150 }; p7 = { col => 0, row => 250 }; # Middles of the 9 squares of a tic-tac-toe pattern.
p2 = { col => 150, row => 0 }; p5 = { col => 150, row => 150 }; p8 = { col => 150, row => 250 };
p3 = { col => 250, row => 0 }; p6 = { col => 250, row => 150 }; p9 = { col => 250, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == FALSE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
assert (g2d::point_in_polygon(p9,points) == FALSE);
p1 = { col => 0, row => 100 }; # On the horizontal lines of the tic-tac-toe pattern.
p2 = { col => 250, row => 100 };
p3 = { col => 0, row => 200 };
p4 = { col => 250, row => 200 };
p5 = { col => 100, row => 0 }; # On the vertical lines of the tic-tac-toe pattern.
p7 = { col => 100, row => 250 };
p7 = { col => 200, row => 0 };
p8 = { col => 200, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == FALSE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
# Chevron shape concave right:
#
points = [ { col => 100, row => 150 }, { col => 150, row => 200 }, { col => 110, row => 150 }, { col => 150, row => 100 } ];
#
#
p1 = { col => 0, row => 0 }; p4 = { col => 0, row => 150 }; p7 = { col => 0, row => 250 }; # Middles of the 9 squares of a tic-tac-toe pattern.
p2 = { col => 150, row => 0 }; p5 = { col => 150, row => 150 }; p8 = { col => 150, row => 250 };
p3 = { col => 250, row => 0 }; p6 = { col => 250, row => 150 }; p9 = { col => 250, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == FALSE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
assert (g2d::point_in_polygon(p9,points) == FALSE);
p1 = { col => 0, row => 100 }; # On the horizontal lines of the tic-tac-toe pattern.
p2 = { col => 250, row => 100 };
p3 = { col => 0, row => 200 };
p4 = { col => 250, row => 200 };
p5 = { col => 100, row => 0 }; # On the vertical lines of the tic-tac-toe pattern.
p7 = { col => 100, row => 250 };
p7 = { col => 200, row => 0 };
p8 = { col => 200, row => 250 };
assert (g2d::point_in_polygon(p1,points) == FALSE);
assert (g2d::point_in_polygon(p2,points) == FALSE);
assert (g2d::point_in_polygon(p3,points) == FALSE);
assert (g2d::point_in_polygon(p4,points) == FALSE);
assert (g2d::point_in_polygon(p5,points) == FALSE);
assert (g2d::point_in_polygon(p6,points) == FALSE);
assert (g2d::point_in_polygon(p7,points) == FALSE);
assert (g2d::point_in_polygon(p8,points) == FALSE);
};
fun next_relief wt::FLAT => wt::RAISED;
next_relief wt::RAISED => wt::SUNKEN;
next_relief wt::SUNKEN => wt::GROOVE;
next_relief wt::GROOVE => wt::RIDGE;
next_relief wt::RIDGE => wt::FLAT;
end;
fun relief_to_string wt::FLAT => "FLAT";
relief_to_string wt::RAISED => "RAISED";
relief_to_string wt::SUNKEN => "SUNKEN";
relief_to_string wt::GROOVE => "GROOVE";
relief_to_string wt::RIDGE => "RIDGE";
end;
fun make_three_row_guiplan
(
scrollable_view_size: g2d::Size,
popup_info: Null_Or( Void -> { requested_popup_site: g2d::Box, # For popup_plan this was: { row => 200, col => 200, wide => 1200, high => 900 };
popup_plan: gt::Guiplan, #
read_sites_and_ports: Void -> Void
}
),
popup_info3: Null_Or( Void -> { requested_popup_site: g2d::Box, #
popup_plan: gt::Guiplan, #
read_sites_and_ports: Void -> Void
}
),
popup_info1c: Null_Or( Void -> { requested_popup_site: g2d::Box, #
popup_plan: gt::Guiplan, #
read_sites_and_ports: Void -> Void
}
),
popup_info2c: Null_Or( Void -> { requested_popup_site: g2d::Box, #
popup_plan: gt::Guiplan, #
read_sites_and_ports: Void -> Void
}
),
popup_info3c: Null_Or( Void -> { requested_popup_site: g2d::Box, #
popup_plan: gt::Guiplan, #
read_sites_and_ports: Void -> Void
}
),
popup_info4c: Null_Or( Void -> { requested_popup_site: g2d::Box, #
popup_plan: gt::Guiplan, #
read_sites_and_ports: Void -> Void
}
)
)
: { guiplan: gt::Guiplan,
# Here we return globals which wind up containing the window sites
# assigned to our various widgets. Normal application code never
# needs to know this, but our test code needs this information in
# order to synthesize fake mouseclicks etc on the buttons.
#
scrollport_scroller: Ref( Null_Or( gt::Scroller ) ),
scroll_state: Ref( g2d::Point ),
widget_sites: { site1a: Ref (Null_Or((Id,g2d::Box))), # Row one, button one.
site2a: Ref (Null_Or((Id,g2d::Box))), # Row one, button two.
site3a: Ref (Null_Or((Id,g2d::Box))), # Row one, button three.
site4a: Ref (Null_Or((Id,g2d::Box))), # Row one, button four.
#
site1b: Ref (Null_Or((Id,g2d::Box))), # Row two, button one.
site2b: Ref (Null_Or((Id,g2d::Box))), # Row two, button two.
site3b: Ref (Null_Or((Id,g2d::Box))), # Row two, button three.
site4b: Ref (Null_Or((Id,g2d::Box))), # Row two, button four.
#
site1c: Ref (Null_Or((Id,g2d::Box))), # Row three, button one.
site2c: Ref (Null_Or((Id,g2d::Box))), # Row three, button two.
site3c: Ref (Null_Or((Id,g2d::Box))), # Row three, button three.
site4c: Ref (Null_Or((Id,g2d::Box))) # Row three, button four.
},
read_back_sites_and_ports_of_guiplan_widgets: Void -> Void # Fills in values of widget_sites
}
=
{
scrollport_scroller = REF (NULL: Null_Or(gt::Scroller)); # This global tracks the scrollport scroller which will be handed to use by guiboss-imp at GUI startup -- see SCROLLABLE_VIEW below in guiplan.
scroll_state = REF { row => 0, col => 0 }; # Not currently in use. This global tracks where the middle roll is current scrolled to. We only need this when doing autoscrolling in conjunction with autoscroll_distance above.
stipulate
site1a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row one, first button, site notification mailqueue.
site2a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row one, second button, site notification mailqueue.
site3a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row one, third button, site notification mailqueue.
site4a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row one, fourth button, site notification mailqueue.
#
site1b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row two, first button, site notification mailqueue.
site2b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row two, second button, site notification mailqueue.
site3b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row two, third button, site notification mailqueue.
site4b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row two, fourth button, site notification mailqueue.
#
site1c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row three, first button, site notification mailqueue.
site2c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row three, second button, site notification mailqueue.
site3c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row three, third button, site notification mailqueue.
site4c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row three, fourth button, site notification mailqueue.
port1a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or(ab::App_To_Arrowbutton) ); # Row one, first button, port notification mailqueue.
port2a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or(ab::App_To_Arrowbutton) ); # Row one, seond button, port notification mailqueue.
port3a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or(ab::App_To_Arrowbutton) ); # Row one, third button, port notification mailqueue.
port4a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or(ab::App_To_Arrowbutton) ); # Row one, fourth button, port notification mailqueue.
#
port1b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or(ab::App_To_Arrowbutton) ); # Row two, first button, port notification mailqueue.
port2b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or(ab::App_To_Arrowbutton) ); # Row two, second button, port notification mailqueue.
port3b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or(ab::App_To_Arrowbutton) ); # Row two, third button, port notification mailqueue.
port4b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or(ab::App_To_Arrowbutton) ); # Row two, fourth button, port notification mailqueue.
#
port1c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or(ab::App_To_Arrowbutton) ); # Row three, first button, port notification mailqueue.
port2c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or(ab::App_To_Arrowbutton) ); # Row three, second button, port notification mailqueue.
port3c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or(ab::App_To_Arrowbutton) ); # Row three, third button, port notification mailqueue.
port4c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or(ab::App_To_Arrowbutton) ); # Row three, fourth button, port notification mailqueue.
herein
# These globals hold the values read from the above
# mailops by the later do_one_mailop() calls.
# They hold the sites (window locations) assigned to
# our twelve pushbuttons. (We need this information
# to generate fake mouseclicks on them for test
# purposes. A normal GUI app wouldn't do this.)
#
site1a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button one.
site2a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button two.
site3a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button three.
site4a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button four.
#
site1b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button one.
site2b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button two.
site3b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button three.
site4b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button four.
#
site1c = REF (NULL: Null_Or((Id,g2d::Box))); # Row three, button one.
site2c = REF (NULL: Null_Or((Id,g2d::Box))); # Row three, button two.
site3c = REF (NULL: Null_Or((Id,g2d::Box))); # Row three, button three.
site4c = REF (NULL: Null_Or((Id,g2d::Box))); # Row three, button four.
port1a = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row one, button one.
port2a = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row one, button two.
port3a = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row one, button three.
port4a = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row one, button four.
# #
port1b = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row two, button one.
port2b = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row two, button two.
port3b = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row two, button three.
port4b = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row two, button four.
# #
port1c = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row three, button one.
port2c = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row three, button two.
port3c = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row three, button three.
port4c = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row three, button four.
# These are the site-watcher callbacks we pass to the
# guiboss layer to find out where our buttons are on
# the window:
#
fun sitewatcher1a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1a', site); # Row one, first button, site notification callback.
fun sitewatcher2a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2a', site); # Row one, second button, site notification callback.
fun sitewatcher3a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site3a', site); # Row one, third button, site notification callback.
fun sitewatcher4a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site4a', site); # Row one, fourth button, site notification callback.
# #
fun sitewatcher1b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1b', site); # Row two, first button, site notification callback.
fun sitewatcher2b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2b', site); # Row two, second button, site notification callback.
fun sitewatcher3b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site3b', site); # Row two, third button, site notification callback.
fun sitewatcher4b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site4b', site); # Row two, fourth button, site notification callback.
# #
fun sitewatcher1c (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1c', site); # Row three, first button, site notification callback.
fun sitewatcher2c (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2c', site); # Row three, second button, site notification callback.
fun sitewatcher3c (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site3c', site); # Row three, third button, site notification callback.
fun sitewatcher4c (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site4c', site); # Row three, fourth button, site notification callback.
fun portwatcher1a (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port1a', port); # Row one, first button, port notification callback.
fun portwatcher2a (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port2a', port); # Row one, second button, port notification callback.
fun portwatcher3a (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port3a', port); # Row one, third button, port notification callback.
fun portwatcher4a (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port4a', port); # Row one, fourth button, port notification callback.
# #
fun portwatcher1b (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port1b', port); # Row two, first button, port notification callback.
fun portwatcher2b (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port2b', port); # Row two, second button, port notification callback.
fun portwatcher3b (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port3b', port); # Row two, third button, port notification callback.
fun portwatcher4b (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port4b', port); # Row two, fourth button, port notification callback.
# #
fun portwatcher1c (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port1c', port); # Row three, first button, port notification callback.
fun portwatcher2c (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port2c', port); # Row three, second button, port notification callback.
fun portwatcher3c (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port3c', port); # Row three, third button, port notification callback.
fun portwatcher4c (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port4c', port); # Row three, fourth button, port notification callback.
fun read_back_sites_and_ports_of_guiplan_widgets () # Fill in the above globals via blocking reads.
= # We use timeouts (only) to recover gracefully if things are
{ # somehow so broken that guiboss-imp never calls our callbacks.
# The order shouldn't matter; here we go left-to-right top-to-bottom:
# XXX SUCKO FIXME all of these 'take' operations really should be done
# in a microthread that loops, rather than just once here, otherwise
# dynamic re-layout ops will not result in our 'site*' values getting
# properly updated here. (This logic predates dynamic re-layouts.)
do_one_mailop [ take_from_mailqueue' site1a' ==> {. site1a := #site; assert(TRUE); }, # Row one, button one.
timeout_in' 1.0 ==> {. printf "no site1a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2a' ==> {. site2a := #site; assert(TRUE); }, # Row one, button two.
timeout_in' 1.0 ==> {. printf "no site2a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site3a' ==> {. site3a := #site; assert(TRUE); }, # Row one, button three.
timeout_in' 1.0 ==> {. printf "no site3a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site4a' ==> {. site4a := #site; assert(TRUE); }, # Row one, button four.
timeout_in' 1.0 ==> {. printf "no site4a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1b' ==> {. site1b := #site; assert(TRUE); }, # Row two, button one.
timeout_in' 1.0 ==> {. printf "no site1b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2b' ==> {. site2b := #site; assert(TRUE); }, # Row two, button two.
timeout_in' 1.0 ==> {. printf "no site2bin 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site3b' ==> {. site3b := #site; assert(TRUE); }, # Row two, button three.
timeout_in' 1.0 ==> {. printf "no site3b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site4b' ==> {. site4b := #site; assert(TRUE); }, # Row two, button four.
timeout_in' 1.0 ==> {. printf "no site4b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1c' ==> {. site1c := #site; assert(TRUE); }, # Row three, button one.
timeout_in' 1.0 ==> {. printf "no site1c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2c' ==> {. site2c := #site; assert(TRUE); }, # Row three, button two.
timeout_in' 1.0 ==> {. printf "no site2c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site3c' ==> {. site3c := #site; assert(TRUE); }, # Row three, button three.
timeout_in' 1.0 ==> {. printf "no site3c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site4c' ==> {. site4c := #site; assert(TRUE); }, # Row three, button four.
timeout_in' 1.0 ==> {. printf "no site4c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port1a' ==> {. port1a := #port; assert(TRUE); }, # Row one, button one.
timeout_in' 1.0 ==> {. printf "no port1a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port2a' ==> {. port2a := #port; assert(TRUE); }, # Row one, button two.
timeout_in' 1.0 ==> {. printf "no port2a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port3a' ==> {. port3a := #port; assert(TRUE); }, # Row one, button three.
timeout_in' 1.0 ==> {. printf "no port3a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port4a' ==> {. port4a := #port; assert(TRUE); }, # Row one, button four.
timeout_in' 1.0 ==> {. printf "no port4a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port1b' ==> {. port1b := #port; assert(TRUE); }, # Row two, button one.
timeout_in' 1.0 ==> {. printf "no port1b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port2b' ==> {. port2b := #port; assert(TRUE); }, # Row two, button two.
timeout_in' 1.0 ==> {. printf "no port2b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port3b' ==> {. port3b := #port; assert(TRUE); }, # Row two, button three.
timeout_in' 1.0 ==> {. printf "no port3b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port4b' ==> {. port4b := #port; assert(TRUE); }, # Row two, button four.
timeout_in' 1.0 ==> {. printf "no port4b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port1c' ==> {. port1c := #port; assert(TRUE); }, # Row three, button one.
timeout_in' 1.0 ==> {. printf "no port1c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port2c' ==> {. port2c := #port; assert(TRUE); }, # Row three, button two.
timeout_in' 1.0 ==> {. printf "no port2c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port3c' ==> {. port3c := #port; assert(TRUE); }, # Row three, button three.
timeout_in' 1.0 ==> {. printf "no port3c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port4c' ==> {. port4c := #port; assert(TRUE); }, # Row three, button four.
timeout_in' 1.0 ==> {. printf "no port4c in 1 sec!\n"; assert(FALSE); }
];
};
end; # stipulate
# fun mouse_drag_fn # This mouse-drag callback fn is used by all twelve buttons.
# {
# id: Id, # Unique id.
# doc: String,
# event_point: g2d::Point,
# start_point: g2d::Point,
# last_point: g2d::Point,
# widget_layout_hint: gt::Widget_Layout_Hint,
# site: g2d::Box, # Widget's assigned area in window coordinates.
# phase: gt::Drag_Phase,
# button: evt::Mousebutton,
# modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
# mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
# widget_to_guiboss: gt::Widget_To_Guiboss,
# theme: wt::Widget_Theme,
# do: (Void -> Void) -> Void,
# to: Replyqueue # Used to call 'pass_*' methods in other imps.
# }
# =
# if (phase == gt::DRAG) # Ignore the OPEN and DONE events because OPEN won't have a good last_point and
# # # DONE's event_point may be dubious, e.g. if drag ended outside of drag widget.
# motion = event_point - last_point;
# #
# scroll_state := *scroll_state + motion;
#
# case *scrollport_scroller
# #
# NULL => ();
# THE s => s.set_scrollport_upperleft *scroll_state;
# esac;
# fi;
fun arrowbutton_mouse_drag_fn #
#
(port: Ref( Null_Or( ab::App_To_Arrowbutton ))) # Curried.
#
( ab::MOUSE_DRAG_FN_ARG
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
widget_layout_hint: gt::Widget_Layout_Hint,
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Widget's assigned area in window coordinates.
phase: gt::Drag_Phase,
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue, # Used to call 'pass_*' methods in other imps.
#
default_mouse_drag_fn: ab::Mouse_Drag_Fn,
#
button_state: Bool, # Is the button ON or OFF?
button_direction: Ref(ab::d::Button_Direction), # Which way does the arrow on the button point?
button_type: ab::t::Button_Type, # Is the button push-on-push-off or momentary-contact?
button_relief: Ref(wt::Relief), # Is the button outline a slope, a ridge, or a flat band?
#
initial_state: Bool, # Original state of button.
note_state: Bool -> Void, # Change state of button. This takes care of notifying our state-watchers.
needs_redraw_gadget_request:Void -> Void # Notify guiboss-imp that this button needs to be redrawn (i.e., sent a redraw_gadget_request()).
}
)
=
if (mousebuttons_state == evt::only_mouse_button_1_was_down
and modifier_keys_state == evt::no_modifier_keys_were_down)
#
# Handle drag stuff:
#
if (phase == gt::DRAG) # Ignore the OPEN and DONE events because OPEN won't have a good last_point and
# # DONE's event_point may be dubious, e.g. if drag ended outside of drag widget.
motion = event_point - last_point;
#
scroll_state := *scroll_state + motion;
case *scrollport_scroller
#
NULL => ();
THE s => s.set_scrollport_upperleft *scroll_state;
esac;
fi;
if (phase == gt::DONE)
#
case *port
#
NULL =>
{
();
};
THE app_to_arrowbutton
=>
{
relief = app_to_arrowbutton.get_button_relief ();
old_relief = relief;
relief = next_relief relief;
nb {. sprintf "make_three_row_guiplan.arrowbutton_mouse_drag_fn: relief was %s, now %s" (relief_to_string old_relief) (relief_to_string relief); };
app_to_arrowbutton.set_state_to FALSE; # Widget appearance depends on both 'state' and 'relief' settings; keep state FALSE for simplicity.
app_to_arrowbutton.set_button_relief_to relief;
};
esac;
fi;
fi;
stipulate
client_to_guiwindow_ref_1a = REF (NULL: Null_Or( gt::Client_To_Guiwindow ) ); # This is NULL when our popup_plan sub-gui is not running; when popup_plan gui is running it contains (THE client_to_guiwindow), which interface contains the call to shut down the popup gui.
client_to_guiwindow_ref_4a = REF (NULL: Null_Or( gt::Client_To_Guiwindow ) ); # This is NULL when our popup_plan sub-gui is not running; when popup_plan gui is running it contains (THE client_to_guiwindow), which interface contains the call to shut down the popup gui.
client_to_guiwindow_ref_1c = REF (NULL: Null_Or( gt::Client_To_Guiwindow ) ); # This is NULL when our popup_plan sub-gui is not running; when popup_plan gui is running it contains (THE client_to_guiwindow), which interface contains the call to shut down the popup gui.
client_to_guiwindow_ref_2c = REF (NULL: Null_Or( gt::Client_To_Guiwindow ) ); # This is NULL when our popup_plan sub-gui is not running; when popup_plan gui is running it contains (THE client_to_guiwindow), which interface contains the call to shut down the popup gui.
client_to_guiwindow_ref_3c = REF (NULL: Null_Or( gt::Client_To_Guiwindow ) ); # This is NULL when our popup_plan sub-gui is not running; when popup_plan gui is running it contains (THE client_to_guiwindow), which interface contains the call to shut down the popup gui.
client_to_guiwindow_ref_4c = REF (NULL: Null_Or( gt::Client_To_Guiwindow ) ); # This is NULL when our popup_plan sub-gui is not running; when popup_plan gui is running it contains (THE client_to_guiwindow), which interface contains the call to shut down the popup gui.
herein
fun mouse_drag_and_popup_fn_1a # This mouse-drag callback fn is used by only row-1, button-4 on guiplan gui, which button pops up a popup gui based on popup_plan.
(
ab::MOUSE_DRAG_FN_ARG
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
widget_layout_hint: gt::Widget_Layout_Hint,
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Widget's assigned area in window coordinates.
phase: gt::Drag_Phase,
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue, # Used to call 'pass_*' methods in other imps.
#
default_mouse_drag_fn: ab::Mouse_Drag_Fn,
#
button_state: Bool, # Is the button ON or OFF?
button_direction: Ref(ab::d::Button_Direction), # Which way does the arrow on the button point?
button_type: ab::t::Button_Type, # Is the button push-on-push-off or momentary-contact?
button_relief: Ref(wt::Relief), # Is the button outline a slope, a ridge, or a flat band?
#
initial_state: Bool, # Original state of button.
note_state: Bool -> Void, # Change state of button. This takes care of notifying our state-watchers.
needs_redraw_gadget_request: Void -> Void # Notify guiboss-imp that this button needs to be redrawn (i.e., sent a redraw_gadget_request()).
}
)
=
case phase
#
gt::DONE => (); # Ignore the DONE event.
gt::OPEN
=>
if (button == evt::button1)
#
case *client_to_guiwindow_ref_1a
#
THE client_to_guiwindow # popup_plan is running, so we'll interpret the mouse downclick as a request to kill it.
=>
{
client_to_guiwindow.kill_gui (); # Tell guiboss_imp to shut down the popup_plan gui.
#
client_to_guiwindow_ref_1a := NULL; # Trust that guiboss_imp did so and record the popup_plan as being dead.
};
NULL => # popup_plan is not currently running, so we'll interpret the mouse downclick as a request try starting it.
case popup_info3
#
NULL => (); # This gui doesn't pop up a sub-gui.
THE popup_info_fn
=>
{
(popup_info_fn ())
->
{ requested_popup_site: g2d::Box, # For popup_plan this was: { row => 200, col => 200, wide => 1200, high => 900 };
popup_plan: gt::Guiplan, #
read_sites_and_ports
};
(widget_to_guiboss.g.make_popup (requested_popup_site, popup_plan))
->
(actual_site, client_to_guiwindow);
client_to_guiwindow_ref_1a := (THE client_to_guiwindow);
read_sites_and_ports ();
};
esac;
esac;
fi;
gt::DRAG # For drag purposes (sliding the scrollport contents) we ignore the OPEN
=> # and DONE events because OPEN won't have a good last_point and DONE's
if (mousebuttons_state == evt::only_mouse_button_1_was_down # event_point may be dubious, e.g. if drag ended outside of drag widget.
and modifier_keys_state == evt::no_modifier_keys_were_down)
#
motion = event_point - last_point;
#
scroll_state := *scroll_state + motion;
case *scrollport_scroller
#
NULL => ();
THE s => s.set_scrollport_upperleft *scroll_state;
esac;
fi;
esac;
fun mouse_drag_and_popup_fn_4a # This mouse-drag callback fn is used by only row-1, button-4 on guiplan gui, which button pops up a popup gui based on popup_plan.
(
ab::MOUSE_DRAG_FN_ARG
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
widget_layout_hint: gt::Widget_Layout_Hint,
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Widget's assigned area in window coordinates.
phase: gt::Drag_Phase,
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue, # Used to call 'pass_*' methods in other imps.
#
default_mouse_drag_fn: ab::Mouse_Drag_Fn,
#
button_state: Bool, # Is the button ON or OFF?
button_direction: Ref(ab::d::Button_Direction), # Which way does the arrow on the button point?
button_type: ab::t::Button_Type, # Is the button push-on-push-off or momentary-contact?
button_relief: Ref(wt::Relief), # Is the button outline a slope, a ridge, or a flat band?
#
initial_state: Bool, # Original state of button.
note_state: Bool -> Void, # Change state of button. This takes care of notifying our state-watchers.
needs_redraw_gadget_request: Void -> Void # Notify guiboss-imp that this button needs to be redrawn (i.e., sent a redraw_gadget_request()).
}
)
=
case phase
#
gt::DONE => (); # Ignore the DONE event.
gt::OPEN
=>
if (button == evt::button1)
#
case *client_to_guiwindow_ref_4a
#
THE client_to_guiwindow # popup_plan is running, so we'll interpret the mouse downclick as a request to kill it.
=>
{
client_to_guiwindow.kill_gui (); # Tell guiboss_imp to shut down the popup_plan gui.
#
client_to_guiwindow_ref_4a := NULL; # Trust that guiboss_imp did so and record the popup_plan as being dead.
};
NULL => # popup_plan is not currently running, so we'll interpret the mouse downclick as a request try starting it.
case popup_info
#
NULL => (); # This gui doesn't pop up a sub-gui.
THE popup_info_fn
=>
{ (popup_info_fn ())
->
{ requested_popup_site: g2d::Box, # For popup_plan this was: { row => 200, col => 200, wide => 1200, high => 900 };
popup_plan: gt::Guiplan, #
read_sites_and_ports
};
(widget_to_guiboss.g.make_popup (requested_popup_site, popup_plan))
->
(actual_site, client_to_guiwindow);
client_to_guiwindow_ref_4a := (THE client_to_guiwindow);
read_sites_and_ports ();
};
esac;
esac;
fi;
gt::DRAG # For drag purposes (sliding the scrollport contents) we ignore the OPEN
=> # and DONE events because OPEN won't have a good last_point and DONE's
if (mousebuttons_state == evt::only_mouse_button_1_was_down # event_point may be dubious, e.g. if drag ended outside of drag widget.
and modifier_keys_state == evt::no_modifier_keys_were_down)
#
motion = event_point - last_point;
#
scroll_state := *scroll_state + motion;
case *scrollport_scroller
#
NULL => ();
THE s => s.set_scrollport_upperleft *scroll_state;
esac;
fi;
esac;
fun mouse_drag_and_popup_fn_1c # This mouse-drag callback fn is used by only row-3, button-1 on guiplan gui, which button pops up a popup gui based on hsliders_plan.
(
ab::MOUSE_DRAG_FN_ARG
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
widget_layout_hint: gt::Widget_Layout_Hint,
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Widget's assigned area in window coordinates.
phase: gt::Drag_Phase,
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue, # Used to call 'pass_*' methods in other imps.
#
default_mouse_drag_fn: ab::Mouse_Drag_Fn,
#
button_state: Bool, # Is the button ON or OFF?
button_direction: Ref(ab::d::Button_Direction), # Which way does the arrow on the button point?
button_type: ab::t::Button_Type, # Is the button push-on-push-off or momentary-contact?
button_relief: Ref(wt::Relief), # Is the button outline a slope, a ridge, or a flat band?
#
initial_state: Bool, # Original state of button.
note_state: Bool -> Void, # Change state of button. This takes care of notifying our state-watchers.
needs_redraw_gadget_request: Void -> Void # Notify guiboss-imp that this button needs to be redrawn (i.e., sent a redraw_gadget_request()).
}
)
=
case phase
#
gt::DONE => (); # Ignore the DONE event.
gt::OPEN
=>
if (button == evt::button1)
#
case *client_to_guiwindow_ref_1c
#
THE client_to_guiwindow # hsliders_plan is running, so we'll interpret the mouse downclick as a request to kill it.
=>
{
client_to_guiwindow.kill_gui (); # Tell guiboss_imp to shut down the popup_plan gui.
#
client_to_guiwindow_ref_1c := NULL; # Trust that guiboss_imp did so and record the popup_plan as being dead.
};
NULL => # hsliders_plan is not currently running, so we'll interpret the mouse downclick as a request try starting it.
case popup_info1c
#
NULL => (); # This gui doesn't pop up a sub-gui.
THE popup_info_fn
=>
{
(popup_info_fn ())
->
{ requested_popup_site: g2d::Box, # For popup_plan this was: { row => 200, col => 200, wide => 1200, high => 900 };
popup_plan: gt::Guiplan, #
read_sites_and_ports
};
(widget_to_guiboss.g.make_popup (requested_popup_site, popup_plan))
->
(actual_site, client_to_guiwindow);
client_to_guiwindow_ref_1c := (THE client_to_guiwindow);
read_sites_and_ports ();
};
esac;
esac;
fi;
gt::DRAG # For drag purposes (sliding the scrollport contents) we ignore the OPEN
=> # and DONE events because OPEN won't have a good last_point and DONE's
if (mousebuttons_state == evt::only_mouse_button_1_was_down # event_point may be dubious, e.g. if drag ended outside of drag widget.
and modifier_keys_state == evt::no_modifier_keys_were_down)
#
motion = event_point - last_point;
#
scroll_state := *scroll_state + motion;
case *scrollport_scroller
#
NULL => ();
THE s => s.set_scrollport_upperleft *scroll_state;
esac;
fi;
esac;
fun mouse_drag_and_popup_fn_2c # This mouse-drag callback fn is used by only row-3, button-2 on guiplan gui, which button pops up a popup gui based on hsliders_plan.
(
ab::MOUSE_DRAG_FN_ARG
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
widget_layout_hint: gt::Widget_Layout_Hint,
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Widget's assigned area in window coordinates.
phase: gt::Drag_Phase,
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue, # Used to call 'pass_*' methods in other imps.
#
default_mouse_drag_fn: ab::Mouse_Drag_Fn,
#
button_state: Bool, # Is the button ON or OFF?
button_direction: Ref(ab::d::Button_Direction), # Which way does the arrow on the button point?
button_type: ab::t::Button_Type, # Is the button push-on-push-off or momentary-contact?
button_relief: Ref(wt::Relief), # Is the button outline a slope, a ridge, or a flat band?
#
initial_state: Bool, # Original state of button.
note_state: Bool -> Void, # Change state of button. This takes care of notifying our state-watchers.
needs_redraw_gadget_request: Void -> Void # Notify guiboss-imp that this button needs to be redrawn (i.e., sent a redraw_gadget_request()).
}
)
=
case phase
#
gt::DONE => (); # Ignore the DONE event.
gt::OPEN
=>
if (button == evt::button1)
#
case *client_to_guiwindow_ref_2c
#
THE client_to_guiwindow # hsliders_plan is running, so we'll interpret the mouse downclick as a request to kill it.
=>
{
client_to_guiwindow.kill_gui (); # Tell guiboss_imp to shut down the popup_plan gui.
#
client_to_guiwindow_ref_2c := NULL; # Trust that guiboss_imp did so and record the popup_plan as being dead.
};
NULL => # hsliders_plan is not currently running, so we'll interpret the mouse downclick as a request try starting it.
case popup_info2c
#
NULL => (); # This gui doesn't pop up a sub-gui.
THE popup_info_fn
=>
{
(popup_info_fn ())
->
{ requested_popup_site: g2d::Box, # For popup_plan this was: { row => 200, col => 200, wide => 1200, high => 900 };
popup_plan: gt::Guiplan, #
read_sites_and_ports
};
(widget_to_guiboss.g.make_popup (requested_popup_site, popup_plan))
->
(actual_site, client_to_guiwindow);
client_to_guiwindow_ref_2c := (THE client_to_guiwindow);
read_sites_and_ports ();
};
esac;
esac;
fi;
gt::DRAG # For drag purposes (sliding the scrollport contents) we ignore the OPEN
=> # and DONE events because OPEN won't have a good last_point and DONE's
if (mousebuttons_state == evt::only_mouse_button_1_was_down # event_point may be dubious, e.g. if drag ended outside of drag widget.
and modifier_keys_state == evt::no_modifier_keys_were_down)
#
motion = event_point - last_point;
#
scroll_state := *scroll_state + motion;
case *scrollport_scroller
#
NULL => ();
THE s => s.set_scrollport_upperleft *scroll_state;
esac;
fi;
esac;
fun mouse_drag_and_popup_fn_3c # This mouse-drag callback fn is used by only row-3, button-3 on guiplan gui, which button pops up a popup gui based on hsliders_plan.
(
ab::MOUSE_DRAG_FN_ARG
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
widget_layout_hint: gt::Widget_Layout_Hint,
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Widget's assigned area in window coordinates.
phase: gt::Drag_Phase,
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue, # Used to call 'pass_*' methods in other imps.
#
default_mouse_drag_fn: ab::Mouse_Drag_Fn,
#
button_state: Bool, # Is the button ON or OFF?
button_direction: Ref(ab::d::Button_Direction), # Which way does the arrow on the button point?
button_type: ab::t::Button_Type, # Is the button push-on-push-off or momentary-contact?
button_relief: Ref(wt::Relief), # Is the button outline a slope, a ridge, or a flat band?
#
initial_state: Bool, # Original state of button.
note_state: Bool -> Void, # Change state of button. This takes care of notifying our state-watchers.
needs_redraw_gadget_request: Void -> Void # Notify guiboss-imp that this button needs to be redrawn (i.e., sent a redraw_gadget_request()).
}
)
=
case phase
#
gt::DONE => (); # Ignore the DONE event.
gt::OPEN
=>
if (button == evt::button1)
#
case *client_to_guiwindow_ref_3c
#
THE client_to_guiwindow # hsliders_plan is running, so we'll interpret the mouse downclick as a request to kill it.
=>
{
client_to_guiwindow.kill_gui (); # Tell guiboss_imp to shut down the popup_plan gui.
#
client_to_guiwindow_ref_3c := NULL; # Trust that guiboss_imp did so and record the popup_plan as being dead.
};
NULL => # hsliders_plan is not currently running, so we'll interpret the mouse downclick as a request try starting it.
case popup_info3c
#
NULL => (); # This gui doesn't pop up a sub-gui.
THE popup_info_fn
=>
{
(popup_info_fn ())
->
{ requested_popup_site: g2d::Box, # For popup_plan this was: { row => 200, col => 200, wide => 1200, high => 900 };
popup_plan: gt::Guiplan, #
read_sites_and_ports
};
(widget_to_guiboss.g.make_popup (requested_popup_site, popup_plan))
->
(actual_site, client_to_guiwindow);
client_to_guiwindow_ref_3c := (THE client_to_guiwindow);
read_sites_and_ports ();
};
esac;
esac;
fi;
gt::DRAG # For drag purposes (sliding the scrollport contents) we ignore the OPEN
=> # and DONE events because OPEN won't have a good last_point and DONE's
if (mousebuttons_state == evt::only_mouse_button_1_was_down # event_point may be dubious, e.g. if drag ended outside of drag widget.
and modifier_keys_state == evt::no_modifier_keys_were_down)
#
motion = event_point - last_point;
#
scroll_state := *scroll_state + motion;
case *scrollport_scroller
#
NULL => ();
THE s => s.set_scrollport_upperleft *scroll_state;
esac;
fi;
esac;
fun mouse_drag_and_popup_fn_4c # This mouse-drag callback fn is used by only row-3, button-4 on guiplan gui, which button pops up a popup gui based on hsliders_plan.
(
ab::MOUSE_DRAG_FN_ARG
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
widget_layout_hint: gt::Widget_Layout_Hint,
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Widget's assigned area in window coordinates.
phase: gt::Drag_Phase,
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue, # Used to call 'pass_*' methods in other imps.
#
default_mouse_drag_fn: ab::Mouse_Drag_Fn,
#
button_state: Bool, # Is the button ON or OFF?
button_direction: Ref(ab::d::Button_Direction), # Which way does the arrow on the button point?
button_type: ab::t::Button_Type, # Is the button push-on-push-off or momentary-contact?
button_relief: Ref(wt::Relief), # Is the button outline a slope, a ridge, or a flat band?
#
initial_state: Bool, # Original state of button.
note_state: Bool -> Void, # Change state of button. This takes care of notifying our state-watchers.
needs_redraw_gadget_request: Void -> Void # Notify guiboss-imp that this button needs to be redrawn (i.e., sent a redraw_gadget_request()).
}
)
=
case phase
#
gt::DONE => (); # Ignore the DONE event.
gt::OPEN
=>
if (button == evt::button1)
#
case *client_to_guiwindow_ref_4c
#
THE client_to_guiwindow # hsliders_plan is running, so we'll interpret the mouse downclick as a request to kill it.
=>
{
client_to_guiwindow.kill_gui (); # Tell guiboss_imp to shut down the popup_plan gui.
#
client_to_guiwindow_ref_4c := NULL; # Trust that guiboss_imp did so and record the popup_plan as being dead.
};
NULL => # hsliders_plan is not currently running, so we'll interpret the mouse downclick as a request try starting it.
case popup_info4c
#
NULL => (); # This gui doesn't pop up a sub-gui.
THE popup_info_fn
=>
{
(popup_info_fn ())
->
{ requested_popup_site: g2d::Box, # For popup_plan this was: { row => 200, col => 200, wide => 1200, high => 900 };
popup_plan: gt::Guiplan, #
read_sites_and_ports
};
(widget_to_guiboss.g.make_popup (requested_popup_site, popup_plan))
->
(actual_site, client_to_guiwindow);
client_to_guiwindow_ref_4c := (THE client_to_guiwindow);
read_sites_and_ports ();
};
esac;
esac;
fi;
gt::DRAG # For drag purposes (sliding the scrollport contents) we ignore the OPEN
=> # and DONE events because OPEN won't have a good last_point and DONE's
if (mousebuttons_state == evt::only_mouse_button_1_was_down # event_point may be dubious, e.g. if drag ended outside of drag widget.
and modifier_keys_state == evt::no_modifier_keys_were_down)
motion = event_point - last_point;
#
scroll_state := *scroll_state + motion;
case *scrollport_scroller
#
NULL => ();
THE s => s.set_scrollport_upperleft *scroll_state;
esac;
fi;
esac;
end;
font = [ "-*-courier-bold-r-*-*-20-*-*-*-*-*-*-*" ];
label_1c = case popup_info1c NULL => ab::TEXT "xyz"; _ => ab::TEXT "HSLIDERS"; esac;
label_2c = case popup_info2c NULL => ab::TEXT "xyz"; _ => ab::TEXT "VSLIDERS"; esac;
label_3c = case popup_info3c NULL => ab::TEXT "xyz"; _ => ab::TEXT "TEXT ENTRIES"; esac;
label_4c = case popup_info4c NULL => ab::TEXT "xyz"; _ => ab::TEXT "TEXT EDITOR"; esac;
guiplan
=
gt::FRAME
( [ gt::FRAME_WIDGET (popupframe::with []) ],
gt::COL
[
( gt::FRAME
# ( [ gt::FRAME_WIDGET (frame::with [ frm::FRAME_INDENT_HINT { pixels_for_top_of_frame => 50, pixels_for_bottom_of_frame => 5, pixels_for_left_of_frame => 3, pixels_for_right_of_frame => 3 }]) ],
( [ gt::FRAME_WIDGET (frame::with [ frm::FRAME_INDENT_HINT { pixels_for_top_of_frame => 0, pixels_for_bottom_of_frame => 0, pixels_for_left_of_frame => 0, pixels_for_right_of_frame => 0 }]) ],
# ( [],
gt::ROW [
arrowbutton::with [ ab::PORTWATCHER portwatcher1a, ab::LEFT , ab::TEXT "BUTTONS", ab::THICK 20, ab::FONTS font, ab::MARGIN 40, ab::SITEWATCHER sitewatcher1a, ab::MOUSE_DRAG_FN mouse_drag_and_popup_fn_1a ],
arrowbutton::with [ ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher2a, ab::UP , ab::TEXT "xyz", ab::THICK 20, ab::FONTS font, ab::MARGIN 40, ab::SITEWATCHER sitewatcher2a, ab::MOUSE_DRAG_FN (arrowbutton_mouse_drag_fn port2a) ],
arrowbutton::with [ ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher3a, ab::DOWN , ab::TEXT "xyz", ab::THICK 20, ab::FONTS font, ab::MARGIN 40, ab::SITEWATCHER sitewatcher3a, ab::MOUSE_DRAG_FN (arrowbutton_mouse_drag_fn port3a) ],
arrowbutton::with [ ab::PORTWATCHER portwatcher4a, ab::RIGHT, ab::TEXT "SUB", ab::THICK 20, ab::FONTS font, ab::MARGIN 40, ab::SITEWATCHER sitewatcher4a, ab::MOUSE_DRAG_FN mouse_drag_and_popup_fn_4a ]
]
)
),
( gt::SCROLLPORT
{
scroller_callback => (\\ scroller = scrollport_scroller := scroller): gt::Scroller_Callback,
#
pixmap_size => scrollable_view_size,
widget => gt::FRAME
( [],
gt::ROW [
arrowbutton::with [ ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher1b, ab::LEFT , ab::TEXT "xyz", ab::THICK 20, ab::FONTS font, ab::MARGIN 40, ab::SITEWATCHER sitewatcher1b, ab::MOUSE_DRAG_FN (arrowbutton_mouse_drag_fn port1b) ],
arrowbutton::with [ ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher2b, ab::UP , ab::TEXT "xyz", ab::THICK 20, ab::FONTS font, ab::MARGIN 40, ab::SITEWATCHER sitewatcher2b, ab::MOUSE_DRAG_FN (arrowbutton_mouse_drag_fn port2b) ],
arrowbutton::with [ ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher3b, ab::DOWN , ab::TEXT "xyz", ab::THICK 20, ab::FONTS font, ab::MARGIN 40, ab::SITEWATCHER sitewatcher3b, ab::MOUSE_DRAG_FN (arrowbutton_mouse_drag_fn port3b) ],
arrowbutton::with [ ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher4b, ab::RIGHT, ab::TEXT "xyz", ab::THICK 20, ab::FONTS font, ab::MARGIN 40, ab::SITEWATCHER sitewatcher4b, ab::MOUSE_DRAG_FN (arrowbutton_mouse_drag_fn port4b) ]
]
)
}
),
( gt::FRAME
( [],
gt::ROW [
arrowbutton::with [ ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher1c, ab::LEFT , label_1c, ab::THICK 20, ab::FONTS font, ab::MARGIN 40, ab::SITEWATCHER sitewatcher1c, ab::MOUSE_DRAG_FN mouse_drag_and_popup_fn_1c ],
arrowbutton::with [ ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher2c, ab::UP , label_2c, ab::THICK 20, ab::FONTS font, ab::MARGIN 40, ab::SITEWATCHER sitewatcher2c, ab::MOUSE_DRAG_FN mouse_drag_and_popup_fn_2c ],
arrowbutton::with [ ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher3c, ab::DOWN , label_3c, ab::THICK 20, ab::FONTS font, ab::MARGIN 40, ab::SITEWATCHER sitewatcher3c, ab::MOUSE_DRAG_FN mouse_drag_and_popup_fn_3c ],
arrowbutton::with [ ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher4c, ab::RIGHT, label_4c, ab::THICK 20, ab::FONTS font, ab::MARGIN 40, ab::SITEWATCHER sitewatcher4c, ab::MOUSE_DRAG_FN mouse_drag_and_popup_fn_4c ]
]
)
)
]
);
{ guiplan,
scrollport_scroller,
scroll_state,
widget_sites => { site1a, site2a, site3a, site4a,
site1b, site2b, site3b, site4b,
site1c, site2c, site3c, site4c
},
read_back_sites_and_ports_of_guiplan_widgets
};
}; # fun make_three_row_guiplan
fun make_grid_2x2_guiplan ()
#
: { guiplan: gt::Guiplan,
# Here we return globals which wind up containing the window sites
# assigned to our various widgets. Normal application code never
# needs to know this, but our test code needs this information in
# order to synthesize fake mouseclicks etc on the buttons.
#
widget_sites: { site1a: Ref (Null_Or((Id,g2d::Box))), # Row one, button one.
site2a: Ref (Null_Or((Id,g2d::Box))), # Row one, button two.
#
site1b: Ref (Null_Or((Id,g2d::Box))), # Row two, button one.
site2b: Ref (Null_Or((Id,g2d::Box))) # Row two, button two.
},
read_back_sites_and_ports_of_grid_guiplan_widgets: Void -> Void # Fills in values of widget_sites
}
=
{
stipulate
site1a' = make_mailqueue (get_current_microthread()): Mailqueue(Null_Or((Id,g2d::Box))); # Row one, first button, site notification mailqueue.
site2a' = make_mailqueue (get_current_microthread()): Mailqueue(Null_Or((Id,g2d::Box))); # Row one, second button, site notification mailqueue.
# #
site1b' = make_mailqueue (get_current_microthread()): Mailqueue(Null_Or((Id,g2d::Box))); # Row two, first button, site notification mailqueue.
site2b' = make_mailqueue (get_current_microthread()): Mailqueue(Null_Or((Id,g2d::Box))); # Row two, second button, site notification mailqueue.
port1a' = make_mailqueue (get_current_microthread()): Mailqueue(Null_Or(ab::App_To_Arrowbutton)); # Row one, first button, port notification mailqueue.
port2a' = make_mailqueue (get_current_microthread()): Mailqueue(Null_Or(ab::App_To_Arrowbutton)); # Row one, seond button, port notification mailqueue.
#
port1b' = make_mailqueue (get_current_microthread()): Mailqueue(Null_Or(ab::App_To_Arrowbutton)); # Row two, first button, port notification mailqueue.
port2b' = make_mailqueue (get_current_microthread()): Mailqueue(Null_Or(ab::App_To_Arrowbutton)); # Row two, second button, port notification mailqueue.
port1aa' = make_mailqueue (get_current_microthread()): Mailqueue(Null_Or(rb::App_To_Roundbutton)); # Row one, first button, port notification mailqueue.
herein
# These globals hold the values read from the above
# mailops by the later do_one_mailop() calls.
# They hold the sites (window locations) assigned to
# our twelve pushbuttons. (We need this information
# to generate fake mouseclicks on them for test
# purposes. A normal GUI app wouldn't do this.)
#
site1a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button one.
site2a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button two.
# #
site1b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button one.
site2b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button two.
port1a = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row one, button one.
port2a = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row one, button two.
# #
port1b = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row two, button one.
port2b = REF (NULL: Null_Or( ab::App_To_Arrowbutton )); # Row two, button two.
port1aa = REF (NULL: Null_Or( rb::App_To_Roundbutton )); # Row one, button one, alternate version (roundbutton vs arrowbutton).
# These are the site-watcher callbacks we pass to the
# guiboss layer to find out where our buttons are on
# the window:
#
# fun sitewatcher1a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1a', site); # Row one, first button, site notification callback.
# fun sitewatcher2a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2a', site); # Row one, second button, site notification callback.
# # #
# fun sitewatcher1b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1b', site); # Row two, first button, site notification callback.
# fun sitewatcher2b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2b', site); # Row two, second button, site notification callback.
fun sitewatcher1a (site: Null_Or((Id,g2d::Box)))
=
{
put_in_mailqueue (site1a', site); # Row one, first button, site notification callback.
};
fun sitewatcher2a (site: Null_Or((Id,g2d::Box)))
=
{
put_in_mailqueue (site2a', site); # Row one, second button, site notification callback.
};
# #
fun sitewatcher1b (site: Null_Or((Id,g2d::Box)))
=
{
put_in_mailqueue (site1b', site); # Row two, first button, site notification callback.
};
fun sitewatcher2b (site: Null_Or((Id,g2d::Box)))
=
{
put_in_mailqueue (site2b', site); # Row two, second button, site notification callback.
};
fun portwatcher1a (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port1a', port); # Row one, first button, port notification callback.
fun portwatcher2a (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port2a', port); # Row one, second button, port notification callback.
# #
fun portwatcher1b (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port1b', port); # Row two, first button, port notification callback.
fun portwatcher2b (port: Null_Or(ab::App_To_Arrowbutton)) = put_in_mailqueue (port2b', port); # Row two, second button, port notification callback.
fun portwatcher1aa(port: Null_Or(rb::App_To_Roundbutton)) = put_in_mailqueue (port1aa',port); # Row one, first button, port notification callback, alternate version (roundbutton instead of arrowbutton).
fun read_back_sites_and_ports_of_grid_guiplan_widgets () # Fill in the above globals via blocking reads.
= # We use timeouts (only) to recover gracefully if things are
{ # somehow so broken that guiboss-imp never calls our callbacks.
# The order shouldn't matter; here we go left-to-right top-to-bottom:
do_one_mailop [ take_from_mailqueue' site1a' ==> {. site1a := #site; assert(TRUE); }, # Row one, button one.
timeout_in' 1.0 ==> {. printf "no site1a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2a' ==> {. site2a := #site; assert(TRUE); }, # Row one, button two.
timeout_in' 1.0 ==> {. printf "no site2a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1b' ==> {. site1b := #site; assert(TRUE); }, # Row two, button one.
timeout_in' 1.0 ==> {. printf "no site1b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2b' ==> {. site2b := #site; assert(TRUE); }, # Row two, button two.
timeout_in' 1.0 ==> {. printf "no site2b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port1a' ==> {. port1a := #port; assert(TRUE); }, # Row one, button one.
timeout_in' 1.0 ==> {. printf "no port1a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port2a' ==> {. port2a := #port; assert(TRUE); }, # Row one, button two.
timeout_in' 1.0 ==> {. printf "no port2a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port1b' ==> {. port1b := #port; assert(TRUE); }, # Row two, button one.
timeout_in' 1.0 ==> {. printf "no port1b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' port2b' ==> {. port2b := #port; assert(TRUE); }, # Row two, button two.
timeout_in' 1.0 ==> {. printf "no port2b in 1 sec!\n"; assert(FALSE); }
];
};
end;
# fun mouse_drag_fn #
# {
# id: Id, # Unique id.
# doc: String,
# event_point: g2d::Point,
# start_point: g2d::Point,
# last_point: g2d::Point,
# widget_layout_hint: gt::Widget_Layout_Hint,
# frame_indent_hint: gt::Frame_Indent_Hint,
# site: g2d::Box, # Widget's assigned area in window coordinates.
# phase: gt::Drag_Phase,
# button: evt::Mousebutton,
# modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
# mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
# widget_to_guiboss: gt::Widget_To_Guiboss,
# theme: wt::Widget_Theme,
# do: (Void -> Void) -> Void,
# to: Replyqueue # Used to call 'pass_*' methods in other imps.
# }
# =
# if (phase == gt::DRAG) # Ignore the OPEN and DONE events because OPEN won't have a good last_point and
# # # DONE's event_point may be dubious, e.g. if drag ended outside of drag widget.
# motion = event_point - last_point;
# #
# fi;
grid_2x2 = issue_unique_id ();
#
bigarrowbtn = issue_unique_id ();
bigroundbtn = issue_unique_id ();
verticalbtn = issue_unique_id ();
horizontalbtn = issue_unique_id ();
cornerbtn = issue_unique_id ();
fun arrowbutton_mouse_drag_fn #
#
(which: Int) # 1,2,3,4.
(port: Ref( Null_Or( ab::App_To_Arrowbutton ))) # Curried.
#
=
{ big = REF FALSE; # Issue each button its own boolean state value.
#
\\ ( ab::MOUSE_DRAG_FN_ARG
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
widget_layout_hint: gt::Widget_Layout_Hint,
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Widget's assigned area in window coordinates.
phase: gt::Drag_Phase,
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue, # Used to call 'pass_*' methods in other imps.
#
default_mouse_drag_fn: ab::Mouse_Drag_Fn,
#
button_state: Bool, # Is the button ON or OFF?
button_direction: Ref(ab::d::Button_Direction), # Which way does the arrow on the button point?
button_type: ab::t::Button_Type, # Is the button push-on-push-off or momentary-contact?
button_relief: Ref(wt::Relief), # Is the button outline a slope, a ridge, or a flat band?
#
initial_state: Bool, # Original state of button.
note_state: Bool -> Void, # Change state of button. This takes care of notifying our state-watchers.
needs_redraw_gadget_request: Void -> Void # Notify guiboss-imp that this button needs to be redrawn (i.e., sent a redraw_gadget_request()).
}
)
=
# Handle drag stuff:
#
case phase
#
gt::OPEN => if (button == evt::button1
and mousebuttons_state == evt::no_mouse_buttons_were_down
and modifier_keys_state == evt::no_modifier_keys_were_down)
#
if (which == 1)
#
do_while_not {.
#
(widget_to_guiboss.g.get_guipiths ())
->
(gui_version, guipiths);
guipiths = gtj::guipith_map
(
guipiths,
[ gtj::XI_GRID_MAP_FN do_grid
]
)
where
fun do_grid (xi_grid: gt::Xi_Grid)
=
{ xi_grid -> { id: Id, # A grid of widgets.
widgets: List( List( gt::Xi_Widget_Type ) )
};
if (same_id (id, grid_2x2))
#
case xi_grid
#
{ id, widgets => [ [ w1 as gt::XI_WIDGET w1', w2 ], [ w3, w4 ] ] }
=>
{ id, widgets => [ [ w4,
w3
],
[ w2,
gt::XI_GUIPLAN (roundbutton::with [ rb::ID bigroundbtn,
rb::MOMENTARY_CONTACT,
rb::PORTWATCHER portwatcher1aa,
rb::SITEWATCHER sitewatcher1a,
rb::MOUSE_DRAG_FN (roundbutton_mouse_drag_fn 1 port1aa),
rb::PIXELS_HIGH_MIN 0,
rb::PIXELS_WIDE_MIN 0,
rb::PIXELS_HIGH_CUT 1.0,
rb::PIXELS_WIDE_CUT 1.0,
rb::MARGIN 40,
rb::THICK 20
]
)
]
]
};
_ => { log::note_on_stderr {. "widgets grid not 2x2 as expected?! -- arrowbutton_mouse_drag_fn in widget-unit-test.pkg"; };
xi_grid;
};
esac;
else
xi_grid;
fi;
};
end;
widget_to_guiboss.g.install_updated_guipiths # If this returns FALSE we'll repeat.
#
(gui_version, guipiths);
}; # do_while_not
else
big := not *big;
widget_layout_hint
->
{ pixels_high_min,
pixels_wide_min,
pixels_high_cut,
pixels_wide_cut
};
my (pixels_high_min, pixels_wide_min)
=
*big ?? (pixels_high_min + 10, pixels_wide_min + 10)
:: (pixels_high_min - 10, pixels_wide_min - 10);
widget_layout_hint
=
{ pixels_high_min,
pixels_wide_min,
pixels_high_cut,
pixels_wide_cut
};
widget_to_guiboss.note_widget_layout_hint { id, widget_layout_hint };
fi;
();
fi;
gt::DRAG => if (mousebuttons_state == evt::only_mouse_button_1_was_down
and modifier_keys_state == evt::no_modifier_keys_were_down)
#
motion = event_point - last_point;
fi;
gt::DONE => if (mousebuttons_state == evt::only_mouse_button_1_was_down
and modifier_keys_state == evt::no_modifier_keys_were_down)
#
case *port
#
NULL =>
{
();
};
THE app_to_arrowbutton
=>
{
relief = app_to_arrowbutton.get_button_relief ();
old_relief = relief;
relief = next_relief relief;
nb {. sprintf "make_grid_2x2_guiplan.arrowbutton_mouse_drag_fn: relief was %s, now %s" (relief_to_string old_relief) (relief_to_string relief); };
app_to_arrowbutton.set_state_to FALSE; # Widget appearance depends on both 'state' and 'relief' settings; keep state FALSE for simplicity.
app_to_arrowbutton.set_button_relief_to relief;
};
esac;
fi;
esac;
}
also
fun roundbutton_mouse_drag_fn #
#
(which: Int) # 1,2,3,4.
(port: Ref( Null_Or( rb::App_To_Roundbutton ))) # Curried.
#
=
{ big = REF FALSE; # Issue each button its own boolean state value.
#
\\ ( rb::MOUSE_DRAG_FN_ARG
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
widget_layout_hint: gt::Widget_Layout_Hint,
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Widget's assigned area in window coordinates.
phase: gt::Drag_Phase,
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue, # Used to call 'pass_*' methods in other imps.
#
default_mouse_drag_fn: rb::Mouse_Drag_Fn,
#
button_state: Bool, # Is the button ON or OFF?
button_type: rb::t::Button_Type, # Is the button push-on-push-off or momentary-contact?
button_relief: Ref(wt::Relief), # Is the button outline a slope, a ridge, or a flat band?
#
initial_state: Bool, # Original state of button.
note_state: Bool -> Void, # Change state of button. This takes care of notifying our state-watchers.
needs_redraw_gadget_request: Void -> Void # Notify guiboss-imp that this button needs to be redrawn (i.e., sent a redraw_gadget_request()).
}
)
=
# Handle drag stuff:
#
case phase
#
gt::OPEN => if (button == evt::button1
and mousebuttons_state == evt::no_mouse_buttons_were_down
and modifier_keys_state == evt::no_modifier_keys_were_down)
#
if (which == 1)
#
do_while_not {.
#
(widget_to_guiboss.g.get_guipiths ())
->
(gui_version, guipiths);
guipiths = gtj::guipith_map
(
guipiths,
[ gtj::XI_GRID_MAP_FN do_grid
]
)
where
fun do_grid (xi_grid: gt::Xi_Grid)
=
{ xi_grid -> { id: Id, # A grid of widgets.
widgets: List( List( gt::Xi_Widget_Type ) )
};
if (same_id (id, grid_2x2))
#
case xi_grid
#
{ id, widgets => [ [ w1 as gt::XI_WIDGET w1', w2 ], [ w3, w4 ] ] }
=>
{ id, widgets => [ [ gt::XI_GUIPLAN (arrowbutton::with [ ab::ID bigarrowbtn,
ab::MOMENTARY_CONTACT,
ab::PORTWATCHER portwatcher1a,
ab::SITEWATCHER sitewatcher1a,
ab::LEFT,
ab::MOUSE_DRAG_FN (arrowbutton_mouse_drag_fn 1 port1a),
ab::PIXELS_HIGH_MIN 0,
ab::PIXELS_WIDE_MIN 0,
ab::PIXELS_HIGH_CUT 1.0,
ab::PIXELS_WIDE_CUT 1.0,
ab::MARGIN 40,
ab::THICK 20
]
),
w3
],
[ w2,
w1
]
]
};
_ => { log::note_on_stderr {. "widgets grid not 2x2 as expected?! -- roundbutton_mouse_drag_fn in widget-unit-test.pkg"; };
xi_grid;
};
esac;
else
xi_grid;
fi;
};
end;
widget_to_guiboss.g.install_updated_guipiths # If this returns FALSE, we'll loop back and retry.
#
(gui_version, guipiths);
}; # do_while_not
else
big := not *big;
widget_layout_hint
->
{ pixels_high_min,
pixels_wide_min,
pixels_high_cut,
pixels_wide_cut
};
my (pixels_high_min, pixels_wide_min)
=
*big ?? (pixels_high_min + 10, pixels_wide_min + 10)
:: (pixels_high_min - 10, pixels_wide_min - 10);
widget_layout_hint
=
{ pixels_high_min,
pixels_wide_min,
pixels_high_cut,
pixels_wide_cut
};
widget_to_guiboss.note_widget_layout_hint { id, widget_layout_hint };
fi;
();
fi;
gt::DRAG => if (mousebuttons_state == evt::only_mouse_button_1_was_down
and modifier_keys_state == evt::no_modifier_keys_were_down)
#
motion = event_point - last_point;
fi;
gt::DONE => if (mousebuttons_state == evt::only_mouse_button_1_was_down
and modifier_keys_state == evt::no_modifier_keys_were_down)
#
case *port
#
NULL =>
{
();
};
THE app_to_roundbutton
=>
{
relief = app_to_roundbutton.get_button_relief ();
old_relief = relief;
relief = next_relief relief;
nb {. sprintf "make_grid_2x2_guiplan.roundbutton_mouse_drag_fn: relief was %s, now %s" (relief_to_string old_relief) (relief_to_string relief); };
app_to_roundbutton.set_state_to FALSE; # Widget appearance depends on both 'state' and 'relief' settings; keep state FALSE for simplicity.
app_to_roundbutton.set_button_relief_to relief;
};
esac;
fi;
esac;
};
guiplan
=
gt::FRAME
( [ gt::FRAME_WIDGET (gt::MARK (popupframe::with [])) ],
( gt::MARK # These two MARKs serve no purpose beyond exercising MARK support code in src/lib/x-kit/widget/gui/translate-guiplan-to-guipane.pkg, src/lib/x-kit/widget/gui/translate-guipane-to-guipith.pkg and src/lib/x-kit/widget/gui/guiboss-types.pkg (gt::GRID'
( grid_2x2,
[
[ arrowbutton::with [ ab::ID bigarrowbtn, ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher1a, ab::SITEWATCHER sitewatcher1a, ab::LEFT , ab::MOUSE_DRAG_FN (arrowbutton_mouse_drag_fn 1 port1a), ab::PIXELS_HIGH_MIN 0, ab::PIXELS_WIDE_MIN 0, ab::PIXELS_HIGH_CUT 1.0, ab::PIXELS_WIDE_CUT 1.0, ab::MARGIN 40, ab::THICK 20 ],
arrowbutton::with [ ab::ID verticalbtn, ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher2a, ab::SITEWATCHER sitewatcher2a, ab::UP , ab::MOUSE_DRAG_FN (arrowbutton_mouse_drag_fn 2 port2a), ab::PIXELS_HIGH_MIN 0, ab::PIXELS_WIDE_MIN 40, ab::PIXELS_HIGH_CUT 1.0, ab::PIXELS_WIDE_CUT 0.0 ]
],
[ arrowbutton::with [ ab::ID horizontalbtn, ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher1b, ab::SITEWATCHER sitewatcher1b, ab::LEFT , ab::MOUSE_DRAG_FN (arrowbutton_mouse_drag_fn 3 port1b), ab::PIXELS_HIGH_MIN 40, ab::PIXELS_WIDE_MIN 0, ab::PIXELS_HIGH_CUT 0.0, ab::PIXELS_WIDE_CUT 1.0 ],
arrowbutton::with [ ab::ID cornerbtn, ab::MOMENTARY_CONTACT, ab::PORTWATCHER portwatcher2b, ab::SITEWATCHER sitewatcher2b, ab::UP , ab::MOUSE_DRAG_FN (arrowbutton_mouse_drag_fn 4 port2b), ab::PIXELS_HIGH_MIN 40, ab::PIXELS_WIDE_MIN 40, ab::PIXELS_HIGH_CUT 0.0, ab::PIXELS_WIDE_CUT 0.0 ]
]
]
)
)
)
);
{ guiplan,
widget_sites => { site1a, site2a,
site1b, site2b
},
read_back_sites_and_ports_of_grid_guiplan_widgets
};
}; # fun make_grid_2x2_guiplan
fun make_buttons_guiplan ()
#
: { guiplan: gt::Guiplan,
# Here we return globals which wind up containing the window sites
# assigned to our various widgets. Normal application code never
# needs to know this, but our test code needs this information in
# order to synthesize fake mouseclicks etc on the buttons.
#
widget_sites: { site1a: Ref (Null_Or((Id,g2d::Box))), # Row one, button one.
site2a: Ref (Null_Or((Id,g2d::Box))), # Row one, button two.
site3a: Ref (Null_Or((Id,g2d::Box))), # Row one, button three.
site4a: Ref (Null_Or((Id,g2d::Box))), # Row one, button four.
#
site1b: Ref (Null_Or((Id,g2d::Box))), # Row two, button one.
site2b: Ref (Null_Or((Id,g2d::Box))), # Row two, button two.
site3b: Ref (Null_Or((Id,g2d::Box))), # Row two, button three.
site4b: Ref (Null_Or((Id,g2d::Box))), # Row two, button four.
#
site1c: Ref (Null_Or((Id,g2d::Box))), # Row three, button one.
site2c: Ref (Null_Or((Id,g2d::Box))), # Row three, button two.
site3c: Ref (Null_Or((Id,g2d::Box))), # Row three, button three.
site4c: Ref (Null_Or((Id,g2d::Box))), # Row three, button four.
#
site1d: Ref (Null_Or((Id,g2d::Box))), # Row four, button one.
site2d: Ref (Null_Or((Id,g2d::Box))), # Row four, button two.
site3d: Ref (Null_Or((Id,g2d::Box))), # Row four, button three.
site4d: Ref (Null_Or((Id,g2d::Box))) # Row four, button four.
},
read_back_sites_and_ports_of_buttons_guiplan_widgets: Void -> Void # Fills in values of widget_sites
}
=
{
stipulate
site1a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row one, first button, site notification mailqueue.
site2a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row one, second button, site notification mailqueue.
site3a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row one, third button, site notification mailqueue.
site4a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row one, fourth button, site notification mailqueue.
# #
site1b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row two, first button, site notification mailqueue.
site2b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row two, second button, site notification mailqueue.
site3b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row two, third button, site notification mailqueue.
site4b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row two, fourth button, site notification mailqueue.
# #
site1c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row three, first button, site notification mailqueue.
site2c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row three, second button, site notification mailqueue.
site3c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row three, third button, site notification mailqueue.
site4c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row three, fourth button, site notification mailqueue.
# #
site1d' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row four, first button, site notification mailqueue.
site2d' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row four, second button, site notification mailqueue.
site3d' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row four, third button, site notification mailqueue.
site4d' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box))); # Row four, fourth button, site notification mailqueue.
herein
# These globals hold the values read from the above
# mailops by the later do_one_mailop() calls.
# They hold the sites (window locations) assigned to
# our twelve pushbuttons. (We need this information
# to generate fake mouseclicks on them for test
# purposes. A normal GUI app wouldn't do this.)
#
site1a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button one.
site2a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button two.
site3a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button three.
site4a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button four.
# #
site1b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button one.
site2b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button two.
site3b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button three.
site4b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button four.
# #
site1c = REF (NULL: Null_Or((Id,g2d::Box))); # Row three, button one.
site2c = REF (NULL: Null_Or((Id,g2d::Box))); # Row three, button two.
site3c = REF (NULL: Null_Or((Id,g2d::Box))); # Row three, button three.
site4c = REF (NULL: Null_Or((Id,g2d::Box))); # Row three, button four.
# #
site1d = REF (NULL: Null_Or((Id,g2d::Box))); # Row four, button one.
site2d = REF (NULL: Null_Or((Id,g2d::Box))); # Row four, button two.
site3d = REF (NULL: Null_Or((Id,g2d::Box))); # Row four, button three.
site4d = REF (NULL: Null_Or((Id,g2d::Box))); # Row four, button four.
# These are the site-watcher callbacks we pass to the
# guiboss layer to find out where our buttons are on
# the window:
#
fun sitewatcher1a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1a', site); # Row one, first button, site notification callback.
fun sitewatcher2a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2a', site); # Row one, second button, site notification callback.
fun sitewatcher3a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site3a', site); # Row one, third button, site notification callback.
fun sitewatcher4a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site4a', site); # Row one, fourth button, site notification callback.
# #
fun sitewatcher1b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1b', site); # Row two, first button, site notification callback.
fun sitewatcher2b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2b', site); # Row two, second button, site notification callback.
fun sitewatcher3b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site3b', site); # Row two, third button, site notification callback.
fun sitewatcher4b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site4b', site); # Row two, fourth button, site notification callback.
# #
fun sitewatcher1c (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1c', site); # Row three, first button, site notification callback.
fun sitewatcher2c (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2c', site); # Row three, second button, site notification callback.
fun sitewatcher3c (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site3c', site); # Row three, third button, site notification callback.
fun sitewatcher4c (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site4c', site); # Row three, fourth button, site notification callback.
# #
fun sitewatcher1d (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1d', site); # Row four, first button, site notification callback.
fun sitewatcher2d (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2d', site); # Row four, second button, site notification callback.
fun sitewatcher3d (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site3d', site); # Row four, third button, site notification callback.
fun sitewatcher4d (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site4d', site); # Row four, fourth button, site notification callback.
fun read_back_sites_and_ports_of_buttons_guiplan_widgets () # Fill in the above globals via blocking reads.
= # We use timeouts (only) to recover gracefully if things are
{ # somehow so broken that guiboss-imp never calls our callbacks.
# The order shouldn't matter; here we go left-to-right top-to-bottom:
do_one_mailop [ take_from_mailqueue' site1a' ==> {. site1a := #site; assert(TRUE); }, # Row one, button one.
timeout_in' 1.0 ==> {. printf "no site1a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2a' ==> {. site2a := #site; assert(TRUE); }, # Row one, button two.
timeout_in' 1.0 ==> {. printf "no site2a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site3a' ==> {. site3a := #site; assert(TRUE); }, # Row one, button three.
timeout_in' 1.0 ==> {. printf "no site3a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site4a' ==> {. site4a := #site; assert(TRUE); }, # Row one, button four.
timeout_in' 1.0 ==> {. printf "no site4a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1b' ==> {. site1b := #site; assert(TRUE); }, # Row two, button one.
timeout_in' 1.0 ==> {. printf "no site1b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2b' ==> {. site2b := #site; assert(TRUE); }, # Row two, button two.
timeout_in' 1.0 ==> {. printf "no site2b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site3b' ==> {. site3b := #site; assert(TRUE); }, # Row two, button three.
timeout_in' 1.0 ==> {. printf "no site3b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site4b' ==> {. site4b := #site; assert(TRUE); }, # Row two, button four.
timeout_in' 1.0 ==> {. printf "no site4b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1c' ==> {. site1c := #site; assert(TRUE); }, # Row three, button one.
timeout_in' 1.0 ==> {. printf "no site1c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2c' ==> {. site2c := #site; assert(TRUE); }, # Row three, button two.
timeout_in' 1.0 ==> {. printf "no site2c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site3c' ==> {. site3c := #site; assert(TRUE); }, # Row three, button three.
timeout_in' 1.0 ==> {. printf "no site3c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site4c' ==> {. site4c := #site; assert(TRUE); }, # Row three, button four.
timeout_in' 1.0 ==> {. printf "no site4c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1d' ==> {. site1d := #site; assert(TRUE); }, # Row four, button one.
timeout_in' 1.0 ==> {. printf "no site1d in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2d' ==> {. site2d := #site; assert(TRUE); }, # Row four, button two.
timeout_in' 1.0 ==> {. printf "no site2d in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site3d' ==> {. site3d := #site; assert(TRUE); }, # Row four, button three.
timeout_in' 1.0 ==> {. printf "no site3d in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site4d' ==> {. site4d := #site; assert(TRUE); }, # Row four, button four.
timeout_in' 1.0 ==> {. printf "no site4d in 1 sec!\n"; assert(FALSE); }
];
};
end;
on_image
=
mtx::make_rw_matrix ((rows, cols), yellow)
where
rows = 30;
cols = 30;
yellow = r8::rgb8_yellow;
end;
off_image
=
mtx::make_rw_matrix ((rows, cols), green)
where
rows = 30;
cols = 30;
green = r8::rgb8_green;
end;
guiplan
=
gt::FRAME
( [ gt::FRAME_WIDGET (popupframe::with []) ],
( gt::GRID
[
[ arrowbutton::with [ ab::SITEWATCHER sitewatcher1a, ab::LEFT , ab::PIXELS_HIGH_MIN 0, ab::PIXELS_WIDE_MIN 0, ab::PIXELS_HIGH_CUT 1.0, ab::PIXELS_WIDE_CUT 1.0 ],
button::with [ bb::SITEWATCHER sitewatcher2a, bb::PIXELS_HIGH_MIN 0, bb::PIXELS_WIDE_MIN 0, bb::PIXELS_HIGH_CUT 1.0, bb::PIXELS_WIDE_CUT 1.0 ],
checkbox::with [ cb::SITEWATCHER sitewatcher3a, cb::PIXELS_HIGH_MIN 0, cb::PIXELS_WIDE_MIN 0, cb::PIXELS_HIGH_CUT 1.0, cb::PIXELS_WIDE_CUT 1.0 ],
checkbox::with [ cb::SITEWATCHER sitewatcher4a, cb::TEXT "fee", cb::ON_TEXT "FEE", cb::PIXELS_HIGH_MIN 0, cb::PIXELS_WIDE_MIN 0, cb::PIXELS_HIGH_CUT 1.0, cb::PIXELS_WIDE_CUT 1.0 ]
],
[ diamondbutton::with [ db::SITEWATCHER sitewatcher1b, db::TEXT "bff", db::ON_TEXT "BFF", db::PIXELS_HIGH_MIN 0, db::PIXELS_WIDE_MIN 0, db::PIXELS_HIGH_CUT 1.0, db::PIXELS_WIDE_CUT 1.0 ],
roundbutton::with [ rb::SITEWATCHER sitewatcher2b, rb::TEXT "xyz", rb::PIXELS_HIGH_MIN 0, rb::PIXELS_WIDE_MIN 0, rb::PIXELS_HIGH_CUT 1.0, rb::PIXELS_WIDE_CUT 1.0 ],
blank::with [ blk::SITEWATCHER sitewatcher3b, blk::PIXELS_HIGH_MIN 0, blk::PIXELS_WIDE_MIN 0, blk::PIXELS_HIGH_CUT 1.0, blk::PIXELS_WIDE_CUT 1.0 ],
checkbox::with [ cb::SITEWATCHER sitewatcher4b, cb::TEXT "fie", cb::ON_TEXT "FIE", cb::PIXELS_HIGH_MIN 0, cb::PIXELS_WIDE_MIN 0, cb::PIXELS_HIGH_CUT 1.0, cb::PIXELS_WIDE_CUT 1.0 ]
],
[ button::with [ bb::SITEWATCHER sitewatcher1c, bb::ON_IMAGE on_image, bb::OFF_IMAGE off_image, bb::PIXELS_HIGH_MIN 0, bb::PIXELS_WIDE_MIN 0, bb::PIXELS_HIGH_CUT 1.0, bb::PIXELS_WIDE_CUT 1.0 ],
button::with [ bb::SITEWATCHER sitewatcher2c, bb::ON_IMAGE on_image, bb::OFF_IMAGE off_image, bb::ITALIC, bb::ON_TEXT "ON", bb::OFF_TEXT "OFF", bb::PIXELS_HIGH_MIN 0, bb::PIXELS_WIDE_MIN 0, bb::PIXELS_HIGH_CUT 1.0, bb::PIXELS_WIDE_CUT 1.0 ],
button::with [ bb::SITEWATCHER sitewatcher3c, bb::ITALIC, bb::ON_TEXT "ON", bb::OFF_TEXT "OFF", bb::PIXELS_HIGH_MIN 0, bb::PIXELS_WIDE_MIN 0, bb::PIXELS_HIGH_CUT 1.0, bb::PIXELS_WIDE_CUT 1.0 ],
checkbox::with [ cb::SITEWATCHER sitewatcher4c, cb::TEXT "foe", cb::ON_TEXT "FOE", cb::PIXELS_HIGH_MIN 0, cb::PIXELS_WIDE_MIN 0, cb::PIXELS_HIGH_CUT 1.0, cb::PIXELS_WIDE_CUT 1.0 ]
],
[ blank::with [ blk::SITEWATCHER sitewatcher1d, blk::PIXELS_HIGH_MIN 0, blk::PIXELS_WIDE_MIN 0, blk::PIXELS_HIGH_CUT 1.0, blk::PIXELS_WIDE_CUT 1.0 ],
his::with [ his::SITEWATCHER sitewatcher2d, his::PIXELS_HIGH_MIN 0, his::PIXELS_WIDE_MIN 0, his::PIXELS_HIGH_CUT 1.0, his::PIXELS_WIDE_CUT 1.0 ],
blank::with [ blk::SITEWATCHER sitewatcher3d, blk::PIXELS_HIGH_MIN 0, blk::PIXELS_WIDE_MIN 0, blk::PIXELS_HIGH_CUT 1.0, blk::PIXELS_WIDE_CUT 1.0 ],
checkbox::with [ cb::SITEWATCHER sitewatcher4d, cb::TEXT "fum", cb::ON_TEXT "FUM", cb::PIXELS_HIGH_MIN 0, cb::PIXELS_WIDE_MIN 0, cb::PIXELS_HIGH_CUT 1.0, cb::PIXELS_WIDE_CUT 1.0 ]
]
]
)
);
{ guiplan,
widget_sites => { site1a, site2a, site3a, site4a,
site1b, site2b, site3b, site4b,
site1c, site2c, site3c, site4c,
site1d, site2d, site3d, site4d
},
read_back_sites_and_ports_of_buttons_guiplan_widgets
};
}; # fun make_buttons_guiplan
fun make_hsliders_guiplan ()
#
: { guiplan: gt::Guiplan,
# Here we return globals which wind up containing the window sites
# assigned to our various widgets. Normal application code never
# needs to know this, but our test code needs this information in
# order to synthesize fake mouseclicks etc on the buttons.
#
widget_sites: { site1a: Ref (Null_Or((Id,g2d::Box))), # Row one, button one.
site2a: Ref (Null_Or((Id,g2d::Box))), # Row one, button two.
#
site1b: Ref (Null_Or((Id,g2d::Box))), # Row two, button one.
site2b: Ref (Null_Or((Id,g2d::Box))), # Row two, button two.
#
site1c: Ref (Null_Or((Id,g2d::Box))), # Row three, button one.
site2c: Ref (Null_Or((Id,g2d::Box))), # Row three, button two.
#
site1d: Ref (Null_Or((Id,g2d::Box))), # Row four, button one.
site2d: Ref (Null_Or((Id,g2d::Box))), # Row four, button two.
#
site1e: Ref (Null_Or((Id,g2d::Box))), # Row five, button one.
site2e: Ref (Null_Or((Id,g2d::Box))), # Row five, button two.
#
site1f: Ref (Null_Or((Id,g2d::Box))), # Row six, button one.
site2f: Ref (Null_Or((Id,g2d::Box))), # Row six, button two.
#
site1g: Ref (Null_Or((Id,g2d::Box))), # Row seven, button one.
site2g: Ref (Null_Or((Id,g2d::Box))), # Row seven, button two.
#
site1h: Ref (Null_Or((Id,g2d::Box))), # Row eight, button one.
site2h: Ref (Null_Or((Id,g2d::Box))) # Row eight, button two.
},
read_back_sites_and_ports_of_hsliders: Void -> Void # Fills in values of widget_sites
}
=
{
stipulate
site1a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row one, first button, site notification mailqueue.
site2a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row one, second button, site notification mailqueue.
# #
site1b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row two, first button, site notification mailqueue.
site2b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row two, second button, site notification mailqueue.
# #
site1c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row three, first button, site notification mailqueue.
site2c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row three, second button, site notification mailqueue.
# #
site1d' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row four, first button, site notification mailqueue.
site2d' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row four, second button, site notification mailqueue.
# #
site1e' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row five, first button, site notification mailqueue.
site2e' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row five, second button, site notification mailqueue.
# #
site1f' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row six, first button, site notification mailqueue.
site2f' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row six, second button, site notification mailqueue.
# #
site1g' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row seven, first button, site notification mailqueue.
site2g' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row seven, second button, site notification mailqueue.
# #
site1h' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row eight, first button, site notification mailqueue.
site2h' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row eight, second button, site notification mailqueue.
herein
# These globals hold the values read from the above
# mailops by the later do_one_mailop() calls.
# They hold the sites (window locations) assigned to
# our twelve pushbuttons. (We need this information
# to generate fake mouseclicks on them for test
# purposes. A normal GUI app wouldn't do this.)
#
site1a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button one.
site2a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button two.
# #
site1b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button one.
site2b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button two.
# #
site1c = REF (NULL: Null_Or((Id,g2d::Box))); # Row three, button one.
site2c = REF (NULL: Null_Or((Id,g2d::Box))); # Row three, button two.
# #
site1d = REF (NULL: Null_Or((Id,g2d::Box))); # Row four, button one.
site2d = REF (NULL: Null_Or((Id,g2d::Box))); # Row four, button two.
# #
site1e = REF (NULL: Null_Or((Id,g2d::Box))); # Row five, button one.
site2e = REF (NULL: Null_Or((Id,g2d::Box))); # Row five, button two.
# #
site1f = REF (NULL: Null_Or((Id,g2d::Box))); # Row six, button one.
site2f = REF (NULL: Null_Or((Id,g2d::Box))); # Row six, button two.
# #
site1g = REF (NULL: Null_Or((Id,g2d::Box))); # Row seven, button one.
site2g = REF (NULL: Null_Or((Id,g2d::Box))); # Row seven, button two.
# #
site1h = REF (NULL: Null_Or((Id,g2d::Box))); # Row eight, button one.
site2h = REF (NULL: Null_Or((Id,g2d::Box))); # Row eight, button two.
# These are the site-watcher callbacks we pass to the
# guiboss layer to find out where our buttons are on
# the window:
#
fun sitewatcher1a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1a', site); # Row one, first button, site notification callback.
fun sitewatcher2a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2a', site); # Row one, second button, site notification callback.
# #
fun sitewatcher1b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1b', site); # Row two, first button, site notification callback.
fun sitewatcher2b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2b', site); # Row two, second button, site notification callback.
# #
fun sitewatcher1c (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1c', site); # Row three, first button, site notification callback.
fun sitewatcher2c (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2c', site); # Row three, second button, site notification callback.
# #
fun sitewatcher1d (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1d', site); # Row four, first button, site notification callback.
fun sitewatcher2d (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2d', site); # Row four, second button, site notification callback.
# #
fun sitewatcher1e (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1e', site); # Row five, first button, site notification callback.
fun sitewatcher2e (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2e', site); # Row five, second button, site notification callback.
# #
fun sitewatcher1f (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1f', site); # Row six, first button, site notification callback.
fun sitewatcher2f (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2f', site); # Row six, second button, site notification callback.
# #
fun sitewatcher1g (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1g', site); # Row seven, first button, site notification callback.
fun sitewatcher2g (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2g', site); # Row seven, second button, site notification callback.
# #
fun sitewatcher1h (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1h', site); # Row eight, first button, site notification callback.
fun sitewatcher2h (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2h', site); # Row eight, second button, site notification callback.
fun read_back_sites_and_ports_of_hsliders () # Fill in the above globals via blocking reads.
= # We use timeouts (only) to recover gracefully if things are
{ # somehow so broken that guiboss-imp never calls our callbacks.
# The order shouldn't matter; here we go left-to-right top-to-bottom:
do_one_mailop [ take_from_mailqueue' site1a' ==> {. site1a := #site; assert(TRUE); }, # Row one, button one.
timeout_in' 1.0 ==> {. printf "no site1a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2a' ==> {. site2a := #site; assert(TRUE); }, # Row one, button two.
timeout_in' 1.0 ==> {. printf "no site2a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1b' ==> {. site1b := #site; assert(TRUE); }, # Row two, button one.
timeout_in' 1.0 ==> {. printf "no site1b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2b' ==> {. site2b := #site; assert(TRUE); }, # Row two, button two.
timeout_in' 1.0 ==> {. printf "no site2b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1c' ==> {. site1c := #site; assert(TRUE); }, # Row three, button one.
timeout_in' 1.0 ==> {. printf "no site1c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2c' ==> {. site2c := #site; assert(TRUE); }, # Row three, button two.
timeout_in' 1.0 ==> {. printf "no site2c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1d' ==> {. site1d := #site; assert(TRUE); }, # Row four, button one.
timeout_in' 1.0 ==> {. printf "no site1d in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2d' ==> {. site2d := #site; assert(TRUE); }, # Row four, button two.
timeout_in' 1.0 ==> {. printf "no site2d in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1e' ==> {. site1e := #site; assert(TRUE); }, # Row five, button one.
timeout_in' 1.0 ==> {. printf "no site1e in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2e' ==> {. site2e := #site; assert(TRUE); }, # Row five, button two.
timeout_in' 1.0 ==> {. printf "no site2e in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1f' ==> {. site1f := #site; assert(TRUE); }, # Row six, button one.
timeout_in' 1.0 ==> {. printf "no site1f in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2f' ==> {. site2f := #site; assert(TRUE); }, # Row six, button two.
timeout_in' 1.0 ==> {. printf "no site2f in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1g' ==> {. site1g := #site; assert(TRUE); }, # Row seven, button one.
timeout_in' 1.0 ==> {. printf "no site1g in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2g' ==> {. site2g := #site; assert(TRUE); }, # Row seven, button two.
timeout_in' 1.0 ==> {. printf "no site2g in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1h' ==> {. site1h := #site; assert(TRUE); }, # Row eight, button one.
timeout_in' 1.0 ==> {. printf "no site1h in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2h' ==> {. site2h := #site; assert(TRUE); }, # Row eight, button two.
timeout_in' 1.0 ==> {. printf "no site2h in 1 sec!\n"; assert(FALSE); }
];
};
end;
on_image
=
mtx::make_rw_matrix ((rows, cols), yellow)
where
rows = 30;
cols = 30;
yellow = r8::rgb8_yellow;
end;
off_image
=
mtx::make_rw_matrix ((rows, cols), green)
where
rows = 30;
cols = 30;
green = r8::rgb8_green;
end;
guiplan
=
gt::FRAME
( [ gt::FRAME_WIDGET (popupframe::with []) ],
( gt::GRID
[
[ hflider::with [ hfs::SITEWATCHER sitewatcher1a, hfs::TEXT "red", hfs::LOWER_LIMIT 0.0, hfs::UPPER_LIMIT 1.0, hfs::INITIAL_VALUE 0.5, hfs::PIXELS_HIGH_MIN 0, hfs::PIXELS_WIDE_MIN 0, hfs::PIXELS_HIGH_CUT 1.0, hfs::PIXELS_WIDE_CUT 1.0 ],
hflider::with [ hfs::SITEWATCHER sitewatcher2a, hfs::LOWER_LIMIT 0.0, hfs::UPPER_LIMIT 1.0, hfs::INITIAL_VALUE 0.5, hfs::PIXELS_HIGH_MIN 0, hfs::PIXELS_WIDE_MIN 0, hfs::PIXELS_HIGH_CUT 1.0, hfs::PIXELS_WIDE_CUT 1.0 ]
],
[ hflider::with [ hfs::SITEWATCHER sitewatcher1b, hfs::TEXT "green", hfs::LOWER_LIMIT 0.0, hfs::UPPER_LIMIT 1.0, hfs::INITIAL_VALUE 0.5, hfs::PIXELS_HIGH_MIN 0, hfs::PIXELS_WIDE_MIN 0, hfs::PIXELS_HIGH_CUT 1.0, hfs::PIXELS_WIDE_CUT 1.0, hfs::SHOW_LIMITS FALSE, hfs::SHOW_VALUE FALSE, hfs::COVERAGE 0.3 ],
hflider::with [ hfs::SITEWATCHER sitewatcher2b, hfs::LOWER_LIMIT 0.0, hfs::UPPER_LIMIT 1.0, hfs::INITIAL_VALUE 0.5, hfs::PIXELS_HIGH_MIN 0, hfs::PIXELS_WIDE_MIN 0, hfs::PIXELS_HIGH_CUT 1.0, hfs::PIXELS_WIDE_CUT 1.0, hfs::SHOW_LIMITS FALSE, hfs::SHOW_VALUE FALSE, hfs::COVERAGE 0.3 ]
],
[ hflider::with [ hfs::SITEWATCHER sitewatcher1c, hfs::TEXT "blue", hfs::LOWER_LIMIT 0.0, hfs::UPPER_LIMIT 1.0, hfs::INITIAL_VALUE 0.5, hfs::PIXELS_HIGH_MIN 0, hfs::PIXELS_WIDE_MIN 0, hfs::PIXELS_HIGH_CUT 1.0, hfs::PIXELS_WIDE_CUT 1.0 ],
hflider::with [ hfs::SITEWATCHER sitewatcher2c, hfs::LOWER_LIMIT 0.0, hfs::UPPER_LIMIT 1.0, hfs::INITIAL_VALUE 0.5, hfs::PIXELS_HIGH_MIN 0, hfs::PIXELS_WIDE_MIN 0, hfs::PIXELS_HIGH_CUT 1.0, hfs::PIXELS_WIDE_CUT 1.0 ]
],
[ hflider::with [ hfs::SITEWATCHER sitewatcher1d, hfs::TEXT "alpha", hfs::LOWER_LIMIT 0.0, hfs::UPPER_LIMIT 1.0, hfs::INITIAL_VALUE 0.5, hfs::PIXELS_HIGH_MIN 0, hfs::PIXELS_WIDE_MIN 0, hfs::PIXELS_HIGH_CUT 1.0, hfs::PIXELS_WIDE_CUT 1.0 ],
hflider::with [ hfs::SITEWATCHER sitewatcher2d, hfs::LOWER_LIMIT 0.0, hfs::UPPER_LIMIT 1.0, hfs::INITIAL_VALUE 0.5, hfs::PIXELS_HIGH_MIN 0, hfs::PIXELS_WIDE_MIN 0, hfs::PIXELS_HIGH_CUT 1.0, hfs::PIXELS_WIDE_CUT 1.0 ]
],
[ hslider::with [ his::SITEWATCHER sitewatcher1e, his::TEXT "red", his::LOWER_LIMIT 0, his::UPPER_LIMIT 1000, his::INITIAL_VALUE 500, his::PIXELS_HIGH_MIN 0, his::PIXELS_WIDE_MIN 0, his::PIXELS_HIGH_CUT 1.0, his::PIXELS_WIDE_CUT 1.0 ],
hslider::with [ his::SITEWATCHER sitewatcher2e, his::LOWER_LIMIT 0, his::UPPER_LIMIT 1000, his::INITIAL_VALUE 500, his::PIXELS_HIGH_MIN 0, his::PIXELS_WIDE_MIN 0, his::PIXELS_HIGH_CUT 1.0, his::PIXELS_WIDE_CUT 1.0 ]
],
[ hslider::with [ his::SITEWATCHER sitewatcher1f, his::TEXT "green", his::LOWER_LIMIT 0, his::UPPER_LIMIT 1000, his::INITIAL_VALUE 500, his::PIXELS_HIGH_MIN 0, his::PIXELS_WIDE_MIN 0, his::PIXELS_HIGH_CUT 1.0, his::PIXELS_WIDE_CUT 1.0, his::SHOW_LIMITS FALSE, his::SHOW_VALUE FALSE, his::COVERAGE 0.3 ],
hslider::with [ his::SITEWATCHER sitewatcher2f, his::LOWER_LIMIT 0, his::UPPER_LIMIT 1000, his::INITIAL_VALUE 500, his::PIXELS_HIGH_MIN 0, his::PIXELS_WIDE_MIN 0, his::PIXELS_HIGH_CUT 1.0, his::PIXELS_WIDE_CUT 1.0, his::SHOW_LIMITS FALSE, his::SHOW_VALUE FALSE, his::COVERAGE 0.3 ]
],
[ hslider::with [ his::SITEWATCHER sitewatcher1g, his::TEXT "blue", his::LOWER_LIMIT 0, his::UPPER_LIMIT 1000, his::INITIAL_VALUE 500, his::PIXELS_HIGH_MIN 0, his::PIXELS_WIDE_MIN 0, his::PIXELS_HIGH_CUT 1.0, his::PIXELS_WIDE_CUT 1.0 ],
hslider::with [ his::SITEWATCHER sitewatcher2g, his::LOWER_LIMIT 0, his::UPPER_LIMIT 1000, his::INITIAL_VALUE 500, his::PIXELS_HIGH_MIN 0, his::PIXELS_WIDE_MIN 0, his::PIXELS_HIGH_CUT 1.0, his::PIXELS_WIDE_CUT 1.0 ]
],
[ hslider::with [ his::SITEWATCHER sitewatcher1h, his::TEXT "alpha", his::LOWER_LIMIT 0, his::UPPER_LIMIT 1000, his::INITIAL_VALUE 500, his::PIXELS_HIGH_MIN 0, his::PIXELS_WIDE_MIN 0, his::PIXELS_HIGH_CUT 1.0, his::PIXELS_WIDE_CUT 1.0 ],
hslider::with [ his::SITEWATCHER sitewatcher2h, his::LOWER_LIMIT 0, his::UPPER_LIMIT 1000, his::INITIAL_VALUE 500, his::PIXELS_HIGH_MIN 0, his::PIXELS_WIDE_MIN 0, his::PIXELS_HIGH_CUT 1.0, his::PIXELS_WIDE_CUT 1.0 ]
]
]
)
);
{ guiplan,
widget_sites => { site1a, site2a,
site1b, site2b,
site1c, site2c,
site1d, site2d,
site1e, site2e,
site1f, site2f,
site1g, site2g,
site1h, site2h
},
read_back_sites_and_ports_of_hsliders
};
}; # fun make_hsliders_guiplan
fun make_vsliders_guiplan ()
#
: { guiplan: gt::Guiplan,
# Here we return globals which wind up containing the window sites
# assigned to our various widgets. Normal application code never
# needs to know this, but our test code needs this information in
# order to synthesize fake mouseclicks etc on the buttons.
#
widget_sites: { site1a: Ref (Null_Or((Id,g2d::Box))), # Row one, button one.
site2a: Ref (Null_Or((Id,g2d::Box))), # Row one, button two.
#
site1b: Ref (Null_Or((Id,g2d::Box))), # Row two, button one.
site2b: Ref (Null_Or((Id,g2d::Box))), # Row two, button two.
#
site1c: Ref (Null_Or((Id,g2d::Box))), # Row three, button one.
site2c: Ref (Null_Or((Id,g2d::Box))), # Row three, button two.
#
site1d: Ref (Null_Or((Id,g2d::Box))), # Row four, button one.
site2d: Ref (Null_Or((Id,g2d::Box))), # Row four, button two.
#
site1e: Ref (Null_Or((Id,g2d::Box))), # Row five, button one.
site2e: Ref (Null_Or((Id,g2d::Box))), # Row five, button two.
#
site1f: Ref (Null_Or((Id,g2d::Box))), # Row six, button one.
site2f: Ref (Null_Or((Id,g2d::Box))), # Row six, button two.
#
site1g: Ref (Null_Or((Id,g2d::Box))), # Row seven, button one.
site2g: Ref (Null_Or((Id,g2d::Box))), # Row seven, button two.
#
site1h: Ref (Null_Or((Id,g2d::Box))), # Row eight, button one.
site2h: Ref (Null_Or((Id,g2d::Box))) # Row eight, button two.
},
read_back_sites_and_ports_of_vsliders: Void -> Void # Fills in values of widget_sites
}
=
{
stipulate
site1a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row one, first button, site notification mailqueue.
site2a' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row one, second button, site notification mailqueue.
# #
site1b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row two, first button, site notification mailqueue.
site2b' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row two, second button, site notification mailqueue.
# #
site1c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row three, first button, site notification mailqueue.
site2c' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row three, second button, site notification mailqueue.
# #
site1d' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row four, first button, site notification mailqueue.
site2d' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row four, second button, site notification mailqueue.
# #
site1e' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row five, first button, site notification mailqueue.
site2e' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row five, second button, site notification mailqueue.
# #
site1f' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row six, first button, site notification mailqueue.
site2f' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row six, second button, site notification mailqueue.
# #
site1g' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row seven, first button, site notification mailqueue.
site2g' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row seven, second button, site notification mailqueue.
# #
site1h' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row eight, first button, site notification mailqueue.
site2h' = make_mailqueue (get_current_microthread()): Mailqueue( Null_Or((Id,g2d::Box)) ); # Row eight, second button, site notification mailqueue.
herein
# These globals hold the values read from the above
# mailops by the later do_one_mailop() calls.
# They hold the sites (window locations) assigned to
# our twelve pushbuttons. (We need this information
# to generate fake mouseclicks on them for test
# purposes. A normal GUI app wouldn't do this.)
#
site1a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button one.
site2a = REF (NULL: Null_Or((Id,g2d::Box))); # Row one, button two.
# #
site1b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button one.
site2b = REF (NULL: Null_Or((Id,g2d::Box))); # Row two, button two.
# #
site1c = REF (NULL: Null_Or((Id,g2d::Box))); # Row three, button one.
site2c = REF (NULL: Null_Or((Id,g2d::Box))); # Row three, button two.
# #
site1d = REF (NULL: Null_Or((Id,g2d::Box))); # Row four, button one.
site2d = REF (NULL: Null_Or((Id,g2d::Box))); # Row four, button two.
# #
site1e = REF (NULL: Null_Or((Id,g2d::Box))); # Row five, button one.
site2e = REF (NULL: Null_Or((Id,g2d::Box))); # Row five, button two.
# #
site1f = REF (NULL: Null_Or((Id,g2d::Box))); # Row six, button one.
site2f = REF (NULL: Null_Or((Id,g2d::Box))); # Row six, button two.
# #
site1g = REF (NULL: Null_Or((Id,g2d::Box))); # Row seven, button one.
site2g = REF (NULL: Null_Or((Id,g2d::Box))); # Row seven, button two.
# #
site1h = REF (NULL: Null_Or((Id,g2d::Box))); # Row eight, button one.
site2h = REF (NULL: Null_Or((Id,g2d::Box))); # Row eight, button two.
# These are the site-watcher callbacks we pass to the
# guiboss layer to find out where our buttons are on
# the window:
#
fun sitewatcher1a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1a', site); # Row one, first button, site notification callback.
fun sitewatcher2a (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2a', site); # Row one, second button, site notification callback.
# #
fun sitewatcher1b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1b', site); # Row two, first button, site notification callback.
fun sitewatcher2b (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2b', site); # Row two, second button, site notification callback.
# #
fun sitewatcher1c (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1c', site); # Row three, first button, site notification callback.
fun sitewatcher2c (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2c', site); # Row three, second button, site notification callback.
# #
fun sitewatcher1d (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1d', site); # Row four, first button, site notification callback.
fun sitewatcher2d (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2d', site); # Row four, second button, site notification callback.
# #
fun sitewatcher1e (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1e', site); # Row five, first button, site notification callback.
fun sitewatcher2e (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2e', site); # Row five, second button, site notification callback.
# #
fun sitewatcher1f (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1f', site); # Row six, first button, site notification callback.
fun sitewatcher2f (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2f', site); # Row six, second button, site notification callback.
# #
fun sitewatcher1g (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1g', site); # Row seven, first button, site notification callback.
fun sitewatcher2g (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2g', site); # Row seven, second button, site notification callback.
# #
fun sitewatcher1h (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site1h', site); # Row eight, first button, site notification callback.
fun sitewatcher2h (site: Null_Or((Id,g2d::Box))) = put_in_mailqueue (site2h', site); # Row eight, second button, site notification callback.
fun read_back_sites_and_ports_of_vsliders () # Fill in the above globals via blocking reads.
= # We use timeouts (only) to recover gracefully if things are
{ # somehow so broken that guiboss-imp never calls our callbacks.
# The order shouldn't matter; here we go left-to-right top-to-bottom:
do_one_mailop [ take_from_mailqueue' site1a' ==> {. site1a := #site; assert(TRUE); }, # Row one, button one.
timeout_in' 1.0 ==> {. printf "no site1a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2a' ==> {. site2a := #site; assert(TRUE); }, # Row one, button two.
timeout_in' 1.0 ==> {. printf "no site2a in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1b' ==> {. site1b := #site; assert(TRUE); }, # Row two, button one.
timeout_in' 1.0 ==> {. printf "no site1b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2b' ==> {. site2b := #site; assert(TRUE); }, # Row two, button two.
timeout_in' 1.0 ==> {. printf "no site2b in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1c' ==> {. site1c := #site; assert(TRUE); }, # Row three, button one.
timeout_in' 1.0 ==> {. printf "no site1c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2c' ==> {. site2c := #site; assert(TRUE); }, # Row three, button two.
timeout_in' 1.0 ==> {. printf "no site2c in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1d' ==> {. site1d := #site; assert(TRUE); }, # Row four, button one.
timeout_in' 1.0 ==> {. printf "no site1d in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2d' ==> {. site2d := #site; assert(TRUE); }, # Row four, button two.
timeout_in' 1.0 ==> {. printf "no site2d in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1e' ==> {. site1e := #site; assert(TRUE); }, # Row five, button one.
timeout_in' 1.0 ==> {. printf "no site1e in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2e' ==> {. site2e := #site; assert(TRUE); }, # Row five, button two.
timeout_in' 1.0 ==> {. printf "no site2e in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1f' ==> {. site1f := #site; assert(TRUE); }, # Row six, button one.
timeout_in' 1.0 ==> {. printf "no site1f in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2f' ==> {. site2f := #site; assert(TRUE); }, # Row six, button two.
timeout_in' 1.0 ==> {. printf "no site2f in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site1g' ==> {. site1g := #site; assert(TRUE); }, # Row seven, button one.
timeout_in' 1.0 ==> {. printf "no site1g in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [ take_from_mailqueue' site2g' ==> {. site2g := #site; assert(TRUE); }, # Row seven, button two.
timeout_in' 1.0 ==> {. printf "no site2g in 1 sec!\n"; assert(FALSE); }
];
do_one_mailop [&n