CoolBasic Fast-Gamedev Compo

Post Reply
User avatar
CCE
Artist
Artist
Posts: 650
Joined: Mon Aug 27, 2007 9:53 pm

CoolBasic Fast-Gamedev Compo

Post by CCE »

Julistan täten CoolBasicin historian ensimmäisen(?) Fast-Gamedev Compon avatuksi.
Osallistujina toimivat CB-miitin jäsenet Assemblyssä, ja aikaa on klo 21.30 asti.
Eli peli pitää olla palautettuna 21:30.

Palauta peli tähän ketjuun latauslinkin kera.
Kelpo filehosti on esim. Servut.us http://up.servut.us/

Pelin pitää toimia 40x30 tai 30x40 näyttötilassa, ruudun resoluution ei tarvitse olla sama, ja esim. doublepixeling käy hyvin.
Näin megascreenin hengessä. Myös järjestäjät saavat osallistua.

Hikistä koodailua kaikille! Jonkinlainen katselmus on myös kisan jälkeen mahdollinen.

Edit: Kilpailuaikaa pidennetty 30min fastgraafiikka kompon takia.
Edit2: Diktatuurinen 30min viimeistelypidennys :D Palautus klo 22:00
Last edited by CCE on Fri Aug 01, 2008 9:37 pm, edited 1 time in total.
Joxi
Newcomer
Posts: 23
Joined: Sun Aug 26, 2007 5:40 pm
Location: Kuopio
Contact:

Re: CoolBasic Fast-Gamedev Compo

Post by Joxi »

Entäs musakompopidennys?

vetää vähän tiukalle :S

Atomimalli, Joxin koneelta ja omalla tunnuksella on jotain häikkää.
Image
Henkru
Advanced Member
Posts: 359
Joined: Sun Aug 26, 2007 2:46 pm

Re: CoolBasic Fast-Gamedev Compo

Post by Henkru »

Nyt kävi niin etten saanu ideaa päähän niin jäi tämäkin tkemät. Saa nähä mitä tulee kun resona 40x30 :)
Koodiapina
Forum Veteran
Posts: 2396
Joined: Tue Aug 28, 2007 4:20 pm

Re: CoolBasic Fast-Gamedev Compo

Post by Koodiapina »

Saisinko tiedustella miksi tähän kilpailuun hyväksytään vain CB miitin jäsenet? Osallistuisin näihin kilpailuihin nimittäin mielelläni.
Ozcar
Advanced Member
Posts: 439
Joined: Mon Aug 27, 2007 8:43 pm
Location: Helsinki

Re: CoolBasic Fast-Gamedev Compo

Post by Ozcar »

Huoh. Kahden tunnin säätämisen tuloksena ei ole oikein mitään näyttämiskelpoista, sillä homma kaatui niin mystisiin bugeihin, etten niitä ehtinyt alkaa poistamaan aikarajan puitteissa. Tarkoitukseni oli tehdä peli, jossa kerätään vihreitä ja väistellään punaisia palloja, ja punaisten koko ajan lisääntyessä ainoa tapa hankkiutua niistä eroon oli kerätä vihreitä palloja, jotka pystyi räjäyttämään kerralla. Mutta kun ei niin ei, ja ongelmien edessä oli pakko tyytyä kompromissiin. Joten nyt pelissä vain yritetään vältellä punaiseen palloon osumista, ja kerätä vihreistä hipareita. Jos "hahmo" muuttuu täysin punaiseksi, se on hame over. Tylsää, eikä kuolla voi kuin yrittämällä, mutta minkäs teet.

Code: Select all

start:

FrameLimit 40
SCREEN 40,30,32,2

Type VIHUT
 Field tyyppi
 Field vihux
 Field vihuy
 Field xliike
 Field yliike
 Field elossa
 Field ajastin
 Field syntyy
End Type

herox = 20
heroy = 15

punvah = 0
vihota = 0

R = 225
G = 225
B = 225

For a = 1 To 2
 vihu.VIHUT = New(VIHUT)
 vihu\tyyppi = a
 arvoco:
 vihu\vihux = Rand(2,37)
 vihu\vihuy = Rand(2,27)
  If vihu\vihux > herox - 5 And vihu\vihux < herox + 5 And vihu\vihuy > heroy - 5 And vihu\vihuy < heroy + 5 Then
   Goto arvoco
  EndIf
 arvoliike:
 vihu\xliike = Rand(-1,1)
 vihu\yliike = Rand(-1,1)
 If vihu\xliike = 0 Or vihu\yliike = 0 Then
  Goto arvoliike
 EndIf
 vihu\syntyy = 0
 vihu\elossa = 0
 vihu\ajastin = 0
Next a



Repeat

ClsColor 0,0,0
Color 225,225,225

Box 0,0,40,30,0

If ajastin > 2 Then
 If KeyDown(208) Then
  heroy + 1
 EndIf
 If KeyDown(200) Then
  heroy - 1
 EndIf
 If KeyDown(203) Then
  herox - 1
 EndIf
 If KeyDown(205) Then
  herox + 1
 EndIf
 ajastin = 0
EndIf
ajastin + 1

If herox > 38 Then 
 herox - 1
ElseIf herox < 1 Then
 herox + 1
ElseIf heroy < 1 Then
 heroy + 1
ElseIf heroy > 28 Then
 heroy - 1
EndIf

