## Clothe 2D stick figure

BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

### Clothe 2D stick figure

This gives an idea how images might be used to cloth the rigging in a 2D figure.
To keep it short I have not implemented all the BONE types variables in this demo nor have I implemented branching bones.
Multiput rotates around the center of an image.
I made use of multiput scaling with variable mag to change the length and size of images.

You must right click and save the two images and resave in the same folder as the program under the names arm1.bmp and arm2.bmp

save this source code as multiput.bi

Code: Select all

`' by D.J.Peters (Joshy)' an put, scale, rotate hackfor the new ImageHeader format.' MultiPut [destination],[xmidpos],[ymidpos],source,[xScale],[yScale],[Trans]'#define UseRad 'if not then Rotate are in degresSub MultiPut(Byval lpTarget As Any Ptr= 0, _             Byval xMidPos  As Integer= 0, _             Byval yMidPos  As Integer= 0, _             Byval lpSource As Any Ptr   , _             Byval xScale   As Single = 1, _             Byval yScale   As Single = 1, _             Byval Rotate   As Single = 0, _             Byval Trans    As Integer= 0)  If (screenptr=0) Or (lpSource=0) Then Exit Sub  If xScale < 0.001 Then xScale=0.001  If yScale < 0.001 Then yScale=0.001  Dim As Integer MustLock,MustRotate  If lpTarget= 0 Then MustLock  =1  If Rotate  <>0 Then MustRotate=1  Dim as Integer  TargetWidth,TargetHeight,TargetBytes,TargetPitch  If MustLock Then    ScreenInfo    _    TargetWidth , _    TargetHeight, _    TargetBytes ,,_    TargetPitch    TargetBytes shr=3    lpTarget=ScreenPtr  Else    TargetBytes  = cptr(uinteger Ptr,lpTarget)[1]    TargetWidth  = cptr(uinteger Ptr,lpTarget)[2]    TargetHeight = cptr(uinteger Ptr,lpTarget)[3]    TargetPitch  = cptr(uinteger Ptr,lpTarget)[4]    lpTarget    += 32  End If  If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub  Dim As Integer   SourceWidth,SourceHeight,SourceBytes,SourcePitch  if cptr(integer Ptr,lpSource)[0] = 7 then    SourceBytes  = cptr(uinteger Ptr,lpSource)[1]    SourceWidth  = cptr(uinteger Ptr,lpSource)[2]    SourceHeight = cptr(uinteger Ptr,lpSource)[3]    SourcePitch  = cptr(uinteger Ptr,lpSource)[4]    lpSource    += 32  else    SourceBytes  = 1    SourceWidth  = cptr(ushort Ptr,lpSource)[0] shr 3    SourceHeight = cptr(ushort Ptr,lpSource)[1]    SourcePitch  = SourceWidth    lpSource    += 4  end if#if 0  ? TargetWidth & "x" & TargetHeight & "x" & TargetBytes,TargetPitch  ? SourceWidth & "x" & SourceHeight & "x" & SourceBytes,SourcePitch  ? MustLock,Trans  sleep:end #endif  If (SourceWidth<2) Or (SourceHeight<2) Then Exit Sub  If (TargetBytes<>SourceBytes) Then Exit Sub#define xs 0 'screen#define ys 1#define xt 2 'texture#define yt 3  Dim As Single Points(3,3)  points(0,xs)=-SourceWidth/2 * xScale  points(1,xs)= SourceWidth/2 * xScale  points(2,xs)= points(1,xs)  points(3,xs)= points(0,xs)  points(0,ys)=-SourceHeight/2 * yScale  points(1,ys)= points(0,ys)  points(2,ys)= SourceHeight/2 * yScale  points(3,ys)= points(2,ys)  points(1,xt)= SourceWidth-1  points(2,xt)= points(1,xt)  points(2,yt)= SourceHeight-1  points(3,yt)= points(2,yt)  Dim As Uinteger i  Dim As Single x,y  If MustRotate Then    #ifndef UseRad    Rotate*=0.017453292 'degre 2 rad    #endif    While Rotate< 0        :rotate+=6.2831853:Wend    While Rotate>=6.2831853:rotate-=6.2831853:Wend    For i=0 To 3      x=points(i,xs)*Cos(Rotate) - points(i,ys)*Sin(Rotate)      y=points(i,xs)*Sin(Rotate) + points(i,ys)*Cos(Rotate)      points(i,xs)=x:points(i,ys)=y    Next  End If  Dim As Integer yStart,yEnd,xStart,xEnd  yStart=100000:yEnd=-yStart:xStart=yStart:xEnd=yEnd#define LI 0   'LeftIndex#define RI 1   'RightIndex#define  IND 0 'Index#define NIND 1 'NextIndex  Dim As Integer CNS(1,1) 'Counters  For i=0 To 3    points(i,xs)=Int(points(i,xs)+xMidPos)    points(i,ys)=Int(points(i,ys)+yMidPos)    If points(i,ys)<yStart Then yStart=points(i,ys):CNS(LI,IND)=i    If points(i,ys)>yEnd   Then yEnd  =points(i,ys)    If points(i,xs)<xStart Then xStart=points(i,xs)    If points(i,xs)>xEnd   Then xEnd  =points(i,xs)  Next  If yStart =yEnd         Then Exit Sub  If yStart>=TargetHeight Then Exit Sub  If yEnd   <0            Then Exit Sub  If xStart = xEnd        Then Exit Sub  If xStart>=TargetWidth  Then Exit Sub  If xEnd   <0            Then Exit Sub  Dim As uByte    Ptr t1,s1  Dim As uShort   Ptr t2,s2  Dim As uInteger Ptr t4,s4#define ADD 0#define CMP 1#define SET 2  Dim As Integer ACS(1,2) 'add compare and set  ACS(LI,ADD)=-1:ACS(LI,CMP)=-1:ACS(LI,SET)=3  ACS(RI,ADD)= 1:ACS(RI,CMP)= 4:ACS(RI,SET)=0#define EX  0#define EU  1#define EV  2#define EXS 3#define EUS 4#define EVS 5  Dim As Single E(2,6),S(6),Length,uSlope,vSlope  Dim As Integer U,UV,UA,UN,V,VV,VA,VN  ' share the same highest point  CNS(RI,IND)=CNS(LI,IND)  If MustLock Then ScreenLock  ' loop from Top to Bottom  While yStart<yEnd    'Scan Left and Right sides together    For i=LI To RI      ' bad to read but fast and short ;-)      If yStart=points(CNS(i,IND),ys) Then        CNS(i,NIND)=CNS(i,IND)+ACS(i,Add)        If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)        While points(CNS(i,IND),ys) = points(CNS(i,NIND),ys)          CNS(i, IND)=CNS(i,NIND)          CNS(i,NIND)=CNS(i, IND)+ACS(i,Add)          If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)        Wend        E(i,EX) = points(CNS(i, IND),xs)        E(i,EU) = points(CNS(i, IND),xt)        E(i,EV) = points(CNS(i, IND),yt)        Length  = points(CNS(i,NIND),ys)        Length -= points(CNS(i, IND),ys)        If Length <> 0.0 Then          E(i,EXS) = points(CNS(i, NIND),xs)-E(i,EX):E(i,EXS)/=Length          E(i,EUS) = points(CNS(i, NIND),xt)-E(i,EU):E(i,EUS)/=Length          E(i,EVS) = points(CNS(i, NIND),yt)-E(i,EV):E(i,EVS)/=Length        End If        CNS(i,IND)=CNS(i,NIND)      End If    Next    If (yStart<0)                              Then Goto SkipScanLine    xStart=E(LI,EX)+0.5:If xStart>=TargetWidth Then Goto SkipScanLine    xEnd  =E(RI,EX)-0.5:If xEnd  < 0           Then Goto SkipScanLine    If (xStart=xEnd)                           Then Goto SkipScanLine    'if xEnd  <xStart                           then goto SkipScanLine    Length=xEnd-xStart    uSlope=E(RI,EU)-E(LI,EU):uSlope/=Length    vSlope=E(RI,EV)-E(LI,EV):vSlope/=Length    If xstart<0 Then      Length=Abs(xStart)      U=Int(E(LI,EU)+uSlope*Length)      V=Int(E(LI,EV)+vSlope*Length)      xStart = 0    Else      U=Int(E(LI,EU)):V=Int(E(LI,EV))    End If    If xEnd>=TargetWidth Then xEnd=TargetWidth-1    UV=Int(uSlope):UA=(uSlope-UV)*100000:UN=0    VV=Int(vSlope):VA=(vSlope-VV)*100000:VN=0    xEnd-=xStart    Select Case TargetBytes      Case 1        t1=cptr(ubyte ptr,lpTarget)        t1+=yStart*TargetPitch+xStart:xStart=0        If Trans=0 Then          While xStart<xEnd            s1=lpSource+V*SourcePitch+U            *t1=*s1            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000            If u<0 Then u=0            If v<0 Then v=0            xStart+=1:t1+=1          Wend        Else          While xStart<xEnd            s1=lpSource+V*SourcePitch+U            If *s1 Then *t1=*s1            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000            If u<0 Then u=0            If v<0 Then v=0            xStart+=1:t1+=1          Wend        End If      Case 2        t2=cptr(Short Ptr,lpTarget)        t2+=yStart*(TargetPitch shr 1)+xStart:xStart=0        If Trans=0 Then          While xStart<xEnd            s2=cptr(Short Ptr,lpSource)+V*(SourcePitch shr 1)+U            *t2=*s2            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000            If u<0 Then u=0            If v<0 Then v=0            xStart+=1:t2+=1          Wend        Else          While xStart<xEnd            s2=cptr(Short Ptr,lpSource)+V*(SourcePitch shr 1)+U            If *s2<>&HF81F Then *t2=*s2            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000            If u<0 Then u=0            If v<0 Then v=0            xStart+=1:t2+=1          Wend        End If      Case 4        t4=cptr(Integer Ptr,lpTarget)+yStart*(TargetPitch shr 2)+xStart:xStart=0        If Trans=0 Then          While xStart<xEnd            s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch shr 2)+U            *t4=*s4            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000            If u<0 Then u=0            If v<0 Then v=0            xStart+=1:t4+=1          Wend        Else          While xStart<xEnd            's4=cptr(Integer Ptr,lpSource):s4+=V*(SourcePitch shr 2):s4+=U            s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch shr 2)+U            If *s4<>&HFFFF00FF Then *t4=*s4            U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000            V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000            If u<0 Then u=0            If v<0 Then v=0            xStart+=1:t4+=1          Wend        End If    End SelectSkipScanLine:    E(LI,EX)+=E(LI,EXS):E(LI,EU)+=E(LI,EUS):E(LI,EV)+=E(LI,EVS)    E(RI,EX)+=E(RI,EXS):E(RI,EU)+=E(RI,EUS):E(RI,EV)+=E(RI,EVS)    yStart+=1:If yStart=TargetHeight Then yStart=yEnd 'exit loop  WendIf MustLock Then ScreenUnlockEnd Sub`

