Cyberpunk aiheisia ohjelmia

[Ahriman]

Hei vaan kaikille!

Itse en ole koskaan coolbasicilla mitään ole saanut aikaiseksi, vaikka yritys on ollutkin kova. Mutta tuli sitten sellanen idea ilmi, että jos saisi Cyberpunk liveroolipeliin jonkinlaisia 'ohjelmia' pyörimään, lähinnä lavasteeksi. Esimerkiksi vihreitä lukuja, jotka rullaisiavat epätaisaiseen tahtiin tai diagrammeja, vihreitä ruudukkoja joka piirtäisi jotain viivaa tai olevinaan karttaa. Tässähän on vain mielikuvitus rajana.

Kysyisin sitten teiltä arvon ihmiset palvelusta, jos joku olisi jo tehnyt jonkinlaista hupiefektiä, joka sopisi aiheeseen tai sitten olisi valmis nopeasti kehittelemään jonkinlaisen ohjelman.

Ohjelman ei todellakaan tarvitse kuin näyttää hyvältä. Ei tarvitse oikeasti laskea mitään eikä tehdä toimivaa karttaa. tärkeätä olisi kuitenkin se, että ohjelman saisi koko ruudulle sekä se jatkuisi kunnes painaisi esimerkiksi enteriä, että sitä ei voi pelkästään näppäimistöön nojaamalla laittaa pois päältä.

Korvauksesta voidaan keskustella, mutta ainakin tekijä saa kunniamaininnan tapahtumassa. Ja ehkä joku nimellinen rahallinenkin korvaus olisi mahdollista.

Postaile jos olet kiinnostunut tai ota yhteyttä Arhi.Makkonen[ÄT]Gmail.com tai lisää msn messengeriin Ahriman_sama[ÄT]hotmail.com

[mikeful]

Tein joskus muutamankin vähän Matrix-tyyliä matkivan grafiikkahärpäkkeen. Voisin kaivella esiin niitä, kunhan pääsen kotiin.

EDIT: Vanhoilla foorumeilla oli tallessa joku versio efektistä. Kotona on muistaakseni parempi versio.

Code: Select all

Randomize Timer()
leveys=39
korkeus=24
skaala=ModeWidth()/leveys
Dim alue (leveys,korkeus)
Repeat
If nx>tx Then nx=nx-1
If nx<tx Then nx=nx+1
If ny>ty Then ny=ny-1
If ny<ty Then ny=ny+1
If nx=tx And ny=ty Then
    tx=Rand(leveys)
    ty=Rand(korkeus)
EndIf
alue(nx,ny)=255
For a=0 To leveys
 For b=0 To korkeus
 If alue(a,b)>0 Then
  voima=alue(a,b)
  Color 0,voima,0
  Box a*skaala,b*skaala,skaala-1,skaala-1
  alue(a,b)=alue(a,b)-10
 EndIf
 Next b
Next a
Sync
Forever

[TheDuck]

Tein joskus muutamankin vähän Matrix-tyyliä matkivan grafiikkahärpäkkeen. Voisin kaivella esiin niitä, kunhan pääsen kotiin.

EDIT: Vanhoilla foorumeilla oli tallessa joku versio efektistä. Kotona on muistaakseni parempi versio.

Code: Select all

koodia.....

Tosiaan, tuo on kai vielä BETA 5-ajoilta tai jtn. Sync --> Drawscreen

Code: Select all

Randomize Timer()
leveys=39
korkeus=24
skaala=ScreenWidth()/leveys
Dim alue (leveys,korkeus)
Repeat
If nx>tx Then nx=nx-1
If nx<tx Then nx=nx+1
If ny>ty Then ny=ny-1
If ny<ty Then ny=ny+1
If nx=tx And ny=ty Then
    tx=Rand(leveys)
    ty=Rand(korkeus)
EndIf
alue(nx,ny)=255
For a=0 To leveys
For b=0 To korkeus
If alue(a,b)>0 Then
  voima=alue(a,b)
  Color 0,voima,0
  Box a*skaala,b*skaala,skaala-1,skaala-1
  alue(a,b)=alue(a,b)-10
EndIf
Next b
Next a
DrawScreen
Forever 

