CoolVector

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
Dande
Active Member
Posts: 193
Joined: Tue Aug 28, 2007 4:30 pm

CoolVector

Post by Dande »

Ajattelin kaivaa arkistojeni kätköistä pienen koodinpalasen, josta voi olla jollekulle kenties jotain apua. Ainakin sen avulla voi perehtyä muistipalojen mahdollisiin käyttötapoihin :)

Kyseessä on siis vektorikirjasto (C++ mielessä, ei matemaattisessa mielessä) CoolBasicille. Se ei tietenkään voi tarjota samanlaista syntaksista sokeria kuin C++:n vastaava, mutta koodin tarkoitus onkin näyttää, että onnistuu tämä CoolBasicilläkin. Koodia ei ole liikoja kommentoitu, mutta löytyy sieltä jokunen kommentti selvittämään asioita.

Code: Select all

//CoolVector - by Dande

//Mikäli automaattinen siivous on päällä, ohjelma vapauttaa
//automaattisesti vektoreihin tallennetun muistin.
//MUTTA: Tällöin vektoreihin saa tallettaa vain ja ainoastaan
//muistipaloja. Sen takia myös tyypille int on luotu dynaamisen 
//talletuksen funtiot
Global VEC_AUTO_CLEANING
VEC_AUTO_CLEANING   =   False

//Määrittää monelleko alkiolle varataan lisää tilaa kun sitä tarvitaan
//Suuremmalla arvolla muistin uudelleen varauksia tarvitaan vähemmän
Const VEC_AUTO_RESERVE = 4

//Jos asetettu nollasta suuremmaksi, heitetään virhetilanteissa MakeErrorilla luettava virhe
Const VEC_MAKE_ERRORS= 1

Const VECTOR_T  =   1
Const INT_T     =   2
Const FLOAT_T   =   3
Const STRING_T  =   4

Const ERROR_NONE        =    0 //Ei virheitä havaittu
Const ERROR_OVERREAD    =   -1 //Taulukon yliluku/ylikirjoitusyritys
Const ERROR_NON_VALID   =   -2 //Annettu parametri ei ollut validi
Const ERROR_OTHER       =   -3 //Esim. Vectorista menettäisiin alkioita jos sitä pienennettäisiin

Const ERROR_OVERREAD_MSG$="You tried to read/write over Vectors bounds"
Const ERROR_NON_VALID_MSG$ = "Vector you send isn't valid"


// Kokonaisluvun säilyttäjä tietue
Function I_New( num=0 )
    Dim mem
    mem=MakeMEMBlock(8)
    PokeInt mem,0,INT_T
    PokeInt mem,4,num
    Return mem
EndFunction

Function I_Get( i )
    Return PeekInt(i,4)
EndFunction

Function I_Set( i, num )
    PokeInt i,4,num
EndFunction

Function I_Delete( i )
    If (MEMBlockSize(i)<>8 Or PeekInt(i,0)<>INT_T) Then Return ERROR_NON_VALID
    DeleteMEMBlock i
    Return ERROR_NONE
EndFunction


// Liukuluvun säilyttäjä tietue
Function F_New( num As Float=0 )
    Dim mem
    mem=MakeMEMBlock(8)
    PokeInt mem,0,FLOAT_T
    PokeFloat mem,4,num
    Return mem
EndFunction

Function F_Get( f ) 
    Return PeekFloat(f,4)
EndFunction

Function F_Set( f, num As Float )
    PokeFloat f,4,num
EndFunction

Function F_Delete( f )
    If (MEMBlockSize(f)<>8 Or PeekInt(f,0)<>FLOAT_T) Then Return ERROR_NON_VALID
    DeleteMEMBlock f
    Return ERROR_NONE
EndFunction

Function S_New( strng As String )
    Dim mem
    mem=MakeMEMBlock(8)
    PokeInt mem,0,STRING_T
    Dim mem2
    mem2=MakeMEMBlock(Len(strng))
    Dim i
    For i=0 To Len(strng)-1
        PokeByte mem2,i,Asc(Mid(strng,1+i,1))
    Next i
    PokeInt mem,4,mem2
    Return mem
EndFunction

Function S_Get( s )
    Dim ret As String
    Dim mem
    mem=PeekInt(s,4)

    Dim i
    For i=0 To MEMBlockSize(mem)-1
        ret=ret+Chr(PeekByte(mem,i))
    Next i
    Return ret
EndFunction

Function S_Set( s, strng As String )
    Dim mem
    DeleteMEMBlock(PeekInt(s,4))
    mem=MakeMEMBlock(Len(strng))
    Dim i
    For i=0 To Len(strng)-1
        PokeByte mem,i,Asc(Mid(strng,i+1,1))
    Next i
    PokeInt s,4,mem
EndFunction

Function S_Delete(s)
    If (MEMBlockSize(s)<>8 Or PeekInt(s,0)<>STRING_T) Then Return ERROR_NON_VALID
    DeleteMEMBlock(PeekInt(s,4))
    DeleteMEMBlock(s)
    Return ERROR_NONE
EndFunction

//Vectorin koon voi määritellä luotaessa. Tällöin vectoriin mahtuu juuri
//niin monta alkiota ja ensimmäisen indeksi on 0 ja viimesen koko-1
//Vectori varaa automaattisesti lisää muistia tarvittaessa



Function VEC_New( size=0 )
    Dim mem
    mem=MakeMEMBlock(12)
    PokeInt mem,0,VECTOR_T // Tyypin tunnistetiedot
    PokeInt mem,4,0 //Osoittaa viimeisen alkion jälkeiseen tilaan
    If (size<=0) Then size=VEC_AUTO_RESERVE
    PokeInt mem,8,MakeMEMBlock(size Shl 2)
    Return mem
EndFunction 

Function VEC_IsValid(vec)
    Return (MEMBlockSize(vec)=12 And PeekInt(vec,0)=VECTOR_T)
EndFunction

