Taskulamppuefekti tilekarttaan

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Taskulamppuefekti tilekarttaan

Post by MaGetzUb »

Tällaisen muokasin, mutta tämähän kusee kuin 20vuotta pidätellyt kani. Seinien taakse kun ei pitäisi pystyä näkemään ollenkaan, tässä tämä ukko vain näkee sinne puoliksi. =_= Ongelmahan johtuu siitä, koska tämä musta asetetaan laajemmalla ns. näkökentällä kuin tämä dither ("pimeä").

Code: Select all

'Täytettyihin kolmiohin ja poimintaan perustuva valoefekti CoolBasicille
'koodaillut cce 13.11.2010
'kiitokset koodajalle trifilleristä

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())
imgMask2 = MakeImage(ScreenWidth(), ScreenHeight())
MaskImage imgMask, 255, 255, 255
MaskImage imgMask2, 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
   
   DrawToImage imgMask2
   ' Täytetään maski aluksi mustalla
   Color cbBlack
   Box 0, 0, ImageWidth( imgMask2 ), ImageHeight( imgMask2 ), 1
   Color cbWhite
   
   Circle 200-circle_size/2, 150-circle_size/2, circle_size, 1
   
   Lock()

   For i=-Int(quality*0.75) To int(quality*0.75)
      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
   DrawImage imgMask2, 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
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.
User avatar
Execute
Active Member
Posts: 110
Joined: Fri Feb 11, 2011 6:41 pm

Re: Taskulamppuefekti tilekarttaan

Post by Execute »

Joku halusi näkökenttä version? Tulee:

Code: Select all

'Täytettyihin kolmiohin ja poimintaan perustuva valoefekti CoolBasicille
'koodaillut cce 13.11.2010
'kiitokset koodajalle trifilleristä
'Execute koodaili näkökenttä efektin ja puoliksi sen että enteriä painaessa valokeila häipyy.


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 KeyDown(28) Then 
    press = 1
    EndIf 
If KeyHit(28) Then 
press = 0
EndIf 
If press =  1 Then 
    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
    EndIf 
    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 200
      Dot x+(y Mod 2), y
   Next x
   Next y
      DrawToImage img
   For y = 0 To h Step 200
      DrawImage temp, 0, y
   Next y
   DrawToScreen
   Return img
EndFunction 
Jos on jotain valittamista niin antaa tulla vaan...

//Edit: Paina enteriä pohjassa niin valokeila häipyy...

//Oho äskenen teki tällasen... En huomannu. Saati matkinut.
SpaceCraft on kokopitkä peli! Nyt ladattavissa! Tsekkaa!
Post Reply