Demo

Code: Select all

`'some useful definesConst Pi = 4 * Atn(1)Dim Shared As Double TwoPi = 8 * Atn(1)Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degreesDim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radianssub drawLine(x1 As Integer,y1 As Integer,x2 As Integer,y2 As Integer,size As Integer,c As ulong)  var dx = x2 - x1  var dy = y2 - y1  if dx = 0 andalso dy=0 then    circle (x1, y1), size, c, , , , f          elseif abs(dx) > abs(dy) then    var m = dy / dx    for x as Integer = x1 To x2 step sgn(dx)      circle (x,m * (x - x1) + y1), size, c, , , , f    next  else    var m =dx / dy    for y as Integer = y1 To y2 step sgn(dy)      circle (m * (y - y1) + x1,y), size, c, , , ,f    next  end ifend sub#include "multiput.bi"'MultiPut [destination],[xmidpos],[ymidpos],source,[xScale],[yScale],[Trans]const SCRW = 800const SCRH = 600screenres SCRW,SCRH,32dim shared as any ptr img1,img2,torsoimg1 = imagecreate(391,43,rgb(255,0,255))bload "arm1.bmp",img1img2 = imagecreate(391,43,rgb(255,0,255))bload "arm2.bmp",img2torso = imagecreate(113,353)bload "torso.bmp",torsotype 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 any ptr img     'imageend typedim shared as BONE arm1,arm2arm1.x1 = SCRW\2  'starting pointarm1.y1 = SCRH\2arm1.s  = 185   'lengtharm2.s  = 185arm1.aMin = 36  'set rotation limitsarm1.aMax = 227arm2.aMin = 0arm2.aMax = 141arm1.a  = 90    'starting angles must be between rotational limitsarm2.a  = 100dim as single angledim as single mag     'magnificationmag = 0.5do    screenlock    cls        multiput 0,arm1.x1,arm1.y1,torso,mag,mag,0,1  'draw torso        angle = arm1.a    if angle < 0   then angle = angle + 360    if angle > 359 then angle = angle - 360    arm1.x2 = arm1.x1 + cos(angle*DtoR) * arm1.s * mag    arm1.y2 = arm1.y1 + sin(angle*DtoR) * arm1.s * mag    multiput 0,arm1.x1,arm1.y1,img1,mag,mag,angle,1    drawLine (arm1.x1,arm1.y1,arm1.x2,arm1.y2,3,rgb(255,0,0))    'line (arm1.x1,arm1.y1)-(arm1.x2,arm1.y2),rgb(255,0,0)        arm2.x1 = arm1.x2    arm2.y1 = arm1.y2    angle = arm1.a + arm2.a  'add next angle    if arm2.a < 0   then arm2.a = arm2.a + 360    if arm2.a > 359 then arm2.a = arm2.a - 360    arm2.x2 = arm2.x1 + cos(angle*DtoR) * arm2.s * mag    arm2.y2 = arm2.y1 + sin(angle*DtoR) * arm2.s * mag    multiput 0,arm2.x1,arm2.y1,img2,mag,mag,angle,1    line (arm2.x1,arm2.y1)-(arm2.x2,arm2.y2),rgb(0,255,0)        locate 2,1    print " arm1.a =";arm1.a    print " arm2.a =";arm2.a    print " Use arrow keys"    screenunlock    if multikey(&H4B) then 'MOVE LEFT        arm1.a = arm1.a + 1        if arm1.a > 359 then arm1.a = arm1.a - 360    end if             if multikey(&H4D) then 'MOVE RIGHT        arm1.a =  arm1.a - 1        if arm1.a < 0 then arm1.a = arm1.a + 360    end if    if multikey(&H48) then 'MOVE UP        arm2.a = arm2.a + 1        if arm2.a > 359 then arm2.a = arm2.a - 360    end if            if multikey(&H50) then 'MOVE DOWN        arm2.a = arm2.a - 1        if arm2.a < 0 then arm2.a = arm2.a + 360    end if        'adjust for limits    if arm1.a < arm1.aMin then arm1.a = arm1.aMin    if arm1.a > arm1.aMax then arm1.a = arm1.aMax    if arm2.a < arm2.aMin then arm2.a = arm2.aMin    if arm2.a > arm2.aMax then arm2.a = arm2.aMax        sleep 2loop until multikey(&H01)imagedestroy(img1)imagedestroy(img2)imagedestroy(torso)`
Last edited by BasicCoder2 on Mar 18, 2018 23:41, edited 1 time in total.
nimdays
Posts: 236
Joined: May 29, 2014 22:01
Location: ID