Function VEC_Clean(vec, pos) //Tätä funktiota ei ole tarkoitus käyttää itse,
//vaan sitä kutsutaan jos automaattinen siivous on päällä. Toki tätä voi käyttää itsekin
    Dim mem
    mem=PeekInt(PeekInt(vec,8),pos Shl 2)
    Dim type_t
    type_t=PeekInt(mem,0)
    If (type_t=VECTOR_T)
        VEC_Delete(mem)
    ElseIf (type_t=STRING_T)
            S_Delete(mem)
    Else
        DeleteMEMBlock mem
    EndIf
    Return ERROR_NONE
EndFunction 

Function VEC_At(vec, pos)
    If Not(VEC_isValid(vec))
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_At: "+ERROR_NON_VALID_MSG
        Return ERROR_NON_VALID
    EndIf
    Dim tmp
    Dim dat
    tmp=pos Shl 2
    dat=PeekInt(vec,8)
    If (tmp>PeekInt(vec,4)-4)
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_At: "+ERROR_OVERREAD_MSG
        Return ERROR_OVERREAD
    EndIf
    Return PeekInt(dat,tmp)
EndFunction

Function VEC_Set(vec, pos, a)
    If Not(VEC_isValid(vec))
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_Set: "+ERROR_NON_VALID_MSG
        Return ERROR_NON_VALID
    EndIf
    Dim tmp
    Dim dat
    tmp=pos Shl 2
    dat=PeekInt(vec,8)
    If (tmp>MEMBlockSize(dat)-4) 
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_Set: "+ERROR_OVERREAD_MSG
        Return ERROR_OVERREAD
    EndIf
    If(VEC_AUTO_CLEANING) Then VEC_Clean(vec,pos)
    PokeInt dat,tmp,a
    Return ERROR_NONE
EndFunction

Function VEC_Reserve(vec, size) //Varaa tarpeeksi muistia size määrälle alkioita
    If Not(VEC_isValid(vec))
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_Reserve: "+ERROR_NON_VALID_MSG
        Return ERROR_NON_VALID
    EndIf
    Dim tmp
    Dim dat
    dat=PeekInt(vec,8)
    tmp=size Shl 2
    If (tmp>=PeekInt(vec,4)) 
        ResizeMEMBlock dat,tmp
        PokeInt vec,8,dat //varmuuden vuoksi
        Return ERROR_NONE
    Else
        Return ERROR_NONE //vektorissa on jo enemmän alkioita kuin size määrää, 
        //joten lisää tilaa ei tarvitse varata
    EndIf
EndFunction

Function VEC_Capacity(vec) //Palauttaa monelleko alkiolle on jo varattu tilaa
    Return MEMBlockSize(PeekInt(vec,8)) Shr 2
EndFunction

Function VEC_Size(vec) // Palauttaa alkioiden määrän vektorissa
    Return (PeekInt(vec,4)) Shr 2
EndFunction

Function VEC_PushBack(vec, a)
    If Not(VEC_isValid(vec))
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_PushBack: "+ERROR_NON_VALID_MSG
        Return ERROR_NON_VALID
    EndIf
    Dim addr
    Dim dat
    dat =PeekInt(vec,8)
    addr = PeekInt(vec,4)
    If (addr>MEMBlockSize(dat)-4) //Tarvitaan lisää tilaa
        ResizeMEMBlock dat,MEMBlockSize(dat)+(VEC_AUTO_RESERVE Shl 2)
        PokeInt vec,8,dat //varmuuden vuoksi
    EndIf
    PokeInt dat,addr,a //Tallennetaan tietue
    PokeInt vec,4,addr+4 //Siirretään loppukohdan osoitinta eteenpäin
    Return ERROR_NONE
EndFunction

Function VEC_Back(vec)
    If Not(VEC_isValid(vec))
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_Back: "+ERROR_NON_VALID_MSG
        Return ERROR_NON_VALID
    EndIf
    If PeekInt(vec,4)=0 
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_Back: "+ERROR_OVERREAD+" (Vector is empty)"
        Return ERROR_OVERREAD //vektori on tyhjä
    EndIf
    Return PeekInt(PeekInt(vec,8),PeekInt(vec,4)-4)
EndFunction 

Function VEC_Front(vec)
    If Not(VEC_isValid(vec))
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_Front: "+ERROR_NON_VALID_MSG
        Return ERROR_NON_VALID
    EndIf
    If PeekInt(vec,4)=0 
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_Back: "+ERROR_OVERREAD+" (Vector is empty)"
        Return ERROR_OVERREAD //vektori on tyhjä
    EndIf
    Return PeekInt(PeekInt(vec,8),0)
EndFunction

Function VEC_PopBack(vec)
    If Not(VEC_isValid(vec))
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_PopBack: "+ERROR_NON_VALID_MSG
        Return ERROR_NON_VALID
    EndIf
    Dim addr
    addr=PeekInt(vec,4)
    If addr=0 
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_Back: "+ERROR_OVERREAD+" (Vector is empty)"
        Return ERROR_OVERREAD //vektori on tyhjä
    EndIf
    If (VEC_AUTO_CLEANING) Then VEC_Clean(vec,addr)
    PokeInt vec,4,addr-4
    Return ERROR_NONE
EndFunction

Function VEC_Insert(vec, pos, a)
    If Not(VEC_isValid(vec))
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_Insert: "+ERROR_NON_VALID_MSG
        Return ERROR_NON_VALID
    EndIf
    Dim addr
    Dim dat
    dat=PeekInt(vec,8)
    addr=PeekInt(vec,4)
    Dim dat2
    Dim bool
    bool=addr>MEMBlockSize(dat)-4
    If (bool) //Tarvitaan lisätilaa
        dat2=MakeMEMBlock(MEMBlockSize(dat)+(VEC_AUTO_RESERVE Shl 2))
    Else
        dat2=dat
    EndIf
    MemCopy dat,pos Shl 2,dat2,(pos+1)Shl 2,addr-(pos Shl 2)
    PokeInt dat2, pos Shl 2,a
    PokeInt vec,4,addr+4
    If (bool) Then
        MemCopy dat,0,dat2,0,pos Shl 2
        DeleteMEMBlock dat
        PokeInt vec,8,dat2
    EndIf
