import GUI
var main_run : int
main_run := Window.Open ("nooffscreenonly,nobuttonbar")
var x, y, size, co : int
var x1, y1, button : int
var co_l : int := black
x1 := -99
y1 := -99
var first : int % The menus.
var item : array 1 .. 3 of int % The menu items.
var name : array 1 .. 3 of string :=
init ("New", "Open", "Save")
var second : int
var item1 : array 1 .. 3 of int
var name1 : array 1 .. 3 of string :=
init ("Cut", "Copy", "Paste")
procedure colou_r
if x < 100 and button = 1 and whatdotcolour (x, y) = 1 then
co_l := 1
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 2 then
co_l := 2
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 3 then
co_l := 3
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 4 then
co_l := 4
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 5 then
co_l := 5
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 6 then
co_l := 6
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 7 then
co_l := 7
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 8 then
co_l := 8
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 9 then
co_l := 9
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 10 then
co_l := 10
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 11 then
co_l := 11
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 12 then
co_l := 12
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 13 then
co_l := 13
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 14 then
co_l := 14
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 15 then
co_l := 15
end if
if x < 100 and button = 1 and whatdotcolour (x, y) = 16 then
co_l := 16
end if
end colou_r
proc d_colours
% default colours
drawline (100, 1, 100, maxy, black)
drawfillbox (1, 360, 10, 370, 1)
drawfillbox (12, 360, 22, 370, 2)
drawfillbox (24, 360, 34, 370, 3)
drawfillbox (36, 360, 46, 370, 4)
drawfillbox (48, 360, 58, 370, 5)
drawfillbox (60, 360, 70, 370, 6)
drawfillbox (72, 360, 82, 370, 7)
drawfillbox (84, 360, 94, 370, 8)
% start second row of default colours
drawfillbox (1, 348, 10, 358, 9)
drawfillbox (12, 348, 22, 358, 10)
drawfillbox (24, 348, 34, 358, 11)
drawfillbox (36, 348, 46, 358, 12)
drawfillbox (48, 348, 58, 358, 13)
drawfillbox (60, 348, 70, 358, 14)
drawfillbox (72, 348, 82, 358, 15)
drawfillbox (84, 348, 94, 358, 16)
end d_colours
d_colours
proc cut
View.Set ("offscreenonly")
loop
mousewhere (x, y, button)
colou_r
if x < 100 and button = 1 and y < 320 then
exit
end if
if x < 100 and button = 1 and y > 375 then
exit
end if
if button = 1 and x > 100 then
x1 := x
y1 := y
Pic.ScreenSave (100, 1, maxx, maxy, "screen.bmp")
loop
colou_r
mousewhere (x, y, button)
drawbox (x1, y1, x, y, co_l)
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
drawbox (x1, y1, x, y, white)
drawfillbox (100, 1, maxx, maxy, white)
Pic.ScreenLoad ("screen.bmp", 100, 1, picCopy)
GUI.Refresh
if button = 0 then
Pic.ScreenSave (x1, y1, x, y, "clipboard.bmp")
drawfillbox (x1, y1, x, y, white)
exit
end if
end loop
end if
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
end loop
drawfillbox (1, 1, 100, maxy, white)
Pic.ScreenLoad ("screen1.bmp", 1, 370, picCopy)
d_colours
GUI.Refresh
View.Set ("nooffscreenonly")
end cut
proc copy
View.Set ("offscreenonly")
loop
mousewhere (x, y, button)
if x < 100 and button = 1 and y < 320 then
exit
end if
if x < 100 and button = 1 and y > 375 then
exit
end if
if button = 1 and x > 100 then
x1 := x
y1 := y
Pic.ScreenSave (100, 1, maxx, maxy, "screen.bmp")
loop
colou_r
mousewhere (x, y, button)
drawbox (x1, y1, x, y, co_l)
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
drawbox (x1, y1, x, y, white)
drawfillbox (100, 1, maxx, maxy, white)
Pic.ScreenLoad ("screen.bmp", 100, 1, picCopy)
GUI.Refresh
if button = 0 then
Pic.ScreenSave (x1, y1, x, y, "clipboard.bmp")
exit
end if
end loop
end if
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
end loop
drawfillbox (1, 1, 100, maxy, white)
Pic.ScreenLoad ("screen1.bmp", 1, 370, picCopy)
d_colours
GUI.Refresh
View.Set ("nooffscreenonly")
end copy
proc paste
View.Set ("offscreenonly")
loop
mousewhere (x, y, button)
if button = 1 then
Pic.ScreenLoad ("clipboard.bmp", x, y, picCopy)
View.Update
exit
end if
end loop
View.Update
drawfillbox (1, 1, 100, maxy, white)
Pic.ScreenLoad ("screen1.bmp", 1, 370, picCopy)
d_colours
GUI.Refresh
View.Set ("nooffscreenonly")
end paste
procedure Erase
drawfillbox (101, 1, maxx, maxy, white)
end Erase
procedure Open_file
var prompt_file : int
var fileName : string
prompt_file := Window.Open ("graphics:320,25")
put "Name of file: " ..
get fileName
Window.Hide (prompt_file)
Window.SetActive (main_run)
var pic1 : int := Pic.FileNew (fileName + ".bmp")
if pic1 = 0 then
else
var pic2 : int := Pic.Scale (pic1, maxx - 100, maxy)
Pic.Draw (pic2, 101, 1, picCopy)
end if
end Open_file
procedure Save
var prompt_save : int
prompt_save := Window.Open ("graphics:200;30")
var file_name : string
put "Save as: " ..
get file_name
Window.Hide (prompt_save)
Window.SetActive (main_run)
Pic.ScreenSave (101, 1, maxx, maxy, file_name + ".bmp")
end Save
% Create the menus
first := GUI.CreateMenu ("File")
item (1) := GUI.CreateMenuItem (name (1), Erase)
item (2) := GUI.CreateMenuItem (name (2), Open_file)
item (3) := GUI.CreateMenuItem (name (3), Save)
second := GUI.CreateMenu ("Edit")
item1 (1) := GUI.CreateMenuItem (name1 (1), cut)
drawfillbox (101, 1, maxx, maxy, white)
item1 (2) := GUI.CreateMenuItem (name1 (2), copy)
item1 (3) := GUI.CreateMenuItem (name1 (3), paste)
% --------------------- argh problems here---------------------
procedure drawdots
View.Set ("offscreenonly")
loop
mousewhere (x, y, button)
colou_r
if x < 100 and button = 1 and y < 320 then
exit
end if
if x < 100 and button = 1 and y > 375 then
exit
end if
if x1 = -99 and y1 = -99 then
x1 := x
y1 := y
end if
if button = 1 and x > 100 then
drawline (x1, y1, x, y, co_l)
x1 := x
y1 := y
end if
if button = 0 then
x1 := -99
y1 := -99
GUI.Refresh
end if
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
end loop
drawfillbox (1, 1, 100, maxy, white)
Pic.ScreenLoad ("screen1.bmp", 1, 370, picCopy)
d_colours
GUI.Refresh
View.Set ("nooffscreenonly")
end drawdots
proc quiting
break
% loop
% mousewhere (x, y, button)
% locate (1, 1)
% put y
% View.Update
% end loop
end quiting
procedure line1
View.Set ("offscreenonly")
loop
mousewhere (x, y, button)
colou_r
if button = 1 and x < 100 and y < 320 then
exit
end if
if x < 100 and button = 1 and y > 375 then
exit
end if
if button = 1 and x > 100 then
x1 := x
y1 := y
Pic.ScreenSave (100, 1, maxx, maxy, "screen.bmp")
Pic.ScreenSave (1, 370, 100, maxy, "screen1.bmp")
loop
colou_r
mousewhere (x, y, button)
drawline (x1, y1, x, y, co_l)
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
drawline (x1, y1, x, y, white)
drawfillbox (100, 1, maxx, maxy, white)
Pic.ScreenLoad ("screen.bmp", 100, 1, picCopy)
GUI.Refresh
if button = 0 then
drawline (x1, y1, x, y, co_l)
exit
end if
end loop
end if
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
end loop
drawfillbox (1, 1, 100, maxy, white)
Pic.ScreenLoad ("screen1.bmp", 1, 370, picCopy)
d_colours
GUI.Refresh
View.Set ("nooffscreenonly")
end line1
procedure box1
View.Set ("offscreenonly")
loop
mousewhere (x, y, button)
colou_r
if x < 100 and button = 1 and y < 320 then
exit
end if
if x < 100 and button = 1 and y > 375 then
exit
end if
if button = 1 and x > 100 then
x1 := x
y1 := y
Pic.ScreenSave (100, 1, maxx, maxy, "screen.bmp")
loop
colou_r
mousewhere (x, y, button)
drawbox (x1, y1, x, y, co_l)
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
drawbox (x1, y1, x, y, white)
drawfillbox (100, 1, maxx, maxy, white)
Pic.ScreenLoad ("screen.bmp", 100, 1, picCopy)
GUI.Refresh
if button = 0 then
drawbox (x1, y1, x, y, co_l)
exit
end if
end loop
end if
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
end loop
drawfillbox (1, 1, 100, maxy, white)
Pic.ScreenLoad ("screen1.bmp", 1, 370, picCopy)
d_colours
GUI.Refresh
View.Set ("nooffscreenonly")
end box1
procedure box2
View.Set ("offscreenonly")
loop
mousewhere (x, y, button)
colou_r
if x < 100 and button = 1 and y < 320 then
exit
end if
if x < 100 and button = 1 and y > 375 then
exit
end if
if button = 1 and x > 100 then
x1 := x
y1 := y
Pic.ScreenSave (100, 1, maxx, maxy, "screen.bmp")
loop
colou_r
mousewhere (x, y, button)
drawfillbox (x1, y1, x, y, co_l)
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
drawfillbox (x1, y1, x, y, white)
drawfillbox (100, 1, maxx, maxy, white)
Pic.ScreenLoad ("screen.bmp", 100, 1, picCopy)
GUI.Refresh
if button = 0 then
drawfillbox (x1, y1, x, y, co_l)
exit
end if
end loop
end if
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
end loop
drawfillbox (1, 1, 100, maxy, white)
Pic.ScreenLoad ("screen1.bmp", 1, 370, picCopy)
d_colours
GUI.Refresh
View.Set ("nooffscreenonly")
end box2
procedure colour_get
var winID : int
winID := Window.Open ("title:colours,graphics:500,220,position:middle;center")
var a, b : int
a := 1
b := 5
for i : 0 .. 140
drawfillbox (a, 1, b, 100, i)
a := a + 5
b := b + 5
View.Update
end for
% =========================
var c, v : int
c := 1
v := 5
for i : 140 .. 255
drawfillbox (c, 100, v, 200, i)
c := c + 5
v := v + 5
View.Update
end for
var x, y, button : int
loop
mousewhere (x, y, button)
View.Update
if button = 1 then
co_l := whatdotcolour (x, y)
Window.Hide (winID)
exit
end if
end loop
end colour_get
procedure erase
View.Set ("offscreenonly")
loop
mousewhere (x, y, button)
if x < 100 and button = 1 and y < 320 then
exit
end if
if x < 100 and button = 1 and y > 375 then
exit
end if
if button = 1 and x > 105 then
drawfillbox (x - 5, y - 5, x + 5, y + 5, white)
end if
View.Update
end loop
drawfillbox (1, 1, 100, maxy, white)
Pic.ScreenLoad ("screen1.bmp", 1, 370, picCopy)
d_colours
GUI.Refresh
View.Set ("nooffscreenonly")
end erase
proc p_brush
var the_x : int
var the_y : int
loop
View.Set ("offscreenonly")
mousewhere (x, y, button)
colou_r
if button = 1 and x > 110 then
loop
mousewhere (x, y, button)
randint (the_x, x - 10, x + 10)
randint (the_y, y - 10, y + 10)
if sqrt (((the_x - x) * (the_x - x)) + ((the_y - y) * (the_y - y))) < 10 then
drawdot (the_x, the_y, co_l)
end if
View.UpdateArea (100, 1, maxx, maxy)
if button = 0 then
exit
end if
end loop
end if
if button = 1 and x < 100 and y < 345 then
exit
end if
end loop
drawfillbox (1, 1, 100, maxy, white)
Pic.ScreenLoad ("screen1.bmp", 1, 370, picCopy)
d_colours
GUI.Refresh
View.Set ("nooffscreenonly")
end p_brush
procedure circleE
View.Set ("offscreenonly")
loop
mousewhere (x, y, button)
colou_r
if x < 100 and button = 1 and y < 320 then
exit
end if
if x < 100 and button = 1 and y > 375 then
exit
end if
colou_r
if button = 1 and x > 100 then
x1 := x
y1 := y
Pic.ScreenSave (100, 1, maxx, maxy, "screen.bmp")
loop
mousewhere (x, y, button)
drawoval (x1 + (x - x1), y1 + (y - y1), x - x1, y - y1, co_l)
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
drawbox (x1, y1, x, y, white)
drawoval (100, 1, maxx, maxy, white)
Pic.ScreenLoad ("screen.bmp", 100, 1, picCopy)
GUI.Refresh
if button = 0 then
drawoval (x1 + (x - x1), y1 + (y - y1), x - x1, y - y1, co_l)
exit
end if
end loop
end if
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
end loop
drawfillbox (1, 1, 100, maxy, white)
Pic.ScreenLoad ("screen1.bmp", 1, 370, picCopy)
d_colours
GUI.Refresh
View.Set ("nooffscreenonly")
end circleE
procedure circleF
View.Set ("offscreenonly")
loop
mousewhere (x, y, button)
colou_r
if x < 100 and button = 1 and y < 320 then
exit
end if
if x < 100 and button = 1 and y > 375 then
exit
end if
colou_r
if button = 1 and x > 100 then
x1 := x
y1 := y
Pic.ScreenSave (100, 1, maxx, maxy, "screen.bmp")
loop
mousewhere (x, y, button)
drawfilloval (x1 + (x - x1), y1 + (y - y1), x - x1, y - y1, co_l)
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
drawbox (x1, y1, x, y, white)
drawfilloval (100, 1, maxx, maxy, white)
Pic.ScreenLoad ("screen.bmp", 100, 1, picCopy)
GUI.Refresh
if button = 0 then
drawfilloval (x1 + (x - x1), y1 + (y - y1), x - x1, y - y1, co_l)
exit
end if
end loop
end if
View.UpdateArea (100, 1, maxx, maxy)
GUI.Refresh
end loop
drawfillbox (1, 1, 100, maxy, white)
Pic.ScreenLoad ("screen1.bmp", 1, 370, picCopy)
d_colours
GUI.Refresh
View.Set ("nooffscreenonly")
end circleF
procedure buttons
var dot : int := GUI.CreateButton (1, 3, 20, "Hand Draw", drawdots)
var Quit : int := GUI.CreateButton (1, 60, 50, "Quit", quiting)
var line : int := GUI.CreateButton (1, 30, 50, "Line", line1)
var box : int := GUI.CreateButton (1, 90, 20, "Box", box1)
var fillb : int := GUI.CreateButton (50, 90, 10, "Fill", box2)
var custc : int := GUI.CreateButton (1, 320, 50, "Custom", colour_get)
var Erase : int := GUI.CreateButton (1, 120, 50, "Erase", erase)
var pbrush : int := GUI.CreateButton (1, 150, 50, "Spray Paint", p_brush)
var circle : int := GUI.CreateButton (1, 210, 50, "Circle", circleE)
var cirlcef : int := GUI.CreateButton (1, 180, 50, "Fill", circleF)
end buttons
buttons
View.UpdateArea (100, 1, maxx, maxy)
loop
exit when GUI.ProcessEvent
View.UpdateArea (100, 1, maxx, maxy)
end loop
|
Register
Wiki
Blog
Search
Turing
Chat Room
Members