### Re: Cloth 2D stick figure

My isp is blocking imgur, Do you have any alternatives?
BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: Clothe 2D stick figure

@nimdays,
Do they show up as images in the forum post?
If so there is always the print screen key then fire up PAINT and PASTE. Then cut out the images.
Otherwise run the program below to make and save some similar images.
The images are a bit rubbish it was only to show how using multiput you could overlay an image on the line segments of a stick figure.

Code: Select all

`screenres 640,480,32dim as any ptr arm1,arm2,torsoarm1 = imagecreate(391,43,rgb(255,0,255))arm2 = imagecreate(391,43,rgb(255,0,255))torso = imagecreate(113,352,rgb(255,0,255))line arm1,(178,6)-(391,38),rgb(255,127,0),bfline arm1,(178,6)-(391,38),rgb(0,0,0),bcircle arm1,(195,22),5,rgb(255,255,255),,,,fcircle arm1,(195,22),5,rgb(0,0,0)circle arm1,(372,22),5,rgb(255,255,255),,,,fcircle arm1,(372,22),5,rgb(0,0,0)line arm2,(177,6)-(305,38),rgb(255,127,0),bfline arm2,(177,6)-(305,38),rgb(0,0,0),bline arm2,(306,0)-(346,38),rgb(255,127,0),bfline arm2,(306,0)-(346,42),rgb(0,0,0),bfor i as integer = 0 to 2   line arm2,(347,i*14)-(391,i*14+14),rgb(255,127,0),bf   line arm2,(347,i*14)-(391,i*14+14),rgb(0,0,0),bnext iline torso,(0,100)-(113,352),rgb(10,255,10),bfline torso,(0,100)-(113,352),rgb(0,0,0),bput (0,0),arm1,psetput (0,100),arm2,psetput (400,0),torso,psetbsave "arm1.bmp",arm1bsave "arm2.bmp",arm2bsave "torso.bmp",torsosleep`
Last edited by BasicCoder2 on Mar 18, 2018 23:42, edited 3 times in total.
lizard
Posts: 440
Joined: Oct 17, 2017 11:35
Location: Germany

