------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 199x by International Computer Science Institute            --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

-- Author: Holger Klawitter <holger@icsi.berkeley.edu>
-- Date: 6/12/96

-- Demonstration program for the Sather Gui.
-- Simulating a pizza ordering tool.
-- Compile with
--   sacomp -gui -main PIZZA_MAIN -o pizza

class TOPPING < $TK_WIDGET
-- Toppings are mainly buttons on which van click to select that
-- topping for your pizza. They also store the name of the topping
-- the the value factor.
is
    include TK_CHECK
	  create->private create;
    
    readonly attr name: STR;
    private attr var: TK_VAR;
    
    create(frame:$TK_WIDGET,n:STR,updfunc:ROUT): SAME
    -- Creates a new topping button in the frame 'frame'. 'n' is the name
    -- of the topping. 'updfunc' will be called when the button is pressed.
    is
	screenname: STR;
	variable: TK_VAR;
	
	-- If the topping has double value, it will be displayed with a star.
	if PIZZA_DATA::topping_factor(n) /= 1.0 then
	    screenname := n + "*"
	else
	    screenname := n
	end;
	
	variable := #TK_VAR;
	res ::= create(frame,
		  TK_CHECK_CFG::std.text(screenname).variable(variable),
		       TK_PACK::top.anchor(TK_ANCHOR::w) );
	res.command(updfunc);
	res.name := n;
	res.var := variable;
	return res
    end;
    
    price: FLT is return PIZZA_DATA::price(name); end;
    -- Returns the price for this topping on the current pizza.
    
    is_selected: BOOL is return var.query = "1"; end;
    -- Returns true if button is selected.
    
