Creating Mip Maps

[kevin]

   This function creates a mip mapped version of the source image.  The mip mapped version is 1/2 the original size and the source pixels are blended together during the scale.  This tends to make the resulting image a better (subjective!)  representation than a linear scale.  

 

PlayBASIC Code: [Select]

   Circle 128,128,128,true
   
   getImage 1,0,0,256,256
   
   
   Cls 255
   
   Max=4

   Dim MipMaps(Max)
   Dim Scaled(Max)
   MipMaps(1)=1
   Scaled(1)=1
   




   ThisIMage=1
   For lp=2 to Max
      ; Make the mipmap from the Last image
      ThisImage=CreateMipMap(ThisImage)
      MipMaps(lp)=ThisImage

      ; make the scaled version  (scaling from the original image)
      Width      =GetImageWidth(thisImage)
      Height   =GetImageHeight(thisImage)
      
      ScaledIMage=getFreeimage()
      CopyImage 1,ScaledIMage
      Scaleimage ScaledImage,Width,height,1
      Scaled(lp)=Scaledimage


   next


   ; Draw the mip mapped + scaled versions of the images

   Xpos=100
   For lp=1 to Max
      img=MipMaps(lp)      
      drawimage Img,Xpos,20,false

      img=Scaled(lp)      
      drawimage Img,Xpos,300,false


      Xpos=Xpos+getImageWIdth(img)+16
   next


   
   sync
   waitkey
   
   





Function CreateMipMap(ThisImage)
   oldSurface=getsurface()
      if GetImageStatus(ThisImage)

      W=GetImageWidth(ThisImage)
      H=GetImageHeight(ThisImage)

      w2=w/2
      h2=h/2
      if GetimageType(ThisImage)=1 then   MipImage=NewImage(W2,h2)   
      if GetimageType(ThisImage)=2 then   MipImage=NewFXImage(W2,h2)   


      if GetImageSTatus(MipIMage)

         Dim Buffer(w,h)

         RenderToImage Thisimage
         lockbuffer
            maskcolour=point(0,0)
            For Ylp=0 to H-1
               For Xlp=0 to W-1
                     Buffer(Xlp,ylp)=FastPOint(xlp,ylp)         
               next
            next
         unlockbuffer

         rendertoimage MipImage
         imagemaskcolour mipimage,maskcolour   
         For ylp=0 to (h and $fffe)-1 step 2
            
            lockbuffer
            ThisPixel=point(0,0)
            Xpos=0
            ylp2=ylp+1
            For Xlp=0 to (W and $fffe)-1 step 2
            
               Xlp2=xlp+1
               C1=Buffer(Xlp,ylp)
               C2=Buffer(Xlp2,ylp)
               C3=Buffer(Xlp2,ylp2)
               C4=Buffer(Xlp,ylp2)
   
               r=(rgbr(c1)+rgbr(c2)+rgbr(c3)+rgbr(c4))/4
               g=(rgbg(c1)+rgbg(c2)+rgbg(c3)+rgbg(c4))/4
               b=(rgbb(c1)+rgbb(c2)+rgbb(c3)+rgbb(c4))/4
   

               FastDot Xpos,Ypos,Rgb(r,g,b)
               xpos=xpos+1
            next

            unlockbuffer
            inc ypos            
         next

         undim Buffer()

      endif   
 endif
   rendertoimage oldsurface 
EndFunction   MipImage
   
   

[kevin]

  Here's a version that has alpha support and and uses the file dialog

PlayBASIC Code: [Select]

openscreen 1280,840,32,1

; Include the Dialogs library in this program
  #Include "PBDialogs2"

 
; Title Of the Dialog
  Filename$="Some Cool FIle.txt"
   Filter$ ="(*.Images)|*.JPG;*.bmp;*.PNG;*tga"   ; Mixture of image files
; Call the dialog
  File$=OpenFileDialog("Load Image",Filename$,Filter$)
  
   if fileexist(file$)  


      loadimage file$,1,8

   
   
      Cls 255
   
      Max=4

      Dim MipMaps(Max)
      Dim Scaled(Max)
      MipMaps(1)=1
      Scaled(1)=1
   




      ThisIMage=1
      For lp=2 to Max
         ; Make the mipmap from the Last image
         ThisImage=CreateMipMap(ThisImage)
         MipMaps(lp)=ThisImage

         ; make the scaled version  (scaling from the original image)
         Width      =GetImageWidth(thisImage)
         Height   =GetImageHeight(thisImage)
      
         ScaledIMage=getFreeimage()
         CopyImage 1,ScaledIMage
         Scaleimage ScaledImage,Width,height,1
         Scaled(lp)=Scaledimage


      next


      ; Draw the mip mapped + scaled versions of the images

      Xpos=100
      For lp=1 to Max
         img=MipMaps(lp)      
         drawimage Img,Xpos,20,false

         img=Scaled(lp)      
         drawimage Img,Xpos,300,false


         Xpos=Xpos+getImageWIdth(img)+16
      next
   else
      print "File Not Found"+File$

   endif

   sync
   waitkey
   
   end





Function CreateMipMap(ThisImage)
   oldSurface=getsurface()
      if GetImageStatus(ThisImage)

      W=GetImageWidth(ThisImage)
      H=GetImageHeight(ThisImage)

      w2=w/2
      h2=h/2
      if GetimageType(ThisImage)=1 then   MipImage=NewImage(W2,h2)   
      if GetimageType(ThisImage)=2 then   MipImage=NewFXImage(W2,h2)   


      if GetImageSTatus(MipIMage)

         Dim Buffer(w,h)

         RenderToImage Thisimage
         lockbuffer
            maskcolour=point(0,0)
            For Ylp=0 to H-1
               For Xlp=0 to W-1
                     Buffer(Xlp,ylp)=FastPOint(xlp,ylp)         
               next
            next
         unlockbuffer

         rendertoimage MipImage
         imagemaskcolour mipimage,maskcolour   
         For ylp=0 to (h and $fffe)-1 step 2
            
            lockbuffer
            ThisPixel=point(0,0)
            Xpos=0
            ylp2=ylp+1
            For Xlp=0 to (W and $fffe)-1 step 2
            
               Xlp2=xlp+1
               C1=Buffer(Xlp,ylp)
               C2=Buffer(Xlp2,ylp)
               C3=Buffer(Xlp2,ylp2)
               C4=Buffer(Xlp,ylp2)
   
               a=(rgba(c1)+rgba(c2)+rgba(c3)+rgba(c4))/4
               r=(rgbr(c1)+rgbr(c2)+rgbr(c3)+rgbr(c4))/4
               g=(rgbg(c1)+rgbg(c2)+rgbg(c3)+rgbg(c4))/4
               b=(rgbb(c1)+rgbb(c2)+rgbb(c3)+rgbb(c4))/4
   

               FastDot Xpos,Ypos,aRgb(a,r,g,b)
               xpos=xpos+1
            next

            unlockbuffer
            inc ypos            
         next

         undim Buffer()

      endif   
 endif
   rendertoimage oldsurface 
EndFunction   MipImage