### Re: Cloth 2D stick figure

In this case it would be easier to use glyph-strings, then it would be possiible to post all as one listing.
BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: Clothe 2D stick figure

@lizard,
There was a thread on inserting images in the source code as data statements or as a string.
viewtopic.php?f=15&t=25440&hilit=images
Last edited by BasicCoder2 on Mar 18, 2018 23:42, edited 1 time in total.
sancho3
Posts: 358
Joined: Sep 30, 2017 3:22

### Re: Cloth 2D stick figure

nimdays wrote:My isp is blocking imgur, Do you have any alternatives?

I can't imagine why your ISP would be blocking imgur. Its the most innocuous site out there. There aren't even a ton of ads on it.
But if that is the case then maybe it would be best if you google searched an image hoster that your ISP isn't blocking.
Here is a top ten list
nimdays
Posts: 236
Joined: May 29, 2014 22:01
Location: ID

### Re: Cloth 2D stick figure

sancho3 wrote:I can't imagine why your ISP would be blocking imgur. Its the most innocuous site out there. There aren't even a ton of ads on it.
But if that is the case then maybe it would be best if you google searched an image hoster that your ISP isn't blocking.
Here is a top ten list

Vimeo, Reddit and Imgur are blocked in Indonesia.Thanks for the list.

@BasicCoder2,Looks great.
BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: Clothe 2D stick figure

