Esimerkkejä aloittelijoille.

Taatero · Post by **Taatero** » Fri Dec 26, 2008 10:28 pm

Ikävää näin nostella vanhoja asiota, mutta TTD on vaan niin helmi että on pakko hypettää. Eli itse tätä pelailen, nykyään vähän harvemmin netissä, kun yksikin "matsi" vie niin paljon aikaa. Mutta kiinnostusta olisi lähteä pelailemaan näin cb-yhteisön kesken, kun pääsisi heti "matsin" alussa mukaan ja ajoista voitaisiin sopia, ettei koko päivää putkeen tarvitsisi pelata.

Ozcar · Post by **Ozcar** » Sat Dec 27, 2008 1:50 am

Taatero wrote:Ikävää näin nostella vanhoja asiota, mutta TTD on vaan niin helmi että on pakko hypettää. Eli itse tätä pelailen, nykyään vähän harvemmin netissä, kun yksikin "matsi" vie niin paljon aikaa. Mutta kiinnostusta olisi lähteä pelailemaan näin cb-yhteisön kesken, kun pääsisi heti "matsin" alussa mukaan ja ajoista voitaisiin sopia, ettei koko päivää putkeen tarvitsisi pelata.

Tämä liittyy.. Mihin?

Taatero · Post by **Taatero** » Sat Dec 27, 2008 10:47 am

Ozcar wrote:
Taatero wrote:Ikävää näin nostella vanhoja asiota, mutta TTD on vaan niin helmi että on pakko hypettää. Eli itse tätä pelailen, nykyään vähän harvemmin netissä, kun yksikin "matsi" vie niin paljon aikaa. Mutta kiinnostusta olisi lähteä pelailemaan näin cb-yhteisön kesken, kun pääsisi heti "matsin" alussa mukaan ja ajoista voitaisiin sopia, ettei koko päivää putkeen tarvitsisi pelata.
Tämä liittyy.. Mihin?

Viime sivun offeihin.

Post by **mikeful** » Sat Dec 27, 2008 1:39 pm

Offtopic pois. Kysy peliseuraa yleisen alueen Videopelit-ketjusta.

Jonhu · Post by **Jonhu** » Sun Dec 28, 2008 2:17 pm

Tässä ohjelmassa pääasiana olisi tuo ReadMap()-functio.
Katsoin FPS:än melko alhaiseksi niin päätin piirtää kaiken imageen, joka aiheutti vähäsen sotkua

EDIT: Joudut purkamaan rarin ennen ajoa, muuten ohjelma ei toimi..

Code: Select all

SCREEN 800,600

Const PalikkaSizeX=12
Const PalikkaSizeY=12
Const Viive=80 ' ms

Type PALIKKA
    Field x
    Field y
    Field ID
EndType

aika=Timer()
ReadMap("map.txt")
aika=Timer()-aika

Screen1=MakeImage(800,260)
UpdateImg(Screen1)

Repeat

    DrawToImage Screen1 ' piirretään imageen kaikki kuviot imageen
    If KeyHit(28) And kaynnissa=OFF Then 'entter
        kaynnissa=ON
        For bb.PALIKKA=Each PALIKKA
            If bb\ID>10 Then bb\ID=bb\ID-10
            If bb\ID=2 Then oldID=2 Then bb\ID = 4 Then ColorBox(bb\x,bb\y,bb\id)
        Next bb
        ttime=Timer()
    EndIf
    
    If kaynnissa=ON Then
        For aa.PALIKKA=Each PALIKKA
            If Timer()>=ttime+Viive And aa\ID=4 Then
                If oldID<>3 ' jos ei ole maalissa
                    For bb.PALIKKA=Each PALIKKA
                        If bb\ID>0 And bb\ID<10 Then ' jos ei ole tyhä, eikä ole käytetty ruutu
                            If Distance(aa\x,aa\y,bb\x,bb\y)=1 Then
                                aa\ID = oldID+10 ' lisätään 10, niin merkataan käytetyksi, eikä tarvita uutta muuttujaa
                                ColorBox(aa\x,aa\y,aa\id) ' värjätään vanha paikka vanhan väriseksi
                                oldID = bb\ID 'otetaan vanha ID muistiin
                                bb\ID = 4
                                ColorBox(bb\x,bb\y,bb\id) ' värjätään uusi liikkuva nappulan paikka
                                Exit
                            EndIf
                        EndIf
                    Next bb
                Else ' jos on maalissa
                    aa\ID = 3
                    ColorBox(aa\x,aa\y,aa\id)
                    kaynnissa=OFF
                EndIf
                ttime=Timer()
            EndIf
        Next aa
    EndIf
    DrawToScreen
    
    DrawImage screen1, 0, 0
    
    DrawGame
    
    Color cbwhite
    Text 200,10,"Tiedoston läpikäynti kesti: "+aika+"ms"
    Text 100,10,"FPS: "+FPS()
    Text 500,10,"Liikkeessä = "+kaynnissa
    If kaynnissa=OFF Then Text 100,120,"Paina entter"
    
    DrawScreen
    
Forever

Function ReadMap(file$)
    If Not FileExists(file$) Then MakeError "Didn't find "+file$
    r=OpenToRead(file$)
        While Not EOF(r)
            yn+1
            SLine$=ReadLine(r)
            For a=1 To Len(SLine$)
                merkki$=Mid(SLine$,a,1)
                aa.PALIKKA=New(PALIKKA)
                aa\x=a
                aa\y=yn
                If merkki$="#" 
                    aa\id=1 ' reitti
                ElseIf merkki$="A" 
                    aa\id=2 ' alkupiste
                ElseIf merkki$="M" 
                    aa\id=3 ' loppupiste
                EndIf
            Next a
        Wend
    CloseFile r
EndFunction


Function ColorBox(x1,y1,nro)
    Color cbblack : Box x1*PalikkaSizeX,y1*PalikkaSizeY,PalikkaSizeX,PalikkaSizeY
    If nro<>0 And nro<>10 Then IDcolor(nro) Then Box x1*PalikkaSizeX,y1*PalikkaSizeY,PalikkaSizeX,PalikkaSizeY
