AI TANKS first draft

Game development specific discussions.
Post Reply
h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Re: AI TANKS first draft

Post by h4tt3n »

BasicCoder2 wrote:@badidea,
Here I have changed the image a bit and shown it on the left with 1 pixel per dot and on the right with small circle per dot.
The problem with all rotations is leaving blank pixels that have to be filled in some way.
Image
What rotation algorithm are you using? If you rotate a source pixel at a time, you may very well get blank spots. But if you go the other way, backtracking the source pixel related to each rotated pixel, there won't be blanks. I coded a working algorithm for this a few years back, and it was surprisingly easy. I'll dig out the code for you, if you'd like a peek at it.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: AI TANKS first draft

Post by BasicCoder2 »

h4tt3n wrote:What rotation algorithm are you using?
viewtopic.php?f=7&t=25951&

In the above ambulance example there are 6922 3d points (pixels, voxels 1x1 size) each with x,y,z coordinate and 24 bit color value.

Code: Select all

type Point3D
    x as single
    y as single
    z as single
    c as ulong
end type
They are displayed with this simple function.

Code: Select all

sub plot3D(x as single,y as single,z as single, c as ulong)
    circle ( (x-y) + SCRW/2, (x+y)/2 + z + SCRH/2 ),1,c,,,,f
    'pset ( (x-y) + SCRW/2, (x+y)/2 + z + SCRH/2 ),c
end sub
But before displaying they are rotated around the z axis by some angle using these equations.

Code: Select all

    for i as integer = 0 to t1.TOT_DOTS - 1  'rotate each dot
        x = abs3DA(i).x
        y = abs3DA(i).y
        z = abs3DA(i).z
        rel3DA(i).x = (cosAngleZ * x) - (sinAngleZ * y)
        rel3DA(i).y = (sinAngleZ * x) + (cosAngleZ * y)
        rel3DA(i).z = z
        rel3DA(i).c = abs3DA(i).c
    next i
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: AI TANKS first draft

Post by dodicat »

Hi basiccoder2
I try to use your rotate as given above by you.
One method for pixel filling.
If you make your sprites a bit bigger than required ,say sqr(2)*size required, then scaling back by 1/sqr(2) will keep pixels filled during rotation.
Your rotator;

Code: Select all

 

type Point3D
    x as single
    y as single
    z as single
    c as ulong
end type

dim shared as integer SCRW,SCRH
screen 19,32
screeninfo  SCRW,SCRH



sub plot3D(x as single,y as single,z as single, c as ulong)
   ' circle ( (x-y) + SCRW/2, (x+y)/2 + z + SCRH/2 ),1,c,,,,f
    pset ( (x-y) + SCRW/2, (x+y)/2 + z + SCRH/2 ),c
end sub

sub rotate(abs3DA() as point3d,rel3DA() as point3d,anglez as single,scale as single=1/sqr(2))
dim as single cosAngleZ=cos(anglez)
dim as single sinAngleZ=sin(anglez)
for i as integer = lbound(abs3DA) to ubound(abs3DA)
        dim as single x = abs3DA(i).x
        dim as single y = abs3DA(i).y
        dim as single z = abs3DA(i).z
        rel3DA(i).x = scale*((cosAngleZ * x) - (sinAngleZ * y))
        rel3DA(i).y = scale*((sinAngleZ * x) + (cosAngleZ * y))
        rel3DA(i).z = z
        rel3DA(i).c = abs3DA(i).c
    next i
end sub


         'set up an array of coloured points
        redim as Point3D a(1 to 401*301)
        redim as Point3D result(1 to 401*301)
        dim as long counter
        
        for x as long=0 to 400
            for y as long=0 to 300
            counter+=1
          a(counter).x=x
          a(counter).y=y
          a(counter).z=0
          a(counter).c=rgb(x\2,x\2 or y\2,y\2)
        next
    next
   
     dim as single anglez
    
    do
        anglez+=.01 'rotate about z axis
        screenlock
        cls
        rotate(a(),result(),anglez)
        
        for n as long=lbound(result) to ubound(result)
          plot3d(result(n).x,result(n).y,result(n).z,result(n).c)   
        next
        
        screenunlock
        sleep 1
        loop until len(inkey)
          
I use arrays from (1 to something)
I don't like starting at zero, seems unnatural somehow.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: AI TANKS first draft

Post by BasicCoder2 »

@dodicat,
Starting at zero seems natural to me because at the hardware level you start at address zero and my first language was assembler. However that is not how we number homes along a street which is usually given when explaining the notion of a variable having an address.

Thanks for the suggestion dodicat. Here I have reduced the example image by 50% and have used pset not circle.

Code: Select all

    for i as integer = 0 to t1.TOT_DOTS - 1  'rotate each dot
        x = abs3DA(i).x
        y = abs3DA(i).y
        z = abs3DA(i).z
        rel3DA(i).x = ((cosAngleZ * x) - (sinAngleZ * y))*0.5
        rel3DA(i).y = ((sinAngleZ * x) + (cosAngleZ * y))*0.5
        rel3DA(i).z = z*0.5
        rel3DA(i).c = abs3DA(i).c
    next i
Image
Image
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: AI TANKS first draft

Post by dodicat »

1/sqr(2) scale should always give a full pixel rotation to an image.
.5 is smaller of course so it works, but 1/sqr(2) (.7071067811865475) is the upper limit.
Above that you see holes.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: AI TANKS first draft

Post by BasicCoder2 »

Thought there might be some maths magic behind the 1/sqr(2) number.

If you are able to download the two images below and resave them as .bmp files you can use this code to create the 3dPoint data.
The code will then allow you to drive the image around using the the arrow keys.
As you will see the steering needs changing as it is different to that used by a tank.

You can load the images into a Paint program and play with them, providing you don't change their outlines, to see if changing things like colors, thickness of lines and so on makes any difference. I thought maybe a dithering process on the resultant image might make it look better.

It uses a TANK type but I will make it a more generic "isometric sprite" type later.

The other change is the images will be rotated in their own bitmaps and then PUT onto their x,y coordinate position.

Code: Select all

const ScrW = 1280
const ScrH = 480

'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

type Point3D
    x as single
    y as single
    z as single
    c as ulong
end type

sub plot3D(x as single,y as single,z as single, c as ulong)
    'circle ( (x-y) + SCRW/2, (x+y)/2 + z + SCRH/2 ),1,c,,,,f
    pset ( (x-y) + SCRW/2, (x+y)/2 + z + SCRH/2 ),c
end sub

'dodicat's fast qsort of points according to distance
Sub QsortZ(array() As Point3D,begin As Long,Finish As Ulong)
    Dim As Long i=begin,j=finish
    Dim As Point3D x =array(((I+J)\2))
    While I <= J
        While array(I).z > X .z:I+=1:Wend
        While array(J).z < X .z:J-=1:Wend
        If I<=J Then Swap array(I),array(J): I+=1:J-=1
    Wend
    If J >begin Then QsortZ(array(),begin,J)
    If I <Finish Then QsortZ(array(),I,Finish)
End Sub

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  angle     'direction in degrees
    as integer MAX_DOTS
    as integer TOT_DOTS
end type

dim shared as TANK t1
t1.x = 0
t1.y = 0
t1.angle = 110
t1.MAX_DOTS = 50000 'max number of dots

screenres ScrW,ScrH,32
color rgb(0,0,0),rgb(255,255,255):cls

dim shared as any ptr ambulance
ambulance = imagecreate(61,47)
bload "ambulance4.bmp",ambulance

dim shared as any ptr top
top = imagecreate(110,31)
bload "top2.bmp",top
dim as integer edgeX(0 to 110),edgeY(0 to 110)
for i as integer = 0 to 110
    read edgeX(i),edgeY(i)
next i

'now dimension array of pixel points
dim shared as Point3D abs3DA(t1.MAX_DOTS)  'absolute positions
dim shared as Point3D rel3DA(t1.MAX_DOTS)  'relative positions after any rotation

dim as ulong v,v2
dim as integer flag,x,y,z

'create points for ambulance
for j as integer = 1 to 46
    flag = 0
    for i as integer = 0 to 60
        v = point(i,j,ambulance)
        if v <> rgb(255,0,255)  then
            abs3DA(t1.TOT_DOTS).x = i
            abs3DA(t1.TOT_DOTS).y = 15
            abs3DA(t1.TOT_DOTS).z = j
            abs3DA(t1.TOT_DOTS).c = v
            if t1.TOT_DOTS < t1.MAX_DOTS then t1.TOT_DOTS = t1.TOT_DOTS + 1            
        end if
    next i
next j

for j as integer = 0 to 46
    for i as integer = 0 to 60
        v = point(i,j,ambulance)
        if v <> rgb(255,0,255) then
            abs3DA(t1.TOT_DOTS).x = i
            abs3DA(t1.TOT_DOTS).y = -15
            abs3DA(t1.TOT_DOTS).z = j
            abs3DA(t1.TOT_DOTS).c = v
            if t1.TOT_DOTS < t1.MAX_DOTS then t1.TOT_DOTS = t1.TOT_DOTS + 1
        end if
    next i
next j

for i as integer = 0 to 109
    for y as integer = -15 to 15
        abs3DA(t1.TOT_DOTS).x = edgeX(i)
        abs3DA(t1.TOT_DOTS).y = y
        abs3DA(t1.TOT_DOTS).z = edgeY(i)
        abs3DA(t1.TOT_DOTS).c = point(i,y+15,top)
        if t1.TOT_DOTS < t1.MAX_DOTS then t1.TOT_DOTS = t1.TOT_DOTS + 1 
    next y
next i

sub update()
    

    
    dim as single x,y,z,scale

    'move tank
    t1.dx = cos(t1.angle*DtoR) * t1.v
    t1.dy = sin(t1.angle*DtoR) * t1.v
    
    t1.x = t1.x + t1.dx
    t1.y = t1.y + t1.dy
    
    dim as single cosAngleX,sinAngleX,angleX
    dim as single cosAngleY,sinAngleY,angleY
    dim as single cosAngleZ,sinAngleZ,angleZ

    
    angleZ = t1.angle*DtoR    
    cosAngleZ = cos(angleZ)
    sinAngleZ = sin(angleZ)
    scale = 1/sqr(2)
    for i as integer = 0 to t1.TOT_DOTS - 1  'rotate each dot
        'rotate z axis
        x = abs3DA(i).x
        y = abs3DA(i).y
        z = abs3DA(i).z
        rel3DA(i).x = ((cosAngleZ * x) - (sinAngleZ * y))*scale
        rel3DA(i).y = ((sinAngleZ * x) + (cosAngleZ * y))*scale
        rel3DA(i).z = z*0.5
        rel3DA(i).c = abs3DA(i).c
    next i
    
    'sort by distance along z axis
    '***dodisort***
    Qsortz(rel3DA(),Lbound(rel3DA),Ubound(rel3DA))
    
    
end sub

