"Luokat" CoolBasiciin

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
User avatar
MetalRain
Active Member
Posts: 188
Joined: Sun Mar 21, 2010 12:17 pm
Location: Espoo

"Luokat" CoolBasiciin

Post by MetalRain » Fri Apr 01, 2011 4:22 am

Kävipä mielessä muistipalakikkailuja tehdessä, että joskus olisi kiva kun ei tarvitsisi huolehtia indekseistä ja voisi vain koodailla. Tälläinen puolivillainen luokkatoteutus siitä sitten tuli.

Ideana siis se että voi luoda omia muistipaloja yksinkertaisella konstruktorilla, jolle voi antaa alkeistyyppisiä kenttiä (Int, Float, String). Tämän jälkeen tietoja pääsee muokkaamaan kentän nimellä vähän kuin tyyppikokoelmien tapauksessa, mutta koska toteutus on tehty muistipaloja käyttäen voi näitä myös panna toistensa sisään, välittää funktiolle ja laittaa taulukkoihin yms. Luokalle yksityisistä funktioista voi vain haaveilla, mutta olion/olioiden luokan tarkistaminen/vertailu onnistuu.

Mitä tehokkuuteen sitten tulee, niin merkkijonojen vertailu on aika raskasta, vaan CoolBasicin sisäinen CRC32 funktio avitti kenttien vertailussa kummasti. Tehokkaampaa koodia saa kun luo koodinsa muistipaloilla alusta saakka, vaan monesti niissä tuntuu olevan ongelmia niin ajattelin josko näistä joku hyötyisi/oppisi.

