AI TANKS first draft

[BasicCoder2]

This is a first draft of an AI tank simulation.
It makes use of Joshy's multiput.bi program to rotate the images.

In this example the turret just keeps slowly turning while randomly firing a bullet if one is available. When a tank hits an obstacle (another tank or a wall) it does a random turn away from the obstacle. When a bullet hits a brown tile (building) the tile is removed. When a bullet hits another tank the collision circle's color turns magenta.

Edit: changed multiput.bi to latest version

'multiput.bi

Code: Select all

#ifndef __MULTIPUT_BI__
#define __MULTIPUT_BI__

' Multiput by D.J.Peters (Joshy)
' MultiPut [destination],[xmidpos],[ymidpos], source,[xScale],[yScale],[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(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 Then *t=c
          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)
          If c<>&HFFFF00FF Then *t=c
          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__

'Demo program

Code: Select all

#include "multiput.bi"

const Pi = 4 * Atn(1)
Dim Shared As single TwoPi = 8 * Atn(1)
Dim Shared As single RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As single DtoR = Pi / 180   ' degrees * DtoR = radians

'======== SET SCREEN SIZE, INK AND PAPER COLOR ====================
const SCRW = 1024
const SCRH = 480
screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(100,255,100):cls

'bitmaps used
dim shared as any ptr TB,TT
TB = imagecreate(35,35)
'  bload "tankBody.bmp",TB
TT = imagecreate(35,35)
'  bload "tankTurret.bmp",TT
dim shared as any ptr backGround
backGround = imagecreate(1024,480)
' bload "backGround2.bmp",backGround

dim as ulong colors( 6)
colors(0)=RGB(255,0,255)
colors(1)=RGB(0,0,0)
colors(2)=RGB(166,202,240)
colors(3)=RGB(0,160,192)
colors(4)=RGB(192,192,192)
colors(5)=RGB(128,128,128)
dim as integer n
for j as integer = 0 to  34
    for i as integer = 0 to  34
        read n
        pset TT,(i,j),colors(n)
    next i
next j
for j as integer = 0 to  34
    for i as integer = 0 to  34
        read n
        pset TB,(i,j),colors(n)
    next i
next j

'create background bitmap from world tile id array
for j as integer = 0 to 14
    for i as integer = 0 to 31
        read n
        if n = 1 then
            line backGround,(i*32,j*32)-(i*32+31,j*32+31),rgb(128,64,0),bf
        else
            line backGround,(i*32,j*32)-(i*32+31,j*32+31),rgb(255,255,255),bf
        end if
    next i
next j
   

const TOTAL_TANKS = 8  'number of tanks on the field

type BULLET
    as single x      'x position of center of disc
    as single y      'y position of center of disc
    as single dx     'change in x position per cycle
    as single dy     'change in y position per cycle
    as single v      'speed restricted to -1.0 to +1.0
    as single rad    'radius of bullet image
    as single angle  'direction in degrees
    as ulong  c      'color of bullet image
    as integer alive 'bullet exists or not
end type

type TANK
    as single x          'x position of center of disc
    as single y          'y position of center of disc
    as single dx         'change in x position per cycle
    as single dy         'change in y position per cycle
    as single v          'speed restricted to -1.0 to +1.0
    as single rad        'radius of collision circle around center of image
    as single angle1      'direction in degrees
    as single angle2      'direction of turret
    as ulong  c          'color of DISC
    as integer task      'current task being done by agent
    as integer ID        'ID of agent
    as integer lastAngle 'memory for agent during collision evasion
    as integer hitWall   'memory for agent
    as integer hittank  'memory for agent
end type


dim shared as TANK r(1 to TOTAL_TANKS)
'initialize tanks
for i as integer = 1 to 4
    r(i).x = 42
    r(i).y = i*42+140+50
    r(i).v = 1   'moving forward
    r(i).angle1 = int(rnd(1)*360) 'random direction of travel
    r(i).angle2 = int(rnd(1)*360) 'random direction of turret
    r(i).rad = 18
    r(i).ID  = i
    'r(i).c = rgb(int(rnd(1)*256),int(rnd(1)*256),int(rnd(1)*256))
    r(i).c = rgb(100,255,100)