EndFunction

Function IDcolor(nro)
    If nro>=10 Then nro-10 
    Select nro
        Case 0 : Color cbblack 
        Case 1 : Color cbwhite
        Case 2 : Color cbgreen
        Case 3 : Color cbblue
        Case 4 : Color cbred
        Default : MakeError "Color "+nro+ " is Not specified!"
    EndSelect 
EndFunction

Function UpdateImg(img)
    DrawToImage img
    For aa.PALIKKA=Each PALIKKA
        ColorBox(aa\x,aa\y,aa\id)
    Next aa
    DrawToScreen
EndFunction

Jonhu · Post by **Jonhu** » Tue Dec 30, 2008 3:02 pm

Tässä muutama piirtokomennoille tehty functio

Kokosin yhteen vähäsen tekemiäni functioita..
Toivottavasti näistä on hyötyä jollekkin.

EDIT: päivitetty.. Lisätty pari uutta functiota ja paranneltu vanhoja

Code: Select all

SCREEN 800,600

// Erillaisia piirto funtioita versio 0.2
// Made by Jonhu 

Repeat
    a+2
    Color cbwhite
    Line2(100,100,a,80)
    Line3(300,200,100,300)
    DotLine1(300,20,400,400)
    DotLine2(100,100,-a,80,6,5,0)
    DrawTringle(500,300,a,100)
    Monikulmio1(700,50,5,100,-a)
    Monikulmio2(600,450,3,200,a,8)
    Monikulmio2(400,470,4,200,45)
    
    tahti1(650,200,a)
    DrawGingerBread2(200,450,10,80,-a) 
    luku#=voimaviiva(500,100,MouseX(),MouseY(),2,150)

    CenterText 500,105, luku#
    Text 10,10,"FPS: "+FPS()
    DrawScreen 
Forever

