MultiPut V2.0 :-)

[sero]

If you're interested, I'll post the link when I'm done.

That would be nice of you. Yes please :)

[wio]

Here is a 2x zoomed in screenshot of my experience of what is happening with this multiput using an 8x8 sprite. The titles 32bit and 64bit refers to how the code was compiled.

Hi Sero, yes that looks to be the same problems I am getting, although my approach to testing wasn't quite as systematic and pretty as yours :D
Well done for providing a very good visual representation of what is happening.

[wio]

If you're interested, I'll post the link when I'm done.

That would be nice of you. Yes please :)

I second that :D

Thank you.

[sero]

I found some alternate code that works pretty well with both 32bit and 64bit at rotating. Things look good at 90,180,270 viewtopic.php?f=2&t=26373 This code also allows for scaling, but lacks transparency. With this code I discovered a strange snapping into intervals of 90. I also noticed the rotation (when scaling) gets off a bit and loses some edge definition in one of the quadrants. Perhaps this code works with your needs.

Should probably ask you, are you looking for sprite rotation at 90 degree steps? If this is the case then the fancy math can be avoided and it basically turns into swapping x & y values. Something not too far off of this viewtopic.php?f=7&t=11374

Code: Select all

' https://www.freebasic.net/forum/viewtopic.php?f=2&t=26373
declare Sub rotate(im As Any Ptr,angle As single,shiftx As long=0,shifty As long=0,sc As Single=1)

screen 18,32
Dim spr_pedehead As Any Ptr  = ImageCreate(8,8)

line spr_pedehead, (0,0)-(7,7), rgb(255,0,255),b
line spr_pedehead, (1,1)-(6,6), rgb(127,127,127),bf
line spr_pedehead, (1,0)-(6,0), rgb(255,0,0)
line spr_pedehead, (7,1)-(7,6), rgb(0,255,0)
line spr_pedehead, (1,7)-(6,7), rgb(31,31,255)
line spr_pedehead, (0,1)-(0,6), rgb(255,63,127)

'bload"test.bmp",spr_pedehead

dim as single r = 0
dim as long yoffset = 102

Do       
 
  screenlock()    
    draw string(120,yoffset - 16),"no trans"
    draw string(120,yoffset),"original"
    put (120,yoffset+18),spr_pedehead,pset
   
    line(238,yoffset+20)-(272,yoffset+121),rgb(0,0,0),bf
    draw string(240,yoffset),"rotate()"
    rotate(spr_pedehead,r,243,yoffset+21,1)
    rotate(spr_pedehead,r,243,yoffset+42,1.5)
    rotate(spr_pedehead,r,243,yoffset+64,2)
    rotate(spr_pedehead,r,243,yoffset+92,3)
   
    draw string(360,yoffset),"90 rotate()"
    rotate(spr_pedehead,90,364,yoffset+22,1)
    draw string(360,yoffset+40),"180 rotate()"
    rotate(spr_pedehead,180,364,yoffset+62,1)
    draw string(360,yoffset+80),"270 rotate()"
    rotate(spr_pedehead,270,364,yoffset+102,1)
  screenunlock()
 
  r += 1
  if r > 180 then r -= 360
  
  sleep 15
Loop Until inkey <>""

ImageDestroy spr_pedehead