end; -- class TOPPING
------------------------------------------------------------------------    
class PIZZA_MAIN
is
    include GUI_UTIL;
    
    private shared pizzalist: TK_LISTBOX;
    -- Listbox with specials.
    
    private shared toppingframe: TK_FRAME;
    -- Master frame for list of toppings.
    
    shared size: TK_VAR; -- TK variable containing the size of the pizza.
    shared price: TK_LABEL; -- Area to display the price.
    shared extras: TK_ENTRY; -- Area to enter extra requests.
    shared toppingboxes: SET{TOPPING};  -- List of all toppings.

    init
    -- The main program of this application.
    -- Sets up display.
    is
	-- First get all data for the application from the model class
	-- PIZZA_DATA.
	specialnames: ARRAY{STR} := void;
	toppingnames: SET{STR} := void;
	PIZZA_DATA::init(out specialnames,out toppingnames);
	
	dummy: $OB := void;
	radio: TK_RADIO := void;
	
	TK_WINDOW_MGR::title(root_window,"The Sather Pizza Blitz");

	-- 1.) The top line
	top ::= #TK_FRAME(root_window, TK_PACK::top);
	
	-- 1.1.) The Pizza Specials selector box with title and listbox.
	pizzaframe ::= #TK_FRAME(top, TK_PACK::left);
	dummy := #TK_LABEL(pizzaframe,
			   TK_LABEL_CFG::std.text("Select a pizza")
			   .justify_left,
			   TK_PACK::top_grow_horiz);
	pizzalist := #TK_LISTBOX(pizzaframe,
				 TK_LISTBOX_CFG::std.height(5.0).width(40.0),
				 TK_PACK::top_grow_horiz
				 );
	loop pizzalist.insert(1.up!,specialnames.elt!); end;
	pizzalist.bind_event(TK_BUTTON_EVENT::B1,bind(select_pizza(_)));
	
	-- 1.2.) The list of sizes
	size := #TK_VAR;
	sizeframe ::= #TK_FRAME(top, TK_PACK::right);
	dummy := #TK_LABEL(sizeframe,
			   TK_LABEL_CFG::std.text("Select pizza size"),
			   TK_PACK::top);
	
	-- 1.2.1.) Left column
	sizeleft ::= #TK_FRAME(sizeframe,TK_PACK::left);
	radio := #TK_RADIO(sizeleft,
			TK_RADIO_CFG::std.variable(size)
			.text("12\"").justify_left.val("12"),
			   TK_PACK::top);
	radio.command(bind(compute_price));
	-- Remember radio for 14 to select it later.
	size14 ::= #TK_RADIO(sizeleft,
			     TK_RADIO_CFG::std.variable(size)
			     .text("14\"").justify_left.val("14"),
			     TK_PACK::top);
	size14.command(bind(compute_price));
	
	-- 1.2.2.) Right column
	sizeright ::=  #TK_FRAME(sizeframe,TK_PACK::right);
	radio := #TK_RADIO(sizeright,
			   TK_RADIO_CFG::std.variable(size)
			   .text("16\"").justify_left.val("16"),
			   TK_PACK::top);
	radio.command(bind(compute_price));
	radio := #TK_RADIO(sizeright,
			   TK_RADIO_CFG::std.variable(size)
			   .text("18\"").justify_left.val("18"),
			   TK_PACK::top);
	radio.command(bind(compute_price));

	-- 2.) In the middle there go the toppings.
	toppingframe := #TK_FRAME(root_window, TK_PACK::top);
	toppingboxes := #;
	init_toppings(toppingnames);

	-- 3.) The line for extra requests
	extraframe ::= #TK_FRAME(root_window, TK_PACK::top);
	-- 3.1.) A label for it
	extralbl ::= #TK_LABEL(extraframe,
			       TK_LABEL_CFG::std.text("Extra requests ? :"),
			       TK_PACK::left);
	-- 3.2.) The user can enter the text here
	extras := #TK_ENTRY(extraframe,
			    TK_ENTRY_CFG::std.variable(#TK_VAR)
			    .width(40.0),
			    TK_PACK::right);
	extras.set_text("none");
	
	-- 4.) Bottom line
	bottom ::= #TK_FRAME(root_window, TK_PACK::bot_grow_horiz);
	
	-- 4.1.) The 'Order' button
	order ::= #TK_BUTTON(bottom,
			     TK_BUTTON_CFG::std.text("Order(quits)"),
			     TK_PACK::left);
	order.command(quit_routine); -- The quit_routine is included from GUI_UTIL
	
	-- 4.2.) The 'Clear' button
	clear ::= #TK_BUTTON(bottom,
				  TK_BUTTON_CFG::std.text("Unselect toppings"),
				  TK_PACK::left);
	clear.command(bind(unselect_all));
	
	-- 4.3.) The price information
	price := #TK_LABEL(bottom,
			   TK_LABEL_CFG::std
			    .justify_right
			    .font("-*-screen-*-r-*-*-*-160-*-*-*-*-*-*"),
			   TK_PACK::right);
	-- 4.4.) Some fixed text for the price information
	dummy := #TK_LABEL(bottom,
			   TK_LABEL_CFG::std.text("This Pizza costs: "),
			   TK_PACK::right);
	
	-- Selecting some defaults.
	size14.invoke;
	pizzalist.set_selection(0);
    end; -- init

    private init_toppings(toppings:SET{STR})
    -- Puts the set of toppings vertically alphabetically (4 columns)
    -- into the toppingframe.
    is
	-- Create the frames for the columns.
	subframes: ARRAY{TK_FRAME} := #(4);
	loop
	    subframes[0.upto!(3)] :=
		  #TK_FRAME(toppingframe,TK_PACK::left_grow_vert);
	end;

	-- Sort the list of toppings.
	n ::= toppings.size;
	sorted_top ::= #ARRAY{STR}(n);
	loop sorted_top.set!(toppings.elt!) end;
	sorted_top.sort;
	
	-- Put them vertiacally sorted in the colums.
	bound ::= (n/4)*4;
	if n%4>0 then bound := bound + 4; end;
	loop
	    cur ::= 0.upto!(bound);
	    tp ::= sorted_top.elt!;
	    toppingboxes.insert( #TOPPING(subframes[cur*4/bound], tp,
					  bind(compute_price) ));
	end;
    end;
    
    ------------------------------------------
    -- EVENTS
    
    unselect_all
    -- Turns all topping buttons off.
    is
	loop toppingboxes.elt!.deselect end;
	extras.set_text("none");
	compute_price;
    end;
    
    compute_price(e:TK_EVENT_INFO) is compute_price end;
    -- A hook for 'compute_price' without argument. 

    select_pizza(e:TK_EVENT_INFO)
    -- Routine being called when Mouse is pressed in the
    -- list of pizza specials. Looks whether there is a selection
    -- (there shouldn't be more than one -- as the list is a browse list)
    -- and selects the toppings of this pizza.
    is
	x: INT := 0;
	y: INT := 0;
	if pizzalist.curselection.size = 0 then return end;
	e.mouse_coordinates(out x,out y);
	select_pizza(pizzalist.index_at(x.flt,y.flt));
    end;

    ------------------------------------------
    -- ACTIONS:
    
    compute_price
    -- Will be called whenever something happens which changes the
    -- value of the pizza and computes the new price.
    is
	newprice: FLT := PIZZA_DATA::baseprice;
	loop
	    toppingbox ::= toppingboxes.elt!;
	    if toppingbox.is_selected then
		newprice := newprice + toppingbox.price;
	    end
	end;
	price.configure
	      (TK_LABEL_CFG::std.text(#FMT("$<##.##>",newprice).str));
    end;
        
    select_pizza(newpizza:INT)
    -- When a speical is selected, this function changes the topping
    -- buttons to match the recipe.
    is
	loop
	    toppingbox ::= toppingboxes.elt!;
	    if PIZZA_DATA::has_topping(newpizza,toppingbox.name) then
		toppingbox.select;
	    else
		toppingbox.deselect;
	    end
	end;
	compute_price;
    end;

end; -- class PIZZA_MAIN
----------------------------------------------------------------------
class PIZZA_DATA
-- This class stores all prices and selections of Sathers Pizza Blitz.
is
    private shared specials: ARRAY{STR};
    private shared special_count: INT;
    -- List of all specials.
    
    private shared pizzatoppings: ARRAY{ARRAY{STR}};
    -- List of toppings on special number `i'.
    
    private shared doubletoppings: ARRAY{STR} :=
	  | "Clams","Green Olives","Pastrami","Pesto Sauce",
	   "Marinated Chicken","Shrimp","Sun Dried Tomatoes" |;
    -- List of toppings with double value.
    
    private shared toppings: SET{STR};
    -- List of all topping names.
    
    init(out specialnames: ARRAY{STR},out toppingnames: SET{STR})
    -- Sets the recepies for the speical pizzas which are available
    -- from a specials list. The toppings mentioned in this list will
    -- be used to generate the list of toppings.
    is
	toppings := #;
	pizzatoppings := #(16);
	specials := #(16);
	special_count := 0;

	addpizza( "Pizza with Sauche and Cheese", #ARRAY{STR}(0) );
	addpizza( "The Mission Special",
		 |"Salami","Pepperoni","Mushrooms","Sausage"| );
	addpizza( "Mr Pizza Man Special",
		 |"Salami","Pepperoni","Mushrooms","Onions","Bell Peppers",
		  "Sausage" | );
	addpizza( "Vegetarian Special",
		 | "Mushrooms","Onions","Bell Peppers","Sliced Tomatos",
		  "Olives" | );
	addpizza( "Meat Only Special",
		 | "Salami","Pepperoni","Linguica","Beef","Canadian Bacon",
		  "Sausage" | );
	addpizza( "Aloha Special",
		 | "Ham","Canadian Bacon","Pineapple" | );
	addpizza( "Fiesta Special",
		 | "Ground Beef","Onions","Linguica","Jalapenos",
		  "Mushrooms"| );
	addpizza( "Ol' West Cattlemans's",
		 | "Salami","Pepperoni","Beef","Ham","Linguica",
		  "Mushrooms","Onions" | );
	addpizza( "Pesto Special",
		 | "Pesto Sauce","Spinach","Onions","Feta Cheese" | );
	addpizza( "Seafood Special",
		 | "Clams", "Garlic" | );
	addpizza( "Zorba the Greek",
		 |"Salami","Pepperoni","Mushrooms","Onions","Bell Peppers",
		  "Sausage","Feta Cheese","Canadian Bacon" | );
	addpizza( "Guadalajara Special",
		 |"Guadalajara Sauce","Green Olives","Beef","Onions",
		  "Jalapenos","Linguica","Ranchero Cheese"| );
	addpizza( "Vegi Deluxe",
		 | "Pesto Sauce","Artichoke Hearts","Black Olives","Mushrooms",
		  "Garlic","Mozzarella" | );
	addpizza( "Quatro Stagioni", 
		 | "Ham","Artichoke Hearts","Black Olives","Mushrooms" | );
	addpizza( "The Bird Special",
		 | "Marinated Chicken","Mushrooms" | );
	addpizza( "Gurmet Vegetarian",
		 | "Pesto Sauce","Roasted Red Peppers","Pine Nuts",
		  "Zucchini","Broccoli","Eggplant" | );

	specialnames := specials;
	toppingnames := toppings;
    end;

    private addpizza( name:STR, thistoppings: ARRAY{STR} )
    -- Function sued for initialzing. Adds a special with the name 'name'
    -- and the list of toppings on that special.
    is
	specials[special_count] := name;
	pizzatoppings[special_count] := thistoppings;
	loop toppings.insert(thistoppings.elt!) end;
	special_count := special_count + 1;
    end;

    
    has_topping(special_nr:INT,topping:STR): BOOL
    -- Returns 'true' if the special number 'special_nr' has the given
    -- topping.
    is
	return pizzatoppings[special_nr].has(topping)
    end;
    
    baseprice: FLT
    -- Computes the base price for a pizza of the currently selected size.
    is
	s: STR := PIZZA_MAIN::size.query;
	case s
	when "12" then return 7.16
 	when "14" then return 8.52
	when "16" then return 10.62
	when "18" then return 12.1
	else
	    raise "unknown pizza size " + s;
	end;
    end;
    
    topping_factor(topping:STR): FLT
    -- Computes the relative price for a topping.
    is
	if doubletoppings.has(topping) then return 2.0 end;
	return 1.0;
    end;
    
    price(topping:STR): FLT
    -- Computes the price for the given topping. Considers expensice toppings
    -- and the pizza size.
    is 
	val_factor: FLT := topping_factor(topping);

	case PIZZA_MAIN::size.query
	when "12" then return 0.95 * val_factor
	when "14" then return 1.10 * val_factor
	when "16" then return 1.30 * val_factor
	when "18" then return 1.45 * val_factor
	else
	    raise "unknown pizza size"
	end
    end;

end; -- PIZZA_VALUES
----------------------------------------------------------------------