next i

for i as integer = 5 to 8
    r(i).x = SCRW-42
    r(i).y = (i-4)*42+140+50
    r(i).v = 1   'moving forward
    r(i).angle1 = int(rnd(1)*360) 'random direction of travel
    r(i).angle2 = int(rnd(1)*360) 'random direction of turret
    r(i).rad = 18
    r(i).ID  = i
    'r(i).c = rgb(int(rnd(1)*256),int(rnd(1)*256),int(rnd(1)*256))
    r(i).c = rgb(100,100,255)
next i

dim shared as BULLET b1(1 to TOTAL_TANKS)
for i as integer = 1 to TOTAL_TANKS

    b1(i).v = 0
    b1(i).rad = 3
    b1(i).c = r(i).c
    b1(i).alive = 0   'not fired
    
next i


sub display()
    screenlock
    cls
    put (0,0),backGround,trans

    for i as integer = 1 to TOTAL_TANKS
        circle (r(i).x,r(i).y),r(i).rad,r(i).c,,,,f
        circle (r(i).x,r(i).y),r(i).rad,rgb(0,0,0)
        line (r(i).x,r(i).y)-(r(i).x + cos(r(i).angle1 * DtoR)*r(i).rad,r(i).y + sin(r(i).angle1 * DtoR)*r(i).rad),rgb(0,0,0)
        draw string (r(i).x-r(i).rad,r(i).y-r(i).rad),str(i)
        multiput 0,r(i).x,r(i).y,TB,1,1,r(i).angle1,1
        multiput 0,r(i).x,r(i).y,TT,1,1,r(i).angle2+r(i).angle1,1

        if b1(i).alive = 1 then
            circle (b1(i).x,b1(i).y),b1(i).rad,b1(i).c,,,,f
            circle (b1(i).x,b1(i).y),b1(i).rad,rgb(0,0,0)
        end if
    next i

    screenunlock
end sub


dim as single frameTimer
frameTimer = timer

