Esimerkkejä aloittelijoille.

[DatsuniG]

Heitetääs sekaan vielä tämmöinen kiva pyramidi funktio : )
Kaikki toimii samalla tavalla kuin tuossa ylemmässä : )

Code: Select all

SCREEN 800,600

Repeat

If plusx=False Then 
x=x+1
Else 
x=x-1
EndIf 

If x>Rand(30,250) Then
plusx=True
EndIf 

If plusz=False Then
z=z+1
Else 
z=z-1
EndIf 

If z>Rand(30,250) Then 
plusz=True 
EndIf 

If plusy=False Then
y=y+1
Else 
y=y-1
EndIf 

If plusy>Rand(30,250) Then 
plusy=True
EndIf 

If plusx=0 Then 
plusx=False
EndIf 

If plusy=0 Then 
plusy=False
EndIf 

If plusz=0 Then 
plusz=False
EndIf 

Text 0,0,x+" - "+y+" - "+z



Pyramidi(MouseX(),MouseY(),x,y,z)

DrawScreen

Forever 


Function Pyramidi(x,y,_w,_h,_z)

Line x,y,x+_w,y
Line x-_z/2,y-_z/2,x,y
Line x-_z/2,y-_z/2,x-_z/2+_w,y-_z/2
Line x+_w,y,x-_z/2+_w,y-_z/2

temp=x-(x-_z/2)

// VIIVA ; O
'Line x+temp/2,y-_z/4,x+temp/2,(y-_z/4)-_h

Line x,y,x+temp/2,(y-_z/4)-_h
Line x+_w,y,x+temp/2,(y-_z/4)-_h
Line x-_z/2,y-_z/2,x+temp/2,(y-_z/4)-_h
Line x-_z/2+_w,y-_z/2,x+temp/2,(y-_z/4)-_h

EndFunction 

[Ris]

Heitetääs sekaan vielä tämmöinen kiva pyramidi funktio : )
Kaikki toimii samalla tavalla kuin tuossa ylemmässä : )

