Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /eXene/releases/release-110.77/graph-util/band.sml
ViewVC logotype

View of /eXene/releases/release-110.77/graph-util/band.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3940 - (download) (annotate)
Fri Aug 22 21:39:51 2014 UTC (4 years, 10 months ago) by jhr
File size: 8223 byte(s)
Release 110.77
(* band.sml
 *
 * COPYRIGHT (c) 1994 by AT&T Bell Laboratories
 *
 * Code for band data structure.
 *
 * A band is a list non-continguous rectangles listed from left
 * to right (increasing x) that all have the same upper and lower
 * y coordinates. Regions (see region-sig.sml and region.sml)
 * are essentially ordered lists of bands.
 * 
 *
 *)
signature BAND =
  sig
    structure G : GEOMETRY

    datatype rect_overlap = RectangleOut | RectangleIn | RectanglePart

    datatype band = BAND of {
                      y1 : int,         (* top y value *)
                      y2 : int,         (* bottom y value *)
                      xs : (int * int) list   (* list of (left,right) values *)
                    }

          (* Return y1(y2) of band *)
    val y1Of : band -> int
    val y2Of : band -> int

          (* Return number of intervals. Always > 0 *)
    val sizeOf : band -> int

          (* concat list of rectangles of band on accumlator list
           * The leftmost rectangle in the band will be the head of
           * the resulting list.
           *)
    val rectsOfBand : band * G.rect list -> G.rect list

          (* True if point is in band *)
    val inBand : band * G.point -> bool

          (* Return left and right extent of band *)
    val bandExtent : band -> (int * int)

          (* Compares argument interval with x intervals of band *)
    val rectInBand : band * int * int -> rect_overlap

          (* Returns true if any two x intervals of the bands intersect *)
    val overlap : band * band -> bool

          (* Translate band by given vector *)
    val offsetBand : G.point -> band -> band

          (* Translate band horizontally(vertically) *)
    val xOffsetBand : int -> band -> band
    val yOffsetBand : int -> band -> band

          (* Coalesce lower band below upper band.
           * Return SOME of new band if successful.
           * Assumes y values are compatible.
           *)
    val coalesce : {lower : band, upper : band} -> band option

          (* Create a new band that is the union(intersection,difference)
           * of the two argument bands. The integer return value is
           * the number of intervals in the band.
           * The integer arguments provide the upper
           * and lower y coordinates for the resulting band. The operation
           * only involves the x intervals; it is assumed that y overlap
           * has already been checked.
           *)
    val union : band * band * int * int -> (band * int)
    val intersect : band * band * int * int -> (band * int)
    val subtract : band * band * int * int -> (band * int)

          (* Return a new band that has the same x intervals as the
           * argument band, but with the new upper and lower y values.
           *)
    val squeeze : band * int * int -> (band * int)
  end