[Harakka]

Tällaisen kehittelin ajankuluksi.

Code: Select all

//CYBERPUNK-SKANNERI BY HARAKKA :)

Const SW = 1280         'RUUDUN LEVEYS
Const SH = 1024         'RUUDUN KORKEUS
Const FULLSCREEN = 1   'ONKO FULLSCREEN
Const KOKO = 20         'RUUTUJEN KOKO    
Const VALI = 4          'TYHJÄÄ RUUTUJEN VÄLILLÄ
Const SPEED = 100       'SKANNAUSVIIVAN HITAUS - PIENEMPI NOPEAMPI
Const ODOTUS = 3000     'KUINKA KAUAN ODOTETAAN UUDEN KIERROKSEN ALKUA

Const VARI = 0          'Selkeyttämässä koodia, älä koske näihin ;)
Const KOHDE = 1

If FULLSCREEN Then
    SCREEN SW,SH,0,0
Else
    SCREEN SW,SH
EndIf
    

global ruutujax : ruutujax = SW/KOKO
global ruutujay : ruutujay = SH/KOKO
Dim ruutu(ruutujaX,ruutujaY,1)

arvoVarit()

Repeat
    If Timer() > tick Then
        ScanX = ScanX + 1
        tick = Timer() + SPEED
        If scanX = ruutujaX Then palautus = Timer() + ODOTUS
    EndIf
    
    If Timer() > palautus And ScanX > ruutujaX Then
        ScanX = 0
        ArvoVarit()
    EndIf
    
    For x = 0 To ruutujaX
    For y = 0 To ruutujaY
        If x = ScanX Then
            ruutu(x,y,VARI) = ruutu(x,y,KOHDE)
            Color 0,max(30,ruutu(x,y,VARI)),0
        Else
            ruutu(x,y,VARI) = Max(10,ruutu(x,y,VARI) - 3)
            Color 0,ruutu(x,y,VARI),0
        EndIf
        
        Box x*KOKO,y*KOKO,KOKO-VALI,KOKO-VALI
        j +1
    Next y
    Next x
    DrawScreen
Forever
    
Function ArvoVarit(mustaa = 20,minVari = 150)
    For x = 0 To ruutujaX
    For y = 0 To ruutujaY
        If Not Rand(mustaa) Then
            ruutu(x,y,KOHDE) = Rand(minVari,255)
        EndIf
    Next y
    Next x
End Function

(Pyörii oletuksena 1280*1024-fullscreenissä, tämän voi vaihtaa muokkaamalla ensimmäisiä rivejä)

EDIT: Sammuu siis escistä, kuten CB-ohjelmat nyt yleensäkin.

EDIT2: Teinpä toisenkin.

Code: Select all

//TOINEN SKANNERI BY HARAKKA

Const SW    = 1280      'RUUDUN LEVEYS
Const SH    = 1024      'RUUDUN KORKEUS
Const FULLSCREEN = 1    'FULLSCREEN PÄÄLLÄ
Const SPEED = 6000      'KUINKA KAUAN SKANNAILLAAN KOHDETTA
Const SMOOTH = 30       'SULAVUUS
Const MINSIZE = 20      'RUUTUJEN KOKO
Const MAXSIZE = 50      'SKANNAUSNELIÖN KOKO SUURIMMILLAAN

SCREEN SW,SH,0,Not FULLSCREEN

Dim targetX     As Integer
Dim targetY     As Integer
Dim currentX    As Float
Dim currentY    As Float
Dim currentSize As Float

Type POINT
    Field x
    Field y#
    Field phase#
    Field size#
    Field col#
EndType

grid = MakeImage(SW,SH)
DrawToImage grid
Color 0,30,0
For x = 0 To SW Step MINSIZE
For y = 0 To SH Step MINSIZE
    Box x,y,MINSIZE-2,MINSIZE-2,1
Next y
Next x
DrawToScreen


font = LoadFont("Lucida Console",8)
SetFont font

