Can I check I understand file put & get correctly?

New to FreeBASIC? Post your questions here.
Post Reply
olympic sleeper
Posts: 41
Joined: Jun 07, 2020 15:47

Can I check I understand file put & get correctly?

Post by olympic sleeper »

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.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Can I check I understand file put & get correctly?

Post by fxm »

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:
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.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Can I check I understand file put & get correctly?

Post by badidea »

olympic sleeper wrote:If so Is there anything I need to watch for?
Yes, also don't use the (U)Integer data type.
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)
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Can I check I understand file put & get correctly?

Post by fxm »

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.
.....
On the contrary, the UDT array can be of variable-length (resizable).
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Can I check I understand file put & get correctly?

Post by badidea »

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
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Can I check I understand file put & get correctly?

Post by fxm »

badidea wrote:A "put" for my example above:

Code: Select all

.....
	for i as integer = 0 to ubound(bla)
		put #fileNum, , bla(i)
	next
.....
or simpler:

Code: Select all

.....
	put #fileNum, , bla()
.....
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Can I check I understand file put & get correctly?

Post by dodicat »

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"

 
Last edited by dodicat on Jul 29, 2020 17:56, edited 1 time in total.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Can I check I understand file put & get correctly?

Post by fxm »

Code: Select all

.....
    for m as long=1 to 8 ' and not 10, otherwise out of bounds
        .a(m)=rnd
    next m
.....
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Can I check I understand file put & get correctly?

Post by dodicat »

Sorry, fixed that.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Can I check I understand file put & get correctly?

Post by grindstone »

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


dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Can I check I understand file put & get correctly?

Post by dodicat »

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

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


  
and loadagame.bas, to run the file.

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

 
   
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
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Can I check I understand file put & get correctly?

Post by fxm »

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.
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.
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.
jmgbsas
Posts: 35
Joined: Dec 26, 2020 16:03

Re: Can I check I understand file put & get correctly?

Post by jmgbsas »

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"

Post Reply