PlayBASICFX / PBFX Vm2 Translation (WIP)

[kevin]

 Low Level Type Instruction Set on VM2

    Currently i'm testing the read type instructions at the moment.  Seem to be working, at least the basic data types anyway.

Code Select Expand



Type Tpos
x,y,z
f#
s$
ArrayI(100)
ArrayF#(100)
ArrayS$(100)
EndType

Dim Obj(10) as tpos

Dim PointerToObject as Tpos pointer
PointerToObject = new tpos

; alloc
Obj(1)=new Tpos

; copy from existing typed pointer
; Obj(2)=PointerToObject

; Write a NULL cell (integer assign)
Obj(3)=new Tpos
Obj(3)=0


Print Obj(1)
Print Obj(2)
Print Obj(3)



obj(1).x=50
obj(1).f=123.456
obj(1).s="string"

; read opcodes
print Obj(1).x
print Obj(1).F#
print Obj(1).s$

Sync
waitkey





    Embedded  structure support (Int/float/String).

Code Select Expand



Type Tpos
x,y,z
f#
s$
ArrayI(100)
ArrayF#(100)
ArrayS$(100)
EndType

Dim Obj(10) as tpos

Dim PointerToObject as Tpos pointer
PointerToObject = new tpos

; alloc
Obj(1)=new Tpos

; copy from existing typed pointer
; Obj(2)=PointerToObject

; Write a NULL cell (integer assign)
Obj(3)=new Tpos
Obj(3)=0

Print Obj(1)
Print Obj(2)
Print Obj(3)

obj(1).x=50
obj(1).f=123.456
obj(1).s="string"

; read opcodes
print Obj(1).x
print Obj(1).F#
print Obj(1).s$

; nested structures
Obj(1).Arrayi(10)=1000
Obj(1).Arrayf(10)=222.46
Obj(1).Arrays(10)="String array"

print Obj(1).Arrayi(10)
print Obj(1).Arrayf(10)
print Obj(1).Arrays(10)

Sync
waitkey



  Export nested typed pointer

Code Select Expand


type tNestedStuff
a,b,c
EndType

Type Tpos
x,y,z
f#
s$
ArrayI(100)
ArrayF#(100)
ArrayS$(100)

Nest as tNestedStuff

EndType

Dim Obj(10) as tpos

Dim PointerToObject as Tpos pointer
PointerToObject = new tpos

; alloc
Obj(1)=new Tpos

; copy from existing typed pointer
; Obj(2)=PointerToObject

; Write a NULL cell (integer assign)
Obj(3)=new Tpos
Obj(3)=0

Print Obj(1)
Print Obj(2)
Print Obj(3)

obj(1).x=50
obj(1).f=123.456
obj(1).s="string"

; read opcodes
print Obj(1).x
print Obj(1).F#
print Obj(1).s$

; nested structures
Obj(1).Arrayi(10)=1000
Obj(1).Arrayf(10)=222.46
Obj(1).Arrays(10)="String array"

print Obj(1).Arrayi(10)
print Obj(1).Arrayf(10)
print Obj(1).Arrays(10)

; Get pointer to Nested Types
InitNest(Obj(1).Nest)
print Obj(1).nest.a
print Obj(1).nest.b
print Obj(1).nest.c

Sync
waitkey



Function InitNest(Me as tNestedStuff Pointer)
me.a=5555
me.b=6666
me.c=7777
EndFunction



[kevin]

 Read field & field pointer copies.

Code Select Expand


type tNestedStuff
a,b,c
EndType

Type Tpos
x,y,z
f#
s$
ArrayI(20)
ArrayF#(20)
ArrayS$(20)

Nest as tNestedStuff

EndType

Dim VarType as tpos

VarType = new tpos
VarType.x =12345
VarType.s ="variable type string"

for lp=0 to 10
VarType.Arrays$(lp)="String "+str$(lp+20000)
next

Dim Obj(10) as tpos

Dim PointerToObject as Tpos pointer
PointerToObject = new tpos

; alloc
Obj(1)=new Tpos