Repeat
    DrawImage grid,0,0
    If Timer() > tick Then
        targetX = Rand(ScreenWidth()/MINSIZE) * MINSIZE -1- MINSIZE/2
        targetY = Rand(ScreenHeight()/MINSIZE) * MINSIZE -1- MINSIZE/2
        targetSize = MAXSIZE'Rand(MINSIZE,MAXSIZE)
        tick = Timer() + SPEED
        addPoint(targetX,targetY,MINSIZE-2)
    EndIf
    
    If currentSize > targetSize - 5 Then
        currentX = CurveValue(targetX,currentX,SMOOTH)
        currentY = CurveValue(targetY,currentY,SMOOTH)
    EndIf
    currentSize = CurveValue(targetSize,currentSize,SMOOTH)
    

    If Distance(currentX,currentY,targetX,targetY) < 10 Then
        targetSize = MINSIZE
        scanning = 1
    Else
        scanning = 0
    EndIf

    For ip.POINT = Each POINT
        If ip\phase = 0 Then
            ip\col = CurveValue(255.0,ip\col,80)
            If ip\col => 254 Then ip\phase = 1
        Else
            ip\phase = ip\phase + 0.2
            ip\y = ip\y + ip\phase
            ip\size = Max(0,ip\size-0.2)
        EndIf
        
        Color 0,ip\col,0
        Box ip\x-ip\size/2,ip\y-ip\size/2,ip\size,ip\size,1
        
        If ip\size = 0 Then
            Delete ip
        EndIf
    Next ip
    
    Color 0,255,0

    Line 0,currentY,currentX-currentSize/2,currentY
    Line currentX+currentSize/2,currentY,SW,currentY
    Line currentX,0,currentX,currentY-currentSize/2
    Line currentX,currentY+currentSize/2,currentX,SH
    Box currentX-currentSize/2,currentY-currentSize/2,currentSize,currentSize,0
    Box currentX-currentSize/2 - 2,currentY-currentSize/2 - 2,currentSize+4,currentSize+4,0
    
    Color 0,150,0
    
    If scanning Then
        blink = Not blink
        If blink Then plustxt$ = " - SCANNING..." Else plustxt$ = ""
    Else
        plustxt$ = ""
    EndIf
    
    Text currentX + currentSize/2 + 5,currentY -9,CurrentX + plustxt$
    
    VerticalText currentX - 5, currentY + currentsize/2 + 20,CurrentY

    DrawScreen
Forever

Function addPoint(_x,_y,_size)
    np.POINT = New(POINT)
    np\x = _x
    np\y = _y
    np\phase = 0
    np\size = _size
End Function

[temu92]

Harakka, toi ekahan on iha sikahieno

[mikeful]

Tässä pari projektikansioista kaivettua kokeilua. Saa käyttää ja muokata vapaasti.

Code: Select all

SCREEN 800,600,16,0
FrameLimit 40

font=LoadFont("arial",20)
font1=LoadFont("arial",15)
font2=LoadFont("arial",10)
SetFont font

quantity=500

Dim letters$(quantity)
Dim letterx(quantity)
Dim lettery#(quantity)
Dim letterspeed#(quantity)

Color 0,200,0

For i=0 To quantity
letters(i)=Chr(Rand(33,255))
letterx(i)=Rand(-3,ScreenWidth())
letterspeed(i)=Rnd(1,3)
lettery(i)=Rand(0,ScreenHeight())
Next i

Repeat
Color 0,200,0
For i=0 To quantity
lettery(i)=lettery(i)+letterspeed(i)
If Int(letterspeed(i))=3 Then SetFont font
If Int(letterspeed(i))=2 Then SetFont font1
If Int(letterspeed(i))=1 Then SetFont font2
Text letterx(i),lettery(i),letters(i)
If lettery(i)>ScreenHeight() Then lettery(i)=-3
Next i
DrawScreen
Until EscapeKey()

Code: Select all

SCREEN 800,600,16,0
FrameLimit 30

font=LoadFont("arial",15)
SetFont font

quantity=500

kuva=MakeImage(ScreenWidth(),ScreenHeight())

Dim letters$(quantity)
Dim letterx(quantity)
Dim lettery#(quantity)
Dim letterspeed#(quantity)

Color 0,200,0

For i=0 To quantity
    letters(i)=Chr(Rand(33,255))
    letterx(i)=Rand(-3,ScreenWidth())
    letterspeed(i)=Rnd(-3,3)
    lettery(i)=Rand(0,ScreenHeight())
