Tässä kuvankaappaus efektistä toiminnassa
Ja tässä koodi
Code: Select all
'Täytettyihin kolmiohin ja poimintaan perustuva valoefekti CoolBasicille
'koodaillut cce 13.11.2010
'kiitokset koodajalle trifilleristä
FrameLimit 40 'rajoita nopeutta
kartta = LoadMap("Media\cdm2.til","Media\tileset.bmp")
PlayObject kartta,0,0,1
ObjectPickable kartta, ON
ukko = LoadObject ("Media\guy.bmp",72)
SetupCollision ukko, kartta, 1, 4, 2
DrawToWorld False, False, False
imgMask = MakeImage(ScreenWidth(), ScreenHeight())
MaskImage imgMask, 255, 255, 255
imgDither = CreateDitherImage(ScreenWidth(), ScreenHeight())
Repeat
'Ukon ohjaus
If LeftKey() Then TurnObject ukko,5
If RightKey() Then TurnObject ukko,-5
If UpKey() Then MoveObject ukko,3
If DownKey() Then MoveObject ukko,-3
UpdateGame
CloneCameraPosition ukko
DrawGame
fov# = 90 ' valaistuksen leveys asteina
quality# = 20 ' kuinka monta kolmiota piirretään, enempi parempi
turn# = fov / quality
old_angle# = ObjectAngle(ukko)
circle_size = 40 ' ukkoa ympäröivän valoympyrän koko
DrawToImage imgMask
' Täytetään maski aluksi mustalla
Color cbBlack
Box 0, 0, ImageWidth( imgMask ), ImageHeight( imgMask ), 1
Color cbWhite
DrawImage imgDither, 0,0 ' Lisätään "läpinäkyvyys"
Circle 200-circle_size/2, 150-circle_size/2, circle_size, 1
Lock()
For i=-quality/2 To quality/2
RotateObject ukko, old_angle + i * turn
ObjectPick ukko
cam_x = -CameraX()
cam_y = CameraY()
pos_x = cam_x + 200 + PickedX()
pos_y = cam_y + 150 - PickedY()
'Line cam_x + 200 + ObjectX(ukko), cam_y + 150 -ObjectY(ukko), pos_x, pos_y
If i>(-quality/2) Then
' koodajan vauhdikas kolmiontäyttö
filltriangle( cam_x + 200 + ObjectX(ukko), cam_y + 150 - ObjectY(ukko), pos_x, pos_y, old_pos_x, old_pos_y )
EndIf
old_pos_x = pos_x ' tallennetaan nykyisen poiminnan tiedot seuraavalle kierrokselle
old_pos_y = pos_y
Next i
Unlock()
RotateObject ukko, old_angle
DrawToScreen
DrawImage imgMask, 1, 1
Text 0,0, "FPS: "+FPS()
DrawScreen
Forever
Function filltriangle(x1#, y1#, x2#, y2#, x3#, y3#)
//If x1<0 Or y1<0 Or x2<0 Or y2<0 Or x3<0 Or y3<0 Or x1>kgl_scrwidth Or x2>kgl_scrwidth Or x3>kgl_scrwidth Or y1>kgl_scrheight Or y2>kgl_scrheight Or y3>kgl_scrheight Then Return 0
Dim tmpx, tmpy, slp1#, slp2#, slp3#, i
If (y1>y2) Then
tmpy = y1
tmpx = x1
y1 = y2
x1 = x2
y2 = tmpy
x2 = tmpx
EndIf
If (y1>y3) Then
tmpy = y1
tmpx = x1
y1 = y3
x1 = x3
y3 = tmpy
x3 = tmpx
EndIf
If (y2>y3) Then
tmpy = y2
tmpx = x2
y2 = y3
x2 = x3
y3 = tmpy
x3 = tmpx
EndIf
If(y2=y1) Then y1-0.001
If(y3=y2) Then y3+0.001
slp1# = (x3-x1)/(y3-y1)
slp2# = (x2-x1)/(y2-y1)
slp3# = (x3-x2)/(y3-y2)
For i = y1 To y2
Line x1+slp1*(i-y1), i, x2+slp2*(i-y2), i
Next i
For i = y2 To y3
Line x1+slp1*(i-y1), i, x3+slp3*(i-y3), i
Next i
EndFunction
'simppeli funktio joka luo kuvan ja täyttää sen 1x1 mustavalko shakkiruudukolla
Function CreateDitherImage( w, h )
img = MakeImage( w, h )
temp = MakeImage( w, 2)
DrawToImage temp
Color cbWhite
For y = 0 To 2
For x = 0 To w Step 2
Dot x+(y Mod 2), y
Next x
Next y
DrawToImage img
For y = 0 To h Step 2
DrawImage temp, 0, y
Next y
DrawToScreen
Return img
EndFunction
Edit: Koodia optimoitu.