EndFunction

Function VEC_Erase(vec,pos,pos_end=0)
    If Not(VEC_isValid(vec))
        If(VEC_MAKE_ERRORS) Then MakeError "VEC_Erase: "+ERROR_NON_VALID_MSG
        Return ERROR_NON_VALID
    EndIf
    Dim addr
    Dim dat
    addr = PeekInt(vec,4)
    If (pos Shl 2)>addr-4
        If (VEC_MAKE_ERRORS) Then MakeError "VEC_Erase: position is out of range"
        Return ERROR_OVERREAD
    EndIf
    dat = PeekInt(vec,8)
    If(VEC_AUTO_CLEANING) Then VEC_Clean(vec,pos)
    If(pos_end=0) Then
        MemCopy dat,(pos+1) Shl 2,dat,pos Shl 2,addr-(pos Shl 2)
        PokeInt vec,4,addr-4
        Return ERROR_NONE
    Else
        If(pos_end<=pos)
            If (VEC_MAKE_ERRORS) Then MakeError "VEC_Erase: Range send is not valid"
            Return ERROR_OTHER
        EndIf
        If (pos_end Shl 2)>addr
            If (VEC_MAKE_ERRORS) Then MakeError "VEC_Erase: ending position is out of range"
            Return ERROR_OVERREAD
        EndIf
        If (VEC_AUTO_CLEANING)
            Dim i
            i=pos
            While(i<pos_end)
                VEC_Clean(vec,i)
                i+1
            Wend
        EndIf
        If ((pos_end Shl 2)<addr) Then MemCopy dat, pos_end Shl 2, dat, pos Shl 2, addr-(pos_end Shl 2)
        PokeInt vec,4,addr-((pos_end-pos)Shl 2)
        Return ERROR_NONE
    EndIf
EndFunction

Function VEC_Delete(vec)
    If Not(VEC_isValid(vec))
        If (VEC_MAKE_ERRORS) Then MakeError "VEC_Delete: "+ERROR_NON_VALID_MSG
        Return ERROR_NON_VALID
    EndIf
    If(VEC_AUTO_CLEANING)
        Dim i
        For i=0 To VEC_Size(vec)-1
            VEC_Clean(vec,i)
        Next i
    EndIf
    DeleteMEMBlock(PeekInt(vec,8))
    DeleteMEMBlock(vec)
    Return ERROR_NONE
EndFunction
Tarjotakseni pienen esimerkin sen käytöstä, muokkasin nopeasti ammukset2-esimerkin käyttämään vektoreita tyyppien sijaan.

Code: Select all

//Vaihtoehto A: Copy-pasteta vektori kirjasto tähän, tai
//Vaihtoehto B: tallenna se jonnekin ja sisällytä se include käskyllä

FrameLimit 40 'rajoita nopeutta

ukko=LoadObject("Media\soldier.bmp",72)
pati=LoadObject("Media\bullet.bmp")
ShowObject pati,OFF

//Luodaan vektori ammuksille
ammukset = VEC_New(2) //Varataan alustavasti tilaa kahdelle paukulle, 
//mikäli pelaaja ampuu enemmän, kokoa kasvatetaan automaagisesti :)


AddText "Nuolista ohjaa, CTRL=ampuu"

Repeat

    'Ohjaa ukkoa NUOLILLA
    If LeftKey() Then TurnObject ukko,5
    If RightKey() Then TurnObject ukko,-5
    If UpKey() Then MoveObject ukko,2
    If DownKey() Then MoveObject ukko,-2    

    'Ammu-systeemi. Vain, jos ase on ladattu
    If KeyDown(cbKeyRControl) And reload=0 Then    
        obj=CloneObject(pati) 'tee klooni
        'asetetaan pati samaan paikkaan
        CloneObjectPosition obj,ukko                
        'käännetään pati samaan suuntaan
        CloneObjectOrientation obj,ukko            
        VEC_PushBack(ammukset,obj) // lisätään obj ammuksiin
        reload=5 'aseen lataus        
    EndIf
    'päivitä aseen lataaminen
    If reload>0 Then reload=reload-1

    'Päivitä kaikki ammukset
    For i = 0 To VEC_Size(ammukset)-1
        obj=VEC_At(ammukset, i)
        If obj<>0 Then 
            MoveObject obj,6
            If ObjectX(obj)<-180 Or ObjectX(obj)>180 Or ObjectY(obj)<-130 Or ObjectY(obj)>130 Then
                'ammus ylittää rajan -> tuhoa se                
                DeleteObject obj 'poista objekti
                VEC_Erase(ammukset, i) // poistetaan luoti kokoelmasta
            EndIf        
        EndIf
    Next i

    'tämä ennen muuta grafiikkaa (box)
    DrawGame

    'piirrä "kenttä"
    Color cbOrange
    Box 20,20,360,260,OFF    
    
    DrawScreen

Until EscapeKey()

//Poistetaan ammuskokoelma, muistinhallinta on aina hyvä tapa ;)
For i=0 To VEC_Size(ammukset)-1
    obj=VEC_At(ammukset, i)
    If obj<>0 Then DeleteObject obj
Next i
VEC_Delete(ammukset) 
Tälläisessä vektoria ei kyllä kannata käyttää, sillä suurilla paukkumäärillä VEC_Erase()-kutsu voi käydä kalliiksi (johtuen funktion sisältämästä MemCopy:stä).
Ja jottei F_* I_* ja S_* funktioiden olemassaolo jäisi täydeksi mysteeriksi, tässä yksinkertainen esimerkki merkkijonojen ja liukulukujen säilyttämisestä samaan säiliöön (ei välttämättä hyvä tapa, mutta mahdollistaa funktioiden nopean demoamisen)

Code: Select all

//Vaihtoehto A: Copy-pasteta vektori kirjasto tähän, tai
//Vaihtoehto B: tallenna se jonnekin ja sisällytä se include käskyllä

