------------------------------------------------------------------------------ -- -- -- Sample JEWL.Windows application: a simple sketchpad application. -- -- -- -- Copyright (C) John English 2000. Contact address: je@brighton.ac.uk -- -- This software is released under the terms of the GNU General Public -- -- License and is intended primarily for educational use. Please contact -- -- the author to report bugs, suggestions and modifications. -- -- -- ------------------------------------------------------------------------------ -- $Id: sketch.adb 1.6 2001/11/02 16:00:00 JE Exp JE $ ------------------------------------------------------------------------------ -- -- $Log: sketch.adb $ -- Revision 1.6 2001/11/02 16:00:00 JE -- * Fixed canvas bug when saving an empty canvas -- * Restore with no prior save now acts as erase -- * Removed redundant variable declaration in Image function -- -- Revision 1.5 2001/08/22 15:00:00 JE -- * Minor bugfix to Get_Text for combo boxes -- * Minor changes to documentation (including new example involving dialogs) -- -- Revision 1.4 2001/01/25 09:00:00 je -- * Calculator, Converter and Minipad amended to use JEWL.Simple_Windows -- * Show_Image and Pong added -- -- Revision 1.1 2000/04/09 21:00:00 je -- Initial revision -- ------------------------------------------------------------------------------ with JEWL.Windows; procedure Sketch is type Cmd is (Quit, Draw, Undo, Pen, Fill, No_Fill, Background, Line, Rectangle, Ellipse, OK, Cancel, Set_Pen_Colour); package Sketch_Windows is new JEWL.Windows(Cmd); use Sketch_Windows; Sketch_Frame : Frame_Type := Frame (300,400, "Sketchpad", Quit); Shape_Menu : Menu_Type := Menu (Sketch_Frame, "&Shape"); Menu_L : Menuitem_Type := Menuitem (Shape_Menu, "&Line", Line); Menu_R : Menuitem_Type := Menuitem (Shape_Menu, "&Rectangle", Rectangle); Menu_E : Menuitem_Type := Menuitem (Shape_Menu, "&Ellipse", Ellipse); Sep : Menuitem_Type := Separator(Shape_Menu); Menu_U : Menuitem_Type := Menuitem (Shape_Menu, "&Undo draw", Undo); Tools_Menu : Menu_Type := Menu (Sketch_Frame, "&Tools"); Menu_P : Menuitem_Type := Menuitem (Tools_Menu, "Select &pen", Pen); Menu_F : Menuitem_Type := Menuitem (Tools_Menu, "Set &fill colour", Fill); Menu_N : Menuitem_Type := Menuitem (Tools_Menu, "Fill shapes", No_Fill); Menu_B : Menuitem_Type := Menuitem (Tools_Menu, "Set &background colour", Background); Surface : Canvas_Type := Canvas (Sketch_Frame, (0,0), 0, 0, Draw); Pen_Dialog : Dialog_Type := Dialog (365, 125, "Pen properties", Cancel); Pen_Label_1 : Label_Type := Label (Pen_Dialog, (20,20), 100, 20, "Pen width:", Right); Pen_Edit : Editbox_Type := Editbox (Pen_Dialog, (125,20), 50, 20); Pen_Label_2 : Label_Type := Label (Pen_Dialog, (190,20), 100, 20, "Pen colour:", Right); Pen_Canvas : Canvas_Type := Canvas (Pen_Dialog, (295,20), 50, 20); OK_Button : Button_Type := Button (Pen_Dialog, (10,60), 100, 25, "OK", OK, True); Cancel_Button : Button_Type := Button (Pen_Dialog, (130,60), 100, 25, "Cancel", Cancel); Colour_Button : Button_Type := Button (Pen_Dialog, (250,60), 100, 25, "Set colour...", Set_Pen_Colour); Fill_Colour : Colour_Dialog_Type := Colour_Dialog; Pen_Colour : Colour_Dialog_Type := Colour_Dialog; BG_Colour : Colour_Dialog_Type := Colour_Dialog; Current_Tool : Cmd := Line; Pen_Width : Natural := 1; procedure Draw_Shape is begin case Current_Tool is when Line => Draw_Line (Surface, Start_Point(Surface), End_Point(Surface)); when Rectangle => Draw_Rectangle (Surface, Start_Point(Surface), End_Point(Surface)); when Ellipse => Draw_Ellipse (Surface, Start_Point(Surface), End_Point(Surface)); when others => Show_Error ("Invalid tool (" & Cmd'Image(Current_Tool) & ")"); end case; end Draw_Shape; begin Set_Colour (Fill_Colour, White); Set_Colour (Pen_Colour, Black); Set_Colour (BG_Colour, White); Set_State (Menu_L, True); loop Enable (Menu_F, Get_State(Menu_N)); case Next_Command is when Quit => exit; when Draw => Save (Surface); while Mouse_Down(Surface) loop if Mouse_Moved(Surface) then Restore (Surface); Draw_Shape; end if; end loop; when Undo => Restore (Surface); when Pen => loop Set_Colour (Pen_Canvas, Get_Colour(Pen_Colour)); Set_Text (Pen_Edit, Integer'Image(Pen_Width)); case Execute(Pen_Dialog) is when OK => begin Pen_Width := Natural'Value(Get_Text(Pen_Edit)); Set_Pen (Surface, Get_Colour(Pen_Colour), Pen_Width); exit; exception when Constraint_Error => Show_Error ("Pen width must be a positive number!"); end; when Cancel => exit; when Set_Pen_Colour => if Execute(Pen_Colour) then null; end if; when others => null; end case; end loop; when Fill => if Execute(Fill_Colour) then Set_Fill (Surface, Get_Colour(Fill_Colour)); end if; when No_Fill => Set_State (Menu_N, not Get_State(Menu_N)); if Get_State(Menu_N) then Set_Fill (Surface, Get_Colour(Fill_Colour)); else Set_Fill (Surface); end if; when Background => if Execute(BG_Colour) then Set_Colour (Surface, Get_Colour(BG_Colour)); end if; when Line => Current_Tool := Line; Set_State (Menu_L, True); Set_State (Menu_R, False); Set_State (Menu_E, False); when Rectangle => Current_Tool := Rectangle; Set_State (Menu_L, False); Set_State (Menu_R, True); Set_State (Menu_E, False); when Ellipse => Current_Tool := Ellipse; Set_State (Menu_L, False); Set_State (Menu_R, False); Set_State (Menu_E, True); when OK | Cancel | Set_Pen_Colour => null; end case; end loop; end Sketch;