Sub rotate(im As Any Ptr,angle As single,shiftx As long=0,shifty As long=0,sc As Single=1)
    static As Integer pitch,pitchs,xres,yres,runflag
    static As Any Ptr row
    static As integer ddx,ddy,resultx,resulty
    Imageinfo im,ddx,ddy,,pitch,row
   if runflag=0 then Screeninfo xres,yres,,,pitchS:runflag=1
    Dim As Any Ptr rowS=Screenptr
    Dim As long centreX=ddx\2,centreY=ddy\2
    Dim as single rad = angle * 0.0174533
    Dim As single sx=Sin(rad)
    Dim As single cx=Cos(rad)
    Dim As long mx=Iif(ddx>=ddy,ddx,ddy),shftx,shfty
    Var fx=sc*.7071067811865476,sc2=1/sc
     shiftx+=centreX*sc-centrex
     shiftY+=centrey*sc-centrey
    For y As long=centrey-fx*mx+1 To centrey+ fx*mx
        dim as single sxcy=Sx*(y-centrey),cxcy=Cx*(y-centrey)
        shfty=y+shifty
        For x As long=centrex-mx*fx To centrex+mx*fx
             'on screen
                 if x+shiftx >=0 then
                    if x+shiftx <xres then
                        if shfty >=0 then
                            if shfty<yres then
            resultx=sc2*(Cx*(x-centrex)-Sxcy) +centrex:resulty=sc2*(Sx*(x-centrex)+Cxcy) +centrey
                'on image
                if resultx >=0 then
                    if resultx<ddx then
                        if resulty>=0 then
                            if resulty<ddy then
    *cast(ulong ptr,rowS+pitchS*(y+shifty)+(x+shiftx) Shl 2)= _
    *cast(ulong ptr,row+pitch*((resultY))+((resultX)) Shl 2 )
                End If:end if:end if:end if
                End If:end if:end if:end if
        Next x
    Next y
End Sub

[Dr_D]

If you're interested, I'll post the link when I'm done.

That would be nice of you. Yes please :)

I second that :D

Thank you.

Here is the forum link to the stuff I made. I think DJ actually improved it somewhere on the forum as well, but I could be wrong about that. Anyway, I hope it's helpful. :)
viewtopic.php?f=15&t=29158

[wio]

Thanks so much sero and Dr D. I will have a look through your suggestions. Very much appreciated.

I am just using 90 degree intervals yes, it is to avoid drawing 4 sets of sprites and also to avoid having an overly complicated animation system.
I've got a retro buzz on and want to teach my son a bit of coding so, thought I would brush up on some basic. UE4 is giving me the doldrums, so I wanted to do something a bit different. :D

[wio]

Thanks sero, I used the code you suggested and achieved what I wanted to do :)
Initially I was disappointed because there was no transparency but I ended up 'Get'ting an 8x8 section of the screen where my 8x8 sprite was to be drawn, rotating it with the rotate sub then 'Put' it back down in the same place. Then I Put my game sprite on top of that with transparency on and then Get and rotate (the opposite way) the result of that. Fantastic, you guys are awesome. There was a bit of an offset I needed to add when I drew it back to the screen but it all works great now thanks.

Code: Select all

Get (pedeheadx,pedeheady) - (pedeheadx+7,pedeheady+7), spr_screensection ' gets 8x8 part of screen at game sprite location
rotate(spr_screensection,angle,pedeheadx+directionOffset,pedeheady+directionOffset,1)
Put (pedeheadx,pedeheady),img_pedesheet,(0,0)-(7,7),trans
Get (pedeheadx,pedeheady) - (pedeheadx+7,pedeheady+7), spr_pedehead
rotate(spr_pedehead,angle,pedeheadx+directionOffset,pedeheady+directionOffset,1) 

I found some alternate code that works pretty well with both 32bit and 64bit at rotating. Things look good at 90,180,270 viewtopic.php?f=2&t=26373 This code also allows for scaling, but lacks transparency. With this code I discovered a strange snapping into intervals of 90. I also noticed the rotation (when scaling) gets off a bit and loses some edge definition in one of the quadrants. Perhaps this code works with your needs.

Should probably ask you, are you looking for sprite rotation at 90 degree steps? If this is the case then the fancy math can be avoided and it basically turns into swapping x & y values. Something not too far off of this viewtopic.php?f=7&t=11374

Code: Select all

' https://www.freebasic.net/forum/viewtopic.php?f=2&t=26373
declare Sub rotate(im As Any Ptr,angle As single,shiftx As long=0,shifty As long=0,sc As Single=1)

screen 18,32
Dim spr_pedehead As Any Ptr  = ImageCreate(8,8)

line spr_pedehead, (0,0)-(7,7), rgb(255,0,255),b
line spr_pedehead, (1,1)-(6,6), rgb(127,127,127),bf
line spr_pedehead, (1,0)-(6,0), rgb(255,0,0)
line spr_pedehead, (7,1)-(7,6), rgb(0,255,0)
line spr_pedehead, (1,7)-(6,7), rgb(31,31,255)
line spr_pedehead, (0,1)-(0,6), rgb(255,63,127)