Parannelkaa ja heitelkää ehdotuksia jos tulee. (:

Code: Select all

SCREEN 800,600

//Luodaan luokka nimeltään Henkilö
//kenttinä nimi, paikka syntymäpäivä, puoliso ja lemmikki
//kentät erotellaan pilkulla
//kenttien nimet toimivat kuten normaalissa Cb:ssä merkeillä $#% voi merkata tyyppiä
//vaihtoehtoisesti voi kertoa kentän tyypin seuraavasti:
//Class("Testiluokka","kenttä:Integer, pieniluku: Byte, kokonainen:i")
//Kaikki mahdolliset lyhennelmät löytyvät Class funktiosta
Person = Class("Henkilö","nimi$, palkka, syntymäpäivä$, vaimo, lemmikki")


//Tässä luodaan olio luokalle Henkilö, käytetään luotua luokkaa parametrina
matti = Object(Person)

//nyt oliolle voidaan antaa arvoja, Huomaa että coolBasicin rajoituksista johtuen 
//on kokonaisluvuille (Int, Short, Byte) liukuluvuille (Float) ja merkkijonoille String
//omat funktionsa
SetString(matti,"nimi","Matti Meikäläinen")
SetInt(matti,"palkka",Rand(1000,5000))

//tässä luodaan toinen olio luokasta Henkilö
maija = Object(Person)
SetString(maija,"nimi","Maija Meikäläinen")
SetInt(maija,"palkka",Rand(1000,5000))

//olioita voi laittaa myös toistensa kentiksi
//tällöin tulee käyttää SetInt funktiota sillä muistipalat
//näkyvät coolbasicissa kokonaislukuina (muistiosoitteina)
SetInt(Matti,"vaimo",maija)


//Vihdoin päästään käyttämään annettuja tietoja, samalla get funktiolla saadaan 
//kaikki tiedot hankittua, huomaa kuitenkin että kenttien nimissä kiRJaiNkoOlla on väliä
Print Get(Matti,"nimi")+" saa palkkaa "+Get(Matti,"palkka")+" euroa kuukaudessa."

//koska oliot käyttäytyvät myös kuin kokonaisluvut voidaan niitä käsitellä mukavasti
matinpuoliso = Get(Matti,"vaimo")


//tässä tarkistetaan että matinpuoliso muuttujassa oleva olio on oikeasti
//Henkilö luokan olio, tällä voidaan välttää virheitä.
If isObjectOf(matinpuoliso,"Henkilö")

    //lisää hakuja, ja hyvinhän nuo toimii vaikka maija vaihtui matinpuolisoon
    Print "Hänen vaimonsa "+get(matinpuoliso,"nimi")+" saa palkkaa "+get(matinpuoliso,"palkka")+" euroa kuukaudessa."
    
    Print 
    
    //täällä tulee esiin olioiden dynaamisuus, koska olio on vain osoite käytettyyn muistipalaan 
    //voidaan sitä vaihtaa kuin sukkia tai useamminkin! :o
    If Get(Matti,"palkka")>Get(matinpuoliso,"palkka") Then pienempi= matinpuoliso: Suurempi=Matti Else pienempi = Matti: suurempi = matinpuoliso
    
    //täällä taasen huomataan että get todellakin palauttaa luokan kentissä ilmoitettuja arvoja muutehan palkkoja ei voisi vähentää toisistaan
    Print Get(pienempi,"nimi")+" saa "+Int(Get(suurempi,"palkka")-Get(pienempi,"palkka"))+" euroa vähemmän palkkaa kuin "+Get(suurempi,"nimi")+"."

EndIf 


//tehdään vielä yksi Henkilö
liisa = Object(Person)
SetString(liisa,"nimi","Liisa Lillukka")
SetInt(liisa,"palkka",Rand(1000,5000))


//ja luodaan uusi luokka, jolla kaksi kenttää
lemmikki = Class("Lemmikki","nimi$, söpöys$")

//luodaan lemmikki luokalle puudeli olio
puudeli = Object(lemmikki)

//asetetaan puudelille vähän tietoja
SetString(puudeli,"nimi","Struudeli puudeli")
SetString(puudeli,"söpöys","awww")

//ja alistetaan puudeli liisan lemmikiksi
//huomataan taas että lemmikki on kokonaislukukenttä jotta
//puudeli voidaan siihen tallentaa
SetInt(liisa,"lemmikki",puudeli)

//taas kikkaillaan vähän osoituksella
//tätä kannattaa suosia sillä jatkuva nimellä hakeminen on varsin tehotonta
liisanlemmikki = get(liisa,"lemmikki")

//Tässä kokeillaan ominaisuutta jossa voidaan olion luokan nimi kertoa merkkijonona
//jos vertailua aikoo tehdä niin on kuitenkin nopeampaa käyttää kahden olion väliseen vertailuun
//isSameClass funktiota tai jos haluaa tarkistaa onko haluttu olio tietyn luokan jäsen
//isObjectOf funktiota, tällöin vältytään muuntamasta muistissa tavuina tallennettua 
//merkkijonoa merkki kerrallaan takaisin merkkijonoksi.
Print get(liisa,"nimi")+" on "+getClassName(liisa)+"."

//tässä varmistetaan että liisanlemmikki olio on todella Lemmikki luokan olio
If isObjectOf(liisanlemmikki,"Lemmikki") Then 
    //ja vielä tulostellaan vähän tietoja
    Print "Ja hänellä on "+get(liisanlemmikki,"nimi")+" lemmikkinään."
    Print get(liisanlemmikki,"nimi")+ " ON söpöydeltään aivan "+get(liisanlemmikki,"söpöys")+"."
EndIf 

//lopuksi poistetaan, vaikka se ei taitaisi olla aivan välttämätöntä
Remove(liisa)
Remove(Matti)
Remove(Maija)
//Kannattaa huomioida että luokka tulee poistaa vasta sen olioiden jälkeen
//erityisesti siksi ettei luokan olioita tule vahingossa käytettyä 
//luokan poistamisen jälkeen. Se aiheuttaa virhetilanteita
//tietysti tämäkin olisi kierrettävissä ylimääräisillä tarkastuksilla
//mutta kaikki varmistelutarkistelut maksavat suoritusaikaa
//ja silloin emme saa tehtyä niin hienoja pelejä. Vaikea valinta, eikös vain :P
DeleteClass(Personator)
//sama toimenpide myös Lemmikki luokalle.
REmove(puudeli)
DeleteClass(lemmikki)


WaitKey 


//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 

User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: "Luokat" CoolBasiciin

Post by MaGetzUb » Fri Apr 01, 2011 7:18 pm

No ohoh! Näitähän kaivattiinkin! :D Paitsi noh kuinkahan bugivapaasti nuo toimii?
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
Jani
Devoted Member
Posts: 741
Joined: Fri Oct 31, 2008 5:53 pm

Re: "Luokat" CoolBasiciin

Post by Jani » Sun Feb 10, 2013 9:19 pm

Noh, tässä kävi nyt niin, että tein häpeilemättä oman versioni ja häpeilemättä bumppaan vanhan aiheen.
Toivoisin, että joku testaakin tätä. Erona on siis käytännössä 300 riviä vähemmän. En ajanut nopeustestejä ja veikkaan, että jotain tärkeää jäi unohtumaan. Kertokaa jos näin kävi.

Code: Select all

// Tehdään pari luokkaa
Person = Class("Person", "name:s, age:i, height:f")
Class("Pet", "name:s, type:s, age:s, owner:s") // Ei ole tarpeen ottaa luokkaa talteen.

// Tehdään Matti.
Matti = Object(Person)
set(Matti, "name", "Matti")
set(Matti, "age", 21)
set(Matti, "height", 1.89)

// Ja Minna..
Minna = Object(Person)
set(Minna, "name", "Minna")
set(Minna, "age", 13)
set(Minna, "height", 1.60)

// Ja lemmikki..
Rotta = Object(GetClass("Pet")) // HOX! Käytetään GetClass-funktiota luokan hakuun.
set(Rotta, "name", "Cat")
set(Rotta, "type", "kissa")
set(Rotta, "age", 4)
set(Rotta, "owner", "Minna")

Print get(Matti, "name") + " - " + get(Matti, "age") + " - " + get(Matti, "height")
Print get(Minna, "name") + " - " + get(Minna, "age") + " - " + get(Minna, "height")
Print get(Rotta, "name") + " - " + get(Rotta, "age") + " - " + get(Rotta, "type") + " - " + get(Rotta, "owner")
// Muutetaan arvoja.
set(Matti, "age", 30)
set(Matti, "height", 1.72)
Print get(Matti, "name") + " - " + get(Matti, "age") + " - " + get(Matti, "height")

If isSameClass(Matti, Minna) Then Print "Matti ja Minna ovat samaa lajia!"
If isSameClass(Matti, Rotta) Then Print "Matti ja Rotta ovat samaa lajia!"
If isObjectOf(Rotta, GetClass("Pet")) Then Print "Rotta on lemmikki!"

// Poistetaan instanssi.
RemObject(Matti)

// Luokan poistaminen poistaa samalla myös kaikki instanssit.
RemClass(Person)
RemClass(GetClass("Pet"))

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
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition

User avatar
MetalRain
Active Member
Posts: 188
Joined: Sun Mar 21, 2010 12:17 pm
Location: Espoo

Re: "Luokat" CoolBasiciin

Post by MetalRain » Mon Feb 11, 2013 10:58 pm

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.

User avatar
Jani
Devoted Member
Posts: 741
Joined: Fri Oct 31, 2008 5:53 pm

Re: "Luokat" CoolBasiciin

Post by Jani » Sat Feb 23, 2013 5:03 pm

Sain systeemiä optimoitua jonkin verran, mutta edelleen ihmettelen mikä tökkii. Hyödyntämällä GetField -funktiota, saa nopeutta kasvatettua merkittävästi.

Funktiot ja esimerkki:

Code: Select all

// Tehdään pari luokkaa
Person = Class("Person", "name:s, age:i, height:f")
Class("Pet", "name:s, type:s, age:s, owner:s") // Ei ole tarpeen ottaa luokkaa talteen.

name = GetField(Person, "name") // Nopea kutsu kenttään name. Huomaa, että käytetään luokkaa, ei objektia!
// Tässä tapauksessa GetField palauttaa 0, jota voi käyttää hakemaan minkä tahansa objektin ensimmäistä kenttää.
// Tällä tavoin myös esim. 1 hakee minkä tahansa objektin toista kenttää get ja set -funktioissa.

// Tehdään Matti.
Matti = Object(Person)
set(Matti, name, "Matti")
set(Matti, "age", 21)
set(Matti, "height", 1.89)

// Ja Minna..
Minna = Object(Person)
set(Minna, name, "Minna")
set(Minna, "age", 13)
set(Minna, "height", 1.60)

// Ja lemmikki..
Rotta = Object(GetClass("Pet")) // HOX! Käytetään GetClass-funktiota luokan hakuun.
set(Rotta, "name", "Cat")
set(Rotta, "type", "kissa")
set(Rotta, "age", 4)
set(Rotta, "owner", "Minna")

Print get(Matti, "name") + " - " + get(Matti, "age") + " - " + get(Matti, "height")
Print get(Minna, "name") + " - " + get(Minna, "age") + " - " + get(Minna, "height")
Print get(Rotta, "name") + " - " + get(Rotta, "age") + " - " + get(Rotta, "type") + " - " + get(Rotta, "owner")
// Muutetaan arvoja.
set(Matti, "age", 30)
set(Matti, "height", 1.72)
Print get(Matti, "name") + " - " + get(Matti, "age") + " - " + get(Matti, "height")

If isSameClass(Matti, Minna) Then Print "Matti ja Minna ovat samaa lajia!"
If isSameClass(Matti, Rotta) Then Print "Matti ja Rotta ovat samaa lajia!"
If isObjectOf(Rotta, GetClass("Pet")) Then Print "Rotta on lemmikki!"

// Poistetaan instanssi.
RemObject(Matti)

// Luokan poistaminen poistaa samalla myös kaikki instanssit.
RemClass(Person)
RemClass(GetClass("Pet"))

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)
    
    If Asc(Left(fieldname, 1)) > 58 Then
        fieldcount = MEMBlockSize(fields) / 4
        fieldnamecrc = Crc32(StringToMem(fieldname))
        For i = 0 To fieldcount - 1
            f = PeekInt(fields, i * 4)
            If fieldnamecrc = 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
    Else
        f = PeekInt(fields, Int(fieldname) * 4)
        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
    Return False