; copy from existing typed pointer
; Obj(2)=PointerToObject

; Write a NULL cell (integer assign)
Obj(3)=new Tpos

Obj(4)=new Tpos


Print Obj(1)
Print Obj(2)
Print Obj(3)

obj(1).x=50
obj(1).f=123.456
obj(1).s="string"

; read opcodes
print Obj(1).x
print Obj(1).F#
print Obj(1).s$

; nested structures
Obj(1).Arrayi(10)=1000
Obj(1).Arrayf(10)=222.46
Obj(1).Arrays(10)="String array"

print Obj(1).Arrayi(10)
print Obj(1).Arrayf(10)
print Obj(1).Arrays(10)

; Get pointer to Nested Types
InitNest(Obj(1).Nest)
print Obj(1).nest.a
print Obj(1).nest.b
print Obj(1).nest.c


; copy via pointer
Obj(3).tpos= obj(1).tpos

; Null via pointer
Obj(1).tpos= 0

; Assign pointer a type variable/list handle
Obj(4).tpos= VarType.Tpos

Sync
waitkey



Function InitNest(Me as tNestedStuff Pointer)
me.a=5555
me.b=6666
me.c=7777
EndFunction






BenchMark

   This is the standard array/type field access benchmark from way back. 

   Vm2 runs this test 2.3 times faster than Vm1

Code Select Expand


MakeBitmapFont 1,$ffffff

Dim TestArrayInt(1000)
Dim TestArrayFloat#(1000)

Type Mixed
i,f#
endtype

Dim TestArray(1000) as Mixed

for lp=0 to 1000
TestArray(lp)= new Mixed
next
Dim Results#(100)
TestStart=Timer()


MaxTests=10000

Repeat
Cls 0
frames=frames+1

Test=0
Print "Array + Type Test "+str$(Maxtests)+" Tests"

Print "Current Frame:"+Str$(frames)
print ""


