The Matrix CodeFall

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
atomimalli
Moderator
Moderator
Posts: 227
Joined: Wed Aug 29, 2007 3:55 pm

Re: The Matrix CodeFall

Post by atomimalli »

Njaa, eipä tuo rivimäärä aina totuutta kerro, mutta ilmenipä nyt tarve tuoda esiin toinenkin ääripää. Taidan vielä lisätä nätimmän merkistön valikoinnin, jos jaksan ne merkit siihen valita. En efekteissä kovasti pidä koodin ulkopuolisesta sälästä :P

Ps. Olisi tuossa jatella joku systeemi olla ettei tarvisi copypasteta samaa riviä joka merkille

Edit:
Lisäsimpä vielä lapsellisesti zHelmetinkin kikkailun tähän samaan tuon merkistön lomassa. Eipä oikein sitä kuitenkaan tullut hiottua :S

Code: Select all

For i=i To i+1
  If i Mod (40*30) = 40*30-1 Then SetWindow "Fps: "+FPS() Else Color 200-Max(0,Min(200,Abs((((-(i Mod (40*30))/30.0/40-(Sin(i Mod 40*7)*Sin(i Mod 40*13)*Sin(i Mod 40*5)*8+3)^2+Timer()/1500.0)Mod 3) )*(1500-1200*((i Mod 40)>15)*((i Mod 40)<26)*(RoundDown(i Mod (30*40)/30)=16)))))+200*KeyDown(cbkeyspace),255-Max(0,Min(255,Abs((((-(i Mod (40*30))/30.0/40-(Sin(i Mod 40*7)*Sin(i Mod 40*13)*Sin(i Mod 40*5)*8+3)^2+Timer()/1500.0)Mod 3) )*(800-700*((i Mod 40)>15)*((i Mod 40)<26)*(RoundDown(i Mod (30*40)/30)=16))))),200-Max(0,Min(200,Abs((((-(i Mod (40*30))/30.0/40-(Sin(i Mod 40*7)*Sin(i Mod 40*13)*Sin(i Mod 40*5)*8+3)^2+Timer()/1500.0)Mod 3) )*(1500-1200*((i Mod 40)>15)*((i Mod 40)<26)*(RoundDown(i Mod (30*40)/30)=16)))))
  If i Mod (40*30) = 40*30-1 Then DrawScreen Else Text i Mod 40*10,(i Mod (40*30))/40*10,Left(Mid("The Matrix",(i Mod (30*40)+4) Mod 10+1,((i Mod 40)>15)*((i Mod 40)<26)*(RoundDown(i Mod (30*40)/30)=16))+Mid(" !'(/)+,-./0123456789:;<CB>A=CDE7FGHIJKLMN7OPTUVW7XYZ[\]^_\`{}¡w¦J«¬­¯°±÷"+chr(34),1+(i mod (40*30)) mod 74,1),1)
Next i

Last edited by atomimalli on Mon Mar 08, 2010 4:44 pm, edited 1 time in total.
zHelmet
Member
Posts: 73
Joined: Mon Nov 10, 2008 3:55 pm

Re: The Matrix CodeFall

Post by zHelmet »

Pieni kikkailu että olisi näyttävämpi ;)