nimdays wrote:Vimeo, Reddit and Imgur are blocked in Indonesia.Thanks for the list.
@BasicCoder2,Looks great.

A pity they are blocked do you know why?
Imgur was easy to use the others look complicated.
I have written a full side version of the clothed stickman but no point posting without images.
I will try and find time to write a program to generate the images.
.
Last edited by BasicCoder2 on Mar 18, 2018 23:42, edited 1 time in total.
Boromir
Posts: 451
Joined: Apr 30, 2015 19:28
Location: Texas,U.S., Earth,Solar System
Contact:

### Re: Cloth 2D stick figure

BasicCoder2 wrote:Imgur was easy to use the others look complicated.

This one is simple.
https://postimages.org/

BasicCoder2 wrote:A pity they are blocked do you know why?

Indonesian laws. In Indonesia the government controls most of DNS servers so they can block sites that don't conform to their laws.
BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: Clothe 2D stick figure

@Boromir,
Are they blocked in Indonesia?

The above images have to be resaved as bitmaps.
I guess I need to find a fb library to load a .png file.

Code: Select all

`#include "multiput.bi"'MultiPut [destination],[xmidpos],[ymidpos],source,[xScale],[yScale],[Trans]'some useful definesConst Pi = 4 * Atn(1)Dim Shared As Double TwoPi = 8 * Atn(1)Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degreesDim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radianssub drawLine(x1 As Integer,y1 As Integer,x2 As Integer,y2 As Integer,size As Integer,c As ulong)  var dx = x2 - x1  var dy = y2 - y1  if dx = 0 andalso dy=0 then    circle (x1, y1), size, c, , , , f          elseif abs(dx) > abs(dy) then    var m = dy / dx    for x as Integer = x1 To x2 step sgn(dx)      circle (x,m * (x - x1) + y1), size, c, , , , f    next  else    var m =dx / dy    for y as Integer = y1 To y2 step sgn(dy)      circle (m * (y - y1) + x1,y), size, c, , , ,f    next  end ifend subscreenres 640,480,32'color rgb(0,0,0),rgb(255,255,255):cls'CREATE AND LOAD IMAGES'pointers to imagesdim as any ptr head,kneckdim as any ptr upperArmLeft,lowerArmLeft,leftHanddim as any ptr upperArmRight,lowerArmRight,rightHanddim as any ptr torsodim as any ptr upperLegLeft,lowerLegLeft,leftShoedim as any ptr upperLegRight,lowerLegRight,rightShoe'create bitmaps for each pointer to point tohead = imagecreate(37,46)kneck = imagecreate(69,23)upperArmLeft = imagecreate(133,23)lowerArmLeft = imagecreate(95,17)leftHand = imagecreate(53,19)upperArmRight = imagecreate(133,23)lowerArmRight = imagecreate(95,17)rightHand = imagecreate(53,19)torso = imagecreate(191,33)upperLegLeft = imagecreate(189,33)lowerLegLeft = imagecreate(165,23)leftShoe = imagecreate(63,17)upperLegRight = imagecreate(189,33)lowerLegRight = imagecreate(165,23)rightShoe = imagecreate(63,17)'load images into bitmapsbload "head.bmp",headbload "kneck.bmp",kneckbload "upperArmLeft.bmp",upperArmLeftbload "lowerArmLeft.bmp",lowerArmLeftbload "leftHand.bmp",leftHandbload "upperArmRight.bmp",upperArmRightbload "lowerArmRight.bmp",lowerArmRIghtbload "rightHand.bmp",rightHandbload "torso.bmp",torsobload "upperLegLeft.bmp",upperLegLeftbload "lowerLegLeft.bmp",lowerLegLeftbload "leftShoe.bmp",leftShoebload "upperLegRight.bmp",upperLegRightbload "lowerLegRight.bmp",lowerLegRightbload "rightShoe.bmp",rightShoedim shared as integer selected   'selected bone numberselected = 1                     'first bone as bone(0) is a dummydim shared as single mag         'magnification of imagemag = 1type 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  a2      'save computed angles    as single  aMin    'limits of joint movement    as single  aMax    as single  s       'size    as ulong   c       'color    as any ptr imgend typedim shared as BONE bones(0 to 15)'order in which to draw components for overlapdim shared as integer Order(1 to 15)for i as integer = 1 to 15    read order(i)next i'=================== LEG 1 ================bones(0).x2 = 320   'start pointbones(0).y2 = 240bones(1).r = 1bones(1).a = 53bones(2).a = 53bones(3).a = 239bones(1).s = 85bones(2).s = 75bones(3).s = 31bones(1).c = rgb(255,0,0)bones(2).c = rgb(255,0,0)bones(3).c = rgb(255,0,0)bones(1).p = 0bones(2).p = 1bones(3).p = 2bones(1).img = upperLegLeftbones(2).img = lowerLegLeftbones(3).img = leftShoe'==================== LEG 2 =====================bones(4).r = 1bones(4).a = 90 '59bones(5).a = 53bones(6).a = 239bones(4).s = 85bones(5).s = 75bones(6).s = 31bones(4).c = rgb(0,255,0)bones(5).c = rgb(0,255,0)bones(6).c = rgb(0,255,0)bones(4).p = 0bones(5).p = 4bones(6).p = 5bones(4).img = upperLegRightbones(5).img = lowerLegRightbones(6).img = rightShoe'===================== TORSO ========================bones(7).r = 1bones(7).a = 270bones(7).s = 85bones(7).c = rgb(0,0,255)bones(7).p = 0bones(7).img = torso'===================== ARM 1 =========================bones(8).r = 1bones(8).a = 81bones(9).a = 294bones(10).a = 33bones(8).s = 59bones(9).s = 42bones(10).s = 27bones(8).c = rgb(0,255,255)bones(9).c = rgb(0,255,255)bones(10).c = rgb(0,255,255)bones(8).p = 7bones(9).p = 8bones(10).p = 9bones(8).img = upperArmLeftbones(9).img = lowerArmLeftbones(10).img = leftHand'===================== ARM 2 =========================bones(11).r = 1bones(11).a = 135bones(12).a = 343bones(13).a = 320bones(11).s = 59bones(12).s = 42bones(13).s = 27bones(11).c = rgb(155,155,0)bones(12).c = rgb(155,155,0)bones(13).c = rgb(155,155,0)bones(11).p = 7bones(12).p = 11bones(13).p = 12bones(11).img = upperArmRightbones(12).img = lowerArmRightbones(13).img = rightHand'==================  KNECK AND HEAD ====================bones(14).r = 1bones(14).a = 270bones(14).s = 29bones(14).c = rgb(200,0,200)bones(14).p = 7bones(14).img = kneckbones(15).a = 90bones(15).s = 18bones(15).c = rgb(100,30,100)bones(15).p = 14bones(15).img = headdim shared as single anglesub drawBones()    color rgb(255,255,255)    screenlock    cls    locate 2,1    print " Tap space bar to move through pivot points"    print    print " You can select front pivots by clicking them with left mouse button"    print    print " Use left/right arrow keys OR keys [A] and [D] to rotate selected pivot"        'compute end point positions of each bone x1,y1,and x2,y2    angle = 0    for i as integer = 1 to 15        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        bones(i).a2 = angle               'save computed angles for images        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 * mag        bones(i).y2 = bones(i).y1 + sin(angle*DtoR) * bones(i).s * mag    next i        'draw the bones    dim as integer ii    for i as integer = 1 to 15        'line (bones(i).x1,bones(i).y1)-(bones(i).x2,bones(i).y2),bones(i).c        'drawLine (bones(i).x1,bones(i).y1,bones(i).x2,bones(i).y2,2,bones(i).c)        'circle (bones(i).x1,bones(i).y1),3,rgb(200,200,200)        ii = order(i)        multiput 0,bones(ii).x1,bones(ii).y1,bones(ii).img,mag,mag,bones(ii).a2,1    next i        'show selected pivot    for i as integer = 1 to 15        if selected = i then            circle (bones(i).x1,bones(i).y1),8,rgb(255,255,0),,,,f            draw string (bones(i).x1-6,bones(i).y1-4), str(selected),rgb(0,0,0)        end if    next i            screenunlockend subdim as string keydim as integer mx,my,mbdrawBones()dim as single dd,dx,dydo        'enable to click select front most pivot        getmouse mx,my,,mb        if mb = 1 then            for i as integer = 0 to 15                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                'Use key to rotate selected pivot        key = inkey        'can use the left/right arrow keys        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        'or can sue the [A] and [D] key        If key= "a" Then bones(selected).a = bones(selected).a - 1        If key= "d" Then bones(selected).a = bones(selected).a + 1                'Tap space bar to move selection to next pivot number        if key = " " then selected = selected + 1        if selected = 16 then selected = 1                drawBones()                circle (320,240),15,rgb(255,255,0)  'ABSOLUTE START COORD            sleep 2loop until  multikey(&H01)'release bitmap memoryimagedestroy(head)imagedestroy(kneck)imagedestroy(upperArmLeft)imagedestroy(lowerArmLeft)imagedestroy(leftHand)imagedestroy(upperArmRight)imagedestroy(lowerArmRight)imagedestroy(rightHand)imagedestroy(torso)imagedestroy(upperLegLeft)imagedestroy(lowerLegLeft)imagedestroy(leftShoe)imagedestroy(upperLegRight)imagedestroy(lowerLegRight)imagedestroy(rightShoe)sleep'order in which to draw bones for overlapdata 1,2,3,8,9,10,7,4,5,6,11,12,13,14,15`
Last edited by BasicCoder2 on Mar 18, 2018 23:43, edited 3 times in total.
BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: Clothe 2D stick figure