'bload"test.bmp",spr_pedehead

dim as single r = 0
dim as long yoffset = 102

Do       
 
  screenlock()    
    draw string(120,yoffset - 16),"no trans"
    draw string(120,yoffset),"original"
    put (120,yoffset+18),spr_pedehead,pset
   
    line(238,yoffset+20)-(272,yoffset+121),rgb(0,0,0),bf
    draw string(240,yoffset),"rotate()"
    rotate(spr_pedehead,r,243,yoffset+21,1)
    rotate(spr_pedehead,r,243,yoffset+42,1.5)
    rotate(spr_pedehead,r,243,yoffset+64,2)
    rotate(spr_pedehead,r,243,yoffset+92,3)
   
    draw string(360,yoffset),"90 rotate()"
    rotate(spr_pedehead,90,364,yoffset+22,1)
    draw string(360,yoffset+40),"180 rotate()"
    rotate(spr_pedehead,180,364,yoffset+62,1)
    draw string(360,yoffset+80),"270 rotate()"
    rotate(spr_pedehead,270,364,yoffset+102,1)
  screenunlock()
 
  r += 1
  if r > 180 then r -= 360
  
  sleep 15
Loop Until inkey <>""

ImageDestroy spr_pedehead

Sub rotate(im As Any Ptr,angle As single,shiftx As long=0,shifty As long=0,sc As Single=1)
    static As Integer pitch,pitchs,xres,yres,runflag
    static As Any Ptr row
    static As integer ddx,ddy,resultx,resulty
    Imageinfo im,ddx,ddy,,pitch,row
   if runflag=0 then Screeninfo xres,yres,,,pitchS:runflag=1
    Dim As Any Ptr rowS=Screenptr
    Dim As long centreX=ddx\2,centreY=ddy\2
    Dim as single rad = angle * 0.0174533
    Dim As single sx=Sin(rad)
    Dim As single cx=Cos(rad)
    Dim As long mx=Iif(ddx>=ddy,ddx,ddy),shftx,shfty
    Var fx=sc*.7071067811865476,sc2=1/sc
     shiftx+=centreX*sc-centrex
     shiftY+=centrey*sc-centrey
    For y As long=centrey-fx*mx+1 To centrey+ fx*mx
        dim as single sxcy=Sx*(y-centrey),cxcy=Cx*(y-centrey)
        shfty=y+shifty
        For x As long=centrex-mx*fx To centrex+mx*fx
             'on screen
                 if x+shiftx >=0 then
                    if x+shiftx <xres then
                        if shfty >=0 then
                            if shfty<yres then
            resultx=sc2*(Cx*(x-centrex)-Sxcy) +centrex:resulty=sc2*(Sx*(x-centrex)+Cxcy) +centrey
                'on image
                if resultx >=0 then
                    if resultx<ddx then
                        if resulty>=0 then
                            if resulty<ddy then
    *cast(ulong ptr,rowS+pitchS*(y+shifty)+(x+shiftx) Shl 2)= _
    *cast(ulong ptr,row+pitch*((resultY))+((resultX)) Shl 2 )
                End If:end if:end if:end if
                End If:end if:end if:end if
        Next x
    Next y
End Sub

[sero]

I'm glad you were able to make it fit wio. Welcome to FreeBasic and please do ask questions. There are a lot of smart coders here. And thanks Dr_D for bringing back your rotozoomer :)

[Gunslinger]

I have a problem with the code at line 5 first post, the example of the function inputs.

Code: Select all

' MultiPut [destination],[xmidpos],[ymidpos], source,[xScale],[yScale],[Trans]

think it's better to add rotation parameter option here.
like this.

Code: Select all

' MultiPut [destination],[xmidpos],[ymidpos], source,[xScale],[yScale],[Rotate],[Trans]

First i got disappointed thinking it can not rotate, looking at that line.
later i got happy to see it did.
Thank for sharing.

[Gunslinger]

Here a modified version with alpha channel transparent for 32bit color.
color mixer optimized as good as i can do.

Code: Select all