Next i

Repeat
    Color 0,200,0
    For i=0 To quantity
        If lettery(i)>ScreenHeight() Or lettery(i)<0 Then
            letterspeed(i)=-letterspeed(i)
        EndIf
        lettery(i)=lettery(i)+letterspeed(i)
        If letterspeed(i)<0 Then
            Color 0,100,0
        Else
            Color 0,200,0
        EndIf 
        Text letterx(i),lettery(i),letters(i)
    Next i
    DrawScreen
Forever

Code: Select all

Randomize TIMER()
SCREEN 800,600,16,0
leveys=39
korkeus=24
skaala=ScreenWidth()/leveys
fontti=LoadFont("Courier New",Int(skaala*1.3))
SetFont fontti
Dim alue (leveys,korkeus)
Dim kir(leveys,korkeus)

Repeat
If nx>tx Then
nx=nx-1
ElseIf nx<tx Then
nx=nx+1
ElseIf ny>ty Then
ny=ny-1
ElseIf ny<ty Then
ny=ny+1
EndIf
If nx=tx And ny=ty Then
    tx=Rand(leveys)
    ty=Rand(korkeus)
EndIf
alue(nx,ny)=255
kir(nx,ny)=Rand(255)
Cls
For a=0 To leveys
    For b=0 To korkeus
        If alue(a,b)>0 Then
            voima=alue(a,b):Color 0,voima,0
            Text a*skaala,b*skaala,Chr(kir(a,b))
            'Box a*skaala,b*skaala,skaala,skaala,ON
            alue(a,b)=alue(a,b)-1
        EndIf
    Next b
Next a
DrawScreen
Forever

Code: Select all

Randomize TIMER()
SCREEN 800,600,16,0
leveys=39
korkeus=24
skaala=ScreenWidth()/leveys
fontti=LoadFont("Courier New",Int(skaala*1.3))
SetFont fontti
Dim alue (leveys,korkeus)
Dim kir(leveys,korkeus)
madot=10
Dim nx(madot-1)
Dim ny(madot-1)
Dim tx(madot-1)
Dim ty(madot-1)
Repeat
For mato=0 To madot-1
	If nx(mato)>tx(mato) Then
		nx(mato)=nx(mato)-1
	ElseIf nx(mato)<tx(mato) Then
		nx(mato)=nx(mato)+1
	ElseIf ny(mato)>ty(mato) Then
		ny(mato)=ny(mato)-1
	ElseIf ny(mato)<ty(mato) Then
		ny(mato)=ny(mato)+1
	EndIf
	If nx(mato)=tx(mato) And ny(mato)=ty(mato) Then
		tx(mato)=Rand(leveys)
		ty(mato)=Rand(korkeus)
	EndIf
	alue(nx(mato),ny(mato))=255
    kir(nx(mato),ny(mato))=Rand(255)
Next mato
Cls
For a=0 To leveys
    For b=0 To korkeus
        If alue(a,b)>0 Then
            voima=alue(a,b):Color 0,voima,0
            Text a*skaala,b*skaala,Chr(kir(a,b))
            alue(a,b)=alue(a,b)-10
        EndIf
    Next b
Next a
DrawScreen
Forever

Code: Select all

SCREEN 800,600,16,0

FrameLimit 30

vontti=LoadFont("Courier New",16)
SetFont vontti

kokox=Int(ScreenWidth()/8)'320x240=39
kokoy=Int(ScreenHeight()/13)'320x240=17
Dim kentta$(kokox,kokoy)
For a=0 To kokox
    For b=0 To kokoy
        kentta(a,b)=Chr(Rand(33,126)) '64-122
    Next b
Next a

Cls
Repeat

For a=0 To 5
    kohtax=Rand(0,kokox)
    kohtay=Rand(0,kokoy)
    kentta(kohtax,kohtay)=Chr(Rand(33,126))
    'Color 255,255,255
    'Box kohtax*8,kohtay*13,8,13,ON
Next a

For a=0 To kokox
    For b=0 To kokoy
        Color 0,200,0
        Text a*8,b*13,kentta(a,b)
    Next b
Next a
DrawScreen
Forever