1signature GLUE_CALCULATION  =
2sig
3
4  exception Rigid        (* cannot stretch / shrink *)
5
6  val extractGlue: (BoxTypes.glueSpec -> (BasicTypes.dist * BoxTypes.infOrder)) ->
7                   BoxTypes.node list -> (BasicTypes.dist * BoxTypes.infOrder) list
8  (* Given an access function (#stretch or #shrink),
9     the relevant glue information is extracted from a node list. *)
10
11  val addGlue: BoxTypes.infOrder -> (BasicTypes.dist * BoxTypes.infOrder) list -> BasicTypes.dist
12  (* This function adds up the glue values of the given infinity order. *)
13
14  val totalGlue: (BasicTypes.dist * BoxTypes.infOrder) list -> BasicTypes.dist * BoxTypes.infOrder
15  (* This function adds up the glue values in the list,
16     separately by the infOrder,
17     and returns the highest order where the sum does not cancel out to zero,
18     and this sum *)
19
20  val getGlueParam: BasicTypes.dist -> BoxTypes.node list -> BoxTypes.glueParam
21  (* computes the glue parameter resulting from changing the natural size
22     of the node list by the given amount *)
23end  (* signature GLUE_CALCULATION *)
24(*----------*)
25
26structure GlueCalculation: GLUE_CALCULATION  =
27struct
28  open BasicTypes;  open BoxTypes
29  open Distance;  open BasicBox
30
31  fun extractGlue  access  =
32  let fun extr []              =  []
33      |   extr (Glue gs :: t)  =  access gs :: extr t
34      |   extr (_       :: t)  =               extr t
35  in extr end
36
37  fun addGlue ord  =
38  let fun add            []     =  zero
39      |   add ((s, ord') :: t)  =  if  ord = ord'  then  s + add t  else  add t
40  in  add  end
41
42  exception Rigid
43
44  fun totalGlue gl  =
45  let fun checkGlue []             =  raise Rigid
46      |   checkGlue (ord :: rest)  =
47          let val sum  =  addGlue ord gl
48          in  if  sum = zero  then  checkGlue rest  else  (sum, ord)  end
49  in  checkGlue [filll, fill, fil, normal]  end
50
51  fun getGlueParam dw nl  =
52    (if dw > zero then
53       let val (str, order) = totalGlue (extractGlue #stretch nl)
54       in  stretching ( (real dw) / real str, order )  end
55     else if dw < zero then
56       let val (shr, order) = totalGlue (extractGlue #shrink  nl)
57       in  shrinking ( ~(real dw) / real shr, order )  end
58     else natural
59    )
60    handle Rigid => natural
61
62end  (* structure GlueCalculation *)
63