#ifndef __MULTIPUT_BI__
#define __MULTIPUT_BI__

' Multiput by D.J.Peters (Joshy)
' MultiPut_alpha32 [destination],[xmidpos],[ymidpos], source,[xScale],[yScale],[Rotate],[Trans]

type FP16 ' fixed point 16:16
	union
	type
		as ushort l
		as  short h
	end type
	as integer v
	end union
end type

#define _ADD_ 0 ' increment a value
#define _CMP_ 1 ' compare values
#define _SET_ 2 ' set a value

#define _XScreen_  0
#define _YScreen_  1
#define _UTexture_ 2
#define _VTexture_ 3

#define _LeftIndex_    0
#define _RightIndex_   1

#define _CurrentIndex_ 0
#define _NextIndex_    1

#define _EdgeXStart_ 0
#define _EdgeUStart_ 1
#define _EdgeVStart_ 2
#define _EdgeXStep_  3
#define _EdgeUStep_  4
#define _EdgeVStep_  5

'#define UseRad 'if not then Rotate are in degrees

Sub MultiPut_alpha32(Byval pTarget As Any Ptr= 0, _
						 Byval xMidPos As Integer= 0, _
						 Byval yMidPos As Integer= 0, _
						 Byval pSource As Any Ptr   , _
						 Byval xScale  As Single = 1, _
						 Byval yScale  As Single = 1, _
						 Byval Rotate  As Single = 0, _
						 Byval Transparent As boolean = false)
	Dim As Integer SourceWidth=any,SourceHeight=any,SourceBytes=any,SourcePitch=any
	Dim as Integer TargetWidth=any,TargetHeight=any,TargetBytes=any,TargetPitch=any
	Dim As Integer i=any,yStart=any,yEnd=any,xStart=any,xEnd=any
	Dim As Integer CNS(1,1)=any 'Counters
	Dim As Integer ACS(1,2)=any '_ADD_ compare and _SET_
	Dim As Single fPoints(3,3)=any,fEdges(2,6)=any,fLength=any,fUSlope=any,fVSlope=any
	Dim As FP16 U=any,V=any,US=any,VS=any
	Dim As boolean MustRotate = iif(Rotate<>0,true,false)
	
	If (ScreenPtr()=0) Or (pSource=0) Then Exit Sub
	
	If xScale < 0.001 Then xScale=0.001
	If yScale < 0.001 Then yScale=0.001
	
	If pTarget=0 Then
		ScreenInfo     _
		TargetWidth  , _
		TargetHeight,, _
		TargetBytes  , _
		TargetPitch
		pTarget=ScreenPtr()
	Else
		ImageInfo     _
		pTarget     , _
		TargetWidth , _
		TargetHeight, _
		TargetBytes , _
		TargetPitch , _
		pTarget
	End If
	If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub

	ImageInfo     _
	pSource     , _
	SourceWidth , _
	SourceHeight, _
	SourceBytes , _
	SourcePitch , _
	pSource

	Select Case as const TargetBytes
	case 1    ' TargetPitch shr=0 : SourcePitch shr=0
	case 2    : TargetPitch shr=1 : SourcePitch shr=1
	case 4    : TargetPitch shr=2 : SourcePitch shr=2
	case else : exit sub
	end select

	fPoints(0,_XScreen_)=-SourceWidth/2 * xScale
	fPoints(1,_XScreen_)= SourceWidth/2 * xScale
	fPoints(2,_XScreen_)= fPoints(1,_XScreen_)
	fPoints(3,_XScreen_)= fPoints(0,_XScreen_)

	fPoints(0,_YScreen_)=-SourceHeight/2 * yScale
	fPoints(1,_YScreen_)= fPoints(0,_YScreen_)
	fPoints(2,_YScreen_)= SourceHeight/2 * yScale
	fPoints(3,_YScreen_)= fPoints(2,_YScreen_)

	fPoints(0,_UTexture_)=0
	fPoints(1,_UTexture_)= SourceWidth
	fPoints(2,_UTexture_)= fPoints(1,_UTexture_)
	fPoints(3,_UTexture_)=0
 
	fPoints(0,_VTexture_)=0
	fPoints(1,_VTexture_)=0
	fPoints(2,_VTexture_)= SourceHeight
	fPoints(3,_VTexture_)= fPoints(2,_VTexture_)

	If MustRotate=true Then
		#ifndef UseRad
		Rotate*=0.017453292 'deg 2 rad
		#endif
		var co = cos(rotate)
		var si = sin(rotate)
		For i=0 To 3
			var x = fPoints(i,_XScreen_)*co - fPoints(i,_YScreen_)*si
			var y = fPoints(i,_XScreen_)*si + fPoints(i,_YScreen_)*co
			fPoints(i,_XScreen_) = x
			fPoints(i,_YScreen_) = y
		Next
	End If
	yStart=30^2:yEnd=-yStart:xStart=yStart:xEnd=yEnd
 
	' get min max
	For i=0 To 3
		fPoints(i,_XScreen_)=Int(fPoints(i,_XScreen_)+xMidPos)
		fPoints(i,_YScreen_)=Int(fPoints(i,_YScreen_)+yMidPos)
		If fPoints(i,_YScreen_)<yStart Then yStart=fPoints(i,_YScreen_):CNS(_LeftIndex_,_CurrentIndex_)=i
		If fPoints(i,_YScreen_)>yEnd   Then yEnd  =fPoints(i,_YScreen_)
		If fPoints(i,_XScreen_)<xStart Then xStart=fPoints(i,_XScreen_)
		If fPoints(i,_XScreen_)>xEnd   Then xEnd  =fPoints(i,_XScreen_)
	Next

	If yStart = yEnd        Then Exit Sub
	If xStart = xEnd        Then Exit Sub
	If yEnd   < 0           Then Exit Sub
	If xEnd   < 0           Then Exit Sub
	If yStart>=TargetHeight Then Exit Sub
	If xStart>=TargetWidth  Then Exit Sub
 
 
	ACS(_LeftIndex_ ,_ADD_)=-1:ACS(_LeftIndex_ ,_CMP_)=-1:ACS(_LeftIndex_ ,_SET_)=3
	ACS(_RightIndex_,_ADD_)= 1:ACS(_RightIndex_,_CMP_)= 4:ACS(_RightIndex_,_SET_)=0

	' share the same highest point
	CNS(_RightIndex_,_CurrentIndex_)=CNS(_LeftIndex_,_CurrentIndex_)
 
	' loop from Top to Bottom
	While yStart<yEnd
		'Scan Left and Right edges together
		For i=_LeftIndex_ To _RightIndex_
			' bad to read but fast and short ;-)
			If yStart=fPoints(CNS(i,_CurrentIndex_),_YScreen_) Then
				CNS(i,_NextIndex_)=CNS(i,_CurrentIndex_)+ACS(i,_ADD_)
				If CNS(i,_NextIndex_)=ACS(i,_CMP_) Then CNS(i,_NextIndex_)=ACS(i,_SET_)
				While fPoints(CNS(i,_CurrentIndex_),_YScreen_) = fPoints(CNS(i,_NextIndex_),_YScreen_)
					CNS(i,_CurrentIndex_)=CNS(i,_NextIndex_)
					CNS(i,_NextIndex_   )=CNS(i,_CurrentIndex_)+ACS(i,_ADD_)
					If CNS(i,_NextIndex_)=ACS(i,_CMP_) Then CNS(i,_NextIndex_)=ACS(i,_SET_)
				Wend
				fEdges(i,_EdgeXStart_) = fPoints(CNS(i,_CurrentIndex_),_XScreen_)
				fEdges(i,_EdgeUStart_) = fPoints(CNS(i,_CurrentIndex_),_UTexture_)
				fEdges(i,_EdgeVStart_) = fPoints(CNS(i,_CurrentIndex_),_VTexture_)
				fLength  = fPoints(CNS(i,_NextIndex_),_YScreen_) - fPoints(CNS(i,_CurrentIndex_),_YScreen_)
				If fLength <> 0.0 Then
					fLength=1/fLength
					fEdges(i,_EdgeXStep_) = fPoints(CNS(i,_NextIndex_),_XScreen_ )-fEdges(i,_EdgeXStart_):fEdges(i,_EdgeXStep_)*=fLength
					fEdges(i,_EdgeUStep_) = fPoints(CNS(i,_NextIndex_),_UTexture_)-fEdges(i,_EdgeUStart_):fEdges(i,_EdgeUStep_)*=fLength
					fEdges(i,_EdgeVStep_) = fPoints(CNS(i,_NextIndex_),_VTexture_)-fEdges(i,_EdgeVStart_):fEdges(i,_EdgeVStep_)*=fLength
				End If
				CNS(i,_CurrentIndex_)=CNS(i,_NextIndex_)
			End If
		Next

		If (yStart<0)                                                   Then Goto NextScanLine
		xStart=fEdges(_LeftIndex_ ,_EdgeXStart_):If xStart>=TargetWidth Then Goto NextScanLine
		xEnd  =fEdges(_RightIndex_,_EdgeXStart_):If xEnd  < 0           Then Goto NextScanLine
		If (xStart=xEnd)                                                Then Goto NextScanLine
		if xEnd  <xStart                                                Then goto NextScanLine

		fLength=1/(xEnd-xStart)
		fUSlope=fEdges(_RightIndex_,_EdgeUStart_)-fEdges(_LeftIndex_,_EdgeUStart_):fUSlope*=fLength
		fVSlope=fEdges(_RightIndex_,_EdgeVStart_)-fEdges(_LeftIndex_,_EdgeVStart_):fVSlope*=fLength
		If xStart<0 Then
			fLength=-xStart
			U.v=(fEdges(_LeftIndex_,_EdgeUStart_)+fUSlope*fLength)*&HFFFF
			V.v=(fEdges(_LeftIndex_,_EdgeVStart_)+fVSlope*fLength)*&HFFFF
			xStart = 0
		Else
			U.v=fEdges(_LeftIndex_,_EdgeUStart_)*&HFFFF
			V.v=fEdges(_LeftIndex_,_EdgeVStart_)*&HFFFF
		End If
		If u.v<0 Then u.v=0
		If v.v<0 Then v.v=0
		US.v=fUSlope*&HFFFF
		VS.v=fVSlope*&HFFFF

		If xEnd>=TargetWidth Then xEnd=TargetWidth-1

		Select Case as const TargetBytes
		Case 1
			var s=cptr(ubyte ptr,pSource)
			var t=cptr(ubyte ptr,pTarget)+yStart*TargetPitch+xStart
			var e=t+(xEnd-xStart)
			If Transparent=false Then
				While t<e
					*t=*(s+V.h*SourcePitch+U.h)
					V.v+=VS.v : U.v+=US.v : t+=1
				Wend
			Else
				While t<e
					dim as ubyte c = *(s+V.h*SourcePitch+U.h)
					If c=0 Then *t=c  'black color
					V.v+=VS.v : U.v+=US.v : t+=1
				Wend
			End If
		Case 2
			var s=cptr(ushort ptr,pSource)
			var t=cptr(ushort ptr,pTarget)+yStart*TargetPitch+xStart
			var e=t+(xEnd-xStart)
			If Transparent=false Then
				While t<e
					*t=*(s+V.h*SourcePitch+U.h)
					V.v+=VS.v : U.v+=US.v : t+=1
				Wend
			Else
				While t<e
					dim as ushort c=*(s+V.h*SourcePitch+U.h)
					If c<>&HF81F Then *t=c
					V.v+=VS.v : U.v+=US.v : t+=1
				Wend
			End If
		Case 4
			var s=cptr(ulong ptr,pSource)
			var t=cptr(ulong ptr,pTarget)+yStart*TargetPitch+xStart
			var e=t+(xEnd-xStart)
			If Transparent=false Then
				While t<e
					*t=*(s+V.h*SourcePitch+U.h)
					V.v+=VS.v : U.v+=US.v : t+=1
				Wend
			Else
				While t<e
					dim as ulong c=*(s+V.h*SourcePitch+U.h) 'get color from img pixel
					dim as ubyte al = c shr 24 'get alpha value to ubyte
					If al >= 255 Then
						*t = c  'Draw pixel without alpha transparent 0%
					elseif al = 0 then
						'nothing (drawing 100% transparent)
					else
						'color mixing
						dim as ubyte inv_al = 255 - al 'inverted alpha channel
						*t = _
						(((((c and &H00FF0000) shr 16) * al + ((*t and &H00FF0000) shr 16) * inv_al) and &H0000FF00) shl 8) + _ 'red
						(((((c and &H0000FF00) shr 8 ) * al + ((*t and &H0000FF00) shr 8 ) * inv_al)) and &H0000FF00) + _ 'green
						(((((c and &H000000FF)       ) * al + ((*t and &H000000FF)       ) * inv_al)) shr 8) + _ 'blue
						(c and &HFF000000) 'alpha re-added to output
					end if
					V.v+=VS.v
					U.v+=US.v
					t+=1
				Wend
			End If
		End Select

	NextScanLine:
		yStart+=1 : If yStart=TargetHeight Then exit while
		fEdges(_LeftIndex_ ,_EdgeXStart_)+=fEdges(_LeftIndex_ ,_EdgeXStep_)
		fEdges(_LeftIndex_ ,_EdgeUStart_)+=fEdges(_LeftIndex_ ,_EdgeUStep_)
		fEdges(_LeftIndex_ ,_EdgeVStart_)+=fEdges(_LeftIndex_ ,_EdgeVStep_)
		fEdges(_RightIndex_,_EdgeXStart_)+=fEdges(_RightIndex_,_EdgeXStep_)
		fEdges(_RightIndex_,_EdgeUStart_)+=fEdges(_RightIndex_,_EdgeUStep_)
		fEdges(_RightIndex_,_EdgeVStart_)+=fEdges(_RightIndex_,_EdgeVStep_)
	Wend