EndFunction

// Hakee objektin muuttujan arvon.
Function get(inst, fieldname$)
    fields = PeekInt(inst, cIPfields)
    
    If Asc(Left(fieldname, 1)) > 58 Then
        fieldcount = MEMBlockSize(fields) / 4
        fieldnamecrc = Crc32(StringToMem(fieldname))
        For i = 0 To fieldcount - 1
            f = PeekInt(fields, i * 4)
            If fieldnamecrc = 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
    Else
        f = PeekInt(fields, Int(fieldname) * 4)
        Select PeekByte(f, cFPtype)
            Case 0
                Return MemToString(PeekInt(f, cFPvalue))
            Case 1
                Return PeekInt(f, cFPvalue)
            Case 2
                Return PeekFloat(f, cFPvalue)
        EndSelect
    EndIf
    Return 0
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

// Get field pointer for faster calls
Function GetField(_class, fieldname As String)
    fields = PeekInt(_class, cCPfields)
    fieldcount = MEMBlockSize(fields) / 4
    fieldnamecrc = Crc32(StringToMem(fieldname))
    For i = 0 To fieldcount - 1
        f = PeekInt(fields, i * 4)
        If fieldnamecrc = PeekInt(f, cFPcrc) Then
            Return i
        EndIf
    Next i
    Return -1
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
MetalRainin testi, ilman GetFieldiä ja sen kanssa.

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