Code: Select all

    SCREEN 600,500

    //Rajoitetaan pyörimisnopeutta,ettei nykimistä tapahdu
    //Tekstin putoamisnopeus ei ole suoraan verrannollinen tämän arvon kanssa

    //VAKIOITA
    Const ScrWidth=400//Efektiruudun leveys
    Const ScrHeight=300//Efektiruudun korkeus
    Const ScrPosX=100//Efektiruudun vasemman yläkulman x-koordinaatti
    Const ScrPosY=100//Efektiruudun vasemman yläkulman y-koordinaatti

    Const RowWidth=10//Tekstirivin leveys
    Const CharHeight=14//Kirjaimen korkeus

    Const UpdSpeed=33//Monenko millisekunnin välein tekstiriviä siirretään alas pykälällä
    Const DropProb1=0.05////Millä todennäköisyydellä tekstirivi pudotetaan,JOS KAKSI VIEREISTÄ RIVIÄ KUMMALLAKAAN PUOLELLAA EIVÄT TIPU
    Const DropProb2=0.028//Millä todennäköisyydellä tekstirivi pudotetaan,JOS VIEREISET RIVIT EIVÄT TIPU
    Const DropProb3=0.025//Millä todennäköisyydellä tekstirivi pudotetaan,JOS VIEREINEN RIVI TIPPUU

    //MUITA TARVITTAVIA MUUTTUJIA YMS.
    Global Rows,CharsInRow,TextBufC,FadeOut
    Rows=RoundDown(ScrWidth/RowWidth)
    CharsInRow=RoundDown(ScrHeight/CharHeight)
    TextBufC = 0
    FadeOut = False

    //Taulukko tekstirivien tietoja varten
    Dim CharRow(Rows+1,3) As Integer
    Dim TextBuf(CharsInRow+1) As integer
    Dim TextBufHelp(CharsInRow+1) As integer
    //Vakioita osoittimiksi taulukon sarakkeille
    Const IsRowFalling=1//Tippuuko tekstirivi
    Const RowFallPosition=2//Tekstirivin sijainti ruuudussa; YKSIKKÖ=CharsInRow*Pikseli
    Const LastFallUpd=3//Koska tekstirivin putoaminen viimeksi päivitettiin

    //Arvotaan tippuvat rivit, ettei alussa tule "tekstisumaa", joka näyttää huonolta
    For i=1 To Rows
        If Rand(1,8)=1 Then
            CharRow(x,IsRowFalling)=True
        EndIf
    Next i

    AddMatrixText(Rows/2-3,CharsInRow/2,"Matrix")
    fpst = AddMatrixText(1,1,"FPS: ")
    Repeat
        UpdateMatrixText(fpst,1,1,"FPS: "+FPS())
        UpdateMatrix()  
        DrawScreen
    Forever
        Function UpdateMatrix()
        counter=Timer()
        For x=1 To Rows
            //Ettei lueta taulukon ulkopuolelta arpomisissa (MIKSI TAULUKON PARAMETRIKSI TÄYTYY ANTAA VAKIO TAI MUUTTUJA?!?!?!?!)
            tmp1=Max(x-2,0)
            tmp2=Min(x+2,Rows+1)
            //Jos tekstirivi ei putoa
            If CharRow(x,IsRowFalling)=False And FadeOut = False Then
                //Sijainti ruudun yläreunassa
                CharRow(x,RowFallPosition)=-1
                //Jos kaksi viereistä riviä kummallakaan puolella ei putoa
                If CharRow(x-1,IsRowFalling)=False And CharRow(x+1,IsRowFalling)=False And CharRow(tmp1,IsRowFalling)=False And CharRow(tmp2,IsRowFalling)=False Then
                    //Arvotaan pudotetaanko tekstirivi
                    If Rand(1,1/DropProb1)=1 Then
                        CharRow(x,IsRowFalling)=True
                    EndIf
                    //Jos viereiset rivit eivät putoa
                ElseIf CharRow(x-1,IsRowFalling)=False And CharRow(x+1,IsRowFalling)=False Then
                    //Arvotaan pudotetaanko tekstirivi
                    If Rand(1,1/DropProb2)=1 Then
                        CharRow(x,IsRowFalling)=True
                    EndIf
                    //Jos viereiset rivit putoavat
                Else
                    //Arvotaan pudotetaanko tekstirivi
                    If Rand(1,1/DropProb3)=1 Then
                        CharRow(x,IsRowFalling)=True
                    EndIf
                EndIf
                //Jos tekstirivi putoaa
            ElseIf CharRow(x,IsRowFalling)=True Then
                //Sijainnin päivitys ajan mukaan
                If Timer()>CharRow(x,LastFallUpd)+UpdSpeed Then
                    //Siirretään
                    CharRow(x,RowFallPosition)=CharRow(x,RowFallPosition)+1
                    //Päivitetään viimeisimmän päivityksen tapahtumaajankohta biggrin.gif
                    CharRow(x,LastFallUpd)=Timer()
                EndIf
                //Jos koko jono on ulkona ruudusta, siirretään se ylös; kts. luupin alkupuoli
                If CharRow(x,RowFallPosition)>2*CharsInRow Then
                    CharRow(x,IsRowFalling)=False
                EndIf
            EndIf
            //Yksittäisten merkkien käsittely ylhäältä alas
            //Jonon ylin merkki on siis järjestysluvultaan 1
            For y=1 To CharsInRow
                //Jos Tulostettava merkki on efektiruudun sisällä tulostetaan se
                If CharRow(x,RowFallPosition)-(CharsInRow+1-y)>=0 And CharRow(x,RowFallPosition)-(CharsInRow+1-y)=<CharsInRow Then
                    //Merkin sijainti jonossa määrää merkin värin
                    Color 0,RoundDown(255/CharsInRow)*y,0
                    xx = ScrPosX+x*RowWidth-RowWidth
                    yy = ScrPosY+(CharRow(x,RowFallPosition)-(CharsInRow+1-y))*CharHeight
                    tulostus = False
                    For MemC = 1 To TextBufC
                        For i = 1 To PeekInt(TextBuf(MemC),8)
                            If x = PeekInt(TextBuf(MemC),0)+i And Int((yy-ScrPosY)/CharHeight) = PeekInt(TextBuf(MemC),4) Then 
                                c = RoundDown(255/CharsInRow)*y
                                Color c,c,c
                                Text xx,yy,Chr(PeekByte(TextBuf(MemC),11+i))
                                tulostus = True
                            EndIf 
                        Next i
                    Next MemC
                    If tulostus = False Then
                        Text xx,yy,Chr(Rand(0,255))
                    EndIf 
                EndIf
            Next y   
        Next x
    EndFunction 
    Function AddMatrixText(x,y,txt$)
        TextBufC = TextBufC + 1
        mem = MakeMEMBlock(12+(Len(txt$)))
        PokeInt mem,0,x
        PokeInt mem,4,y
        PokeInt mem,8,Len(txt$)
        For i = 1 To Len(txt$)
            PokeByte mem,11+i,Asc(Mid(txt$,i,1))
        Next i
        TextBuf(TextBufC) = mem
        Return TextBufC
    EndFunction
    Function UpdateMatrixText(bf,x,y,txt$)
        If TextBuf(bf) Then DeleteMEMBlock TextBuf(bf)
        mem = MakeMEMBlock(12+(Len(txt$)))
        PokeInt mem,0,x
        PokeInt mem,4,y
        PokeInt mem,8,Len(txt$)
        For i = 1 To Len(txt$)
            PokeByte mem,11+i,Asc(Mid(txt$,i,1))
        Next i
        TextBuf(bf) = mem
        Return bf
    EndFunction 
    Function DeleteMatrixText(bf)
        If TextBuf(bf) Then DeleteMEMBlock TextBuf(bf)
        pos = 1
        For MemC = 1 To TextBufC
            If i <> bf Then
                TextBufHelp(pos) = TextBuf(i)
                pos = pos + 1
            EndIf 
        Next MemC
        TextBufC = TextBufC - 1
        For MemC = 1 To TextBufC
            TextBuf(i) = TextBufHelp(i)
        Next MemC
    EndFunction 