End Sub
#endif ' __MULTIPUT_BI__

test code

Code: Select all

#include "MultiPut.bi"

dim as single rotation(8)
screenres 1920,1080,32
dim as integer w,h
screeninfo w,h

dim as any ptr img=ImageCreate(128,128,rgb(255,255,255),32)
line img,(0,0)-step(127,127),RGB(255,255,255),BF
for i as integer = 0 to 127 step 32
	line img,(i ,0 )-step(0,127),rgb(128,128,128)
	line img,(i+1,0)-step(0,127),rgb(128,128,128)
	line img,(0 ,i )-step(127,0),rgb(128,128,128)
	line img,(0,i+1)-step(127,0),rgb(128,128,128)
next
for i as integer = 0 to 3
  line img,(i,i)-step(127-i*2,127-i*2),RGB(0,0,255),B
next
' some holes (in pink)
circle img,(12    ,12    ),8,RGBA(255,0,255,127),,,,F
circle img,(127-12,12    ),8,RGBA(255,0,255,127),,,,F
circle img,(12    ,127-12),8,RGBA(255,0,255,127),,,,F
circle img,(127-12,127-12),8,RGBA(255,0,255,127),,,,F

for y as integer = 0 to 63
	for x as integer = 0 to 63
		pset img,(x+33,y+33),rgba(0, y*4, x*4,((x+y)*8)mod 255)
		circle img,(63.5,63.5),48+y/4+x/63,0
	next x
next y

' yes baby version 2.0 :-)
draw string img,(24,9   ),"MultiPut2()",RGBA(255,0,0,127)
draw string img,(24,9+32),"MultiPut2()",RGBA(0,255,0,127)
draw string img,(24,9+64),"MultiPut2()",RGBA(0,0,255,127)
draw string img,(24,9+96),"MultiPut2()",RGBA(255,255,0,127)



dim as boolean transparent = true
dim as integer frames
while inkey()=""
  'screensync
  screenlock 
    line (0,0)-step(w-1,h-1),0,BF
    draw string (32,0),"Original"
    put  (0,8),img,alpha

    dim as single x=400
    for i as integer = 1 to 6
      dim as single scale = i
      x+=150+scale
      MultiPut_alpha32 ,x,440,img,scale,scale,rotation(i-1)*10,transparent
      rotation(6-i)+=i*.25
    next

  screenunlock
  frames+=1
  'if frames mod 60=0 then transparent=not transparent
  sleep 1
wend
sleep