dim as integer count = 1
do
    

    if timer > frameTimer + 0.005 then
        frameTimer = timer

        
        'TEST FOR COLLISIONS
        for i as integer = 1 to TOTAL_TANKS 
            
            'compute value to add to dx,dy for a given speed and direction
            b1(i).dx = cos(b1(i).angle * DtoR) * b1(i).v
            b1(i).dy = sin(b1(i).angle * DtoR) * b1(i).v            
            'move BULLET
            b1(i).x = b1(i).x + b1(i).dx
            b1(i).y = b1(i).y + b1(i).dy
            
            'compute value to add to dx,dy for a given speed and direction
            r(i).dx = cos(r(i).angle1 * DtoR) * r(i).v
            r(i).dy = sin(r(i).angle1 * DtoR) * r(i).v            
            'move tank
            r(i).x = r(i).x + r(i).dx
            r(i).y = r(i).y + r(i).dy
            
            'was there any contact with another tank?
            for j as integer = 1 to TOTAL_TANKS
                if i<>j then  'don't compare with self
                    if sqr( (r(i).x - r(j).x)^2 + (r(i).y - r(j).y)^2) <= r(i).rad*2 then
                        r(i).x = r(i).x - r(i).dx
                        r(i).y = r(i).y - r(i).dy
                        r(i).angle1 = r(i).angle1 + 1
                        if r(i).angle1 > 360 then r(i).angle1 = r(i).angle1-360
                        r(i).hittank = 1 'flag it hit a tank
                    end if
                end if
            next j
            
            'scan around tank for background hit
            dim as integer hit
            dim as single dx,dy
            hit = 0
            for ca as single = 0 to 359 step 10
                dx = cos(ca*DtoR) * 17
                dy = sin(ca*DtoR) * 17
                if point(r(i).x + dx, r(i).y + dy, backGround)<>rgb(255,255,255) then
                    hit = 1
                end if
            next ca
            
            if hit = 1 then
                'set exit angle, lastAngle, if first hit
                if r(i).hitWall = 0 then
                    r(i).lastAngle = r(i).angle1 +160
                    if r(i).lastAngle > 360 then r(i).lastAngle = r(i).lastAngle-360
                end if
                r(i).x = r(i).x - r(i).dx
                r(i).y = r(i).y - r(i).dy
                r(i).v = 0  'turn off motors
                r(i).hitWall = 1   'flag it hit a wall
            end if                    
            
            'was there any contact with screen boundary?
            if r(i).x <= r(i).rad or r(i).x >= SCRW-r(i).rad or r(i).y <= r(i).rad or r(i).y >= SCRH-r(i).rad then
                'set exit angle, lastAngle, if first hit
                if r(i).hitWall = 0 then
                    r(i).lastAngle = r(i).angle1 +160
                    if r(i).lastAngle > 360 then r(i).lastAngle = r(i).lastAngle-360
                end if
                r(i).x = r(i).x - r(i).dx
                r(i).y = r(i).y - r(i).dy
                r(i).v = 0  'turn off motors
                r(i).hitWall = 1   'flag it hit a wall
            end if
            
            if r(i).hitWall = 1 then
                if r(i).angle1 <> r(i).lastAngle then
                    r(i).angle1 = r(i).angle1 + 1
                    if r(i).angle1 > 360 then r(i).angle1 = r(i).angle1 - 360
                else
                    r(i).hitWall = 0
                    r(i).v = 1  'start up motors
                end if
            end if
            
            r(i).angle2 = r(i).angle2 + .1  'rotate turret
            
            'if bullet not in use random fire bullet
            if int(rnd(1)*550)=1 and b1(i).alive = 0 then
                b1(i).alive = 1
                b1(i).v = 2
                b1(i).angle = r(i).angle1 + r(i).angle2
                'if b1(i).angle > 359 then b1(i).angle = b1(i).angle - 360
                b1(i).x =  r(i).x + cos(b1(i).angle * DtoR)*18  'end of turret
                b1(i).y =  r(i).y + sin(b1(i).angle * DtoR)*18
            end if
            
            'did bullet hit a tile?
            dim as ulong v
            dim as integer tileX,tileY
            if b1(i).alive = 1 then
                v = point(b1(i).x,b1(i).y,backGround)
                if b1(i).x>SCRW or b1(i).x<0 or b1(i).y>SCRH or b1(i).y<0 or point(b1(i).x,b1(i).y,backGround) <> rgb(255,255,255) then
                    b1(i).alive = 0
                    if v = rgb(128,64,0) then
                        tileX = b1(i).x\32
                        tileY = b1(i).y\32
                        line backGround,(tileX*32,tileY*32)-(tileX*32+31,tileY*32+31),rgb(255,255,255),bf
                        'circle backGround,(b1(i).x,b1(i).y),13,rgb(255,255,255),,,,f
                    end if
                end if
            end if
            
            'bullet connect with tank?
            for j as integer = 1 to TOTAL_TANKS
                if j<>i then  'not bullet of this tank
                    if sqr( (b1(i).x - r(j).x)^2 + (b1(i).y - r(j).y)^2) <= r(i).rad*2 then
                        r(j).c = rgb(255,0,255)
                        b1(i).alive = 0
                    end if
                end if
            next j
            
   
        next i

        display()
        
    end if

    sleep 2

loop until multikey(&H01)

DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,0,0,0,0,0,1,1,0,0,0
DATA  0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,1,3,3,1,1,1,1,1,1,3,3,1,0,0
DATA  0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,1,1,1,2,2,2,1,3,3,3,3,3,3,3,3,3,3,1,0,0
DATA  0,0,0,0,0,0,0,0,0,1,2,2,2,2,1,1,1,1,1,2,2,1,3,3,1,1,1,1,1,1,3,3,1,0,0
DATA  0,0,0,0,0,0,0,0,0,1,2,2,2,2,1,1,1,1,1,2,2,1,1,1,1,0,0,0,0,0,1,1,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,1,1,1,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0
DATA  0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA  0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA  0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA  0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0
DATA  0,0,0,0,0,1,1,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,1,1,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,1,1,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,1,1,0,0,0,0,0
DATA  0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0
DATA  0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA  0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA  0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA  0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