VEC_AUTO_CLEANING=True //Siivoaa säilötyt muistipalat automaattisesti vektoria tuhottaessa
a=VEC_New()
VEC_PushBack(a,F_New(3.14))
VEC_PUSHBack(a,F_New(2.72))
VEC_PushBack(a,S_New("Hello"))
VEC_PushBack(a,S_New("World!"))
S_Set(VEC_At(a,3),"Vector!")

For i=0 To VEC_Size(a)-1
    If(PeekInt(VEC_At(a,i),0)=FLOAT_T)
        AddText ""+F_GET(VEC_At(a,i))
    Else
        AddText ""+S_GET(VEC_At(a,i))
    EndIf
Next i
VEC_Delete(a) //tuhoaa automaattisesti tallennetut muistipalat
DrawScreen
WaitKey
Tätä ei ole mitenkään suuremmalti testattu, joten en toki takaa sen täydellistä toimivuutta, varsinkin kun en ole hetkeen CoolBasicillä taas ohjelmoinutkaan, mutta bugithan on tehty korjattaviksi (ja tietenkin sen takia, että niistä saa, ja pitääkin, valittaa).

Off: Nämä spoiler-tagit ovat loistavia viestin lyhentämiseen piilottamalla esimerkit ;)
EDIT:

VEC_At-funktion virheentarkistusta korjattu

EDIT:

otto90x wrote:Huomasin muuten että tuo VEC_Clean ei toimi kunnolla string muotoisilla tietueilla, vaan poistaa sen muistipalan jossa merkkijonon sisältävä muistipala on.
Hups! Korjasin tämän kyllä jo kerran, mutta en näköjään muistanut silloin tallettaa :oops: No nyt se on korjattu[/edit]
Last edited by Dande on Sat Jan 16, 2010 12:14 am, edited 3 times in total.
??

Re: CoolVector

Post by ?? »

Mitä tästä hyötyy? Tämä on kuin Type?
skorpioni-cb
Advanced Member
Posts: 364
Joined: Wed Dec 03, 2008 3:48 pm
Location: Turku

Re: CoolVector

Post by skorpioni-cb »

?? wrote:Mitä tästä hyötyy? Tämä on kuin Type?
Olen samaa mieltä
En tiedä, mitä tiedän, mutta tiedän ettei se ole mitään kaunista.

I know not what I know, but I do know that it's not beautiful.
TheFish
Developer
Developer
Posts: 477
Joined: Mon Aug 27, 2007 9:28 pm
Location: Joensuu

Re: CoolVector

Post by TheFish »

skorpioni-cb wrote:
?? wrote:Mitä tästä hyötyy? Tämä on kuin Type?
Olen samaa mieltä
Itse asiassa kyseessä ei ole sama asia kuin type. Muutama tärkeä ero:
- Typeen voi määritellä useita kenttiä
- Typeä ei voi antaa funktion parametriksi, eikä palauttaa funktiosta
- Type on aina globaali
- Typen jäseneen ei pääse käsiksi suoraan indeksillä, vaan pitää käydä jäseniä läpi kunnes löytää oikean.
CoolBasic henkilökuntaa
Kehittäjä
skorpioni-cb
Advanced Member
Posts: 364
Joined: Wed Dec 03, 2008 3:48 pm
Location: Turku

Re: CoolVector

Post by skorpioni-cb »

TheFish wrote:
skorpioni-cb wrote:
?? wrote:Mitä tästä hyötyy? Tämä on kuin Type?
Olen samaa mieltä
Itse asiassa kyseessä ei ole sama asia kuin type. Muutama tärkeä ero:
- Typeen voi määritellä useita kenttiä
- Typeä ei voi antaa funktion parametriksi, eikä palauttaa funktiosta
- Type on aina globaali
- Typen jäseneen ei pääse käsiksi suoraan indeksillä, vaan pitää käydä jäseniä läpi kunnes löytää oikean.
voi antaa funktiolle ja palauttaa sieltä jos muuntaa kokonaiseksi ja tällä tavalla saa id:n
1.Tee ylimääräinen id kenttä tai niin kuin minä teen:

Code: Select all

*kaikki ennen id:tä*
id=*tyypin nimi for each loopissa*
if id=*tyypin nimi for each loopissa* then *jotain*
*loppuun*
En tiedä, mitä tiedän, mutta tiedän ettei se ole mitään kaunista.

I know not what I know, but I do know that it's not beautiful.
User avatar
valscion
Moderator
Moderator
Posts: 1599
Joined: Thu Dec 06, 2007 7:46 pm
Location: Espoo
Contact:

Re: CoolVector

Post by valscion »

skorpioni-cb wrote:
TheFish wrote:- Typen jäseneen ei pääse käsiksi suoraan indeksillä, vaan pitää käydä jäseniä läpi kunnes löytää oikean.
tällä tavalla saa id:n
1.Tee ylimääräinen id kenttä tai niin kuin minä teen:

Code: Select all

*kaikki ennen id:tä*
id=*tyypin nimi for each loopissa*
if id=*tyypin nimi for each loopissa* then *jotain*
*loppuun*
Itsehän juuri heität tuohon koodiesimerkkiin sen for...each loopin, jossa käyt jäseniä läpi. Fail'd. -.-

Vertaa vaikka:

Code: Select all

For instanssi.TYYPPI = Each TYYPPI
  If instanssi\id = jokutyyppi Then arvo = jokutyyppi\arvo
Next instanssi
ja vektoreilla esim.

Code: Select all

arvo = VEC_At( jokuvektori, jokuid )
EDIT: Hups :D oli pikkuvirhe tossa vektoreilla jutussa
Last edited by valscion on Thu Jan 14, 2010 4:49 pm, edited 1 time in total.
cbEnchanted, uudelleenkirjoitettu runtime. Uusin versio: 0.4.1 — Nyt myös sorsat GitHubissa!
NetMatch - se kunnon nettimättö-deathmatch! Avoimella lähdekoodilla varustettu
vesalaakso.com
TheFish
Developer
Developer
Posts: 477
Joined: Mon Aug 27, 2007 9:28 pm
Location: Joensuu

Re: CoolVector

Post by TheFish »