For vihu.VIHUT = Each VIHUT
 Select vihu\tyyppi
  Case 1
   Color 0,225,0
   Dot vihu\vihux,vihu\vihuy
   If vihu\ajastin > 2 Then
    vihu\vihux + vihu\xliike
    vihu\vihuy + vihu\yliike
     If vihu\vihux < 2 Then 
      vihu\xliike = vihu\xliike * -1 
     EndIf
     If vihu\vihux > 37 Then 
      vihu\xliike = vihu\xliike * -1
     EndIf
     If vihu\vihuy < 2 Then
      vihu\yliike = vihu\yliike * -1 
     EndIf
     If vihu\vihuy > 27 Then
      vihu\yliike = vihu\yliike * -1 
     EndIf 
    vihu\ajastin = 0
   EndIf    
   vihu\ajastin + 1
   If vihu\vihux > herox - 1 And vihu\vihux < herox + 1 Then
    If vihu\vihuy > heroy - 1 And vihu\vihuy < heroy + 1 Then
     If vihota < 1
      R - 25
      B - 25
      G + 15
      vihota = FPS() 
     EndIf
     If R < 1 Then
      R = 0
     EndIf
     If B < 1 Then
      B = 0
     EndIf 
     If G > 225 Then
      G = 225
     EndIf
    EndIf
   EndIf 
   vihota -1
  Case 2
   Color 225,0,0
   Dot vihu\vihux,vihu\vihuy
   If vihu\ajastin > 2 Then
    vihu\vihux + vihu\xliike
    vihu\vihuy + vihu\yliike
     If vihu\vihux < 2 Then 
      vihu\xliike = vihu\xliike * -1 
     EndIf
     If vihu\vihux > 37 Then 
      vihu\xliike = vihu\xliike * -1
     EndIf
     If vihu\vihuy < 2 Then
      vihu\yliike = vihu\yliike * -1 
     EndIf
     If vihu\vihuy > 27 Then
      vihu\yliike = vihu\yliike * -1 
     EndIf 
    vihu\ajastin = 0
   EndIf    
   vihu\ajastin + 1
   If vihu\vihux > herox - 1 And vihu\vihux < herox + 1 Then
    If vihu\vihuy > heroy - 1 And vihu\vihuy < heroy + 1 Then
     If punvah < 1 Then
      B - 25
      G - 25
      R + 35
      punvah = FPS()
     EndIf
     If G < 1 Then
      G = 0
     EndIf
     If B < 1 Then
      B = 0
     EndIf 
     If R > 225 Then
      If B < 1
       If G < 1
        Goto loppu
       EndIf
      EndIf 
     EndIf
    EndIf
   EndIf 
   punvah - 1
 End Select
Next vihu.VIHUT

Color R,G,B
Dot herox,heroy


DrawScreen
Forever 

loppu:
Color 225,225,225
arial = LoadFont("arial",12) 
SetFont arial
Text 5,3,"FAIL!"
Text 5,10,"Retry?"
Text 5,18,"Y/N"

DrawScreen
paina:
WaitKey 
If KeyDown(21) Then
 For vihu.VIHUT = Each VIHUT
  Delete(vihu.VIHUT)
 Next vihu.VIHUT
 Goto start
ElseIf KeyDown(49) Then
 Goto pois
EndIf
Goto paina
pois:
Ratkaisit juuri universaaliongelman! Hienoa, ota keksi.

Filosofia on ajattelun taidetta, mutta sen maalari elää juoden apurahojaan masennukseensa.
temu92
Web Developer
Web Developer
Posts: 1226
Joined: Mon Aug 27, 2007 9:56 pm
Location: Gamindustri
Contact:

Re: CoolBasic Fast-Gamedev Compo

Post by temu92 »

Surkee viritelmä mutta tässäpä näin. Pelin ideana on painella nuolinäppäimiä oikeassa kohdassa. Et vähä niinku joku tanssipeli. Ilman musiikkeja tosin :D

Code: Select all

SCREEN 800, 600

SetWindow "Fäst Däns"

Const _ARROW_UP		= 0
Const _ARROW_DOWN	= 1
Const _ARROW_LEFT	= 2
Const _ARROW_RIGHT	= 3

SetFont LoadFont("Courier New", 8)

Dim arrowData(3, 10) As String
Dim arrowImg(3)
arrowData(_ARROW_UP, 1)		= "0000110000"
arrowData(_ARROW_UP, 2)		= "0001111000"
arrowData(_ARROW_UP, 3)		= "0011111100"
arrowData(_ARROW_UP, 4)		= "0110110110"
arrowData(_ARROW_UP, 5)		= "1100110011"
arrowData(_ARROW_UP, 6)		= "0000110000"
arrowData(_ARROW_UP, 7)		= "0000110000"
arrowData(_ARROW_UP, 8)		= "0000110000"
arrowData(_ARROW_UP, 9)		= "0000110000"
arrowData(_ARROW_UP, 10)	= "0000110000"

arrowData(_ARROW_DOWN, 1)	= "0000110000"
arrowData(_ARROW_DOWN, 2)	= "0000110000"
arrowData(_ARROW_DOWN, 3)	= "0000110000"
arrowData(_ARROW_DOWN, 4)	= "0000110000"
arrowData(_ARROW_DOWN, 5)	= "0000110000"
arrowData(_ARROW_DOWN, 6)	= "1100110011"
arrowData(_ARROW_DOWN, 7)	= "0110110110"
arrowData(_ARROW_DOWN, 8)	= "0011111100"
arrowData(_ARROW_DOWN, 9)	= "0001111000"
arrowData(_ARROW_DOWN, 10)	= "0000110000"

arrowData(_ARROW_LEFT, 1)	= "0000100000"
arrowData(_ARROW_LEFT, 2)	= "0001100000"
arrowData(_ARROW_LEFT, 3)	= "0011000000"
arrowData(_ARROW_LEFT, 4)	= "0110000000"
arrowData(_ARROW_LEFT, 5)	= "1111111111"
arrowData(_ARROW_LEFT, 6)	= "1111111111"
arrowData(_ARROW_LEFT, 7)	= "0110000000"
arrowData(_ARROW_LEFT, 8)	= "0011000000"
arrowData(_ARROW_LEFT, 9)	= "0001100000"
arrowData(_ARROW_LEFT, 10)	= "0000100000"

arrowData(_ARROW_RIGHT, 1)	= "0000010000"
arrowData(_ARROW_RIGHT, 2)	= "0000011000"
arrowData(_ARROW_RIGHT, 3)	= "0000001100"
arrowData(_ARROW_RIGHT, 4)	= "0000000110"
arrowData(_ARROW_RIGHT, 5)	= "1111111111"
arrowData(_ARROW_RIGHT, 6)	= "1111111111"
arrowData(_ARROW_RIGHT, 7)	= "0000000110"
arrowData(_ARROW_RIGHT, 8)	= "0000001100"
arrowData(_ARROW_RIGHT, 9)	= "0000011000"
arrowData(_ARROW_RIGHT, 10)	= "0000010000"

