Point Lighting an Image

[kevin]

  Point Lighting an Image

  This takes the input image,  grabs the colours then renders each pixel out as an 8 by 8 block.  The blocks are lit so the edges are black and the center of the block is the pixel colour.  Gives a neat little effect.

PlayBASIC Code: [Select]

   File$="D:\Source_Codes\GFX\Animal.jpg"

   TempImage =LoadNewIMage(File$)



   Do
      Cls 255
      
      
      HandleX=(GetIMageWidth(TempIMage)/-2)*8
      HandleY=(GetIMageHeight(TempIMage)/-2)*8

      x=MouseX()
      y=Mousey()
      
      Draw_blocked TempImage,X+HAndleX,Y+HandleY
   
      Sync   
   loop




Function Draw_Blocked(ThisImage,Xpos,Ypos)

   ScreenX2=GetSCreenWidth()
   ScreenY2=GetSCreenHeight()


   ; Early reject to viewport
   if Ypos>Screeny2 then exitfunction
   if Xpos>ScreenX2 then exitfunction

   ScreenY1=0
   ScreenX1=0
   Width =GetImageWidth(ThisIMage)
   Height=GetImageHeight(ThisIMage)

   if Xpos+(Width*8)<ScreenX1 then exitfunction
   if Ypos+(Height*8)<ScreenY1 then exitfunction



   Dim Row(Width,Height)
   rendertoimage ThisIMage
      lockbuffer
      For Ylp=0 to Height-1
         thisRgb=point(0,0)
         ; read row
         For Xlp=0 to Width-1
               Row(xlp,ylp)=fastPOint(Xlp,ylp)
         next
      next
      unlockbuffer
   rendertoscreen
   

   RowStart   =0
   RowEnd      =Width-1


   ; Clip right edge         
   If (Xpos+Width*8)>ScreenX2
         DX=(ScreenX2-Xpos)
         RowEnd=DX/8         
   Endif

   ; Clip left edge
   If Xpos<ScreenX1
         DX=(ScreenX1-Xpos)
         RowStart=DX/8         
   Endif


   IF RowEnd<0 then RowEnd=0
   IF RowEnd>(Width-1) then RowEnd=Width-1
   
   
   lockbuffer
      For Ylp=0 to Height-1
         ; read row
         y1=Ypos+(Ylp*8)
         y2=y1+8
         
         if y2<ScreenY1 then Continue         
         if y1>ScreenY2 then exitfor
         
                  
         For Xlp=RowStart to RowEnd
               x1=Xpos+(Xlp*8)
               x2=x1+8
               ThisRGB=Row(xlp,ylp)
                              
               cx=x1+4
               cy=y1+4
               
               GouraudTri x1,y1,0,cx,y1,0,cx,cy,ThisRGB
               GouraudTri x2,y1,0,cx,y1,0,cx,cy,ThisRGB
                 GouraudTri x2,y1,0,x2,cy,0,cx,cy,ThisRGB
               GouraudTri x2,y2,0,x2,cy,0,cx,cy,ThisRGB
               GouraudTri x1,y1,0,x1,cy,0,cx,cy,ThisRGB
               GouraudTri x1,y2,0,x1,cy,0,cx,cy,ThisRGB
               GouraudTri x1,y2,0,cx,y2,0,cx,cy,ThisRGB
               GouraudTri x2,y2,0,cx,y2,0,cx,cy,ThisRGB
               
         next
      next
   unlockbuffer
   
EndFUnction

[kevin]

  This is a bit of extension to the previous snippet.  This one adds various 'render modes' (SPACE to change) and the ability to change the block size (UP/DOWN arrows).  

PlayBASIC Code: [Select]

   Global BlockSize =8

   File$="SOME SMALL PICTURE.bmp"

   TempImage =LoadNewIMage(File$)

   Mode=2


   Do
      Cls 255
      
      
      HandleX=(GetIMageWidth(TempIMage)/-2)*BlockSize
      HandleY=(GetIMageHeight(TempIMage)/-2)*BlockSize

      x=MouseX()
      y=Mousey()
      
      Draw_blocked TempImage,X+HAndleX,Y+HandleY,Mode
      
      ; ----------------------------------------
      ; ARROW KEYS TO ZOOM IN/OUT
      ; ----------------------------------------
      
      if Upkey() then BlockSize++
      if Downkey() then BlockSize--
      If BlockSize<3 then BlockSize=3
      If BlockSize>128 then BlockSize=128
      
       
      ; ----------------------------------------
      ; SPACE TO CHANGE MODES
      ; ----------------------------------------
      
      if Spacekey() then MOde++ : Flushkeys
      
      Select Mode
      
            case 0
               s$="Point Highlights"
            
            case 1
               s$="Block"

            case 2
               s$="Fixed size bilinear filter"

            case 3
               s$="Fliped filter"
               
            default
               Mode =0   

      endselect
      
      
      print "Mode:"+S$
      print "BlockSize:"+Str$(BlockSize)
   
      Sync   
   loop





Function Draw_Blocked(ThisImage,Xpos,Ypos,Mode=1)

   ScreenX2=GetSCreenWidth()
   ScreenY2=GetSCreenHeight()


   ; Early reject to viewport
   if Ypos>Screeny2 then exitfunction
   if Xpos>ScreenX2 then exitfunction

   ScreenY1=0
   ScreenX1=0
   Width =GetImageWidth(ThisIMage)
   Height=GetImageHeight(ThisIMage)

   if Xpos+(Width*BlockSize)<ScreenX1 then exitfunction
   if Ypos+(Height*BlockSize)<ScreenY1 then exitfunction


   Static LastIMage
   
   if LastIMage<> ThisIMage

      LastIMage=ThisIMage

      Dim Row(Width,Height)
      rendertoimage ThisIMage
         lockbuffer
         For Ylp=0 to Height-1
            thisRgb=point(0,0)
            ; read row
            For Xlp=0 to Width-1
                  Row(xlp,ylp)=fastPOint(Xlp,ylp)
            next
         next
         unlockbuffer
      rendertoscreen
   endif
      

   RowStart   =0
   RowEnd      =Width-1


   ; Clip right edge         
   If (Xpos+Width*BlockSize)>ScreenX2
         DX=(ScreenX2-Xpos)
         RowEnd=DX/BlockSize         
   Endif

   ; Clip left edge
   If Xpos<ScreenX1
         DX=(ScreenX1-Xpos)
         RowStart=DX/BlockSize         
   Endif


   IF RowEnd<0 then RowEnd=0
   IF RowEnd>(Width-1) then RowEnd=Width-1
   
   
   lockbuffer
      For Ylp=0 to Height-1
         ; read row
         y1=Ypos+(Ylp*BlockSize)
         y2=y1+BlockSize
         
         if y2<ScreenY1 then Continue         
         if y1>ScreenY2 then exitfor
         
         cy=y1+(BlockSize/2)

         Select Mode
      
            ; --------------------------------
            Case 0
            ; --------------------------------
                        
               x1=Xpos+(RowSTart*BlockSize)
               For Xlp=RowStart to RowEnd
                  x2=x1+BlockSize

Login required to view complete source code

[ATLUS]

very nice function!