structure Band : BAND =
  struct
    structure G = Geometry

    datatype rect_overlap = RectangleOut | RectangleIn | RectanglePart

      (* It might be worthwhile to maintain the length of xs in the band *)
    datatype band = BAND of {
                      y1 : int,
                      y2 : int,
                      xs : (int * int) list
                    }

    fun isIn (x : int) (x1,x2) = x1 <= x andalso x < x2
    fun xoff (x : int) (x1,x2) = (x1+x,x2+x)
    fun ontop ([],l,n) = (l,n)
      | ontop (a::t,l,n) = ontop(t,a::l,n+1)
    fun mkr (y1,y2) = let
          val ht = y2 - y1
          in fn ((x1,x2),l) => ((G.RECT{x=x1,y=y1,wid=x2 - x1,ht = ht})::l) end

    fun rectsOfBand (BAND{xs,y1,y2},l) = foldr (mkr (y1,y2)) l xs
    fun squeeze (BAND{xs,...},top,bot) = (BAND{xs=xs,y1=top,y2=bot},length xs)

    fun y1Of (BAND{y1,...}) = y1
    fun y2Of (BAND{y2,...}) = y2
    fun sizeOf (BAND{xs,...}) = length xs

    fun inBand (BAND{y1,y2,xs},G.PT{x=px,y=py}) =
          y1 <= py andalso py < y2 andalso List.exists (isIn px) xs

    fun bandExtent (BAND{xs = xs as ((x1,_)::_),...}) = let
          fun right ([(l,r)]) = r
            | right (_::t) = right t
            | right _ = raise LibBase.Impossible "Band.bandExtent.right"
          in (x1,right xs) end
      | bandExtent _ = raise LibBase.Impossible "Band.bandExtent"

    fun rectInBand (BAND{y1,y2,xs},x1,x2) = let
          fun rib [] = RectangleOut 
            | rib ((l,r)::rest) =
                if r <= x1 then rib rest
                else if x2 <= l then RectangleOut
                else if l <= x1 andalso x2 <= r then RectangleIn
                else RectanglePart
          in rib xs end

      (* Only check overlap of x intervals *)
    fun overlap (BAND{xs,...},BAND{xs=xs',...}) = let
          fun loop([],_) = false
            | loop(_,[]) = false
            | loop(x as ((x1,x2)::xs),x' as ((x1',x2')::xs')) =
                if x2 <= x1' then loop(xs,x')
                else if x2' <= x1 then loop(x,xs')
                else true
          in loop (xs,xs') end

    fun xOffsetBand dx (BAND{y1,y2,xs}) = BAND{y1=y1,y2=y2, xs = map (xoff dx) xs}

    fun yOffsetBand dy (BAND{y1,y2,xs}) = BAND{y1=y1+dy,y2=y2+dy, xs = xs}

    fun offsetBand (G.PT{x=dx,y=dy}) (BAND{y1,y2,xs}) =
          BAND{y1=y1+dy,y2=y2+dy, xs = map (xoff dx) xs}

      (* coalesces two bands into one, if possible.
       * assume y1 of lower band = y2 of upper band
       * Check that each contain same horizontal intervals.
       * If so, combine and return SOME of resulting band.
       * Else return NONE.
       *)
    fun coalesce {lower = BAND{y2,xs,...}, upper = BAND{y1=y1',xs=xs',...}} =
          if xs = xs' then SOME(BAND{y1=y1',y2=y2,xs=xs}) else NONE

    fun union (BAND{xs,...},BAND{xs=xs',...},top,bot) = let
          val h = hd xs
          val h' = hd xs'
          fun finalmerge([],ci,xs) = ontop(xs,[ci],1)
            | finalmerge((i as (l,r))::t ,i' as (l',r'),xs) =
                if r' < l then ontop(xs,i'::i::t,2 + length t)
                else if r <= r' then finalmerge(t,i',xs) 
                else ontop(xs,(l',r)::t,1 + length t)
          fun loop ([],[],ci,xs) = ontop(xs,[ci],1)
            | loop (x,[],ci,xs) = finalmerge(x,ci,xs)
            | loop ([],x,ci,xs) = finalmerge(x,ci,xs)
            | loop (x as ((i as (x1,x2))::t),x' as ((i' as (x1',x2'))::t'),ci,xs) =
                if x1 < x1' then merge(t,x',i,ci,xs) else merge(x,t',i',ci,xs)
          and merge(t,t',i as (l,r),i' as (l',r'),xs) =
                if r' < l then loop(t,t',i,i'::xs) 
                else if r <= r' then loop(t,t',i',xs) 
                else loop(t,t',(l',r),xs) 
          val (xs'',n) = if #1 h < #1 h' then loop(tl xs,xs',h,[])
                         else loop(xs,tl xs',h',[])
          in
            (BAND{y1=top,y2=bot,xs= xs''},n)
          end

    fun intersect (BAND{xs,...},BAND{xs=xs',...},top,bot) = let
          fun loop ([],_,xs) = ontop(xs,[],0)
            | loop (_,[],xs) = ontop(xs,[],0)
            | loop (x as ((x1,x2)::t),x' as ((x1',x2')::t'),xs) = let
	        val l = Int.max(x1,x1')
	        val r = Int.min(x2,x2')
                val xs' = if l < r then (l,r)::xs else xs
                in
	          if x2 < x2' then loop(t,x',xs')
	          else if x2 > x2' then loop(x,t',xs')
                  else loop(t,t',xs')
                end
          in
            case loop(xs,xs',[]) of
              (xs'',n) => (BAND{y1=top,y2=bot,xs= xs''},n)
          end

    fun subtract (BAND{xs,...},BAND{xs=xs',...},top,bot) = let
          fun loop ([],_,xs) = ontop(xs,[],0)
            | loop (x,[],xs) = ontop(xs,x,length x)
            | loop (x as ((x1,x2)::t),x' as ((x1',x2')::t'),xs) =
                if x2' <= x1 then loop(x,t',xs)
                else if x2 <= x1' then loop(t,x',(x1,x2)::xs)
                else if x1' <= x1 then
                  if x2' < x2 then loop((x2',x2)::t,t',xs)
                  else if x2' = x2 then loop(t,t',xs)
                  else loop(t,x',xs)
                else
                  if x2' < x2 then loop((x2',x2)::t,t',(x1,x1')::xs)
                  else if x2' = x2 then loop(t,t',(x1,x1')::xs)
                  else loop(t,x',(x1,x1')::xs)
          in
            case loop(xs,xs',[]) of
              (xs'',n) => (BAND{y1=top,y2=bot,xs=xs''},n)
          end

  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0