Dim bgImg(30, 1)
For i=1 To 30
	bgImg(i, 0)	= MakeImage(40, 1)
	
	For x=0 To 39
		DrawToImage bgImg(i, 0)
			Color (255 - x*Rnd(0.7, 0.8)) * Cos(x*4), (180 + x*Rnd(1.45, 1.55)) * Sin(i*3), 0
			Dot x, 0
		DrawToScreen
	Next x
	
	bgImg(i, 1)	= i
Next i

For i=0 To 3
	arrowImg(i)		= MakeImage(10, 10)
	DrawToImage arrowImg(i)
		For y=1 To 10
			For x=1 To 10
				char$	= Mid(arrowData(i, y), x, 1)
				If char$ = 1 Then
					Color 255, 255, 255
					Dot x-1, y-1
				Else
					Color 0, 0, 0
					Dot x-1, y-1
				EndIf
			Next x
		Next y
	DrawToScreen
	
	MaskImage arrowImg(i), 0, 0, 0
Next i

Dim gameData As String
objs	= Rand(100, 200)
For i=0 To objs
	gameData	= gameData + "0"
	For l=0 To Rand(2, 5)
		gameData	= gameData + Str(Rand(1, 4))
	Next l
Next i

Global screenImg
screenImg	= MakeImage(40, 30)

old1		= -5

score		= 0
waittime	= 60

iLine		= MakeImage(1, 20)
DrawToImage iLine
	Color 255, 255, 255
	Line 0, 0, 0, 20
DrawToScreen

iBox		= MakeImage(40, 10)
DrawToImage iLine
	Color 0, 0, 0
	Box 0, 0, 40, 10
DrawToScreen

Repeat
	DrawToImage screenImg
		For i=1 To 30
			DrawImage bgImg(i, 0), bgImg(i, 1), i-1
			DrawImage bgImg(i, 0), bgImg(i, 1)-40, i-1
			
			bgImg(i, 1)	= bgImg(i, 1) - 1
			If bgImg(i, 1) < 0 Then bgImg(i, 1) = 40
		Next i
		
		Color 255, 255, 255
		DrawImage iLine, 20, 0', 0, 70
		Line 0, 20, 40, 20
		DrawGhostImage iBox, 0, 20, 0, 40
		
		curArrow	= Mid(gameData, position + 1, 1)
		arrow		= False
		If curArrow > 0 Then
			curArrow	= curArrow - 1
			arrow		= True
		EndIf
		If arrow Then DrawImage arrowImg(curArrow), arrowpos, 5
		
		If old1 > -5 Then
			curArrow	= Mid(gameData, position, 1)
			arrow		= False
			If curArrow > 0 Then
				curArrow	= curArrow - 1
				arrow		= True
			EndIf
			If arrow Then DrawGhostImage arrowImg(curArrow), old1, 5, 0, old1opa
		EndIf
		
		Color 255, 255, 255
		Text 1, (30 - TextHeight(score))*-1, score
	DrawToScreen
	
	dotX - 1
	If dotX < 0 Then dotX = 40
	
	If arrowpos < 14 Then
		old2 	= old1
		old1	= arrowpos
		old1opa	= 100
		position + 1
		If position Mod 5 = 0 And waittime > 15 Then waittime	= waittime - 2
		
		arrowpos	= 45
	EndIf
	
	If Timer() > liike + waittime Then
		arrowpos - 1
		
		old1 - 1
		old1opa		= old1opa - 5
		
		liike	= Timer()
	EndIf
	
	pressed		= -1
	If KeyHit(200) Then pressed		= _ARROW_UP
	If KeyHit(208) Then pressed		= _ARROW_DOWN
	If KeyHit(203) Then pressed		= _ARROW_LEFT
	If KeyHit(205) Then pressed		= _ARROW_RIGHT
	
	If pressed >= 0 Then
		If arrowpos > 15 And arrowpos < 25 And curArrow = pressed Then
			score + 1
		Else
			If score > 0 Then score - 1
		EndIf
	EndIf
	
	Lock Image(screenImg)
	For y=0 To 29
		For x=0 To 39
			PickImageColor2 screenImg, x, y
			Box x*20, y*20, 20, 20, True
		Next x
	Next y
	Unlock Image(screenImg)
	
	DrawScreen
	ClearScreenImage()
Forever

Function ClearScreenImage()
	DrawToImage screenImg
		Color 0, 0, 0
		Box 0, 0, 40, 30, True
	DrawToScreen
EndFunction

Last edited by temu92 on Fri Aug 01, 2008 9:35 pm, edited 1 time in total.
Joxi
Newcomer
Posts: 23
Joined: Sun Aug 26, 2007 5:40 pm
Location: Kuopio
Contact:

Re: CoolBasic Fast-Gamedev Compo

Post by Joxi »

Jäi surullisesti kesken. Ja kiireessä koodikin on vähän rumaa ja keskeneräistä ja purkkaa :P
Ei ehditty tehdä enempää maita saatika viimeistellä. Jälki oli kuitenkin melkein toivottua.

Atomimallilta ja Joxilta siis.

Code: Select all

SCREEN 200,150
SCREEN 40,30,0,2
'SetWindow "",3
Global curmap

sw = 39
sh = 29

Dim map(10,100) As String
map(1,0)="###############"
map(1,1)="###############"
map(1,2)="#             #"
map(1,3)="#      ##     #"
map(1,4)="#      #      #"
map(1,5)="#            ##"
map(1,6)="#             #"
map(1,7)="#  #          #"
map(1,8)="#  R          #"
map(1,9)="###############"