viewtopic.php?f=14&t=24105&hilit=FBImage

I replaced the load bitmaps with D.J.Peters FBImage.bi commands to make use of the .png versions but although the program ran it only displayed the head, kneck and torso.

Code: Select all

`#include once "FBImage.bi"...screenres 640,480,32'color rgb(0,0,0),rgb(255,255,255):cls'CREATE AND LOAD IMAGES'USING https://www.freebasic.net/forum/viewtopic.php?f=14&t=24105&hilit=FBImagevar head = LoadRGBAFile("head.png")var kneck = LoadRGBAFile("kneck.png")var upperArmLeft = LoadRGBAFile("upperArmLeft.png")var lowerArmLeft = LoadRGBAFile("lowerArmLeft.png")var leftHand = LoadRGBAFile("leftHand.png")var upperArmRight = LoadRGBAFile("upperArmRight.png")var lowerArmRight = LoadRGBAFile("lowerArmRight.png")var rightHand = LoadRGBAFile("rightHand.png")var torso = LoadRGBAFile("torso.png")var upperLegLeft = LoadRGBAFile("upperLegLeft.png")var lowerLegLeft = LoadRGBAFile("lowerLegLeft.png")var leftShoe = LoadRGBAFile("leftShoe.png")var upperLegRight = LoadRGBAFile("upperLegRight.png")var lowerLegRight = LoadRGBAFile("lowerLegRight.png")var rightShoe = LoadRGBAFile("rightShoe.png")dim shared as integer selected   'selected bone number ...`
Last edited by BasicCoder2 on Mar 18, 2018 23:43, edited 1 time in total.
dodicat
Posts: 6692
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Cloth 2D stick figure

