Can I check I understand file put & get correctly?
-
- Posts: 41
- Joined: Jun 07, 2020 15:47
Can I check I understand file put & get correctly?
Hi,
Before I delve into a lot of code can I check I've understood file put and get for sequential files correctly?
Its it true that I have an array of a user defined type which itself contains arrays, strings and arrays of strings I can just 'put' the whole thing to a file and then later re-open that file and just 'get' a variable of the same type, without having to worry how big the original type, its strings or its arrays were? This would be a sequential write of the whole array of the type and sequential read of the whole array.
If so Is there anything I need to watch for?
If not would I have to write invividual elements? My reading of the wiki suggests no.
Thanks in advance.
Before I delve into a lot of code can I check I've understood file put and get for sequential files correctly?
Its it true that I have an array of a user defined type which itself contains arrays, strings and arrays of strings I can just 'put' the whole thing to a file and then later re-open that file and just 'get' a variable of the same type, without having to worry how big the original type, its strings or its arrays were? This would be a sequential write of the whole array of the type and sequential read of the whole array.
If so Is there anything I need to watch for?
If not would I have to write invividual elements? My reading of the wiki suggests no.
Thanks in advance.
Re: Can I check I understand file put & get correctly?
As UDT members, this can only work for both fixed-lengths array and fixed-length strings, otherwise (for variable-length arrays/strings) only dangling arrays/strings descriptors would be written to the file and not the data themselves.
Extract of the TYPE documentation page:
Extract of the TYPE documentation page:
Variable-length data
In FreeBASIC, Type data structures must ultimately be fixed-size, such that the compiler knows how much memory to allocate for objects of that Type. Nevertheless, Types may contain variable-length (dynamic) string or array data members. However, the string's/array's data will not be embedded in the Type directly. Instead, the Type will only contain a String/array descriptor structure, which FreeBASIC uses behind the scenes to manage the variable-length string/array data. For sizing the structure of the array descriptor in the Type, a variable-length (dynamic) array data member must be always declared by using Any(S) in place of the array bounds, in order to fix the amount of dimensions based on the number of Anys specified. A variable-length (dynamic) array data member can also be pre-sized in its declaration by using syntax with ReDim.
Variable-length array fields are considered as pseudo-objects when they are declared in a Type, just like variable-length strings (the implicit copy constructor and the implicit let operator themselves support [re]sizing and copying such arrays, or their erasing).
Because of that, saving such a Type into a file will write out the descriptor, not the actual string/array data. In order to embed strings/arrays into Types directly, fixed-length strings/arrays must be used.
Similarly, when maintaining dynamic data manually through the use of pointers within a Type, it does usually not make sense to save the Type to a file, because the address stored in the pointer field will be written to file, not the actual memory it points to. Addresses are meaningful to a specific process only though, and cannot be shared that way.
Re: Can I check I understand file put & get correctly?
Yes, also don't use the (U)Integer data type.olympic sleeper wrote:If so Is there anything I need to watch for?
And do use field alignment.
This gives 465 bytes on 32- and 64-bit fbc:
Code: Select all
type udt_5p field = 1
dim as long x(0 to 4) '5 x 4 = 20 bytes
dim as long y(0 to 4) '5 x 4 = 20 bytes
end type
type udt_bla field = 1
dim as string * 64 label '1 + 64 = 65 bytes
dim as udt_5p list(0 to 9) '10 x 40 = 400 bytes
end type
print sizeof(udt_bla)
Re: Can I check I understand file put & get correctly?
On the contrary, the UDT array can be of variable-length (resizable).fxm wrote:As UDT members, this can only work for both fixed-lengths array and fixed-length strings, otherwise (for variable-length arrays/strings) only dangling arrays/strings descriptors would be written to the file and not the data themselves.
.....
Re: Can I check I understand file put & get correctly?
A "put" for my example above:
Code: Select all
type udt_5p field = 1
dim as long x(0 to 4) '5 x 4 = 20 bytes
dim as long y(0 to 4) '5 x 4 = 20 bytes
end type
type udt_bla field = 1
dim as string * 64 label '1 + 64 = 65 bytes
dim as udt_5p list(0 to 9) '10 x 40 = 400 bytes
end type
const as integer NUM_BLA = 3
dim as udt_bla bla(0 to NUM_BLA - 1) '3 x 465 = 1395 bytes
dim as string fileName = "_blabla_.bin"
dim as integer fileNum = freeFile()
if open(fileName for binary as #fileNum) <> 0 then
print "Error opening: " & fileName
else
for i as integer = 0 to ubound(bla)
put #fileNum, , bla(i)
next
close #fileNum
print "Data written to: " & fileName
end if
Re: Can I check I understand file put & get correctly?
or simpler:badidea wrote:A "put" for my example above:Code: Select all
..... for i as integer = 0 to ubound(bla) put #fileNum, , bla(i) next .....
Code: Select all
.....
put #fileNum, , bla()
.....
Re: Can I check I understand file put & get correctly?
Save and load a udt array.
It is all in the help files.
For no warnings/errors, fixed length strings and arrays.
If you extend object and use OOP in general, then you may be in trouble, but I have not really tested this out yet.
(If you use abstract then you won't be able even to create udt objects in the first place, so you are definitely in trouble.)
You may have to save any child udt's extending the main udt.
I will experiment with saving a game to file -- sometime.
It is all in the help files.
For no warnings/errors, fixed length strings and arrays.
If you extend object and use OOP in general, then you may be in trouble, but I have not really tested this out yet.
(If you use abstract then you won't be able even to create udt objects in the first place, so you are definitely in trouble.)
You may have to save any child udt's extending the main udt.
I will experiment with saving a game to file -- sometime.
Code: Select all
width 100,500
#include "file.bi"
type udt
as zstring * 50 num
as long x,y
as string * 100 s
as single a(1 to 8)
declare sub printout()
end type
sub udt.printout()
with this
print .num
print .x,.y
print .s
for m as long=lbound(.a) to ubound(.a)
print .a(m);
next m
print
end with
print
end sub
sub load(file as string,u() as udt)
var f=freefile
if fileexists(file)=0 then print file;" not found":return
Open file For Binary Access Read As #f
If Lof(f) > 0 Then
Get #f, ,u()
End If
Close #f
end sub
sub save(file as string,u() as udt)
var h=freefile
open file for binary access write as #h
put #h, ,u()
close #h
end sub
dim as udt x(1 to 3)
for n as long=lbound(x) to ubound(x)
with x(n)
.num= "Element " +str(n)
.x=n
.y=n*2
.s="hi " +string(70,"-") +str(n)
for m as long=lbound(.a) to ubound(.a)
.a(m)=rnd
next m
end with
next n
print "ORIGINAL"
for n as long=lbound(x) to ubound(x)
x(n).printout()
next
save("data",x())
var N=filelen("data")\sizeof(udt) 'get the number of elements to load
redim as udt y(1 to N)
load("data",y())
print
print
print "============= FROM FILE ============="
for n as long=1 to ubound(y)
y(n).printout()
next
sleep
kill "data"
Last edited by dodicat on Jul 29, 2020 17:56, edited 1 time in total.
Re: Can I check I understand file put & get correctly?
Code: Select all
.....
for m as long=1 to 8 ' and not 10, otherwise out of bounds
.a(m)=rnd
next m
.....
Re: Can I check I understand file put & get correctly?
Sorry, fixed that.
-
- Posts: 862
- Joined: May 05, 2015 5:35
- Location: Germany
Re: Can I check I understand file put & get correctly?
Alternatively, you can write a load/save SUB as member of the TYPE. Here an excerpt of BER approach, a flight operator simulation:
Code: Select all
...
Type tPlane
callsign As String
origin As String
destination As String
position As tPosition
target As tPosition
xdisp As Integer
ydisp As Integer
tagDispx As Integer
tagDispy As Integer
tagDispBasex As Integer = 15 '10
tagDispBasey As Integer = -29 '-24
Union
selbuffer_ As Byte
selbuffer As tMark
End Union
altitude As Double 'ft
targetAltitude As Integer 'ft
messageAltitude As Integer 'ft
climbrate As Integer = 30 'ft/min
descendrate As Integer = 30 'ft/min
tagAltitude As String
direction As Double 'as angle
turn As String
messageTurn As String
speed As Double 'kt
targetSpeed As Integer 'kt
messageSpeed As Integer 'kt
maxSpeed As Integer = 450 'kt (450kt = 833 km/h) '(500kt = 910 km/h)
stallSpeed As Integer = 120 'kt (120kt = 222 km/h)
approachSpeed As Integer = 150 'kt (150kt = 278 km/h)
cruiseSpeed As Integer = 400 'kt (400kt = 740 km/h)
acceleration As Integer = 5 'kt/s
deceleration As Integer = 5 'kt/s
tagSpeed As String
timerem As Double
scheduledDepartureTime As Double
fuel As Double 'as time
messageLock As Double '= 2
Union
planeflags As UShort 'for saving / loading
planeflag As tPlaneflag
End Union
Union
mark_ As Byte
mark As tMark
End Union
flightstatus As Byte
runway_ As Byte
wheelrem As Integer
listColor As tMMcolors
comment As String
Static As Integer tagTop
Static As Integer tagBottom
Static As Integer tagLeft
Static As Integer tagRight
Static As tPlane plane() 'planes array
Declare Static Function create(org As Integer = 0) As boolean
Declare Sub operate(mode As Integer)
Declare Function checkApproach(runway As tRunway) As Integer
Declare Sub savePlane(filenr As Integer)
Declare Sub loadPlane(filenr As Integer)
End Type
'dim static variables
Static As Integer tPlane.tagTop = -29 '-24
Static As Integer tPlane.tagBottom = 29 '24
Static As Integer tPlane.tagLeft = -35 '-30
Static As Integer tPlane.tagRight = 15 '10
ReDim As tPlane tPlane.plane(0)
...
Sub tPlane.savePlane(filenr As Integer)
Print #filenr, "PLANE"
Print #filenr, callsign
Print #filenr, destination
Print #filenr, origin
Print #filenr, position.x
Print #filenr, position.y
Print #filenr, tagDispBasex
Print #filenr, tagDispBasey
Print #filenr, target.x
Print #filenr, target.y
Print #filenr, selbuffer_
Print #filenr, altitude
Print #filenr, targetAltitude
Print #filenr, messageAltitude
Print #filenr, direction
Print #filenr, turn
Print #filenr, messageTurn
Print #filenr, speed
Print #filenr, targetSpeed
Print #filenr, messageSpeed
Print #filenr, timerem
Print #filenr, scheduledDepartureTime
Print #filenr, fuel
Print #filenr, planeflags
Print #filenr, mark_
Print #filenr, flightstatus
Print #filenr, runway_
End Sub
Sub tPlane.loadPlane(filenr As Integer)
Input #filenr, callsign
Input #filenr, destination
Input #filenr, origin
Input #filenr, position.x
Input #filenr, position.y
Input #filenr, tagDispBasex
Input #filenr, tagDispBasey
Input #filenr, target.x
Input #filenr, target.y
Input #filenr, selbuffer_
Input #filenr, altitude
Input #filenr, targetAltitude
Input #filenr, messageAltitude
Input #filenr, direction
Input #filenr, turn
Input #filenr, messageTurn
Input #filenr, speed
Input #filenr, targetSpeed
Input #filenr, messageSpeed
Input #filenr, timerem
Input #filenr, scheduledDepartureTime
Input #filenr, fuel
Input #filenr, planeflags
Input #filenr, mark_
Input #filenr, flightstatus
Input #filenr, runway_
timerem = Timer
operate(0)
End Sub
...
ff = FreeFile
Open "resume.pln" For Output As #ff
...
For p = 1 To UBound(tPlane.plane)
tPlane.plane(p).savePlane(ff)
Next
Close ff
...
ff = FreeFile
Open "resume.pln" For Input As #ff
...
ReDim tPlane.plane(0)
p = 0
Do Until Eof(ff)
Input #ff, g
If g = "PLANE" Then
p += 1
tPlane.create(-1)
tPlane.plane(p).loadPlane(ff)
EndIf
Loop
Close ff
Re: Can I check I understand file put & get correctly?
Just got my new machine, 64 bit win 10.
I coded saveagame in 32 bit XP.
I coded Loadagame on XP and in my new box, loading the saved file.
(I copied the code over via pen drive)
Saveagame.bas
and loadagame.bas, to run the file.
I experimented with extends object and the IS keyword, but the Run-Time Type Info was not passed across in the file and I got a blank screen.
The game is simple, just eat the coloured shapes (arrow keys) without the killer red triangles getting you.
Run saveagame then run loadagame.
Every saveagame run produces a different configuration of shapes.
The file is called "gamedata", it holds a udt array
I coded saveagame in 32 bit XP.
I coded Loadagame on XP and in my new box, loading the saved file.
(I copied the code over via pen drive)
Saveagame.bas
Code: Select all
#define seed timer
Const xres=1024 'can change within reason
Const yres=768
Type pt
As Single x,y
As Long nsides
End Type
Type piece
As pt vel
As pt p(1 to 30)
As Ulong clr
As Long active
As zstring * 6 id
as pt xy
Declare Sub Construct(As pt,As pt,As Ulong,As pt,As Long,As String ,As Long)
End Type
Type stillpiece Extends piece
End Type
Type killerpiece Extends piece
End Type
Type eaterpiece Extends piece
End Type
Function rotate(pivot As pt,p As pt,a As Single) As pt
Return Type<pt>((Cos(a)*(p.x-pivot.x)-Sin(a)*(p.y-pivot.y)) +pivot.x,_
(Sin(a)*(p.x-pivot.x)+Cos(a)*(p.y-pivot.y)) +pivot.y)
End Function
#define range(f,l) Rnd*((l)-(f))+(f)
#define Irange(f,l) Int(Rnd*((l+1)-(f)))+(f)
Sub piece.Construct(xy As pt,wh As pt,c As Ulong,v As pt,a As Long,s As String,sides As Long)
Dim As Long ctr
Dim As Single cx,cy
For z As Single=0 To 360*2 Step 360/sides
ctr+=1
If ctr>sides Then Exit For
p(ctr).x=xy.x+wh.x*Cos(z*.0174533)
p(ctr).y=xy.y+wh.y*Sin(z*.0174533)
cx+=p(ctr).x
cy+=p(ctr).y
Next z
cx/=sides:cy/=sides
Var ang=0.0
If s="eat" Then ang=Atn(1) Else ang=Rnd
For n As Long=1 To sides
p(n)=rotate(Type(cx,cy),p(n),ang)
Next n
clr=c
vel=v
active=a
id=s
p(1).nsides=sides
End Sub
Function inpolygon(p1() As pt,Byval p2 As pt) As Long
#define Winder(L1,L2,p) ((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
var lim=p1(1).nsides
Dim As Long index,nextindex,wn,k=lim+1
For n As Long=1 To lim
index=n Mod k:nextindex=(n+1) Mod k
If nextindex=0 Then nextindex=1
If p1(index).y<=p2.y Then
If p1(nextindex).y>p2.y Andalso Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1
Else
If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1
End If
Next n
Return wn
End Function
Function overlaps(p1() As pt,p2() As pt) As Long
var lim1=p1(1).nsides,lim2=p2(1).nsides
For m As Long=1 To lim2
If inpolygon(p1(),p2(m)) Then Return 1
Next m
For m As Long=1 To lim1
If inpolygon(p2(),p1(m)) Then Return 1
Next m
Return 0
End Function
sub savefile(file as string,u() as piece)
var h=freefile
open file for binary access write as #h
put #h, ,u()
close #h
end sub
'=======SET UP========
randomize seed
Dim As stillpiece s(1 To 20)
For n As Long=1 To 20
dim as ulong clr
lbl:
do
clr=irange(1,15)
loop until clr<>3 and clr<>14 and clr<>4
Var xx= range(50,xres-50),yy=range(50,yres-50)
s(n).Construct(Type<pt>(xx,yy),Type<pt>(30,30),clr,Type<pt>(0,0),1,"still",irange(4,8))
For m As Long=1 To n-1
If overlaps(s(m).p(),s(n).p()) Then Goto lbl 'keep isolated
Next m
Next n
Dim As killerpiece k(1 To 3)
For n As Long=1 To 3
Var xx= range(50,xres-50),yy=range(50,yres-50)
k(n).Construct(Type<pt>(xx ,yy),Type<pt>(20,20),4,Type<pt>(range(-1,1),range(-1,1)),1,"kill",3)
'doesn't matter too much if it overlaps a still piece
Next n
Dim As eaterpiece e(1 To 1)
lbl2:
Var xx= range(50,xres-50),yy=range(50,yres-50)
e(1).Construct(Type<pt>(xx ,yy),Type<pt>(35,35),14,Type<pt>(range(-2,2),range(-2,2)),1,"eat",4)
For m As Long=1 To Ubound(k)
var d=sqr( (e(1).p(1).x-k(m).p(1).x)^2+(e(1).p(1).y-k(m).p(1).y)^2)
If overlaps(k(m).p(),e(1).p()) or d<200 Then Goto lbl2 'dont want to overlap or be near a killpiece
Next m
redim as piece save()
Dim As Long ctr
For n As Long=Lbound(s) To Ubound(s)'still pieces
ctr+=1
Redim Preserve save(1 To ctr)
save(ctr)=s(n)
Next
For n As Long=Lbound(k) To Ubound(k)'killer pieces
ctr+=1
Redim Preserve save(1 To ctr)
save(ctr)=k(n)
Next
Redim Preserve save(1 To ctr+1)
save(Ubound(save))=e(1)'the eater piece last
save(1).xy.x=xres 'pass the screen resolutions
save(1).xy.y=yres
savefile("gamedata",save())
print "Done"
sleep
Code: Select all
#include "fbgfx.bi"
#include "file.bi"
Const jmp=2 'arrow key base stepper
dim shared as long xres
dim shared as long yres
Type pt
As Single x,y
As Long nsides
End Type
Type piece
As pt vel
As pt p(1 to 30)
As Ulong clr
As Long active
As zstring * 6 id
as pt xy
Declare Sub Construct(As pt,As pt,As Ulong,As pt,As Long,As String ,As Long)
Declare Sub blow(n As Single)
End Type
Function zip() Byref As Single
Static As Single s
Return s
End Function
Function rndlim() Byref As Single
Static As Single s
Return s
End Function
function key() byref as single
Static As Single s
Return s
End Function
Sub fill(p() As pt,c As Ulong,im As Any Ptr=0)
#define ub Ubound
Dim As Long Sy=1e6,By=-1e6,i,j,y,k
Dim As Single a(Ub(p)+1,1),dx,dy
For i =0 To Ub(p)
a(i,0)=p(i).x
a(i,1)=p(i).y
If Sy>p(i).y Then Sy=p(i).y
If By<p(i).y Then By=p(i).y
Next i
Dim As Single xi(Ub(a,1)),S(Ub(a,1))
a(Ub(a,1),0) = a(0,0)
a(Ub(a,1),1) = a(0,1)
For i=0 To Ub(a,1)-1
dy=a(i+1,1)-a(i,1)
dx=a(i+1,0)-a(i,0)
If dy=0 Then S(i)=1
If dx=0 Then S(i)=0
If dy<>0 Andalso dx<>0 Then S(i)=dx/dy
Next i
For y=Sy-1 To By+1
k=0
For i=0 To Ub(a,1)-1
If (a(i,1)<=y Andalso a(i+1,1)>y) Orelse _
(a(i,1)>y Andalso a(i+1,1)<=y) Then
xi(k)=(a(i,0)+S(i)*(y-a(i,1)))
k+=1
End If
Next i
For j=0 To k-2
For i=0 To k-2
If xi(i)>xi(i+1) Then Swap xi(i),xi(i+1)
Next i
Next j
For i = 0 To k - 2 Step 2
Line im,(xi(i),y)-(xi(i+1)+1,y),c
Next i
Next y
End Sub
Function drawpolygon(p() As Pt,clr As Ulong,flag As Long=0) As pt
Dim As Long sz=p(1).nsides
Dim As Single cx,cy
Dim As pt f(sz)
For n As Long=1 To sz
f(n-1)=p(n)
cx+=p(n).x:cy+=p(n).y
Next
cx/=sz:cy/=sz
f(sz)=p(1)
fill(f(),clr)
Return Type(cx,cy)
End Function
Function rotate(pivot As pt,p As pt,a As Single) As pt
Return Type<pt>((Cos(a)*(p.x-pivot.x)-Sin(a)*(p.y-pivot.y)) +pivot.x,_
(Sin(a)*(p.x-pivot.x)+Cos(a)*(p.y-pivot.y)) +pivot.y)
End Function
#define range(f,l) Rnd*((l)-(f))+(f)
#define Irange(f,l) Int(Rnd*((l+1)-(f)))+(f)
Sub piece.Construct(xy As pt,wh As pt,c As Ulong,v As pt,a As Long,s As String,sides As Long)
Dim As Long ctr
Dim As Single cx,cy
For z As Single=0 To 360*2 Step 360/sides
ctr+=1
If ctr>sides Then Exit For
p(ctr).x=xy.x+wh.x*Cos(z*.0174533)
p(ctr).y=xy.y+wh.y*Sin(z*.0174533)
cx+=p(ctr).x
cy+=p(ctr).y
Next z
cx/=sides:cy/=sides
Var ang=0.0
If s="eat" Then ang=Atn(1) Else ang=Rnd
For n As Long=1 To sides
p(n)=rotate(Type(cx,cy),p(n),ang)
Next n
clr=c
vel=v
active=a
id=s
p(1).nsides=sides
End Sub
Sub piece.blow(n As Single)
Dim As Single cx,cy
var lim=p(1).nsides
For m As Long=Lbound(p) To lim
cx+=p(m).x
cy+=p(m).y
Next m
cx=cx/lim:cy=cy/lim
For m As Long=Lbound(p) To lim
p(m).x=n*(p(m).x-cx)+cx
p(m).y=n*(p(m).y-cy)+cy
Next m
End Sub
Type stillpiece Extends piece
Declare Sub Draw()
End Type
Sub stillpiece.draw()
drawpolygon(p(),clr)
End Sub
Type killerpiece Extends piece
Declare Sub move()
Declare Sub Draw()
End Type
Sub killerpiece.move
var lim=p(1).nsides
For n As Long=Lbound(p) To lim
p(n).x+=vel.x*zip
p(n).y+=vel.y*zip
Next
For n As Long=Lbound(p) To lim
If p(n).x<1 Or p(n).x>xres-1 Then vel.x=-vel.x:Exit For
If p(n).y<1 Or p(n).y>yres-1 Then vel.y=-vel.y:Exit For
Next n
End Sub
Sub killerpiece.draw()
drawpolygon(p(),clr)
End Sub
Type eaterpiece Extends piece
Declare Sub move()
Declare Sub Draw()
End Type
Sub eaterpiece.move
var lim=p(1).nsides
If Multikey(75) Then For n As Long=1 To lim:p(n).x-=jmp+key:Next:key()+=1' r
If Multikey(77) Then For n As Long=1 To lim:p(n).x+=jmp+key:Next:key()+=1' l
If Multikey(80) Then For n As Long=1 To lim:p(n).y+=jmp+key:Next:key()+=1 'up
If Multikey(72) Then For n As Long=1 To lim:p(n).y-=jmp+key:Next:key()+=1 'down
For n As Long=Lbound(p) To lim'Ubound(p)
If p(n).x<1 Or p(n).x>xres-1 Then key()=0
If p(n).y<1 Or p(n).y>yres-1 Then key()=0
Next n
static as fb.event e
screenevent(@e)
if e.type=fb.EVENT_KEY_RELEASE then key()=jmp
End Sub
Sub eaterpiece.draw()
Var p=drawpolygon(p(),clr )
..draw String(p.x-12,p.y-8),"EAT",0
End Sub
'non methods and overlapping boxes macros
Function inpolygon(p1() As pt,Byval p2 As pt) As Long
#define Winder(L1,L2,p) ((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
var lim=p1(1).nsides
Dim As Long index,nextindex,wn,k=lim+1
For n As Long=1 To lim
index=n Mod k:nextindex=(n+1) Mod k
If nextindex=0 Then nextindex=1
If p1(index).y<=p2.y Then
If p1(nextindex).y>p2.y Andalso Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1
Else
If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1
End If
Next n
Return wn
End Function
Function overlaps(p1() As pt,p2() As pt) As Long
var lim1=p1(1).nsides,lim2=p2(1).nsides
For m As Long=1 To lim2'Ubound(p2)
If inpolygon(p1(),p2(m)) Then Return 1
Next m
For m As Long=1 To lim1'Ubound(p1)
If inpolygon(p2(),p1(m)) Then Return 1
Next m
Return 0
End Function
'non member functions
Sub checkimpacts(w() As piece)
For n1 As Long=1 To Ubound(w)-1
For n2 As Long=n1+1 To Ubound(w)
If overlaps(w(n2).p(),w(n1).p()) Then
If n1=24 And w(n2).id="still" And w(n2).active Then w(24).blow(1.05):w(n2).active=false
If n2=24 And w(n1).id="still" And w(n1).active Then w(24).blow(1.05):w(n1).active=false
If n1=24 And w(n2).id="kill" Then w(24).active=false
If n2=24 And w(n1).id="kill" Then w(24).active=false
End If
Next n2
Next n1
End Sub
Sub showAllBoxes(w() As piece)
For n As Long=1 To ubound(w)
If w(n).id="kill" Then Cast(killerpiece Ptr,@w(n))->move
If w(n).id="eat" Then Cast(eaterpiece Ptr,@w(n))->move
If w(n).active Then
If w(n).id="kill" Then Cast(killerpiece Ptr,@w(n))->Draw
If w(n).id="eat" Then Cast(eaterpiece Ptr,@w(n))->Draw
If w(n).id="still" Then Cast(stillpiece Ptr,@w(n))->Draw
End If
Next n
End Sub
Function LooksLikeDone(w() As piece) As Long
Dim As Long ctr
For n As Long=Lbound(w) To Ubound(w)
If w(Ubound(w)).active=0 Then
Screenunlock
Print "LOSE"
Return 1
End If
If w(n).active=0 Then ctr+=1
Next n
If ctr=20 Then
Screenunlock
Print "WIN"
Return 1
End If
End Function
Sub PopOneBack(w() As piece,s() As piece) 'now and then
Var z=Irange(1,20)'pop up somewhere else, but clear of others
Dim As piece eater=w(Ubound(w))
dim as ulong clr
If w(z).active=0 And Rnd<rndlim Then
Dim As stillpiece tmp
lbl3:
do
clr=irange(1,15)
loop until clr<>3 and clr<>14 and clr<>4
Var xx= range(50,xres-50),yy=range(50,yres-50)
tmp.Construct(Type<pt>(xx,yy),Type<pt>(30,30),clr,Type<pt>(0,0),1,"still",6)
For m As Long=1 To Ubound(s)
If m<>z Then
If overlaps(s(m).p(),tmp.p()) Then Goto lbl3
End If
If overlaps(eater.p(),tmp.p()) Then Goto lbl3
Next m
s(z)=tmp
w(z)=s(z) 'update working array
End If
End Sub
Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
Static As Double timervalue,_lastsleeptime,t3,frames
frames+=1
If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
If sleeptime<1 Then sleeptime=1
_lastsleeptime=sleeptime
timervalue=Timer
Return sleeptime
End Function
sub load(file as string,u() as piece)
var f=freefile
if fileexists(file)=0 then print file;" not found":return
Open file For Binary Access Read As #f
If Lof(f) > 0 Then
Get #f, ,u()
End If
Close #f
end sub
'==== load the data ==============
var L=filelen("gamedata")\sizeof(piece)
redim as piece w(1 to L)
load("gamedata",w())
dim as piece s(1 to 20)
for n as long=1 to 20
s(n)=w(n)
next n
xres=w(1).xy.x 'retrieve the screen resolutions
yres=w(1).xy.y
Screenres xres,yres
Width xres\8,yres\16
Color , 3
'================================================
'start menu
#define inbox(b) mx>b.x And mx<b.x+300 And my>b.y And my<b.y+50
#macro showbox(z,f)
If f =0 Then Line (z.x,z.y)-(z.x+300,z.y+50),0,b Else Line (z.x,z.y)-(z.x+300,z.y+50),4,bf
#endmacro
Dim As pt start(1 To 3)={(200,200),(200,250),(200,300)}
Dim As Long mx,my,btn
Do
Getmouse mx,my,,btn
Screenlock
Cls
For n As Long=1 To 3
showbox(start(n),0)
If n=1 Then Draw String(220,200),"Very easy"
If n=2 Then Draw String(220,250),"Moderate"
If n=3 Then Draw String(220,300),"More difficult"
Next
For n As Long=1 To 3
If inbox(start(n)) Then
showbox(start(n),1)
If n=1 Then Draw String(220,200),"Very easy"
If n=2 Then Draw String(220,250),"Moderate"
If n=3 Then Draw String(220,300),"More difficult"
If btn=1 Then
Select Case n
Case 1:zip()=1:rndlim()=.001
Case 2:zip()=2:rndlim()=.01
Case 3:zip()=4:rndlim()=.05
End Select
End If
End If
Next n
Screenunlock
Sleep 10
Loop Until btn=1
'=================================================
'run game
Dim As Long fps,lastframes,k
Do
Screenlock
Cls
Draw String(10,30),"FPS "&fps
showAllBoxes(w())
CheckImpacts(w())
PopOneBack(w(),s())
If LooksLikeDone(w()) Then lastframes=1
if lastframes then k+=1
Screenunlock
if k>60 then exit do
Sleep regulate(65,fps)
Loop Until inkey=chr(27)
dim as fb.event ev
do
screenevent(@ev)
loop until ev.type=fb.EVENT_KEY_RELEASE
while inkey<>"":wend
Sleep
sleep
The game is simple, just eat the coloured shapes (arrow keys) without the killer red triangles getting you.
Run saveagame then run loadagame.
Every saveagame run produces a different configuration of shapes.
The file is called "gamedata", it holds a udt array
Re: Can I check I understand file put & get correctly?
Indeed, the first member of such an object is the vptr (pointer to the vtable of its run-time type), but only its value is written in the file.dodicat wrote: I experimented with extends object and the IS keyword, but the Run-Time Type Info was not passed across in the file and I got a blank screen.
When restarting the program, there is no reason for the vtable of the type to be create at the same address as during the previous execution.
Re: Can I check I understand file put & get correctly?
dodicat wrote: ↑Jul 29, 2020 17:36 Save and load a udt array.
It is all in the help files.
For no warnings/errors, fixed length strings and arrays.
If you extend object and use OOP in general, then you may be in trouble, but I have not really tested this out yet.
(If you use abstract then you won't be able even to create udt objects in the first place, so you are definitely in trouble.)
You may have to save any child udt's extending the main udt.
I will experiment with saving a game to file -- sometime.
Code: Select all
width 100,500 #include "file.bi" type udt as zstring * 50 num as long x,y as string * 100 s as single a(1 to 8) declare sub printout() end type sub udt.printout() with this print .num print .x,.y print .s for m as long=lbound(.a) to ubound(.a) print .a(m); next m print end with print end sub sub load(file as string,u() as udt) var f=freefile if fileexists(file)=0 then print file;" not found":return Open file For Binary Access Read As #f If Lof(f) > 0 Then Get #f, ,u() End If Close #f end sub sub save(file as string,u() as udt) var h=freefile open file for binary access write as #h put #h, ,u() close #h end sub dim as udt x(1 to 3) for n as long=lbound(x) to ubound(x) with x(n) .num= "Element " +str(n) .x=n .y=n*2 .s="hi " +string(70,"-") +str(n) for m as long=lbound(.a) to ubound(.a) .a(m)=rnd next m end with next n print "ORIGINAL" for n as long=lbound(x) to ubound(x) x(n).printout() next save("data",x()) var N=filelen("data")\sizeof(udt) 'get the number of elements to load redim as udt y(1 to N) load("data",y()) print print print "============= FROM FILE =============" for n as long=1 to ubound(y) y(n).printout() next sleep kill "data"
Thanks
19-04-2022 I could do it with variable Array and run ok----------------------------Code: Select all
ReDim (x(1).a)(1 To 8) ' <-- All the Redim coul be a FOR 1 to 100 ,but is not necessary, run ok the rest of the array is blank For i=1 to 100 ReDim (x(i).a)(1 To 8) next i
Code: Select all
width 100,500 #include "file.bi" type udt as zstring * 50 num as long x,y as string * 100 s as single a(Any) declare sub printout() end type sub udt.printout() with this print .num print .x,.y print .s for m as long=lbound(.a) to ubound(.a) print .a(m); next m print end with print end sub sub load(file as string,u() as udt) var f=freefile if fileexists(file)=0 then print file;" not found":return Open file For Binary Access Read As #f If Lof(f) > 0 Then Get #f, ,u() End If Close #f end sub sub save(file as string,u() as udt) var h=freefile open file for binary access write as #h put #h, ,u() close #h end sub ReDim x (1 To 100) As udt 'here I adjust the ANY ReDim (x(1).a)(1 To 8) ReDim (x(2).a)(1 To 8) ReDim (x(3).a)(1 To 8) for n as long=lbound(x) to ubound(x) with x(n) .num= "Element " +str(n) .x=n .y=n*2 .s="hi " +string(70,"-") +str(n) for m as long=lbound(.a) to ubound(.a) .a(m)=rnd next m end with next n print "ORIGINAL" for n as long=lbound(x) to ubound(x) x(n).printout() Sleep next save("data",x()) var N=filelen("data")\sizeof(udt) 'get the number of elements to load redim as udt y(1 to N) load("data",y()) print print print "============= FROM FILE =============" for n as long=1 to ubound(y) y(n).printout() next sleep kill "data"