map(2,0)="###############"
map(2,1)="###############"
map(2,2)="#             #"
map(2,3)="#      ##     #"
map(2,4)="#      #      #"
map(2,5)="#            ##"
map(2,6)="#             #"
map(2,7)="#  #          #"
map(2,8)="#  R          #"
map(2,9)="###############"




px#=3
py#=3
pk=40
vauhti#=0
askel#=0.1

nextlevel()

Repeat
    vauhti=vauhti=0.9
    vauhti=vauhti+0.2*MouseDown(1)-0.2*MouseDown(2)
    pk=pk+MouseMoveX()*4
    bx#=px+Cos(pk)*vauhti
    by#=py+Sin(pk)*vauhti

    //If abs(px-Int(px))<(vauhti*1.1) And Mid(map(curmap,RoundDown(py)),RoundDown(px),1)<>" " Then
    //    py=Int(py)
    //ElseIf Mid(map(curmap,RoundDown(py)),RoundDown(px),1)<>" " 
    //    px=Int(px)
    //EndIf
    
    If Mid(map(curmap,RoundDown(by)),RoundDown(bx),1)=" " Then
        px=bx
        py=by
    EndIf
    
    if Mid(map(curmap,RoundDown(by)),RoundDown(bx),1)="R" Then nextlevel()


    PositionMouse 20,15
    Lock SCREEN()
    For x=0 To sw
        kk=x*1.5-20+pk
        kx#=px
        ky#=py
        char$=" "
        dist#=0
        Repeat 
            kx=kx+Cos(kk)*askel
            ky=ky+Sin(kk)*askel
            char$=Mid(map(curmap,RoundDown(ky)),RoundDown(kx),1)
        Until char<>" "
        dist#=Distance(px,py,kx,ky)
        
        skorkeus#=15.0/dist
        alku=Max(0,sh/2.0-skorkeus-1)
        For y=alku To min(30,sh/2.0+skorkeus)
            
            col=Max(0,Min(255,Int((Abs(Int(kx)-kx)+Abs(Int(ky)-ky)+1-(y-alku)/skorkeus)*255)))+Max(0,Min(255,255-Int((Abs(Int(kx)-kx)+Abs(Int(ky)-ky)+1-(y-alku)/skorkeus)*255))) Shl 16
            If char="R" Then col=200 Shl 8
            PutPixel2 x,y,col
        Next y
    Next x
    Unlock()
    //Text 0,0, Mid(map(curmap,RoundDown(py)),RoundDown(px),1)
    SetWindow "FPS:"+FPS()
    DrawScreen
Forever

Function nextlevel()
    curmap+1
    ClsColor cbblue
    Repeat 
        Text 0,0,"Lvl:"
        Text 0,15,curmap
        DrawScreen
    Until GetKey()
    ClsColor cbdark

EndFunction
EDIT:

plöp meni vääriin tageihin niin vääristyi

Lopullinen:

Code: Select all

SCREEN 200,150
SCREEN 40,30,0,2
'SetWindow "",3
Global curmap

sw = 39
sh = 29

Dim map(10,100) As String
map(1,0)="###############"
map(1,1)="###############"
map(1,2)="#             #"
map(1,3)="#      ##     #"
map(1,4)="#      #      #"
map(1,5)="#            ##"
map(1,6)="#             #"
map(1,7)="#  #          #"
map(1,8)="#  R          #"
map(1,9)="###############"


map(2,0)="###############"
map(2,1)="###############"
map(2,2)="#             #"
map(2,3)="#      ##     #"
map(2,4)="#      #    ###"
map(2,5)="#           #R#"
map(2,6)="# ###       # #"
map(2,7)="#  #          #"
map(2,8)="#      ##     #"
map(2,9)="###############"

map(3,0)="###############"
map(3,1)="###############"
map(3,2)="#     R#      #"
map(3,3)="#      ##   # #"
map(3,4)="#      #    # #"
map(3,5)="#           # #"
map(3,6)="# ###       ###"
map(3,7)="#  #          #"
map(3,8)="#      ##     #"
map(3,9)="###############"


map(4,0)="###############"
map(4,1)="###############"
map(4,2)="#  #    #   R #"
map(4,3)="#       #  ## #"
map(4,4)="#     ###     #"
map(4,5)="#             #"
map(4,6)="# ###   #   # #"
map(4,7)="#  #          #"
map(4,8)="#      ##     #"
map(4,9)="###############"

map(5,0)="###############"
map(5,1)="###############"
map(5,2)="#  #    ##    #"
map(5,3)="#     ####    #"
map(5,4)="#     #  ##  ##"
map(5,5)="#             #"
map(5,6)="# ###   #  ## #"
map(5,7)="#  #  #     # #"
map(5,8)="#R    ###     #"
map(5,9)="###############"





px#=3
py#=3
pk=40
vauhti#=0
askel#=0.1

nextlevel()

Repeat
    vauhti=vauhti=0.9
    vauhti=vauhti+0.2*MouseDown(1)-0.2*MouseDown(2)
    pk=pk+MouseMoveX()*4
    bx#=px+Cos(pk)*vauhti
    by#=py+Sin(pk)*vauhti

    //If abs(px-Int(px))<(vauhti*1.1) And Mid(map(curmap,RoundDown(py)),RoundDown(px),1)<>" " Then
    //    py=Int(py)
    //ElseIf Mid(map(curmap,RoundDown(py)),RoundDown(px),1)<>" " 
    //    px=Int(px)
    //EndIf
    
    If Mid(map(curmap,RoundDown(by)),RoundDown(bx),1)=" " Then
        px=bx
        py=by
    EndIf
    
    if Mid(map(curmap,RoundDown(by)),RoundDown(bx),1)="R" Then nextlevel()


    PositionMouse 20,15
    Lock SCREEN()
    For x=0 To sw
        kk=x*1.5-20+pk
        kx#=px
        ky#=py
        char$=" "
        dist#=0
        Repeat 
            kx=kx+Cos(kk)*askel
            ky=ky+Sin(kk)*askel
            char$=Mid(map(curmap,RoundDown(ky)),RoundDown(kx),1)
        Until char<>" "
        dist#=Distance(px,py,kx,ky)
        
        skorkeus#=15.0/dist
        alku=Max(0,sh/2.0-skorkeus-1)
        For y=alku To min(30,sh/2.0+skorkeus)
            
            col=Max(0,Min(255,Int((Abs(Int(kx)-kx)+Abs(Int(ky)-ky)+1-(y-alku)/skorkeus)*255)))+Max(0,Min(255,255-Int((Abs(Int(kx)-kx)+Abs(Int(ky)-ky)+1-(y-alku)/skorkeus)*255))) Shl 16
            If char="R" Then col=200 Shl 8
            PutPixel2 x,y,col
        Next y
    Next x
    Unlock()
    //Text 0,0, Mid(map(curmap,RoundDown(py)),RoundDown(px),1)
    SetWindow "FPS:"+FPS()
    DrawScreen
