MultiPut[DES],[x],[y],SRC,[xScale],[yScale],[Rotate],[Trans]

User projects written in or related to FreeBASIC.
RayBritton
Posts: 306
Joined: Jun 02, 2005 7:11
Contact:

Post by RayBritton »

Here's another version, containing everything so far, as well as simple alpha (created by D.J. Peters, not me, I just added it):

Code: Select all

' by D.J.Peters (Joshy)
' a put, scale, rotate hack for the new ImageHeader format.
'MultiPut [destination],[xmidpos],[ymidpos],source,[xScale],[yScale],[Mirror],[Flip],[Trans],[Custom],[Param]
' Small changes/additions by counting_pine (2007/04/27)
' Mirror and Flip parameters added by Cleber de Mattos Casali (2008/08/18)
' Alpha from D.J. Peters added by RayBritton (2008/11/07)

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

Sub 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 Mirror   As Integer = 0, _
             Byval Flipp   As Integer = 0, _
             Byval Trans    As Integer= 0, _
             Byval alphavalue As Integer = 255, _
             Byval Custom As Function(Byval Src As Uinteger, Byval Dest As Uinteger, Byval Param As Any Ptr = 0) As Uinteger = 0, _
             Byval Param As Any Ptr = 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
  
   'variables for the alpha blending
     Dim As Uinteger srb = Any
     Dim As Uinteger drb = Any
     Dim As Uinteger  rb = Any
     Dim As Uinteger sr = Any, sg = Any, sb = Any, sa = Any, sa2 = Any
     Dim As Uinteger dr = Any, dg = Any, db = Any, da = Any, da2 = Any
     Dim As Uinteger  r = Any,  g = Any,  b = Any,  a = Any

  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  = cptr(Ushort Ptr,lpSource)[0] And 7
    SourceWidth  = cptr(Ushort Ptr,lpSource)[0] Shr 3
    SourceHeight = cptr(Ushort Ptr,lpSource)[1]
    SourcePitch  = SourceWidth * SourceBytes
    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)