'tile id data 32x15 for world array
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0
DATA 0,0,0,1,1,1,1,0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,1,1,1,1,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,1,1,1,1,0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,0,0,0,1,1,1,1,0,0,0
DATA 0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

[paul doe]

Hey, nice work! The first post in GameDev in a long while, too =D

There are nice little graphics embedded in the code, but here it only displays a circle with a line pointing in the direction of the tracks. Is this intended, or just for debug?

[BasicCoder2]

I just select all and copy from the post and the graphics work ok for me?

[paul doe]

I just select all and copy from the post and the graphics work ok for me?

That's odd. I also copied from the post, and this is what I get:

[srvaldez]

the code is not 64-bit clean, I did a search&replace for integer to long, except for the line

Code: Select all

Dim as integer  TargetWidth,TargetHeight,TargetBytes,TargetPitch

not sure it's bug free, but the tanks show now when compiling to 64-bit

[paul doe]

the code is not 64-bit clean, I did a search&replace for integer to long, except for the line

Code: Select all

Dim as integer  TargetWidth,TargetHeight,TargetBytes,TargetPitch

not sure it's bug free, but the tanks show now when compiling to 64-bit

Oooh, you're right! I forgot I was compiling on 64-bit. Been a little tired lately ='(

@BasicCoder2: is this version 2.0 of Multiput? I seem to recall that Joshy modified it to work correctly on 64-bit, as srvaldez above has done. If not, then that's the cause of my mishap =D

[badidea]

Seems like an older version of "MultiPut". The one I have has no problem with 64-bit.
Forum link: MultiPut V2.0 :-)

You don't like the "with" statement to prevent typing "r(i)" many times?

[BasicCoder2]

Thanks everyone for the input. I have changed the multiput.bi to the latest version in the first post.
I had toyed with writing my own shorter rotate image routine (see below), no multiput required, but I suspect is is much slower.

Code: Select all

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As single TwoPi = 8 * Atn(1)
Dim Shared As single RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As single DtoR = Pi / 180   ' degrees * DtoR = radians

const SCRW = 640
const SCRH = 480

screenres SCRW,SCRH,32

'bitmaps used
dim shared as any ptr TB,TT
TB = imagecreate(35,35)
'  bload "tankBody.bmp",TB
TT = imagecreate(35,35)
'  bload "tankTurret.bmp",TT
dim shared as any ptr backGround
backGround = imagecreate(1024,480)
' bload "backGround2.bmp",backGround

    dim shared as integer imgW,imgH
    imgW = 35
    imgH = 35
    
dim as ulong colors( 6)
colors(0)=RGB(255,0,255)
colors(1)=RGB(0,0,0)
colors(2)=RGB(166,202,240)
colors(3)=RGB(0,160,192)
colors(4)=RGB(192,192,192)
colors(5)=RGB(128,128,128)
dim as integer n
for j as integer = 0 to  34
    for i as integer = 0 to  34
        read n
        pset TT,(i,j),colors(n)
    next i
next j
for j as integer = 0 to  34
    for i as integer = 0 to  34
        read n
        pset TB,(i,j),colors(n)
    next i
next j

sub rotateImage(img as any ptr, angle as single, x as integer, y as integer)
    dim as double tx,ty,nx,ny,vx,vy
    angle = angle*DtoR   
    dim as ulong c
    for yp as single = 0 to imgH-1 step .5
        for xp as single = 0 to imgW-1 step .5 
            
            c = point(xp,yp,img):'get color
            if c<>rgb(255,0,255) then
                'select centre of image as centre of rotation
                vx = xp-(imgW\2)
                vy = yp-(imgH\2)     
                'equations to compute new x,y coordinates for rotation of ww degrees
                tx = cos(angle) * vx - sin(angle) * vy
                ty = cos(angle) * vy + sin(angle) * vx      
                nx = tx+(imgW\2)
                ny = ty+(imgH\2)
                pset (nx+x,ny+y),c    
            end if

         next xp
    next yp
