Copyright (C) 1992, Digital Equipment Corporation
All rights reserved.
See the file COPYRIGHT for a full description.
Last modified On Mon Dec 21 18:39:26 PST 1992 by meehan
modified On Tue Jun 16 13:12:42 PDT 1992 by muller
Modified On Tue Dec 18 09:18:23 1990 by jdd
<* PRAGMA LL *>
Management of VT intervals.
MODULE VTInterval;
IMPORT VTDef, VTReal;
REVEAL
Interval = Private BRANDED OBJECT
vt : T;
options: IntervalOptions;
state := OnOffState.Off
OVERRIDES
left := Left;
right := Right;
getOptions := GetOptions
END;
PROCEDURE Left (i: Interval): I =
BEGIN
RETURN i.l
END Left;
PROCEDURE Right (i: Interval): I =
BEGIN
RETURN i.r
END Right;
PROCEDURE GetOptions (i: Interval): IntervalOptions =
BEGIN
RETURN i.options
END GetOptions;
PROCEDURE ExplodeInterval (READONLY interval : Interval;
VAR (* OUT *) indexL, indexR: Index;
VAR (* OUT *) options : IntervalOptions;
VAR (* OUT *) state : OnOffState ) =
BEGIN
indexL := interval.l;
indexR := interval.r;
options := interval.options;
state := interval.state;
END ExplodeInterval;
PROCEDURE New (vt: T; hl, hr: Index; READONLY options: IntervalOptions):
Interval =
VAR
interval := NEW (Interval, vt := vt, l := hl, r := hr, options := options);
BEGIN
Insert (interval);
RETURN interval;
END New;
PROCEDURE MakeOptions (style : IntervalStyle;
whiteBlack, whiteStroke: ColorScheme;
leading : Tint ):
IntervalOptions =
VAR options: IntervalOptions;
BEGIN
options.style := style;
options.whiteBlack := whiteBlack;
options.whiteStroke := whiteStroke;
options.leading := leading;
RETURN options;
END MakeOptions;
PROCEDURE Switch (interval: Interval; state: OnOffState)
RAISES {VTDef.Error} =
VAR vt := interval.vt;
BEGIN
LOCK vt.mutex DO
IF vt.closed THEN
RAISE VTDef.Error (VTDef.ErrorCode.Closed)
ELSE
LockedSwitch (interval, state)
END
END
END Switch;
PROCEDURE LockedSwitch (interval: Interval; state: OnOffState) =
<* LL = interval.vt.mutex *>
BEGIN
IF interval.state # state THEN
Invalidate (interval.vt, interval.l, interval.r);
interval.state := state;
END
END LockedSwitch;
PROCEDURE Move (interval: Interval; indexL, indexR: Index)
RAISES {VTDef.Error} =
VAR vt := interval.vt;
VAR oldLeft, oldRight, newLeft, newRight: I;
BEGIN
LOCK vt.mutex DO
IF vt.closed THEN RAISE VTDef.Error (VTDef.ErrorCode.Closed) END;
newLeft := MIN (indexL, interval.vt.length);
newRight := MIN (indexR, interval.vt.length);
IF indexL > interval.vt.length THEN indexL := interval.vt.length; END;
IF indexR > interval.vt.length THEN indexR := interval.vt.length; END;
IF newLeft > newRight THEN
RAISE VTDef.Error (VTDef.ErrorCode.IllegalIndex)
END;
oldLeft := interval.l;
oldRight := interval.r;
IF newLeft = oldLeft AND newRight = oldRight THEN RETURN END;
interval.l := newLeft;
interval.r := newRight;
IF interval.state = OnOffState.On
AND interval.options.style # IntervalStyle.NoStyle THEN
IF newLeft >= oldRight OR newRight <= oldLeft THEN
Invalidate (interval.vt, oldLeft, oldRight);
Invalidate (interval.vt, newLeft, newRight);
ELSE
IF newLeft > oldLeft THEN
Invalidate (interval.vt, oldLeft, newLeft);
ELSIF newLeft < oldLeft THEN
Invalidate (interval.vt, newLeft, oldLeft);
END;
IF newRight > oldRight THEN
Invalidate (interval.vt, oldRight, newRight);
ELSIF newRight < oldRight THEN
Invalidate (interval.vt, newRight, oldRight);
END
END
END
END
END Move;
PROCEDURE ChangeOptions (interval: Interval; READONLY options: IntervalOptions)
RAISES {VTDef.Error} =
VAR vt := interval.vt;
BEGIN
LOCK vt.mutex DO
IF vt.closed THEN
RAISE VTDef.Error (VTDef.ErrorCode.Closed)
ELSIF interval.state = OnOffState.On THEN
Invalidate (interval.vt, interval.l, interval.r);
END;
interval.options := options
END
END ChangeOptions;
PROCEDURE Delete (interval: Interval) RAISES {VTDef.Error} =
VAR vt := interval.vt;
BEGIN
LOCK vt.mutex DO
IF vt.closed THEN RAISE VTDef.Error (VTDef.ErrorCode.Closed) END;
Close (interval)
END
END Delete;
PROCEDURE Close (interval: Interval) = <* LL = interval.vt.mutex *>
BEGIN
LockedSwitch (interval, OnOffState.Off);
Remove (interval)
END Close;
internal VT operations
Fix bubble-sorts the intervals into order by start.
PROCEDURE Fix (vt: T) =
VAR
i, ii, iii: Interval;
needScan : BOOLEAN;
BEGIN
i := vt.intervals;
needScan := TRUE;
WHILE needScan DO
needScan := FALSE;
i := vt.intervals;
ii := NIL;
iii := NIL;
WHILE i # NIL DO
IF (ii # NIL) AND (ii.l > i.l) THEN
IF iii = NIL THEN
vt.intervals := i;
ii.next := i.next;
i.next := ii;
ELSE
iii.next := i;
ii.next := i.next;
i.next := ii;
END;
needScan := TRUE;
iii := i;
i := ii.next;
ELSE
iii := ii;
ii := i;
i := i.next;
END;
END;
END;
END Fix;
PROCEDURE CurrentOptions (view: View; at: I; VAR (*OUT*) from, to: I):
IntervalOptions =
VAR
interval: Interval;
opt : IntervalOptions;
BEGIN
opt.style := IntervalStyle.NoStyle;
from := 0;
to := view.vt.length;
interval := view.vt.intervals;
WHILE interval # NIL DO
IF interval.state = OnOffState.On THEN
IF (interval.l <= at) THEN from := MAX (interval.l, from); END;
IF (interval.r <= at) THEN from := MAX (interval.r, from); END;
IF (at < interval.l) THEN to := MIN (interval.l, to); END;
IF (at < interval.r) THEN to := MIN (interval.r, to); END;
IF (interval.l <= at) THEN
IF (at < interval.r) THEN
IF opt.style = IntervalStyle.NoStyle THEN
opt := interval.options;
ELSIF interval.options.style = IntervalStyle.NoStyle THEN
ELSIF (opt.style = IntervalStyle.SlugStyle)
OR (opt.style = IntervalStyle.OverlapStyle) THEN
ELSIF (interval.options.style = IntervalStyle.SlugStyle)
OR (interval.options.style = IntervalStyle.OverlapStyle) THEN
opt := interval.options;
ELSIF view.vOptions.intervalStylePrecedence # NIL THEN
IF view.vOptions.intervalStylePrecedence [
opt.style, interval.options.style] THEN
ELSIF view.vOptions.intervalStylePrecedence [
interval.options.style, opt.style] THEN
opt := interval.options;
ELSE
opt.style := IntervalStyle.OverlapStyle;
END;
ELSE
opt.style := IntervalStyle.OverlapStyle;
END;
END;
ELSE
RETURN opt;
END;
END;
interval := interval.next;
END;
RETURN opt;
END CurrentOptions;
Internal procedures to manipulate the list of intervals.
PROCEDURE Insert (interval: Interval) =
BEGIN
interval.next := interval.vt.intervals;
interval.vt.intervals := interval
END Insert;
PROCEDURE Remove (interval: Interval) =
VAR i: Interval;
BEGIN
i := interval.vt.intervals;
IF i = interval THEN
interval.vt.intervals := i.next;
ELSE
WHILE i.next # interval DO i := i.next; END;
i.next := i.next.next;
END;
interval.next := NIL
END Remove;
**********************************************************************
(Utility)
**********************************************************************
PROCEDURE Invalidate (vt: T; b, e: I) =
BEGIN
VTReal.Change (vt, b, e, e);
END Invalidate;
BEGIN
END VTInterval.