ts=Timer()
For i = 0 To MaxTests
index=i and $ff
TestArrayInt(index)=TestArrayInt(index)+1
Next i
t=Timer()-ts
totalloops=totalloops+i
Results#(test)=results#(test)+t
Print "Integer Array: Addition:"+Str$(results#(test)/frames)
test=test+1


ts=Timer()
For i = 0 To MaxTests
index=i and $ff
TestArrayFloat#(index)=TestArrayFloat#(index)+1
Next i
t=Timer()-ts
totalloops=totalloops+i
Results#(test)=results#(test)+t
Print "Float Array: Addition:"+Str$(results#(test)/frames)
test=test+1


ts=Timer()
For i = 0 To MaxTests
index=i and $ff
TestArray(index).i=TestArray(0).i+1
Next i
t=Timer()-ts
totalloops=totalloops+i
Results#(test)=results#(test)+t
Print "Typed Array: Integer Field:"+Str$(results#(test)/frames)
test=test+1


ts=Timer()
For i = 0 To MaxTests
index=i and $ff
TestArray(index).f=TestArray(index).f+1
Next i
t=Timer()-ts
Results#(test)=results#(test)+t
Print "Typed Array: Float Field:"+Str$(results#(test)/frames)
test=test+1


totalloops=totalloops+i
print TotalLoops
Sync

Until Frames>200

Print "Test Complete"
testEnd=Timer()-TestSTart
Print "Seconds:"+Str$((timer()-TestStart)/1000.0)
Sync
WaitKey


[kevin]

  Moving Embedded Data opcodes To Vm2

    So far the basic replacement frame work is in place, it shouldn't take too long to rewrite the opcodes, since there's only a handful of them.

Code Select Expand



Print GetDataType()
Print GetDataPointer()
Print GetDataQuantity()

Sync
Waitkey

Data "234.45"
Data 1,2,3,4,5,6,7,8,9,10






ReadData()

Code Select Expand


Print "Running"

for lp=0 to 10
Ptr=GetDataPointer()
A=ReadData()
Print digits$(Ptr,4)+"  "+str$(a)
next

Sync
Waitkey

Data 111,2222,33.33,4444,5555,6666,7777,8888,9999,101010
Data 234.45








ReadData#()

Code Select Expand


Print "Running"

for lp=0 to 10
Ptr =GetDataPointer()
A# =ReadData#()
Print digits$(Ptr,4)+"  "+str$(a#)
next

Sync
Waitkey

Data 111,2222,33.33,4444,5555,6666,7777,8888,9999,101010
Data 234.45




ReadData$()

Code Select Expand


Print "Running"

for lp=1 to 5
Ptr =GetDataPointer()
A$ =ReadData$()
Print digits$(Ptr,4)+"  "+a$
next

Sync
Waitkey

Data "A","B","C","D","E"
Data 234.45


[kevin]

 Find Data (string)

Code Select Expand



For lp=4 to 0 step -1
This$=chr$( asc("A") + lp )
This$=This$+This$
Index=FindData(This$,0,0)
print Digits$(Index,4)+"  "+This$
Next

Sync
Waitkey

Data "AA","BB","CC","DD","EE"
Data 234.45



Code Select Expand


// Find Integers
print "ints"
For lp=4 to 0 step -1
ThisInt =rnd(10)*1000
Index=FindData(ThisInt,0,0)
print Digits$(Index,4)+"  "+Str$(ThisInt)
Next


// Find Floats
print "Floats"
For lp=4 to 0 step -1
ThisFlt# =(rnd(10)*10)+0.5
Index=FindData(ThisFlt#,0,0)
print Digits$(Index,4)+"  "+Str$(ThisFlt#)
Next

// Find strings
print "Strings"
For lp=4 to 0 step -1
This$=chr$( asc("A") + lp )
This$=This$+This$
Index=FindData(This$,0,0)
print Digits$(Index,4)+"  "+This$
Next

Sync
Waitkey

Data 0000,1000,2000,3000,4000,5000,6000,7000,8000,9000,10000
Data 0000,10.5, 20.5, 30.5, 40.5, 50.5, 60.5, 70.5,80.5,90.5,100.5

Data "AA","BB","CC","DD","EE","FF","GG","HH","II","JJ"



[kevin]

Restore LABEL

Code Select Expand


// Label restores

// Find Integers
restore MyIntegers
Print "Ints"
For lp=0 to 5
print Digits$(GetDataPointer(),4)+"  "+Str$(ReadData())
Next

restore MyFloats
Print "floats"
For lp=0 to 5
print Digits$(GetDataPointer(),4)+"  "+Str$(ReadData#())
Next

restore MyStrings
Print "Strings"
For lp=0 to 5
print Digits$(GetDataPointer(),4)+"  "+ReadData$()
Next


Sync
Waitkey

; Data "STUFF"

MyIntegers:
Data 1000,2000,3000,4000,5000,6000,7000,8000,9000,10000


MyFloats:
Data 10.5, 20.5, 30.5, 40.5, 50.5, 60.5, 70.5,80.5,90.5,100.5

MyStrings:
Data "AA","BB","CC","DD","EE","FF","GG","HH","II","JJ"





Restore Integer/Float Value

Code Select Expand


// Integer restores

// Find Integers
restore 1  // Set the data pointer manually
Print "Ints"
For lp=0 to 5
print Digits$(GetDataPointer(),4)+"  "+Str$(ReadData())
Next

restore 11
Print "floats"
For lp=0 to 5
print Digits$(GetDataPointer(),4)+"  "+Str$(ReadData#())
Next

restore 21
Print "Strings"
For lp=0 to 5
print Digits$(GetDataPointer(),4)+"  "+ReadData$()
Next


Sync
Waitkey

Data "STUFF"

//MyIntegers:
Data 1000,2000,3000,4000,5000,6000,7000,8000,9000,10000


//MyFloats:
Data 10.5, 20.5, 30.5, 40.5, 50.5, 60.5, 70.5,80.5,90.5,100.5

// MyStrings:
Data "AA","BB","CC","DD","EE","FF","GG","HH","II","JJ"




String Restores

Code Select Expand


// String Token restores

restore "MyIntegers"
print ReadData$()
For lp=0 to 5
print Digits$(GetDataPointer(),4)+"  "+Str$(ReadData())
Next

restore "MyFloats"
print ReadData$()
For lp=0 to 5
print Digits$(GetDataPointer(),4)+"  "+Str$(ReadData#())
Next

restore "MyStrings"
print ReadData$()
For lp=0 to 5
print Digits$(GetDataPointer(),4)+"  "+ReadData$()
Next

Sync
Waitkey

Data "STUFF"

data "MyIntegers"
Data 1000,2000,3000,4000,5000,6000,7000,8000,9000,10000


data "MyFloats"
Data 10.5, 20.5, 30.5, 40.5, 50.5, 60.5, 70.5,80.5,90.5,100.5

data "MyStrings"
Data "AA","BB","CC","DD","EE","FF","GG","HH","II","JJ"



BenchMark

  VM2 runs this about twice as fast as VM1.

  Integer Test Vm2 is 2.4 times faster
  Float Test Vm2 is 2.5 times faster
  String Test Vm2 is 1.8 times faster

Code Select Expand



maxtests=10000

do
cls 0
inc frames

t=timer()
For lp=0 to maxtests

restore "MyIntegers"
Label$=ReadData$()
a=ReadData()
a=ReadData()
a=ReadData()
a=ReadData()
a=ReadData()
next
t1#=t1#+(timer()-t)
print "Integers:"+str$(t1#/frames)

t=timer()
For lp=0 to maxtests
restore "MyFloats"
Label$=ReadData$()
a#=ReadData#()
a#=ReadData#()
a#=ReadData#()
a#=ReadData#()
a#=ReadData#()
next
t2#=t2#+(timer()-t)
print "Floats:"+str$(t2#/frames)


t=timer()
For lp=0 to maxtests
restore "MyStrings"
Label$=ReadData$()
a$=ReadData$()
a$=ReadData$()
a$=ReadData$()
a$=ReadData$()
a$=ReadData$()
next
t3#=t3#+(timer()-t)
print "Strings:"+str$(t3#/frames)

Sync
loop




data "MyIntegers"
Data 1000,2000,3000,4000,5000,6000,7000,8000,9000,10000


data "MyFloats"
Data 10.5, 20.5, 30.5, 40.5, 50.5, 60.5, 70.5,80.5,90.5,100.5

data "MyStrings"
Data "AA","BB","CC","DD","EE","FF","GG","HH","II","JJ"



[kevin]

    Replaced another pocket Vm1 &  launcher / environment functions tonight,  some are actual commands such the FPS() stuff, most are not.  Anyway,   I've made one change to the FPS stuff, that is, they now allow the user to select a max frame rate in floating point.   Previously it was integer only,  which meant that due to rounding errors you'll generally get a few fps lower than requested.    Now the replacements will also suffer from rounding issues.   But this just allows you to 'tweak' the rate little more.

Code Select Expand



setfps 60.7

Do
cls 255

print fps()
print GetFps()

print 1000.0/GetFps()

Sync
loop



[kevin]

 PBFX V1.74RC2 - Auto Casting for Internal & Externally Bound Functions

   Previous versions of the 1.72/1.73 required explicit type matching when dealing with functions internally and externally bound.  Meaning that if the function was declared requiring an Integer parameter say, and you passed it a float, the compiler would have previously halted and pop an error.   This was most notable with externally bound functions, which the latest FX builds using more and more of.  Therefore making the function matching seem much stricter.  Anyway, the auto casting will ease this.   It's also be added to internally bound functions as well.

   It should be noted though, that if PB has to auto casting a parameter for you, this will cost you one operation at runtime.  So it's always best to keep the data types matching throughout.

Code Select Expand



// Auto recasting of integers to floats for bound functions
setfps 50


x#=100

print GetFps()
lockbuffer
dotc x#,x#,255
p=point(x#,x#)
p=fastpoint(X#,X#)
unlockbuffer
print p
Sync
waitkey

   

[kevin]

 PBFX V1.74RC2 - Auto Type Allocation Restored

    RC2 now includes Auto type allocation when writing to none existent types within the container (aka the array). Therefore allowing a lot of old code (such as the stuff bellow) to run again.     The picture bellow is the recent Frogger demo running in 1.74RC2.   A few changes we're needed to make it run, primarily relating to the CurrentDir$() function.  Since bound functions names can't currently include post fixes.. So CurrentDir$() should be CurrentDir() in PBFX, for the time being. 

Code Select Expand


  Type Stuff
  Status
  x#,y#
  EndTYpe
 
  Type Yeah
  a,b,c
status
  x#,y#
  EndTYpe


  Type Yeah2
  a,b,c
status
  x#,y#
  EndTYpe


  Dim collection(10) as stuff
  Dim collection2(10) as stuff
  Dim collection3(10) as yeah
   
Collection(5).status=true
Collection(6) = new yeah

Collection(5).x#=100
Collection(5).y#=2100
Print Collection(5).status
Print Collection(5).x#
Print Collection(5).Y#
 
sync
waitkey


[kevin]

 PBFX V1.74RC5 - Polishing Off Arrays

     After looking through some programs noticed there's a few Array commands not fully in the VM2 side of the runtime.  Namely Set/Get array.  Both of which use these extra info tables that I was going to replace in VM2, but since time is pressing, I'm just shoveling them across for the time being.   

Test getArray()

Code Select Expand



Type Pos
x,ymz
endType

Dim STuff1(1)
Dim STuff2(1)

Dim STuff1#(1)
Dim STuff2#(1)

Dim STuff1$(1)
Dim STuff2$(1)

Dim Vertex as pos
DIm VertexArray(10) as pos

print GetArray(Stuff1())
print GetArray(Stuff2())
print GetArray(Stuff1#())
print GetArray(Stuff2#())
print GetArray(Stuff1$())
print GetArray(Stuff2$())

print GetArray(Vertex())
print GetArray(VertexArray())


Sync
waitkey




[kevin]

 PBFX V1.74RC5 - SetArray

  Had a few drama's getting SetArray to work initially, but it now seems to be working as expected.  

PlayBASIC Code: [Select]

 max=10
 Dim Table(max)
 
 For lp=0 to max 
    Table(lp)=rnd(100)
   print Table(lp)
 next


 MakeArray Lookup()

 
 SetArray LookUp(),GetArray(Table())

 print "Redirected array"
 For lp=0 to max 
   print LookUp(lp)
 next

 Sync
 Waitkey

PlayBASIC Code: [Select]

 max=10
 Dim Table2(max)
 Dim Table(max)
 
 For lp=0 to max 
    Table(lp)=rnd(100)
   print Table(lp)
 next


 MakeArray Lookup()

 H=GetArray(Table())
 SetArray LookUp(),h

 print "Redirected array"
 print h
 
 For lp=0 to max 
   print LookUp(lp)
 next


  ThisFunction(h)

  ThisOtherFunction(h)

 Sync
 Waitkey



Function ThisFunction(ThisArray)

 print "Locally"
 print ThisArray
   makeArray Localarray()
   SetArray LocalArray(),ThisArray

   For lp=0 to GetArrayElements(localArray(),1)
         print LocalArray(lp)
   next

EndFunction


Function ThisOtherFunction(ThisArray)
 Max=5
 Dim Cool(max)


 Print "standard local"
 
 For lp=0 to max 
       Cool(lp)=rnd(100)   
      print Cool(lp)
 next

 MakeArray Localarray()
 SetArray LocalArray(),GetArray(Cool())

 Print "redirect locally"
  
 For lp=0 to max 
      print LocalArray(lp)
 next


EndFunction

[kevin]

 Set/Get/Delete Array Benchmark

 VM2 runs this benchmark about 2->4 times as fast as VM1.

 GetArray Test Vm2 is 4.1 times faster
 SetArray Test Vm2 is 2.3 times faster
 DeleteArray Test Vm2 is 2.2 times faster

PlayBASIC Code: [Select]

 max=10
 Dim Table2(max)
 Dim Table(max)
 
 For lp=0 to max 
    Table(lp)=rnd(100)
 next

 MakeArray Lookup()



   maxtests=25000

   do
      cls 0
      inc frames

      t=timer()
      For lp=0 to maxtests
          H=GetArray(Table())
      next
      t1#=t1#+(timer()-t)
      print "GetArray:"+str$(t1#/frames)
   
      t=timer()
      For lp=0 to maxtests
          SetArray LookUp(),h
      next
      t2#=t2#+(timer()-t)
      print "SetArray:"+str$(t2#/frames)


      t=timer()
      For lp=0 to maxtests
          DeleteArray LookUp()
      next
      t3#=t3#+(timer()-t)
      print "DeleteArray:"+str$(t3#/frames)

   Sync
loop

[kevin]

  Vm2 Number Crunching

  While the translation to VM2 isn't complete (but pretty close) it's become already pretty apparent that certain functions can yield anything from 2 to 5 times the performance of VM1.  But those are generally focused tests, the following are some result running old demos (unchanged) in current VM2 betas running against the fastest VM1 V1.64b/c.   

  The first demo is the fire lines example from Projects/Demos.  The demo was changed to display the frame rate on screen, the version and number of the lines.  With 250 firelines (28 sections each, that's 7000 z sorted line fragments)   1.64 runs it 20/21fps,  1.74 runs it 52/53 fps.  So in a real world test VM2 is about 2.4 times the processing speed of Vm1.

[kevin]

 Shape Particles

   This is the shape particles demo from the Projects/Demos.   Even though this demo is mainly rendering bound,  VM2 can squeeze another 30 off fps out it.  Which is pretty surprising.



Dot Sphere

   This is the dot sphere example, VM2 runs it about 100fps faster than Vm1. 

Dot Shpere (Code)

 

[kevin]

   Vm2 Fractal Crunching

   Fractals are notoriously processor hungry and not really the sort of thing that we should be doing in PB really.  Having said that,  it's here that we start to see just how much better the number crunching performance of VM2 in PBFX V1.74 is when compared the quickest VM1 edition in PB1.64.    Vm2 runs this demo in about 5 seconds.  Which works out to be about (approx) 61,000 pixels per second.  Vm1 took 21/22 seconds (approx) 14,000 pixels per second.  So in this real world raw performance test,  we're seeing approximately 4 times the number crunching performance.  

Test Code

PlayBASIC Code: [Select]

openscreen 640,480,16,1
titlescreen playbasic$

x#=-1.257
y#=-0.126
z#=0.02
z2#=0.015
StartTime=timer()


For ypoint=0 To 479
lockbuffer
For xpoint=0 To 639
x1#=x#+(z#/640)*xpoint
y1#=y#+(z2#/480)*ypoint
x2#=x#+(z#/640)*xpoint
y2#=y#+(z2#/480)*ypoint

 For b=0 To 200
  x3#=x2#*x2#-y2#*y2#+x1#
  y3#=2*x2#*y2#+y1#
  a#=Sqrt(x3#*x3#+y3#*y3#)
  x2#=x3#
  y2#=y3#
  If a#>=2.0 Then Exit
 Next
If a#>2.0
 r=255-b
 g=0
 b=50+b

 col1=lsl32(r,16)+g+b

 dotc xpoint,ypoint,col1

 EndIf

Next

unlockbuffer
if toss=30
      sync
      toss=0
endif
inc toss


Next

 ShowINfo(startTime,ypoint)

Sync

WaitKey



Function ShowINfo(StartTime,Ypoint)
boxc 0,0,100,30,true,0
text 0,15,(timer()-starttime)/1000.0

 if mod(ypoint,SyncEvery)=0 then sync
EndFunction

 P.S.  If you look closely, the inner loop of this code could be improved a great deal.  See Optimization :)

[kevin]

   Restoring Vm1/Vm2 File Functions

    While a lot of the old file command set has been replaced,  a lot of the disc processing stuff is still bound to the Vm1 side of the runtime.  Making programs that are Dependant upon reading/write files misbehave.  While it probably wouldn't take took long to move the whole library across to the VM2,  i'm going to fore go that for time being and temporarily hook the read/write command set into the Vm2 program data tables.   While this will restore the original functionality, they won't be anywhere near as quick as pure Vm2 solution (context switching between VM's).    We'll tackle that post V1.74.


My Test codes:

PlayBASIC Code: [Select]

   Dim ChrBuffer(0)
   Dim WordBuffer(0)
   Dim IntBuffer(0)
   Dim Text$(0)

   Filename$="C:\Features.txt"
   print LoadTextFile(Filename$,text$())
   
   print LoadCharFileAsIntegers(Filename$,ChrBuffer())
   print LoadWordFileAsIntegers(Filename$,WordBuffer())
   print LoadIntFileAsIntegers(Filename$,IntBuffer())
   
   Sync
   waitkey
   


Function LoadTextFile(Filename$,Array$())
   t=timer()
   Row=-1

   if fileexist(filename$)=true
      #print "file exist"
      f=GetFreeFile()
      if f>0

         readfile filename$,f
         ArraySize=GetArrayElements(Array$(),1)
         while not endoffile(f)
            inc row
            s$=readstring$(f)
            if Row>ArraySize
               ArraySize=ArraySize+1000
               redim Array$(ArraySize)
            endif
            Array$(Row)=s$
         endwhile
         
         
         if (Row>-1) and (row<ArraySize)
            redim Array$(Row)
         endif   

      endif   
   endif
   #print "ticks:"+str$(timer()-t)
EndFunction row




Function LoadCharFileAsIntegers(Filename$,Array())
   row=-1
   t=timer()

   if fileexist(filename$)=true
      #print "file exist"
      f=GetFreeFile()
      if f>0

         readfile filename$,f
         ArraySize=GetArrayElements(Array(),1)
         while not endoffile(f)
            inc row
            if Row>ArraySize
               ArraySize=ArraySize+5000
               redim Array(ArraySize)
            endif
            Array(Row)=readbyte(f)

         endwhile
         
         if (Row>-1) and (row<ArraySize)
            redim Array(Row)
         endif   


      endif   
   endif
   #print "ticks:"+str$(timer()-t)

EndFunction row


Function LoadWordFileAsIntegers(Filename$,Array())
   row=-1
   t=timer()

   if fileexist(filename$)=true
      #print "file exist"
      f=GetFreeFile()
      if f>0

         readfile filename$,f
         ArraySize=GetArrayElements(Array(),1)
         while not endoffile(f)
            inc row
            if Row>ArraySize
               ArraySize=ArraySize+5000
               redim Array(ArraySize)
            endif
            Array(Row)=readword(f)

         endwhile
         
         if (Row>-1) and (row<ArraySize)
            redim Array(Row)
         endif   


      endif   
   endif
   #print "ticks:"+str$(timer()-t)

EndFunction row



Function LoadIntFileAsIntegers(Filename$,Array())
   row=-1
   t=timer()

   if fileexist(filename$)=true
      #print "file exist"
      f=GetFreeFile()
      if f>0

         readfile filename$,f
         ArraySize=GetArrayElements(Array(),1)
         while not endoffile(f)
            inc row
            if Row>ArraySize
               ArraySize=ArraySize+5000
               redim Array(ArraySize)
            endif
            Array(Row)=readInt(f)

         endwhile
         
         if (Row>-1) and (row<ArraySize)
            redim Array(Row)
         endif   


      endif   
   endif
   #print "ticks:"+str$(timer()-t)

EndFunction row

Login required to view complete source code

ReadChrsAt

 This was being passed the wrong param's


File contents

Code Select Expand


1234567890
1234567890
1234567890
1234567890
1234567890



PlayBASIC Code: [Select]

   Filename$="C:\testfile.txt"
   f=1
   Openfile filename$,f

   for lp=1 to 12
      print readbyte(f)
   next
   for lp=0 to 2
      print ReadChrAt$(F,(lp*12),10)
   next
   closefile f   
   print s$
   
   Sync
   waitkey