phons
Guru
Posts: 1056
Joined: Wed May 14, 2008 10:11 am

Re: The Matrix CodeFall

Post by phons »

Hehe, hiesnoti alitettu nuo Matrix ja FPS tekstit tuonne vilkkumaan valkoisena. Ja oli muuten aika paljon nopemapi, tosin se saattaa johtua myös siitä että alue jossa tekstiä tippui oli aika pieni..
Image
SPuntte
Tech Developer
Tech Developer
Posts: 650
Joined: Mon Aug 27, 2007 9:51 pm
Location: Helsinki, Finland
Contact:

Re: The Matrix CodeFall

Post by SPuntte »

phons wrote:Löysin koneeltani tällasen umpi vanhan koodin:

Code: Select all

*snip*
Ei ole oma..
Tuo on ikivanha kyhäelmäni kyseisestä efektistä. En löytänyt referenssiä tähän hätään, joten, en osaa sanoa, onko tuo alkuperäinen. Julkaisin sen joskus wanhoilla foorumeilla, varmaan liki 5 vuotta sitten. Kommentointi on aika... öh, mielenkiintoista paikoitellen.

Koodin julkaisu tässä ketjussa oli ihan ok, mutta olisin kiitollinen, jos kuitenkin lisäisit sen alkuun tiedon tekijästä.
CoolBasic henkilökuntaa
Tech-kehittäjä
CoolBasic Classic, Cool VES