end sub

put (100,100),TB,trans
dim as single angle1,angle2

do
    screenlock
    cls
    rotateImage(TB,angle1,320,240)
    rotateImage(TT,angle2,320,240)
    screenunlock
    angle2 = angle2 + 1
    sleep 20
loop until multikey(&H01)

DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,0,0,0,0,0,1,1,0,0,0
DATA  0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,1,3,3,1,1,1,1,1,1,3,3,1,0,0
DATA  0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,1,1,1,2,2,2,1,3,3,3,3,3,3,3,3,3,3,1,0,0
DATA  0,0,0,0,0,0,0,0,0,1,2,2,2,2,1,1,1,1,1,2,2,1,3,3,1,1,1,1,1,1,3,3,1,0,0
DATA  0,0,0,0,0,0,0,0,0,1,2,2,2,2,1,1,1,1,1,2,2,1,1,1,1,0,0,0,0,0,1,1,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,1,1,1,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0
DATA  0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA  0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA  0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA  0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0
DATA  0,0,0,0,0,1,1,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,1,1,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,0,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,0,0,0,0,0,0
DATA  0,0,0,0,0,1,1,1,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,1,1,1,0,0,0,0,0
DATA  0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0
DATA  0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA  0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA  0,0,0,0,1,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,4,5,4,1,0,0,0,0
DATA  0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

The next step should I bother to expand the demo is to make some AI so each team of tanks can seek out the other team and fight it out.
One problem I thought about was as the target tank might be moving the shooting tank has to calculate where it will be when the bullet hits.

Of course these are primitive retro tanks in a retro tank demo. In modern warfare they can fire self guided missiles that track the targets and can locate them with radar and satellite or drone surveillance.

You don't like the "with" statement to prevent typing "r(i)" many times?

Never think of it. I can type very fast so short hand stuff is not an issue.
Also within the same block of code I might have line of code with b1(i).x as well as r(i).x

[badidea]

Also within the same block of code I might have b1(i).x as well as r(i).x

That's true, also "r(j)" I see.
I would probably use a temporary pointer, thinking that is it faster, but I could very well be wrong. E.g:

Code: Select all

dim as BULLET ptr pB 'or pBullet
dim as TANK ptr pT 'or pTank

	'TEST FOR COLLISIONS
	for i as integer = 1 to TOTAL_TANKS
	pB = @b1(i)
	'compute value to add to dx,dy for a given speed and direction
	pB->dx = cos(pB->angle * DtoR) * pB->v
	pB->dy = sin(pB->angle * DtoR) * pB->v           
	'move BULLET
	pB->x += pB->dx
	pB->y += pB->dy

	pT = @r(i)
	'compute value to add to dx,dy for a given speed and direction
	pT->dx = cos(pT->angle1 * DtoR) * pT->v
	pT->dy = sin(pT->angle1 * DtoR) * pT->v           
	'move tank
	pT->x += pT->dx
	pT->y += pT->dy

	'etc.

Less brackets to worry about :-)

[paul doe]

Thanks everyone for the input. I have changed the multiput.bi to the latest version in the first post.

Now it looks more like it. However:

Code: Select all

FbTemp.c: In function 'MULTIPUT':
FbTemp.c:287:16: warning: 'VS$1' may be used uninitialized in this function [-Wmaybe-uninitialized]
  struct $4FP16 VS$1;
                ^
FbTemp.c:286:16: warning: 'US$1' may be used uninitialized in this function [-Wmaybe-uninitialized]
  struct $4FP16 US$1;
                ^