sub drawPoints()
    screenlock
    cls
    for i as integer = 0 to t1.TOT_DOTS - 1 
        plot3D(rel3DA(i).x + t1.x, rel3DA(i).y + t1.y, rel3DA(i).z, rel3DA(i).c)
    next i
    screenunlock()
end sub

dim as single now1
now1 = timer


do
    
    if timer - now1 > 0.01 then
        now1 = timer
        update()
        drawPoints()
        

        t1.v = 0
    
        if multikey(&H50) then t1.v = -2 'REVERSE
        if multikey(&H48) then t1.v =  2 'FORWARD
        
        'rotate around z axis
        if multikey(&H4D) then
            t1.angle = t1.angle + 1
            if t1.angle > 360 then t1.angle = t1.angle - 360
        end if
        if multikey(&H4B) then
            t1.angle = t1.angle - 1
            if t1.angle < 0 then t1.angle = t1.angle + 360
        end if
        
    end if
    
    sleep 2 
    
loop until multikey(&H01)


sleep

'coordinates of back, top and front of side image to join using colors in top2 bitmap
data 0,30, 0,29, 0,28, 0,27, 1,27, 1,26, 1,25, 1,24, 1,23, 1,22, 1,21, 1,20, 1,19, 1,18, 1,19, 1,18, 1,17, 1,16
data 1,15, 1,14, 1,13, 1,12, 1,11, 1,10, 1,9, 1,8, 1,7, 1,6, 1,5, 1,4, 1,3, 1,2, 2,1, 3,0
data 4,0, 5,0, 6,0, 7,0, 8,0, 9,0, 10,0, 11,0, 12,0, 13,0, 14,0, 15,0, 16,0, 17,0, 18,0, 19,0, 20,0, 21,0
data 22,0, 23,0, 24,0, 25,0, 26,0, 27,0, 28,0, 29,0, 30,0, 31,0, 32,0, 33,0, 34,0, 35,0, 36,0, 37,0, 38,0, 39,0
data 40,0, 41,0, 42,0, 43,0, 44,0
data 44,1, 45,2, 45,3, 46,4, 46,5, 47,6, 47,7, 48,8, 48,9, 49,10, 49,11, 50,12, 51,13, 52,14, 53,14, 54,15, 55,15
data 56,16, 57,16, 58,17, 58,18, 58,19, 58,20, 58,21, 58,22, 58,23, 58,24, 58,25, 58,26, 58,27, 59,27, 60,27, 60,28, 60,29, 60,30
Image
Image
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: AI TANKS first draft

Post by badidea »

Fun demo: Ambulance on its way to help war casualties.
No additional resources needed, image in code. The code it a bit long, but only a part is used.
Working on a set of common includes file here. Concatenated into one file in this post.

Code: Select all

'===============================================================================

Function inRange(value As Integer, min As Integer, max As Integer) As Integer
	If value >= min And value <= max Then
		Return true
	Else
		Return false
	End If
End Function

Sub xyPrint (x As Integer, y As Integer, text As String)
	Locate y, x: Print text;
End Sub

Function max(v1 As Integer, v2 As Integer) As Integer
	Return IIf(v1 > v2, v1, v2) 
End Function 

Function min(v1 As Integer, v2 As Integer) As Integer
	Return IIf(v1 < v2, v1, v2) 
End Function 

Function rndRangeInt(vMin As Integer, vMax As Integer) As Integer
	Return Int(Rnd * (vMax - vMin + 1)) + vMin
End Function

Function rndChoiceInt(v1 As Integer, v2 As Integer) As Integer
	Return IIf(Rnd > 0.5, v1, v2)
End Function

Function rndRangeSgl(vMin As Single, vMax As Single) As Single
	Return Rnd * (vMax - vMin) + vMin
End Function

Function isDigit(text As String) As Integer
	Return (Asc(text) >= 48) And (Asc(text) <= 57)
End Function

Function isLetter(text As String) As Integer
	Return (Asc(text) >= 97) And (Asc(text) <= 122)
End Function

'===============================================================================

Type int2d
	As Integer x, y
	Declare Operator Cast () As String
End Type

Operator =(a As int2d, b As int2d) As boolean
	If a.x <> b.x Then Return false
	If a.y <> b.y Then Return false
	Return true
End Operator

Operator <>(a As int2d, b As int2d) As boolean
	If a.x = b.x And a.y = b.y Then Return false
	Return true
End Operator

' "x, y"
Operator int2d.cast () As String
  Return Str(x) & "," & Str(y)
End Operator

' a + b 
Operator + (a As int2d, b As int2d) As int2d
	Return Type(a.x + b.x, a.y + b.y)
End Operator

' a - b
Operator - (a As int2d, b As int2d) As int2d
	Return Type(a.x - b.x, a.y - b.y)
End Operator

' -a
Operator - (a As int2d) As int2d
	Return Type(-a.x, -a.y)
End Operator

' a * b
Operator * (a As int2d, b As int2d) As int2d
	Return Type(a.x * b.x, a.y * b.y)
End Operator

' a * mul
Operator * (a As int2d, mul As Integer) As int2d
	Return Type(a.x * mul, a.y * mul)
End Operator

' a \ b
Operator \ (a As int2d, b As int2d) As int2d
	Return Type(a.x \ b.x, a.y \ b.y)
End Operator

' a \ div
Operator \ (a As int2d, div As Integer) As int2d
	Return Type(a.x \ div, a.y \ div)
End Operator

'===============================================================================

Type sgl2d
	As Single x, y
	Declare Operator Cast () As String
End Type

' "x, y"
Operator sgl2d.cast () As String
	Return Str(x) & "," & Str(y)
End Operator

' distance
Operator Len(a As sgl2d) As Single
	Return Sqr(a.x * a.x + a.y * a.y)
End Operator

' a = b ?
Operator =(a As sgl2d, b As sgl2d) As boolean
	If a.x <> b.x Then Return false
	If a.y <> b.y Then Return false
	Return true
End Operator

' a != b ?
Operator <>(a As sgl2d, b As sgl2d) As boolean
	If a.x = b.x And a.y = b.y Then Return false
	Return true
End Operator

' a + b 
Operator + (a As sgl2d, b As sgl2d) As sgl2d
	Return Type(a.x + b.x, a.y + b.y)
End Operator

' a - b
Operator - (a As sgl2d, b As sgl2d) As sgl2d
	Return Type(a.x - b.x, a.y - b.y)
End Operator

' -a
Operator - (a As sgl2d) As sgl2d
	Return Type(-a.x, -a.y)
End Operator

' a * b
Operator * (a As sgl2d, b As sgl2d) As sgl2d
	Return Type(a.x * b.x, a.y * b.y)
End Operator

' a * mul
Operator * (a As sgl2d, mul As Integer) As sgl2d
	Return Type(a.x * mul, a.y * mul)
End Operator

' a \ div
Operator \ (a As sgl2d, div As Integer) As sgl2d
	Return Type(a.x \ div, a.y \ div)
End Operator

'===============================================================================

#Include Once "file.bi"
#Include Once "string.bi"

Union rgba_union
	value As ULong
	Type
		b As UByte
		g As UByte
		r As UByte
		a As UByte
	End Type
End Union

Const As ULong C_BLACK = &h00000000
Const As ULong C_DARK_GRAY = &h00404040
Const As ULong C_GRAY = &h00808080
Const As ULong C_LIGHT_GRAY = &h00C0C0C0
Const As ULong C_WHITE = &h00F0F0F0
Const As ULong C_RED = &h00F04040
Const As ULong C_YELLOW = &h00F0F000
Const As ULong C_MANGENTA = &h00FF00FF
Const As ULong C_DARK_GREEN = &h00006F00

'===============================================================================

'Modified version of DynamicUserStackTypeCreateMacro.bi
'https://freebasic.net/forum/viewtopic.php?f=9&t=27026

#Macro listTypeCreate(list_type, data_type)

	Type list_type
		Public:
		Declare Property Push(ByVal value As data_type)
		Declare Property Pop() As data_type
		Declare Property size() As Integer 'stack size
		Declare Property find(ByVal value As data_type) As Integer
		Declare Property Get(index As Integer) As data_type
		Declare Destructor()
		Private:
		Dim As data_type list(Any) 'stack
		Dim As Integer current = 0
	End Type

	'increase list size + add value
	Property list_type.push(ByVal value As data_type)
		ReDim Preserve list(UBound(list) + 1)
		list(UBound(list)) = value
	End Property

	Property list_type.pop() As data_type
		Dim As data_type value
		Select Case UBound(list)
		Case Is > 0
			'get value + decrease list size
			value = list(UBound(list))
			ReDim Preserve list(UBound(list) - 1)
		Case Is = 0
			'get value + empty list
			value = list(UBound(list))
			Erase list
		Case Else
			'keep uninitialised value
		End Select
		Return value
	End Property

	Property list_type.size() As Integer
		Return UBound(list) + 1
	End Property

	'find first match
	Property list_type.find(ByVal value As data_type) As Integer
		For i As Integer = LBound(list) To UBound(list)
			If list(i) = value Then Return i 
		Next
		Return -1
	End Property

	Property list_type.get(index As Integer) As data_type
		Dim As data_type value
		If index >= LBound(list) And index <= UBound(list) Then
			value = list(index)
		End If
		Return value 
	End Property

	Destructor list_type
		Erase list
	End Destructor

#EndMacro

'===============================================================================

listTypeCreate(listTypeUlong, ULong) 'macro thing

Type bitmap_header Field = 1
	bfType          As UShort
	bfsize          As ULong
	bfReserved1     As UShort
	bfReserved2     As UShort
	bfOffBits       As ULong
	biSize          As ULong
	biWidth         As ULong
	biHeight        As ULong
	biPlanes        As UShort
	biBitCount      As UShort
	biCompression   As ULong
	biSizeImage     As ULong
	biXPelsPerMeter As ULong
	biYPelsPerMeter As ULong
	biClrUsed       As ULong
	biClrImportant  As ULong
End Type

Const As Integer SPRITE_DRAW_NO_CENTER = 0
Const As Integer SPRITE_DRAW_CENTER = 1

Const As Integer SPRITE_DRAW_PSET = 0
Const As Integer SPRITE_DRAW_TRANS = 1
Const As Integer SPRITE_DRAW_ALPHA = 2

Type sprite_type
	Public:
	Dim As Any Ptr pImage
	Dim As int2d size, half 
	Dim As Integer center, method, alphaval
	Declare Sub create(sizeInit As int2d, colorInit As ULong)
	Declare Function createFromBmp(fileName As String) As Integer
	Declare Sub destroy()
	Declare Destructor()
	Declare Sub drawxy(x As Integer, y As Integer)
	Declare Sub drawxym(x As Integer, y As Integer, m As Integer)
	Declare Sub drawpos(xypos As int2d)
	Declare Sub setDrawProp(centerInit As Integer, methodInit As Integer, alphavalInit As Integer)
	Declare Sub saveToFbDataFormat(fileName As String)
	Declare Sub createFromFbDataFormat()
	Declare Sub rotateFrom(pSrcImg As Any Ptr, rotation As Single, defaultColour As ULong)