skorpioni-cb wrote:voi antaa funktiolle ja palauttaa sieltä jos muuntaa kokonaiseksi
ConvertToInteger:illä voit palauttaa tyypin _jäsenen_, et tyyppiä.
CoolBasic henkilökuntaa
Kehittäjä
Dande
Active Member
Posts: 193
Joined: Tue Aug 28, 2007 4:30 pm

Re: CoolVector

Post by Dande »

Tätä ei ole tarkoitettu varsinaisesti typen korvaajaksi, ja osittain tämän yksi hyvä käyttötarkoitus liittyy juuri typeen: Oletetaan, että haluat jonkin typen sisältävän taulukon, kuten usein esim. roolipeleissä saattaa tulla tarpeeseen, silloin voisit lähestyä ongelmaa vaikkapa seuraavalla tavalla:

Code: Select all

Type Laatikko
    Field nimi As String
    Field tavarat // sisältää listan tavaroista
End Type 

Type Tavara
    Field nimi As String
EndType

Function LuoLaatikko( nimi As String ) //As Ptr Laatikko 
    l.Laatikko=New(Laatikko)
    l\tavarat=VEC_New()
    l\nimi=nimi
    Return ConvertToInteger(l)
EndFunction

Function LuoTavara( nimi As String ) //As Ptr Tavara
    t.Tavara = New(Tavara)
    t\nimi=nimi
    Return ConvertToInteger(t)
EndFunction

Function LisaaTavara( laatikko_ptr, tavara_ptr )
    l.Laatikko=ConvertToType(laatikko_ptr)
    VEC_PushBack(l\tavarat, tavara_ptr)
EndFunction

Function TulostaTavarat( laatikko_ptr )
    l.Laatikko=ConvertToType(laatikko_ptr)
    AddText ""+l\nimi+" contains:"
    For i=0 To VEC_Size(l\tavarat)-1
        t.Tavara=ConvertToType(VEC_At(l\tavarat,i))
        AddText " -"+t\nimi
    Next i
EndFunction

a=LuoLaatikko("Testi loota")
b=LuoLaatikko("2. Loota")
LisaaTavara(a,LuoTavara("Kuutio"))
LisaaTavara(a,LuoTavara("Miekka"))
LisaaTavara(a,LuoTavara("Tietokone"))
LisaaTavara(b,LuoTavara("Type"))
LisaaTavara(b,LuoTavara("Vector"))
LisaaTavara(b,LuoTavara("Function"))
TulostaTavarat( a )
TulostaTavarat( b )
DrawScreen 
WaitKey
Kyseinen esimerkki ei tietenkään ole kovinkaan täydellinen, mutta antaa idean siitä, miten tälläisen systeemin voisi toteuttaa
Itseasiassa taisin aikoinaan tämän tehdäkin juuri helpottamaan taulukoiden sisällyttämistä typeen, jottei tarvinnut aina erikseen pelleillä jokaisen muistipalan muistinhallinnan kanssa.

Ja huomioikaa muuten, että vektoreita voi tallettaa toisiinsa:

Code: Select all

a=VEC_New()
VEC_PushBack(a,VEC_New()) //Luodaan a-vektorin sisälle toinen vektori
VEC_PushBack(VEC_Back(a),9) // Talletetaan sinne luku yhdeksän
AddText ""+VEC_Back(VEC_Back(a)) //Luetaan ysi vektorin sisäisestä vektorista
DrawScreen 
WaitKey
VesQ wrote:...ja vektoreilla esim.

Code: Select all

arvo = I_GET( jokuid )
Ööh... tarkoititkohan

Code: Select all

arvo=VEC_At(joku_vektori, joku_kohta)
Jani
Devoted Member
Posts: 741
Joined: Fri Oct 31, 2008 4:53 pm

Re: CoolVector

Post by Jani »

Testailin tätä vähän ja tulin pienen ongelman kohdalle.
Voisiko joku selittää, että miks tää heittää PeekByte failedin?

Code: Select all

Include "Lib/Vector.cb"

Function Vtype(vec,i) // Älkää ees kysykö, et oliko järkeä...
    Return PeekInt(VEC_At(vec,i),0)
EndFunction

vec=VEC_New()
If VEC_IsValid(vec)=False Then MakeError "Virhe luotaessa vektoria!"

VEC_PushBack(vec,S_New("Hello world!"))
VEC_PushBack(vec,S_New("This is vector testing program."))

For i=1 To VEC_Size(vec)
    If Vtype(vec,i)=STRING_T
        AddText ""+S_GET(VEC_At(vec,i))
    EndIf
Next i

For i=1 To VEC_Size(vec)
    If Vtype(vec,i)=STRING_T
        S_Delete(VEC_At(vec,i))
    EndIf
Next i
VEC_Delete(vec)
DrawScreen
WaitKey
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition
legend
Advanced Member
Posts: 371
Joined: Wed Nov 18, 2009 8:06 pm

Re: CoolVector

Post by legend »

Tää on muuten kätevä. Jos ei käytä funktioita tästä ei kauheasti hyöydy, mutta kun itse käytän kovasti funktioita joten kiitos, tulen käyttämään =).
Mutta muokkasin koodia sen verran, että poistin noita if lauseita, "if makeerrorr =0 then ..." ne hidastivat sitä.
User avatar
esa94
Guru
Posts: 1855
Joined: Tue Sep 04, 2007 5:35 pm

Re: CoolVector

Post by esa94 »

legend wrote:Tää on muuten kätevä. Jos ei käytä funktioita tästä ei kauheasti hyöydy, mutta kun itse käytän kovasti funktioita joten kiitos, tulen käyttämään =).
Mutta muokkasin koodia sen verran, että poistin noita if lauseita, "if makeerrorr =0 then ..." ne hidastivat sitä.
Wat, poistit virhetarkistukset? Onko sulla päässä vikaa :D
(Stpts, miten funktiot liittyvät mitenkään containereiden käyttöön?)
otto90x
Advanced Member
Posts: 349
Joined: Mon Aug 27, 2007 9:00 pm
Location: Lapinjärvi, Finland
Contact:

Re: CoolVector