Forever

Function nextlevel()
    curmap+1
    If curmap=6 Then the_end()
    ClsColor cbblue
    Repeat 
        Text 0,0,"Lvl:"
        Text 0,15,curmap
        DrawScreen
    Until GetKey()
    ClsColor cbdark

EndFunction

Function the_end()
Repeat
Lock SCREEN()
    For x=0 To 39
    For y=0 To 29
    PutPixel2 x,y,Rand(100,150) +Rand(100,150)Shl 8+Rand(100,150)Shl 16
    Next y
    Next x
    Unlock()
    Text 0,0,"The"
    Text 0,15,"End"
    DrawScreen
Forever
EndFunction 
Last edited by Joxi on Fri Aug 01, 2008 10:00 pm, edited 3 times in total.
Image
User avatar
CCE
Artist
Artist
Posts: 650
Joined: Mon Aug 27, 2007 9:53 pm

Re: CoolBasic Fast-Gamedev Compo

Post by CCE »

Otin vapauden julkaista koodin myöhässä :D
Skitsotris, bugaava tetrisklooni.

Code: Select all

// Skitsotris 0.1

SCREEN 40,30,16,2

Dim Lauta(19,27)
Dim RollLaskin(0)
Dim CurrentMuoto(4,4)
Dim CurrentMuotoX(1)    // 0 = nykyinen, 1 =  vanha
Dim CurrentMuotoY(1)
Dim Score(0)

    Const LautaOffsetx = 11
Const LautaOffsety = 1
Const TOTALMUODOT = 2



    PutBlock(Rand(TOTALMUODOT))
   //  alkushit()
Repeat
ClsColor Rand(64),Rand(64),Rand(64)
    CurrentMuotoX(1) = CurrentMuotoX(0)
    CurrentMuotoX(1) = CurrentMuotoX(0)
    // Text 0,0,"HEI"
    RollPlot(59)
    LiikutaMuotoa()
        checkmuotoover()
    drawmuoto()
    drawlauta()
    checkmuotohit()
    checkmuotohitside()

    
        CheckFail()
        // Debug ;)
        Text 0,0,Score(0)   

    DrawScreen

Forever

Function DrawLauta()
    Color cbwhite
    Box lautaoffsetx-1,lautaoffsety,20,29,0

    For y = 0 To 27
    For x = 0 To 9
        If Lauta(x,y) > 0 Then 
            savy = Lauta(x,y)
            CorrectColor(savy) // haetaan oikea värisävy

            Dot x*2+lautaoffsetx,y+lautaoffsety
            Dot x*2+lautaoffsetx+1,y+lautaoffsety
        EndIf
    Next x
    Next y
EndFunction

Function ClearBlock()
    For y = 0 To 4
    For x = 0 To 4
        CurrentMuoto(x,y) = 0
    Next x
    Next y
EndFunction

Function PutBlock(nimi)
    ClearBlock()
    Select nimi
        Case 0
            PutPlot2(0,0,1)
            PutPlot2(1,0,1)
            PutPlot2(0,1,1)
            PutPlot2(1,1,1)
        Case 1
            PutPlot2(0,0,2)
            PutPlot2(1,0,2)
            PutPlot2(2,0,2)
            PutPlot2(2,1,2)
        Case 2
            PutPlot2(0,0,1)           
            PutPlot2(0,1,1)
            PutPlot2(0,2,1)
    End Select
EndFunction

Function PutPlot(x,y,arvo)
    Lauta(x,y) = arvo
EndFunction

Function PutPlot2(x,y,arvo)
    CurrentMuoto(x,y) = arvo
EndFunction

Function RollPlot(speed)
    If RollLaskin(0) > 1 Then
        RollLaskin(0) = RollLaskin(0) - 1
    Else
       //  For y = 26 To 0 Step -1
       //  For x = 0 To 9
       //     if not y=0 then Lauta(x,y) = Lauta(x,y-1)
        //Next x
       // Next y
       CurrentMuotoY(0) = CurrentMuotoY(0) + 1
     RollLaskin(0) = speed
     CheckLine()
    EndIf
EndFunction

Function RollPlot2()
        For y = 0 To 26 
        For x = 0 To 9
            If y < 26 Then  Lauta(x,y+1) = Lauta(x,y)
        Next x
        Next y
        
            For i = 0 To 10
                Lauta(i, 0) = 0
                // End
            Next i

EndFunction

Function CorrectColor(savy)
            Select savy
            Case 0
             Color Rand(128),Rand(128),Rand(128)   
                Case 1
             Color Rand(128),Rand(255),Rand(128)              
                Case 2
              Color Rand(255),Rand(255),Rand(128)   
            End Select
EndFunction

Function DrawMuoto()
    For y = 0 To 4
    For x = 0 To 4
        If CurrentMuoto(x,y) > 0 Then 
            savy = currentMuoto(x,y)
            CorrectColor(savy) // haetaan oikea värisävy

            Dot (x+CurrentMuotoX(0))*2+lautaoffsetx,(y+CurrentMuotoY(0))+lautaoffsety
            Dot (x+CurrentMuotoX(0))*2+lautaoffsetx+1,(y+CurrentMuotoY(0))+lautaoffsety
        EndIf
    Next x
    Next y