// Function LINE2
// alkupaikka ( x# & y# )
// kulma ( ang# )
// viivan pituus ( pituus# )
Function Line2(x#,y#,ang#,pituus#)
    Line x#,y#,x# + Sin(ang#)*pituus#,y# - Cos(ang#)*pituus#
EndFunction


// Function LINE3
//
// viiva paikasta ( x1# , y1# ) paikkaan (x2# , y2#)
// Haaroja "pääviivasta", joiden erkanema on ( Ulontuma# ) pikseliä
// Jaetaan ( jakoja ) moneen yhtäsuureen osaan
Function Line3(x1#,y1#,x2#,y2#,Ulontuma#=10,jakoja=10)
    Line x1#,y1#,x2#,y2#
    ang# = -GetAngle(x1#,y1#,x2#,y2#)+90
    jakovali# = Distance(x1#,y1#,x2#,y2#)/jakoja
    For a=0 To jakoja
        xn1# = x1# + Sin( ang# ) * (jakovali# * a) + Sin( ang# - 90 ) * Ulontuma#
        yn1# = y1# - Cos( ang# ) * (jakovali# * a) - Cos( ang# - 90 ) * Ulontuma#
        xn2# = x1# + Sin( ang# ) * (jakovali# * a) + Sin( ang# + 90 ) * Ulontuma#
        yn2# = y1# - Cos( ang# ) * (jakovali# * a) - Cos( ang# + 90 ) * Ulontuma#
        Line xn1#,yn1#,xn2#,yn2#
    Next a
EndFunction

// Function DotLine1
//
// piirtää pisteitä pisteiden (x1#,y1#) ja (x2#,y2#) välille
// pisteiden tiheys on (vali) pikselin välein
// size on pisteen koko
// fill = 1 täyte, fill=0 ei täytettä 
Function DotLine1(x1#,y1#,x2#,y2#,vali=10,size=2,fill=1)
    ang#=GetAngle(x1#,y1#,x2#,y2#)
    For a=0 To Distance(x1#,y1#,x2#,y2#)/vali
        Circle x1#+Cos(ang#)*(a*vali)-size/2,y1#-Sin(ang#)*(a*vali)-size/2,size,fill
    Next a
EndFunction

// Function DotLine2
//
// piirtää pisteviivan pisteestä (x1#,y1#)
// kulmaan (ang#), jonka pituus on ( pituus )
// pisteitä on (vali) pikselin välein
// size on pisteen koko
// fill = 1 täyte, fill=0 ei täytettä 
Function DotLine2(x1#,y1#,ang#,pituus,vali=10,size=2,fill=1)
    For a=0 To pituus/vali
        Circle x1#+Cos(ang#)*(a*vali)-size/2,y1#-Sin(ang#)*(a*vali)-size/2,size,fill
    Next a
EndFunction

// Function DrawTringle
//
// Keskipiste paikassa ( x# , y# )
// Kolmion kulma ( ang# )
// Kolmion sivunpituus ( size# )
Function DrawTringle(x#,y#,ang#,size#) ' size=sivun pituus
    h#= ( size# * Sqrt(3) ) /3 ' lasketaan keskipisteestä matka kärkipisteeseen  
    For a=0 To 2
        If a=2 Then n=0 Else n=a+1
        Line x# + Sin(ang#+a*120)*h#,y# - Cos(ang#+a*120)*h#,x# + Sin(ang#+n*120)*h#,y# - Cos(ang#+n*120)*h#
    Next a
EndFunction

// Function voimaviiva
//
// Osoittaa paikasta ( x1# , y1# ) paikkaan ( x2# , y2# )
// Viivan leveys = ( paksuus )
// viivan maksimi pituus = ( maxpituus )
// functio palauttaa viivan pituuden arvon
Function voimaviiva(x1#,y1#,x2#,y2#,paksuus,maxpituus)
    pituus# = Distance(x1#,y1#,x2#,y2#)           // mittaa etäisyyden
    angle#  = -GetAngle(x1#,y1#,x2#,y2#)+90       // mittaa kulman
    If pituus#>maxpituus Then pituus#=maxpituus   // rajoittaa viivan pituuden
    g=180        
    For a=1 To RoundUp(pituus#)
        Color r,g,0     
        xn2# = x1# + Sin(angle#)*(a) 
        yn2# = y1# - Cos(angle#)*(a)
        Circle xn2#-paksuus/2,yn2#-paksuus/2,paksuus  // 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  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

// Function tahti1 
//
// Kuvion keskikohta ( x , y )
// kuvion kallistuma ( kulma )
// kuvion koko ( koko )
// viivojen väli ( vali )
Function tahti1(x,y,kulma=0,koko=200,vali=8)
    For a=0 To (koko/2) / vali
        pit1#=(koko/2) - (a*vali)
        pit2#=a*vali
        Line x + Sin(kulma+90) * pit1#, y - Cos(kulma+90) * pit1#, x + Sin(kulma) * pit2#, y - Cos(kulma) * pit2#
        Line x + Sin(kulma+90) * pit1#, y - Cos(kulma+90) * pit1#, x + Sin(kulma+180) * pit2#, y - Cos(kulma+180) * pit2#
        Line x + Sin(kulma-90) * pit1#, y - Cos(kulma-90) * pit1#, x + Sin(kulma+180) * pit2#, y - Cos(kulma+180) * pit2#
        Line x + Sin(kulma-90) * pit1#, y - Cos(kulma-90) * pit1#, x + Sin(kulma) * pit2#, y - Cos(kulma) * pit2#
    Next a
EndFunction


// Function Monikulmio1
//
// piirtää kuvion jossa on (kulmia) monta kulmaa
// Keskipiste paikassa (x1#,y1#)
// Etäisyys nurkkaan (koko)
// kuvion kulma (angle#)
Function Monikulmio1(x1#,y1#,kulmia,koko=100,angle#=0)
    For a=0 To kulmia
        If a=kulmia Then n=0 Else n=a+1
        Line x1# + Cos(a * 360 / (kulmia) + angle#) * (koko/2), y1# - Sin(a * 360 / (kulmia) + angle#) * (koko/2), x1# + Cos(n * 360 / (kulmia) + angle#) * (koko/2), y1# - Sin(n * 360 / (kulmia) + angle#) * (koko/2)
    Next a
EndFunction


// Function Monikulmio2
//
// Piirtää hienon kuvion jossa on (kulmia) 
// Keskipiste paikassa (x1#,y1#)
// Etäisyys nurkkaan (koko)
// kuvion kulma (angle#)
// Viivojen tiheys (vali)
Function Monikulmio2(x1#,y1#,kulmia=5,koko=100,angle#=10,vali=8)
    For a=0 To kulmia
        If a=kulmia Then n=0 Else n=a+1
        If a>=kulmia-1 Then h=a-kulmia+2 Else h=a+2
        Kaari2(x1# + Cos(a * 360 / (kulmia) + angle#) * (koko/2) ,y1# - Sin(a * 360 / (kulmia) + angle#) * (koko/2),x1# + Cos(n * 360 / (kulmia) + angle#) * (koko/2) ,y1# - Sin(n * 360 / (kulmia) + angle#) * (koko/2),x1# + Cos(h * 360 / (kulmia) + angle#) * (koko/2) ,y1# - Sin(h * 360 / (kulmia) + angle#) * (koko/2),vali)
    Next a
EndFunction

// Function Kaari2
//
// piirtää kahden janan väliin viivoja (vali) pikselin välein
// viiva1 (x1#,y1#,x2#,y2#)
// viiva2 (x2#,y2#,x3#,y3#)
// HUOM. Function Kuvio tarvitsee tätä functiota toimiakseen
Function Kaari2(x1#,y1#,x2#,y2#,x3#,y3#,vali)
    ang1#=GetAngle(x1#,y1#,x2#,y2#)
    ang2#=GetAngle(x2#,y2#,x3#,y3#)
    For a=0 To Distance(x1#,y1#,x2#,y2#)/vali
        Line x1#+Cos(ang1#)*(vali*a), y1#-Sin(ang1#)*(vali*a), x2#+Cos(ang2#)*(vali*a), y2#-Sin(ang2#)*(vali*a)
    Next a
EndFunction


// Function DrawGingerBread2
//
// Piirretään vasen yläkulma paikkaan ( x# , y# )
// sakaroita on ( sakaroita ) verran [HUOM. ei toimi kaikilla määrillä]
// Kuvion koko ( koko )
// kuvion kulma ( angle# )
Function DrawGingerBread2(x#,y#,sakaroita=10,koko=80,angle#=0)
    vali#=360/sakaroita
    dist#=koko*Sin(vali/2)
    For a=0 To sakaroita-1
        kaari(x# + Sin(vali#*a+angle#) * koko,y# - Cos(vali#*a+angle#) * koko,RoundUp(dist#),-GetAngle(x# + Sin(vali#*a+angle#) * koko,y# - Cos(vali#*a+angle#) * koko,x#,y#)+180)
    Next a
EndFunction

// Function kaari
//
// aloittaa kaaren paikasta ( x# , y# )
// kaaren koko ( koko )
// kaaren kulma ( kulma )
// HUOM1. PIIRTÄÄ AINA PUOLIYMPYRÄN
// HUOM2. Function DrawGingerBread tarvitsee tätä functiota toimiakseen.
Function kaari(x#,y#,koko,kulma)
    For n=0 To 180
        Dot x# + Sin(n+kulma) * koko , y# - Cos(n+kulma) * koko
    Next n
EndFunction

Jani · Post by **Jani** » Tue Dec 30, 2008 3:06 pm

Hienoa työtä, Johnu.

-Z- · Post by **-Z-** » Tue Dec 30, 2008 3:13 pm

Jonhu wrote:Tässä muutama piirtokomennoille tehty functio

Kokosin yhteen vähäsen tekemiäni functioita..
Toivottavasti näistä on hyötyä jollekkin.

Code: Select all

SCREEN 800,600

// Erillaisia piirto funtioita versio 0.1
// Made by Jonhu 

Dim piste(2,1) ' taulukko DrawTringle()-function pisteille
Dim Piste2(11,1) ' taulukko DrawGingerBread()-function pisteille

Repeat
    a+2
    Color cbwhite
    Line2(100,100,a,80)
    Line3(300,200,100,300)
    DotLine1(300,20,400,400)
    DotLine2(100,100,-a,80,6,5,0)
    DrawTringle(500,300,a,100)
    nelio(550,350)
    tahti1(650,200,a)
    DrawGingerBread(200,450) 
    luku#=voimaviiva(500,100,MouseX(),MouseY(),2,150)
    
    
    CenterText 500,105, luku#
    Text 10,10,"FPS: "+FPS()
    DrawScreen
Forever

// Function LINE2
// alkupaikka ( x# & y# )
// kulma ( ang# )
// viivan pituus ( pituus# )
Function Line2(x#,y#,ang#,pituus#)
    Line x#,y#,x# + Sin(ang#)*pituus#,y# - Cos(ang#)*pituus#
EndFunction


// Function LINE3
//
// viiva paikasta ( x1# , y1# ) paikkaan (x2# , y2#)
// Haaroja "pääviivasta", joiden erkanema on ( Ulontuma# ) pikseliä
// Jaetaan ( jakoja ) moneen yhtäsuureen osaan
Function Line3(x1#,y1#,x2#,y2#,Ulontuma#=10,jakoja=10)
    Line x1#,y1#,x2#,y2#
    ang# = -GetAngle(x1#,y1#,x2#,y2#)+90
    jakovali# = Distance(x1#,y1#,x2#,y2#)/jakoja
    For a=0 To jakoja
        xn1# = x1# + Sin( ang# ) * (jakovali# * a) + Sin( ang# - 90 ) * Ulontuma#
        yn1# = y1# - Cos( ang# ) * (jakovali# * a) - Cos( ang# - 90 ) * Ulontuma#
        xn2# = x1# + Sin( ang# ) * (jakovali# * a) + Sin( ang# + 90 ) * Ulontuma#
        yn2# = y1# - Cos( ang# ) * (jakovali# * a) - Cos( ang# + 90 ) * Ulontuma#
        Line xn1#,yn1#,xn2#,yn2#
    Next a
EndFunction

// Function DotLine1
//
// piirtää pisteitä pisteiden (x1#,y1#) ja (x2#,y2#) välille
// pisteiden tiheys on (vali) pikselin välein
// size on pisteen koko
// fill = 1 täyte, fill=0 ei täytettä 
Function DotLine1(x1#,y1#,x2#,y2#,vali=10,size=2,fill=1)
    ang#=GetAngle(x1#,y1#,x2#,y2#)
    For a=0 To Distance(x1#,y1#,x2#,y2#)/vali
        Circle x1#+Cos(ang#)*(a*vali)-size/2,y1#-Sin(ang#)*(a*vali)-size/2,size,fill
    Next a
EndFunction

// Function DotLine2
//
// piirtää pisteviivan pisteestä (x1#,y1#)
// kulmaan (ang#), jonka pituus on ( pituus )
// pisteitä on (vali) pikselin välein
// size on pisteen koko
// fill = 1 täyte, fill=0 ei täytettä 
Function DotLine2(x1#,y1#,ang#,pituus,vali=10,size=2,fill=1)
    For a=0 To pituus/vali
        Circle x1#+Cos(ang#)*(a*vali)-size/2,y1#-Sin(ang#)*(a*vali)-size/2,size,fill
    Next a
EndFunction

// Function DrawTringle
//
// Keskipiste paikassa ( x# , y# )
// Kolmion kulma ( ang# )
// Kolmion sivunpituus ( size# )
Function DrawTringle(x#,y#,ang#,size#) ' size=sivun pituus
    h#=( ( size# * Sqrt(3) ) / 2 ) / 3 * 2 ' lasketaan keskipisteestä matka kärkipisteeseen  
    For a=0 To 2
        Piste(a,0) = x# + Sin(ang#+a*120)*h#
        Piste(a,1) = y# - Cos(ang#+a*120)*h#
    Next a
    For a=0 To 2
        If a=2 Then n=0 Else n=a+1
        Line piste(a,0),piste(a,1),piste(n,0),piste(n,1)
    Next a
EndFunction

// Function voimaviiva
//
// Osoittaa paikasta ( x1# , y1# ) paikkaan ( x2# , y2# )
// Viivan leveys = ( paksuus )
// viivan maksimi pituus = ( maxpituus )
// functio palauttaa viivan pituuden arvon
Function voimaviiva(x1#,y1#,x2#,y2#,paksuus,maxpituus)
    pituus# = Distance(x1#,y1#,x2#,y2#)           // mittaa etäisyyden
    angle#  = -GetAngle(x1#,y1#,x2#,y2#)+90       // mittaa kulman
    If pituus#>maxpituus Then pituus#=maxpituus   // rajoittaa viivan pituuden
    g=180        
    For a=1 To RoundUp(pituus#)
        Color r,g,0     
        xn2# = x1# + Sin(angle#)*(a) 
        yn2# = y1# - Cos(angle#)*(a)
        Circle xn2#-paksuus/2,yn2#-paksuus/2,paksuus  // 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  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

// Function tahti1 
//
// Kuvion keskikohta ( x , y )
// kuvion kallistuma ( kulma )
// kuvion koko ( koko )
// viivojen väli ( vali )
Function tahti1(x,y,kulma=0,koko=200,vali=8)
    For a=0 To (koko/2) / vali
        pit1#=(koko/2) - (a*vali)
        pit2#=a*vali
        Line x + Sin(kulma+90) * pit1#, y - Cos(kulma+90) * pit1#, x + Sin(kulma) * pit2#, y - Cos(kulma) * pit2#
        Line x + Sin(kulma+90) * pit1#, y - Cos(kulma+90) * pit1#, x + Sin(kulma+180) * pit2#, y - Cos(kulma+180) * pit2#
        Line x + Sin(kulma-90) * pit1#, y - Cos(kulma-90) * pit1#, x + Sin(kulma+180) * pit2#, y - Cos(kulma+180) * pit2#
        Line x + Sin(kulma-90) * pit1#, y - Cos(kulma-90) * pit1#, x + Sin(kulma) * pit2#, y - Cos(kulma) * pit2#
    Next a
EndFunction

// Function nelio 
//
// Neliön vasemman ylänurkan sijainti ( xx , yy )
// vali on kuinka tiheään tulee viivoja 
// HUOM. Tämä on hyvin vanha functio ja alottelijamaisesti tehty! Mutta hienon näköinen, niin lisäsin sen tähän xD
Function nelio(xx,yy,koko=200,vali=8) 
    viivoja=koko/vali
    For x=0 To viivoja
        Line xx+1,yy+x*vali,xx+x*vali,yy+koko
        Line xx+koko-1-x*vali,yy+koko,xx+koko-1,yy+x*vali
        Line xx+x*vali,1+yy,xx+koko-1,yy+x*vali
        Line xx+1,yy+koko-x*vali,xx+x*vali,1+yy
    Next x
EndFunction

// Function DrawGingerBread
//
// Piirretään vasen yläkulma paikkaan ( x# , y# )
// sakaroita on ( sakaroita ) verran [HUOM. ei toimi kaikilla määrillä]
// Kuvion koko ( koko )
// kuvion kulma ( angle# )
Function DrawGingerBread(x#,y#,sakaroita=10,koko=80,angle#=0)

    vali#=360/sakaroita
    For a=0 To sakaroita-1
        piste2(a,0) = x# + Sin(vali#*a+angle#) * koko
        piste2(a,1) = y# - Cos(vali#*a+angle#) * koko
    Next a
    
    dist#=Distance(piste2(0,0),piste2(0,1),piste2(1,0),piste2(1,1))/2
    For a=0 To sakaroita-1
        kaari(piste2(a,0),piste2(a,1),RoundUp(dist#),-GetAngle(piste2(a,0),piste2(a,1),x#,y#)+180)
    Next a
    
EndFunction

// Function kaari
//
// aloittaa kaaren paikasta ( x# , y# )
// kaaren koko ( koko )
// kaaren kulma ( kulma )
// HUOM1. PIIRTÄÄ AINA PUOLIYMPYRÄN
// HUOM2. Function DrawGingerBread tarvitsee tätä functiota toimiakseen.
Function kaari(x#,y#,koko,kulma)
    For n=0 To 180
        Dot x# + Sin(n+kulma) * koko , y# - Cos(n+kulma) * koko
    Next n
EndFunction

Ihan khyyl, ainakin olet oppinut Sinin ja Cosinin käytön. Kuviot olivat perussettiä ja helppoja ohjelmoida, mutta suht nättejähän ne.

Jonhu · Post by **Jonhu** » Wed Dec 31, 2008 3:08 pm

No kun olen tässä alkanut päästä vauhtiin tässä sininin ja cosinin pyörittelyssä, niin tein muutaman function lisää..
(Selosteita en tälläkertaa jaksanut tehdä.. Muuttujien nimet paljastavat jo tarpeeksi tietoa

)

EDIT: Lisäsin nämä tuohon aijempaan functiopakettiin

Siinä on myös jonkinlaiset selostukset raaputeltu näille functioille. Lisäksi muokkasin vähäsen vanhoja functioita siinä paketissa.

Code: Select all

SCREEN 800,600

Repeat
    a#+1.0
    Monikulmio1(700,100,8,80,-a#)
    Kuvio(400,300,5,600,a#)
    Kuvio(400,300,3,400,a#)
    Kuvio(400,300,3,400,a#+60)
    Text 10,10,"FPS: "+FPS()
    DrawScreen
Forever


Function Monikulmio1(x1#,y1#,kulmia,koko=100,angle#=0)
    For a=0 To kulmia
        If a=kulmia Then n=0 Else n=a+1
        Line x1# + Cos(a * 360 / (kulmia) + angle#) * (koko/2), y1# - Sin(a * 360 / (kulmia) + angle#) * (koko/2), x1# + Cos(n * 360 / (kulmia) + angle#) * (koko/2), y1# - Sin(n * 360 / (kulmia) + angle#) * (koko/2)
    Next a
EndFunction

Function Kuvio(x1#,y1#,kulmia=5,koko=100,angle#=10,vali=8)
    For a=0 To kulmia
        If a=kulmia Then n=0 Else n=a+1
        If a>=kulmia-1 Then h=a-kulmia+2 Else h=a+2
        Kaari2(x1# + Cos(a * 360 / (kulmia) + angle#) * (koko/2) ,y1# - Sin(a * 360 / (kulmia) + angle#) * (koko/2),x1# + Cos(n * 360 / (kulmia) + angle#) * (koko/2) ,y1# - Sin(n * 360 / (kulmia) + angle#) * (koko/2),x1# + Cos(h * 360 / (kulmia) + angle#) * (koko/2) ,y1# - Sin(h * 360 / (kulmia) + angle#) * (koko/2),vali)
    Next a
EndFunction

Function Kaari2(x1#,y1#,x2#,y2#,x3#,y3#,vali)
    ang1#=GetAngle(x1#,y1#,x2#,y2#)
    ang2#=GetAngle(x2#,y2#,x3#,y3#)
    For a=0 To Distance(x1#,y1#,x2#,y2#)/vali
        Line x1#+Cos(ang1#)*(vali*a), y1#-Sin(ang1#)*(vali*a), x2#+Cos(ang2#)*(vali*a), y2#-Sin(ang2#)*(vali*a)
    Next a
EndFunction

MaGetzUb · Post by **MaGetzUb** » Thu Jan 01, 2009 8:29 pm

Ihan jees, hyvää työtä Jonhu. Kuviot oli hianoja tossa ekassa..Edit: Ja noissa muissa

Jonhu · Post by **Jonhu** » Mon Jan 05, 2009 12:21 pm

Tässä nyt vielä pari uutta

Taidan kohta siirtyä seuraavaan aiheeseen

Code: Select all

SCREEN 800,600

Repeat
    a+1
    Kuvioita1(400,300,1,5,600,20,10)
    Kuvioita1(100,100,2,5,100,-a,6)
    Kuvioita1(700,100,3,3,200,a,12)
    Text 10,10,"fps: "+FPS()
    DrawScreen
Forever

// Function Kuvioita1
//
// Kuvion keskikohta ( x1# , y1# )
// kuvion muoto = tyyppi
// tyyppi=1 piirtää hienon tähden tyyppisen virityksen
// tyyppi=2 piirtää eri tyyppisen tähden
// tyyppi=3 piirtää monikulmion jossa on täytteenä pienempiä monikulmioita
// sakaroita = kuinka monta sakaraa/kulmaa kuviossa on
// kuvion kallistuma ( kulma# )
// kuvion koko ( koko# )
// viivojen väli ( vali )
Function Kuvioita1(x1#,y1#,tyyppi,sakaroita,koko#,kulma#=0,vali#=8)
    koko#=koko#/2
    For a=0 To sakaroita
        If a=sakaroita Then n=0 Else n=a+1
        Line5(x1#,y1#,x1# + Cos(a * 360 / sakaroita + kulma#) * koko#,y1# - Sin(a * 360 / sakaroita + kulma#) * koko#,x1# + Cos(n * 360 / sakaroita + kulma#) * koko#,y1# - Sin(n * 360 / sakaroita + kulma#) * koko#,vali#,tyyppi)
    Next a
EndFunction

Function Line5(kx#,ky#,x2#,y2#,x3#,y3#,vali#,typ)
    ang1#=GetAngle(kx#,ky#,x2#,y2#)
    ang2#=GetAngle(kx#,ky#,x3#,y3#)
    For a=0 To (Distance(kx#,ky#,x2#,y2#)/vali#)
        Select typ
            Case 1: Line x2#-Cos(ang1#)*(vali#*a), y2#+Sin(ang1#)*(vali#*a) , kx#+Cos(ang2#)*(vali#*a), ky#-Sin(ang2#)*(vali#*a)
            Case 2: Line x2#+Cos(ang1#)*(vali#*a), y2#-Sin(ang1#)*(vali#*a) , kx#+Cos(ang2#)*(vali#*a), ky#-Sin(ang2#)*(vali#*a)
            Case 3: Line kx#+Cos(ang1#)*(vali#*a), ky#-Sin(ang1#)*(vali#*a) , kx#+Cos(ang2#)*(vali#*a), ky#-Sin(ang2#)*(vali#*a)
            Default: MakeError "Tyyppin "+typ+ " toimintoa ei ole määritelty functiossa line5()"
        EndSelect
    Next a
EndFunction

Aloittelija CB käytössä · Wed Jan 07, 2009 12:44 am

Olen käyttänyt coolbasicia nyt 5 minuuttia joten ette varmaan ihmettele miksi en osaa

. The Duckin tulipallo jutskasta, (anteeksi että käytin sitä

) yritin säätää jonkun jutun että ukkoa liikutetaan ja kun tulipallo osuu ukkoon ukko kuolee. Yritykseni tyssäsi jo liikumis vaiheeseen, VOisitteko ystävällisesti opastaa ja näyttää CB voimat!

Code: Select all

FrameLimit 60

kartta = LoadMap("Media\cdm2.til","Media\tileset.bmp")
PlayObject kartta,0,0,1

tulipallo = LoadObject ("Media\fireball.bmp",72)
ukko=LoadObject("Media\soldier.bmp",72)

 If LeftKey() Then TurnObject ukko,5
    If RightKey() Then TurnObject ukko,-5
    If UpKey() Then MoveObject ukko,2
    If DownKey() Then MoveObject ukko,-2  
    

SetupCollision tulipallo, kartta, 1, 4, 2
TurnObject tulipallo,Rand(0,360)

palloplusx#=Cos(ObjectAngle(tulipallo))*6
palloplusy#=Sin(ObjectAngle(tulipallo))*6


Repeat

TranslateObject tulipallo,palloplusx#,palloplusy#
TurnObject tulipallo,40

        If CountCollisions(tulipallo) Then
            angle=CollisionAngle(tulipallo,1)
            If angle=0 Or angle=180 Then
                palloplusx#= -palloplusx#
            EndIf
            If angle=90 Or angle=270 Then
                palloplusy#= -palloplusy#
            EndIf
            TranslateObject tulipallo,palloplusx#,palloplusy#
        EndIf

    UpdateGame


    DrawScreen

Forever

Jani · Post by **Jani** » Wed Jan 07, 2009 7:40 am

Yritin jonkinlaista skripti hommelia tehä, mutta ei siitä mitään tullu.

Laitan silti tänne jos siitä on hyötyä jollekkin.

Tee CoolBasicin kansioon joku.txt

Code: Select all

^^**joku.txt**
txt=terve! #up ^^ Tekstit (kommentti)
txt=Parsittu tiedostosta joku.txt #!!
txt=PIENENNYS #DOWN
TXT=ja isonnus onnistuu :p #UP #!!
#!!
txt=Tarkista joku2.txt

:savefile: joku2.txt ^^ tiedosto

:savetxt: //Parseri :) ^^ kirjoita "Parseri :)"

__Write_save_
__write_cb_save_

:savetxt: //kirjoitus toiseen tiedostoon

__Write_save_
__write_cb_save_

:savetxt: //savetxt ja __Write_save_

__Write_save_
__write_cb_save_

kopioi tu ylläoleva koodi joku.txt tiedostoon.

suorita seuraava ohjelma CoolBasucussa.

Code: Select all

Type T
    Field txt   As String
EndType

Parse("joku.txt")

Print_Parse()
Del_Parse()

DrawScreen

WaitKey

Function Parse(file$)

    f=OpenToRead(file)

        While Not EOF(f)
    
            l$=ReadLine(f)
            ln$=Upper(l)
            
            For i = 1 To Len(l)
                If Mid(l, i, 2) = "^^" Then l = StrRemove(l, i, Len(l)-i+1) : Exit
            Next i
        
            If InStr(ln,"TXT=") Then
                If InStr(ln,"#DOWN") Then
                    tx.T=New(T)
                        tx\txt=Lower(Mid(l,InStr(l,"=")+1,InStr(ln,"#DOWN")-(InStr(ln,"=")+1)))
                ElseIf InStr(ln,"#UP") Then
                    tx.T=New(T)
                        tx\txt=Upper(Mid(l,InStr(l,"=")+1,InStr(ln,"#UP")-(InStr(ln,"=")+1)))
                Else
                    tx.T=New(T)
                        tx\txt=Mid(l,InStr(l,"=")+1)
                        If InStr(tx\txt,"#!!") Then
                            tx\txt=StrRemove(tx\txt,Len(tx\txt)-4,4)
                        EndIf
                EndIf
            EndIf
            
            If InStr(ln,"#!!")
                tx.T=New(T)
                    tx\txt=""
            EndIf
            
            If InStr(ln,":SAVEFILE:")
                If InStr(ln,":SAVETXT:")=0 And InStr(ln,"__WRITE_SAVE_")=0
                    fil$=Mid(l,Len(":SAVEFILE:")+2)
                EndIf
            EndIf
            
            If InStr(ln,":SAVETXT:")
                If InStr(ln,":SAVEFILE:")=0 And InStr(ln,"__WRITE_SAVE__")=0
                    tex$=Mid(l,Len(":SAVETXT:")+2)
                EndIf
            EndIf
            
            If InStr(ln,"__WRITE_SAVE_")
                If InStr(ln,":SAVETXT:")=0 And InStr(ln,":SAVEFILE:")=0 Then
                    filary=OpenToEdit(fil$)
                        While Not EOF(filary)
                            turha=ReadLine(filary)
                        Wend
                        WriteLine filary,tex$
                    CloseFile filary
                EndIf
            EndIf
            
            If InStr(ln,"__WRITE_CB_SAVE")
                If InStr(ln,":SAVETXT:")=0 And InStr(ln,":SAVEFILE:")=0 Then
                    filary=OpenToEdit(fil)
                        While Not EOF(filary)
                            turha=ReadLine(filary)
                        Wend
                        WriteLine filary,"Print "+Chr(34)+tex+Chr(34)
                    CloseFile filary
                EndIf
            EndIf
        
        Wend
        
    CloseFile f
    
EndFunction

Function Print_Parse()
    
    For tx.T=Each T
        AddText tx\txt
    Next tx
    
EndFunction

Function Del_Parse()

    For tx.T=Each T
        Delete tx
    Next tx
    
EndFunction

Nyt katso CoolBasicin kansiosta filu joku2.txt

EDIT: joku2.txt tiedoston voi suorittaa näiden jälkeen coolbasicissa ihan vain näin:

Code: Select all

Include "joku2.txt"

WaitKey

Sly_Jack0 · Post by **Sly_Jack0** » Thu Jan 08, 2009 5:08 pm

Teinpä tälläisen tekstipainike funktion, joita varmaan löytyy tuhottomasti muitakin, mutta kun tuli tämä tehtyä yhteen projektiin, niin ajattelin sen tännekin nyt laittaa. En ole valitettavasti kommentoinut koodia, mikä johtuu pelkästään laiskuudesta, mutta koittakaa saada selvää. Funktio palauttaa joko 0, 1 tai 2. 1 jos hiiri on sen päällä, 2 jos sitä klikataan ja muuten 0.

Parametrit:

x = x-sijainti
y = y-sijainti
(ruutukoordinaateissa)

teksti = Teksti mikä näkyy napissa.
tekstiVäri = Tekstin väri. Esim. punainen = "255,0,0"

pohjaVäri = Painikkeen väri.

margin = Marginaalien koko. Esim. jos haluat 5 pikselin marginaalit joka puolelle laitat 5.

Code: Select all

Function TekstiPainike(x,y,teksti As String,tekstiVäri As String,pohjaVäri As String,margin)

	width = TextWidth(teksti) + margin*2
	height = TextHeight(teksti) + margin*2
	
	tempR = Int(GetWord(pohjaVäri,1,","))
	tempG = Int(GetWord(pohjaVäri,2,","))
	tempB = Int(GetWord(pohjaVäri,3,","))
	
	If MouseX() > x And MouseX() < x + width And MouseY() > y And MouseY() < y + height Then
		hover = True
		
		tempR = tempR + 100
		tempG = tempG + 100
		tempB = tempB + 100
		
		If tempR > 255 Then tempR = 255
		If tempG > 255 Then tempG = 255
		If tempB > 255 Then tempB = 255
	Else
		hover = False
	EndIf
	
	Color tempR,tempG,tempB
	Box x,y,width,height
	
	tempR = Int(GetWord(tekstiVäri,1,","))
	tempG = Int(GetWord(tekstiVäri,2,","))
	tempB = Int(GetWord(tekstiVäri,3,","))
	
	Color tempR,tempG,tempB
	Text x + margin,y + margin,teksti
	
	If hover = True And MouseHit(1) Then
		Return 2
	ElseIf hover = True
		Return 1
	Else
		Return 0
	EndIf
	
EndFunction

Ja vielä esimerkki:

Code: Select all

Repeat

	aloita = TekstiPainike(10,10,"Aloita","255,255,255","180,0,60",5)
	lopeta = TekstiPainike(10,40,"Lopeta","0,255,0","0,0,255",10)
	
	If aloita = 2 Then MakeError "Aloitit"
	If lopeta = 2 Then End
	
	DrawScreen
	
Forever

Jani · Post by **Jani** » Thu Jan 08, 2009 6:53 pm

Tein jonkinlaisen ûber salauksen.
Parantelin siis Encrypt ja Decrypt komentoja Encrypt2() ja Decrypt2() funktioilla.

Ja tässä on linkki

Eipä tästä varsinaisesti hyötyä ole kuin jos tarvitsee tehosalausta.

Post by **valscion** » Thu Jan 08, 2009 6:59 pm

Sly_Jack0 wrote:Teinpä tälläisen tekstipainike funktion, joita varmaan löytyy tuhottomasti muitakin, mutta kun tuli tämä tehtyä yhteen projektiin, niin ajattelin sen tännekin nyt laittaa. En ole valitettavasti kommentoinut koodia, mikä johtuu pelkästään laiskuudesta, mutta koittakaa saada selvää. Funktio palauttaa joko 0, 1 tai 2. 1 jos hiiri on sen päällä, 2 jos sitä klikataan ja muuten 0.

Pakko vähän kommentoida

. Ensinnäkin, miksi funktioon laitetaan väri String:nä? Vaikka parametreja tulisikin kamalasti tuohon funktion määritykseen, niin olisi se kyllä mielestäni silti selkeämpi laittaa siihen r, g ja b parametrit erikseen. Toiseksi, tuon Returnin määrittämiseen käytät turhaan If-lausetta. Senkus heität "Return hover + MouseHit(1)" niin toimii ihan samalla tavalla, nopeammin tosin

Sly_Jack0 · Post by **Sly_Jack0** » Thu Jan 08, 2009 10:05 pm

OonSuomesta wrote:
Sly_Jack0 wrote:Teinpä tälläisen tekstipainike funktion, joita varmaan löytyy tuhottomasti muitakin, mutta kun tuli tämä tehtyä yhteen projektiin, niin ajattelin sen tännekin nyt laittaa. En ole valitettavasti kommentoinut koodia, mikä johtuu pelkästään laiskuudesta, mutta koittakaa saada selvää. Funktio palauttaa joko 0, 1 tai 2. 1 jos hiiri on sen päällä, 2 jos sitä klikataan ja muuten 0.
Pakko vähän kommentoida . Ensinnäkin, miksi funktioon laitetaan väri String:nä? Vaikka parametreja tulisikin kamalasti tuohon funktion määritykseen, niin olisi se kyllä mielestäni silti selkeämpi laittaa siihen r, g ja b parametrit erikseen. Toiseksi, tuon Returnin määrittämiseen käytät turhaan If-lausetta. Senkus heität "Return hover + MouseHit(1)" niin toimii ihan samalla tavalla, nopeammin tosin

Mielestäni tuo värin antaminen merkkijonona on ihan mukava tapa juuri sen takia että parametrit vähentyy. Ja tuosta Return-jutusta: Hyvä huomio! Eihän sitä nyt voi mitään tollasta älytä kun on himo koodaus menossa.

Jani · Post by **Jani** » Sat Jan 10, 2009 8:15 pm

Enpä tiedä mutta ehkä tänne sopisi Write2() funktio? <-- linkki

Esimerkki:

Code: Select all

Write2("Taas on uusi funktio saapunut funktiolasta.",100,1)
Write2("(hehe, hyvä alku)",100,1)
Write2("Se funktio on",100,0) : Write2("...",400,0) : Write2(" Se on...",400,0) : Write2(" Write2()",100,1)

WaitKey


Function Write2(txt$,wai,nextl)
    For i=1 To Len(txt)
        Write Mid(txt,i,1) : Wait wai
    Next i
    If nextl Then Print
EndFunction

EDIT: niin ja linkki BoldText() (<-- linkki) funktioon

DatsuniG · Post by **DatsuniG** » Sun Jan 11, 2009 10:13 am

Plagiointi on kivaa.

Jani · Post by **Jani** » Tue Jan 13, 2009 4:15 pm

Uppista, sori DG.

Mutta oli tylsää ja tein tämmösen PasswordGenerator funktion.
Funktio on alkeellinen, mutta kivan tehkokkaita salasanoja se tekee

.

Tein pientä testiä:

Code: Select all

Tunnus: Jani | Salasana: q4530=4530T3020(1510y3020g4530p4530+3020h4530B4530
Tunnus: Jani | Salasana: c3020.453021510I4530M3020d4530:1510o3020K4530v4530
Tunnus: Jani | Salasana: l4530o4530;4530)4530U4530d1510n3020s45300302003020
Tunnus: Jani | Salasana: j151003020D3020C453013020c151063020K4530W1510f1510
Tunnus: Jani | Salasana: i4530;453011510w1510Z1510y3020n4530;4530W302034530
Tunnus: Jani | Salasana: /1510@4530^3020I3020w4530D3020U3020F4530H3020n4530
Tunnus: Jani | Salasana: s0]0P0i0U0J0O0_0v0s0
Tunnus: Jani | Salasana: 60E0:030-0O0&0`0a0+0

Eli tuommoista jälkeä se tekee

Koodi ja esimerkki:

Code: Select all

SCREEN 500,300

pass$=PasswordGenerator("Esimerkki","",10,0,255,10,"D:\PG.txt") // vaihdappa tuo "ES" vaikka "CB" tai "C" tai miksi vain.

Print pass

WaitKey

Function PasswordGenerator(username$,startpassword$="",passlength=10,_min=0,_max=255,down=10,savefile$="D:\PG.txt")
    For i=1 To Len(startpassword)
        _password=_password+Asc(Mid(startpassword,i,1))/down
    Next i
    For i=1 To passlength
        password$=password+Chr(Rand(_min,_max))
        If _password>0 Then password=password+_password*Rand(1,3)
    Next i
    f=OpenToEdit(savefile)
        SeekFile f,FileSize(savefile)
        WriteLine f,"Tunnus: "+username+" | Salasana: "+password
    CloseFile f
    Return username+" - "+password$
EndFunction

tein parametreistä toimivia niille, jotka ymmärtävät englantia.

EDIT: noniin. nyt ovat kaikki merkit käytössä ja rivejä lyhennetty.

EDIT2: Salasanojen pituutta voi määrittää passlength muuttujasta.

EDIT3: Lisäsin kirjain muuttujat _min ja _max. Esim. _min on 0 ja _max on 255 niin kirjaimen ASCII-koodi on väliltä 0-255

CoolBasic Forums

Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.

Re: Esimerkkejä aloittelijoille.