Post by otto90x »

Aika monta funktiota, kannattaisikohan niitä yhdistellä siten että tietueiden luontiin, poistamiseen, arvon vaihtamiseen ja -hakemiseen olisi vain kuhunkin vain yksi funktio? Esim.

Code: Select all

f = NewInst("F",0.6)
i = NewInst("I",3)
s = NewInst("S",0,"Instansseja: ")

SetInst(f,Float(GetInst(i)))
Print GetInst(s)+Str(GetInst(f))
DeleteInst(s)
Tietotyyppejen tunnisteina voisi käyttää merkkijonoja "F" "f" "#" "Float" "S" "s" "$" "String" "I" "i" "%" "Integer" tai jos merkkijonojen vertailu tuntuu liian hitaalta niin sopivasti nimetyt vakiot ajavat asiansa myöskin. Käyttämällä näitä tietoja ja tietueisiin luonnin yhteydessä tallennettuja tietotyyppitunnisteita, jotka voisi muuten tallentaa yhdelläkin tavulla, voi kukin funktio päätellä esimerkiksi Select .. Case -rakenteen avulla mitä tehdä kussakin tilanteessa.

Toisaalta taas kokonais- ja liukuluvut eivät tarvitsisi muistipaloja vaan koko vektori voisi koostua 5 tavun pötköistä, jossa ensimmäinen tavu olisi tietotyyppitunniste (kokonaisluku, liukuluku, merkkijono, muistipala) ja loput 4 tavua joko osoitin muistipalaan, kokonais- tai liukuluku. Tällöin tietueet tosin pitäisi lisätä suoraan johonkin vektoriin, eikä niitä voisi käsitellä erillisinä (onko se edes tarpeen?).

Onkohan tuo Shl 2 nopeampaa kuin neljällä kertominen?
Otto Martikainen a.k.a. MetalRain, otto90x, kAATOSade.
Runoblogi, vuodatusta ja sekoiluja.
Dande
Active Member
Posts: 193
Joined: Tue Aug 28, 2007 4:30 pm

Re: CoolVector

Post by Dande »

Jani wrote:Testailin tätä vähän ja tulin pienen ongelman kohdalle.
Voisiko joku selittää, että miks tää heittää PeekByte failedin?

Code: Select all

Include "Lib/Vector.cb"

Function Vtype(vec,i) // Älkää ees kysykö, et oliko järkeä...
    Return PeekInt(VEC_At(vec,i),0)
EndFunction

vec=VEC_New()
If VEC_IsValid(vec)=False Then MakeError "Virhe luotaessa vektoria!"

VEC_PushBack(vec,S_New("Hello world!"))
VEC_PushBack(vec,S_New("This is vector testing program."))

For i=1 To VEC_Size(vec)
    If Vtype(vec,i)=STRING_T
        AddText ""+S_GET(VEC_At(vec,i))
    EndIf
Next i

For i=1 To VEC_Size(vec)
    If Vtype(vec,i)=STRING_T
        S_Delete(VEC_At(vec,i))
    EndIf
Next i
VEC_Delete(vec)
DrawScreen
WaitKey
Sanotaanko, että se johtuu osittain pienestä suunnittelu virheestä, sillä sen pitäisi tuottaa "VEC_At: You tried to read/write over Vectors bounds"-viesti, mutta se ei sitä tuota, koska VEC_AUTO_RESERVE on oletuksena suurempi kuin ykkönen, ja vektori varaa kerralla muistia aina neljälle alkiolle. Jos VEC_AUTO_RESERVE:n arvon muuttaa oletuksena ykköseksi, niin ongelma katoaa, ja saat selkokielisen virheilmoituksen. Toisaalta vika johtuu myös siitä, että vektorin indeksit kulkevat välillä 0:sta VEC_Size()-1:een, eikä 1:stä VEC_Size():een. ;)

Taidampa tehdä pari muutosta tuohon yliluvun tarkistamiseen...
legend wrote:Mutta muokkasin koodia sen verran, että poistin noita if lauseita, "if makeerrorr =0 then ..." ne hidastivat sitä.
Tiedetään :|, mutta virheilmoitukset helpottavat virheen etsintää :)
Tietenkin mikäli pitää itse kunnolla huolta virheenhallinnasta, niin voihan ne sieltä tosiaan poistaa hidastamasta, mutta mikäli ne eivät ole ohjelmalle pullonkaula, niin suosittelisin kuitenkin niiden pitämistä siellä.
otto90x wrote:Aika monta funktiota, kannattaisikohan niitä yhdistellä siten että tietueiden luontiin, poistamiseen, arvon vaihtamiseen ja -hakemiseen olisi vain kuhunkin vain yksi funktio? Esim.

Code: Select all

f = NewInst("F",0.6)
i = NewInst("I",3)
s = NewInst("S",0,"Instansseja: ")

SetInst(f,Float(GetInst(i)))
Print GetInst(s)+Str(GetInst(f))
DeleteInst(s)
Tietotyyppejen tunnisteina voisi käyttää merkkijonoja "F" "f" "#" "Float" "S" "s" "$" "String" "I" "i" "%" "Integer" tai jos merkkijonojen vertailu tuntuu liian hitaalta niin sopivasti nimetyt vakiot ajavat asiansa myöskin. Käyttämällä näitä tietoja ja tietueisiin luonnin yhteydessä tallennettuja tietotyyppitunnisteita, jotka voisi muuten tallentaa yhdelläkin tavulla, voi kukin funktio päätellä esimerkiksi Select .. Case -rakenteen avulla mitä tehdä kussakin tilanteessa.

Toisaalta taas kokonais- ja liukuluvut eivät tarvitsisi muistipaloja vaan koko vektori voisi koostua 5 tavun pötköistä, jossa ensimmäinen tavu olisi tietotyyppitunniste (kokonaisluku, liukuluku, merkkijono, muistipala) ja loput 4 tavua joko osoitin muistipalaan, kokonais- tai liukuluku. Tällöin tietueet tosin pitäisi lisätä suoraan johonkin vektoriin, eikä niitä voisi käsitellä erillisinä (onko se edes tarpeen?).