Sori mutta pakko huomauttaa: Sisennys on vähän huonohkoa ja tuplaposti (vaikka aikaisempi posti on edellisen sivun lopussa ja uuden alussa niin silti se on tuplaposti. Noi kummatkin esimerkit olisi voinut laittaa helposti samaan postiin. Toki jokaisella on omanlainen sisennys tyyli, mutta toi sinun sisennys ei mielestäni ole aivan oikea oppinen sisennystyyli.

Toki ne voi helposti itsekkin sisentää, mutta hyviin ohjelmointitapoihin on aina kuulunut sisennys + esimerkit on parempi postata sisennettynä. Vähän pidemmässä koodissa sisentämättä jättäminen on vain haitaksi. No esimerkkini on type ja partikkeliesimerkkini

Code: Select all

SCREEN 400,400 

Type Partikkeli 'Tyypin nimi
    Field obj    'Fieldin jälkeen tulee muuttujan nimi
    Field par      
End Type         'Tyyppi loppuu tähän 

'Vakiot partikkeleille.

Const PartMäärä = 40  'Partikkeleitten määrä
Const PartX = 0           'Partikkelilähdeen x paikka ruudulla
Const PartY = 160        'Partikkelilähdeen y paikka ruudulla
Const PartLifeTime = 40  'Partikkeleitten eloaika

img=LoadImage("Media\particle.bmp") 'Ladataan kuva

For m = 1 To PartMäärä 'Muodostetaan silmukka joka toistetaan vakion PartMäärä :n mukaisesti

    a.partikkeli=New(partikkeli) 'Uusi kokoelman jäsen on a

    a\obj=CloneImage(img)        'Kloonataan kuva kokoelmaan ja tyyppimuuttujaan a\obj

    'Tehdään tyyppimuuttujasta obj partikkelilähde par ja nämä ovat kokoelmassa a
                                                                
    a\par=MakeEmitter(a\obj,PartLifeTime) 'PartLifeTime on partikkelilähteen eloaika.

    PositionObject a\par,PartX,PartY ' Sijoitetaan partikkelilähde PartX ja PartY numeroihin.

Next m

Repeat 

    'Tämä jännä rand-efekti on vain taustaa varten 

    For i = 1 To Rand(200,500)
        If Rand(1,4)=2 Then 
            ClsColor Rand(1,15),Rand(1,15),Rand(1,15)
            Color Rand(1,255),Rand(1,155),Rand(1,155)
            Dot Rand(1,400),Rand(1,400)
        End If 
    Next i 
    
   'Seuraavassa käydään kokoelman tyyppimuuttujat läpi

    For a.partikkeli=Each partikkeli 

        ParticleMovement a\par,5,0.4   'Asetetaan partikkeleitten liikkuvuusominaisuudet
        ParticleEmission a\par,2,2,400 'Katso manuaalin teksti tästä komennosta.
        RotateObject a\par,90      'Toki katso myös muitten komentojen tekstit manuaalista.

    Next a
    
    ClearText 
    
    AddText ""+FPS()
    
    DrawScreen 
    
Forever 

[koodaaja]

Pyramidista tuli mieleen viime viikolla laskimelle ohjelmoimani sierpinskin kolmio jonka käänsin myös CB:lle, ja siitä taas muistui hieman aiemmin tekemäni "kukkakaalifraktaali", se klassinen puu, joka koki saman TIBasic->CB -rumban.

Kun nyt on kyseessä topic "Esimerkkejä aloittelijoille", niin seuraa pientä sepustusta rekursiosta, johon nämä molemmat perustuvat. Funktio, joka kutsuu itseään, on rekursiivinen funktio. Luonnollisesti se sisältää jonkin ehdon, joka on täytettävä ennen itsensä kutsumista, jotta funktioiden sumasta palataankin joskus.

Esimerkiksi kukkakaalifraktaalissa jokaisen viivan päähän piirretään puolet alkuperäisen viivan pituudesta olevat viivat 45 asteen kulmissa eri suuntiin, ja näistä piirretään puolet niiden pituudesta olevat viivat 45 asteen kulmissa eri suuntiin, ja tätä jatkuu, kunnes puolitettu pituus on liian pieni, jotta sitä kannattaisi piirtää.

Toki ohjelman suoritusjärjestyksen takia ensimmäisestä viivasta haarautuvista kahdesta ensin piirretään toinen ja kaikki sen alahaarat ja sitten vasta toinen. Asia selkenee kenties paremmin katsomalla esimerkkejä ja kovalla ajattelulla. Yritin kommentointiakin heittää sekaan.

Tässäpä näitä.

Code: Select all

SCREEN 640, 480, 0, 1

w# = ScreenWidth()/2
h# = ScreenHeight()
m# = h/2

Function kukkakaali(x#, y#, ang#, m#)
    
    newx# = x+Cos(ang)*m//lasketaan viivan päätepiste, m pikseliä ang suuntaan.
    newy# = y-Sin(ang)*m
    
    Line x, y, newx, newy//piirretään viiva..
    
    DrawScreen OFF
    
    If m>1//.. ja jollei se ole liian pieni...
        kukkakaali( newx, newy, ang+45, m/2.0 )//...piirretään kaksi pienempää lisähaaraa. voit kokeilla jakaa muillakin luvuilla kuin kahdella.
        kukkakaali( newx, newy, ang-45, m/2.0 )
    EndIf
    
End Function

kukkakaali(w, h, 90, m)//ensimmäinen viiva suoraan ylös

//drawscreen funktion sijaan tähän jos et halua katsella kuvion piirtymistä.

WaitKey

Code: Select all

SCREEN 640, 480, 0, 1

w# = ScreenWidth()/2
h# = ScreenHeight()/2
m# = w/2

Function sierpinski(x#, y#, m#)//piirtää kolmion, jonka ylle ja molemmille alasivustoille tulee uudet, pienemmät kolmiot
    
    Line x-m, y,  x+m, y//piirretään kolmio
    Line x+m, y, x, y+m
    Line x, y+m, x-m, y
    
    DrawScreen OFF
    
    If m>4//jos kolmio on tarpeeksi suuri, sille piirretään pikkusiskoja/veljiä
        sierpinski( x, y-m/2, m/2 )
        sierpinski( x+m, y+m/2, m/2 )
        sierpinski( x-m, y+m/2, m/2 )
    EndIf
    
End Function

Line 0, h+m, w, h-m//koko höskää ympäröivä kolmio, lähinnä esteettinen tekijä
Line w, h-m, w*2, h+m
Line w*2, h+m, 0, h+m

sierpinski(w, h, m)//ensimmäinen, isoin kolmio, josta homma lähtee

//jos haluaa ihastella vain valmista kuvaa, tähän voi laittaa DrawScreenin ja poistaa funktion sisällä olevan Drawscreen OFF:n

WaitKey

[Arska]

Tälläsen strategiapeli esimerkin tein, kun en muutakaan keksinyt. Koodi on huonosti toteutettu, koska pitäisi laittaa typeihin pisteet. Eli tämän pohjalta älkää missään nimessä peliä aloittako. Kyllä tästä varmaan jotain irti saa.

Code: Select all

x=100
y=100

Health=10

Repeat

Color 255,255,255
Circle x,y,3


If Distance(x,y,MouseX(),MouseY()) <= 5 And MouseHit(1) Then piste1=1


If piste1=1 And MouseHit(1) Then
pisteen1valX=MouseX()
pisteen1valY=MouseY()
EndIf

//Jos piste valittuna näytetään Health ja pisteen ympärille vihreä laatikko.
Color 0,255,0  
If piste1=1 Then 
Box x-4,y-4,10,10,0
Color cbred
Box x-4,y-7,Health,2
EndIf
Color 0,255,0 

//Pisteen liikkuminen. Jos ei olla paikalla jonne klikattiin liikutaan kunnes x ja y ovat tosi.
If piste1=1 Then 
If x<pisteen1valX Then x+1
If x>pisteen1valX Then x-1
If y<pisteen1valY Then y+1
If y>pisteen1valY Then y-1
EndIf


If MouseHit(2)Then piste1=0 //Jos painetaan hiiren 2 painiketta poistetaan valinta pisteestä.

//piste on valittu ja painetaan P niin klikattu paikka muuttuu nykyiseksi pisteen paikaksi, eli pysähdytään.
If piste1=1 And KeyHit(cbkeyP)Then 
pisteen1valX=X
pisteen1valY=y
EndIf

//Healthin lisäys ja vähennys.
If piste1=1 And Health<10 And KeyHit(cbkeyY)Then Health=Health+1 
If piste1=1 And Health>0 And KeyHit(cbkeyH)Then Health=Health-1

Text 10,10,"P = Halt"
Text 10,25,"Y = Lisää Health"
Text 10,35,"H = Vähennä Health"

DrawScreen
Forever 

[kaneli2000]

Hitto vie! Juuri kun sain tehtyä jotain "hienoa", niin sitten Arska tulee ja tekee melkein saman jutun!

Olen nimittäin ajatellut tehdä RPG-pelin, jossa liikuttaisiin ei yleiseen cb-tyyliin nuolilla vaan hiirellä.

Heitin tuommoisen pienen esimerkin ukon liikkumisesta:

Code: Select all

SCREEN 800,600

'ladataan ukko
ukko=LoadObject ("media\guy.bmp",72)

'tehdään tyhjä objekti
tyhjä=MakeObject()

'mainloop
Repeat

'JOS hiiren oik. painiketta painetaan, tyhjä objekti heitetään sinne missä hiiri oli kilkin hetkellä ja "point" muuttuja vaihdetaan ykköseksi
    If MouseHit(1) Then
        PositionObject tyhjä,MouseWX(),MouseWY()
        point=1
    EndIf
    
'JOS point -muuttuja on yksi (päällä), ukko laitetaan kävelemään tyhjän objektin suuntaan
    If point=1 Then
        PointObject ukko,tyhjä
        MoveObject ukko,3
    EndIf
    
'JOS ukko ja tyhjä objekti törmäävät, ukko pysähtyy ja point -muuttuja -> 0 (pois päältä)
    If ObjectsOverlap(ukko,tyhjä) Then
        point=0
    EndIf

'älä unohda näitä:        
DrawScreen

Forever

'Analyysi:
'Jos point -muuttuja on päällä, ukko likkuu tyhjän objektin suuntaan, ja jos tyhjä objekti ja ukko törmäävät, liikkuminen laitetaan pois päältä.
'Aina kun tapahtuu oik. hiiren klikki, point menee päälle ja tyhjää objektia siirretään. Helppoa!

Se on helpompi käyttää ihan vasta-alkajalle kuin tuo arskan funktiokasa, mutta ei se ihan niin hieno sitten olekkaan. Vaikka, tämähän on RPG-peliin, tuo ylempi stradegiaan.

[Jonhu]

yksinkertainen viiva objectista. (Ajattelin muuttaa vähän tykkipelini voiman säätöä, sivussa syntyi tälläinen functio)

EDIT: Tein 2 eri versiota.. Toisessa tarvitsee vain objectin nimen ja kohteen toisessa molempien sijainnin..

voimaviiva2(x1#,y1#,x2#,y2#,paksuus,maxpituus)
Ekakappale(x1,x2)
Tokakappale(x2,y2)
paksuus=viivan paksuus
maxpituus=maksimi pituus

Code: Select all

SCREEN 800,600

cannon  = LoadObject( "media\cannon.bmp", 72 )

Repeat

    ankle# = -GetAngle(MouseWX(),MouseWY(),ObjectX(cannon),ObjectY(cannon))+180
    
    RotateObject cannon,ankle#

    voima#=voimaviiva2(ObjectX(cannon),ObjectY(cannon),MouseWX(),MouseWY(),2,150)
    
    Text 10,10,"Voima: "+voima#

    DrawScreen 
    
Until EscapeKey()


Function voimaviiva2(x1#,y1#,x2#,y2#,paksuus,maxpituus)
    pituus# = Distance(x1#,y1#,x2#,y2#)           // mittaa etäisyyden
    angle#  = -GetAngle(x1#,y1#,x2#,y2#)          // mittaa kulman
    If pituus#>maxpituus Then pituus#=maxpituus // rajoittaa viivan pituuden
    r=0 : g=180 : b=0          // määrää värit
    For a=1 To RoundUp(pituus#)
        Color r,g,b      // asettaa värit
        xn2# = x1# + Sin(angle# + 90)*(a) +ScreenWidth()/2
        yn2# = -y1# - Cos(angle# - 90)*(a) +ScreenHeight()/2
        Circle xn2#-paksuus/2,yn2#-paksuus/2,paksuus,1  // piirtää ympyrän yllä laskettuun kohtaan
        //värien säätelyä...
        If a<maxpituus/3                       
            r + 3   : g + 4
        ElseIf maxpituus/3<a And a<maxpituus*(2/3)
            r + 3 : g - 1
        ElseIf maxpituus*(2/3)<a And a<maxpituus 
            r + 3 : g - 2
        EndIf
        If  b > 255 : b=255 : ElseIf  b < 0 : b=1 : EndIf
        If  g > 255 : g=255 : ElseIf  g < 0 : g=1 : EndIf
        If  r > 255 : r=255 : ElseIf  r < 0 : r=1 : EndIf
    Next a
    Return pituus# //palauttaa pituuden arvon
EndFunction

voimaviiva(x2#,y2#,obj,paksuus,maxpituus)
Kappale2(x2#,y2#)
Objeckti (obj)
paksuus=viivan paksuus
maxpituus=maksimi pituus

Code: Select all

SCREEN 800,600

cannon  = LoadObject( "media\cannon.bmp", 72 )

Repeat

    ankle# = -GetAngle(MouseWX(),MouseWY(),ObjectX(cannon),ObjectY(cannon))+180
    
    RotateObject cannon,ankle#
    
    voima#=voimaviiva(MouseWX(),MouseWY(),cannon,2,150)
    
    Text 100,100,voima#
    
    DrawScreen 
    
Until EscapeKey()

Function voimaviiva(x2#,y2#,obj,paksuus,maxpituus)

    x1#=ObjectX(obj) 
    y1#=ObjectY(obj) 
    
    pituus#=Distance(x1#,y1#,x2#,y2#)      
    If pituus#>maxpituus Then pituus#=maxpituus 
    
    r=0 : g=180 : b=0      
    
    For a=1 To RoundUp(pituus#)
        Color r,g,0
        xn2# =  ObjectX(obj) + Sin(ObjectAngle(obj) + 90)*(a) + ScreenWidth()/2
        yn2# = -ObjectY(obj) - Cos(ObjectAngle(obj) - 90)*(a) + ScreenHeight()/2
        Circle xn2#-paksuus/2,yn2#-paksuus/2,paksuus,1  
        If a<maxpituus/3                       
            r + 3 : g + 4
        ElseIf maxpituus/3<a And a<maxpituus*(2/3)
            r + 3 : g - 1
        ElseIf maxpituus*(2/3)<a And a<maxpituus 
            r + 3 : g - 2
        EndIf
        If  g > 255 : g=255 : ElseIf  g < 0 : g=1 : EndIf
        If  r > 255 : r=255 : ElseIf  r < 0 : r=1 : EndIf
    Next a
    Return pituus# 
EndFunction

[MaGetzUb]

Hieno, koitappa pistää drawscreen off ja vetää hiirellä siihen täys ympyrä..

EDIT:

Munasin taas..

[DatsuniG]

Teinpäs tämmösen funktio parin joilla saa tehtyä kuvasta tekstitiedoston ja tekstitiedostosta kuvan. Laitoinpa mukaan vielä salauksen, jolla ei nyt ole niin kovin suuri vaikutus, ehkä hieman värien vääristymistä. Nyt on koodi vielä kommentoituna ja sisennettynä :O

Code: Select all

// Ladataan kuva muistiin
kuva=LoadImage("media/guy.bmp")

// Tehdään kuvasta koodi. "img.txt" on koodin tallennuspaikka
// "I'm so 1337" on salasana. Vertaa lyhyen ja pitkän salasanan eroa
Codeimage(kuva,"img.txt","I'm so 1337")

// Tehdään kuva koodin pohjalta
// "img.txt" ladataa koodi
// "I'm so 1337" on salauksen purun avain, kokeile muuttaa tätä
kuva=MakeCodeimage("img.txt","I'm so 1337")

Repeat
    DrawImage kuva,40,40 'Piirretään luotu kuva
DrawScreen
Forever 











/////////////////////////////////////////
// F U N K T I O T //////////////////////
/////////////////////////////////////////

Function Codeimage(Kuvamuuttuja,output$,_pass$="")

file=OpenToWrite(output) ' Avataan tiedosto
WriteLine file,ImageWidth(Kuvamuuttuja) ' Kirjoitetaan tietoja kuvasta
WriteLine file,ImageHeight(Kuvamuuttuja) ' Kirjoitetaan tietoja kuvasta


For i=1 To Len(_pass)
passnum=passnum+Asc(Mid(_pass,i,1)) ' Luodaan salasanasta numero
Next i 

If _pass="" Then passnum=1

For i=1 To ImageHeight(kuvamuuttuja) ' Läpikäynti
    For a=1 To ImageWidth(kuvamuuttuja)
    PickImageColor kuvamuuttuja,a,i
    
            WriteLine file,getRGB(RED)*passnum ' Kirjoitetaan piirtovärin punaisen komponentin arvo
            WriteLine file,getRGB(GREEN)*passnum ' Kirjoitetaan piirtovärin vihreä komponentin arvo
            WriteLine file,getRGB(BLUE)*passnum ' Kirjoitetaan piirtovärin sininen komponentin arvo

    Next a
Next i 

CloseFile file ' Suljetaan tiedosto

EndFunction 


Function MakeCodeImage(_file$,_decode$="")


For i=1 To Len(_decode)
passnum=passnum+Asc(Mid(_decode,i,1)) ' Luodaan salasanasta numero
Next i 

If _decode="" Then passnum=1

file=OpenToRead(_file)

    _w=Int(ReadLine(file)) ' Luetaan kuvan koko
    _h=Int(ReadLine(file)) ' Luetaan kuvan koko
    
img=MakeImage(_W,_h) ' Luodaan kuva aikaisempien tietojen perusteella

DrawToImage img ' Piirretään kuvaan

For I=1 To _H
    For a=1 To _w
    Color Int(ReadLine(file))/passnum,Int(ReadLine(file))/passnum,Int(ReadLine(file))/passnum ' Luodaan väri
    Dot a,i ' Piste
    Next a
Next i 

DrawToScreen ' Piirretään ruudulle

Return img  ' Palautetaan kuva

EndFunction

[MaGetzUb]

Aika kätevä... Paitsi kuvan pituus & leveys kannattaisi salata myös..
Ja sitten myös kannattaa käyttää OpenToEdit, WriteInt, WriteStirng, WriteByte-komentoja..

[DatsuniG]

Teinpäs pari kivaa kuvan muokkaamis funkkaria.
Käyttö:
Lataa kuva
Sijoita funktion parametri kohtaan kuvan muuttuja
Aloita silmukka, piirrä kuva ja voila.

Grayscale

Code: Select all

Function Grayscale(img)
    For a=0 To ImageHeight(img)
        For i=0 To ImageWidth(img)
            
            PickImageColor img,i,a
            DrawToImage img 
            r=getRGB(RED)
            g=getRGB(GREEN)
            b=getRGB(BLUE)
            
            higher=Max(r,g)
            higher1=Max(r,b)
            
            value=Max(higher,higher1)
            
    
            
            Color value,value,value
            Dot i,a
            DrawToScreen 
        Next i
    Next a
EndFunction 

Mustaa ja valkoista

Code: Select all

Function Blackandwhite(img)
For a=0 To ImageHeight(img)
    For i=0 To ImageWidth(img)
        
        PickImageColor img,i,a
        DrawToImage img 
        r=getRGB(RED)
        g=getRGB(GREEN)
        b=getRGB(BLUE)

        If (r+g+b)/3>255/2 Then value=255 Else value=0
        
        Color value,value,value
        Dot i,a
        DrawToScreen 
    Next i
Next a
EndFunction 

EDIT:

Heitetääs sekaan vielä Min2 ja Max2 funktiot

Code: Select all

highest=Max2(231,321,123)
lowest=Min2(231,321,123)
Print "Korkein arvo oli: "+highest
Print "Pienin arvo oli: "+lowest
WaitKey 


Function Max2(a,b,c)
    value1=Max(a,b)
    value2=Max(a,c)
    Return Max(value1,value2)
EndFunction 

Function Min2(a,b,c)
    value1=Min(a,b)
    value2=Min(a,c)
    Return Min(value1,value2)
EndFunction 

[/edit]

[DatsuniG]

Crosshair-funkkari, käytetään drawgamen jälkeen.

Code: Select all

x=200
y=150
Repeat
x=x+(LeftKey()-RightKey())*-3
y=y+(DownKey()-UpKey())*3
Circle x,y,10
Crosshair(x,y,MouseX(),MouseY(),8,60)
DrawScreen
Forever 




Function Crosshair(x,y,x2,y2,size,dis)
angle=GetAngle(x,y,x2,y2)
Circle x+Cos(angle)*dis,y-Sin(angle)*dis,size,OFF 
EndFunction 

[SPuntte]

EDIT:

Heitetääs sekaan vielä Min2 ja Max2 funktiot

Code: Select all

*knips*

[/edit]

Aika turhaa kikkailua. Harvemmin tarvitsee kolmea parametria kahden sijaan, mutta usein kyllä olisi hyötyä, jos funktio ottaisi mielivaltaisen määrän niitä. Tähän taas tarvittaisiin jonkinnäköistä funktioiden ylikuorimittamista..

Mutta varsinainen asiani on, että kirjoittaessasi tuollaiset funktiot, joita todennäköisesti käytetään paljon, ne kannattaa tehdä mahdollisimman helpoiksi prosessorille. Usein valitettavasti koodin selkeyden kustannuksella. Tuossakin on nyt siis yksi Max/Min -kutsu liikaa. Optimointi:

Code: Select all

highest=Max2(231,321,123)
lowest=Min2(231,321,123)
Print "Korkein arvo ON EDELLEEN: "+highest
Print "Pieninkin arvo ON EDELLEEN: "+lowest
WaitKey 

Function Max2(a,b,c)
    Return Max(Max(a,b),c)
EndFunction 

Function Min2(a,b,c)
    Return Min(Min(a,b),c)
EndFunction 

Näin pienenä huomautuksena (en halua olla ilonpilaaja taikka osoittaa tätä kenellekään henkilökohtaisesti, en todellakaan), että kuten tämän ketjun aihe sanoo, tänne on tarkoitus postata hyödyllisiä ja selkeitä esimerkkejä aloitteleville koodareille. Ei aloittelevien koodarien purkkaisia pikku koodinpätkiä, jotka eivät muuten ylitä esimerkkikoodin vaatimuskynnystä...

-- pistetään tänne helpot, pienet ja tarpeelliset esimerkit. --

[DatsuniG]

Ei ollut alunperin tarkoitus laittaa noita, mutta ne syntyivät tuon Grayscale funktion sivussa joten en miettiny niitä paljoa.

[DatsuniG]

No tässä olisi nyt 3 kpl funktioita käyttäjätunnusten hallintaan.

Code: Select all

SCREEN 600,400

Timr=Timer()
If userexists("Pekka","Users.txt")=0 Then 
    Createuser("Pekka","Salis","Users.txt","Salasana123")
    Print "Luotiin käyttäjänimi Pekka, jonka salasana on Salis"
EndIf 
aika=Timer()-timr
Print "Tarkistettiin löytyikö entuudestaan jo käyttäjänimeä Pekka"
Print "Aikaa kului: "+aika+"ms"
Print 
WaitKey

Timr=Timer()
Print "Yritetään kirjautua käyttäjällä Pekka, tarkista seuraava rivi."
If LogIN("Pekka","Salis","Users.txt","Salasana123") Then Print "Onnistui!"
aika=Timer()-timr
Print "Aikaa kului: "+aika+"ms"
WaitKey 

//////////
// CreateUser on funktio, jolla luodaan uusi käyttäjätunnus
//////////
// User$ on luotava käyttäjätunnus
// Pass$ on käyttäjätunnuksen salasana
// File$ on tiedosto, johonka käyttäjätunnuksen tiedot tallennetaan
// Salaus$ on teksti, jolla salasanat kryptataan tiedostoon
//////////


Function Createuser(user$,pass$,file$,salaus$)

    tiedosto=OpenToEdit(file$)
    
    cryptedtxt$=""
    numsalaus=2
    
// Siirrytään tiedoston loppuun
    
    While Not EOF(tiedosto)
        a=ReadLine(tiedosto)
    Wend 

// Luodaan numero, jolla kryptataan
    
        For i=1 To Len(salaus)
            numsalaus=RoundUp(numsalaus+Asc(Mid(salaus,i,1))/Asc(Mid(salaus,1,1)))
        Next i 

// Kryptaus
        
        For i=1 To Len(pass)
            cryptedtxt=cryptedtxt+Chr(Asc(Mid(pass,i,1))-numsalaus)
        Next i

// Kirjoitus
    
    WriteLine tiedosto,user
    WriteLine tiedosto,cryptedtxt
    
    CloseFile tiedosto 

EndFunction

//////////
// Userexists on funktio, jolla tarkistetaan löytyikö etsittyä käyttäjä tunnusta.
// Funktio on kätevä esimerkiksi uutta tunnusta luotaessa.
// Jos käyttäjä tunnus löytyy, funktio palauttaa 1
//////////
// User$ on käyttäjänimi
// File$ on tiedosto, josta tunnusta etsitään
//////////

Function UserExists(user$,file$)

    tiedosto=OpenToRead(file)

// Jos käyttäjätunnus löytyy, palautetaan 1
        
        While Not EOF(tiedosto)
            If ReadLine(tiedosto)=user Then Return 1
        Wend 
    
    CloseFile tiedosto 
     
EndFunction

//////////
// LogIN on funktio, jolla kirjaudutaan sisään
// Jos kirjautuminen onnistuu, funktio palauttaa 1
//////////
// User$ on käyttäjätunnus jolla kirjaudutaan
// Pass$ on käyttäjätunnuksen salasana
// File$ on tiedosto, josta tietoja etsitään
// Salaus$ on teksti, jolla File$:n tiedostot dekryptataan
//////////

Function LogIN(user$,pass$,file$,salaus$)

    tiedosto=OpenToRead(file$)
        
    While Not EOF(tiedosto)
        If user=ReadLine(tiedosto) Then Exit 
    Wend

    passline$=ReadLine(tiedosto)
    Decrypted$=""
    numsalaus=2
    
        For i=1 To Len(salaus)
            numsalaus=RoundUp(numsalaus+Asc(Mid(salaus,i,1))/Asc(Mid(salaus,1,1)))
        Next i 
        
        For i=1 To Len(passline)
            Decrypted=decrypted+Chr(Asc(Mid(passline,i,1))+numsalaus)
        Next i
    
    If decrypted=pass Then Return 1
    
    
    CloseFile tiedosto

EndFunction 

[Jani]

Tässä olisi minunkin vinkkini valikosta johon voi laittaa valintoja niin paljon kuin haluaa:

Code: Select all

v=0

Repeat

    Text 10,10,"Aloita"
    Text 10,30,"Jatka"
    Text 10,50,"Lopeta"
    Text 100,10+v*20,"®"
    
    If KeyHit(cbkeyup) Then v-1
    If KeyHit(cbkeydown) Then v+1
    If KeyHit(28) And v=0 Then MakeError "Peliä ei ole..."
    If KeyHit(28) And v=1 Then MakeError "Jos peli olisi. Ja vielä tallennettu peli..."
    If KeyHit(28) And v=2 Then End
    
    If v<0 Then v=2
    If v>2 Then v=0
    
    DrawScreen
    
Forever 

Tässä on siis valinnat: Aloita, Jatka ja Lopeta.
"Valitaan" merkillä ®. ® merkkiä liikutetaan nuolilla.

Hiirellä toimiva:

Code: Select all

v=Rand(50,255)
v2=Rand(50,255)


Repeat

    Color v,v2,v3
    Text 10,100,"Lopeta"
    Color v,v2,v3
    Text 10,200,"Aloita"
    
    If MouseX()>10 And MouseX()<60 And MouseY()>100 And MouseY()<110
        Color cbblue
        Text 10,100,"Lopeta"
        If MouseDown(1)
            Color cbred
            Text 10,100,"Lopeta"
            DrawScreen
            Wait 1000
            End
        EndIf
    Else
        ClearMouse
    EndIf
    
    If MouseX()>10 And MouseX()<60 And MouseY()>200 And MouseY()<210
        Color cbblue
        Text 10,200,"Aloita"
        If MouseDown(1)
            Color cbred
            Text 10,200,"Aloita"
            DrawScreen
            Wait 1000
            MakeError "Tässä nyt se ^peli^"
        EndIf
    Else
        ClearMouse
    EndIf

aika avara...

[Jonhu]

Tein function, joka laskee viivaan minimi etäisyyden. Veikkaan, että näitä on postattu tänne useampikin, mutta heti en löytänyt..

Kahdella esimerkillä:
Piirtää lyhimmän mahdollisen viivan viivasta hiireen.

Code: Select all

SCREEN 800, 600

Type LINET
    Field x1 As Float
    Field y1 As Float
    Field y2 As Float
    Field x2 As Float
EndType

viiva(500,100,750,150)
viiva(300,450,300,300)

AddText "Viivapeli"
Repeat

    a=0
    For an.LINET=Each LINET
    
        a+1
        dist#=DistLine(MouseX(), MouseY(),an\x1, an\y1, an\x2, an\y2 )

        Color cbwhite
        DrawLine(an\x1, an\y1, an\x2, an\y2)
        
        Text 1,12+a*12, "Viivaan "+a+" etäisyys: "+dist#
        
    Next an
    
    Color cbyellow
    Text 100,1, "FPS: "+FPS()
    
    DrawScreen
    
Until EscapeKey()

Function DrawLine(xx1#,yy1#,xx2#,yy2#)
    Line xx1#,yy1#,xx2#,yy2#
EndFunction

//DistLine
//
// Palauttaa pisteen ja viivan välisen minimi etäisyyden
// pisteen sijainti (px, py)
// viivan alku ja loppu sijainnit: (l1x#, l1y#, l2x#, l2y#)
Function DistLine(px#, py#, l1x#, l1y#, l2x#, l2y#)
    ang#=GetAngle(l1x#, l1y#, l2x#, l2y#)  
    Dist_old#=400000 //maksimi arvo
    For a=1 To Distance(l1x#, l1y#, l2x#, l2y#)
        xn2# = l1x# + Sin(ang#+90)*a
        yn2# = l1y# - Cos(ang#-90)*a
        Dist#=Min( Distance( px#, py#, xn2#, yn2# ) , Dist_old# )
        If Dist#<Dist_old# Then tx#=xn2# : ty#=yn2# ' ei tarvi tätä riviä, jos ei halua piirtää viivaa
        Dist_old#=Dist#
    Next a    
    Color cbred: Line px#, py#,tx#,ty#' ei tarvi tätä riviä, jos ei halua piirtää viivaa
    Return Dist#
EndFunction

// luo uuden viivan..
Function viiva(xx1#,yy1#,xx2#,yy2#)
    aa.LINET=New(LINET)
    aa\x1=xx1#
    aa\x2=xx2#
    aa\y1=yy1#
    aa\y2=yy2#
EndFunction

Viivojen siirtely ohjelma..
Napit:
- Hiirellä liikutat viivoja
- Space lisää viivoja
- numero 1 poistaa ensimmäisen viivan
- numero 2 poistaa viimeisen viivan

Code: Select all

SCREEN 800, 600

Type LINET
    Field x1 As Float
    Field y1 As Float
    Field y2 As Float
    Field x2 As Float
EndType

Global Viivoja

Addline(500,100,750,150)
Addline(300,450,300,300)
Addline(30,45,300,300)
Addline(300,50,300,30)

AddText "Viivapeli : Liikuttele hiirellä viivoja"
AddText "Space lisää viivoja"
Repeat

    For an.LINET=Each LINET
        
        If DistLine(MouseX(), MouseY(),an\x1, an\y1, an\x2, an\y2 )<=30 Then
            If MouseDown(1) Then
                Select LineTop(MouseX(), MouseY(),an\x1, an\y1, an\x2, an\y2)
                    Case 1  
                        an\x1=MouseX()
                        an\y1=MouseY()
                    Case 2
                        an\x2=MouseX()
                        an\y2=MouseY()
                EndSelect
            EndIf
        EndIf
        
        DrawLine(an\x1, an\y1, an\x2, an\y2)
        
    Next an
    
    If KeyUp(cbkeyspace)=1 Then Addline(Rand(1,800),Rand(1,600),Rand(1,800),Rand(1,600))
    If KeyUp(cbkey1)=1 And viivoja>0 Then DeleteLine(1) ' poistaa ekan viivan
    If KeyUp(cbkey2)=1 And viivoja>0 Then DeleteLine(2) ' poistaa vikan viivan
    
    Text 600,1, "FPS: "+FPS()
    
    DrawScreen
    
Until EscapeKey()

Function DeleteLine(valittu)
    Select valittu
        Case 1 
            de.LINET=First(LINET)
        Case 2
            de.LINET=Last(LINET)
    EndSelect
    Delete de
    viivoja-1
EndFunction

Function LineTop(px#, py#, l1x#, l1y#, l2x#, l2y#)
    dist1#=Distance(px#, py#, l1x#, l1y#)
    dist2#=Distance(px#, py#, l2x#, l2y#)
    If dist1#<dist2# Then Return 1 Else Return 2
EndFunction

Function DrawLine(xx1#,yy1#,xx2#,yy2#)
    Line xx1#,yy1#,xx2#,yy2#
EndFunction

Function DistLine(px#, py#, l1x#, l1y#, l2x#, l2y#)
    ang#=GetAngle(l1x#, l1y#, l2x#, l2y#)  
    Dist_old#=4000 //maksimi arvo
    For a=1 To Distance(l1x#, l1y#, l2x#, l2y#)
        xn2# = l1x# + Sin(ang#+90)*(a)
        yn2# = l1y# - Cos(ang#-90)*(a)
        Dist#=Min( Distance( px#, py#, xn2#, yn2# ) , Dist_old# )
        Dist_old#=Dist#
    Next a    
    Return Dist#
EndFunction

Function Addline(xx1#,yy1#,xx2#,yy2#)
    aa.LINET=New(LINET)
    aa\x1=xx1#
    aa\x2=xx2#
    aa\y1=yy1#
    aa\y2=yy2#
    viivoja+1
EndFunction

[tuhoojabotti]

Tylsää kun oli niin tein tämmöisen purkkaisen välimainos esimerkin. Kuvan pistät cb:n media kansioon ja liität koodin suoraan editoriin.

Code: Select all

//näyttö
SCREEN 800,600,32,cbfullscreen
FrameLimit 50

//maasto
ruoho = MakeObjectFloor ()
nurmikko = LoadImage ("Media\grass.bmp")
PaintObject ruoho, nurmikko

//tie
road=LoadObject ("Media\road.png")
road2=CloneObject(road)
PositionObject road2,861,0

//auto
car = LoadObject ("Media\car.bmp",72)
carxm#=0.5
carym#=0.5
carmaxx=30
carminx=-30
carmaxy=10
carminy=-10

Dim Txt(8) As String //tekstit
Dim delay(8) As Float //tekstien kirjoitus nopeus millisekunteina

//tekstien asetus
Txt(0)="Tämä esimerkki teksti voisi sisältää juoni paljastuksia!"
delay(0)=60
Txt(1)="... Tai sitten ei."
delay(1)=100
Txt(2)="Mutta mistä sitä tietää!   Jos vaikka joku tekisi niin."
delay(2)=100
Txt(3)="Näitä tekstejä voi muuten taikoa lähes loputtomiin,"
delay(3)=100
Txt(4)="mutta tuskin sinua kiinnostaa."
delay(4)=100
Txt(5)="Saatat jopa haluta käyttää tätä tekelettäni omassa projektissasi..."
delay(5)=100
Txt(6)="Ei se minua haittaa.      Kiittää Tietenkin saa."
delay(6)=200

stringcount=7 //tekstien määrä
waittime=1000 //odotus ennen seuraavan lauseen aloittamista millisekunteina
pos=0 //kohta lauseessa
Stringi=0 //lause jossa ollaan menossa
gamma=0 //n'ytön gamma

t=Timer()
Repeat

    //update animation
    If ObjectX(car)<carminx Then 
        carxm=Rnd(1)
    EndIf 
    If ObjectX(car)>carmaxx Then 
        carxm=Rnd(-1)
    EndIf
    If ObjectY(car)<carminy Then 
        carym=Rnd(-0.5)
    EndIf 
    If ObjectY(car)>carmaxy Then 
        carym=Rnd(0.5)
    EndIf   
    MoveObject car,carxm,carym
    MoveObject road,-6
    If ObjectX(road)=<-855 Then PositionObject road,861,0
    MoveObject road2,-6
    If ObjectX(road2)=<-855 Then PositionObject road2,861,0
    MoveObject ruoho,-6
    //update texts
    DrawGame 
    Color cbblack
    Text 200,400,Left(txt(stringi),pos) //draw the partion of the text
    //add token to the text
    If t+delay(stringi)<Timer() Then 
        pos+1
        If waiter=0 Then t=Timer()
    EndIf 
    //see if the sentence is written
    If pos=Len(txt(stringi)) Then
        Waiter=waittime
    EndIf 
    //wait some time after the sentence is fully written
    If waiter<>0 And gamma=0 Then
        //Text 0,0,t+" "+waiter+" "+Timer()
        If t+waiter<Timer() Then waiter=0: stringi+1: pos=0
    EndIf 
    //last text? slowly fade away...
    If stringi=stringcount Then
        ScreenGamma gamma,gamma,gamma
        gamma-1
        If gamma<-255 Then Exit 
    EndIf 
    
    DrawScreen

Forever

Wait 300
End 

[rami123]

todella hieno! tuo välimainosefektisi

[Jani]

Teinpäs tämmösen funktio parin joilla saa tehtyä kuvasta tekstitiedoston ja tekstitiedostosta kuvan. Laitoinpa mukaan vielä salauksen, jolla ei nyt ole niin kovin suuri vaikutus, ehkä hieman värien vääristymistä. Nyt on koodi vielä kommentoituna ja sisennettynä :O

Code: Select all

// Ladataan kuva muistiin
kuva=LoadImage("media/guy.bmp")

// Tehdään kuvasta koodi. "img.txt" on koodin tallennuspaikka
// "I'm so 1337" on salasana. Vertaa lyhyen ja pitkän salasanan eroa
Codeimage(kuva,"img.txt","I'm so 1337")

// Tehdään kuva koodin pohjalta
// "img.txt" ladataa koodi
// "I'm so 1337" on salauksen purun avain, kokeile muuttaa tätä
kuva=MakeCodeimage("img.txt","I'm so 1337")

Repeat
    DrawImage kuva,40,40 'Piirretään luotu kuva
DrawScreen
Forever 











/////////////////////////////////////////
// F U N K T I O T //////////////////////
/////////////////////////////////////////

Function Codeimage(Kuvamuuttuja,output$,_pass$="")

file=OpenToWrite(output) ' Avataan tiedosto
WriteLine file,ImageWidth(Kuvamuuttuja) ' Kirjoitetaan tietoja kuvasta
WriteLine file,ImageHeight(Kuvamuuttuja) ' Kirjoitetaan tietoja kuvasta


For i=1 To Len(_pass)
passnum=passnum+Asc(Mid(_pass,i,1)) ' Luodaan salasanasta numero
Next i 

If _pass="" Then passnum=1

For i=1 To ImageHeight(kuvamuuttuja) ' Läpikäynti
    For a=1 To ImageWidth(kuvamuuttuja)
    PickImageColor kuvamuuttuja,a,i
    
            WriteLine file,getRGB(RED)*passnum ' Kirjoitetaan piirtovärin punaisen komponentin arvo
            WriteLine file,getRGB(GREEN)*passnum ' Kirjoitetaan piirtovärin vihreä komponentin arvo
            WriteLine file,getRGB(BLUE)*passnum ' Kirjoitetaan piirtovärin sininen komponentin arvo

    Next a
Next i 

CloseFile file ' Suljetaan tiedosto

EndFunction 


Function MakeCodeImage(_file$,_decode$="")


For i=1 To Len(_decode)
passnum=passnum+Asc(Mid(_decode,i,1)) ' Luodaan salasanasta numero
Next i 

If _decode="" Then passnum=1

file=OpenToRead(_file)

    _w=Int(ReadLine(file)) ' Luetaan kuvan koko
    _h=Int(ReadLine(file)) ' Luetaan kuvan koko
    
img=MakeImage(_W,_h) ' Luodaan kuva aikaisempien tietojen perusteella

DrawToImage img ' Piirretään kuvaan

For I=1 To _H
    For a=1 To _w
    Color Int(ReadLine(file))/passnum,Int(ReadLine(file))/passnum,Int(ReadLine(file))/passnum ' Luodaan väri
    Dot a,i ' Piste
    Next a
Next i 

DrawToScreen ' Piirretään ruudulle

Return img  ' Palautetaan kuva

EndFunction

Heh... tulosti tismalleen oikean kuvan kunhan saliksessa oli vain tarpeeksi merkkejä

[Jani]

Tää nyt vielä isometrinen Lopeta painike (ei toteutettu functioilla). Kommentoimatonta olkaa hyvät

Code: Select all

lopeta$="Lopeta"

x=10 : y=10

Repeat

    Gosub tiedot
    Color cbred
    Box 9,9,laatikkox-2,laatikkoy-1,0
    Box 8,8,laatikkox-2,laatikkoy-2,0
    Color cbgreen
    Box 7,7,laatikkox-3,laatikkoy-3,0
    Box 6,6,laatikkox-4,laatikkoy-4,0
    Color cbred
    Box 5,5,laatikkox-5,laatikkoy-5,0
    Box 4,4,laatikkox-6,laatikkoy-6,0
    Color cbgreen
    Box 3,3,laatikkox-7,laatikkoy-7,0
    Box 2,2,laatikkox-8,laatikkoy-8,0
    Color cborange
    Box 10,10,laatikkox,laatikkoy
    Color cbblack
    Text 15,15,lopeta
    
    If mx>4 And mx<laatikkox+1 And my>4 And my<laatikkoy+1
        Color cbblue
        Box 10,10,laatikkox,laatikkoy
        Color cbwhite
        Text 15,15,lopeta
        If MouseDown(1)
            Wait 1000
            End
        EndIf
    Else
        ClearMouse
    EndIf
    
    DrawScreen
Forever
    
tiedot:

mx=MouseX() : my=MouseY()

laatikkox=TextWidth(lopeta)+15
laatikkoy=TextHeight(lopeta)+15
Return

EDIT: Tässä nyt mukana vielä Aloita painike (Aloita ja Lopeta)

Code: Select all

lopeta$="Lopeta"
aloita$="Aloita"

x=10 : y=10

Repeat

    Gosub tiedot
    Color cbred
    Box 9,9,laatikkox-1,laatikkoy-1,0
    Box 8,8,laatikkox-2,laatikkoy-2,0
    Color cbgreen
    Box 7,7,laatikkox-3,laatikkoy-3,0
    Box 6,6,laatikkox-4,laatikkoy-4,0
    Color cbred
    Box 5,5,laatikkox-5,laatikkoy-5,0
    Box 4,4,laatikkox-6,laatikkoy-6,0
    Color cbgreen
    Box 3,3,laatikkox-7,laatikkoy-7,0
    Box 2,2,laatikkox-8,laatikkoy-8,0
    Color cborange
    Box 10,10,laatikkox,laatikkoy
    Color cbblack
    Text 15,15,lopeta
    Color cbred
    Box 14,79,aloitax-1,aloitay-1,0
    Box 13,78,aloitax-2,aloitay-2,0
    Color cbgreen
    Box 12,77,aloitax-3,aloitay-3,0
    Box 11,76,aloitax-4,aloitay-4,0
    Color cbred
    Box 10,75,aloitax-5,aloitay-5,0
    Box 9,74,aloitax-6,aloitay-6,0
    Color cbgreen
    Box 8,73,aloitax-7,aloitay-7,0
    Box 7,72,aloitax-8,aloitay-8,0
    Color cborange
    Box 15,80,aloitax,aloitay
    Color cbblack
    Text 20,85,aloita
    
    If mx>4 And mx<laatikkox+10 And my>4 And my<laatikkoy+10
        Color cbblue
        Box 10,10,laatikkox,laatikkoy
        Color cbwhite
        Text 15,15,lopeta
        If MouseDown(1)
            Wait 500
            End
        EndIf
    Else
        ClearMouse
    EndIf
    
    If mx>15 And mx<aloitax+15 And my>80 And my<aloitay+80
        Color cbblue
        Box 15,80,aloitax,aloitay
        Color cbwhite
        Text 20,85,aloita
        If MouseDown(1)
            Wait 500
            MakeError "Tässä on se "+Chr(34)+"peli"+Chr(34)+" :)"
        EndIf
    Else
        ClearMouse
    EndIf
    
    DrawScreen
Forever
    
tiedot:

mx=MouseX() : my=MouseY()

aloitax=TextWidth(aloita)+15
aloitay=TextHeight(aloita)+15

laatikkox=TextWidth(lopeta)+15
laatikkoy=TextHeight(lopeta)+15
Return

EDIT2: Anteeksti jos on pientä purkkaa tuo 6 laatikon vaihe.

EDIT3: En tiedä että onko tämmönen jo, mutta tässä tällänen "tekstin tasaaja"

Code: Select all

teksti$="Tasattu"

x=ScreenWidth()/2-TextWidth(teksti)/10
y=ScreenHeight()/2-TextHeight(teksti)/2

Repeat

    CenterText x,y,teksti,2

    DrawScreen

Forever

(tuohon saa liitettyä miyö isometristä tekstiä )