End Type

Declare Sub sprite_rotate(srcImg As Any Ptr, dstImg As Any Ptr, rotation As Single, defaultColour As ULong)

Sub sprite_type.create(sizeInit As int2d, colorInit As ULong)
	pImage = ImageCreate(sizeInit.x, sizeInit.y, colorInit)
	size = sizeInit
	half.x = size.x \ 2
	half.y = size.y \ 2
	center = 0
	method = 0
End Sub

Function sprite_type.createFromBmp(fileName As String) As Integer
	Dim As bitmap_header bmp_header
	Dim As int2d bmpSize
	If FileExists(filename) Then
		Open fileName For Binary As #1
			Get #1, , bmp_header
		Close #1
		bmpSize.x = bmp_header.biWidth
		bmpSize.y = bmp_header.biHeight
		create(bmpSize, &hff000000) '<---!
		BLoad fileName, pImage
		Print "Bitmap loaded: " & filename
	Else
		Print "File not found: " & filename
		Sleep 1000: Return -1
	End If
	Return 0
End Function

Sub sprite_type.destroy()
	If (pImage <> 0) Then
		ImageDestroy(pImage)
		pImage = 0
	End If
End Sub

Destructor sprite_type()
	destroy
End Destructor

Sub sprite_type.drawpos(xypos As int2d)
  drawxy(xypos.x, xypos.y)
End Sub

Sub sprite_type.drawxy(x As Integer, y As Integer)
	If (center) Then
		x -= half.x
		y -= half.y
	End If
	Select Case method
		Case 1 : Put (x , y), pImage, Trans
		Case 2 : Put (x , y), pImage, Alpha, alphaval
		Case Else : Put (x , y), pImage, PSet
	End Select
End Sub

Sub sprite_type.drawxym(x As Integer, y As Integer, m As Integer)
	If (center) Then
		x -= half.x
		y -= half.y
	End If
	Select Case m
		Case 1 : Put (x , y), pImage, Trans
		Case 2 : Put (x , y), pImage, Alpha, alphaval
		Case Else : Put (x , y), pImage, PSet
	End Select
End Sub

Sub sprite_type.setDrawProp(centerInit As Integer, methodInit As Integer, alphavalInit As Integer)
  center = centerInit
  method = methodInit
  alphaval = alphavalInit
End Sub

Sub sprite_type.saveToFbDataFormat(fileName As String)
	Dim As Integer x, y, wImage, hImage, pitchImage
	Dim As ULong c
	Dim As ULong Ptr pPixels
	ImageInfo pImage, wImage, hImage, , pitchImage, pPixels
	pitchImage ShR= 2
	'index the unique colors
	Dim As listTypeUlong list
	Dim As Integer index, lastIndex, colorIndex(wImage-1, hImage-1)
	For y = 0 To hImage-1
		For x = 0 To wImage-1
			c = pPixels[y * pitchImage + x]
			index = list.find(c)
			If index = -1 Then 'not in list
				index = list.size()
				list.push(c) 'add to list
			End If
			colorIndex(x, y) = index
		Next
	Next
	'save to file
	Dim As String sepStr
	Var fileNum = FreeFile() 
	Open fileName For Output As fileNum
		'write number of unique colors
		Print #fileNum, "data " & Str(wImage) & ", " & Str(hImage) & ", " &  Str(list.size)
		'write unique color array
		Print #fileNum, "data";
		lastIndex = list.size() - 1
		For i As Integer = 0 To lastIndex
			If i = lastIndex Then sepStr = "" Else sepStr = ","
			Print #fileNum, " &h" & Hex(list.get(i)) & sepStr;
		Next
		Print #fileNum, "" 'new line
		'write color index map
		For y = 0 To hImage-1
			Print #fileNum, "data";
			For x = 0 To wImage-1
				If x = wImage - 1 Then sepStr = "" Else sepStr = ","
				Print #fileNum, " " & Format(colorIndex(x, y), "00")  & sepStr;
			Next
			Print #fileNum, "" 'new line
		Next
	Close fileNum
	list.destructor() 'clear list
End Sub

Sub sprite_type.createFromFbDataFormat()
	Dim As Integer x, y, wImage, hImage, pitchImage
	Dim As ULong c
	Dim As ULong Ptr pPixels
	'index the unique colors
	Dim As listTypeUlong list
	Dim As Integer index
	Dim As Integer wData, hData, numColor
	'read image dimensions and create empty sprite
	Read wData, hData, numColor
	create(Type(wData, hData), C_MANGENTA)
	ImageInfo pImage, wImage, hImage, , pitchImage, pPixels
	pitchImage ShR= 2
	For i As Integer = 0 To numColor-1
		Read c
		list.push(c)
	Next
	'read color index and get indexed color from list
	For y = 0 To hImage-1
		For x = 0 To wImage-1
			Read index
			pPixels[y * pitchImage + x] = list.get(index)
		Next
	Next
	list.destructor() 'clear list
End Sub

Sub sprite_type.rotateFrom(pSrcImg As Any Ptr, rotation As Single, defaultColour As ULong)
	Dim As Integer srcWidth, srcHeight, srcPitch, dstPitch
	Dim As Single xctr, yctr
	Dim As Integer xdst, ydst
	Dim As Integer xsrc, ysrc
	Dim As ULong colour
	Dim As Single ySin, yCos
	Dim As Single sinRot = Sin(rotation)
	Dim As Single cosRot = Cos(rotation)
	Dim As ULong Ptr scrPixels, dstPixels
	ImageInfo pSrcImg, srcWidth, srcHeight, , srcPitch, scrPixels
	ImageInfo pImage,         ,          , , dstPitch, dstPixels
	dstPitch ShR= 2
	srcPitch ShR= 2
	xctr = srcWidth / 2
	yctr = srcHeight / 2
	'screenlock
	For ydst = 0 To srcHeight-1
		ySin = (yctr - ydst) * sinRot + xctr + 0.5
		yCos = (ydst - yctr) * cosRot + yctr + 0.5
		For xdst = 0 To srcWidth-1
			xsrc = Int((xdst - xctr) * cosRot + ySin)
			ysrc = Int((xdst - xctr) * sinRot + yCos)
			If (xsrc >= 0) And (xsrc < srcWidth) And (ysrc >= 0) And (ysrc < srcHeight) Then
				'colour = point(xsrc, ysrc, srcImg)
				colour = scrPixels[ysrc * srcPitch + xsrc]
			Else
				colour = defaultColour
			End If
			'pset dstImg, (xdst, ydst), colour
			dstPixels[ydst * dstPitch + xdst] = colour
		Next
	Next
	'screenunlock
End Sub

'===============================================================================

#Include Once "fbgfx.bi"

Type graphics_type ' pretty dumb graphics class
	Private:
		'dim as fb.Image ptr pFbImg
	Public:
		Dim As Long w, h 'size
		Declare Constructor(w As Long, h As Long)
		Declare Sub activate()
		Declare Sub clearScreen(colour As ULong)
		Declare Sub dimScreen(dimFactor As Single) '0...1 
End Type

Constructor graphics_type(w As Long, h As Long)
	This.w = w : This.h = h
End Constructor

Sub graphics_type.activate()
	ScreenRes w, h, 32
	Width w \ 8, h \ 16 'bigger font
	'pFbImg = ImageCreate(w, h)
End Sub

Sub graphics_type.clearScreen(colour As ULong)
	Line(0, 0)-(w - 1, h - 1), colour, bf
End Sub

Sub graphics_type.dimScreen(dimFactor As Single)
	Dim As Integer pitch, xi, yi
	Dim As rgba_union Ptr pRow
	'get (0, 0)-(w - 1, h - 1), pFbImg
	'if imageinfo(pFbImg, , , , pitch, pPixels) <> 0 then exit sub
	ScreenInfo , , , , pitch
	Dim As Any Ptr pPixels = ScreenPtr()
	If pPixels = 0 Then Exit Sub
	For yi = 0 To h-1
		pRow = pPixels + yi * pitch
		For xi = 0 To w-1
			pRow[xi].r *= dimFactor
			pRow[xi].g *= dimFactor
			pRow[xi].b *= dimFactor
		Next
	Next
	'put (0, 0), pFbImg, pset
End Sub

'===============================================================================

Const As String KEY_UP = Chr(255) & "H"
Const As String KEY_DN = Chr(255) & "P"
Const As String KEY_LE = Chr(255) & "K"
Const As String KEY_RI = Chr(255) & "M"
Const As String KEY_BACK = Chr(8)
Const As String KEY_ENTER = Chr(13)
Const As String KEY_ESC = Chr(27)
Const As String KEY_SPC = Chr(32)

Function waitForKey() As String
	Dim As String key = InKey
	While key = ""
		key = InKey
		Sleep 1,1
	Wend
	Return key
End Function

'===============================================================================

Const As Single M_PI = 3.141592654
Const As Single M_PI_2 = M_PI * 2
Const As Single M_PI_HALF = M_PI / 2
Const As Single M_RAD = 180 / M_PI

Function rad2deg(radians As Single) As Single
	Return radians * M_RAD
End Function

Function deg2rad(degrees As Single) As Single
	Return degrees / M_RAD
End Function

'===============================================================================

Function calcSpriteNumber(angle As Single, numSprites As Integer) As Integer
	Dim As Integer iSprite
	iSprite = Int ((angle / (M_PI_2)) * numSprites + 0.5)
	If (iSprite < 0) Then iSprite += numSprites
	If (iSprite > numSprites-1) Then iSprite -= numSprites
	'improve this, while loops? modulus?
	If (iSprite < 0) Then iSprite = 0
	If (iSprite > numSprites-1) Then iSprite = 0
	Return iSprite
End Function

Type vehicle_type
	Dim As sgl2d Pos 'position
	Dim As Single angle 'radians
	Dim As Single targetAngle 'radians
	'dim as sgl2d vel 'velocity
	Dim As Single speed 'max speed
	Dim As Single angleSpeed 'max rotation speed
	Dim As sprite_type Ptr pSpr
	Declare Sub update(dt As Double)
End Type

Sub vehicle_type.update(dt As Double)
	Dim As Single vx, vy
	'update position
	vx = speed * Cos(angle)
	vy = speed * -sin(angle)
	pos.x += vx * dt
	pos.y += vy * dt
	'update angle (improve this)
	Dim As Single dAngle = targetAngle - angle
	If dAngle > M_PI Then dAngle -= M_PI_2 
	If dAngle < -M_PI Then dAngle += M_PI_2 
	Dim As Integer rotationDirection = -1
	If dAngle > 0 Then rotationDirection = +1
	If Abs(dAngle) > Abs(angleSpeed * dt) Then
		dAngle = Abs(angleSpeed * dt)
	End If
	angle += rotationDirection * dAngle
	If angle > M_PI Then angle -= M_PI_2 
	If angle < -M_PI Then angle += M_PI_2 