EndFunction

Function LiikutaMuotoa()
    If KeyHit(cbkeyleft) Then
        CurrentMuotoX(0) = CurrentMuotoX(0) - 1
    EndIf
       If KeyHit(cbkeyright) Then
        CurrentMuotoX(0) = CurrentMuotoX(0) + 1
    EndIf
       If KeyDown(cbkeydown) Then
        CurrentMuotoY(0) = CurrentMuotoY(0) + 1
    EndIf
       If KeyHit(cbkeyup) Then
      //   CurrentMuotoY(0) = CurrentMuotoY(0) - 1
    EndIf
    
// tarkistukset    
    // If CurrentMuotoX(0) < 0 Then CurrentMuotoX(0) = 0
    // If CurrentMuotoX(0) > 7 Then CurrentMuotoX(0) = 7
    If CurrentMuotoY(0) > 25 Then 
        ResetMuoto()

    EndIf
EndFunction

Function AlkuShit()
    PutPlot(1,27,1) 
EndFunction

Function Muoto2Plot()
    For y = 0 To 4
    For x = 0 To 4
        If CurrentMuoto(x,y) > 0 Then 
            Color Rand(255),Rand(255),Rand(255)
            Lauta(x+CurrentMuotoX(0),y+CurrentMuotoY(0)) = CurrentMuoto(x,y)

        EndIf
    Next x
    Next y
EndFunction

Function CheckMuotoHit()
    For y = 0 To 4
    For x = 0 To 4
        If CurrentMuoto(x,y) > 0 Then 
            If Lauta(x+CurrentMuotoX(0),y+CurrentMuotoY(0)+1) <> 0 Then
                ResetMuoto()
                Return 1
            EndIf

        EndIf
    Next x
    Next y
EndFunction

Function CheckMuotoHitSide()
    For y = 0 To 4
    For x = 0 To 4
        If CurrentMuoto(x,y) > 0 Then 
            If x > 0 Then 
                If Lauta(x+CurrentMuotoX(0)-1,y+CurrentMuotoY(0)) <> 0 Then
                    CurrentMuotoX(0) = CurrentMuotoX(1)
                    // Return 1
                EndIf
            EndIf
            If x<19 Then
                If Lauta(x+CurrentMuotoX(0)+1,y+CurrentMuotoY(0)) <> 0 Then
                    CurrentMuotoX(0) = CurrentMuotoX(1)
                    // Return 1
                EndIf
            EndIf

        EndIf
    Next x
    Next y
EndFunction

Function CheckMuotoOver()
    For y = 0 To 4
    For x = 0 To 4
        If CurrentMuoto(x,y) > 0 Then 
            If x+CurrentMuotoX(0) > 8 Then
                CurrentMuotoX(0) = CurrentMuotoX(0) - 1
            EndIf
            If x+CurrentMuotoX(0) < 0 Then
                CurrentMuotoX(0) = CurrentMuotoX(0) + 1
            EndIf

        EndIf
    Next x
    Next y
EndFunction

Function ResetMuoto()
    Muoto2Plot()
    PutBlock(Rand(TOTALMUODOT))
    CurrentMuotoY(0) = 0
EndFunction

Function CheckFail()
    If CurrentMuotoY(0) = 0 And CheckMuotoHit() = 1 Then
        MakeError "FAIL"
    EndIf
EndFunction

Function CheckLine()
    For y = 0 To 27
    counter = 0
    For x = 0 To 19
        If Lauta(x,y) <> 0 Then counter = counter + 1
        If counter = 9 Then
            For i = 0 To 10
                Lauta(i, 27) = 0
                // End
            Next i
            RollPlot2()
            Score(0) = Score(0) + 1
            Exit
        EndIf
    Next x
    Next y
EndFunction
Saisinko tiedustella miksi tähän kilpailuun hyväksytään vain CB miitin jäsenet? Osallistuisin näihin kilpailuihin nimittäin mielelläni.
Siitä yksinkertaisesta syystä että he olivat paikalla, jotenkin fast-kompojen henkeen vain kuuluu se että osaanottajat ovat henkilökohtaisesti paikalla.

Edit: Miten olis vielä 30min viimeistelyvenytys? :D Sitten kerääntyisimme jonnekkin katselemaan hurjat koodimme yhdessä.
Last edited by CCE on Fri Aug 01, 2008 9:33 pm, edited 1 time in total.
Ozcar
Advanced Member
Posts: 439
Joined: Mon Aug 27, 2007 8:43 pm
Location: Helsinki

Re: CoolBasic Fast-Gamedev Compo

Post by Ozcar »

Näyttääpi siltä, ettei Fast-gamedevissä kannata mitään turhan vaikeaa alkaa pykäämään. Simppeli on päivän sana, kun aikaa ei ole turhan paljon. Harmi, tässä kisassa oli mainio idea.

Ensi kerralla saatte minulta sen tekstiseikkailun, jota selataan kirjain kerrallaan! =D

Edit: Ajanpidennystä kannatetaan, vaikkakaan turhan toiveikas omien mahdollisuuksieni suhteen en ole =P.
Ratkaisit juuri universaaliongelman! Hienoa, ota keksi.

Filosofia on ajattelun taidetta, mutta sen maalari elää juoden apurahojaan masennukseensa.
temu92
Web Developer
Web Developer
Posts: 1226
Joined: Mon Aug 27, 2007 9:56 pm
Location: Gamindustri
Contact:

Re: CoolBasic Fast-Gamedev Compo

Post by temu92 »

Ozcar wrote:Ensi kerralla saatte minulta sen tekstiseikkailun, jota selataan kirjain kerrallaan! =D
Järjestetääks huomenna joku extreme game compo. Et ois aikaa vähä enemmän tehä ja reso ois vaik 80x60 :D
Ozcar
Advanced Member
Posts: 439
Joined: Mon Aug 27, 2007 8:43 pm
Location: Helsinki

Re: CoolBasic Fast-Gamedev Compo

Post by Ozcar »

