Esimerkkejä aloittelijoille.

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
phons
Guru
Posts: 1056
Joined: Wed May 14, 2008 10:11 am

Re: Esimerkkejä aloittelijoille.

Post by phons »

Tuli tylsää...

Code: Select all

Dim file As String
Dim file_name As String

file = "lol.txt"
file_name = GetWord(file,1,".") + "_translate.txt"

f = OpenToRead(file)
    
    f2 = OpenToEdit(file_name)
        
        row$ = ReadLine(f)
        
        WriteLine f2,Replace(Replace(Replace(Replace(Replace(Replace(Replace(row$,"o","0"),"t","7"),"b","6"),"s","5"),"e","3"),"i","1"),"a","4")
        
    CloseFile f2
    
CloseFile f

AddText "Done"
DrawScreen
WaitKey
Edit: Kertokaas muuten menikö noi aakkoset ihan oikein kun en muistanu kaikkii ja sovelsin sitten sellatti miten se hyvältä näytti
Image
User avatar
Knoy
Active Member
Posts: 187
Joined: Fri Feb 12, 2010 10:50 pm

Re: Esimerkkejä aloittelijoille.

Post by Knoy »

Noniin päätin tehdä tällasen simppelin log(nyt ei ole puhe log komennosta vaan (eng)Log sanasta) esimerkin

Code: Select all

Dim Entry(10) As String//Näytettävät merkinnät

Entering=10// Ohjelma on todella vihainen ilman tätä! Elikä ilman tätä tulee Erroria

For i = 1 To 10//Laitetaan alkumerkinnät
    entry(i) = Rand(1,100)
Next i

Repeat//Silmukka
    
    For i = 1 To 10//Käydään merkinnät läpi
    
        Text 0,15*i-15, Entry(i)//Kirjoitetaan merkinnät
        
    Next i
    
    If GetKey() Then Entry(0) = Rand(1,100): Gosub CombatLog: Entering=10//Tehdään uusimerkintä
    //Tämän voi laittaa oikeastaan mistä tahansa asiasta tekemällä:
    //Entry(0)=Jotain: Gosub Combatlog: Entering=10
    
    DrawScreen// Päivitetään ruutu

Forever //Loputon silmukka

CombatLog://CombatLoginPäivittämistä
    For i = 1 To 10//Käydään merkinnät läpi
        Entry(Entering)=Entry(Entering-1)//Tehdään merkinnästä Entry(Entering[Joka on tällähetkellä 10]) Entry(Entering-1[Joka on sitten 9])
        Entering=Entering-1//Lasketaan enteringin arvoa 1 että voitaisiin käydä kaikki entryt läpi
    Next i
Return// Palataan takaisin pää silmukkaan
User avatar
buke44
Active Member
Posts: 169
Joined: Sat May 23, 2009 8:10 pm
Location: Tampere

Re: Esimerkkejä aloittelijoille.

Post by buke44 »

Tuli tylsää.

Code: Select all

FrameLimit 1
Repeat

tunti=Timer ()/(1000*60*60)
minuutti= (Timer ()-tunti*1000*60*60)/1000/60
sekunti= (Timer ()-(tunti*1000*60*60)-minuutti*1000*60)/1000
Text 0, 0, "Koneesi on ollut päällä "
Text 0, 20, tunti+ " tuntia ,"+minuutti+" minuuttia ja "+sekunti+" sekuntia."

DrawScreen
Forever 
Koneesi on ollut päällä 37 tuntia, 23 minuuttia ja 45 sekuntia
Wingman
Devoted Member
Posts: 594
Joined: Tue Sep 30, 2008 4:30 pm
Location: Ruudun toisella puolella

Re: Esimerkkejä aloittelijoille.

Post by Wingman »

buke44 wrote:Tuli tylsää.

Code: Select all

FrameLimit 1
Repeat

tunti=Timer ()/(1000*60*60)
minuutti= (Timer ()-tunti*1000*60*60)/1000/60
sekunti= (Timer ()-(tunti*1000*60*60)-minuutti*1000*60)/1000
Text 0, 0, "Koneesi on ollut päällä "
Text 0, 20, tunti+ " tuntia ,"+minuutti+" minuuttia ja "+sekunti+" sekuntia."

DrawScreen
Forever 
Koneesi on ollut päällä 37 tuntia, 23 minuuttia ja 45 sekuntia
heh, koneeni ollut päällä 53.3 tuntia. eikö tuo olisi järkevämpää ilman framelimittiä? voisi lopettaa kesken sekuntia...
- - - -
Viltzu
Guru
Posts: 1132
Joined: Sun Aug 26, 2007 5:45 pm
Location: Alavieska
Contact:

Re: Esimerkkejä aloittelijoille.

Post by Viltzu »

Wingman wrote: heh, koneeni ollut päällä 53.3 tuntia. eikö tuo olisi järkevämpää ilman framelimittiä? voisi lopettaa kesken sekuntia...
Ilman FrameLimittiä (Tai waittiä) prosessorin käyttö kasvaisi huomattavasti.
Ja vaikka "lopettaisi kesken sekuntia" (Jos ymmärsin oikein mitä meinasit) niin ei se suuremmilti haittaa, ja kukaan tuskin haluaa niin tarkasti tietää kauanko kone on ollut päällä. (Sekunteina..)
User avatar
MetalRain
Active Member
Posts: 188
Joined: Sun Mar 21, 2010 11:17 am
Location: Espoo

Re: Esimerkkejä aloittelijoille.

Post by MetalRain »

Nyt kun uptime tuli puheeksi niin voisin "julkaista" koodin jota olen sen laskemiseen ja seuraamiseen kehittänyt. Eli ohjelma osaa ajan ja päivämäärän perustelleella määritellä tietokoneen käynnistymisajan ja kirjoittaa data-tiedostoon käynnistämispäivämäärän ja ajan sekä käynnissä olleet sekunnit. Ohjelma myöskin osaa tunnistaa että onko ohjelma jo kirjoittanut ko. tiedostoon nykyisen käynnistymisajan ja tunnistaa sen samaksi käynnistykseksi. Lähinnä siis tarkoitettu tietokoneella vietetyn ajan seuraamiseen.

Code: Select all

SCREEN 400,1

Type oldtime
    Field datetxt$
    Field timetxt$
    Field seconds
End Type

Const SecondsInMinute = 60
Const SecondsInHour = 3600
Const SecondsInDay = 86400
Const SecondsInWeek = 604800

Global ComputerStartTime As String , ComputerStartDate As String , UptimeSeconds As integer

file$ = "uptimedata.dat"

ComputerStartTime = GetComputerStartTime()
ComputerStartDate = GetComputerStartDate()
UptimeSeconds = Timer()/1000

ReadPastData(file$)
WriteNewData(file$) 

SetWindow "Uptime: "+GetSecondsInTextTime(Timer()/1000),2

Repeat
    
    UptimeSeconds = Timer()/1000
    SetWindow "Uptime: "+GetSecondsInTextTime(UptimeSeconds)
    If (UptimeSeconds Mod 5)=0 Then WriteNewData(file$) : DrawScreen 
    Wait 1000

Forever