End Sub

'===============================================================================

Var graphics = graphics_type(800, 600)
graphics.activate()

Const As Integer NUM_SPR_ROT = 360 \ 5
Dim As sprite_type medicSpr, medicRotSpr(NUM_SPR_ROT-1)

Dim As vehicle_type unimog
unimog.pos = Type(graphics.w \ 2, graphics.h \ 2)
unimog.speed = 150 'px/s
unimog.angleSpeed = deg2rad(200) 'rad/s

medicSpr.createFromFbDataFormat()

'create rotated images
Print "Rotating images ";
For i As Integer = 0 To UBound(medicRotSpr)
	medicRotSpr(i).create(medicSpr.size, 0)
	medicRotSpr(i).rotateFrom(medicSpr.pImage, (i / NUM_SPR_ROT) * M_PI_2, C_MANGENTA)
	medicRotSpr(i).setDrawProp(SPRITE_DRAW_CENTER, SPRITE_DRAW_TRANS, 0)
	Print ".";
Next

Const As Integer NUM_WP = 8
Dim As sgl2d waypoint(NUM_WP-1)
Randomize 12345
For i As Integer = 0 To UBound(waypoint)
	waypoint(i).x = rndRangeSgl(50, graphics.w - 50)
	waypoint(i).y = rndRangeSgl(50, graphics.h - 50)
Next
Dim As Integer targetWaypoint = 0
Dim As Single distOkWaypoint = 20.0 'px
Dim As ULong colorWaypoint

Dim As Double tNow = Timer, dt = 0, tPrev
Dim As Integer spriteRot

While Not MultiKey(FB.SC_ESCAPE)
	unimog.targetAngle = ATan2(-waypoint(targetWaypoint).y + unimog.pos.y , waypoint(targetWaypoint).x - unimog.pos.x)
	unimog.update(dt)
	If Len(waypoint(targetWaypoint) - unimog.pos) < distOkWaypoint Then
		targetWaypoint += 1
		If targetWaypoint > UBound(waypoint) Then targetWaypoint = 0
	End If
	ScreenLock
	graphics.clearScreen(C_DARK_GREEN)
	For i As Integer = 0 To UBound(waypoint)
		If i = targetWaypoint Then colorWaypoint = C_RED Else colorWaypoint = C_YELLOW 
		Circle(waypoint(i).x, waypoint(i).y), distOkWaypoint, colorWaypoint
	Next
	spriteRot = calcSpriteNumber(unimog.angle, NUM_SPR_ROT)
	medicRotSpr(spriteRot).drawxy(unimog.pos.x, unimog.pos.y)
	Locate 1, 1 : Print "Position :"; Int(unimog.pos.x); ","; Int(unimog.pos.y);
	Locate 3, 1 : Print "Target angle :"; unimog.targetAngle;
	Locate 2, 1 : Print "Actual angle :"; unimog.angle
	ScreenUnLock

	Sleep 15,1
	tPrev = tNow
	tNow = Timer
	dt = tNow - tPrev
Wend 

endNow:
waitForKey()

'===============================================================================

Data 48, 48, 16
Data &hFFFF00FF, &hFF000000, &hFF303030, &hFF404040, &hFFA0A0A0, &hFF808080, &hFFFF0000, &hFFEDECD4, &hFFFFB27F, &hFFFFD800, &hFFD02F2F, &hFF0026FF, &hFFFFEB00, &hFFA92020, &hFF7FC9FF, &hFF0094FF
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 01, 01, 01, 02, 02, 02, 02, 01, 01, 01, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 01, 01, 01, 02, 02, 02, 02, 01, 01, 01, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 03, 03, 04, 04, 04, 04, 04, 04, 04, 03, 03, 04, 04, 04, 04, 04, 04, 04, 04, 04, 03, 03, 00, 00, 00, 00, 00, 00, 01, 01, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 00, 00, 00, 00, 00, 00
Data 00, 06, 03, 03, 04, 04, 04, 04, 04, 04, 04, 03, 03, 04, 04, 04, 04, 04, 04, 04, 04, 04, 03, 03, 02, 02, 02, 02, 02, 02, 02, 02, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 00, 00, 00
Data 00, 06, 04, 04, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 04, 04, 04, 02, 02, 02, 02, 02, 02, 02, 02, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 08, 00, 00
Data 00, 06, 04, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 05, 05, 05, 05, 02, 02, 08, 08, 08, 08, 02, 02, 02, 02, 02, 02, 08, 08, 08, 07, 07, 00
Data 00, 06, 04, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 08, 08, 08, 08, 08, 08, 08, 08, 08, 08, 08, 07, 07, 09, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 10, 10, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 11, 11, 07, 07, 07, 07, 03, 03, 07, 07, 12, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 11, 14, 15, 11, 07, 07, 07, 03, 03, 07, 07, 09, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 11, 14, 15, 11, 07, 07, 07, 03, 03, 07, 07, 07, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 11, 11, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 07, 07, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 10, 10, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 03, 04, 07, 07, 10, 10, 10, 10, 10, 10, 10, 13, 13, 10, 10, 10, 10, 10, 10, 10, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 10, 10, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 03, 04, 07, 07, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 10, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 10, 10, 10, 10, 10, 10, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 03, 04, 07, 07, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 10, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 10, 10, 10, 10, 10, 10, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 03, 04, 07, 07, 10, 10, 10, 10, 10, 10, 10, 13, 13, 10, 10, 10, 10, 10, 10, 10, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 10, 10, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 10, 10, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 07, 07, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 11, 11, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 11, 14, 15, 11, 07, 07, 07, 03, 03, 07, 07, 07, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 04, 04, 08, 07, 07, 11, 14, 15, 11, 07, 07, 07, 03, 03, 07, 07, 09, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 10, 10, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 04, 04, 08, 07, 07, 07, 11, 11, 07, 07, 07, 07, 03, 03, 07, 07, 12, 00
Data 00, 06, 04, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 08, 08, 08, 08, 08, 08, 08, 08, 08, 08, 08, 07, 07, 09, 00
Data 00, 06, 04, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 05, 05, 05, 05, 02, 02, 08, 08, 08, 08, 02, 02, 02, 02, 02, 02, 08, 08, 08, 07, 07, 00
Data 00, 06, 04, 04, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 04, 04, 04, 02, 02, 02, 02, 02, 02, 02, 02, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 08, 00, 00
Data 00, 06, 03, 03, 04, 04, 04, 04, 04, 04, 04, 03, 03, 04, 04, 04, 04, 04, 04, 04, 04, 04, 03, 03, 02, 02, 02, 02, 02, 02, 02, 02, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 00, 00, 00
Data 00, 00, 03, 03, 04, 04, 04, 04, 04, 04, 04, 03, 03, 04, 04, 04, 04, 04, 04, 04, 04, 04, 03, 03, 00, 00, 00, 00, 00, 00, 01, 01, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 01, 01, 01, 02, 02, 02, 02, 01, 01, 01, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 01, 01, 01, 02, 02, 02, 02, 01, 01, 01, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Todo: Slowdown near target. Ambulance can keep circling the target, with different random values.

Disable clearScreen() and you get a racetrack generator :-)
Image
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: AI TANKS first draft

Post by badidea »

Improved version. Now a formula 1 driver in the driver seat.
Different way-points on each run.

Code: Select all

'===============================================================================

Function inRange(value As Integer, min As Integer, max As Integer) As Integer
	If value >= min And value <= max Then
		Return true
	Else
		Return false
	End If
End Function

Sub xyPrint (x As Integer, y As Integer, text As String)
	Locate y, x: Print text;
End Sub

Function max(v1 As Integer, v2 As Integer) As Integer
	Return IIf(v1 > v2, v1, v2) 
End Function 

Function min(v1 As Integer, v2 As Integer) As Integer
	Return IIf(v1 < v2, v1, v2) 
End Function 

Function rndRangeInt(vMin As Integer, vMax As Integer) As Integer
	Return Int(Rnd * (vMax - vMin + 1)) + vMin
End Function

Function rndChoiceInt(v1 As Integer, v2 As Integer) As Integer
	Return IIf(Rnd > 0.5, v1, v2)
End Function

Function rndRangeSgl(vMin As Single, vMax As Single) As Single
	Return Rnd * (vMax - vMin) + vMin
End Function

Function isDigit(text As String) As Integer
	Return (Asc(text) >= 48) And (Asc(text) <= 57)
End Function

Function isLetter(text As String) As Integer
	Return (Asc(text) >= 97) And (Asc(text) <= 122)
End Function

'===============================================================================

Type int2d
	As Integer x, y
	Declare Operator Cast () As String
End Type

Operator =(a As int2d, b As int2d) As boolean
	If a.x <> b.x Then Return false
	If a.y <> b.y Then Return false
	Return true
End Operator

Operator <>(a As int2d, b As int2d) As boolean
	If a.x = b.x And a.y = b.y Then Return false
	Return true
End Operator

' "x, y"
Operator int2d.cast () As String
  Return Str(x) & "," & Str(y)
End Operator

' a + b 
Operator + (a As int2d, b As int2d) As int2d
	Return Type(a.x + b.x, a.y + b.y)
End Operator

' a - b
Operator - (a As int2d, b As int2d) As int2d
	Return Type(a.x - b.x, a.y - b.y)
End Operator

' -a
Operator - (a As int2d) As int2d
	Return Type(-a.x, -a.y)
End Operator

' a * b
Operator * (a As int2d, b As int2d) As int2d
	Return Type(a.x * b.x, a.y * b.y)
End Operator

' a * mul
Operator * (a As int2d, mul As Integer) As int2d
	Return Type(a.x * mul, a.y * mul)
End Operator

' a \ b
Operator \ (a As int2d, b As int2d) As int2d
	Return Type(a.x \ b.x, a.y \ b.y)
End Operator

' a \ div
Operator \ (a As int2d, div As Integer) As int2d
	Return Type(a.x \ div, a.y \ div)
End Operator

'===============================================================================

Type sgl2d
	As Single x, y
	Declare Operator Cast () As String
End Type

' "x, y"
Operator sgl2d.cast () As String
	Return Str(x) & "," & Str(y)
End Operator

' distance
Operator Len(a As sgl2d) As Single
	Return Sqr(a.x * a.x + a.y * a.y)
End Operator

' a = b ?
Operator =(a As sgl2d, b As sgl2d) As boolean
	If a.x <> b.x Then Return false
	If a.y <> b.y Then Return false
	Return true
End Operator

' a != b ?
Operator <>(a As sgl2d, b As sgl2d) As boolean
	If a.x = b.x And a.y = b.y Then Return false
	Return true
End Operator

' a + b 
Operator + (a As sgl2d, b As sgl2d) As sgl2d
	Return Type(a.x + b.x, a.y + b.y)
End Operator

