PCE version 4C man_modulenamespaceid_tablemodified current_idOIxNexamplesN referenceC hash_tablerefersizeOIxNbothIsNlinking_graphicalsCman_example_card identifiermodule last_modifiednamesummary descriptionsee_alsoinheritcodeOIxNlinking_graphicalsRICdateOIx send(D, report, warning, 'Please first enter a keyword') ; create_keyword(Kwd) ). cancel(D) :- send(D, destroy). % good_make_keywords_dialog(?Dialog) % % Creates the same dialog, but using PCE to glue the % things together. This way the distinction between % UI and application become more clear. good_make_keywords_dialog :- new(D, dialog('Create keyword')), send(D, append, new(label)), send(D, append, new(T, text_item(keyword, ''))), send(D, append, button(create, if(T?selection == '', message(D, report, warning, 'Please enter a keyword'), message(@prolog, create_keyword, T?selection)))), send(D, append, button(cancel, message(D, destroy))), send(D, default_button, create), send(D, open). create_keyword(Name) :- format('Create keyword ~w~n', Name). % Only start the good one :- good_make_keywords_dialog.sNcountingOIxNcountingRIOIx6NCountingOIx Counting long strings in a chainOIxwThe following example assumes a chain of string objects. It will count all strings that are longer than 80 characters.OIxIeN$class/if$C.ifeN$class/number$C.numberEN$class/chain$M.chain.S.for_allXnOIxnumber_of_long_strings(Chain, N) :- new(Number, number(0)), send(Chain, for_all, if(@arg1?size > 80, message(Number, plus, 1))), get(Number, value, N), send(Number, done).sNcreating_objectsOIxNcreating_objectsRIOIx,{FNCreating objectsOIx'Basic examples on how to create objectsOIx:The examples below show how simple objects can be created.nnOIx-% Objects with named references ?- new(@my_window, picture('My Window')). % A graphics window ?- new(@origin, point(0,0)). % A point at (0,0) % Objects with anonymous (integer) references ?- new(B, box(30,40)). % A box of 30 x 40 ?- new(L, line(0,0,100,200, second)). % A line with arrowsNmultiple_fontsOIxNmultiple_fontsRIOIxxname' attribute and the `device <-member' or `device <-catch_all' methods, which provide a mechanism to decent the consists_of hierarchy of graphicals by name. The example below defines a box with text and a method to set the string-value of the text. It uses user-defined classes.OIRxIeN$predicates$14eN$predicates$13eN$class/device$M.device.G.membereN&$class/device$M.device.G.get_catch_allEN!$class/graphical$V.graphical.nameXnOISxL:- pce_begin_class(text_box(string, width, height), device). initialise(T, S:string, Width:[int], Height:[int]) :-> "Initialise from string, width and heigth":: default(Width, 100, W), default(Height, 50, H), send(T, send_super, initialise), send(T, display, box(W,H)), send(T, display, text(S, center)), send(T, recenter). recenter(T) :-> "Put text in center of box":: get(T, member, text, Txt), get(T, member, box, B), send(Txt, center, B?center). string(T, S:string) :-> "Set the string of the text":: get(T, member, text, Txt), send(Txt, string, S). string(T, S) :<- "Get the string of the text":: get(T, member, text, Txt), get(Txt, string, S). :- pce_end_class. % Start the demo :- send(new(P, picture('Text box demo')), open), send(P, display, text_box('Box with centered text', 200, 50), point(50,50)).sNmenu_barOITxNmenu_barRIOIUxd_NMenu BarOIVxUsing a menu_bar in a frameOIWxThe example below illustrates how a menu_bar object is used to present commands for a toolframe to the user. The demo below uses a plain menu_bar object. The library(toolbar) defines more high-level infrastructure to deal with menu- and button bars.nnOIXx\:- set_prolog_flag(xpce_threaded, false). :- use_module(library(pce)). :- pce_autoload(finder, library(find_file)). :- pce_global(@finder, new(finder)). menu_bar_demo :- new(F, frame('Menu Bar demo')), send(F, append, new(D, dialog)), send(new(V, view), below, D), send(D, append, new(MB, menu_bar)), send(MB, append, new(File, popup(file))), send(MB, append, new(Help, popup(help))), send_list(File, append, [ menu_item(load, message(V, load, @finder?file)), menu_item(save, message(V, save_buffer), condition := V?modified == @on, end_group := @on), menu_item(quit, message(F, destroy)) ]), send_list(Help, append, [ menu_item(about, message(@display, inform, 'By Jan Wielemaker')) ]), send(F, open). % Start the demo :- initialization(menu_bar_demo).XaCnumberOIYxx