Function DrawOnOffDiagramm(x,y,dat$,dat2$,w,h)
    If dat$="" Then 
        o.oldtime=First (oldtime)
        dat$ = o\datetxt$
    EndIf
    days = GetDateDifferenceInDays(dat2$,dat$)
    seconds = days*SecondsInDay+GetTimeInSeconds(Time())
    multiplier# = Float(w)/Float(seconds)
    count=0
    For o.oldtime=Each oldtime 
        dsec = GetDateDifferenceInSeconds(o\datetxt$,dat$)+GetTimeDifferenceInSeconds("00:00:00",o\timetxt$)
        If dsec<=seconds And dsec=>0 Then 
            count=count+1
            dx=Int(Float(dsec)*multiplier#)
            dw=dx+Int(Float(o\seconds)*multiplier#)
            Color 64,64,64
            If count=1 Then
                Box x,y+h/2,dx,-h/2
                'Line x,y,x+dx,y 
            Else 
                Box x+pw,y+h/2,dx-pw,-h/2
                'Line x+pw,y,x+dx,y
            EndIf
            Color cbwhite
            Box x+dx,y+h,dw-dx,-h
            'Line x+dx,y+h,x+dw,y+h
            px = dx
            pw = dw
        EndIf
    Next o
End Function 

Function WriteNewData(file$)
    found=0
    For o.oldtime=Each oldtime
        If o\datetxt$ = ComputerStartDate Then
            If GetTimeDifferenceInSeconds(ComputerStartTime,o\timetxt$)<3 Then
                o\seconds=UptimeSeconds
                found=1
                Exit
            EndIf
        EndIf
    Next o
    If Not found Then 
        o.oldtime=New(oldtime)
        o\datetxt$ = ComputerStartDate
        o\timetxt$ = ComputerStartTime
        o\seconds = UptimeSeconds
    EndIf
    
    f=OpenToWrite(file$)
        For o.oldtime=Each oldtime
            WriteLine f,o\datetxt$
            WriteLine f,o\timetxt$
            WriteLine f,o\seconds
         Next o
    CloseFile f
   
End Function 

Function ReadPastData(file$)
    If FileExists(file$) Then 
        f = OpenToRead(file$)
            
            While Not EOF(f)
                o.oldtime=New(oldtime)
                o\datetxt$ = ReadLine (f)
                o\timetxt$ = ReadLine (f)
                o\seconds = Int(ReadLine (f))
            Wend

        CloseFile f
    EndIf
End Function 

Function GetTimeDifferenceInSeconds(timetxt1$,timetxt2$)
    hours = Int(GetWord(timetxt1$,1,":"))
    minutes = Int(GetWord(timetxt1$,2,":"))
    seconds = Int(GetWord(timetxt1$,3,":"))
    
    time1seconds = hours*SecondsInHour+minutes*SecondsInMinute+seconds
    
    hours = Int(GetWord(timetxt2$,1,":"))
    minutes = Int(GetWord(timetxt2$,2,":"))
    seconds = Int(GetWord(timetxt2$,3,":"))
    
    time2seconds = hours*SecondsInHour+minutes*SecondsInMinute+seconds
    
    Return time1seconds-time2seconds

End Function 

Function GetTimeInSeconds(clock$)
    hours = Int(GetWord(clock$,1,":"))
    minutes = Int(GetWord(clock$,2,":"))
    seconds = Int(GetWord(clock$,3,":"))
    Return hours*SecondsInHour+minutes*SecondsInMinute+seconds
End Function 

Function GetComputerStartDate()
    clock$ = Time()
    SecondCounter = Timer()/1000
    dat$ = Date()
    
    year = Int(GetWord(dat$,3))
    month = GetDateMonth(dat$)
    day = Int(GetWord(dat$,1))
    
    hours = Int(GetWord(clock$,1,":"))
    minutes = Int(GetWord(clock$,2,":"))
    seconds = Int(GetWord(clock$,3,":"))
    
    SecondsToday = hours*SecondsInHour+minutes*SecondsInMinute+seconds

    If SecondCounter>SecondsToday Then day=day-1
    SecondCounter= SecondCounter - SecondsToday
    
    If day=0 Then 
        month=month-1
        
        If month=0 Then month=12 : year = year - 1
        
        day = GetMonthDays(month,year)
    EndIf
    
    While SecondCounter>0
    
        If SecondCounter>SecondsInDay Then day=day-1
        SecondCounter=SecondCounter-SecondsInDay
       
        If day=0 Then 
            month=month-1
            
            If month=0 Then month=12 : year = year - 1
            
            day = GetMonthDays(month,year)
        EndIf
    Wend
        
    Return GetDayMonthYearDate(day,month,year)
    
End Function 

Function GetComputerStartTime()
    clock$ = Time()
    SecondCounter = Timer()/1000

    hours = Int(GetWord(clock$,1,":"))
    minutes = Int(GetWord(clock$,2,":"))
    seconds = Int(GetWord(clock$,3,":"))
    
    SecondsToday = hours*SecondsInHour+minutes*SecondsInMinute+seconds
    
    StartSeconds = SecondsToday-SecondCounter

    If StartSeconds<0 Then 
        
        StartSeconds = SecondCounter-SecondsToday
        
        Return GetSecondsInTime(secondsInDay - (StartSeconds Mod secondsInDay))
    Else
        Return GetSecondsInTime(StartSeconds)
    EndIf

End Function 

Function GetSecondsInTime(second)
    hours = RoundDown(Float(second)/Float(SecondsInHour))
    second=second-hours*SecondsInHour
    minutes = RoundDown(Float(second)/float(SecondsInMinute))
    second = second-minutes*SecondsInMinute
    
    shours$=Str(hours)
    If hours < 10 Then shours$="0"+shours$
    sminutes$=Str(minutes)
    If minutes < 10 Then sminutes$="0"+sminutes$
    sseconds$=Str(second)
    If second < 10 Then sseconds$="0"+sseconds$
    
    Return shours$+":"+sminutes$+":"+sseconds$
End Function 

Function GetSecondsInTextTime(second)


    weeks = RoundDown(Float(second)/Float(SecondsInWeek))
    second=second-weeks*SecondsInWeek
    
    days = RoundDown(Float(second)/Float(SecondsInDay))
    second=second-days*SecondsInDay
    
    hours = RoundDown(Float(second)/Float(SecondsInHour))
    second=second-hours*SecondsInHour
    
    minutes = RoundDown(Float(second)/float(SecondsInMinute))
    second = second-minutes*SecondsInMinute
    
    txt$=""
    
    If weeks Then txt$=txt$+weeks+" weeks "
    
    If days Then txt$=txt$+days+" days "
    
    If hours Then txt$=txt$+hours+" hours "
    
    If minutes Then txt$=txt$+minutes+" minutes "
    
    If second Then txt$=txt$+second+" seconds "

    Return txt$
End Function 

Function GetDateDifferenceInSeconds(dat$,dat2$)
    Return GetDateDifferenceInDays(dat$,dat2$)*SecondsInDay
End Function 


Function GetMonthDays(month,year)
    Select month
        Case 1,3,5,7,8,10,12
            Return 31
        Case 4,6,9,11
            Return 30
        Case 2
            If IsLeapYear(year) Then 
                Return 29
            Else
                Return 28
            EndIf
    End Select 
    MakeError "Not valid month year combination: "+month+" "+year
End Function

Function GetDateDifferenceInDays(dat$,dat2$)
    //dat$-dat2$

    year1 = Int(GetWord(dat$,3))
    year2 = Int(GetWord(dat2$,3))
    month1 = GetDateMonth(dat$)
    month2 = GetDateMonth(dat2$)
    day1 = Int(GetWord(dat$,1))
    day2 = Int(GetWord(dat2$,1))
    
    days = 0
    If year1<>year2 Or month1<>month2 Or day1<>day2 Then 
        Repeat
        
            days = days + 1
            day2 = day2 + 1
            
            If day2 = GetMonthDays(month2,year2)+1 Then day2=1 : month2 = month2 + 1

            If month2=13 Then month2=1 : year2=year2+1

            If year1=year2 And month1=month2 And day1=day2 Then Return days
            
        Forever
    Else
        Return 0
    EndIf

End Function 

Function IsLeapYear(year)
    If (year Mod 4)=0 Then
        If (year Mod 100)=0 Then
            If (year Mod 400)=0 Then Return True Else Return False
        EndIf
        Return True
    EndIf
    Return False   
End Function 


Function GetDayMonthYearDate(day,month,year)
 
    Select month
        Case 1
            monthtxt$= "Jan"
        Case 2
            monthtxt$= "Feb"
        Case 3
            monthtxt$= "Mar"
        Case 4
            monthtxt$= "Apr"
        Case 5
            monthtxt$= "May"
        Case 6
            monthtxt$= "Jun"
        Case 7
            monthtxt$= "Jul"
        Case 8
            monthtxt$= "Aug"
        Case 9
            monthtxt$= "Sep"
        Case 10
            monthtxt$= "Oct"
        Case 11
            monthtxt$= "Nov"
        Case 12
            monthtxt$= "Dec"
        Default 
            MakeError "Month: "+month+" not valid!"
    End Select 
    
    Return Str(day+" "+monthtxt$+" "+year)
End Function 

Function GetDateMonth(dat$)
    month$ = GetWord(dat$,2)
    Select month$
        Case "Jan"
            Return 1
        Case "Feb"
            Return 2
        Case "Mar"
            Return 3
        Case "Apr"
            Return 4
        Case "May"
            Return 5
        Case "Jun"
            Return 6
        Case "Jul"
            Return 7
        Case "Aug"
            Return 8
        Case "Sep"
            Return 9
        Case "Oct"
            Return 10
        Case "Nov"
            Return 11
        Case "Dec"
            Return 12
        Default 
            Return 0
    End Select 
End Function 

Function WriteConfig(tiedosto$, otsikko$, arvo$)
    Dim cfg(100) As String
    otsikko$ = Lower(otsikko$)

    f = OpenToRead(tiedosto$)
    While Not EOF(f)
        rivimäärä+1
        cfg(rivimäärä) = Lower(ReadLine(f))
    Wend
    CloseFile f

    For i = 1 To rivimäärä
        If Left(cfg(i), Len(otsikko$)+1) = otsikko$+"=" Then
            cfg(i) = otsikko$+"="+arvo$
            muokattu = 1
        EndIf
    Next i

    If Not muokattu Then
        rivimäärä+1
        cfg(rivimäärä) = otsikko$+"="+arvo$
    EndIf

    f = OpenToWrite(tiedosto$)
    For i = 1 To rivimäärä
        WriteLine f, cfg(i)
    Next i
    CloseFile f

    Return 1
End Function


Function ReadConfig(tiedosto$, otsikko$)
    otsikko$ = Lower(otsikko$)
    If FileExists(tiedosto$) Then
        f = OpenToRead(tiedosto$)

        While Not EOF(f)
            rivi$ = Lower(ReadLine(f))
            If Left(rivi$, Len(otsikko$)+1) = otsikko$+"=" Then
                arvo$ = Replace(rivi$, otsikko$+"=", "")
                Return arvo$
            EndIf
        Wend

        Return 0

    Else
        MakeError "Config file not found!"
    EndIf
End Function 
Muistaakseni siinä on vielä joku vika, tiedosto korruptoitui jostain syystä pitkän käytön aikana. Vielä tarvitsisi jonkinlaisen seurantasysteemin, kenties kuvaajan uptime ajoista.
EDIT:
VesQ wrote:En laskisi tuota hyväksi esimerkiksi lainkaan.
En minäkään, ois pitänyt pistää tää offtopic ketjuun tai jättää kokonaan pöytälaatikkoon homehtumaan.
Last edited by MetalRain on Wed Mar 24, 2010 10:29 pm, edited 4 times in total.
User avatar
valscion
Moderator
Moderator
Posts: 1599
Joined: Thu Dec 06, 2007 7:46 pm
Location: Espoo
Contact:

Re: Esimerkkejä aloittelijoille.

Post by valscion »

MetalRain wrote:Nyt kun uptime tuli puheeksi niin voisin "julkaista" koodin jota olen sen laskemiseen ja seuraamiseen kehittänyt.
En laskisi tuota hyväksi esimerkiksi lainkaan. En edes uskalla ajaa koodia, kun minulla ei ole hajuakaan mitä se tekee + se kirjoittaa jotain kovalevylle..? Kommentointi ei olisi ollut pahitteeksi.
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
phons
Guru
Posts: 1056
Joined: Wed May 14, 2008 10:11 am

Re: Esimerkkejä aloittelijoille.

Post by phons »

Tajusin asken että taulukoita voi käyttää näinkin:

Code: Select all

Dim i(10) // tehdään taulukko i jossa on 10 palaa

For ii = 0 To 9 //käydään kaikki talukon i palat läpi
    i(ii) = ii // ja laitetaan niihin numerot 0 - 9
Next ii

For ii = 0 To 9 //käydään läpi kaikki talukon i palat
    For jj = i(ii) To 9 //otetaan jj:hin talukon i palan ii arvo aloitusarvoksi ja nostetaan sitä 9 saakka
        Text 10 * ii,20 * jj,i(ii) // tulostetaan taulukon i palan ii arvo paikaan ii * 10 ja jj * 20
    Next jj
Next ii

DrawScreen //piirrä näyttö
WaitKey //odota etä jotain painetaan
Image
Tuxu
Member
Posts: 81
Joined: Tue Oct 14, 2008 5:54 pm
Location: Jyväskylä
Contact:

Re: Esimerkkejä aloittelijoille.

Post by Tuxu »

Kuinka monta kertaa minun on pitänyt saada piirrettyä peleihini ruudukko? Ja kuinka monta kertaa olen käyttänyt siihen rumaa koodia(eli piirtänyt viivoilla koko roskan)? Tässä yksinkertainen 10x10 ruudukon piirtokoodi, jota on helppo muokata. :

Code: Select all

'Malliesimerkki ruudukon luomisesta:
    For x=1 To 10
        For y=1 To 10
            Color cbwhite
            Box 24*x,24*y,25,25,OFF'HUOM. Kertolaskuun yksi vähemmän(24), jotta
                                    'saadaan ohut viiva! Ei siis kertaa 25.
        Next y
    Next x
Ja kyllä, mielestäni esimerkin arvoinen koodi. Itse en olisi aloittelijana osannut toteuttaa näin siististi.
aivot pohtii ja raksuttaa
TuxuGames | Projektiblogi
koodaaja
Moderator
Moderator
Posts: 1583
Joined: Mon Aug 27, 2007 11:24 pm
Location: Otaniemi - Mikkeli -pendelöinti

Re: Esimerkkejä aloittelijoille.

Post by koodaaja »

Itse katsoisin viivat huomattavasti nätimmäksi koodiksi, ei tarvita kuin yksi for-looppi ja piirtokutsujen kokonaismäärä on paljon pienempi.
User avatar
Knoy
Active Member
Posts: 187
Joined: Fri Feb 12, 2010 10:50 pm

Re: Esimerkkejä aloittelijoille.

Post by Knoy »

Jos ruudukko on suuri suosittelen piirtämään sen kuvaan ja sitten piirtämään kuvan loopissa.
Jonhu
Active Member
Posts: 186
Joined: Mon Aug 04, 2008 5:45 pm

Re: Esimerkkejä aloittelijoille.

Post by Jonhu »

Tuli tehty 15:sta minutissa tälläinen tyyppien perusteita ja hieman erikoisuuksia käsittelevä koodipätkä. Ohjelma ei ole mitenkään ihmeellinen, mutta ohjelman rakenne on tässä pääasia.

Joskus voi tulla vastaan ongelma, jossa haluaisit toisen tyypin tietoja lainata toisessa. Useissa ohjelmointikielissä tämä on mahdollista erilaisten luokka-systeemien avulla. Coolbasicissä kun ei ole luokkia, niin tämä aiheuttaa ongelman, miten jakaa tietoja tyyppien välillä. Ongelman voi ratkaista tekemällä oman systeemin muistipaloilla, mikä toimisi kaikissa tapauksissa, mutta oman muistijärjestelmän luominen on aika työlästä.. Joissain tapauksissa helpompi tapa on käyttää tyyppien osoittimia hyödyksi, jota esimerkkini yrittää selventää.

Code: Select all

Type PISTE
    Field x As Float
    Field y As Float
EndType


Type VIIVA  
// tyyppiin viiva luodaan kaksi kenttää, joihin tallennetaan muistiosoitteet piste-tyyppiin.
    Field typeID1%
    Field typeID2%
EndType

Const viivoja = 50 // viivojen määrä ( pisteiden määrä 2x viivojen määrä )

// luodaan uusia viivoja..
For a=1 To viivoja
    AddLine( Rand(400),Rand(300), Rand(400),Rand(300) )
Next a


// päälooppi
Repeat

    For aa.VIIVA = Each VIIVA
        // haetaan pisteiden osoitteet..
        bb.PISTE = ConvertToType(aa\typeID1)
        cc.PISTE = ConvertToType(aa\typeID2)
        
        Line bb\x,bb\y,  cc\x,cc\y // piirretään viiva pisteiden välille
    Next aa
    
    If MouseHit(1) Then ResetLines()
    
    DrawScreen
Forever

// funktio uuden viivan lisäämiseksi
Function AddLine( x1#, y1#, x2#, y2# )
    aa.VIIVA = New(VIIVA)
    
    // lähtöpiste
    nn.PISTE = New(PISTE)
    nn\x = x1 : nn\y = y1
    aa\typeID1 = ConvertToInteger(nn)
    
    // päätepiste
    bb.PISTE = New(PISTE)
    bb\x = x2 : bb\y = y2
    aa\typeID2 = ConvertToInteger(bb)
    
EndFunction



Function ResetLines()

    // poistetaan aijemmat viivat, mutta pisteiden sijainnit jäävät toiseen tyyppiin..
    For aa.VIIVA = Each VIIVA
        Delete aa
    Next aa
    
    // luodaan uudet reitit vanhoihin pisteisiin
    bb.PISTE = First( PISTE )
    For b = 0 To viivoja - 1
        
        Repeat
            n = Rand(0,viivoja*2-1) // arvotaan kuinka mones piste valitaan --> 
                                    // osa pisteistä voi jäädä käyttämättä
        Until n <> b // ei tehdä viivaa samojen pisteiden välille..
        
        cc.PISTE = First(PISTE)
        While cc <> NULL        // etsitään hitaasti lineaarisessa ajassa kyseinen piste..
            If n <> 0 Then   
                cc = After( cc ) // edetään seuraavaan tyypin jäseneen
                n = n - 1 
            Else
                Exit // oikea tyypin jäsen löytynyt..
            EndIf
        Wend
        
        // uusi viiva pisteen b ja c välille..
        aa.VIIVA = New( VIIVA )
        aa\typeID1 = ConvertToInteger(bb)
        aa\typeID2 = ConvertToInteger(cc)
        
        bb = After(bb)
    Next b
EndFunction
Samasta aiheesta tehtävä:
Mietittäväksi: Miten toteuttaisit rakenteen seuraavassa tilanteessa?

Sinulla on yksittäisten pelaajien tietoja toisessa tyypissä, jonka kenttinä on mm. nimi ja pisteet. Toisessa tyypissä olisi pelaajien kaupunkeja, jossa lukisi kaupungin koko, pelaaja, jolle kaupuki kuuluu jne.. Tehtäväsi olisi jotenkin rinnastaa nämä tyypit yhteen, että pelaajaa hakemalla näkisit tämän kaikki kaupungit ja muita tarvittavia tietoja toisesta tyypistä..

Koodina sama alkuasettelu:

Code: Select all

Type PELAAJA
    Field nimi$
    Field pisteet
EndType

Type KAUPUNKI
    Field kaupungin_nimi As String
    Field kaupungin_koko
    Field kaupungin_omistaja As String
    Field x  // kaupungin sijainti
    Field y
EndType
Yksi mahdollinen ratkaisu..

Pelaaja-tyyppiin lisättäisiin muistipala mem, johon tallennettaisiin kyseiselle pelaajalle kuuluvien kaupunkien osoitteet. Näin päästäisiin pelaajasta suoraan käsiksi kaupunkeihin muistipalan ja tyypin osoitteen kautta..
Tekeillä pikkupelejä ja ohjelmia :)
Character
Active Member
Posts: 113
Joined: Thu Nov 27, 2008 2:16 pm

Re: Esimerkkejä aloittelijoille.

Post by Character »

Pieni labyrintti generaattori. Idea saatu Destruction II:sta. Saa muokata ei jaksanut tehdä functiota. Entteristä generoi uuden mapin

Code: Select all

SCREEN 800, 600, 32, 1
FrameLimit 40
ClearArray OFF

w = 38
h = 28

Dim MAP(w, h)

For x = 0 To w
    For y = 0 To h
        MAP(x, y) = 1
        If x = 0 Or x = w Or y = 0 Or y = h Then MAP(x, y) = 1
    Next y
Next x

For x = 1 To w-1 Step 2
    For y = 1 To h-1 Step 1
        MAP(x, y) = Rand(1)
    Next y
Next x

For x = 1 To w-1 Step 1
    For y = 1 To h-1 Step 2
        MAP(x, y) = Rand(1)
    Next y
Next x

For x = 1 To w-1 Step 2
    For y = 1 To h-1 Step 2
        MAP(x, y) = 0
    Next y
Next x

player1 = MakeImage(10, 10)
DrawToImage player1
    Color cbGreen
    Circle 0, 0, 10
DrawToScreen
player2 = MakeImage(10, 10)
DrawToImage player2
    Color cbRed
    Circle 0, 0, 10
DrawToScreen

Repeat
    
    Color cbDark
    For x = 0 To w
        For y = 0 To h
            If MAP(x, y) > 0 Then
                Box x * 20 + 10, y * 20 + 10, 20, 20
            EndIf
        Next y
    Next x
    
    DrawImage player1, 35, 35
    DrawImage player2, w * 20 - 20 + 15, h * 20 - 20 + 15
    
    Color cbWhite
    Text 35 - TextWidth("Pelaaja 1")/2 + 5, 35 - TextHeight("Pelaaja 1"), "Pelaaja 1"
    Text w * 20 - 20 + 15 - TextWidth("Pelaaja 2")/2 + 5, h * 20 - 20 + 15 - TextHeight("Pelaaja 2"), "Pelaaja 2"
    
    If KeyHit(cbkeyReturn) Then
        For x = 0 To w
            For y = 0 To h
                MAP(x, y) = 1
                If x = 0 Or x = w Or y = 0 Or y = h Then MAP(x, y) = 1
            Next y
        Next x
        
        For x = 1 To w-1 Step 2
            For y = 1 To h-1 Step 1
                MAP(x, y) = Rand(1)
            Next y
        Next x
        
        For x = 1 To w-1 Step 1
            For y = 1 To h-1 Step 2
                MAP(x, y) = Rand(1)
            Next y
        Next x
        
        For x = 1 To w-1 Step 2
            For y = 1 To h-1 Step 2
                MAP(x, y) = 0
            Next y
        Next x
    EndIf
    
    DrawScreen
    
Forever
Edit: Juu, tarkoitus olikin tehdä samallatavalla kuin destructionissa (sitten se ei kyllä ole kunnon labyrintti tajusin vasta äsken)
Last edited by Character on Mon Dec 13, 2010 7:19 pm, edited 2 times in total.
Koodiapina
Forum Veteran
Posts: 2396
Joined: Tue Aug 28, 2007 4:20 pm

Re: Esimerkkejä aloittelijoille.

Post by Koodiapina »

Labyrinttigeneraattorisi ei oikein pelitä: http://img529.imageshack.us/img529/1248/bloooo.png

Ota tästä mallia. Pitäisi olla aika helposti muunnettavissa CoolBasiciksi:

Code: Select all

<?php
   // Uncle Grandi's Labyrint Generator

	$w = $_GET['leveys'];
	$h = $_GET['korkeus'];
	
	if ($w%2 == 0) $w++;
	if ($h%2 == 0) $h++;
	
	if (!isset($_GET['leveys']) || $w < 31) $w = 31;		
	if (!isset($_GET['korkeus']) || $h < 15) $h = 15;
	
	if ($w > 81) $w = 80;
	if ($h > 41) $h = 40;
	
	$t = array ($x, $y);
	
	$North = 0;
	$East = 1;
	$South = 2;
	$West = 3;
	
	function MoveX ($x, $Dir)
	{
		global $East, $West;
		return $x + ($Dir == $East) - ($Dir == $West);
	}
	
	function MoveY ($y, $Dir)
	{
		global $South, $North;
		return $y + ($Dir == $South) - ($Dir == $North);
	}
	
	function Out ($x, $y)
	{
		global $t, $w, $h;
		return ($x <= 0 || $y <= 0 || $x >=	$w || $y >= $h || $t[$x][$y]!='#');
	}
	
	function Generate ($hx, $hy, $Forb = -1)
	{
		global $t, $North, $East, $West, $South;
			
		$t[$hx][$hy] = "&nbsp;";
		
		$Dir = rand (0, 4);
		for ($u = $Dir; $u < $Dir+4; $u++)
		{
			$i = $u%4;
			
			if ($i == $Forb && rand(0,3))
				continue;
		
			$x = $hx;
			$y = $hy;
		
			$Fail = 0;
			for ($a = 0; $a < 2; $a++)
			{
				$x = MoveX ($x, $i);
				$y = MoveY ($y, $i);
				
				if (Out ($x, $y))
					$Fail = 1;
			}
			
			if ($Fail)
				continue;
			
			$x = $hx;
			$y = $hy;
			for ($a = 0; $a < 2; $a++)
			{
				$x = MoveX ($x, $i);
				$y = MoveY ($y, $i);
				
				$t[$x][$y] = "&nbsp;";
			}
			
			if ($i == $North) $Op = $South;
			if ($i == $South) $Op = $North;
			if ($i == $East) $Op = $West;
			if ($i == $West) $Op = $East;
			Generate ($x, $y, $Op);
		}
	}
	
	for ($y = 0; $y < $h+1; $y++)
	for ($x = 0; $x < $w+1; $x++)
		$t[$x][$y] = "#";
	
	Generate (1+rand(0, $w/2-2)*2, 1+rand(0, $h/2-2)*2);
	
	echo '<div style="line-height:16px;padding:0;margin:0;">';
	for ($y = 0; $y < $h; $y++)
	{
		for ($x = 0; $x < $w; $x++)
		{
			if($t[$x][$y]=='#')
				echo '<span style="background:#000;">&nbsp;&nbsp;</span>';
			else
				echo '&nbsp;&nbsp;';
		}
		echo '<br />';
	}
	echo '</div>';
?>
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Esimerkkejä aloittelijoille.

Post by MaGetzUb »

Grandi wrote:Puhetta

Code: Select all

PHP koodia
No kyllä olisit voinut vähän tuota koodia edes yrittää selittää. Sitäpaitsi itsekkin osaat yhtähyvin CoolBasicia, kyllä olisit itsekkin saanut tuon koodin käännettyä. Ja huom tämä topic on aloittelijoille.
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.
Koodiapina
Forum Veteran
Posts: 2396
Joined: Tue Aug 28, 2007 4:20 pm

Re: Esimerkkejä aloittelijoille.

Post by Koodiapina »

MaGetzUb wrote:No kyllä olisit voinut vähän tuota koodia edes yrittää selittää.
Labyrintti koostuu taulukosta, joka on ensin läpeensä "seinää". Tämän jälkeen siihen kaivetaan polkuja rekursiivisen algoritmin avulla:

Code: Select all

Ollaan ruudussa (x,y). Aivan alussa nämä arvot ovat satunnaisgeneroituja.
Käydään läpi neljä ilmansuuntaa satunnaisessa järjestyksessä:
    Jos ruudusta (x,y) voisi kaivaa polun ko. suuntaan:
        Kaiva polku.
        Suorita tämä sama algoritmi polun pääteruudulle.
MaGetzUb wrote:Sitäpaitsi itsekkin osaat yhtähyvin CoolBasicia
Paremmin.
MaGetzUb wrote:kyllä olisit itsekkin saanut tuon koodin käännettyä.
Minulla ei ole nyt CB:tä käytettävissä, enkä nyt sokkona ala koodaamaan.
Post Reply