Onkohan tuo Shl 2 nopeampaa kuin neljällä kertominen?
Funktioiden runsautta voin puolustella CB:n funktiorajaa nostavilla modauksilla, ja sillä tosiseikalla, että on nopeinta (kirjoittamismielessä) toteuttaa yksittäinen toiminto omana funktionaan :) . Ja tuosta 5 tavun ideasta: se tarkoittaisi, että jokainen PushBack-kutsu vaatisi muistin uudelleenvarausta, mikä ei välttämättä olisi tehokasta. Nykyinen mallihan varaa aina VEC_AUTO_RESERVE-muuttujan määrittämälle määrälle alkioita lisätilaa tarvittaessa, ja VEC_Reservellä voi välttää muistin uudelleenvarausta vieläkin enemmän. Sen takia ajattelin, että on tehokkaampaa säilyttää muistipalassa myös tieto sen nykyisestä koosta. Toki tuon tyyppitunnisteen saisi nykyisessä systeemissä jopa kahteen bittiinkin. Jos joku näkee tuon optimoinnin olennaiseksi, niin koodi on vapaata riistaa. :)

Ja uskoisin, että shl 2 on nopeampi, ellei CoolBasicin nykyinen kääntäjä suorita tuollaisia optimointeja valmiiksi. Neljällä kertomisesta tulee vain niin luonnostaan mieleen "a << 2", että en ole siinä edes oikeastaan nopeutta ajatellut.
otto90x
Advanced Member
Posts: 349
Joined: Mon Aug 27, 2007 9:00 pm
Location: Lapinjärvi, Finland
Contact:

Re: CoolVector

Post by otto90x »

Dande wrote:Ja tuosta 5 tavun ideasta: se tarkoittaisi, että jokainen PushBack-kutsu vaatisi muistin uudelleenvarausta, mikä ei välttämättä olisi tehokasta. Nykyinen mallihan varaa aina VEC_AUTO_RESERVE-muuttujan määrittämälle määrälle alkioita lisätilaa tarvittaessa, ja VEC_Reservellä voi välttää muistin uudelleenvarausta vieläkin enemmän. Sen takia ajattelin, että on tehokkaampaa säilyttää muistipalassa myös tieto sen nykyisestä koosta.
Eihän sitä tarvi pyörää uudelleen keksiä :D Vektorin ensimmäiset neljä tavua sisältäisi käytetyn tilan ja siitä eteenpäin sitten 5 tavun pötköjä kullekin tietueelle. Varattaisiin vaan kerralla useampi 5 tavun pötkö, vaikka sitten nykyiseen malliin neljälle tietueelle eli 20 tavua.
Otto Martikainen a.k.a. MetalRain, otto90x, kAATOSade.
Runoblogi, vuodatusta ja sekoiluja.
Jani
Devoted Member
Posts: 741
Joined: Fri Oct 31, 2008 4:53 pm

Re: CoolVector

Post by Jani »

otto90x wrote:
Aika monta funktiota, kannattaisikohan niitä yhdistellä siten että tietueiden luontiin, poistamiseen, arvon vaihtamiseen ja -hakemiseen olisi vain kuhunkin vain yksi funktio? Esim.

Code: Select all

f = NewInst("F",0.6)
i = NewInst("I",3)
s = NewInst("S",0,"Instansseja: ")

SetInst(f,Float(GetInst(i)))
Print GetInst(s)+Str(GetInst(f))
DeleteInst(s)
Tietotyyppejen tunnisteina voisi käyttää merkkijonoja "F" "f" "#" "Float" "S" "s" "$" "String" "I" "i" "%" "Integer" tai jos merkkijonojen vertailu tuntuu liian hitaalta niin sopivasti nimetyt vakiot ajavat asiansa myöskin. Käyttämällä näitä tietoja ja tietueisiin luonnin yhteydessä tallennettuja tietotyyppitunnisteita, jotka voisi muuten tallentaa yhdelläkin tavulla, voi kukin funktio päätellä esimerkiksi Select .. Case -rakenteen avulla mitä tehdä kussakin tilanteessa.

Toisaalta taas kokonais- ja liukuluvut eivät tarvitsisi muistipaloja vaan koko vektori voisi koostua 5 tavun pötköistä, jossa ensimmäinen tavu olisi tietotyyppitunniste (kokonaisluku, liukuluku, merkkijono, muistipala) ja loput 4 tavua joko osoitin muistipalaan, kokonais- tai liukuluku. Tällöin tietueet tosin pitäisi lisätä suoraan johonkin vektoriin, eikä niitä voisi käsitellä erillisinä (onko se edes tarpeen?).

Onkohan tuo Shl 2 nopeampaa kuin neljällä kertominen?
Tämmöistäkö meinasit?

Code: Select all

Include "Lib/Vector.cb"

Function FInst(a$,c$,vec=0)
    r$=""
    Select Lower(Mid(a,1,1))
    Case "i"
        Select Lower(Mid(a,2,1))
        Case "n"
            r=I_New(Int(c))
        Case "s"
            I_Set(vec,Int(c))
        Case "g"
            r=I_Get(Int(c))
        Case "d"
            I_Delete(Int(c))
        EndSelect
    Case "f"
        Select Lower(Mid(a,2,1))
        Case "n"
            r=F_New(Float(c))
        Case "s"
            F_Set(vec,Float(c))
        Case "g"
            r=F_Get(Int(c))
        Case "d"
            F_Delete(Int(c))
        EndSelect
    Case "s"
        Select Lower(Mid(a,2,1))
        Case "n"
            r=S_New(c)
        Case "s"
            S_Set(vec,c)
        Case "g"
            r=S_Get(Int(c))
        Case "d"
            S_Delete(Int(c))
        EndSelect
    EndSelect
    Return r
EndFunction

// ESIMERKKI
vec=VEC_New()
VEC_PushBack(vec,FInst("sn","Hello, World!"))
VEC_PushBack(vec,FInst("sn","In this program I use FInst-function."))

