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.
AI TANKS first draft
Re: AI TANKS first draft
-
- Posts: 3906
- Joined: Jan 01, 2009 7:03
- Location: Australia
Re: AI TANKS first draft
viewtopic.php?f=7&t=25951&h4tt3n wrote:What rotation algorithm are you using?
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
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
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
Re: AI TANKS first draft
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;
I use arrays from (1 to something)
I don't like starting at zero, seems unnatural somehow.
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 don't like starting at zero, seems unnatural somehow.
-
- Posts: 3906
- Joined: Jan 01, 2009 7:03
- Location: Australia
Re: AI TANKS first draft
@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.
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
Re: AI TANKS first draft
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.
.5 is smaller of course so it works, but 1/sqr(2) (.7071067811865475) is the upper limit.
Above that you see holes.
-
- Posts: 3906
- Joined: Jan 01, 2009 7:03
- Location: Australia
Re: AI TANKS first draft
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.
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
Re: AI TANKS first draft
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.Todo: Slowdown near target. Ambulance can keep circling the target, with different random values.
Disable clearScreen() and you get a racetrack generator :-)
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
Disable clearScreen() and you get a racetrack generator :-)
Re: AI TANKS first draft
Improved version. Now a formula 1 driver in the driver seat.
Different way-points on each run.
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
-
- Posts: 3906
- Joined: Jan 01, 2009 7:03
- Location: Australia
Re: AI TANKS first draft
@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 :)
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"
Re: AI TANKS first draft
Similar, but using a spline.
The Fighting Temerarrow:
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
Re: AI TANKS first draft
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: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.
I think the driver is a bit nervous because of the large amount casualties in need.BasicCoder2 wrote:Your top down ambulance looks more like a salt and pepper shaker :)
Re: AI TANKS first draft
Looks cool. And minimal code again.dodicat wrote:Similar, but using a spline
Just after posted my code, I fought of a better way to slow down to prevent missing a way-point. To be implemented...
DuckDuckGo nor Google have an idea what that is.dodicat wrote:The Fighting Temerarrow
Re: AI TANKS first draft
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.
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.
Re: AI TANKS first draft
Is that the Loch Ness monster at the bottom right of the painting?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.
-
- Posts: 3906
- Joined: Jan 01, 2009 7:03
- Location: Australia
Re: AI TANKS first draft
@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
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