CoolPhysicsEngine | MissileSystem | Jana-ympyrä -törmäys | cbSimpleTexture | CoolCPLX
JATothrim
Tech Developer
Tech Developer
Posts: 606
Joined: Tue Aug 28, 2007 6:46 pm
Location: Kuopio

Re: The Matrix CodeFall

Post by JATothrim »

Lyhensin koodia 235 riviin. ei muuta. ;)

Code: Select all

Const img_char_w = 26
Const img_char_h = 21
Const img_chars = 55
Dim imgchartbl(48)

Type codefall
	Field x#
	Field y#
	Field speed#
	Field xoff#
	
	Field memsize%
	Field memque%
	
	Field rpl_counter%
	Field rpl_at%
	Field rpl_turbulence%
	Field rpl_maxjmp%
	
	Field gen_counter%
	Field gen_at%
	Field gen_turbulence%
	Field dmo_at%
EndType

Function DrawLetter(x%, y%, ind%, fade% = 0)
	imgW% = ImageWidth(imgchartbl(0))
	row% = ind / (imgW / img_char_w)
	colum% = ind - row * (imgW / img_char_w)
	If row >= 4 Then a = 1 'korjataan kuvan virhettä..
	DrawImageBox imgchartbl(fade), x, y, colum*img_char_w, a + row*img_char_h, img_char_w, img_char_h
EndFunction

Color 0,255,0
Text  ScreenWidth()/2 - TextWidth("Looking for best graphics mode..") /2, ScreenHeight()/2, "Looking for best graphics mode.."
DrawScreen

// Etsitään suurin (toivottavasti) tuettu grafiikka tila. Parametrilla /w Ohjelma käynnistyy
// 800x600 kokoisessa ikkunassa.
If Trim(CommandLine()) = "/w"
	SCREEN 800,600
Else
	modew = 0
	modeh = 0
	For y=0 To 2000 Step 2
		For x=0 To 2000 Step 2
			If GFXModeExists(x,y,32) Then
				If modew < x Then modew = x
				If modey < y Then modeh = y
			EndIf
		Next x
	Next y
	SCREEN modew,modeh,0,0
EndIf

Color 0,255,0
Text  ScreenWidth()/2 - TextWidth("Loading awesome graphics..") /2, ScreenHeight()/2, "Loading awesome graphics.."
DrawScreen


// Ladataan kuva ja 
m_imgchars% = LoadImage("matrix_code.png")
For i = 0 To 48
	imgchartbl(i) = ImageBrightness(m_imgchars, -6*i + 30)
Next i