If Mirror Then Swap points(0,xt),points(1,xt) :Swap points(2,xt),points(3,xt)
If Flipp Then Swap points(0,yt),points(3,yt) :Swap points(2,yt),points(1,yt)
'if Mirror then swap points(1,xt),points(2,xt)
'if Flipp then swap points(2,yt),points(3,yt)


  Dim As Uinteger i
  Dim As Single x,y
  If MustRotate Then
    #ifndef UseRad
    Rotate*=Atn(1)/45 'degree 2 rad
    #endif
    While Rotate< 0       :rotate+=8*Atn(1):Wend
    While Rotate>=8*Atn(1):rotate-=8*Atn(1):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     t2c, s2c
  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 Custom Then
          While xStart<xEnd
            s1=lpSource+V*SourcePitch+U
            *t1=Custom(*s1,*t1,Param)
            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
        Elseif 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 Custom Then
          While xStart<xEnd
            s2=cptr(Short Ptr,lpSource)+V*(SourcePitch Shr 1)+U
            s2c=*s2
            t2c=*t2
            s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                (s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                (s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
            t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
                (t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
                (t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
            t2c=Custom(s2c,t2c,Param)
            *t2=(t2c Shr 3 And &H001F) Or _
                (t2c Shr 5 And &H07E0) Or _
                (t2c Shr 8 And &HF800)
            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
        Elseif 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 Custom Then
          While xStart<xEnd
            s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
            '***** start alpha blending
       'this set of if...elseif...end if conditions applies alpha blending
       'these 43 lines can be replaced with '*t4 = *s4' to remove blending
       If alphavalue = 0 Then
         'no change needed *t4 = *t4
       Elseif alphavalue = 255 Then
         *t4 = *s4
       Elseif *t4 Shr 24 = 0 Then
         *t4 = *s4
       Elseif *t4 Shr 24 = 255 Then
         srb = *s4 And &h00ff00ff
         sg  = *s4 Xor srb
         sa  = alphavalue

         drb = *t4 And &h00ff00ff
         dg  = *t4 Xor drb
         da  = 256 - sa

         rb = (drb * da + srb * sa) And &hff00ff00
         g  = (dg  * da + sg  * sa) And &h00ff0000

         *t4 = (rb Or g) Shr 8 Or &hff000000
       Else
         sr = (*s4 Shr 16) And 255
         sg = (*s4 Shr  8) And 255
         sb = (*s4       ) And 255
         sa = (alphavalue)

         dr = (*t4 Shr 16) And 255
         dg = (*t4 Shr  8) And 255
         db = (*t4       ) And 255
         da = (*t4 Shr 24)

         sa2 = sa Shl 8
         da2 = da Shl 8 - da * sa
         a = (sa2 + da2)

         r = (dr * da2 + sr * sa2) \ a
         g = (dg * da2 + sg * sa2) \ a
         b = (db * da2 + sb * sa2) \ a
         *t4 = Rgba(r, g, b, a Shr 8)
       End If
            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
        Elseif 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 And &HFFFFFF)<>&HFF00FF Then 
                '***** start alpha blending
         'this set of if...elseif...end if conditions applies alpha blending
         'these 43 lines can be replaced with '*t4 = *s4' to remove blending
         If alphavalue = 0 Then
           'no change needed *t4 = *t4
         Elseif alphavalue = 255 Then
           *t4 = *s4
         Elseif *t4 Shr 24 = 0 Then
           *t4 = *s4
         Elseif *t4 Shr 24 = 255 Then
           srb = *s4 And &h00ff00ff
           sg  = *s4 Xor srb
           sa  = alphavalue

           drb = *t4 And &h00ff00ff
           dg  = *t4 Xor drb
           da  = 256 - sa

           rb = (drb * da + srb * sa) And &hff00ff00
           g  = (dg  * da + sg  * sa) And &h00ff0000

           *t4 = (rb Or g) Shr 8 Or &hff000000
         Else
           sr = (*s4 Shr 16) And 255
           sg = (*s4 Shr  8) And 255
           sb = (*s4       ) And 255
           sa = (alphavalue)

           dr = (*t4 Shr 16) And 255
           dg = (*t4 Shr  8) And 255
           db = (*t4       ) And 255
           da = (*t4 Shr 24)

           sa2 = sa Shl 8
           da2 = da Shl 8 - da * sa
           a = (sa2 + da2)

           r = (dr * da2 + sr * sa2) \ a
           g = (dg * da2 + sg * sa2) \ a
           b = (db * da2 + sb * sa2) \ a
           *t4 = Rgba(r, g, b, a Shr 8)
         End If
         '***** end alpha blending
                end if
            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 Select

SkipScanLine:
    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
  Wend
If MustLock Then screenunlock
End Sub

Function Trans(Byval Src As Uinteger, Byval Dest As Uinteger, Byval Param As Any Ptr = 0) As Uinteger
   
    If (Src And &HFFFFFF) = &HFF00FF Then Return Dest Else Return Src
   
End Function
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Post by leopardpm »

RayBritton,
thank you for updating the routine... how do I use the 'alpha'? I am loading PNG files with alpha channels, they work fine with regular 'putting' with alpha - do I just use '255' in the function call at the 'alpha' parameter to use the sprites' alpha channel or is it something different?

Thanks again!

Edit: drats, just got off my lazy arse and did some testing... unless I am doing something wrong, the 'alpha' value applies to the entire sprite instead of accessing the alpha channel for a per pixel alpha blend... drats! I need per pixel alpha!
RayBritton
Posts: 306
Joined: Jun 02, 2005 7:11
Contact:

Post by RayBritton »

Yes, sorry it applies to the whole picture, and I didn't code it, D.J. Peters did, so I have no idea.
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Post by leopardpm »

anyone wanna take a stab at activating the Alpha Channel in this very versatile sprite function? That would just about make it perfect! Well, except that it is currently about 1/4 as fast as regular Put - but, it is fast enough for most uses!
creek23
Posts: 261
Joined: Sep 09, 2007 1:57
Location: Philippines
Contact:

Post by creek23 »

sorry, but I just wanted to bump this thread.

It's really pain in the a$$ to create art assets for an FB game that uses MultiPut -- let's face it, MultiPut rocks because it already handles rotation, scaling, flipping, and all that. Put only excels in its ability to blit alpha channel.

I dearly hope someone will pick and apply the alpha channel to MultiPut.

~creek23
creek23
Posts: 261
Joined: Sep 09, 2007 1:57
Location: Philippines
Contact:

Post by creek23 »

feels kind of weird but I guess I did it. here's the newly updated MultiPut that blits Alpha Channel of source image.

Now the native Put really $ucks! \m/

Code: Select all

' by D.J.Peters (Joshy)
' a put, scale, rotate hack for the new ImageHeader format.
'MultiPut [destination],[xmidpos],[ymidpos],source,[xScale],[yScale],[Mirror],[Flip],[Trans],[Custom],[Param]
' Small changes/additions by counting_pine (2007/04/27)
' Mirror and Flip parameters added by Cleber de Mattos Casali (2008/08/18)
' Alpha from D.J. Peters added by RayBritton (2008/11/07)
' Alpha Channel added by creek23 (Mj Mendoza IV) (2011/09/03)

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

Sub 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 Mirror	 As Integer = 0, _
				 Byval Flipp	 As Integer = 0, _
				 Byval Trans		As Integer= 0, _
				 Byval alphavalue As Integer = 255, _
				 Byval Custom As Function(Byval Src As Uinteger, Byval Dest As Uinteger, Byval Param As Any Ptr = 0) As Uinteger = 0, _
				 Byval Param As Any Ptr = 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
	
	'variables for the alpha blending
		 Dim As Uinteger srb = Any
		 Dim As Uinteger drb = Any
		 Dim As Uinteger	rb = Any
		 Dim As Uinteger sr = Any, sg = Any, sb = Any, sa = Any, sa2 = Any
		 Dim As Uinteger dr = Any, dg = Any, db = Any, da = Any, da2 = Any
		 Dim As Uinteger	r = Any,	g = Any,	b = Any,	a = Any
	
	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	= cptr(Ushort Ptr,lpSource)[0] And 7
		SourceWidth	= cptr(Ushort Ptr,lpSource)[0] Shr 3
		SourceHeight = cptr(Ushort Ptr,lpSource)[1]
		SourcePitch	= SourceWidth * SourceBytes
		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)
	
If Mirror Then Swap points(0,xt),points(1,xt) :Swap points(2,xt),points(3,xt)
If Flipp Then Swap points(0,yt),points(3,yt) :Swap points(2,yt),points(1,yt)
'if Mirror then swap points(1,xt),points(2,xt)
'if Flipp then swap points(2,yt),points(3,yt)
	
	
	Dim As Uinteger i
	Dim As Single x,y
	If MustRotate Then
		#ifndef UseRad
		Rotate*=Atn(1)/45 'degree 2 rad
		#endif
		While Rotate< 0			 :rotate+=8*Atn(1):Wend
		While Rotate>=8*Atn(1):rotate-=8*Atn(1):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		 t2c, s2c
	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 Custom Then
					While xStart<xEnd
						s1=lpSource+V*SourcePitch+U
						*t1=Custom(*s1,*t1,Param)
						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
				Elseif 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 Custom Then
					While xStart<xEnd
						s2=cptr(Short Ptr,lpSource)+V*(SourcePitch Shr 1)+U
						s2c=*s2
						t2c=*t2
						s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
								(s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
								(s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
						t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
								(t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
								(t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
						t2c=Custom(s2c,t2c,Param)
						*t2=(t2c Shr 3 And &H001F) Or _
								(t2c Shr 5 And &H07E0) Or _
								(t2c Shr 8 And &HF800)
						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
				Elseif 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 Custom Then
					While xStart<xEnd
						s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
						'***** start alpha blending
						'this set of if...elseif...end if conditions applies alpha blending
						'these 43 lines can be replaced with '*t4 = *s4' to remove blending
						If alphavalue = 0 Then
							'no change needed *t4 = *t4
						Elseif alphavalue = 255 Then
							*t4 = *s4
						Elseif *t4 Shr 24 = 0 Then
							*t4 = *s4
						Elseif *t4 Shr 24 = 255 Then
							srb = *s4 And &h00ff00ff
							sg	= *s4 Xor srb
							sa	= alphavalue
							
							drb = *t4 And &h00ff00ff
							dg	= *t4 Xor drb
							da	= 256 - sa
							
							rb = (drb * da + srb * sa) And &hff00ff00
							g	= (dg	* da + sg	* sa) And &h00ff0000
							
							*t4 = (rb Or g) Shr 8 Or &hff000000
						Else
							sr = (*s4 Shr 16) And 255
							sg = (*s4 Shr	8) And 255
							sb = (*s4			 ) And 255
							sa = (alphavalue)
							
							dr = (*t4 Shr 16) And 255
							dg = (*t4 Shr	8) And 255
							db = (*t4			 ) And 255
							da = (*t4 Shr 24)
							
							sa2 = sa Shl 8
							da2 = da Shl 8 - da * sa
							a = (sa2 + da2)
							
							r = (dr * da2 + sr * sa2) \ a
							g = (dg * da2 + sg * sa2) \ a
							b = (db * da2 + sb * sa2) \ a
							*t4 = Rgba(r, g, b, a Shr 8)
						End If
						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
				Elseif 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 And &HFFFFFF)<>&HFF00FF Then
							'***** start alpha blending
							'this set of if...elseif...end if conditions applies alpha blending
							'these 43 lines can be replaced with '*t4 = *s4' to remove blending
							If alphavalue = 0 Then
								'no change needed *t4 = *t4
							Elseif alphavalue = 255 Then
								*t4 = *s4
							Elseif alphavalue = -1 Then
								sr = (*s4 Shr 16) And 255
								sg = (*s4 Shr	8) And 255
								sb = (*s4			 ) And 255
								sa = (*s4 Shr 24)
								
								dr = (*t4 Shr 16) And 255
								dg = (*t4 Shr	8) And 255
								db = (*t4			 ) And 255
								da = (*t4 Shr 24)
									
								If (sa = 255) Then
									*t4 = Rgba(sr, sg, sb, sa)
								Else
									sa2 = sa Shl 8
									da2 = da Shl 8 - da * sa
									a = (sa2 + da2)
									
									r = (dr * da2 + sr * sa2) \ a
									g = (dg * da2 + sg * sa2) \ a
									b = (db * da2 + sb * sa2) \ a
									*t4 = Rgba(r, g, b, a Shr 8)
								EndIf
							Elseif *t4 Shr 24 = 0 Then
								*t4 = *s4
							Elseif *t4 Shr 24 = 255 Then
								srb = *s4 And &h00ff00ff
								sg	= *s4 Xor srb
								sa	= alphavalue

								drb = *t4 And &h00ff00ff
								dg	= *t4 Xor drb
								da	= 256 - sa

								rb = (drb * da + srb * sa) And &hff00ff00
								g	= (dg	* da + sg	* sa) And &h00ff0000

								*t4 = (rb Or g) Shr 8 Or &hff000000
							Else
								sr = (*s4 Shr 16) And 255
								sg = (*s4 Shr	8) And 255
								sb = (*s4			 ) And 255
								sa = (alphavalue)
								
								dr = (*t4 Shr 16) And 255
								dg = (*t4 Shr	8) And 255
								db = (*t4			 ) And 255
								da = (*t4 Shr 24)
								
								sa2 = sa Shl 8
								da2 = da Shl 8 - da * sa
								a = (sa2 + da2)
								
								r = (dr * da2 + sr * sa2) \ a
								g = (dg * da2 + sg * sa2) \ a
								b = (db * da2 + sb * sa2) \ a
								*t4 = Rgba(r, g, b, a Shr 8)
							End If
							'***** end alpha blending
						End If
						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 Select

SkipScanLine:
		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
	Wend
	If MustLock Then screenunlock
End Sub

Function Trans(Byval Src As Uinteger, Byval Dest As Uinteger, Byval Param As Any Ptr = 0) As Uinteger
   
    If (Src And &HFFFFFF) = &HFF00FF Then Return Dest Else Return Src
   
End Function
~creek23
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Post by leopardpm »

good job creek! i will test it out next time i need to blit!
creek23
Posts: 261
Joined: Sep 09, 2007 1:57
Location: Philippines
Contact:

Post by creek23 »

leopardpm, setting alphavalue to -1 should blit the alpha channel. However, with this current hack I did, MultiPut lost the alpha blending.

I'm still currently working on keeping the alphablending while having the alpha channel blit functionality.

~creek23
creek23
Posts: 261
Joined: Sep 09, 2007 1:57
Location: Philippines
Contact:

Post by creek23 »

got it!

I added a new paramater called alphachannel, this is basically a flag if you wanted to use stored alpha channel to your 32bpp image.

you can still use alphavalue parameter to alphablend the alphachannel-blitted image. ;)

Code: Select all

' by D.J.Peters (Joshy)
' a put, scale, rotate hack for the new ImageHeader format.
'MultiPut [destination],[xmidpos],[ymidpos],source,[xScale],[yScale],[Mirror],[Flip],[Trans],[Custom],[Param]
' Small changes/additions by counting_pine (2007/04/27)
' Mirror and Flip parameters added by Cleber de Mattos Casali (2008/08/18)
' Alpha from D.J. Peters added by RayBritton (2008/11/07)
' Alpha Channel added by creek23 (Mj Mendoza IV) (2011/09/03)

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

Sub 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 Mirror	 As Integer = 0, _
					 Byval Flipp	 As Integer = 0, _
					 Byval Trans		As Integer= 0, _
					 Byval alphavalue As Integer = 255, _
					 Byval alphachannel As Integer = 1, _
					 Byval Custom As Function(Byval Src As Uinteger, Byval Dest As Uinteger, Byval Param As Any Ptr = 0) As Uinteger = 0, _
					 Byval Param As Any Ptr = 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
	
	'variables for the alpha blending
		 Dim As Uinteger srb = Any
		 Dim As Uinteger drb = Any
		 Dim As Uinteger	rb = Any
		 Dim As Uinteger sr = Any, sg = Any, sb = Any, sa = Any, sa2 = Any
		 Dim As Uinteger dr = Any, dg = Any, db = Any, da = Any, da2 = Any
		 Dim As Uinteger	r = Any,	g = Any,	b = Any,	a = Any
		 Dim As Uinteger	sc = Any 'source (alpha) channel
	
	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	= cptr(Ushort Ptr,lpSource)[0] And 7
		SourceWidth	= cptr(Ushort Ptr,lpSource)[0] Shr 3
		SourceHeight = cptr(Ushort Ptr,lpSource)[1]
		SourcePitch	= SourceWidth * SourceBytes
		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)
	
If Mirror Then Swap points(0,xt),points(1,xt) :Swap points(2,xt),points(3,xt)
If Flipp Then Swap points(0,yt),points(3,yt) :Swap points(2,yt),points(1,yt)
'if Mirror then swap points(1,xt),points(2,xt)
'if Flipp then swap points(2,yt),points(3,yt)
	
	
	Dim As Uinteger i
	Dim As Single x,y
	If MustRotate Then
		#ifndef UseRad
		Rotate*=Atn(1)/45 'degree 2 rad
		#endif
		While Rotate< 0			 :rotate+=8*Atn(1):Wend
		While Rotate>=8*Atn(1):rotate-=8*Atn(1):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		 t2c, s2c
	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 Custom Then
					While xStart<xEnd
						s1=lpSource+V*SourcePitch+U
						*t1=Custom(*s1,*t1,Param)
						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
				Elseif 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 Custom Then
					While xStart<xEnd
						s2=cptr(Short Ptr,lpSource)+V*(SourcePitch Shr 1)+U
						s2c=*s2
						t2c=*t2
						s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
								(s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
								(s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
						t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
								(t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
								(t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
						t2c=Custom(s2c,t2c,Param)
						*t2=(t2c Shr 3 And &H001F) Or _
								(t2c Shr 5 And &H07E0) Or _
								(t2c Shr 8 And &HF800)
						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
				Elseif 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 Custom Then
					While xStart<xEnd
						s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
						'***** start alpha blending
						'this set of if...elseif...end if conditions applies alpha blending
						'these 43 lines can be replaced with '*t4 = *s4' to remove blending
						If alphavalue = 0 Then
							'no change needed *t4 = *t4
						Elseif alphavalue = 255 Then
							*t4 = *s4
						Elseif *t4 Shr 24 = 0 Then
							*t4 = *s4
						Elseif *t4 Shr 24 = 255 Then
							srb = *s4 And &h00ff00ff
							sg	= *s4 Xor srb
							sa	= alphavalue
							
							drb = *t4 And &h00ff00ff
							dg	= *t4 Xor drb
							da	= 256 - sa
							
							rb = (drb * da + srb * sa) And &hff00ff00
							g	= (dg	* da + sg	* sa) And &h00ff0000
							
							*t4 = (rb Or g) Shr 8 Or &hff000000
						Else
							sr = (*s4 Shr 16) And 255
							sg = (*s4 Shr	8) And 255
							sb = (*s4       ) And 255
							sa = (alphavalue)
							
							dr = (*t4 Shr 16) And 255
							dg = (*t4 Shr	8) And 255
							db = (*t4       ) And 255
							da = (*t4 Shr 24)
							
							sa2 = sa Shl 8
							da2 = da Shl 8 - da * sa
							a = (sa2 + da2)
							
							r = (dr * da2 + sr * sa2) \ a
							g = (dg * da2 + sg * sa2) \ a
							b = (db * da2 + sb * sa2) \ a
							*t4 = Rgba(r, g, b, a Shr 8)
						End If
						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
				Elseif Trans=0 Then
					While xStart<xEnd
						s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
						'***** start alpha blending
						'this set of if...elseif...end if conditions applies alpha blending
						'these 43 lines can be replaced with '*t4 = *s4' to remove blending
						If alphavalue = 0 Then
							'no change needed *t4 = *t4
						Elseif alphavalue = 255 And alphachannel = 0 Then
							*t4 = *s4
						Elseif alphavalue = 255 And alphachannel = 1 Then
							sr = (*s4 Shr 16) And 255
							sg = (*s4 Shr	8) And 255
							sb = (*s4       ) And 255
							sa = (*s4 Shr 24)
							
							dr = (*t4 Shr 16) And 255
							dg = (*t4 Shr	8) And 255
							db = (*t4       ) And 255
							da = (*t4 Shr 24)
							
							If (sa = 255) Then
								*t4 = Rgba(sr, sg, sb, sa)
							Else
								sa2 = sa Shl 8
								da2 = da Shl 8 - da * sa
								a = (sa2 + da2)
								
								r = (dr * da2 + sr * sa2) \ a
								g = (dg * da2 + sg * sa2) \ a
								b = (db * da2 + sb * sa2) \ a
								*t4 = Rgba(r, g, b, a Shr 8)
							EndIf
						ElseIf alphavalue > 0 And alphachannel = 1 Then
							sr = (*s4 Shr 16) And 255
							sg = (*s4 Shr	8) And 255
							sb = (*s4       ) And 255
							sc = (*s4 Shr 24)
							sa = sc * (alphavalue / 255)
							
							dr = (*t4 Shr 16) And 255
							dg = (*t4 Shr	8) And 255
							db = (*t4       ) And 255
							da = (*t4 Shr 24)
							
							sa2 = sa Shl 8
							da2 = da Shl 8 - da * sa
							a = (sa2 + da2)
							
							r = (dr * da2 + sr * sa2) \ a
							g = (dg * da2 + sg * sa2) \ a
							b = (db * da2 + sb * sa2) \ a
							*t4 = Rgba(r, g, b, a Shr 8)
						Elseif *t4 Shr 24 = 0 Then
							*t4 = *s4
						Elseif *t4 Shr 24 = 255 Then
							srb = *s4 And &h00ff00ff
							sg	= *s4 Xor srb
							sa	= alphavalue
							
							drb = *t4 And &h00ff00ff
							dg	= *t4 Xor drb
							da	= 256 - sa
							
							rb = (drb * da + srb * sa) And &hff00ff00
							g	= (dg	* da + sg	* sa) And &h00ff0000
							
							*t4 = (rb Or g) Shr 8 Or &hff000000
						Else
							sr = (*s4 Shr 16) And 255
							sg = (*s4 Shr	8) And 255
							sb = (*s4       ) And 255
							sa = (alphavalue)
							
							dr = (*t4 Shr 16) And 255
							dg = (*t4 Shr	8) And 255
							db = (*t4       ) And 255
							da = (*t4 Shr 24)
							
							sa2 = sa Shl 8
							da2 = da Shl 8 - da * sa
							a = (sa2 + da2)
							
							r = (dr * da2 + sr * sa2) \ a
							g = (dg * da2 + sg * sa2) \ a
							b = (db * da2 + sb * sa2) \ a
							*t4 = Rgba(r, g, b, a Shr 8)
						End If
						'***** end alpha blending
						
						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 And &HFFFFFF)<>&HFF00FF Then
							'***** start alpha blending
							'this set of if...elseif...end if conditions applies alpha blending
							'these 43 lines can be replaced with '*t4 = *s4' to remove blending
							If alphavalue = 0 Then
								'no change needed *t4 = *t4
							Elseif alphavalue = 255 And alphachannel = 0 Then
								*t4 = *s4
							Elseif alphavalue = 255 And alphachannel = 1 Then
								sr = (*s4 Shr 16) And 255
								sg = (*s4 Shr	8) And 255
								sb = (*s4       ) And 255
								sa = (*s4 Shr 24)
								
								dr = (*t4 Shr 16) And 255
								dg = (*t4 Shr	8) And 255
								db = (*t4       ) And 255
								da = (*t4 Shr 24)
								
								If (sa = 255) Then
									*t4 = Rgba(sr, sg, sb, sa)
								Else
									sa2 = sa Shl 8
									da2 = da Shl 8 - da * sa
									a = (sa2 + da2)
									
									r = (dr * da2 + sr * sa2) \ a
									g = (dg * da2 + sg * sa2) \ a
									b = (db * da2 + sb * sa2) \ a
									*t4 = Rgba(r, g, b, a Shr 8)
								EndIf
							ElseIf alphavalue > 0 And alphachannel = 1 Then
								sr = (*s4 Shr 16) And 255
								sg = (*s4 Shr	8) And 255
								sb = (*s4       ) And 255
								sc = (*s4 Shr 24)
								sa = sc * (alphavalue / 255)
								
								dr = (*t4 Shr 16) And 255
								dg = (*t4 Shr	8) And 255
								db = (*t4       ) And 255
								da = (*t4 Shr 24)
								
								sa2 = sa Shl 8
								da2 = da Shl 8 - da * sa
								a = (sa2 + da2)
								
								r = (dr * da2 + sr * sa2) \ a
								g = (dg * da2 + sg * sa2) \ a
								b = (db * da2 + sb * sa2) \ a
								*t4 = Rgba(r, g, b, a Shr 8)
							Elseif *t4 Shr 24 = 0 Then
								*t4 = *s4
							Elseif *t4 Shr 24 = 255 Then
								srb = *s4 And &h00ff00ff
								sg	= *s4 Xor srb
								sa	= alphavalue
								
								drb = *t4 And &h00ff00ff
								dg	= *t4 Xor drb
								da	= 256 - sa
								
								rb = (drb * da + srb * sa) And &hff00ff00
								g	= (dg	* da + sg	* sa) And &h00ff0000
								
								*t4 = (rb Or g) Shr 8 Or &hff000000
							Else
								sr = (*s4 Shr 16) And 255
								sg = (*s4 Shr	8) And 255
								sb = (*s4       ) And 255
								sa = (alphavalue)
								
								dr = (*t4 Shr 16) And 255
								dg = (*t4 Shr	8) And 255
								db = (*t4       ) And 255
								da = (*t4 Shr 24)
								
								sa2 = sa Shl 8
								da2 = da Shl 8 - da * sa
								a = (sa2 + da2)
								
								r = (dr * da2 + sr * sa2) \ a
								g = (dg * da2 + sg * sa2) \ a
								b = (db * da2 + sb * sa2) \ a
								*t4 = Rgba(r, g, b, a Shr 8)
							End If
							'***** end alpha blending
						End If
						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 Select

SkipScanLine:
		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
	Wend
	If MustLock Then screenunlock
End Sub

Function Trans(Byval Src As Uinteger, Byval Dest As Uinteger, Byval Param As Any Ptr = 0) As Uinteger
   
    If (Src And &HFFFFFF) = &HFF00FF Then Return Dest Else Return Src
   
End Function
~creek23
qbasic
Posts: 20
Joined: May 15, 2009 13:12

multiput

Post by qbasic »

Hi everyone.
I am trying to use multiput in a view port but it dose not seem to recognize the boundaries.
Is this not possible or am I doing it wrong .
This is what I am trying.

Code: Select all

screen 21,32
#include once "multiput1.bas"

dim shared as any ptr map
dim shared as double xzoom,yzoom,rotates
dim shared as integer x,y,z,x_info,y_info
dim shared as integer x_pos,y_pos
dim shared as integer mx,my,mw,mb
dim shared as integer mxwas,mywas,mwwas,mbwas

'Get the size of the image
If Open( "england.bmp" For Binary As #1) Then
    print "File not found":sleep
  Else
    Get #1, 19, x
    Get #1, 23, y
    get #1, 29, z
    Close #1
  End If
map=imagecreate(x,y)
xzoom = 1.2
yzoom = 1.2
rotates = 0
screeninfo x_info,y_info
x_pos = x_info / 2 + 160
y_pos = y_info / 2 - 6
If Bload ("england.bmp",map) <> 0 Then Print "bomb Not Loaded" : Sleep
cls
window
view  (320,0)-(1279,1023),1
MultiPut(,x_pos,y_pos,map,xZoom,yZoom,Rotates,0)
do until inkey <> ""
    mwwas = mw
    getmouse mx,my,mw,mb
    
    if mb = 1 then
        mxwas = mx : mywas = my
        do until mb = 0
        getmouse mx,my,mw,mb
        
        
        if mx <> mxwas or my <> mywas then
            screenlock
            
            x_pos +=(mx - mxwas)
            y_pos +=(my - mywas)
            cls 1
            MultiPut(,x_pos,y_pos,map,xZoom,yZoom,Rotates,0)
        
            screenunlock
            mxwas = mx : mywas = my
        end if
        loop
    end if
    if mw <> mwwas then
        if mw > mwwas then
            xzoom +=.1
            yzoom +=.1
            x_pos -=(10*xzoom)
            y_pos -=(10*yzoom)
        else 
            xzoom -=.1
            yzoom -=.1
            x_pos +=(10*xzoom)
            y_pos +=(10*yzoom)
        end if
        if xzoom <.1 then xzoom = .1
        if yzoom <.1 then yzoom = .1
        if xzoom > 15 then xzoom = 15
        if yzoom > 15 then yzoom = 15
        mwwas = mw
        
        cls 1
        
        MultiPut(,x_pos,y_pos,map,xZoom,yZoom,Rotates,0)
        cls 1
    end if
    

loop
counting_pine
Site Admin
Posts: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: MultiPut[DES],[x],[y],SRC,[xScale],[yScale],[Rotate],[Tr

Post by counting_pine »

From a quick re-read through the Multiput source, it uses pointers to write to the screen buffer instead of primitives such as Pset. This makes it a lot faster, but it also means it doesn't respect the View restrictions that affect the normal primitives.

There are a few possible solutions I can think of to this:
1. rewrite Multiput to use Pset instead (though you will take a speed hit due to the extra processing done by Pset)
2. add code to Multiput to clip the result to a given set of boundaries (you'll have to pass in the boundaries manually because I don't think there's any way to find out what the View boundaries are once they're set)
3. perform the Multiput command on an intermediate buffer, then Put the buffer, and Put should respect the View boundaries. It will take more time and memory though, and you may run into transparency-related issues.

If you can manage it, I would probably favour the second option. It might not be too hard - it looks like it might be enough just to add the extra clipping parameters, and change as needed the comparisons with 0 and TargetWidth/TargetHeight.
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: MultiPut[DES],[x],[y],SRC,[xScale],[yScale],[Rotate],[Tr

Post by Gonzo »

i also recommend using multiput on a buffer... any buffer
it also leaves the option to blend the result onto a backbuffer =)
N3trunn3r
Posts: 110
Joined: Feb 14, 2008 15:48

Re: MultiPut[DES],[x],[y],SRC,[xScale],[yScale],[Rotate],[Tr

Post by N3trunn3r »

I get a floating point error when drawing over another image that uses alpha channel as well. Don't know why.

Code: Select all

#include once "fbgfx.bi"
#include once "pload2.bas"
#include once "multiput_alpha.bas"

screenres 1024,768,32,1

dim shared as any ptr img_test, img_bg
img_test=pload2("test.png")
img_bg=pload2("desert_01.png")

do
    
    screenlock:cls
    
    'put (0,96),img_bg,pset  'this works!
     put (0,96),img_bg,trans 'but not this! I get "error 11, floating point error in MULTIPUT"
    MultiPut(,500,100,img_test,,,,,,0,,1)'I think the error is in multiput with alpha channel, but why?
    'MultiPut(,500,100,img_test,,,,,,1,,0)'this works with either, pset and trans on "img_bg"
    
    screenunlock:sleep 10,1
    
loop
Here is the ZIP with all files needed: http://catbone.freebasic.net/pub/Multiput_error.zip
counting_pine
Site Admin
Posts: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: MultiPut[DES],[x],[y],SRC,[xScale],[yScale],[Rotate],[Tr

Post by counting_pine »

Compiling with -g and running in gdb, I get:

Code: Select all

Program received signal SIGFPE, Arithmetic exception.
0x00403918 in MULTIPUT (LPTARGET=0x8e0030, XMIDPOS=500, YMIDPOS=100,
    LPSOURCE=0x10c4080, XSCALE=1, YSCALE=1, ROTATE=0, MIRROR=0, FLIPP=0,
    TRANS=0, ALPHAVALUE=255, ALPHACHANNEL=1, CUSTOM=0, PARAM=0x0)
    at R:\MULTIPUT_ERROR\MULTIPUT ERROR\MULTIPUT_ALPHA.BAS:394
394                             r = (dr * da2 + sr * sa2) \ a
More info could probably be gained with a graphical debugger or someone who knows their way around gdb better than I do.
dkl
Site Admin
Posts: 3235
Joined: Jul 28, 2005 14:45
Location: Germany

Re: MultiPut[DES],[x],[y],SRC,[xScale],[yScale],[Rotate],[Tr

Post by dkl »

It seems to be a division by zero error, the variable a is zero, apparently it's caused by both source/destination pixels having a zero alpha value (source rgba(255,255,255,0), destination rgba(63,93,161,0)):

Code: Select all

Program received signal SIGFPE, Arithmetic exception.
0x0804d720 in MULTIPUT (LPTARGET=<error reading variable>, 
    XMIDPOS=<error reading variable>, YMIDPOS=<error reading variable>, 
    LPSOURCE=<error reading variable>, XSCALE=<error reading variable>, 
    YSCALE=<error reading variable>, ROTATE=<error reading variable>, 
    MIRROR=<error reading variable>, FLIPP=<error reading variable>, 
    TRANS=<error reading variable>, ALPHAVALUE=<error reading variable>, 
    ALPHACHANNEL=<error reading variable>, CUSTOM=<error reading variable>, 
    PARAM=<error reading variable>)
    at /home/daniel/Downloads/Multiput error/multiput_alpha.bas:394
394	                        r = (dr * da2 + sr * sa2) \ a
(gdb) show A
Ambiguous show command "A": .
(gdb) print A
$1 = 0
(gdb) print SA2
$2 = 0
(gdb) print DA2
$3 = 0
(gdb) print SA
$4 = 0
(gdb) print DA
$5 = 0
(gdb) print SR
$6 = 255
(gdb) print SG
$7 = 255
(gdb) print SB
$8 = 255
(gdb) print SA
$9 = 0
(gdb) print DR
$10 = 63
(gdb) print DG
$11 = 93
(gdb) print DB
$12 = 161
(gdb) print DA
$13 = 0
Post Reply