FbTemp.c:710:44: warning: 'XEND$1' may be used uninitialized in this function [-Wmaybe-uninitialized]
     E$4 = (uint32*)((uint8*)T$4 + ((XEND$1 - XSTART$1) << 2ll));
                                            ^
FbTemp.c:710:44: warning: 'XSTART$1' may be used uninitialized in this function [-Wmaybe-uninitialized]
FbTemp.c:494:4: warning: 'YEND$1' may be used uninitialized in this function [-Wmaybe-uninitialized]
  if( YSTART$1 >= YEND$1 ) goto label$52;
    ^
FbTemp.c:708:61: warning: 'YSTART$1' may be used uninitialized in this function [-Wmaybe-uninitialized]
     T$4 = (uint32*)((uint8*)((uint8*)PTARGET$1 + ((YSTART$1 * TARGETPITCH$1) << 2ll)) + (XSTART$1 << 2ll));

Modified code (to get rid of the nasty warnings):

Code: Select all

#ifndef __MULTIPUT_BI__
#define __MULTIPUT_BI__

' Multiput by D.J.Peters (Joshy)
' MultiPut [destination],[xmidpos],[ymidpos], source,[xScale],[yScale],[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(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,yEnd,xStart,xEnd
  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,V,US,VS
  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 Then *t=c
          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)
          If c<>&HFFFF00FF Then *t=c
          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__

The next step should I bother to expand the demo is to make some AI so each team of tanks can seek out the other team and fight it out.

Do you have an idea as to how you're going to tackle this one? If not, have a look at this: Goal-based Vector Field Pathfinding. Should you need a ready-made implementation, just tell me. I can provide one, and we can study it in detail if you wish.

One problem I thought about was as the target tank might be moving the shooting tank has to calculate where it will be when the bullet hits.

Say, you'll be better off in the end using vectors and vector arithmetic. You'll get rid of most trigonometry (sin and cos), and many things will just become easier. You don't need a really complicated implementation, just a nice, functional one. I already posted one (check the thread "3D without OpenGL", remember?) that's ready to use. Or we can code one from scratch, so you can see the process. It's not hard at all.

Of course these are primitive retro tanks in a retro tank demo. In modern warfare they can fire self guided missiles that track the targets and can locate them with radar and satellite or drone surveillance.

Hahaha it's just a game, buddy. Just do whatever make sense to you, and try to have as much fun as possible =D

[dafhi]

BasicCoder2's rotate blit optimized and using ptrs
[update 2] - source read needed to not go past src_w (and h) - 0.5, so i made the limit src_ - .501

Code: Select all