rndposwc% = ScreenWidth() / img_char_w
rndposhc% = ScreenHeight() / img_char_h
fall_gen_counter% = 0
fall_gen_at% = 400
m_x% = MouseX()
m_y% = MouseY()
Randomize Timer()

// Näytetään demo.
ApplyDemo()

Repeat

	If fall_gen_counter > fall_gen_at
		fall_gen_counter = 0
		fall_gen_at = Rand(1, 4)

		// generoidaan uusi koodipötkö:
		nque.codefall = New(codefall)
		nque\x = Rand(rndposwc) * img_char_w + Rand(-1,1) * (img_char_w/2)
		nque\y = -img_char_h
		// kaikki pötkön generoimis parametrit riippuvat sen nopeudesta..
		nque\speed = Rand(1, img_char_h) + Rnd(-0.5, 1.0)
		
		nque\xoff = (1 - 2*Rand(1)) * Rnd(nque\speed*3)
		// Arvotaan pötkön pituus. (Min 2 merkkiä, koska muuten MemCopy ei toimi!)
		quesize% = 2 + ((Rand(3, rndposhc) / nque\speed))
		nque\memque = MakeMEMBlock(quesize) 	 
		nque\gen_at% = 1+(randposhc / quesize) +  Int(img_char_h / nque\speed) / 2
		nque\gen_turbulence = Rand(1, nque\gen_at / 2) * (1 - 2*Rand(1))
		// jos pötkö liikuu hitaasti tapahtuu siinä paljon "virheitä"
		nque\rpl_maxjmp = Rand(0, quesize-1)
		nque\rpl_turbulence = Rand(nque\rpl_maxjmp / 6)
		nque\rpl_at = Int(nque\speed * 0.75)
	EndIf
	
	fall_gen_counter + 1
	
	TheMatrixCodefall()
	
	If KeyHit(cbkeyspace)
		ApplyDemo()
		fall_gen_at = 10
	EndIf

	If KeyDown(cbkeyf) Then Text 0,0,"FPS:"+FPS()
	
	// Suljetaan ohjelma jos hiiri liikkuu tarpeeksi.
	If Distance(MouseX(),MouseY(),m_x,m_y) > 10 Then End
	
	DrawScreen
Forever
End

Function TheMatrixCodefall()
	
	For cf.codefall = Each codefall
		cf\y = cf\y + cf\speed
		cf\gen_counter = cf\gen_counter + 1
		cf\rpl_counter = cf\rpl_counter + 1
		
		If cf\memsize = 0
			PokeByte cf\memque, 0, Rand(img_chars)  
			cf\memsize = 1
		EndIf
		
		If cf\gen_counter > cf\gen_at + cf\gen_turbulence + cf\dmo_at
			cf\dmo_at = 0
			cf\gen_counter = 0
			cf\gen_turbulence = Rand(1, cf\gen_at / 2) * (1 - 2*Rand(1))
			// siirrä merkki pötköä muistipalassa..
			If MEMBlockSize(cf\memque)-1 < cf\memsize Then cf\memsize = cf\memsize - 1  
			MemCopy cf\memque, 0, cf\memque, 1, cf\memsize  
			cf\memsize = cf\memsize + 1
			// arvo keulaan uusi merkki
			PokeByte cf\memque, 0, Rand(img_chars)  
			cf\y = cf\y + img_char_h '/ 2
		EndIf
		
		If cf\rpl_counter > cf\rpl_at + cf\dmo_at
			// Koravataan jokin merkki, pötkön 'hännässä' on epätodennäköisepää
			// että merkki korvautuu.
			cf\rpl_counter = 0
			pos% = cf\rpl_maxjmp
			Repeat
				If Rand(pos) = 0
					PokeByte cf\memque, Int(Min(MEMBlockSize(cf\memque)-1, pos + Rand(cf\rpl_turbulence))), Rand(img_chars)
					Exit
				EndIf
				pos = pos - 1
			Until pos < 0
		EndIf
		
		// Piirretään koodipötkö.
		For i = 0 To cf\memsize-1
			y# = cf\y - i * img_char_h
			If y < ScreenHeight()
				x# = cf\x+(Float(cf\y)/Float(ScreenHeight()))*cf\xoff
				fade% = Max(0, (i / Max(1, Float(cf\memsize-1))) * 48)
				DrawLetter(x, y, PeekByte(cf\memque, i), fade)
			EndIf
		Next i

		// jos koko pötkö tipahti ulos ruudusta, se poistetaan.
		If (cf\y - cf\memsize * img_char_h) > ScreenHeight()
			DeleteMEMBlock cf\memque
			Delete cf
		EndIf
	Next cf
	