start = Timer()
TestClass = Class("Triangle2", "x1, x2, x3, y1, y2, y3")

x1 = GetField(TestClass, "x1")
x2 = GetField(TestClass, "x2")
x3 = GetField(TestClass, "x3")
y1 = GetField(TestClass, "y1")
y2 = GetField(TestClass, "y2")
y3 = GetField(TestClass, "y3")

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)
    
    If Asc(Left(fieldname, 1)) > 58 Then
        fieldcount = MEMBlockSize(fields) / 4
        fieldnamecrc = Crc32(StringToMem(fieldname))
        For i = 0 To fieldcount - 1
            f = PeekInt(fields, i * 4)
            If fieldnamecrc = 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
    Else
        f = PeekInt(fields, Int(fieldname) * 4)
        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
    Return False
EndFunction

// Hakee objektin muuttujan arvon.
Function get(inst, fieldname$)
    fields = PeekInt(inst, cIPfields)
    
    If Asc(Left(fieldname, 1)) > 58 Then
        fieldcount = MEMBlockSize(fields) / 4
        fieldnamecrc = Crc32(StringToMem(fieldname))
        For i = 0 To fieldcount - 1
            f = PeekInt(fields, i * 4)
            If fieldnamecrc = 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
    Else
        f = PeekInt(fields, Int(fieldname) * 4)
        Select PeekByte(f, cFPtype)
            Case 0
                Return MemToString(PeekInt(f, cFPvalue))
            Case 1
                Return PeekInt(f, cFPvalue)
            Case 2
                Return PeekFloat(f, cFPvalue)
        EndSelect
    EndIf
    Return 0
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

// Get field pointer for faster calls
Function GetField(_class, fieldname As String)
    fields = PeekInt(_class, cCPfields)
    fieldcount = MEMBlockSize(fields) / 4
    fieldnamecrc = Crc32(StringToMem(fieldname))
    For i = 0 To fieldcount - 1
        f = PeekInt(fields, i * 4)
        If fieldnamecrc = PeekInt(f, cFPcrc) Then
            Return i
        EndIf
    Next i
    Return -1
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
Läppärilläni tulokset olivat:

Code: Select all

Set took 754 ms
Get took 644 ms
Took total 1429 ms

Set took 482 ms
Get took 612 ms
Took total 1095 ms
Keskimäärin samaa luokkaa kuin MetalRainin versio.
EDIT:

Jos haluaa luokkien periaatteen säilyttää, tuntuu ettei nopeutta paljoa saa lisää.

Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition

Post Reply

Who is online

Users browsing this forum: No registered users and 1 guest