' a - b
Operator - (a As sgl2d, b As sgl2d) As sgl2d
	Return Type(a.x - b.x, a.y - b.y)
End Operator

' -a
Operator - (a As sgl2d) As sgl2d
	Return Type(-a.x, -a.y)
End Operator

' a * b
Operator * (a As sgl2d, b As sgl2d) As sgl2d
	Return Type(a.x * b.x, a.y * b.y)
End Operator

' a * mul
Operator * (a As sgl2d, mul As Integer) As sgl2d
	Return Type(a.x * mul, a.y * mul)
End Operator

' a \ div
Operator \ (a As sgl2d, div As Integer) As sgl2d
	Return Type(a.x \ div, a.y \ div)
End Operator

'===============================================================================

#Include Once "file.bi"
#Include Once "string.bi"

Union rgba_union
	value As ULong
	Type
		b As UByte
		g As UByte
		r As UByte
		a As UByte
	End Type
End Union

Const As ULong C_BLACK = &h00000000
Const As ULong C_DARK_GRAY = &h00404040
Const As ULong C_GRAY = &h00808080
Const As ULong C_LIGHT_GRAY = &h00C0C0C0
Const As ULong C_WHITE = &h00F0F0F0
Const As ULong C_RED = &h00F04040
Const As ULong C_YELLOW = &h00F0F000
Const As ULong C_MANGENTA = &h00FF00FF
Const As ULong C_DARK_GREEN = &h00006F00
Const As ULong C_BLUE = &h000000FF

'===============================================================================

'Modified version of DynamicUserStackTypeCreateMacro.bi
'https://freebasic.net/forum/viewtopic.php?f=9&t=27026

#Macro listTypeCreate(list_type, data_type)

	Type list_type
		Public:
		Declare Property Push(ByVal value As data_type)
		Declare Property Pop() As data_type
		Declare Property size() As Integer 'stack size
		Declare Property find(ByVal value As data_type) As Integer
		Declare Property Get(index As Integer) As data_type
		Declare Destructor()
		Private:
		Dim As data_type list(Any) 'stack
		Dim As Integer current = 0
	End Type

	'increase list size + add value
	Property list_type.push(ByVal value As data_type)
		ReDim Preserve list(UBound(list) + 1)
		list(UBound(list)) = value
	End Property

	Property list_type.pop() As data_type
		Dim As data_type value
		Select Case UBound(list)
		Case Is > 0
			'get value + decrease list size
			value = list(UBound(list))
			ReDim Preserve list(UBound(list) - 1)
		Case Is = 0
			'get value + empty list
			value = list(UBound(list))
			Erase list
		Case Else
			'keep uninitialised value
		End Select
		Return value
	End Property

	Property list_type.size() As Integer
		Return UBound(list) + 1
	End Property

	'find first match
	Property list_type.find(ByVal value As data_type) As Integer
		For i As Integer = LBound(list) To UBound(list)
			If list(i) = value Then Return i 
		Next
		Return -1
	End Property

	Property list_type.get(index As Integer) As data_type
		Dim As data_type value
		If index >= LBound(list) And index <= UBound(list) Then
			value = list(index)
		End If
		Return value 
	End Property

	Destructor list_type
		Erase list
	End Destructor

#EndMacro

'===============================================================================

listTypeCreate(listTypeUlong, ULong) 'macro thing

Type bitmap_header Field = 1
	bfType          As UShort
	bfsize          As ULong
	bfReserved1     As UShort
	bfReserved2     As UShort
	bfOffBits       As ULong
	biSize          As ULong
	biWidth         As ULong
	biHeight        As ULong
	biPlanes        As UShort
	biBitCount      As UShort
	biCompression   As ULong
	biSizeImage     As ULong
	biXPelsPerMeter As ULong
	biYPelsPerMeter As ULong
	biClrUsed       As ULong
	biClrImportant  As ULong
End Type

Const As Integer SPRITE_DRAW_NO_CENTER = 0
Const As Integer SPRITE_DRAW_CENTER = 1

Const As Integer SPRITE_DRAW_PSET = 0
Const As Integer SPRITE_DRAW_TRANS = 1
Const As Integer SPRITE_DRAW_ALPHA = 2

Type sprite_type
	Public:
	Dim As Any Ptr pImage
	Dim As int2d size, half 
	Dim As Integer center, method, alphaval
	Declare Sub create(sizeInit As int2d, colorInit As ULong)
	Declare Function createFromBmp(fileName As String) As Integer
	Declare Sub destroy()
	Declare Destructor()
	Declare Sub drawxy(x As Integer, y As Integer)
	Declare Sub drawxym(x As Integer, y As Integer, m As Integer)
	Declare Sub drawpos(xypos As int2d)
	Declare Sub setDrawProp(centerInit As Integer, methodInit As Integer, alphavalInit As Integer)
	Declare Sub saveToFbDataFormat(fileName As String)
	Declare Sub createFromFbDataFormat()
	Declare Sub rotateFrom(pSrcImg As Any Ptr, rotation As Single, defaultColour As ULong)
End Type

Declare Sub sprite_rotate(srcImg As Any Ptr, dstImg As Any Ptr, rotation As Single, defaultColour As ULong)

Sub sprite_type.create(sizeInit As int2d, colorInit As ULong)
	pImage = ImageCreate(sizeInit.x, sizeInit.y, colorInit)
	size = sizeInit
	half.x = size.x \ 2
	half.y = size.y \ 2
	center = 0
	method = 0
End Sub

Function sprite_type.createFromBmp(fileName As String) As Integer
	Dim As bitmap_header bmp_header
	Dim As int2d bmpSize
	If FileExists(filename) Then
		Open fileName For Binary As #1
			Get #1, , bmp_header
		Close #1
		bmpSize.x = bmp_header.biWidth
		bmpSize.y = bmp_header.biHeight
		create(bmpSize, &hff000000) '<---!
		BLoad fileName, pImage
		Print "Bitmap loaded: " & filename
	Else
		Print "File not found: " & filename
		Sleep 1000: Return -1
	End If
	Return 0
End Function

Sub sprite_type.destroy()
	If (pImage <> 0) Then
		ImageDestroy(pImage)
		pImage = 0
	End If
End Sub

Destructor sprite_type()
	destroy
End Destructor

Sub sprite_type.drawpos(xypos As int2d)
  drawxy(xypos.x, xypos.y)
End Sub

Sub sprite_type.drawxy(x As Integer, y As Integer)
	If (center) Then
		x -= half.x
		y -= half.y
	End If
	Select Case method
		Case 1 : Put (x , y), pImage, Trans
		Case 2 : Put (x , y), pImage, Alpha, alphaval
		Case Else : Put (x , y), pImage, PSet
	End Select
End Sub

Sub sprite_type.drawxym(x As Integer, y As Integer, m As Integer)
	If (center) Then
		x -= half.x
		y -= half.y
	End If
	Select Case m
		Case 1 : Put (x , y), pImage, Trans
		Case 2 : Put (x , y), pImage, Alpha, alphaval
		Case Else : Put (x , y), pImage, PSet
	End Select
End Sub

Sub sprite_type.setDrawProp(centerInit As Integer, methodInit As Integer, alphavalInit As Integer)
	center = centerInit
	method = methodInit
	alphaval = alphavalInit
End Sub

Sub sprite_type.saveToFbDataFormat(fileName As String)
	Dim As Integer x, y, wImage, hImage, pitchImage
	Dim As ULong c
	Dim As ULong Ptr pPixels
	ImageInfo pImage, wImage, hImage, , pitchImage, pPixels
	pitchImage ShR= 2
	'index the unique colors
	Dim As listTypeUlong list
	Dim As Integer index, lastIndex, colorIndex(wImage-1, hImage-1)
	For y = 0 To hImage-1
		For x = 0 To wImage-1
			c = pPixels[y * pitchImage + x]
			index = list.find(c)
			If index = -1 Then 'not in list
				index = list.size()
				list.push(c) 'add to list
			End If
			colorIndex(x, y) = index
		Next
	Next
	'save to file
	Dim As String sepStr
	Var fileNum = FreeFile() 
	Open fileName For Output As fileNum
		'write number of unique colors
		Print #fileNum, "data " & Str(wImage) & ", " & Str(hImage) & ", " &  Str(list.size)
		'write unique color array
		Print #fileNum, "data";
		lastIndex = list.size() - 1
		For i As Integer = 0 To lastIndex
			If i = lastIndex Then sepStr = "" Else sepStr = ","
			Print #fileNum, " &h" & Hex(list.get(i)) & sepStr;
		Next
		Print #fileNum, "" 'new line
		'write color index map
		For y = 0 To hImage-1
			Print #fileNum, "data";
			For x = 0 To wImage-1
				If x = wImage - 1 Then sepStr = "" Else sepStr = ","
				Print #fileNum, " " & Format(colorIndex(x, y), "00")  & sepStr;
			Next
			Print #fileNum, "" 'new line
		Next
	Close fileNum
	list.destructor() 'clear list
End Sub

Sub sprite_type.createFromFbDataFormat()
	Dim As Integer x, y, wImage, hImage, pitchImage
	Dim As ULong c
	Dim As ULong Ptr pPixels
	'index the unique colors
	Dim As listTypeUlong list
	Dim As Integer index
	Dim As Integer wData, hData, numColor
	'read image dimensions and create empty sprite
	Read wData, hData, numColor
	create(Type(wData, hData), C_MANGENTA)
	ImageInfo pImage, wImage, hImage, , pitchImage, pPixels
	pitchImage ShR= 2
	For i As Integer = 0 To numColor-1
		Read c
		list.push(c)
	Next
	'read color index and get indexed color from list
	For y = 0 To hImage-1
		For x = 0 To wImage-1
			Read index
			pPixels[y * pitchImage + x] = list.get(index)
		Next
	Next
	list.destructor() 'clear list
End Sub

Sub sprite_type.rotateFrom(pSrcImg As Any Ptr, rotation As Single, defaultColour As ULong)
	Dim As Integer srcWidth, srcHeight, srcPitch, dstPitch
	Dim As Single xctr, yctr
	Dim As Integer xdst, ydst
	Dim As Integer xsrc, ysrc
	Dim As ULong colour
	Dim As Single ySin, yCos
	Dim As Single sinRot = Sin(rotation)
	Dim As Single cosRot = Cos(rotation)
	Dim As ULong Ptr scrPixels, dstPixels
	ImageInfo pSrcImg, srcWidth, srcHeight, , srcPitch, scrPixels
	ImageInfo pImage,         ,          , , dstPitch, dstPixels
	dstPitch ShR= 2
	srcPitch ShR= 2
	xctr = srcWidth / 2
	yctr = srcHeight / 2
	'screenlock
	For ydst = 0 To srcHeight-1
		ySin = (yctr - ydst) * sinRot + xctr + 0.5
		yCos = (ydst - yctr) * cosRot + yctr + 0.5
		For xdst = 0 To srcWidth-1
			xsrc = Int((xdst - xctr) * cosRot + ySin)
			ysrc = Int((xdst - xctr) * sinRot + yCos)
			If (xsrc >= 0) And (xsrc < srcWidth) And (ysrc >= 0) And (ysrc < srcHeight) Then
				'colour = point(xsrc, ysrc, srcImg)
				colour = scrPixels[ysrc * srcPitch + xsrc]
			Else
				colour = defaultColour
			End If
			'pset dstImg, (xdst, ydst), colour
			dstPixels[ydst * dstPitch + xdst] = colour
		Next
	Next
	'screenunlock