basiccoder2
From the topic infinite image zoom, here is a picture loading routine (Windows only)
It will load various formats including bmp to the screen or an image.
I have a direct pixel method also which is much faster, if speed is important.

Code: Select all

`#if sizeof(integer)=8#include "windows.bi"#endif#Include  "win/gdiplus.bi"Function Pload(Picture as String,byref i as any ptr=0) as long   Dim As uinteger TMP    GDIPLUS.GdiplusStartup(@TMP,@type<GDIPLUS.GDIPLUSSTARTUPINPUT>(1),0)   Dim as any Ptr Img   if GDIPLUS.GdipLoadImageFromFile(Picture,@Img)>0 then return 0   Dim As Single w,h   GDIPLUS.GdipGetImageDimension(Img,@w,@h)   if w*h=0 then return 0   Dim As GDIPLUS.BitmapData Pdata   Dim As Rect R=Type(0,0,w-1,h-1)   GDIPLUS.GdipBitmapLockBits(Img,Cast(Any Ptr,@R),GDIPLUS.ImageLockModeRead,PixelFormat32bppARGB,@Pdata)   For y as long = 0 To h-1      For x as long = 0 To w-1            pset i,(x,y),Cast(ulong Ptr,Pdata.Scan0)[y*w+x]      Next   Nextreturn w*hEnd Functionsub getsize(picture as string,byref w as single,byref h as single)     Dim As uinteger TMP    GDIPLUS.GdiplusStartup(@TMP,@type<GDIPLUS.GDIPLUSSTARTUPINPUT>(1),0)   Dim as any Ptr Img   if GDIPLUS.GdipLoadImageFromFile(Picture,@Img)>0 then exit sub   GDIPLUS.GdipGetImageDimension(Img,@w,@h)end sub'====================screen 20,32dim as string picture="arkadia0.jpg"if pload(picture)=0 then print picture + "  not found":sleep :endsleep  `
BasicCoder2
Posts: 3586
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: Clothe 2D stick figure