sub rotateImage(img as any ptr, angle as single, x as single, y as single)
    
    '' trying to be more accommodating to bit depths
    static as integer des_w, des_h, pitch_des, bpp, rate, num_pages
    dim as any ptr  p_des = screenptr
    static as string  driver_name
    ScreenInfo des_w,des_h, bpp, num_pages, pitch_des, rate, driver_name
    
    static as integer  src_w, src_h, bypp, pitch_src
    static as any ptr  p_src
    ImageInfo img, src_w, src_h, bypp, pitch_src, p_src
    
    dim as integer  pitch_des_by = pitch_des \ bypp
  
    ''
    dim as single tx,ty,vx '' changed from double
    dim as single cosa = cos(angle*DtoR), wh = imgW/2
    dim as single sina = sin(angle*DtoR), hh = imgH/2
    y += hh
    x += wh
    
    var _step = .9
    var cosa_vx = cosa * _step
    var sina_vx = sina * _step
  
    '' 2018 Sep 15
    var x_des_limit = des_w - .5
    var y_des_limit = des_h - .5
    
    for yp as single = .499 to imgH - .501 step _step ''2018 Sep 16 .. (.499 to avoid banker's round)
        
        var cosa_vy = cosa * (yp-hh) + y
        var sina_vy = sina * (yp-hh) - x
        var x_des = cosa_vx * (.5 - wh) - sina_vy
        var y_des = sina_vx * (.5 - wh) + cosa_vy
        
        select case as const bypp
        case 4
          
          dim as integer  y_pitch_src = int(yp) * pitch_src
          dim as ulong ptr  psrc = p_src + y_pitch_src
          dim as ulong ptr  pdes = p_des
    
          for xp as single = .499 to imgW - .501 step _step '' 2018 Sep 16
              if x_des >=0 andalso x_des < x_des_limit then
                if y_des >=0 andalso y_des < y_des_limit then
                  
                  'dim as ulong c = point(xp,yp,img):'get color
                  
                  if psrc[xp]<>rgb(255,0,255) then
                      'pset (x_des,y_des),psrc[xp]
                      pdes[ int(y_des + .5) * pitch_des_by + x_des ] = psrc[xp]
                  end if
                
                endif
              endif
              x_des += cosa_vx
              y_des += sina_vx
           next xp
        
        End Select
      
      next yp

end sub

[previous post] - took a while
still won't be that fast b/c of point and pset

Code: Select all

sub rotateImage(img as any ptr, angle as single, x as single, y as single)
    dim as single tx,ty,vx '' changed from double
    dim as single cosa = cos(angle*DtoR), wh = imgW/2
    dim as single sina = sin(angle*DtoR), hh = imgH/2
    y += hh
    x += wh
    var _step = .9
    var cosa_vx = cosa * _step
    var sina_vx = sina * _step
    for yp as single = .5 to imgH-.5 step _step
        dim as single cosa_vy = cosa * (yp-hh) + y
        dim as single sina_vy = sina * (yp-hh) - x
        var x_dest = cosa_vx * (.5 - wh) - sina_vy
        var y_dest = sina_vx * (.5 - wh) + cosa_vy
        for xp as single = .5 to imgW-.5 step _step
            dim as ulong c = point(xp,yp,img):'get color
            if c<>rgb(255,0,255) then
                pset (x_dest,y_dest),c
            end if
            x_dest += cosa_vx
            y_dest += sina_vx
         next xp
    next yp
end sub

[MrSwiss]

@paul doe,

seems, you've fallen into the "Integer Trap", again:

Code: Select all

type FP16 ' fixed point 16:16
  union
  type
    as ushort l
    as  short h
  end type
  '' NO WAY: as integer v
  as long v    ' 2 * short = 1 * long
  end union
end type

Integer = Long, only in FBC 32 / in FBC 64, Integer = LongInt ...

simplified:

Code: Select all

union FP16
  type
    as ushort l
    as  short h
  end type
  as long v
end union

[paul doe]

seems, you've fallen into the "Integer Trap" again:

Sorry, the code is not mine, but Joshy's (D.J. Peters). I supressed the warnings, didn't bother to check other stuff (the code is way too crappy and will take me ages to fix it properly). Quick tip: instead of jumping at my throat at the very first opportunity you can get, you would do well to read the <entire> thread and, if at all possible, follow the links that lead to the original implementation (and it's original author as well).

[MrSwiss]

instead of jumping at my throat at the very first opportunity you can get ...

Well, well -- getting a bit touchy, when criticised (however: very good at doing so, with other peoples code?)!

Calling other peoples code crappy, isn't such a good idea either (little Tip, from me).

[paul doe]

instead of jumping at my throat at the very first opportunity you can get ...

Well, well -- getting a bit touchy, when criticised (however: very good at doing so, with other peoples code?)!

For the second time: the code is not mine (it's clearly stated in the thread!). Criticizing is one thing, peer review is another, very different concept. I'm fine with peer reviewing (or 'criticizing' code, as you like to think of it -speak volumes about your mindset). You don't like being 'criticized'? Then, don't post anything, as simple as that.

Calling other peoples code crappy, isn't such a good idea either (little Tip, from me).

Why? crappy code is crappy code, whether it is by me, you, or anybody. Hell, I even state myself that some code I post is, indeed, crappy. Part of the 'crappiness' of the code is because it's old, and part because it's just plain ugly.

Another little tip: second post (by you and me) that doesn't add anything to this thread. Last one (from me, at least). Sorry, BasicCoder2. Carry on, please.