End Sub

'===============================================================================

#Include Once "fbgfx.bi"

Type graphics_type ' pretty dumb graphics class
	Private:
		'dim as fb.Image ptr pFbImg
	Public:
		Dim As Long w, h 'size
		Declare Constructor(w As Long, h As Long)
		Declare Sub activate()
		Declare Sub clearScreen(colour As ULong)
		Declare Sub dimScreen(dimFactor As Single) '0...1 
End Type

Constructor graphics_type(w As Long, h As Long)
	This.w = w : This.h = h
End Constructor

Sub graphics_type.activate()
	ScreenRes w, h, 32
	Width w \ 8, h \ 16 'bigger font
	'pFbImg = ImageCreate(w, h)
End Sub

Sub graphics_type.clearScreen(colour As ULong)
	Line(0, 0)-(w - 1, h - 1), colour, bf
End Sub

Sub graphics_type.dimScreen(dimFactor As Single)
	Dim As Integer pitch, xi, yi
	Dim As rgba_union Ptr pRow
	'get (0, 0)-(w - 1, h - 1), pFbImg
	'if imageinfo(pFbImg, , , , pitch, pPixels) <> 0 then exit sub
	ScreenInfo , , , , pitch
	Dim As Any Ptr pPixels = ScreenPtr()
	If pPixels = 0 Then Exit Sub
	For yi = 0 To h-1
		pRow = pPixels + yi * pitch
		For xi = 0 To w-1
			pRow[xi].r *= dimFactor
			pRow[xi].g *= dimFactor
			pRow[xi].b *= dimFactor
		Next
	Next
	'put (0, 0), pFbImg, pset
End Sub

'===============================================================================

Const As String KEY_UP = Chr(255) & "H"
Const As String KEY_DN = Chr(255) & "P"
Const As String KEY_LE = Chr(255) & "K"
Const As String KEY_RI = Chr(255) & "M"
Const As String KEY_BACK = Chr(8)
Const As String KEY_ENTER = Chr(13)
Const As String KEY_ESC = Chr(27)
Const As String KEY_SPC = Chr(32)

Function waitForKey() As String
	Dim As String key = InKey
	While key = ""
		key = InKey
		Sleep 1,1
	Wend
	Return key
End Function

'===============================================================================

Const As Single M_PI = 3.141592654
Const As Single M_PI_2 = M_PI * 2
Const As Single M_PI_HALF = M_PI / 2
Const As Single M_RAD = 180 / M_PI

Function rad2deg(radians As Single) As Single
	Return radians * M_RAD
End Function

Function deg2rad(degrees As Single) As Single
	Return degrees / M_RAD
End Function

'===============================================================================

Function calcSpriteNumber(angle As Single, numSprites As Integer) As Integer
	Dim As Integer iSprite
	iSprite = Int ((angle / (M_PI_2)) * numSprites + 0.5)
	If (iSprite < 0) Then iSprite += numSprites
	If (iSprite > numSprites-1) Then iSprite -= numSprites
	'improve this, while loops? modulus?
	If (iSprite < 0) Then iSprite = 0
	If (iSprite > numSprites-1) Then iSprite = 0
	Return iSprite
End Function

Type vehicle_type
	Dim As sgl2d Pos 'position
	Dim As Single angle 'radians
	Dim As Single targetAngle 'radians
	Dim As Single accel, maxAccel 'acceleration
	'dim as sgl2d vel 'velocity
	Dim As Single speed, minSpeed, maxSpeed
	Dim As Single angleSpeed 'max rotation speed
	Dim As sprite_type Ptr pSpr
	Declare Sub update(dt As Double)
End Type

Sub vehicle_type.update(dt As Double)
	Dim As Single vx, vy
	'update position
	speed += accel * dt
	If speed > maxSpeed Then speed = maxSpeed
	If speed < minSpeed Then speed = minSpeed
	vx = speed * Cos(angle)
	vy = speed * -sin(angle)
	pos.x += vx * dt
	pos.y += vy * dt
	'update angle (improve this)
	Dim As Single dAngle = targetAngle - angle
	If dAngle > M_PI Then dAngle -= M_PI_2 
	If dAngle < -M_PI Then dAngle += M_PI_2 
	Dim As Integer rotationDirection = -1
	If dAngle > 0 Then rotationDirection = +1
	If Abs(dAngle) > Abs(angleSpeed * dt) Then
		dAngle = Abs(angleSpeed * dt)
	End If
	angle += rotationDirection * dAngle
	If angle > M_PI Then angle -= M_PI_2 
	If angle < -M_PI Then angle += M_PI_2 
End Sub

'===============================================================================

Var graphics = graphics_type(800, 600)
graphics.activate()

Const As Integer NUM_SPR_ROT = 360 \ 5
Dim As sprite_type medicSpr, medicRotSpr(NUM_SPR_ROT-1)

Dim As vehicle_type unimog
unimog.pos = Type(graphics.w \ 2, graphics.h \ 2)
unimog.minSpeed = 100 'px/s
unimog.maxSpeed = 300 'px/s
unimog.speed = unimog.minSpeed
unimog.maxAccel = 400 'px/s^2
unimog.accel = unimog.maxAccel
unimog.angleSpeed = deg2rad(200) 'rad/s

medicSpr.createFromFbDataFormat()

'create rotated images
Print "Rotating images ";
For i As Integer = 0 To UBound(medicRotSpr)
	medicRotSpr(i).create(medicSpr.size, 0)
	medicRotSpr(i).rotateFrom(medicSpr.pImage, (i / NUM_SPR_ROT) * M_PI_2, C_MANGENTA)
	medicRotSpr(i).setDrawProp(SPRITE_DRAW_CENTER, SPRITE_DRAW_TRANS, 0)
	Print ".";
Next

Const As Integer NUM_WP = 12
Dim As sgl2d waypoint(NUM_WP-1)
Randomize Timer
For i As Integer = 0 To UBound(waypoint)
	waypoint(i).x = rndRangeSgl(50, graphics.w - 50)
	waypoint(i).y = rndRangeSgl(50, graphics.h - 50)
Next
Dim As Integer targetWaypoint = 0
Dim As Single distOkWaypoint = 20.0 'px
Dim As Single distNearWaypoint = 80.0 'px
Dim As ULong colorWaypoint
Dim As Single distWaypoint

Dim As Double tNow = Timer, dt = 0, tPrev
Dim As Integer spriteRot

While Not MultiKey(FB.SC_ESCAPE)
	unimog.targetAngle = ATan2(-waypoint(targetWaypoint).y + unimog.pos.y , waypoint(targetWaypoint).x - unimog.pos.x)
	unimog.update(dt)
	distWaypoint = Len(waypoint(targetWaypoint) - unimog.pos)
	If distWaypoint < distOkWaypoint Then
		targetWaypoint += 1
		If targetWaypoint > UBound(waypoint) Then targetWaypoint = 0
	End If
	If distWaypoint < distNearWaypoint Then
		unimog.accel = -unimog.maxAccel 'slow down
	Else
		unimog.accel = +unimog.maxAccel 'go
	End If
	ScreenLock
	graphics.clearScreen(C_DARK_GREEN)
	For i As Integer = 0 To UBound(waypoint)
		If i = targetWaypoint Then colorWaypoint = C_RED Else colorWaypoint = C_YELLOW 
		Circle(waypoint(i).x, waypoint(i).y), distOkWaypoint, colorWaypoint
	Next
	spriteRot = calcSpriteNumber(unimog.angle, NUM_SPR_ROT)
	medicRotSpr(spriteRot).drawxy(unimog.pos.x, unimog.pos.y)
	Locate 1, 1 : Print "Position :"; Int(unimog.pos.x); ","; Int(unimog.pos.y);
	Locate 2, 1 : Print "Target angle :"; unimog.targetAngle;
	Locate 3, 1 : Print "Actual angle :"; unimog.angle
	Locate 4, 1 : Print "Actual speed :"; Int(unimog.speed)
	Line(10, graphics.h-15)-step(distWaypoint, 4), C_BLUE, bf
	Line(10, graphics.h-25)-step(unimog.speed, 4), C_RED, bf
	ScreenUnLock

	Sleep 1,1
	tPrev = tNow
	tNow = Timer
	dt = tNow - tPrev
Wend 

endNow:
waitForKey()

'===============================================================================