Ihmettä, tästä voi jopa tulla jotain! Ei ehkä aikarajan puitteissa, mutta muuten.. näkee sitten. Ikku-pikku muokkauksella peli muuttui tylsästä pirullisen haastavaksi >=D 50 vihua aiheuttavat paaaljon enemmän stressiä kuin 1. Stay tuned.

Update: pelin alkuperäinen suunnitelma alkaa pikkuhiljaa toimia. Jos koodi ei pysy kasassa purkalla, ei se pysy sitten millään =D!
Update2: peli on siinä kunnosa kuin haluan!! Kohta pulttaan koodin kiinni, kunhan hion vielä pikkuisen kulmia pyöreämmiksi
Last edited by Ozcar on Fri Aug 01, 2008 10:18 pm, edited 2 times in total.
Ratkaisit juuri universaaliongelman! Hienoa, ota keksi.

Filosofia on ajattelun taidetta, mutta sen maalari elää juoden apurahojaan masennukseensa.
User avatar
CCE
Artist
Artist
Posts: 650
Joined: Mon Aug 27, 2007 9:53 pm

Re: CoolBasic Fast-Gamedev Compo

Post by CCE »

Jaa-a, viimeistelyn tuloksena oma koodini ryhtyi mavittamaan, joten se siitä sitten :D
Katsokaa vain tuota vanhaa versiota, toivottavasti saamme kisan vihdoin päätökseen ja jonkinlaisen katselmuksen järjestettyä. Alustavasti paikka olisi jossain tuolla joxin/atomimallin lähistöllä.
Ozcar
Advanced Member
Posts: 439
Joined: Mon Aug 27, 2007 8:43 pm
Location: Helsinki

Re: CoolBasic Fast-Gamedev Compo

Post by Ozcar »

Noniin, aikaraja ylittyi puolella tunnilla, mutta laitan silti nyt virallisesti valmiin tekeleeni tänne tyrkylle.

Code: Select all

'CODE BY OZCAR

start:

FrameLimit 40
SCREEN 40,30,32,2

Type VIHUT
 Field tyyppi
 Field vihux
 Field vihuy
 Field xliike
 Field yliike
 Field elossa
 Field ajastin
 Field syntyy
End Type

herox = 20
heroy = 15

punvah = 0
vihota = 0

tappoym = 0
tappoymp = 0
kasvukerroin = 1

R = 225
G = 225
B = 225

For a = 1 To 2
 vihu.VIHUT = New(VIHUT)
 vihu\tyyppi = a
 arvoco:
 vihu\vihux = Rand(2,37)
 vihu\vihuy = Rand(2,27)
  If vihu\vihux > herox - 5 And vihu\vihux < herox + 5 And vihu\vihuy > heroy - 5 And vihu\vihuy < heroy + 5 Then
   Goto arvoco
  EndIf
 arvoliike:
 vihu\xliike = Rand(-1,1)
 vihu\yliike = Rand(-1,1)
 If vihu\xliike = 0 Or vihu\yliike = 0 Then
  Goto arvoliike
 EndIf
 vihu\syntyy = 0
 vihu\elossa = 0
 vihu\ajastin = 0
Next a

uusipun = 0

Repeat

ClsColor 0,0,0
Color 225,225,225

Box 0,0,40,30,0

If ajastin > 2 Then
 If KeyDown(208) Then
  heroy + 1
 EndIf
 If KeyDown(200) Then
  heroy - 1
 EndIf
 If KeyDown(203) Then
  herox - 1
 EndIf
 If KeyDown(205) Then
  herox + 1
 EndIf
 ajastin = 0
EndIf
ajastin + 1

If herox > 38 Then 
 herox - 1
ElseIf herox < 1 Then
 herox + 1
ElseIf heroy < 1 Then
 heroy + 1
ElseIf heroy > 28 Then
 heroy - 1
EndIf

For vihu.VIHUT = Each VIHUT
 Select vihu\tyyppi
  Case 1
   Color 0,225,0
   Dot vihu\vihux,vihu\vihuy
   If vihu\ajastin > 2 Then
    vihu\vihux + vihu\xliike
    vihu\vihuy + vihu\yliike
     If vihu\vihux < 2 Then 
      vihu\xliike = vihu\xliike * -1 
     EndIf
     If vihu\vihux > 37 Then 
      vihu\xliike = vihu\xliike * -1
     EndIf
     If vihu\vihuy < 2 Then
      vihu\yliike = vihu\yliike * -1 
     EndIf
     If vihu\vihuy > 27 Then
      vihu\yliike = vihu\yliike * -1 
     EndIf 
    vihu\ajastin = 0
   EndIf    
   vihu\ajastin + 1
   If vihu\vihux > herox - 1 And vihu\vihux < herox + 1 Then
    If vihu\vihuy > heroy - 1 And vihu\vihuy < heroy + 1 Then
     If vihota < 1
      R - 25
      B - 25
      G + 15
      vihota = FPS() 
     EndIf
     If R < 1 Then
      R = 0
     EndIf
     If B < 1 Then
      B = 0
     EndIf 
     If G > 225 Then
      G = 225
     EndIf
    EndIf
   EndIf 
   vihota -1
  Case 2
   Color 225,0,0
   Dot vihu\vihux,vihu\vihuy
   If vihu\ajastin > 2 Then
    vihu\vihux + vihu\xliike
    vihu\vihuy + vihu\yliike
     If vihu\vihux < 2 Then 
      vihu\xliike = vihu\xliike * -1 
     EndIf
     If vihu\vihux > 37 Then 
      vihu\xliike = vihu\xliike * -1
     EndIf
     If vihu\vihuy < 2 Then
      vihu\yliike = vihu\yliike * -1 
     EndIf
     If vihu\vihuy > 27 Then
      vihu\yliike = vihu\yliike * -1 
     EndIf 
    vihu\ajastin = 0
   EndIf    
   vihu\ajastin + 1
   If vihu\vihux > herox - 1 And vihu\vihux < herox + 1 Then
    If vihu\vihuy > heroy - 1 And vihu\vihuy < heroy + 1 Then
     If punvah < 1 Then
      B - 25
      G - 25
      R + 35
      punvah = FPS()
     EndIf
     If G < 1 Then
      G = 0
     EndIf
     If B < 1 Then
      B = 0
     EndIf 
     If R > 225 Then
      If B < 1
       If G < 1
        Goto loppu
       EndIf
      EndIf 
     EndIf
    EndIf
   EndIf 
   punvah - 1
 End Select
