Code: Select all
'*************************
'*************************
'**** PRO-DRAW V 1.0 ****
'*** by Albert Redditt ***
'***** june 2009 ******
'*************************
'*************************
dim shared i as string * 2
dim shared colors as longint
dim shared files as string*8
dim shared squarex1 as integer
dim shared squarex2 as integer
dim shared squarex3 as integer
dim shared squarex4 as integer
dim shared squarey1 as integer
dim shared squarey2 as integer
dim shared squarey3 as integer
dim shared squarey4 as integer
dim shared trianglex1 as integer
dim shared trianglex2 as integer
dim shared trianglex3 as integer
dim shared triangley1 as integer
dim shared triangley2 as integer
dim shared triangley3 as integer
dim shared circlex as integer
dim shared circley as integer
dim shared circleradius as integer
dim shared circlestart as single
dim shared circleend as single
dim shared circleaspect as single
dim shared linex1 as integer
dim shared linex2 as integer
dim shared liney1 as integer
dim shared liney2 as integer
dim shared arcx1 as single
dim shared arcx2 as single
dim shared arcx3 as single
dim shared arcx4 as single
dim shared arcx5 as single
dim shared arcx6 as single
dim shared arcx7 as single
dim shared arcx8 as single
dim shared arcx9 as single
dim shared arcx10 as single
dim shared arcx11 as single
dim shared arcx12 as single
dim shared arcx13 as single
dim shared arcx14 as single
dim shared arcx15 as single
dim shared arcx16 as single
dim shared arcx17 as single
dim shared arcx18 as single
dim shared arcx19 as single
dim shared arcx20 as single
dim shared arcx21 as single
dim shared arcy1 as single
dim shared arcy2 as single
dim shared arcy3 as single
dim shared arcy4 as single
dim shared arcy5 as single
dim shared arcy6 as single
dim shared arcy7 as single
dim shared arcy8 as single
dim shared arcy9 as single
dim shared arcy10 as single
dim shared arcy11 as single
dim shared arcy12 as single
dim shared arcy13 as single
dim shared arcy14 as single
dim shared arcy15 as single
dim shared arcy16 as single
dim shared arcy17 as single
dim shared arcy18 as single
dim shared arcy19 as single
dim shared arcy20 as single
dim shared arcy21 as single
const pi=3.1415963
declare sub drawsquares()
declare sub drawtriangles()
declare sub drawcircles()
declare sub drawlines()
declare sub drawarcs()
declare sub help()
declare sub menu()
sub help()
locate 1,1
print "Press (s,t,c,l,a) for objects."
print "s = square"
print "F1-F4 and arrows adjust corners"
print " "
print "t = triangle"
print "F1-F3 and arrows adjust corners"
print " "
print "c = circle"
print "F1 and + - keys adjust radius"
print "F2-F3 and up/dn arrows adjust start and end radians"
print "F4 and up/dn arrows adjust aspect (make oval)"
print " "
print "l = line"
print "F1 and F2 and arrows adjust ends"
print " "
print "a = arc"
print "F1-F3 and arrows adjust left/center/right side of arc."
print " "
print "After adjusting points be sure to press the 'space' key to exit adjust mode."
print "To fix the object on the screen press 'enter'."
print " "
print "press ? anytime to see this help page."
print " "
print "press the tilde key anytime to bring up a menu."
print " "
print "Press a key to continue."
do
loop until inkey$<>""
pcopy 0,1
end sub
sub menu()
print "s to save a file."
print "l to load a file."
print "press esc key to abort."
do
i = inkey$
if i = "s" then
'input "file name to save as. ",files
'files = files + ".bmp"
files="test.bmp"
pcopy 0,1
screenset 0,0
screenlock
bsave files,screenptr,480000
screenunlock
pcopy 0,1
screenset 1,1
exit sub
end if
if i = "l" then
'input "file name to load. ",files
'files=files+".bmp"
files = "test.bmp"
pcopy 0,1
screenset 0,0
screenlock
bload files,screenptr
screenunlock
screenset 1,1
pcopy 0,1
exit sub
end if
loop until asc(i) = 27
pcopy 0,1
end sub
sub drawsquares()
pcopy 0,1
line(squarex1,squarey1)-(squarex2,squarey2),colors
line(squarex2,squarey2)-(squarex3,squarey3),colors
line(squarex3,squarey3)-(squarex4,squarey4),colors
line(squarex4,squarey4)-(squarex1,squarey1),colors
end sub
sub drawtriangles()
pcopy 0,1
line(trianglex1,triangley1)-(trianglex2,triangley2),colors
line(trianglex2,triangley2)-(trianglex3,triangley3),colors
line(trianglex3,triangley3)-(trianglex1,triangley1),colors
end sub
sub drawcircles()
pcopy 0,1
circle(circlex,circley),circleradius,colors,circlestart,circleend,circleaspect
end sub
sub drawlines()
pcopy 0,1
line(linex1,liney1)-(linex2,liney2),colors
end sub
sub drawarcs()
pcopy 0,1
arcx2 = arcx1 + ((arcx11 - arcx1)/4)/2
arcx3 = arcx2 + ((arcx11 - arcx2)/4)/2
arcx4 = arcx3 + ((arcx11 - arcx3)/3)/2
arcx5 = arcx4 + ((arcx11 - arcx4)/3)/2
arcx6 = arcx5 + ((arcx11 - arcx5)/3)/2
arcx7 = arcx6 + ((arcx11 - arcx6)/2)/2
arcx8 = arcx7 + ((arcx11 - arcx7)/2)/2
arcx9 = arcx8 + ((arcx11 - arcx8)/2)/2
arcx10= arcx9 + ((arcx11 - arcx9)/2)
arcx20 = arcx21- ((arcx21 - arcx11)/4)/2
arcx19 = arcx20- ((arcx20 - arcx11)/4)/2
arcx18 = arcx19- ((arcx19 - arcx11)/3)/2
arcx17 = arcx18- ((arcx18 - arcx11)/3)/2
arcx16 = arcx17- ((arcx17 - arcx11)/3)/2
arcx15 = arcx16- ((arcx16 - arcx11)/2)/2
arcx14 = arcx15- ((arcx15 - arcx11)/2)/2
arcx13 = arcx14- ((arcx14 - arcx11)/2)/2
arcx12 = arcx13- ((arcx13 - arcx11)/2)
arcy2 = arcy1 + ((arcy11 - arcy1)/4)
arcy3 = arcy2 + ((arcy11 - arcy2)/4)
arcy4 = arcy3 + ((arcy11 - arcy3)/3)
arcy5 = arcy4 + ((arcy11 - arcy4)/3)
arcy6 = arcy5 + ((arcy11 - arcy5)/3)
arcy7 = arcy6 + ((arcy11 - arcy6)/2)
arcy8 = arcy7 + ((arcy11 - arcy7)/2)
arcy9 = arcy8 + ((arcy11 - arcy8)/2)
arcy10= arcy9 + ((arcy11 - arcy9)/2)
arcy20 = arcy21 + ((arcy11 - arcy21)/4)
arcy19 = arcy20 + ((arcy11 - arcy20)/4)
arcy18 = arcy19 + ((arcy11 - arcy19)/3)
arcy17 = arcy18 + ((arcy11 - arcy18)/3)
arcy16 = arcy17 + ((arcy11 - arcy17)/3)
arcy15 = arcy16 + ((arcy11 - arcy16)/2)
arcy14 = arcy15 + ((arcy11 - arcy15)/2)
arcy13 = arcy14 + ((arcy11 - arcy14)/2)
arcy12 = arcy13 + ((arcy11 - arcy13)/2)
line(arcx1,arcy1)-(arcx2,arcy2),colors
line(arcx2,arcy2)-(arcx3,arcy3),colors
line(arcx3,arcy3)-(arcx4,arcy4),colors
line(arcx4,arcy4)-(arcx5,arcy5),colors
line(arcx5,arcy5)-(arcx6,arcy6),colors
line(arcx6,arcy6)-(arcx7,arcy7),colors
line(arcx7,arcy7)-(arcx8,arcy8),colors
line(arcx8,arcy8)-(arcx9,arcy9),colors
line(arcx9,arcy9)-(arcx10,arcy10),colors
line(arcx10,arcy10)-(arcx11,arcy11),colors
line(arcx21,arcy21)-(arcx20,arcy20),colors
line(arcx20,arcy20)-(arcx19,arcy19),colors
line(arcx19,arcy19)-(arcx18,arcy18),colors
line(arcx18,arcy18)-(arcx17,arcy17),colors
line(arcx17,arcy17)-(arcx16,arcy16),colors
line(arcx16,arcy16)-(arcx15,arcy15),colors
line(arcx15,arcy15)-(arcx14,arcy14),colors
line(arcx14,arcy14)-(arcx13,arcy13),colors
line(arcx13,arcy13)-(arcx12,arcy12),colors
line(arcx12,arcy12)-(arcx11,arcy11),colors
end sub
'init squares
squarex1 = 100:squarex2 = 100:squarex3 = 200:squarex4 = 200
squarey1 = 100:squarey2 = 200:squarey3 = 200:squarey4 = 100
'init triangles
trianglex1 = 100:trianglex2 = 200:trianglex3 = 200
triangley1 = 100:triangley2 = 100:triangley3 = 300
'init circles
circlex = 200
circley = 200
circleradius = 100
circlestart = 0.0001
circleend = (pi * 2)-.0001
circleaspect = 1
'init lines
linex1 = 100:linex2 = 200
liney1 = 100:liney2 = 200
'init arc
arcx1 = 100
arcx11 = 200
arcx21 = 300
arcy1 = 300
arcy11 = 200
arcy21 = 300
'init color
colors = 1
screen 19,8,2,1 '800X600 8bpp 2page
mainloop:
pcopy 0,1
screenset 1,1
do
i = inkey$
if i = "s" then goto squares
if i = "t" then goto triangles
if i = "c" then goto circles
if i = "l" then goto lines
if i = "a" then goto arcs
if i = "q" then end
if i = "?" then help()
if asc(i) = 96 then menu()
loop
squares:
do
drawsquares()
do
i = inkey$
if i = "?" then help()
if asc(i) = 96 then menu()
loop until i<>""
if i = chr$(27) then goto mainloop
if i = "-" then colors = colors - 1 :if colors <= -1 then colors = 15
if i = "+" then colors = colors + 1 :if colors >= 16 then colors = 0
if i = chr$(255) + ";" then 'F1
do
i = inkey$
if i = chr$(255)+"M" then squarex1 = squarex1+1
if i = chr$(255)+"K" then squarex1 = squarex1-1
if i = chr$(255)+"P" then squarey1 = squarey1+1
if i = chr$(255)+"H" then squarey1 = squarey1-1
if i = "?" then help()
if asc(i) = 96 then menu()
drawsquares()
loop until i = chr$(32)
goto squares
end if
if i = chr$(255) + "<" then 'F2
do
i = inkey$
if i = chr$(255)+"M" then squarex2 = squarex2+1
if i = chr$(255)+"K" then squarex2 = squarex2-1
if i = chr$(255)+"P" then squarey2 = squarey2+1
if i = chr$(255)+"H" then squarey2 = squarey2-1
if i = "?" then help()
if asc(i) = 96 then menu()
drawsquares()
loop until i = chr$(32)
goto squares
end if
if i = chr$(255) + "=" then 'F3
do
i = inkey$
if i = chr$(255)+"M" then squarex3 = squarex3+1
if i = chr$(255)+"K" then squarex3 = squarex3-1
if i = chr$(255)+"P" then squarey3 = squarey3+1
if i = chr$(255)+"H" then squarey3 = squarey3-1
if i = "?" then help()
if asc(i) = 96 then menu()
drawsquares()
loop until i = chr$(32)
goto squares
end if
if i = chr$(255) + ">" then 'f4
do
i = inkey$
if i = chr$(255)+"M" then squarex4 = squarex4+1
if i = chr$(255)+"K" then squarex4 = squarex4-1
if i = chr$(255)+"P" then squarey4 = squarey4+1
if i = chr$(255)+"H" then squarey4 = squarey4-1
if i = "?" then help()
if asc(i) = 96 then menu()
drawsquares()
loop until i = chr$(32)
goto squares
end if
if i = chr$(255)+"M" then squarex1 = squarex1+1:squarex2 = squarex2+1:squarex3 = squarex3+1:squarex4 = squarex4+1
if i = chr$(255)+"K" then squarex1 = squarex1-1:squarex2 = squarex2-1:squarex3 = squarex3-1:squarex4 = squarex4-1
if i = chr$(255)+"P" then squarey1 = squarey1+1:squarey2 = squarey2+1:squarey3 = squarey3+1:squarey4 = squarey4+1
if i = chr$(255)+"H" then squarey1 = squarey1-1:squarey2 = squarey2-1:squarey3 = squarey3-1:squarey4 = squarey4-1
loop until i = chr$(13)
screenset 0,0
drawsquares()
pcopy 0,1
screenset 1,1
goto squares
triangles:
do
drawtriangles()
do
i = inkey$
if i = "?" then help()
if asc(i) = 96 then menu()
loop until i<>""
if i = chr$(27) then goto mainloop
if i = "-" then colors = colors - 1 :if colors <= -1 then colors = 15
if i = "+" then colors = colors + 1 :if colors >= 16 then colors = 0
if i = chr$(255) + ";" then 'F1
do
i = inkey$
if i = chr$(255)+"M" then trianglex1 = trianglex1+1
if i = chr$(255)+"K" then trianglex1 = trianglex1-1
if i = chr$(255)+"P" then triangley1 = triangley1+1
if i = chr$(255)+"H" then triangley1 = triangley1-1
if i = "?" then help()
if asc(i) = 96 then menu()
drawtriangles()
loop until i = chr$(32)
goto triangles
end if
if i = chr$(255) + "<" then 'F2
do
i = inkey$
if i = chr$(255)+"M" then trianglex2 = trianglex2+1
if i = chr$(255)+"K" then trianglex2 = trianglex2-1
if i = chr$(255)+"P" then triangley2 = triangley2+1
if i = chr$(255)+"H" then triangley2 = triangley2-1
if i = "?" then help()
if asc(i) = 96 then menu()
drawtriangles()
loop until i = chr$(32)
goto triangles
end if
if i = chr$(255) + "=" then 'F3
do
i = inkey$
if i = chr$(255)+"M" then trianglex3 = trianglex3+1
if i = chr$(255)+"K" then trianglex3 = trianglex3-1
if i = chr$(255)+"P" then triangley3 = triangley3+1
if i = chr$(255)+"H" then triangley3 = triangley3-1
if i = "?" then help()
if asc(i) = 96 then menu()
drawtriangles()
loop until i = chr$(32)
goto triangles
end if
if i = chr$(255)+"M" then trianglex1 = trianglex1+1:trianglex2 = trianglex2+1:trianglex3 = trianglex3+1
if i = chr$(255)+"K" then trianglex1 = trianglex1-1:trianglex2 = trianglex2-1:trianglex3 = trianglex3-1
if i = chr$(255)+"P" then triangley1 = triangley1+1:triangley2 = triangley2+1:triangley3 = triangley3+1
if i = chr$(255)+"H" then triangley1 = triangley1-1:triangley2 = triangley2-1:triangley3 = triangley3-1
loop until i = chr$(13)
screenset 0,0
drawtriangles()
pcopy 0,1
screenset 1,1
goto triangles
circles:
do
drawcircles()
do
i = inkey$
if i = "?" then help()
if asc(i) = 96 then menu()
loop until i<>""
if i = chr$(27) then goto mainloop
if i = "-" then colors = colors - 1 :if colors <= -1 then colors = 15
if i = "+" then colors = colors + 1 :if colors >= 16 then colors = 0
if i = chr$(255) + ";" then 'F1
do
i = inkey$
if i = "-" then circleradius = circleradius - 1
if i = "+" then circleradius = circleradius + 1
if i = "?" then help()
if asc(i) = 96 then menu()
drawcircles()
loop until i = chr$(32)
goto circles
end if
if i = chr$(255) + "<" then 'F2
do
i = inkey$
if i = chr$(255)+"P" then circlestart = circlestart - .01
if i = chr$(255)+"H" then circlestart = circlestart + .01
if circlestart < .0001 then circlestart = .0001
if circlestart > circleend then circlestart = circleend
if i = "?" then help()
if asc(i) = 96 then menu()
drawcircles()
loop until i = chr$(32)
goto circles
end if
if i = chr$(255) + "=" then 'F3
do
i = inkey$
if i = chr$(255)+"P" then circleend = circleend + .01
if i = chr$(255)+"H" then circleend = circleend - .01
if circleend >= (pi*2)-.0001 then circleend = (pi*2)-.0001
if circleend < circlestart then circleend = circlestart
if i = "?" then help()
if asc(i) = 96 then menu()
drawcircles()
loop until i = chr$(32)
goto circles
end if
if i = chr$(255) + ">" then 'f4
do
i = inkey$
if i = chr$(255)+"P" then circleaspect = circleaspect + .1
if i = chr$(255)+"H" then circleaspect = circleaspect - .1
if i = "?" then help()
if asc(i) = 96 then menu()
drawcircles()
loop until i = chr$(32)
goto circles
end if
if i = chr$(255)+"M" then circlex = circlex+1
if i = chr$(255)+"K" then circlex = circlex-1
if i = chr$(255)+"P" then circley = circley+1
if i = chr$(255)+"H" then circley = circley-1
loop until i = chr$(13)
screenset 0,0
drawcircles()
pcopy 0,1
screenset 1,1
goto circles
lines:
do
drawlines()
do
i = inkey$
if i = "?" then help()
if asc(i) = 96 then menu()
loop until i<>""
if i = chr$(27) then goto mainloop
if i = "-" then colors = colors - 1 :if colors <= -1 then colors = 15
if i = "+" then colors = colors + 1 :if colors >= 16 then colors = 0
if i = chr$(255) + ";" then 'F1
do
i = inkey$
if i = chr$(255)+"M" then linex1 = linex1+1
if i = chr$(255)+"K" then linex1 = linex1-1
if i = chr$(255)+"P" then liney1 = liney1+1
if i = chr$(255)+"H" then liney1 = liney1-1
if i = "?" then help()
if asc(i) = 96 then menu()
drawlines()
loop until i = chr$(32)
goto lines
end if
if i = chr$(255) + "<" then 'F2
do
i = inkey$
if i = chr$(255)+"M" then linex2 = linex2+1
if i = chr$(255)+"K" then linex2 = linex2-1
if i = chr$(255)+"P" then liney2 = liney2+1
if i = chr$(255)+"H" then liney2 = liney2-1
if i = "?" then help()
if asc(i) = 96 then menu()
drawlines()
loop until i = chr$(32)
goto lines
end if
if i = chr$(255)+"M" then linex1 = linex1+1:linex2 = linex2+1
if i = chr$(255)+"K" then linex1 = linex1-1:linex2 = linex2-1
if i = chr$(255)+"P" then liney1 = liney1+1:liney2 = liney2+1
if i = chr$(255)+"H" then liney1 = liney1-1:liney2 = liney2-1
loop until i = chr$(13)
screenset 0,0
drawlines()
pcopy 0,1
screenset 1,1
goto lines
arcs:
do
drawarcs()
do
i = inkey$
if i = "?" then help()
if asc(i) = 96 then menu()
loop until i<>""
if i = chr$(27) then goto mainloop
if i = "-" then colors = colors - 1 :if colors <= -1 then colors = 15
if i = "+" then colors = colors + 1 :if colors >= 16 then colors = 0
if i = chr$(255) + ";" then 'F1
do
i = inkey$
if i = chr$(255)+"M" then arcx1 = arcx1 + 1
if i = chr$(255)+"K" then arcx1 = arcx1 - 1
if i = chr$(255)+"P" then arcy1 = arcy1 + 1
if i = chr$(255)+"H" then arcy1 = arcy1 - 1
if i = "?" then help()
if asc(i) = 96 then menu()
drawarcs()
loop until i = chr$(32)
goto arcs
end if
if i = chr$(255) + "<" then 'F2
do
i = inkey$
if i = chr$(255)+"M" then arcx11 = arcx11 + 1
if i = chr$(255)+"K" then arcx11 = arcx11 - 1
if i = chr$(255)+"P" then arcy11 = arcy11 + 1
if i = chr$(255)+"H" then arcy11 = arcy11 - 1
if i = "?" then help()
if asc(i) = 96 then menu()
drawarcs()
loop until i = chr$(32)
goto arcs
end if
if i = chr$(255) + "=" then 'F3
do
i = inkey$
if i = chr$(255)+"M" then arcx21 = arcx21 + 1
if i = chr$(255)+"K" then arcx21 = arcx21 - 1
if i = chr$(255)+"P" then arcy21 = arcy21 + 1
if i = chr$(255)+"H" then arcy21 = arcy21 - 1
if i = "?" then help()
if asc(i) = 96 then menu()
drawarcs()
loop until i = chr$(32)
goto arcs
end if
if i = chr$(255)+"M" then
arcx1 = arcx1 + 1
arcx2 = arcx2 + 1
arcx3 = arcx3 + 1
arcx4 = arcx4 + 1
arcx5 = arcx5 + 1
arcx6 = arcx6 + 1
arcx7 = arcx7 + 1
arcx8 = arcx8 + 1
arcx9 = arcx9 + 1
arcx10= arcx10+ 1
arcx11= arcx11+ 1
arcx12= arcx12+ 1
arcx13= arcx13+ 1
arcx14= arcx14+ 1
arcx15= arcx15+ 1
arcx16= arcx16+ 1
arcx17= arcx17+ 1
arcx18= arcx18+ 1
arcx19= arcx19+ 1
arcx20= arcx20+ 1
arcx21= arcx21+ 1
end if
if i = chr$(255)+"K" then
arcx1 = arcx1 - 1
arcx2 = arcx2 - 1
arcx3 = arcx3 - 1
arcx4 = arcx4 - 1
arcx5 = arcx5 - 1
arcx6 = arcx6 - 1
arcx7 = arcx7 - 1
arcx8 = arcx8 - 1
arcx9 = arcx9 - 1
arcx10=arcx10 - 1
arcx11=arcx11 - 1
arcx12= arcx12- 1
arcx13= arcx13- 1
arcx14= arcx14- 1
arcx15= arcx15- 1
arcx16= arcx16- 1
arcx17= arcx17- 1
arcx18= arcx18- 1
arcx19= arcx19- 1
arcx20= arcx20- 1
arcx21=arcx21 - 1
end if
if i = chr$(255)+"P" then
arcy1 = arcy1 + 1
arcy2 = arcy2 + 1
arcy3 = arcy3 + 1
arcy4 = arcy4 + 1
arcy5 = arcy5 + 1
arcy6 = arcy6 + 1
arcy7 = arcy7 + 1
arcy8 = arcy8 + 1
arcy9 = arcy9 + 1
arcy10=arcy10 + 1
arcy11=arcy11 + 1
arcy12= arcy12+ 1
arcy13= arcy13+ 1
arcy14= arcy14+ 1
arcy15= arcy15+ 1
arcy16= arcy16+ 1
arcy17= arcy17+ 1
arcy18= arcy18+ 1
arcy19= arcy19+ 1
arcy20= arcy20+ 1
arcy21=arcy21 + 1
end if
if i = chr$(255)+"H" then
arcy1 = arcy1 - 1
arcy2 = arcy2 - 1
arcy3 = arcy3 - 1
arcy4 = arcy4 - 1
arcy5 = arcy5 - 1
arcy6 = arcy6 - 1
arcy7 = arcy7 - 1
arcy8 = arcy8 - 1
arcy9 = arcy9 - 1
arcy10=arcy10 - 1
arcy11=arcy11 - 1
arcy12= arcy12- 1
arcy13= arcy13- 1
arcy14= arcy14- 1
arcy15= arcy15- 1
arcy16= arcy16- 1
arcy17= arcy17- 1
arcy18= arcy18- 1
arcy19= arcy19- 1
arcy20= arcy20- 1
arcy21=arcy21 - 1
end if
loop until i = chr$(13)
screenset 0,0
drawarcs()
pcopy 0,1
screenset 1,1
goto arcs