EndFunction

// CBSDK:n Vastaavan nimiminen, nopeampi funktio.
Function ImageBrightness(pic%, bright%)
	iw = ImageWidth(pic)
	ih = ImageHeight(pic)
	modified = MakeImage(iw,ih)
	MaskImage modified, Int(Max(0, bright)),int(Max(0, bright)),int(Max(0, bright))
	Lock Image(pic)
	Lock Image(modified)
	For j = 0 To ih-1
		For i = 0 To iw-1
			pixel% = GetPixel2(i,j,Image(pic))
			r = Max(Min((pixel Shl 8) Shr 24 + bright, 255),0)   
			g = Max(Min((pixel Shl 16) Shr 24 + bright, 255),0)
			b = Max(Min((pixel Shl 24) Shr 24 + bright, 255),0)
			PutPixel2 i,j,b + (g Shl 8) + (r Shl 16), Image(modified)
		Next i
	Next j
	Unlock Image(modified)
	Unlock Image(pic)
	Return modified
EndFunction

Function ApplyDemo()
	// Luodaan kuvan merkeistä nipin napin  tunnistettava "The Matrix codefall"
	// Merkit ON valittu luovasti vapaalla silmällä. ;)
	q.codefall = NULL
	// ensin 19 pötköä..
	For i = 1 To 19
		nque.codefall = New(codefall)
		// Keskitetään merkit n. ruudun keskelle.
		nque\x = ((ScreenWidth() / img_char_w)/2 - 9 + i) * img_char_w
		nque\y = -img_char_h
		nque\speed = 1
		nque\xoff = (1 - 2*Rand(1)) * Rnd(nque\speed*2)
		quesize% = 2 + ((Rand(3, rndposhc) / nque\speed))
		nque\memque = MakeMEMBlock(quesize) 	 
		nque\gen_at% = 2+(randposhc / quesize) +  Int(img_char_h / nque\speed)
		nque\dmo_at% = 400 'demo jono ..
		nque\gen_turbulence = Rand(1, nque\gen_at / 2) * (1 - 2*Rand(1))
		nque\rpl_maxjmp = rand(0, quesize-1)
		nque\rpl_turbulence = Rand(1, nque\rpl_maxjmp / 6)
		nque\rpl_at = Int(nque\speed * 0.75)
		
		// lisäämme jokaiseen ainakin yhden merkin!
		nque\memsize = 1
		If i = 1 Then q = nque
	Next i
	// kirjoitetaan viesti.. : P
	
	message$ = "13,49,31,19,11,20,13,49,16,54,19,10,8,4,31,50,20,32,32"
	chars% = CountWords(message,",")
	For i = 1 To chars
		PokeByte q\memque, 0, GetWord(message, i, ",")
		q = After(q)
	Next i
EndFunction
	
"Olkoon tallennus suopa tälle ketjulle ja armahtakoon sen unhoittumista" 8-)
-On selkeästi impulsiivinen koodaaja joka...
ohjelmoi C++:lla rekursiivisesti instantioidun templaten, jonka jokainen instantiaatio instantioi sekundäärisen singleton-template-luokan, jonka jokainen instanssi käynistää säikeen tulostakseen 'jea'.
Post Reply