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
Off: Nämä spoiler-tagit ovat loistavia viestin lyhentämiseen piilottamalla esimerkit
VEC_At-funktion virheentarkistusta korjattu
Hups! Korjasin tämän kyllä jo kerran, mutta en näköjään muistanut silloin tallettaa No nyt se on 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.