Data 48, 48, 16
Data &hFFFF00FF, &hFF000000, &hFF303030, &hFF404040, &hFFA0A0A0, &hFF808080, &hFFFF0000, &hFFEDECD4, &hFFFFB27F, &hFFFFD800, &hFFD02F2F, &hFF0026FF, &hFFFFEB00, &hFFA92020, &hFF7FC9FF, &hFF0094FF
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 01, 01, 01, 02, 02, 02, 02, 01, 01, 01, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 01, 01, 01, 02, 02, 02, 02, 01, 01, 01, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 03, 03, 04, 04, 04, 04, 04, 04, 04, 03, 03, 04, 04, 04, 04, 04, 04, 04, 04, 04, 03, 03, 00, 00, 00, 00, 00, 00, 01, 01, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 00, 00, 00, 00, 00, 00
Data 00, 06, 03, 03, 04, 04, 04, 04, 04, 04, 04, 03, 03, 04, 04, 04, 04, 04, 04, 04, 04, 04, 03, 03, 02, 02, 02, 02, 02, 02, 02, 02, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 00, 00, 00
Data 00, 06, 04, 04, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 04, 04, 04, 02, 02, 02, 02, 02, 02, 02, 02, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 08, 00, 00
Data 00, 06, 04, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 05, 05, 05, 05, 02, 02, 08, 08, 08, 08, 02, 02, 02, 02, 02, 02, 08, 08, 08, 07, 07, 00
Data 00, 06, 04, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 08, 08, 08, 08, 08, 08, 08, 08, 08, 08, 08, 07, 07, 09, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 10, 10, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 11, 11, 07, 07, 07, 07, 03, 03, 07, 07, 12, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 11, 14, 15, 11, 07, 07, 07, 03, 03, 07, 07, 09, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 11, 14, 15, 11, 07, 07, 07, 03, 03, 07, 07, 07, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 11, 11, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 07, 07, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 10, 10, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 03, 04, 07, 07, 10, 10, 10, 10, 10, 10, 10, 13, 13, 10, 10, 10, 10, 10, 10, 10, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 10, 10, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 03, 04, 07, 07, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 10, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 10, 10, 10, 10, 10, 10, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 03, 04, 07, 07, 10, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 10, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 10, 10, 10, 10, 10, 10, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 03, 04, 07, 07, 10, 10, 10, 10, 10, 10, 10, 13, 13, 10, 10, 10, 10, 10, 10, 10, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 10, 10, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 10, 10, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 07, 07, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 07, 11, 11, 07, 07, 07, 07, 03, 03, 07, 07, 00, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 07, 07, 11, 14, 15, 11, 07, 07, 07, 03, 03, 07, 07, 07, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 13, 13, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 04, 04, 08, 07, 07, 11, 14, 15, 11, 07, 07, 07, 03, 03, 07, 07, 09, 00
Data 00, 00, 04, 07, 07, 07, 07, 07, 07, 07, 07, 10, 10, 10, 10, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 04, 04, 08, 07, 07, 07, 11, 11, 07, 07, 07, 07, 03, 03, 07, 07, 12, 00
Data 00, 06, 04, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 07, 07, 07, 05, 02, 02, 08, 08, 08, 08, 08, 08, 08, 08, 08, 08, 08, 08, 07, 07, 09, 00
Data 00, 06, 04, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 04, 04, 02, 05, 05, 05, 05, 05, 02, 02, 08, 08, 08, 08, 02, 02, 02, 02, 02, 02, 08, 08, 08, 07, 07, 00
Data 00, 06, 04, 04, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 04, 04, 04, 02, 02, 02, 02, 02, 02, 02, 02, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 07, 08, 00, 00
Data 00, 06, 03, 03, 04, 04, 04, 04, 04, 04, 04, 03, 03, 04, 04, 04, 04, 04, 04, 04, 04, 04, 03, 03, 02, 02, 02, 02, 02, 02, 02, 02, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 00, 00, 00
Data 00, 00, 03, 03, 04, 04, 04, 04, 04, 04, 04, 03, 03, 04, 04, 04, 04, 04, 04, 04, 04, 04, 03, 03, 00, 00, 00, 00, 00, 00, 01, 01, 05, 05, 05, 05, 05, 05, 05, 05, 05, 05, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 01, 01, 01, 02, 02, 02, 02, 01, 01, 01, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 01, 01, 01, 02, 02, 02, 02, 01, 01, 01, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
Data 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: AI TANKS first draft

Post by BasicCoder2 »

@badidea,
Tried to make something that behaves in a similar way.
I was confused for a while when I replaced your image rotate for the multiput rotate until I realised yours rotates in the opposite direction.
Your top down ambulance looks more like a salt and pepper shaker :)

Code: Select all

'dodicat regulator
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

'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
dim shared as long fps

const SCRW = 640
const SCRH = 480

screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(255,255,255)

dim shared as single angle,dx,dy 'to compute angle to active target

type TARGET
    as integer x
    as integer y
    as integer a  'active target
end type

dim shared as TARGET targets(0 to 7)
for i as integer = 0 to 7
    targets(i).x = int(rnd(1)*600)+20
    targets(i).y = int(rnd(1)*440)+20
next i
dim shared as integer ID
ID = int(rnd(1)*8)
targets(ID).a= 1   'random active



type TANK
    as single x
    as single y
    as single v    'velocity
    as single dx
    as single dy
    as single angle1
end type

dim shared as TANK t1

t1.x = 320
t1.y = 240
t1.angle1 = 0

'bitmaps used
dim shared as any ptr TB
TB = imagecreate(48,48,rgb(255,0,255))

dim shared as any ptr dest
dest = imagecreate(48,48,rgb(255,0,255))

dim as ulong colors( 16)
colors( 0)=RGB(255,0,255)
colors( 1)=RGB(0,0,0)
colors( 2)=RGB(48,48,48)
colors( 3)=RGB(64,64,64)
colors( 4)=RGB(160,160,160)
colors( 5)=RGB(128,128,128)
colors( 6)=RGB(255,0,0)
colors( 7)=RGB(237,236,212)
colors( 8)=RGB(255,178,127)
colors( 9)=RGB(255,216,0)
colors( 10)=RGB(208,47,47)
colors( 11)=RGB(0,38,255)
colors( 12)=RGB(255,235,0)
colors( 13)=RGB(169,32,32)
colors( 14)=RGB(127,201,255)
colors( 15)=RGB(0,148,255)
dim as integer n
dim as string datum,char
for j as integer = 0 to  47
    read datum
    for i as integer = 0 to  47
        char = mid(datum,i+1,1)
        n = val("&H"&char)
        pset TB,(i,j),colors(n)
    next i
next j

'badidea's sprite rotate
sub sprite_rotate(srcImg as any ptr, dstImg as any ptr, rotation as single, defaultColour as integer)
  'replace point & pset with direct memory access
  dim as integer srcWidth, srcHeight, srcPitch, dstPitch
  dim as single xctr, yctr
  dim as integer xdst, ydst
  dim as integer xsrc, ysrc
  dim as ulong colour 'was integer
  dim as single ySin, yCos
  dim as single sinRot = sin(rotation)
  dim as single cosRot = cos(rotation)
  
  dim as ulong ptr scrPixels, dstPixels 'was integer
  imageInfo srcImg, srcWidth, srcHeight, , srcPitch, scrPixels
  imageInfo dstImg,         ,          , , dstPitch, dstPixels
  dstPitch shr= 2
  srcPitch shr= 2
    
  xctr = srcWidth / 2
  yctr = srcHeight / 2

  for ydst = 0 to srcHeight-1
    ySin = (yctr - ydst) * sinRot + xctr + 0.5
    yCos = (ydst - yctr) * cosRot + yctr + 0.5
    for xdst = 0 to srcWidth-1
      xsrc = int((xdst - xctr) * cosRot + ySin)
      ysrc = int((xdst - xctr) * sinRot + yCos)
      if (xsrc >= 0) and (xsrc < srcWidth) and (ysrc >= 0) and (ysrc < srcHeight) then
        'colour = point(xsrc, ysrc, srcImg)
        colour = scrPixels[ysrc * srcPitch + xsrc]
      else
        colour = defaultColour
      end if
      'pset dstImg, (xdst, ydst), colour
      dstPixels[ydst * dstPitch + xdst] = colour
    next
  next

end sub

sub display()
    screenlock
    cls
    locate 2,2
    print "ANGLE = ";angle,t1.angle1
    'sprite_rotate(srcImg, dstImg, rotation, defaultColour)
    sprite_rotate(TB,dest,(360-t1.angle1)*DtoR,rgb(255,0,255))
    put (t1.x,t1.y),dest,trans
    'draw targets
    for i as integer = 0 to 7
        if targets(i).a = 1 then
            circle (targets(i).x, targets(i).y),20,rgb(255,100,100),,,,f
        else
            circle (targets(i).x, targets(i).y),20,rgb(100,255,100)
        end if
    next i
    line (t1.x+24,t1.y+24)-(targets(ID).x, targets(ID).y),rgb(0,0,0)
    screenunlock
end sub

do

    display()
    
    'hit target?
    for i as integer = 0 to 7
        'collision with target
        if targets(i).a = 1 and sqr( (t1.x+24 - targets(i).x)^2 + (t1.y+24 - targets(i).y)^2)<40 then
            'select a new target
            targets(i).a = 0
            ID = int(rnd(1)*8)
            targets(ID).a= 1   'random active
        end if
        'compute angle to target
        if targets(i).a = 1 then 'get angle
            dx = targets(i).x-(t1.x+24)
            dy = targets(i).y-(t1.y+24)
            angle = atan2(dy,dx)*RtoD
            if angle < 0 then angle = angle + 360
        end if
    next i

    t1.v = 2
    
    dim as single inc
    'turn toward target
    if abs(t1.angle1-angle)<5 then
        inc = abs(t1.angle1-angle)
    else
        inc = 5
    end if
    
    if abs(t1.angle1-angle)<180 then
        if t1.angle1>angle then
            t1.angle1 = t1.angle1 - inc
        else
            t1.angle1 = t1.angle1 + inc
        end if
    else
        if t1.angle1>angle then
            t1.angle1 = t1.angle1 + inc
        else
            t1.angle1 = t1.angle1 - inc
        end if 
    end if
    
    if t1.angle1 > 359 then t1.angle1 = t1.angle1 - 360
    if angle > 359 then angle = angle - 360
    if t1.angle1 < 0 then t1.angle1 = t1.angle1 + 360
    if angle < 0 then angle = angle + 360
    
        
    if t1.v <> 0 then 'move ambulance
        t1.dx = cos(t1.angle1*DtoR)*t1.v
        t1.dy = sin(t1.angle1*DtoR)*t1.v
        t1.x = t1.x + t1.dx
        t1.y = t1.y + t1.dy
    end if
        
    sleep regulate(60,fps) '<---------------  set fps here

loop until multikey(&H01)

DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000001112222111000000000000000111222211100000000"
DATA "003344444443344444444433000000115555555555000000"
DATA "063344444443344444444433222222225555555555555000"
DATA "064477777777777777777444222222227777777777777800"
DATA "064777777777777777777744255555228888222222888770"
DATA "064777777777777777777744257775228888888888887790"
DATA "00477777777AAAA777777744257775228777BB77773377C0"
DATA "00477777777ADDA77777774425777522877BEFB777337790"
DATA "00477777777ADDA77777774425777522877BEFB777337770"
DATA "00477777777ADDA777777744257775228777BB7777337700"
DATA "00477777777ADDA777777744257775228777777777337700"
DATA "00477777777ADDA777777744257775228777AA7777337700"
DATA "03477AAAAAAADDAAAAAAA744257775228777AA7777337700"
DATA "03477ADDDDDDDDDDDDDDA7442577752287AAAAAA77337700"
DATA "03477ADDDDDDDDDDDDDDA7442577752287AAAAAA77337700"
DATA "03477AAAAAAADDAAAAAAA744257775228777AA7777337700"
DATA "00477777777ADDA777777744257775228777AA7777337700"
DATA "00477777777ADDA777777744257775228777777777337700"
DATA "00477777777ADDA777777744257775228777BB7777337700"
DATA "00477777777ADDA77777774425777522877BEFB777337770"
DATA "00477777777ADDA77777774425777544877BEFB777337790"
DATA "00477777777AAAA777777744257775448777BB77773377C0"
DATA "064777777777777777777744257775228888888888887790"
DATA "064777777777777777777744255555228888222222888770"
DATA "064477777777777777777444222222227777777777777800"
DATA "063344444443344444444433222222225555555555555000"
DATA "003344444443344444444433000000115555555555000000"
DATA "000001112222111000000000000000111222211100000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
DATA "000000000000000000000000000000000000000000000000"
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: AI TANKS first draft

Post by dodicat »

Similar, but using a spline.
The Fighting Temerarrow:

Code: Select all

 

Type Point 
    As Single x,y',z
    as single dx,dy
End Type