dodicat wrote:basiccoder2
From the topic infinite image zoom, here is a picture loading routine (Windows only)
It will load various formats including bmp to the screen or an image.
I have a direct pixel method also which is much faster, if speed is important.

Thanks dodicat.
As for "Windows only" I like the idea of any FB code also running on Linux particularly as I hope to get my new toy, a Raspberry Pi, up and running.
Not sure if I will do anything more with the program. I was just motivated to add clothes to the side view stick man example I posted some time back after Boromir posting images of his nice skeletal sprite tool for animated sprites and wanted to give it a try.
I also posted one of a isometric walking stick man but couldn't figure out how to clothe it. I had thought using the cloud of pixels you are so good at and where pixel drawing speed really makes a difference but never got around to it.

isometric stickman

Code: Select all

`'some useful definesConst Pi = 4 * Atn(1)Dim Shared As Double TwoPi = 8 * Atn(1)Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degreesDim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radiansscreenres 940,480,32sub 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 subsub 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 subtype ALINE    as integer x1    as integer y1    as integer z1    as integer x2    as integer y2    as integer z2end typedim shared as ALINE lines(1 to 15)dim shared as integer x1,y1,z1,x2,y2,z2for 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 isub 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    screenunlockend subsub 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 angleend subrotatePointsY()'drawLines()sleepdata 321,140,-20,321,140,+20  'shoulderdata 321,140,-20,288,213,-20  'left arm topdata 288,213,-20,280,280,-20  'lowerdata 280,280,-20,306,270,-20  'wristdata 321,140,+20, 334,218,+20 'right armdata 334,218,+20, 402,237,+20data 402,237,+20, 428,222,+20data 322,239,-20, 322,239,+20 'hipdata 322,239,-20, 338,338,-20  'left legdata 338,338,-20, 268,411,-20data 268,411,-20, 297,419,-20data 322,239,+20, 373,326,+20data 373,326,+20, 337,419,+20data 337,419,+20, 367,414,+20data 321,140,0, 322,239,0    'torso`
nimdays
Posts: 236
Joined: May 29, 2014 22:01
Location: ID

### Re: Clothe 2D stick figure

BasicCoder2 wrote:Are they blocked in Indonesia?

No, I can see that.Thanks again.
D.J.Peters
Posts: 8180
Joined: May 28, 2005 3:28
Contact:

### Re: Clothe 2D stick figure

you can save as ... via right click now

Joshy