You can select a joint by clicking on it with the mouse.
Unfortunately some joints exist at the same x,y location and the mouse can only pick one.
To compensate for this problem you can tap the space bar to move through the joints.
You can then use the left/right cursor keys to rotate the joints.
Code: Select all
'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180 ' degrees * DtoR = radians
screenres 640,480,32
'color rgb(0,0,0),rgb(255,255,255):cls
dim shared as integer selected 'selected bone number
type BONE
as integer r 'reset start angle
as integer p 'pointer to previous bone
as integer x1 'absolute start
as integer y1
as integer x2 'end point
as integer y2
as single a 'angle of joint
as single aMin 'limits of joint movement
as single aMax
as single s 'size
as ulong c 'color
end type
dim shared as BONE bones(0 to 13)
'=================== LEG 1 ================
bones(0).x2 = 320 'start point
bones(0).y2 = 240
bones(1).r = 1
bones(1).a = 81
bones(2).a = 53
bones(3).a = 239
bones(1).s = 100
bones(2).s = 100
bones(3).s = 30
bones(1).c = rgb(255,0,0)
bones(2).c = rgb(255,0,0)
bones(3).c = rgb(255,0,0)
bones(1).p = 0
bones(2).p = 1
bones(3).p = 2
'==================== LEG 2 =====================
bones(4).r = 1
bones(4).a = 59
bones(5).a = 53
bones(6).a = 239
bones(4).s = 100
bones(5).s = 100
bones(6).s = 30
bones(4).c = rgb(0,255,0)
bones(5).c = rgb(0,255,0)
bones(6).c = rgb(0,255,0)
bones(4).p = 0
bones(5).p = 4
bones(6).p = 5
'===================== TORSO ========================
bones(7).r = 1
bones(7).a = 270
bones(7).s = 100
bones(7).c = rgb(0,0,255)
bones(7).p = 0
'===================== ARM 1 =========================
bones(8).r = 1
bones(8).a = 81
bones(9).a = 294
bones(10).a = 315
bones(8).s = 80
bones(9).s = 70
bones(10).s = 30
bones(8).c = rgb(0,255,255)
bones(9).c = rgb(0,255,255)
bones(10).c = rgb(0,255,255)
bones(8).p = 7
bones(9).p = 8
bones(10).p = 9
'===================== ARM 2 =========================
bones(11).r = 1
bones(11).a = 114
bones(12).a = 343
bones(13).a = 239
bones(11).s = 80
bones(12).s = 70
bones(13).s = 30
bones(11).c = rgb(155,155,0)
bones(12).c = rgb(155,155,0)
bones(13).c = rgb(155,155,0)
bones(11).p = 7
bones(12).p = 11
bones(13).p = 12
dim shared as single angle
sub drawBones()
screenlock
cls
angle = 0
locate 2,1
for i as integer = 1 to 13
color bones(i).c
if bones(i).r = 1 then angle = 0:print
if bones(i).a < 0 then bones(i).a = bones(i).a + 360
if bones(i).a > 359 then bones(i).a = bones(i).a - 360
angle = angle + bones(i).a
if angle < 0 then angle = angle + 360
if angle > 359 then angle = angle - 360
bones(i).x1 = bones( bones(i).p ).x2
bones(i).y1 = bones( bones(i).p ).y2
bones(i).x2 = bones(i).x1 + cos(angle*DtoR) * bones(i).s
bones(i).y2 = bones(i).y1 + sin(angle*DtoR) * bones(i).s
line (bones(i).x1,bones(i).y1)-(bones(i).x2,bones(i).y2),bones(i).c
circle (bones(i).x1,bones(i).y1),3,rgb(200,200,200)
if selected = i then
circle (bones(i).x1,bones(i).y1),5
draw string (bones(i).x1+8,bones(i).y1), str(selected)
end if
print i;" ";bones(i).a,angle
next i
screenunlock
end sub
dim as string key
dim as integer mx,my,mb
drawBones()
dim as single dd,dx,dy
do
getmouse mx,my,,mb
if mb = 1 then
for i as integer = 0 to 13
dx = mx-bones(i).x1
dy = my-bones(i).y1
dd = sqr(dx^2+dy^2)
if dd < 5 then
selected = i
end if
next i
end if
key = inkey
If key=Chr(255) +"K" Then bones(selected).a = bones(selected).a - 1
If key=Chr(255) +"M" Then bones(selected).a = bones(selected).a + 1
if key = " " then selected = selected + 1
if selected = 14 then selected = 1
drawBones()
sleep 2
loop until multikey(&H01)
sleep
If the joints could be positioned in a 3D volume instead of being restricted to 2D surface with the ability to rotate them around the center of the figure you could probably use the mouse to select all the joints.
It might look something like this.
Code: Select all
'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180 ' degrees * DtoR = radians
screenres 940,480,32
sub setXYZ(x as double,y as double,z as double)
circle (x+z\2,y-z\2),3,rgb(0,255,0)
'draw string (x+z\2,y-z\2),str(int(x+.5))+","+str(int(y+.5))+","+str(int(z+.5))
end sub
sub lineXYZ(x1 as double,y1 as double,z1 as double,x2 as double,y2 as double,z2 as double)
line (x1+z1\2,y1-z1\2)-(x2+z2\2,y2-z2\2),rgb(255,0,0)
setXYZ(x1,y1,z1)
setXYZ(x2,y2,z2)
end sub
type ALINE
as integer x1
as integer y1
as integer z1
as integer x2
as integer y2
as integer z2
end type
dim shared as ALINE lines(1 to 15)
dim shared as integer x1,y1,z1,x2,y2,z2
for i as integer = 1 to 15 'draw 15 lines
read lines(i).x1,lines(i).y1,lines(i).z1,lines(i).x2,lines(i).y2,lines(i).z2
lineXYZ(x1,y1,z1,x2,y2,z2)
next i
sub drawLines()
screenlock
cls
for i as integer = 1 to 15 'draw 15 lines
lineXYZ(lines(i).x1,lines(i).y1,lines(i).z1,lines(i).x2,lines(i).y2,lines(i).z2)
next i
screenunlock
end sub
sub rotatePointsY()
dim as double px1,py1,pz1,px2,py2,pz2,rx1,ry1,rz1,rx2,ry2,rz2
for angle as double = 0 to 360
cls
for i as integer = 1 to 15 '15 lines
pz1 = lines(i).z1 - 50
px1 = lines(i).x1 - 350
py1 = lines(i).y1 - 350
rz1 = (Cos(angle*DtoR) * pz1 - Sin(angle*DtoR) * px1)+50
rx1 = (Sin(angle*DtoR) * pz1 + Cos(angle*DtoR) * px1)+350
ry1 = py1+340
pz2 = lines(i).z2 - 50
px2 = lines(i).x2 - 350
py2 = lines(i).y2 - 350
rz2 = (Cos(angle*DtoR) * pz2 - Sin(angle*DtoR) * px2)+50
rx2 = (Sin(angle*DtoR) * pz2 + Cos(angle*DtoR) * px2)+350
ry2 = py2+340
LINEXYZ(rx1,ry1,rz1,rx2,ry2,rz2)
next i
sleep 50
next angle
end sub
rotatePointsY()
'drawLines()
sleep
data 321,140,-20,321,140,+20 'shoulder
data 321,140,-20,288,213,-20 'left arm top
data 288,213,-20,280,280,-20 'lower
data 280,280,-20,306,270,-20 'wrist
data 321,140,+20, 334,218,+20 'right arm
data 334,218,+20, 402,237,+20
data 402,237,+20, 428,222,+20
data 322,239,-20, 322,239,+20 'hip
data 322,239,-20, 338,338,-20 'left leg
data 338,338,-20, 268,411,-20
data 268,411,-20, 297,419,-20
data 322,239,+20, 373,326,+20
data 373,326,+20, 337,419,+20
data 337,419,+20, 367,414,+20
data 321,140,0, 322,239,0 'torso