UnderwareDESIGN

PlayBASIC => Resources => Source Codes => Topic started by: kevin on May 12, 2014, 12:32:05 AM

Title: Pack Array
Post by: kevin on May 12, 2014, 12:32:05 AM
 Pack Array



[pbcode]


   ; Dimension integer array
   Dim Temp(20)

   ; place values every 5 element through it
   For lp =0 to 20 step 5
         Temp(lp)=lp+1000   
   next
   

   ; Call the function to pack all the used (none zero) cells down towards
   ; the bottom of the array
   UsedItems=Pack1DArray(Temp())

   ; Show the number of used 'none zero' items in this array
   print "Used Items:"+Str$(UsedItems)
   
   ; show the contents to the screen
   For lp =0 to 20
         print Temp(lp)
   next

   Sync
   waitkey
   




   ; -----------------------------------------------------------------------
   ; ------ [ PACK 1D ARRAY ] ----------------------------------------------
   ; -----------------------------------------------------------------------
   ; This Function runs through the array and copies down anything that's not
   ; zero.  It returns the number of none zero values in the array
   ; -----------------------------------------------------------------------
   ; -----------------------------------------------------------------------
      
Function Pack1DArray(SomeArray())

   ; check if this thing exists ?
   if GetArrayStatus(SomeArray())

      ; get address of the element 0
      Address=GetArrayPtr(SomeArray(),true)
   
      ; get size of items
      Size=GetArrayElements(SomeArray())

      Src    = Address
      Dest   = Src

      For lp=0 to Size
            ThisValue=PeekInt(Src)
            if ThisValue
               PokeInt(dest,ThisValue)
               Dest+=4               
               Count++
            endif
            Src+=4
      next      

      ; clear elements above
      For lp=Count to size
               PokeInt(dest,0)
               Dest+=4               
      next
   
   endif

EndFunction  Count





[/pbcode]




Related To:

      * removing an array cell completely? (http://www.underwaredesign.com/forums/index.php?topic=1854.msg13242#msg13242)