Tein yksinkertaisen nopeustestin jolla testataan lähinnä sitä mitä tarvitaankin eli getti ja setti nopeutta. Luokkien alustus ja instanssien luonti voidaan aika usein tehdä etukäteen ja näyttikin että se on aika halpaa. Jostain syystä ratkaisusi vei noin tuplaten aikaa vaikka onkin mukavasti elegantimpi ja miellyttävämpi käyttää.
Testi alkuperäisellä
Code: Select all
start = Timer()
TestClass = Class("Triangle", "x1, x2, x3, y1, y2, y3")
Const testTimes = 3000
Dim insta(testTimes)
For i=0 To testTimes-1
insta(i) = Object(TestClass)
SetInt(insta(i),"x1", 1)
SetInt(insta(i),"x2", 2)
SetInt(insta(i),"x3", 3)
SetInt(insta(i),"y1", 4)
SetInt(insta(i),"y2", 5)
SetInt(insta(i),"y3", 6)
Next i
took = Timer()-start
Print "Set took "+took+ " ms "+(float(took)/float(testTimes))
getstart = Timer()
For i=0 To testTimes-1
//kuvitteellinen trifilleri tai muuta jännää
sum = Get(insta(i),"x1")+Get(insta(i),"y1")+Get(insta(i),"x2")+Get(insta(i),"y2")+Get(insta(i),"x3")+Get(insta(i),"y3")
Next i
took = Timer()-getstart
Print "Get took "+took+ " ms "+(Float(took)/Float(testTimes))
took = Timer()-start
Print "Took total "+took+ " ms "+(Float(took)/Float(testTimes))
WaitKey
End
//tästä sitten alkaa itse koodi
//aluksi on hieman indeksejä joita käytetään
//muistipaloissa offsetteinä, eli ne kertovat
//kuinka paljon muistipalan alusta kyseiseen kohtaan on.
Const pObjectDataAmount = 0
Const pFieldAmount = 4
Const pFieldNames = 8
Const pFieldTypes = 12
Const pFieldPositions = 16
Const pClassName = 20
Const pClassMemBlockSize = 24
Const pObjectData = 0
Const pObjectMemBlockSize = 24
//Luo uuden Luokan
//ottaa parametreiksi luokan nimen
//sekä luokan kenttien nimet ja tietotyypit
//huomaa ettei a As Integer merkitää tueta (vielä)
//Turvallisinta on käyttää a$ a# tai a merkkijonoille
//liukuluvuille ja kokonaisluvuille.
Function Class(ClassName$,parameters$)
size = 0
//alustetaan hieman luokan muistipaloja
//lasketaan siis kenttien määrä ensin
fields = CountWords(parameters$,",")
fieldnamemem = MakeMEMBlock(4*fields)
fieldtypemem = MakeMEMBlock(fields)
fieldpositionmem = MakeMEMBlock(4*fields)
//tässä parsitaan komento ja tietotyyppi toisistaan
//koska eri tietotyypit vievät eri verran tilaa
//pitää myös se ottaa huomioon
//ja koska tietotyyppejä luetaan erilaisilla
//komennoilla, myös niiden järjestyksellä on väliä
For i=1 To fields
oldsize = size
word$ = Trim(GetWord(parameters,i,","))
If InStr(word,":") Then
name$ = Trim(GetWord(word,1,":"))
mtype$ = Trim(GetWord(word,2,":"))
Select mtype$
Case "Int", "Integer", "I", "i", "%"
size = size + 4
memtype = 1
Case "Float", "f", "F", "#"
size = size + 4
memtype = 2
Case "String", "s", "S", "$"
size = size + 4
memtype = 3
Case "MemString", "ms", "MS", "$$"
size = size + 4
memtype = 4
Case "Short", "sh", "SH"
size = size + 2
memtype = 5
Case "Byte", "b", "B"
size = size + 1
memtype = 6
End Select
Else
If Right(word,1)="#" Then
size = size + 4
memtype = 2
name$ = Left(word,Len(word)-1)
ElseIf Right(word,1)="$" Then
size = size + 4
memtype = 3
name$ = Left(word,Len(word)-1)
ElseIf Right(word,1)="%" Then
size = size + 4
memtype = 1
name$ = Left(word,Len(word)-1)
Else
size = size + 4
memtype = 1
name$ = word
EndIf
EndIf
//ja sitten ne tallennetaan luokan muistipalaan
//kenttien nimistä otetaan CRC jotta vertailu
//olisi nopeaa
mem = TextToMem(name$)
PokeInt fieldnamemem,(i-1)*4,Crc32(mem)
DeleteMEMBlock mem
PokeInt fieldtypemem,(i-1),memtype
PokeInt fieldpositionmem,(i-1)*4,oldsize
Next i
//lopuksi kaikki muistipalat kääritään nätisti
//yhden muistipalan sisään, joka palautetaan
//koodaajalle
C = MakeMEMBlock(pClassMemBlockSize)
PokeInt C, pClassName,TextToMem(ClassName$)
PokeInt C,pDataSize,size
PokeInt C,pFieldAmount,fields
PokeInt C,pFieldNames,fieldnamemem
PokeInt C,pFieldTypes,fieldtypemem
PokeInt C,pFieldPositions,fieldpositionmem
Return C
End Function
//Varoitus, luokan poistaminen ennen sen olioita
//tekee olioista epävakaita ts. kone kaatuu todennäköisesti MAViin. Siis
//poista ensin oliot ja sitten vasta luokka
Function DeleteClass(C)
If C Then
If PeekInt(C,pFieldNames) Then DeleteMEMBlock PeekInt(C,pFieldNames)
if PeekInt(C,pFieldTypes) Then DeleteMEMBlock PeekInt(C,pFieldTypes)
if PeekInt(C,pFieldPositions) Then DeleteMEMBlock PeekInt(C,pFieldPositions)
DeleteMEMBlock C
C=0
EndIf
End Function
//tämä antaa olion luokan nimen merkkijonona, ei kannata
//käyttää jos ei aivan pakko
Function getClassName(obj)
If obj Then Return MemToText(PeekInt(obj,pClassName)) Else Return ""
End Function
//vertailee kahta oliota keskenään palauttaa true jos ovat saman luokan olioita
Function isSameClass(obj,obj2)
If obj And obj2 Then
objectClassName = PeekInt(obj,pClassName)
object2ClassName = PeekInt(obj2,pClassName)
If objectClassName = object2ClassName Then Return True
If Crc32(object2ClassName) = Crc32(objectClassName) Then Return True
EndIf
Return False
End Function
//Kertoo kuuluuko olio tämännimiseen luokkaan. Suhteellisen hidas.
Function isObjectOf(obj,ClassName$)
If obj Then
classNameMem = TextToMem(ClassName$)
objectClassName = PeekInt(obj,pClassName)
If Crc32(classNameMem) = Crc32(objectClassName) Then Return True
EndIf
Return False
End Function
//Tämä luo uusia olioita ottaa luokan parametrikseen
Function Object(C)
//tässä luodaan olion datalle muistipaljoja ja
//määritetään niiden kokoa
obj = MakeMEMBlock(pObjectMemBlockSize)
objectDataAmount = PeekInt(C,pObjectDataAmount)
objectData = MakeMEMBlock(objectDataAmount)
For i=0 To MEMBlockSize(objectData)-1
PokeByte objectData,i,0
Next i
PokeInt obj,pObjectData, objectData
PokeInt obj,pClassName,PeekInt(C,pClassName)
//lopuksi taas kääritään kaikki tieto yhteen muistipalaan
//johon kopioidaan luokan tiedoista paikalliset kopiot
PokeInt obj,pFieldAmount,PeekInt(C,pFieldAmount)
PokeInt obj,pFieldNames,PeekInt(C,pFieldNames)
PokeInt obj,pFieldTypes,PeekInt(C,pFieldTypes)
PokeInt obj,pFieldPositions,PeekInt(C,pFieldPositions)
Return obj
End Function
//Tällä poistetaan olioita
Function Remove(obj)
If obj Then
//koska oliolla voi olla muistipaloja kentissään
//pitää ne poistaa ennen olion poistamista
//tässä tarkistetaan merkkijonokenttien poistamista
types = PeekInt(obj,pFieldTypes)
If types Then
For i=0 To MEMBlockSize(types)-1
If PeekByte(types,i) = 3 Then
s=PeekInt(PeekInt(obj,pObjectData),i*4)
If s Then DeleteMEMBlock s
EndIf
Next i
EndIf
//lopuksi koko olio poistetaan ja nollataan osoitin
If PeekInt(obj,pObjectData) Then DeleteMEMBlock PeekInt(obj,pObjectData)
DeleteMEMBlock obj
obj=0
EndIf
End Function
//tällä asetetaan oliolle kokonaislukukenttään arvo
Function SetInt(obj,name$,value)
fieldname = TextToMem(name$)
fieldnames = PeekInt(obj,pFieldNames)
//ensin kenttä tulee kuitenkin etsiä
For i=0 To MEMBlockSize(fieldnames)-1 Step 4
//nimen perusteella etsitään
//voisi myös olla tehokkaampi
//hakupuu tai hajautustaulu
//muutamilla kentillä ei kuitenkaan merkittävää
//eroa.
If Crc32(fieldname) = PeekInt(fieldnames,i) Then
DeleteMEMBlock fieldname
objectData = PeekInt(obj,pObjectData)
fieldPositions = PeekInt(obj,pFieldPositions)
position = PeekInt(fieldPositions,i)
fieldTypes = PeekInt(obj,pFieldTypes)
fieldtype = PeekByte(fieldTypes,RoundDown(i/4))
//kirjoitetaan vain jos kenttä todella on haluttua
//tietotyyppiä Myös tavut ja shortit on tuettuna
Select fieldtype
Case 1
PokeInt objectData,position,value
Case 4
PokeInt objectData,position,value
Case 5
PokeShort objectData,position,value
Case 6
PokeByte objectData,position,value
Default
MakeError "Tried t"+"o set "+name$+" with wrong t"+"ype!"
End Select
PokeInt obj,pObjectData,objectData
Return obj
EndIf
Next i
//täällä tulee virhettä jos etsittyä kenttää ei löydykään
MakeError "Tried t"+"o set value "+value+" to Int field of Object "+name$+" and it isn't defined!"
End Function
//tämä muuten samanlainen mutta value on merkkijonona ja ainoastaan merkkijonot sallittuja
Function SetString(obj,name$,value$)
fieldname = TextToMem(name$)
fieldnames = PeekInt(obj,pFieldNames)
For i=0 To MEMBlockSize(fieldnames)-1 Step 4
If Crc32(fieldname) = PeekInt(fieldnames,i) Then
DeleteMEMBlock fieldname
objectData = PeekInt(obj,pObjectData)
fieldPositions = PeekInt(obj,pFieldPositions)
position = PeekInt(fieldPositions,i)
fieldTypes = PeekInt(obj,pFieldTypes)
fieldtype = PeekByte(fieldTypes,RoundDown(i/4))
Select fieldtype
Case 3
PokeInt objectData,position,TextToMem(value$)
Default
MakeError "Tried t"+"o set "+name$+" with wrong t"+"ype!"
End Select
PokeInt obj,pObjectData,objectData
Return obj
EndIf
Next i
MakeError "Tried t"+"o set value "+value$+" to Int field of Object "+name$+" and it isn't defined!"
End Function
//sama juttu täällä kts. SetInt jos ongelmia
Function SetFloat(obj,name$,value#)
fieldname = TextToMem(name$)
fieldnames = PeekInt(obj,pFieldNames)
For i=0 To MEMBlockSize(fieldnames)-1 Step 4
If Crc32(fieldname) = PeekInt(fieldnames,i) Then
DeleteMEMBlock fieldname
objectData = PeekInt(obj,pObjectData)
fieldPositions = PeekInt(obj,pFieldPositions)
position = PeekInt(fieldPositions,i)
fieldTypes = PeekInt(obj,pFieldTypes)
fieldtype = PeekByte(fieldTypes,RoundDown(i/4))
Select fieldtype
Case 2
PokeFloat objectData,position,value#
Default
MakeError "Tried t"+"o set "+name$+" with wrong t"+"ype!"
End Select
PokeInt obj,pObjectData,objectData
Return obj
EndIf
Next i
MakeError "Tried t"+"o set value "+value#+" to Int field of Object "+name$+" and it isn't defined!"
End Function
//tämä periaatteessa hieman nopeampi tapa käsitellä kenttiä, mutta nimien sijasta
//pääsee vaain tiettyyn kenttään numerolla käsiksi
// jos kentät on määritelty a, b, c niin kenttä c olisi numero 2 eli numerot alkaa
//nollasta.
Function GetN(obj,pos)
fields = PeekInt(obj,pFields)
If fields>=pos Then
objectData = PeekInt(obj,pObjectData)
fieldPositions = PeekInt(obj,pFieldPositions)
position = PeekInt(fieldPositions,pos*4)
fieldTypes = PeekInt(obj,pFieldTypes)
fieldtype = PeekByte(fieldTypes,RoundDown(i/4))
Select fieldtype
Case 1
Return PeekInt(objectData,position)
Case 2
Return PeekFloat(objectData,position)
Case 3
Return MemToText(PeekInt(objectData,position))
Case 4
Return PeekInt(objectData,position)
Case 5
Return PeekShort(objectData,position)
Case 6
Return PeekByte(objectData,position)
End Select
Return 0
Else
MakeError "Tried t"+"o get position "+pos+" and there is only "+fields+"!"
EndIf
End Function
//tässä tämä yleiskäyttöinen hakufunktio
//palauttaa löytämänsä kentän juuri oikeassa muodossa.
Function Get(obj,name$)
fieldname = TextToMem(name$)
fieldnames = PeekInt(obj,pFieldNames)
For i=0 To MEMBlockSize(fieldnames)-1 Step 4
If Crc32(fieldname) = PeekInt(fieldnames,i) Then
DeleteMEMBlock fieldname
objectData = PeekInt(obj,pObjectData)
fieldPositions = PeekInt(obj,pFieldPositions)
position = PeekInt(fieldPositions,i)
fieldTypes = PeekInt(obj,pFieldTypes)
fieldtype = PeekByte(fieldTypes,RoundDown(i/4))
Select fieldtype
Case 1
Return PeekInt(objectData,position)
Case 2
Return PeekFloat(objectData,position)
Case 3
Return MemToText(PeekInt(objectData,position))
Case 4
Return PeekInt(objectData,position)
Case 5
Return PeekShort(objectData,position)
Case 6
Return PeekByte(objectData,position)
End Select
Return 0
EndIf
Next i
MakeError "Tried t"+"o get "+name$+" and it isn't defined!"
End Function
//tämä tallentaa tekstin muistipalaan ja palauttaa sen
Function TextToMem(Txt$)
l = Len(txt$)
mem = MakeMEMBlock(l)
If l>0
For i=1 To l
PokeByte mem,i-1,Asc(Mid(txt$,i,1))
Next i
EndIf
Return mem
End Function
//tämä muuntaa muistipalassa olevan tekstin takaisin merkkijonoksi
Function MemToText(mem)
txt$ = ""
l = MEMBlockSize(mem)
If l>0
For i=0 To l-1
txt$=txt$+Chr(PeekByte(mem,i))
Next i
EndIf
Return txt$
End Function
Testi sinun systeemillä
Code: Select all
start = Timer()
TestClass = Class("Triangle", "x1, x2, x3, y1, y2, y3")
Const testTimes = 3000
Dim insta(testTimes)
For i=0 To testTimes-1
insta(i) = Object(TestClass)
Set(insta(i),"x1", 1)
Set(insta(i),"x2", 2)
Set(insta(i),"x3", 3)
Set(insta(i),"y1", 4)
Set(insta(i),"y2", 5)
Set(insta(i),"y3", 6)
Next i
took = Timer()-start
Print "Set took "+took+ " ms "+(float(took)/float(testTimes))
getstart = Timer()
For i=0 To testTimes-1
//kuvitteellinen trifilleri tai muuta jännää
sum = Get(insta(i),"x1")+Get(insta(i),"y1")+Get(insta(i),"x2")+Get(insta(i),"y2")+Get(insta(i),"x3")+Get(insta(i),"y3")
Next i
took = Timer()-getstart
Print "Get took "+took+ " ms "+(Float(took)/Float(testTimes))
took = Timer()-start
Print "Took total "+took+ " ms "+(Float(took)/Float(testTimes))
WaitKey
End
// Itse systeemi.
Const cCPfields = 0 //class_Class_Position
Const cCPinst = 4
Const cCPObjects = 8
Const cFPname = 0 //class_Field_Position
Const cFPcrc = 4
Const cFPtype = 8
Const cFPvalue = 9
Const cFTstr = 0 //class_Field_Type
Const cFTint = 1
Const cFTfloat = 2
Const cIPclass = 0 //class_Object_Position
Const cIPfields = 4
Type CLASSES
Field name As String
Field mem As Integer
EndType
// Luo luokan.
// name: Luokan nimi haettaessa
// fields: luokan muuttujat
//eg. Class("Person", "name:s, age:i")
Function Class(name As String, fields As String)
classmem = MakeMEMBlock(12) // Initialize class
// Add class to class list and throw in the name.
c.CLASSES = New(CLASSES)
c\name = name
c\mem = classmem
PokeInt classmem, cCPinst, ConvertToInteger(c)
// Count the fields and allocate enough memory for them
fieldcount = CountWords(fields, ",")
fieldsmem = MakeMEMBlock(fieldcount * 4)
PokeInt classmem, cCPfields, fieldsmem
// Initialize the fields for copying.
For i = 0 To fieldcount - 1
cfield$ = Trim(GetWord(fields, i + 1, ","))
fieldmem = MakeMEMBlock(13)
PokeInt fieldmem, cFPname, StringToMem(GetWord(cfield, 1, ":"))
PokeInt fieldmem, cFPcrc, Crc32(PeekInt(fieldmem, cFPname))
Select GetWord(cfield, 2, ":")
Case "String", "s", "$"
PokeByte fieldmem, cFPtype, cFTstr
Case "Integer", "i"
PokeByte fieldmem, cFPtype, cFTint
Case "Float", "f", "#"
PokeByte fieldmem, cFPtype, cFTfloat
EndSelect
PokeInt fieldmem, cFPvalue, 0
PokeInt fieldsmem, i * 4, fieldmem
Next i
Objects = MakeMEMBlock(4)
PokeInt Objects, 0, 0
PokeInt classmem, cCPObjects, Objects
Return classmem
EndFunction
// Poistaa luokan ja sen objektit.
Function RemClass(classmem)
c.CLASSES = ConvertToType(PeekInt(classmem, cCPinst))
Delete c
fieldsmem = PeekInt(classmem, cCPfields)
fieldcount = MEMBlockSize(fieldsmem) / 4 - 1
For i = 0 To fieldcount
f = PeekInt(fieldsmem, i * 4)
DeleteMEMBlock PeekInt(f, cFPname)
DeleteMEMBlock f
Next i
Objects = PeekInt(classmem, cCPObjects)
count = PeekInt(Objects, 0)
If count > 0 Then
For i = 1 To count
RemObject(PeekInt(Objects, i * 4))
Next i
EndIf
Return True
EndFunction
// Luo objektin luokalle.
Function Object(classmem)
If classmem = 0 Then Return 0
inst = MakeMEMBlock(8)
PokeInt inst, cIPclass, classmem
// Throw Object to the list.
Objects = PeekInt(classmem, cCPObjects)
count = PeekInt(Objects, 0) + 1
If count * 4 >= MEMBlockSize(Objects) Then ResizeMEMBlock Objects, count * 4 + 4
PokeInt Objects, 0, count
PokeInt Objects, count * 4, inst
classfields = PeekInt(classmem, cCPfields)
fieldsize = MEMBlockSize(classfields)
fieldcount = fieldsize / 4
fields = MakeMEMBlock(fieldsize)
For i = 0 To fieldcount - 1
f = MakeMEMBlock(13)
MemCopy PeekInt(classfields, i * 4), 0, f, 0, 13
PokeInt fields, i * 4, f
Next i
PokeInt inst, cIPfields, fields
Return inst
EndFunction
// Poistaa objektin.
Function RemObject(inst)
If inst = 0 Then Return False
classmem = PeekInt(inst, cIPclass)
Objects = PeekInt(classmem, cCPObjects)
Objectcount = PeekInt(Objects, 0)
found = False
For i = 1 To Objectcount
If found = False Then
If PeekInt(Objects, i * 4) = inst Then
PokeInt Objects, i * 4, 0
PokeInt Objects, 0, Objectcount - 1
found = True
EndIf
Else
PokeInt Objects, (i - 1) * 4, PeekInt(Objects, i * 4)
EndIf
Next i
fields = PeekInt(inst, cIPfields)
fieldcount = MEMBlockSize(fields) / 4 - 1
For i = 0 To fieldcount
f = PeekInt(fields, i * 4)
If PeekInt(f, cFPtype) = cFTstr Then
t = PeekInt(f, cFPvalue)
If t <> 0 Then DeleteMEMBlock t
EndIf
DeleteMEMBlock PeekInt(f, cFPname)
DeleteMEMBlock f
Next i
DeleteMEMBlock fields
DeleteMEMBlock inst
Return True
EndFunction
// Asettaa objektin muuttujan arvon.
Function set(inst, fieldname$, value$)
fields = PeekInt(inst, cIPfields)
fieldcount = MEMBlockSize(fields) / 4
For i = 0 To fieldcount - 1
f = PeekInt(fields, i * 4)
If Crc32(StringToMem(fieldname)) = PeekInt(f, cFPcrc) Then
Select PeekByte(f, cFPtype)
Case 0
t = PeekInt(f, cFPvalue)
If t <> 0 Then DeleteMEMBlock t
PokeInt f, cFPvalue, StringToMem(value)
Case 1
PokeInt f, cFPvalue, Int(value)
Case 2
PokeFloat f, cFPvalue, Float(value)
EndSelect
Return True
EndIf
Next i
Return False
EndFunction
// Hakee objektin muuttujan arvon.
Function get(inst, fieldname$)
fields = PeekInt(inst, cIPfields)
fieldcount = MEMBlockSize(fields) / 4
For i = 0 To fieldcount - 1
f = PeekInt(fields, i * 4)
If Crc32(StringToMem(fieldname)) = PeekInt(f, cFPcrc) Then
Select PeekByte(f, cFPtype)
Case 0
Return MemToString(PeekInt(f, cFPvalue))
Case 1
Return PeekInt(f, cFPvalue)
Case 2
Return PeekFloat(f, cFPvalue)
EndSelect
Return True
EndIf
Next i
EndFunction
// Hakee luokan merkkijonosta.
Function GetClass(name As String)
For c.CLASSES = Each CLASSES
If c\name = name Then Return c\mem
Next c
Return 0
EndFunction
// Hakee objektin luokan.
Function GetClassFromObject(inst)
Return PeekInt(inst, cIPclass)
EndFunction
// Tarkastaa onko inst luokan objekti
Function isObjectOf(inst, classmem)
Return PeekInt(inst, cIPclass) = classmem
EndFunction
// Tarkastaa ovatko objektit samasta luokasta.
Function isSameClass(inst1, inst2)
Return PeekInt(inst1, cIPclass) = PeekInt(inst2, cIPclass)
EndFunction
// Muuttaa merkkijono muistipalaksi.
Function StringToMem(s As String)
length = Len(s)
If length = 0 Then Return 0
mem = MakeMEMBlock(length)
For i = 1 To length
PokeByte mem, i - 1, Asc(Mid(s, i, 1))
Next i
Return mem
EndFunction
Function MemToString$(mem)
If mem = 0 Then Return ""
s$ = ""
length = MEMBlockSize(mem)
For i = 1 To length
s = s + Chr(PeekByte(mem, i - 1))
Next i
Return s
EndFunction
Seuraavanlaisia tuloksia sain:
Alkuperäisellä:
Code: Select all
Set took 431 ms 0.143667
Get took 374 ms 0.124667
Took total 826 ms 0.275333
Sinun versiolla:
Code: Select all
Set took 1148 ms 0.382667
Get took 1100 ms 0.366667
Took total 2269 ms 0.756333
Näissä siis tuo viimeinen luku kertoo yhden loopin ajan eli luonti ja kuusi settiä tai kuusi gettiä.
Ainakin huomasin että StringToMem funktiota käytetään looppien sisällä (get ja set) ja että sillä luotuja muistipaloja ei poisteta.
Code: Select all
start = Timer()
TestClass = Class("Triangle", "x1, x2, x3, y1, y2, y3")
Const testTimes = 3000
Dim insta(testTimes)
For i=0 To testTimes-1
insta(i) = Object(TestClass)
Set(insta(i),"x1", 1)
Set(insta(i),"x2", 2)
Set(insta(i),"x3", 3)
Set(insta(i),"y1", 4)
Set(insta(i),"y2", 5)
Set(insta(i),"y3", 6)
Next i
took = Timer()-start
Print "Set took "+took+ " ms "+(float(took)/float(testTimes))
getstart = Timer()
For i=0 To testTimes-1
//kuvitteellinen trifilleri tai muuta jännää
sum = Get(insta(i),"x1")+Get(insta(i),"y1")+Get(insta(i),"x2")+Get(insta(i),"y2")+Get(insta(i),"x3")+Get(insta(i),"y3")
Next i
took = Timer()-getstart
Print "Get took "+ (took) + " ms "+(Float(took)/Float(testTimes))
took = Timer()-start
Print "Took total "+took+ " ms "+(Float(took)/Float(testTimes))
WaitKey
End
// Itse systeemi.
Const cCPfields = 0 //class_Class_Position
Const cCPinst = 4
Const cCPObjects = 8
Const cFPname = 0 //class_Field_Position
Const cFPcrc = 4
Const cFPtype = 8
Const cFPvalue = 9
Const cFTstr = 0 //class_Field_Type
Const cFTint = 1
Const cFTfloat = 2
Const cIPclass = 0 //class_Object_Position
Const cIPfields = 4
Type CLASSES
Field name As String
Field mem As Integer
EndType
// Luo luokan.
// name: Luokan nimi haettaessa
// fields: luokan muuttujat
//eg. Class("Person", "name:s, age:i")
Function Class(name As String, fields As String)
classmem = MakeMEMBlock(12) // Initialize class
// Add class to class list and throw in the name.
c.CLASSES = New(CLASSES)
c\name = name
c\mem = classmem
PokeInt classmem, cCPinst, ConvertToInteger(c)
// Count the fields and allocate enough memory for them
fieldcount = CountWords(fields, ",")
fieldsmem = MakeMEMBlock(fieldcount * 4)
PokeInt classmem, cCPfields, fieldsmem
// Initialize the fields for copying.
For i = 0 To fieldcount - 1
cfield$ = Trim(GetWord(fields, i + 1, ","))
fieldmem = MakeMEMBlock(13)
PokeInt fieldmem, cFPname, StringToMem(GetWord(cfield, 1, ":"))
PokeInt fieldmem, cFPcrc, Crc32(PeekInt(fieldmem, cFPname))
Select GetWord(cfield, 2, ":")
Case "String", "s", "$"
PokeByte fieldmem, cFPtype, cFTstr
Case "Integer", "i"
PokeByte fieldmem, cFPtype, cFTint
Case "Float", "f", "#"
PokeByte fieldmem, cFPtype, cFTfloat
EndSelect
PokeInt fieldmem, cFPvalue, 0
PokeInt fieldsmem, i * 4, fieldmem
Next i
Objects = MakeMEMBlock(4)
PokeInt Objects, 0, 0
PokeInt classmem, cCPObjects, Objects
Return classmem
EndFunction
// Poistaa luokan ja sen objektit.
Function RemClass(classmem)
c.CLASSES = ConvertToType(PeekInt(classmem, cCPinst))
Delete c
fieldsmem = PeekInt(classmem, cCPfields)
fieldcount = MEMBlockSize(fieldsmem) / 4 - 1
For i = 0 To fieldcount
f = PeekInt(fieldsmem, i * 4)
DeleteMEMBlock PeekInt(f, cFPname)
DeleteMEMBlock f
Next i
Objects = PeekInt(classmem, cCPObjects)
count = PeekInt(Objects, 0)
If count > 0 Then
For i = 1 To count
RemObject(PeekInt(Objects, i * 4))
Next i
EndIf
Return True
EndFunction
// Luo objektin luokalle.
Function Object(classmem)
If classmem = 0 Then Return 0
inst = MakeMEMBlock(8)
PokeInt inst, cIPclass, classmem
// Throw Object to the list.
Objects = PeekInt(classmem, cCPObjects)
count = PeekInt(Objects, 0) + 1
If count * 4 >= MEMBlockSize(Objects) Then ResizeMEMBlock Objects, count * 4 + 4
PokeInt Objects, 0, count
PokeInt Objects, count * 4, inst
classfields = PeekInt(classmem, cCPfields)
fieldsize = MEMBlockSize(classfields)
fieldcount = fieldsize / 4
fields = MakeMEMBlock(fieldsize)
For i = 0 To fieldcount - 1
f = MakeMEMBlock(13)
MemCopy PeekInt(classfields, i * 4), 0, f, 0, 13
PokeInt fields, i * 4, f
Next i
PokeInt inst, cIPfields, fields
Return inst
EndFunction
// Poistaa objektin.
Function RemObject(inst)
If inst = 0 Then Return False
classmem = PeekInt(inst, cIPclass)
Objects = PeekInt(classmem, cCPObjects)
Objectcount = PeekInt(Objects, 0)
found = False
For i = 1 To Objectcount
If found = False Then
If PeekInt(Objects, i * 4) = inst Then
PokeInt Objects, i * 4, 0
PokeInt Objects, 0, Objectcount - 1
found = True
EndIf
Else
PokeInt Objects, (i - 1) * 4, PeekInt(Objects, i * 4)
EndIf
Next i
fields = PeekInt(inst, cIPfields)
fieldcount = MEMBlockSize(fields) / 4 - 1
For i = 0 To fieldcount
f = PeekInt(fields, i * 4)
If PeekInt(f, cFPtype) = cFTstr Then
t = PeekInt(f, cFPvalue)
If t <> 0 Then DeleteMEMBlock t
EndIf
DeleteMEMBlock PeekInt(f, cFPname)
DeleteMEMBlock f
Next i
DeleteMEMBlock fields
DeleteMEMBlock inst
Return True
EndFunction
// Asettaa objektin muuttujan arvon.
Function set(inst, fieldname$, value$)
fields = PeekInt(inst, cIPfields)
fieldcount = MEMBlockSize(fields) / 4
memString = StringToMem(fieldname)
For i = 0 To fieldcount - 1
f = PeekInt(fields, i * 4)
If Crc32(memString) = PeekInt(f, cFPcrc) Then
Select PeekByte(f, cFPtype)
Case 0
t = PeekInt(f, cFPvalue)
If t <> 0 Then DeleteMEMBlock t
PokeInt f, cFPvalue, StringToMem(value)
Case 1
PokeInt f, cFPvalue, Int(value)
Case 2
PokeFloat f, cFPvalue, Float(value)
EndSelect
DeleteMEMBlock memString
Return True
EndIf
Next i
DeleteMEMBlock memString
Return False
EndFunction
// Hakee objektin muuttujan arvon.
Function get(inst, fieldname$)
fields = PeekInt(inst, cIPfields)
fieldcount = MEMBlockSize(fields) / 4
memString = StringToMem(fieldname)
For i = 0 To fieldcount - 1
f = PeekInt(fields, i * 4)
If Crc32(memString) = PeekInt(f, cFPcrc) Then
DeleteMEMBlock memString
Select PeekByte(f, cFPtype)
Case 0
Return MemToString(PeekInt(f, cFPvalue))
Case 1
Return PeekInt(f, cFPvalue)
Case 2
Return PeekFloat(f, cFPvalue)
EndSelect
Return True
EndIf
Next i
DeleteMEMBlock memString
EndFunction
// Hakee luokan merkkijonosta.
Function GetClass(name As String)
For c.CLASSES = Each CLASSES
If c\name = name Then Return c\mem
Next c
Return 0
EndFunction
// Hakee objektin luokan.
Function GetClassFromObject(inst)
Return PeekInt(inst, cIPclass)
EndFunction
// Tarkastaa onko inst luokan objekti
Function isObjectOf(inst, classmem)
Return PeekInt(inst, cIPclass) = classmem
EndFunction
// Tarkastaa ovatko objektit samasta luokasta.
Function isSameClass(inst1, inst2)
Return PeekInt(inst1, cIPclass) = PeekInt(inst2, cIPclass)
EndFunction
// Muuttaa merkkijono muistipalaksi.
Function StringToMem(s As String)
length = Len(s)
If length = 0 Then Return 0
mem = MakeMEMBlock(length)
For i = 1 To length
PokeByte mem, i - 1, Asc(Mid(s, i, 1))
Next i
Return mem
EndFunction
Function MemToString$(mem)
If mem = 0 Then Return ""
s$ = ""
length = MEMBlockSize(mem)
For i = 1 To length
s = s + Chr(PeekByte(mem, i - 1))
Next i
Return s
EndFunction
Tämän jälkeen sain getit ja setit pudotettua lähemmäs alkuperäistä
Code: Select all
Set took 620 ms 0.206667
Get took 536 ms 0.178667
Took total 1178 ms 0.392667
Toisaalta jos käytetään näin yksinkertaisessa merkityksessä niin on jo sama käyttää tyyppikokoelmia, jolloin nopeutta saadaan noin 20 kertaa lisää.
Code: Select all
start = Timer()
Type triangle
Field x1
Field x2
Field x3
Field y1
Field y2
Field y3
End Type
Const testTimes = 3000
For i=0 To testTimes-1
t.triangle = New(triangle)
Next i
took = Timer()-start
Print "Init took "+took+ " ms "+(float(took)/float(testTimes))
setstart = Timer()
t.triangle = First(Triangle)
For i=0 To testTimes-1
t\x1 = 1
t\x2 = 2
t\x3 = 3
t\y1 = 4
t\y2 = 5
t\y3 = 6
t.triangle = After(t)
Next i
took = Timer()-setstart
Print "Set took "+took+ " ms "+(Float(took)/float(testTimes))
getstart = Timer()
t.triangle = First(Triangle)
For i=0 To testTimes-1
sum = t\x1 + t\x2 + t\x3 + t\y1 + t\y2 + t\y3
t.triangle = After(t)
Next i
took = Timer()-getstart
Print "Get took "+ (took) + " ms "+(Float(took)/Float(testTimes))
took = Timer()-start
Print "Took total "+took+ " ms "+(Float(took)/Float(testTimes))
WaitKey
End
Missä tuo sun versio sitten loistaa on noiden objektin luokan tunnistaminen ja vertailu.
Sun versiolla sain ajaksi 221 ms kun koitettiin kysyä kymmeneltätuhannelta objektilta luokkaa.
Code: Select all
cTri = Class("Triangle", "x1, x2, x3, y1, y2, y3")
cSqu = Class("Square", "x, y, width, height")
cCir = Class("Circle", "x, y, radius")
Const testTimes = 10000
Dim insta(testTimes)
Randomize 1234567
For i=0 To testTimes-1
r = Rand(2)
If (r = 0) Then
insta(i) = Object(cSqu)
set(insta(i),"x",1)
set(insta(i),"y",2)
set(insta(i),"width",2)
set(insta(i),"height",2)
ElseIf ( r = 1 ) Then
insta(i) = Object(cCir)
set(insta(i),"x",1)
set(insta(i),"y",2)
set(insta(i),"radius",2)
Else
insta(i) = Object(cTri)
set(insta(i),"x1",1)
set(insta(i),"y1",2)
set(insta(i),"x2",2)
set(insta(i),"x3",1)
set(insta(i),"y3",2)
set(insta(i),"y2",2)
EndIf
Next i
start = Timer()
sum = 0
For i=0 To testTimes-1
If isObjectOf(insta(i), cTri) or isObjectOf(insta(i), cCir) or isObjectOf(insta(i), cSqu) Then
If i > 0 Then
If isSameClass(insta(i-1),insta(i)) Then sum + 1
EndIf
EndIf
Next i
took = Timer()-start
Print "aika: "+took+" tarkiste "+sum
WaitKey
End
// Itse systeemi.
Const cCPfields = 0 //class_Class_Position
Const cCPinst = 4
Const cCPObjects = 8
Const cFPname = 0 //class_Field_Position
Const cFPcrc = 4
Const cFPtype = 8
Const cFPvalue = 9
Const cFTstr = 0 //class_Field_Type
Const cFTint = 1
Const cFTfloat = 2
Const cIPclass = 0 //class_Object_Position
Const cIPfields = 4
Type CLASSES
Field name As String
Field mem As Integer
EndType
// Luo luokan.
// name: Luokan nimi haettaessa
// fields: luokan muuttujat
//eg. Class("Person", "name:s, age:i")
Function Class(name As String, fields As String)
classmem = MakeMEMBlock(12) // Initialize class
// Add class to class list and throw in the name.
c.CLASSES = New(CLASSES)
c\name = name
c\mem = classmem
PokeInt classmem, cCPinst, ConvertToInteger(c)
// Count the fields and allocate enough memory for them
fieldcount = CountWords(fields, ",")
fieldsmem = MakeMEMBlock(fieldcount * 4)
PokeInt classmem, cCPfields, fieldsmem
// Initialize the fields for copying.
For i = 0 To fieldcount - 1
cfield$ = Trim(GetWord(fields, i + 1, ","))
fieldmem = MakeMEMBlock(13)
PokeInt fieldmem, cFPname, StringToMem(GetWord(cfield, 1, ":"))
PokeInt fieldmem, cFPcrc, Crc32(PeekInt(fieldmem, cFPname))
Select GetWord(cfield, 2, ":")
Case "String", "s", "$"
PokeByte fieldmem, cFPtype, cFTstr
Case "Integer", "i"
PokeByte fieldmem, cFPtype, cFTint
Case "Float", "f", "#"
PokeByte fieldmem, cFPtype, cFTfloat
EndSelect
PokeInt fieldmem, cFPvalue, 0
PokeInt fieldsmem, i * 4, fieldmem
Next i
Objects = MakeMEMBlock(4)
PokeInt Objects, 0, 0
PokeInt classmem, cCPObjects, Objects
Return classmem
EndFunction
// Poistaa luokan ja sen objektit.
Function RemClass(classmem)
c.CLASSES = ConvertToType(PeekInt(classmem, cCPinst))
Delete c
fieldsmem = PeekInt(classmem, cCPfields)
fieldcount = MEMBlockSize(fieldsmem) / 4 - 1
For i = 0 To fieldcount
f = PeekInt(fieldsmem, i * 4)
DeleteMEMBlock PeekInt(f, cFPname)
DeleteMEMBlock f
Next i
Objects = PeekInt(classmem, cCPObjects)
count = PeekInt(Objects, 0)
If count > 0 Then
For i = 1 To count
RemObject(PeekInt(Objects, i * 4))
Next i
EndIf
Return True
EndFunction
// Luo objektin luokalle.
Function Object(classmem)
If classmem = 0 Then Return 0
inst = MakeMEMBlock(8)
PokeInt inst, cIPclass, classmem
// Throw Object to the list.
Objects = PeekInt(classmem, cCPObjects)
count = PeekInt(Objects, 0) + 1
If count * 4 >= MEMBlockSize(Objects) Then ResizeMEMBlock Objects, count * 4 + 4
PokeInt Objects, 0, count
PokeInt Objects, count * 4, inst
classfields = PeekInt(classmem, cCPfields)
fieldsize = MEMBlockSize(classfields)
fieldcount = fieldsize / 4
fields = MakeMEMBlock(fieldsize)
For i = 0 To fieldcount - 1
f = MakeMEMBlock(13)
MemCopy PeekInt(classfields, i * 4), 0, f, 0, 13
PokeInt fields, i * 4, f
Next i
PokeInt inst, cIPfields, fields
Return inst
EndFunction
// Poistaa objektin.
Function RemObject(inst)
If inst = 0 Then Return False
classmem = PeekInt(inst, cIPclass)
Objects = PeekInt(classmem, cCPObjects)
Objectcount = PeekInt(Objects, 0)
found = False
For i = 1 To Objectcount
If found = False Then
If PeekInt(Objects, i * 4) = inst Then
PokeInt Objects, i * 4, 0
PokeInt Objects, 0, Objectcount - 1
found = True
EndIf
Else
PokeInt Objects, (i - 1) * 4, PeekInt(Objects, i * 4)
EndIf
Next i
fields = PeekInt(inst, cIPfields)
fieldcount = MEMBlockSize(fields) / 4 - 1
For i = 0 To fieldcount
f = PeekInt(fields, i * 4)
If PeekInt(f, cFPtype) = cFTstr Then
t = PeekInt(f, cFPvalue)
If t <> 0 Then DeleteMEMBlock t
EndIf
DeleteMEMBlock PeekInt(f, cFPname)
DeleteMEMBlock f
Next i
DeleteMEMBlock fields
DeleteMEMBlock inst
Return True
EndFunction
// Asettaa objektin muuttujan arvon.
Function set(inst, fieldname$, value$)
fields = PeekInt(inst, cIPfields)
fieldcount = MEMBlockSize(fields) / 4
memString = StringToMem(fieldname)
fieldCRC = Crc32(memString)
For i = 0 To fieldcount - 1
f = PeekInt(fields, i * 4)
If fieldCRC = PeekInt(f, cFPcrc) Then
Select PeekByte(f, cFPtype)
Case 0
t = PeekInt(f, cFPvalue)
If t <> 0 Then DeleteMEMBlock t
PokeInt f, cFPvalue, StringToMem(value)
Case 1
PokeInt f, cFPvalue, Int(value)
Case 2
PokeFloat f, cFPvalue, Float(value)
EndSelect
DeleteMEMBlock memString
Return True
EndIf
Next i
DeleteMEMBlock memString
Return False
EndFunction
// Hakee objektin muuttujan arvon.
Function get(inst, fieldname$)
fields = PeekInt(inst, cIPfields)
fieldcount = MEMBlockSize(fields)- 1
memString = StringToMem(fieldname)
fieldCRC = Crc32(memString)
For i = 0 To fieldcount Step 4
f = PeekInt(fields, i)
If fieldCRC = PeekInt(f, cFPcrc) Then
DeleteMEMBlock memString
Select PeekByte(f, cFPtype)
Case 0
Return MemToString(PeekInt(f, cFPvalue))
Case 1
Return PeekInt(f, cFPvalue)
Case 2
Return PeekFloat(f, cFPvalue)
EndSelect
Return True
EndIf
Next i
DeleteMEMBlock memString
EndFunction
// Hakee luokan merkkijonosta.
Function GetClass(name As String)
For c.CLASSES = Each CLASSES
If c\name = name Then Return c\mem
Next c
Return 0
EndFunction
// Hakee objektin luokan.
Function GetClassFromObject(inst)
Return PeekInt(inst, cIPclass)
EndFunction
// Tarkastaa onko inst luokan objekti
Function isObjectOf(inst, classmem)
Return PeekInt(inst, cIPclass) = classmem
EndFunction
// Tarkastaa ovatko objektit samasta luokasta.
Function isSameClass(inst1, inst2)
Return PeekInt(inst1, cIPclass) = PeekInt(inst2, cIPclass)
EndFunction
// Muuttaa merkkijono muistipalaksi.
Function StringToMem(s As String)
length = Len(s)
If length = 0 Then Return 0
mem = MakeMEMBlock(length)
For i = 1 To length
PokeByte mem, i - 1, Asc(Mid(s, i, 1))
Next i
Return mem
EndFunction
Function MemToString(mem)
If mem = 0 Then Return ""
txt$ = ""
l = MEMBlockSize(mem)
If l>0
For i=0 To l-1
txt$=txt$+Chr(PeekByte(mem,i))
Next i
EndIf
Return txt$
EndFunction
Alkuperäisellä versiolla tuli ajaksi 1333 eli aika paljon enemmän.
Code: Select all
SCREEN 1000,200
cTri = Class("Triangle", "x1, x2, x3, y1, y2, y3")
cSqu = Class("Square", "x, y, width, height")
cCir = Class("Circle", "x, y, radius")
Const testTimes = 10000
Dim insta(testTimes)
Randomize 1234567
For i=0 To testTimes-1
r = Rand(2)
If (r = 0) Then
insta(i) = Object(cSqu)
setInt(insta(i),"x",1)
setInt(insta(i),"y",2)
setInt(insta(i),"width",2)
setInt(insta(i),"height",2)
ElseIf ( r = 1 ) Then
insta(i) = Object(cCir)
setInt(insta(i),"x",1)
setInt(insta(i),"y",2)
setInt(insta(i),"radius",2)
Else
insta(i) = Object(cTri)
setInt(insta(i),"x1",1)
setInt(insta(i),"y1",2)
setInt(insta(i),"x2",2)
setInt(insta(i),"x3",1)
setInt(insta(i),"y3",2)
setInt(insta(i),"y2",2)
EndIf
Next i
start = Timer()
sum = 0
For i=0 To testTimes-1
If isObjectOf(insta(i), "Triangle") Or isObjectOf(insta(i), "Circle") Or isObjectOf(insta(i), "Square") Then
If i > 0 Then
If isSameClass(insta(i-1),insta(i)) Then sum + 1
EndIf
EndIf
Next i
took = Timer()-start
Print "aika: "+took+" tarkiste "+sum
WaitKey
End
//tästä sitten alkaa itse koodi
//aluksi on hieman indeksejä joita käytetään
//muistipaloissa offsetteinä, eli ne kertovat
//kuinka paljon muistipalan alusta kyseiseen kohtaan on.
Const pObjectDataAmount = 0
Const pFieldAmount = 4
Const pFieldNames = 8
Const pFieldTypes = 12
Const pFieldPositions = 16
Const pClassName = 20
Const pClassMemBlockSize = 24
Const pObjectData = 0
Const pObjectMemBlockSize = 24
//Luo uuden Luokan
//ottaa parametreiksi luokan nimen
//sekä luokan kenttien nimet ja tietotyypit
//huomaa ettei a As Integer merkitää tueta (vielä)
//Turvallisinta on käyttää a$ a# tai a merkkijonoille
//liukuluvuille ja kokonaisluvuille.
Function Class(ClassName$,parameters$)
size = 0
//alustetaan hieman luokan muistipaloja
//lasketaan siis kenttien määrä ensin
fields = CountWords(parameters$,",")
fieldnamemem = MakeMEMBlock(4*fields)
fieldtypemem = MakeMEMBlock(fields)
fieldpositionmem = MakeMEMBlock(4*fields)
//tässä parsitaan komento ja tietotyyppi toisistaan
//koska eri tietotyypit vievät eri verran tilaa
//pitää myös se ottaa huomioon
//ja koska tietotyyppejä luetaan erilaisilla
//komennoilla, myös niiden järjestyksellä on väliä
For i=1 To fields
oldsize = size
word$ = Trim(GetWord(parameters,i,","))
If InStr(word,":") Then
name$ = Trim(GetWord(word,1,":"))
mtype$ = Trim(GetWord(word,2,":"))
Select mtype$
Case "Int", "Integer", "I", "i", "%"
size = size + 4
memtype = 1
Case "Float", "f", "F", "#"
size = size + 4
memtype = 2
Case "String", "s", "S", "$"
size = size + 4
memtype = 3
Case "MemString", "ms", "MS", "$$"
size = size + 4
memtype = 4
Case "Short", "sh", "SH"
size = size + 2
memtype = 5
Case "Byte", "b", "B"
size = size + 1
memtype = 6
End Select
Else
If Right(word,1)="#" Then
size = size + 4
memtype = 2
name$ = Left(word,Len(word)-1)
ElseIf Right(word,1)="$" Then
size = size + 4
memtype = 3
name$ = Left(word,Len(word)-1)
ElseIf Right(word,1)="%" Then
size = size + 4
memtype = 1
name$ = Left(word,Len(word)-1)
Else
size = size + 4
memtype = 1
name$ = word
EndIf
EndIf
//ja sitten ne tallennetaan luokan muistipalaan
//kenttien nimistä otetaan CRC jotta vertailu
//olisi nopeaa
mem = TextToMem(name$)
PokeInt fieldnamemem,(i-1)*4,Crc32(mem)
DeleteMEMBlock mem
PokeInt fieldtypemem,(i-1),memtype
PokeInt fieldpositionmem,(i-1)*4,oldsize
Next i
//lopuksi kaikki muistipalat kääritään nätisti
//yhden muistipalan sisään, joka palautetaan
//koodaajalle
C = MakeMEMBlock(pClassMemBlockSize)
PokeInt C, pClassName,TextToMem(ClassName$)
PokeInt C,pDataSize,size
PokeInt C,pFieldAmount,fields
PokeInt C,pFieldNames,fieldnamemem
PokeInt C,pFieldTypes,fieldtypemem
PokeInt C,pFieldPositions,fieldpositionmem
Return C
End Function
//Varoitus, luokan poistaminen ennen sen olioita
//tekee olioista epävakaita ts. kone kaatuu todennäköisesti MAViin. Siis
//poista ensin oliot ja sitten vasta luokka
Function DeleteClass(C)
If C Then
If PeekInt(C,pFieldNames) Then DeleteMEMBlock PeekInt(C,pFieldNames)
if PeekInt(C,pFieldTypes) Then DeleteMEMBlock PeekInt(C,pFieldTypes)
if PeekInt(C,pFieldPositions) Then DeleteMEMBlock PeekInt(C,pFieldPositions)
DeleteMEMBlock C
C=0
EndIf
End Function
//tämä antaa olion luokan nimen merkkijonona, ei kannata
//käyttää jos ei aivan pakko
Function getClassName(obj)
If obj Then Return MemToText(PeekInt(obj,pClassName)) Else Return ""
End Function
//vertailee kahta oliota keskenään palauttaa true jos ovat saman luokan olioita
Function isSameClass(obj,obj2)
If obj And obj2 Then
objectClassName = PeekInt(obj,pClassName)
object2ClassName = PeekInt(obj2,pClassName)
If objectClassName = object2ClassName Then Return True
If Crc32(object2ClassName) = Crc32(objectClassName) Then Return True
EndIf
Return False
End Function
//Kertoo kuuluuko olio tämännimiseen luokkaan. Suhteellisen hidas.
Function isObjectOf(obj,ClassName$)
If obj Then
classNameMem = TextToMem(ClassName$)
objectClassName = PeekInt(obj,pClassName)
If Crc32(classNameMem) = Crc32(objectClassName) Then Return True
EndIf
Return False
End Function
//Tämä luo uusia olioita ottaa luokan parametrikseen
Function Object(C)
//tässä luodaan olion datalle muistipaljoja ja
//määritetään niiden kokoa
obj = MakeMEMBlock(pObjectMemBlockSize)
objectDataAmount = PeekInt(C,pObjectDataAmount)
objectData = MakeMEMBlock(objectDataAmount)
For i=0 To MEMBlockSize(objectData)-1
PokeByte objectData,i,0
Next i
PokeInt obj,pObjectData, objectData
PokeInt obj,pClassName,PeekInt(C,pClassName)
//lopuksi taas kääritään kaikki tieto yhteen muistipalaan
//johon kopioidaan luokan tiedoista paikalliset kopiot
PokeInt obj,pFieldAmount,PeekInt(C,pFieldAmount)
PokeInt obj,pFieldNames,PeekInt(C,pFieldNames)
PokeInt obj,pFieldTypes,PeekInt(C,pFieldTypes)
PokeInt obj,pFieldPositions,PeekInt(C,pFieldPositions)
Return obj
End Function
//Tällä poistetaan olioita
Function Remove(obj)
If obj Then
//koska oliolla voi olla muistipaloja kentissään
//pitää ne poistaa ennen olion poistamista
//tässä tarkistetaan merkkijonokenttien poistamista
types = PeekInt(obj,pFieldTypes)
If types Then
For i=0 To MEMBlockSize(types)-1
If PeekByte(types,i) = 3 Then
s=PeekInt(PeekInt(obj,pObjectData),i*4)
If s Then DeleteMEMBlock s
EndIf
Next i
EndIf
//lopuksi koko olio poistetaan ja nollataan osoitin
If PeekInt(obj,pObjectData) Then DeleteMEMBlock PeekInt(obj,pObjectData)
DeleteMEMBlock obj
obj=0
EndIf
End Function
//tällä asetetaan oliolle kokonaislukukenttään arvo
Function SetInt(obj,name$,value)
fieldname = TextToMem(name$)
fieldnames = PeekInt(obj,pFieldNames)
//ensin kenttä tulee kuitenkin etsiä
For i=0 To MEMBlockSize(fieldnames)-1 Step 4
//nimen perusteella etsitään
//voisi myös olla tehokkaampi
//hakupuu tai hajautustaulu
//muutamilla kentillä ei kuitenkaan merkittävää
//eroa.
If Crc32(fieldname) = PeekInt(fieldnames,i) Then
DeleteMEMBlock fieldname
objectData = PeekInt(obj,pObjectData)
fieldPositions = PeekInt(obj,pFieldPositions)
position = PeekInt(fieldPositions,i)
fieldTypes = PeekInt(obj,pFieldTypes)
fieldtype = PeekByte(fieldTypes,RoundDown(i/4))
//kirjoitetaan vain jos kenttä todella on haluttua
//tietotyyppiä Myös tavut ja shortit on tuettuna
Select fieldtype
Case 1
PokeInt objectData,position,value
Case 4
PokeInt objectData,position,value
Case 5
PokeShort objectData,position,value
Case 6
PokeByte objectData,position,value
Default
MakeError "Tried t"+"o set "+name$+" with wrong t"+"ype!"
End Select
PokeInt obj,pObjectData,objectData
Return obj
EndIf
Next i
//täällä tulee virhettä jos etsittyä kenttää ei löydykään
MakeError "Tried t"+"o set value "+value+" to Int field of Object "+name$+" and it isn't defined!"
End Function
//tämä muuten samanlainen mutta value on merkkijonona ja ainoastaan merkkijonot sallittuja
Function SetString(obj,name$,value$)
fieldname = TextToMem(name$)
fieldnames = PeekInt(obj,pFieldNames)
For i=0 To MEMBlockSize(fieldnames)-1 Step 4
If Crc32(fieldname) = PeekInt(fieldnames,i) Then
DeleteMEMBlock fieldname
objectData = PeekInt(obj,pObjectData)
fieldPositions = PeekInt(obj,pFieldPositions)
position = PeekInt(fieldPositions,i)
fieldTypes = PeekInt(obj,pFieldTypes)
fieldtype = PeekByte(fieldTypes,RoundDown(i/4))
Select fieldtype
Case 3
PokeInt objectData,position,TextToMem(value$)
Default
MakeError "Tried t"+"o set "+name$+" with wrong t"+"ype!"
End Select
PokeInt obj,pObjectData,objectData
Return obj
EndIf
Next i
MakeError "Tried t"+"o set value "+value$+" to Int field of Object "+name$+" and it isn't defined!"
End Function
//sama juttu täällä kts. SetInt jos ongelmia
Function SetFloat(obj,name$,value#)
fieldname = TextToMem(name$)
fieldnames = PeekInt(obj,pFieldNames)
For i=0 To MEMBlockSize(fieldnames)-1 Step 4
If Crc32(fieldname) = PeekInt(fieldnames,i) Then
DeleteMEMBlock fieldname
objectData = PeekInt(obj,pObjectData)
fieldPositions = PeekInt(obj,pFieldPositions)
position = PeekInt(fieldPositions,i)
fieldTypes = PeekInt(obj,pFieldTypes)
fieldtype = PeekByte(fieldTypes,RoundDown(i/4))
Select fieldtype
Case 2
PokeFloat objectData,position,value#
Default
MakeError "Tried t"+"o set "+name$+" with wrong t"+"ype!"
End Select
PokeInt obj,pObjectData,objectData
Return obj
EndIf
Next i
MakeError "Tried t"+"o set value "+value#+" to Int field of Object "+name$+" and it isn't defined!"
End Function
//tämä periaatteessa hieman nopeampi tapa käsitellä kenttiä, mutta nimien sijasta
//pääsee vaain tiettyyn kenttään numerolla käsiksi
// jos kentät on määritelty a, b, c niin kenttä c olisi numero 2 eli numerot alkaa
//nollasta.
Function GetN(obj,pos)
fields = PeekInt(obj,pFields)
If fields>=pos Then
objectData = PeekInt(obj,pObjectData)
fieldPositions = PeekInt(obj,pFieldPositions)
position = PeekInt(fieldPositions,pos*4)
fieldTypes = PeekInt(obj,pFieldTypes)
fieldtype = PeekByte(fieldTypes,RoundDown(i/4))
Select fieldtype
Case 1
Return PeekInt(objectData,position)
Case 2
Return PeekFloat(objectData,position)
Case 3
Return MemToText(PeekInt(objectData,position))
Case 4
Return PeekInt(objectData,position)
Case 5
Return PeekShort(objectData,position)
Case 6
Return PeekByte(objectData,position)
End Select
Return 0
Else
MakeError "Tried t"+"o get position "+pos+" and there is only "+fields+"!"
EndIf
End Function
//tässä tämä yleiskäyttöinen hakufunktio
//palauttaa löytämänsä kentän juuri oikeassa muodossa.
Function Get(obj,name$)
fieldname = TextToMem(name$)
fieldnames = PeekInt(obj,pFieldNames)
For i=0 To MEMBlockSize(fieldnames)-1 Step 4
If Crc32(fieldname) = PeekInt(fieldnames,i) Then
DeleteMEMBlock fieldname
objectData = PeekInt(obj,pObjectData)
fieldPositions = PeekInt(obj,pFieldPositions)
position = PeekInt(fieldPositions,i)
fieldTypes = PeekInt(obj,pFieldTypes)
fieldtype = PeekByte(fieldTypes,RoundDown(i/4))
Select fieldtype
Case 1
Return PeekInt(objectData,position)
Case 2
Return PeekFloat(objectData,position)
Case 3
Return MemToText(PeekInt(objectData,position))
Case 4
Return PeekInt(objectData,position)
Case 5
Return PeekShort(objectData,position)
Case 6
Return PeekByte(objectData,position)
End Select
Return 0
EndIf
Next i
MakeError "Tried t"+"o get "+name$+" and it isn't defined!"
End Function
//tämä tallentaa tekstin muistipalaan ja palauttaa sen
Function TextToMem(Txt$)
l = Len(txt$)
mem = MakeMEMBlock(l)
If l>0
For i=1 To l
PokeByte mem,i-1,Asc(Mid(txt$,i,1))
Next i
EndIf
Return mem
End Function
//tämä muuntaa muistipalassa olevan tekstin takaisin merkkijonoksi
Function MemToText(mem)
txt$ = ""
l = MEMBlockSize(mem)
If l>0
For i=0 To l-1
txt$=txt$+Chr(PeekByte(mem,i))
Next i
EndIf
Return txt$
End Function
Mihin suuntaan näitä sit vois jatkokehittää ois joku perintäsysteemi ja luokan tunnistaminen vielä sen jälkeen ja mahdollisesti sen tunnistaminen onko luokat yhteensopivia vielä perinnän jälkeen. Mutta enpä oikeen osaa sanoa onko suorituskyky ollenkaan tarpeeksi vaikka ominaisuuksia lisäisi.