For i=0 To VEC_Size(vec)-1
    If PeekInt(VEC_At(vec,i),0)=STRING_T
        AddText ""+FInst("sg",VEC_At(vec,i))
    EndIf
Next i

For i=0 To VEC_Size(vec)-1
    If PeekInt(VEC_At(vec,i),0)=STRING_T
        FInst("sd",VEC_At(vec,i))
    EndIf
Next i
VEC_Delete(vec)
DrawScreen
WaitKey
Ite tykkäsin käyttää tota koska pysty yhellä funktiolla suorittaan nuo jutut.
Pitäs tosin viel VEC-funktioille tehä toi.

EDIT: Laitoin koodin ja lainauksen spoilereihin, kun oli sen verran pitkä viesti muuten.
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition
otto90x
Advanced Member
Posts: 349
Joined: Mon Aug 27, 2007 9:00 pm
Location: Lapinjärvi, Finland
Contact:

Re: CoolVector

Post by otto90x »

Jani wrote:Tämmöistäkö meinasit?
En vaan tämmöstä

Code: Select all

Const VECTOR_T  =   1
Const INT_T     =   2
Const FLOAT_T   =   3
Const STRING_T  =   4

Const ERROR_NONE        =    0 //Ei virheitä havaittu
Const ERROR_OVERREAD    =   -1 //Taulukon yliluku/ylikirjoitusyritys
Const ERROR_NON_VALID   =   -2 //Annettu parametri ei ollut validi
Const ERROR_OTHER       =   -3 //Esim. Vectorista menettäisiin alkioita jos sitä pienennettäisiin

Const ERROR_OVERREAD_MSG$="You tried to read/write over Vectors bounds"
Const ERROR_NON_VALID_MSG$ = "Vector you send isn't valid"


f = NewInst("F",0.6)
i = NewInst("I",3)
s = NewInst("S",0,"Instansseja: ")

SetInst(f,Float(GetInst(i)))
Print GetInst(s)+Str(GetInst(f))
DeleteInst(s)
DeleteInst(i)
DeleteInst(f)

WaitKey


Function NewInst(InstType$="I",number#=0.0,txt$="")
    Select InstType$
        Dim mem
        Case "I", "i", "%", "Integer"
            mem=MakeMEMBlock(5)
            PokeByte mem,0,INT_T
            PokeInt mem,1,Int(number#)
            Return mem
        Case "S", "s", "$", "String"
            
            mem=MakeMEMBlock(5)
            PokeByte mem,0,STRING_T
            Dim mem2
            mem2=MakeMEMBlock(Len(txt$))
            Dim i
            For i=0 To Len(txt$)-1
                PokeByte mem2,i,Asc(Mid(txt$,1+i,1))
            Next i
            PokeInt mem,1,mem2
            Return mem
        Case "F", "f", "#", "Float"
            mem=MakeMEMBlock(8)
            PokeByte mem,0,FLOAT_T
            PokeFloat mem,1,number#
            Return mem
        
    
    End Select 

End Function 

Function GetInst(Inst)

    If Inst Then 
        InstType = PeekByte(Inst,0)
        
        Select InstType
            Case 2 //INT_T
                Return PeekInt(Inst,1)
            Case 3 //FLOAT_T
                Return PeekFloat(Inst,1)
            Case 4 //STRING_T
                Dim ret As String
                Dim mem
                mem=PeekInt(Inst,1)
        
                Dim i
                For i=0 To MEMBlockSize(mem)-1
                    ret=ret+Chr(PeekByte(mem,i))
                Next i
                Return ret
            
        End Select 
        Return ERROR_NON_VALID
    EndIf 

End Function 

Function SetInst(Inst,number#=0.0,txt$="")

    If Inst Then 
        InstType = PeekByte(Inst,0)
        
        Select InstType
            Case 2 //INT_T
                PokeInt Inst,1,Int(number#)
                Return ERROR_NONE
            Case 3 //FLOAT_T
                PokeFloat Inst,1,number#
                Return ERROR_NONE
            Case 4 //STRING_T
                Dim mem
                DeleteMEMBlock(PeekInt(s,1))
                mem=MakeMEMBlock(Len(txt$))
                Dim i
                For i=0 To Len(txt$)-1
                    PokeByte mem,i,Asc(Mid(txt$,i+1,1))
                Next i
                PokeInt Inst,1,mem
                Return ERROR_NONE
            
        End Select 
       
    EndIf 
    Return ERROR_NON_VALID
End Function 

Function DeleteInst(Inst)

    If Inst Then 
        InstType = PeekByte(Inst,0)
        
        Select InstType
            Case 2, 3 //INT_T, FLOAT_T
                DeleteMEMBlock Inst
                Return ERROR_NONE
            Case 4 //STRING_T
                DeleteMEMBlock(PeekInt(Inst,1))
                DeleteMEMBlock(Inst)
                Return ERROR_NONE
        End Select 
        
        
    EndIf 
    Return ERROR_NON_VALID
    
End Function
Huomasin muuten että tuo VEC_Clean ei toimi kunnolla string muotoisilla tietueilla, vaan poistaa sen muistipalan jossa merkkijonon sisältävä muistipala on.
Otto Martikainen a.k.a. MetalRain, otto90x, kAATOSade.
Runoblogi, vuodatusta ja sekoiluja.
Jani
Devoted Member
Posts: 741
Joined: Fri Oct 31, 2008 4:53 pm

Re: CoolVector

Post by Jani »

Ihmettelin tossa, että mitä VEC_Back-funktio tekee?
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition
Dande
Active Member
Posts: 193
Joined: Tue Aug 28, 2007 4:30 pm

Re: CoolVector

Post by Dande »

Jani wrote:Ihmettelin tossa, että mitä VEC_Back-funktio tekee?
Palauttaa vektorin viimeisen alkion, samaan tyyliin, kuin VEC_Front palauttaa ensimmäisen alkion.
Eli VEC_Back on periaatteessa VEC_At(vec,VEC_Size(vec)-1)
Funktioiden toiminnallisuus vastaa pitkälti C++:n vektorin vastaavia.
Post Reply