Next vihu.VIHUT

Color R,G,B
Dot herox,heroy

If KeyHit(57) Then
 If G > 1 Then
  If G > 30 Then
   G = 30
  EndIf 
  tappoym = G
  G = 0
 EndIf 
EndIf

If tappoym > 0 Then 
 tappoymp + 1 
 Color 0,150,0
 If tappoymp > tappoym Then 
  kasvukerroin = -1
 EndIf
 If kasvukerroin = -1 Then
  tappoymp - 2
 EndIf
 Circle herox - tappoymp/2, heroy - tappoymp/2,tappoymp,0
 For vihu.VIHUT = Each VIHUT
  If vihu\tyyppi = 2
   If vihu\vihux > herox Then
    If vihu\vihuy > heroy Then
     If vihu\vihux - herox < tappoymp/2 Then
      If vihu\vihuy - heroy < tappoymp/2 Then
       Delete vihu.VIHUT
      EndIf
     EndIf
    EndIf
   EndIf
   If vihu\vihux < herox Then
    If vihu\vihuy > heroy Then
     If herox - vihu\vihux < tappoymp/2 Then
      If vihu\vihuy - heroy < tappoymp/2 Then
       Delete vihu.VIHUT
      EndIf
     EndIf
    EndIf
   EndIf
   If vihu\vihux > herox Then
    If vihu\vihuy < heroy Then
     If vihu\vihux - herox < tappoymp/2 Then
      If heroy - vihu\vihuy < tappoymp/2 Then
       Delete vihu.VIHUT
      EndIf
     EndIf
    EndIf
   EndIf
   If vihu\vihux < herox Then
    If vihu\vihuy < heroy Then
     If herox - vihu\vihux < tappoymp/2 Then
      If heroy - vihu\vihuy < tappoymp/2 Then
       Delete vihu.VIHUT
      EndIf
     EndIf
    EndIf
   EndIf
  EndIf
 Next vihu.VIHUT
 If tappoymp < 2 And kasvukerroin = -1 Then
  tappoymp = 0
  tappoym = 0
  kasvukerroin = 1
 EndIf
EndIf
   
   
 

If uusipun = 80 Then
 vihu.VIHUT = New(VIHUT)
 vihu\tyyppi = 2
 vihu\vihux = Rand(2,37)
 vihu\vihuy = Rand(2,27)
  If vihu\vihux > herox - 5 And vihu\vihux < herox + 5 And vihu\vihuy > heroy - 5 And vihu\vihuy < heroy + 5 Then
   Goto arvoco
  EndIf
 arvoliike:
 vihu\xliike = Rand(-1,1)
 vihu\yliike = Rand(-1,1)
 If vihu\xliike = 0 Or vihu\yliike = 0 Then
  Goto arvoliike
 EndIf
 uusipun = 0
EndIf

uusipun + 1
 

DrawScreen
Forever 

loppu:
Color 225,225,225
arial = LoadFont("arial",12) 
SetFont arial
Text 5,3,"FAIL!"
Text 5,10,"Retry?"
Text 5,18,"Y/N"

DrawScreen
paina:
WaitKey 
If KeyDown(21) Then
 For vihu.VIHUT = Each VIHUT
  Delete(vihu.VIHUT)
 Next vihu.VIHUT
 Goto start
ElseIf KeyDown(49) Then
 Goto pois
EndIf
Goto paina
pois:
Jotta siinä se, kaikessa komeudessaan. Tiukan tilanteen tullen spacea näpäyttämällä saa ympärilleen räjähdyksen, joka pyyhkäisee kaikki tielleen tulevat punaiset pallurat mennessään. Tosin tämän taidon käyttäminen vie kaiken vihreytesi nollaan, jota sinun täytyy ladata lisää osumalla vihreään palloon. Maksimiräjähdysaalto ladataan valmiiksi osumalla vihreään palloon kahdesti, mutta osumat lasketaan vain kerran sekunnissa, eli vihreän pallon päällä majailu ei auta ketään kuin sekunnin välein. Ja punaiseen osuminen paitsi vie elinvoimaasi (jota saat lisää vihreistä palloista. Tavoite on selvitä muuttumatta täysin punaiseksi itse), myös haukkaa reilun siivun vihreys-pommivoimaasi.

Sekavista selityksistä huolimatta, nauttikaa!
Ratkaisit juuri universaaliongelman! Hienoa, ota keksi.

Filosofia on ajattelun taidetta, mutta sen maalari elää juoden apurahojaan masennukseensa.
User avatar
-Z-
Devoted Member
Posts: 682
Joined: Tue Aug 28, 2007 3:33 pm
Location: In ur danmaku, grazin ur bullets

Re: CoolBasic Fast-Gamedev Compo

Post by -Z- »

Itse olen kovasti tämän toisen kompon kannalla. Tähänkin olin osallistumassa, mutta koska halusin hommaan vähän haastetta ( : DDDD ) päätin ensimmäistä kertaa tehdä pelin kokonaan ilman objekteja (siis kuvia käyttäen). Kuten arvata saattaa, monet mystiset bugit jumittivat homman loppumetreille, ja menin teeäffään angstaamaan. Sitten tulin foorumille kurkkimaan ja kas, kisa-aikaa olisi pidennetty vielä vaikka kuinka. Stna. Joku vähän löyhempi aikaraja olisi kyllä asiaa mahdolliseen seuraavaan kompoon.
"Fallout 3 (#10) marked a shift in the industry, a move that saw the western RPG begin to surpass its Japanese counterparts." -IGN top 100 RPGs of all time
Post Reply