Sub rotateimage(im As Any Ptr,angle As Single,shiftx As Long=0,shifty As Long=0,sc As Single=1,miss As Ulong=Rgb(255,0,255))
    Static As Integer pitch,pitchs,xres,yres,runflag
    Static As Any Ptr row
    Static As Integer ddx,ddy,resultx,resulty
    Imageinfo im,ddx,ddy,,pitch,row
   If runflag=0 Then Screeninfo xres,yres,,,pitchS:runflag=1
    Dim As Any Ptr rowS=Screenptr
    Dim As Long centreX=ddx\2,centreY=ddy\2
    Dim As Single sx=Sin(angle)
    Dim As Single cx=Cos(angle)
    Dim As Long mx=Iif(ddx>=ddy,ddx,ddy),shftx,shfty
    Var fx=sc*.7071067811865476,sc2=1/sc
     shiftx+=centreX*sc-centrex
     shiftY+=centrey*sc-centrey
    For y As Long=centrey-fx*mx+1 To centrey+ fx*mx 
        Dim As Single sxcy=Sx*(y-centrey),cxcy=Cx*(y-centrey)
        shfty=y+shifty
        For x As Long=centrex-mx*fx To centrex+mx*fx 
                 If x+shiftx >=0 Then 'on the screen
                    If x+shiftx <xres Then
                        If shfty >=0 Then
                            If shfty<yres Then
            resultx=sc2*(Cx*(x-centrex)-Sxcy) +centrex:resulty=sc2*(Sx*(x-centrex)+Cxcy) +centrey
                If resultx >=0 Then 'on the image
                    If resultx<ddx Then
                        If resulty>=0 Then
                            If resulty<ddy Then
    Dim As Ulong u=*Cast(Ulong Ptr,row+pitch*((resultY))+((resultX)) Shl 2 ) 'point(image)
   If u<>miss Then *Cast(Ulong Ptr,rowS+pitchS*(y+shifty)+(x+shiftx) Shl 2)= u 'pset (screen)
                End If:End If:End If:End If
                End If:End If:End If:End If
        Next x
    Next y
End Sub

Function spline(p() As Point,t As Single) As Point
    #macro set(n)
    0.5 *(     (2 * P(2).n) +_
   (-1*P(1).n + P(3).n) * t +_
    (2*P(1).n - 5*P(2).n + 4*P(3).n - P(4).n) * t*t +_
    (-1*P(1).n + 3*P(2).n- 3*P(3).n + P(4).n) * t*t*t)
    #endmacro
    Return Type<Point>(set(x),set(y))',set(z))
End Function

Sub GetCatmull(v() As Point,outarray() As Point,arraysize As Integer=500)
    Dim As Point p(1 To 4)
    Redim outarray(0)
    Dim As Single stepsize=(Ubound(v)-1)/(arraysize)
    If stepsize>1 Then stepsize=1
    For n As Integer=2 To Ubound(v)-2
        p(1)=v(n-1):p(2)=v(n):p(3)=v(n+1):p(4)=v(n+2)
        For t As Single=0 To 1 Step stepsize
            Redim Preserve outarray(1 To Ubound(outarray)+1)
            outarray(Ubound(outarray))=spline(p(),t)'temp
        Next t
    Next n
End Sub  

Sub DrawCurve(a() As Point,col As Ulong,xdisp As Long=0,ydisp As Long=0)
    Pset(a(Lbound(a)).x+xdisp,a(Lbound(a)).y+ydisp),col
    For z As Integer=Lbound(a) To Ubound(a)
        Line-(a(z).x+xdisp,a(z).y+ydisp),col
    Next z
End Sub

Sub drawnext(p() As Point,m as long,im as any ptr=0)
    For n As Long=Lbound(p) To Ubound(p)
        var s=Str(n-4)
        if n=m then Circle im,(p(n).x,p(n).y),20,Rgba(200,0,0,100),,,,f: _
        Draw String(p(n).x-len(s)*8\2,p(n).y-6),Str(n-4),rgb(255,255,255)
    Next n
End Sub

Sub thickline(x1 As long,y1 as long,x2 as long,y2 as long,thickness as double,p as ulong,im as any ptr=0)
        Dim As Double h=Sqr((x2-x1)^2+(y2-y1)^2):If h=0 Then h=1e-6
        Dim As Double s= (y1-y2)/h ,c=(x2-x1)/h 
            Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),p
            Line im,(x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
            Line im,(x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),p
            Line im,(x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
            Paint im,((x1+x2)/2, (y1+y2)/2), p, p
End Sub

sub lineto(x1 As long,y1 as long,x2 as long,y2 as long,d as double,th as double,col as ulong)
    var L=sqr((x1-x2)^2 + (y1-y2)^2),dx=x2-x1,dy=y2-y1
    thickline(x1,y1,x1+d*dx/L,y1+d*dy/L,th,col)
end sub

sub advance(pts() as point)
    for m as long=lbound(pts) to ubound(pts)
         pts(m).x+=pts(m).dx
         pts(m).y+=pts(m).dy
         if pts(m).x<20 or pts(m).x>780 then pts(m).dx=-pts(m).dx
         if pts(m).y<20 or pts(m).y>580 then pts(m).dy=-pts(m).dy
         next
    end sub
    
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

Randomize 1
Screen 19,32,,64
color ,rgb(0,0,100)
Dim As String arrow = _
"C4278241280BM25,0M+-49,22M+8,8M+37,-15M+-6,58M+10,-21"_
&"M+8,18M+-4,-54M+38,10M+6,-10M+-48,-15"_
&"BM+-1,7P4294904320,4278241280"
Dim As Any Ptr i=Imagecreate(50,50)
Draw i,arrow
#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
Redim Shared pts()As Point
Redim Shared cout() As Point
Redim pts(1 To 15)
redim as any ptr im(1 to ubound(pts))
For n As Long=1 To Ubound(pts)
    im(n)=imagecreate(40,40)
    circle im(n),(20,20),18,rgb(0,200,0),,,,f
    pts(n)=Type(Range(100,700),Range(100,500),(rnd-rnd)/3,(rnd-rnd)/3)
Next
pts(Ubound(pts))=pts(4)
pts(Ubound(pts)-1)=pts(3)
pts(Ubound(pts)-2)=pts(2)
pts(Ubound(pts)-3)=pts(1)
GetCatmull(pts(),cout(),2000)


const pi=4*Atn(1)
#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
Dim As Long mx,my,btn,change=1,fps,nxt,nxtplus,id
dim as string key

start:
For n As Long=Lbound(cout) To Ubound(cout)-1
    key=inkey
    if key=" " then change=-change
    if key=chr(27) then  exit for
    
    screenlock
    cls
    Getmouse mx,my,,btn
    'move by mouse
   For m As Long=Lbound(pts) To Ubound(pts)
       put(pts(m).x-20,pts(m).y-20),im(m),trans
       if cout(n).x=pts(m).x then nxt=m+1:nxtplus=m+2
       if nxt>ubound(pts) then nxt=lbound(pts)+4
       if nxtplus>ubound(pts) then nxtplus=lbound(pts)+5
       If incircle(pts(m).x,pts(m).y,20,mx,my) And btn=1 Then
           pts(m).x=mx
           pts(m).y=my
       End If
   Next m
   advance(pts())
pts(Ubound(pts))=pts(4)
pts(Ubound(pts)-1)=pts(3)
pts(Ubound(pts)-2)=pts(2)
pts(Ubound(pts)-3)=pts(1)
GetCatmull(pts(),cout(),2000)

    draw string (50,50),"Framerate " &fps
    draw string (50,70),"Drag by mouse, space key to see the spline"
    drawnext(pts(),nxt)
   if change<0 then DrawCurve(cout(),Rgba(200,0,0,100))          'toggle spline
    Var a=Atan2(-(cout(n+1).y-cout(n).y),(cout(n+1).x-cout(n).x))'slope of curve
    rotateimage(i,a+pi/2+pi,cout(n).x-25,cout(n).y-25)
    'shooter
    id=nxtplus
    if rnd>.9 then 
     line(cout(n).x,cout(n).y)-(pts(id).x,pts(id).y),rgb(200,200,200)
     circle im(id),(rnd*40,rnd*40),4,rgb(0,0,100),,,,f
    end if
    if rnd >.995 then 'target 1 spontaenously
        id=5
      line(cout(n).x,cout(n).y)-(pts(id).x,pts(id).y),rgb(200,200,200)
      circle im(5),(rnd*40,rnd*40),4,rgb(0,0,100),,,,f
 end if
    'cannon
    circle(cout(n).x,cout(n).y),7,rgb(200,200,201),,,,f
    lineto(cout(n).x,cout(n).y,pts(id).x,pts(id).y,10,15,rgb(200,200,200))
    lineto(cout(n).x,cout(n).y,pts(id).x,pts(id).y,30,5,rgb(0,100,200))
    
    Screenunlock
    Sleep regulate(60,fps)
    If cout(n).x=pts(Ubound(pts)-2).x And n<> Lbound(cout) Then Goto start
Next n
for n as long=1 to ubound(pts)
    imagedestroy(im(n))
next n
imagedestroy i
end
Sleep
      
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: AI TANKS first draft

Post by badidea »

BasicCoder2 wrote:Tried to make something that behaves in a similar way.
I was confused for a while when I replaced your image rotate for the multiput rotate until I realised yours rotates in the opposite direction.
The problem is that the screen coordinates are upside down. Then when we do positive rotation, should we go clockwise or counter-clock?
BasicCoder2 wrote:Your top down ambulance looks more like a salt and pepper shaker :)
I think the driver is a bit nervous because of the large amount casualties in need.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: AI TANKS first draft

Post by badidea »

dodicat wrote:Similar, but using a spline
Looks cool. And minimal code again.
Just after posted my code, I fought of a better way to slow down to prevent missing a way-point. To be implemented...
dodicat wrote:The Fighting Temerarrow
DuckDuckGo nor Google have an idea what that is.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: AI TANKS first draft

Post by dodicat »

It's a twist of
https://en.wikipedia.org/wiki/The_Fighting_Temeraire
Not for Napoleon fans maybe, but he did always threaten to invade (England).
He had the South coast twitching for years.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: AI TANKS first draft

Post by badidea »

dodicat wrote:It's a twist of
https://en.wikipedia.org/wiki/The_Fighting_Temeraire
Not for Napoleon fans maybe, but he did always threaten to invade (England).
He had the South coast twitching for years.
Is that the Loch Ness monster at the bottom right of the painting?
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: AI TANKS first draft

Post by BasicCoder2 »

@dodicat,
So essentially you have a list of points which you draw a curve through and the arrow follows the curved path. Following a path solves an issue I had with using angles as a direction because of the need to deal with the sudden change between 0 and 359. I guess using vectors, as suggested by paul doe, instead of an angle would also have solved the 0 to 359 cross over problem.
For anyone interested in implementing splines we had the exchange,
viewtopic.php?f=3&t=24211&hilit
Post Reply