123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085 |
- MODULE TextModels;
- (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Text/Mod/Models.odc *)
- (* DO NOT EDIT *)
- (* re-check alien attributes: project to base attributes? *)
- (* support *lists* of attribute extensions? *)
- (* support for enumeration of texts within embedded views
- - generally: support for enumeration of X-views within a recursive scheme?
- - however: Containers already provides a general iteration scheme
- -> could add recursion support to Reader later
- *)
- IMPORT
- Files, Services, Fonts, Ports, Stores, Models, Views, Properties, Containers;
- (* text file format:
- text = 0 CHAR
- textoffset INTEGER (> 0)
- { run }
- -1 CHAR
- { char }
- run = attrno BYTE (0..32)
- [ attr ] attr.Internalize
- ( piece | lpiece | viewref )
- piece = length INTEGER (> 0)
- lpiece = -length INTEGER (< 0, length MOD 2 = 0)
- viewref = 0 INTEGER
- w INTEGER
- h INTEGER
- view view.Internalize
- *)
- CONST
- (* unicode* = 1X; *)
- viewcode* = 2X; (** code for embedded views **)
- tab* = 9X; line* = 0DX; para* = 0EX; (** tabulator; line and paragraph separator **)
- zwspace* = 8BX; nbspace* = 0A0X; digitspace* = 8FX;
- hyphen* = 90X; nbhyphen* = 91X; softhyphen* = 0ADX;
- (** Pref.opts, options of text-aware views **)
- maskChar* = 0; hideable* = 1;
- (** Prop.known/valid/readOnly **)
- offset* = 0; code* = 1;
- (** InfoMsg.op **)
- store* = 0;
- (** UpdateMsg.op **)
- replace* = 0; insert* = 1; delete* = 2;
- (* EditOp.mode *)
- deleteRange = 0; moveBuf = 1; writeSChar = 2; writeChar = 3; writeView = 4;
- dictSize = 32;
- point = Ports.point;
- defW = 64 * point; defH = 32 * point;
- (* embedding limits - don't increase maxHeight w/o checking TextViews.StdView *)
- minWidth = 5 * point; maxWidth = MAX(INTEGER) DIV 2;
- minHeight = 5 * point; maxHeight = 1500 * point;
- minVersion = 0; maxAttrVersion = 0; maxModelVersion = 0;
- noLCharStdModelVersion = 0; maxStdModelVersion = 1;
- cacheWidth = 8; cacheLen = 4096; cacheLine = 128;
- TYPE
- Model* = POINTER TO ABSTRACT RECORD (Containers.Model) END;
- Attributes* = POINTER TO EXTENSIBLE RECORD (Stores.Store)
- init-: BOOLEAN; (* immutable once init is set *)
- color-: Ports.Color;
- font-: Fonts.Font;
- offset-: INTEGER
- END;
- AlienAttributes* = POINTER TO RECORD (Attributes)
- store-: Stores.Alien
- END;
- Prop* = POINTER TO RECORD (Properties.Property)
- offset*: INTEGER;
- code*: CHAR
- END;
- Context* = POINTER TO ABSTRACT RECORD (Models.Context) END;
- Pref* = RECORD (Properties.Preference)
- opts*: SET; (** preset to {} **)
- mask*: CHAR (** valid if maskChar IN opts **)
- END;
- Reader* = POINTER TO ABSTRACT RECORD
- eot*: BOOLEAN;
- attr*: Attributes;
- char*: CHAR;
- view*: Views.View;
- w*, h*: INTEGER
- END;
- Writer* = POINTER TO ABSTRACT RECORD
- attr-: Attributes
- END;
- InfoMsg* = RECORD (Models.Message)
- op*: INTEGER
- END;
- UpdateMsg* = RECORD (Models.UpdateMsg)
- op*: INTEGER;
- beg*, end*, delta*: INTEGER (** range: [beg, end); length = length' + delta **)
- END;
- Directory* = POINTER TO ABSTRACT RECORD
- attr-: Attributes
- END;
- Run = POINTER TO EXTENSIBLE RECORD
- prev, next: Run;
- len: INTEGER;
- attr: Attributes
- END;
- LPiece = POINTER TO EXTENSIBLE RECORD (Run)
- file: Files.File;
- org: INTEGER
- END;
- Piece = POINTER TO RECORD (LPiece) END; (* u IS Piece => CHAR run *)
- ViewRef = POINTER TO RECORD (Run) (* u IS ViewRef => View run *)
- w, h: INTEGER;
- view: Views.View (* embedded view *)
- END;
- PieceCache = RECORD
- org: INTEGER;
- prev: Run (* Org(prev.next) = org *)
- END;
- SpillFile = POINTER TO RECORD
- file: Files.File; (* valid if file # NIL *)
- len: INTEGER; (* len = file.Length() *)
- writer: Files.Writer (* writer.Base() = file *)
- END;
- AttrDict = RECORD
- len: BYTE;
- attr: ARRAY dictSize OF Attributes
- END;
- StdModel = POINTER TO RECORD (Model)
- len: INTEGER; (* len = sum(u : [trailer.next, trailer) : u.len) *)
- id: INTEGER; (* unique (could use SYSTEM.ADR instead ...) *)
- era: INTEGER; (* stable era >= k *)
- trailer: Run; (* init => trailer # NIL *)
- pc: PieceCache;
- spill: SpillFile; (* spill file, created lazily, shared with clones *)
- rd: Reader (* reader cache *)
- END;
- StdContext = POINTER TO RECORD (Context)
- text: StdModel;
- ref: ViewRef
- END;
- StdReader = POINTER TO RECORD (Reader)
- base: StdModel; (* base = Base() *)
- pos: INTEGER; (* pos = Pos() *)
- era: INTEGER;
- run: Run; (* era = base.era => Pos(run) + off = pos *)
- off: INTEGER; (* era = base.era => 0 <= off < run.len *)
- reader: Files.Reader (* file reader cache *)
- END;
- StdWriter = POINTER TO RECORD (Writer)
- base: StdModel; (* base = Base() *)
- (* hasSequencer := base.Domain() = NIL OR base.Domain().GetSequencer() = NIL *)
- pos: INTEGER; (* pos = Pos() *)
- era: INTEGER; (* relevant iff hasSequencer *)
- run: Run (* hasSequencer & era = base.era => Pos(run) = pos *)
- END;
- StdDirectory = POINTER TO RECORD (Directory) END;
- MoveOp = POINTER TO RECORD (Stores.Operation) (* MoveStretchFrom *)
- (* move src.[beg, end) to dest.pos *)
- src: StdModel;
- beg, end: INTEGER;
- dest: StdModel;
- pos: INTEGER
- END;
- EditOp = POINTER TO RECORD (Stores.Operation) (* CopyStretchFrom, Delete, WriteXXX *)
- mode: INTEGER;
- canBunch: BOOLEAN;
- text: StdModel;
- beg, end: INTEGER; (* op = deleteRange: move text.[beg, end) to <first, last> *)
- pos: INTEGER;
- first, last: Run; (* op = moveBuf: move <first, last> to text.pos;
- op = writeView: insert <first> at text.pos*)
- len: INTEGER; (* op = moveBuf: length of <first, last>;
- op = write[L]Char: length of spill file before writing new [long] char *)
- attr: Attributes (* op = write[L]Char *)
- END;
- AttrList = POINTER TO RECORD
- next: AttrList;
- len: INTEGER;
- attr: Attributes
- END;
- SetAttrOp = POINTER TO RECORD (Stores.Operation) (* SetAttr, Modify *)
- text: StdModel;
- beg: INTEGER;
- list: AttrList
- END;
- ResizeViewOp = POINTER TO RECORD (Stores.Operation) (* ResizeView *)
- text: StdModel;
- pos: INTEGER;
- ref: ViewRef;
- w, h: INTEGER
- END;
- ReplaceViewOp = POINTER TO RECORD (Stores.Operation) (* ReplaceView *)
- text: StdModel;
- pos: INTEGER;
- ref: ViewRef;
- new: Views.View
- END;
- TextCache = RECORD
- id: INTEGER; (* id of the text block served by this cache block *)
- beg, end: INTEGER; (* [beg .. end) cached, 0 <= end - beg < cacheLen *)
- buf: ARRAY cacheLen OF BYTE (* [beg MOD cacheLen .. end MOD cacheLen) *)
- END;
- Cache = ARRAY cacheWidth OF TextCache;
- VAR
- dir-, stdDir-: Directory;
- stdProp: Properties.StdProp; (* temp for NewColor, ... NewWeight *)
- prop: Prop; (* temp for NewOffset *)
- nextId: INTEGER;
- cache: Cache;
- (** Model **)
- PROCEDURE (m: Model) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
- VAR thisVersion: INTEGER;
- BEGIN
- m.Internalize^(rd); IF rd.cancelled THEN RETURN END;
- rd.ReadVersion(minVersion, maxModelVersion, thisVersion)
- END Internalize;
- PROCEDURE (m: Model) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
- BEGIN
- m.Externalize^(wr);
- wr.WriteVersion(maxModelVersion)
- END Externalize;
- PROCEDURE (m: Model) Length* (): INTEGER, NEW, ABSTRACT;
- PROCEDURE (m: Model) NewReader* (old: Reader): Reader, NEW, ABSTRACT;
- PROCEDURE (m: Model) NewWriter* (old: Writer): Writer, NEW, ABSTRACT;
- PROCEDURE (m: Model) InsertCopy* (pos: INTEGER; m0: Model; beg0, end0: INTEGER), NEW, ABSTRACT;
- PROCEDURE (m: Model) Insert* (pos: INTEGER; m0: Model; beg0, end0: INTEGER), NEW, ABSTRACT;
- PROCEDURE (m: Model) Delete* (beg, end: INTEGER), NEW, ABSTRACT;
- PROCEDURE (m: Model) SetAttr* (beg, end: INTEGER; attr: Attributes), NEW, ABSTRACT;
- PROCEDURE (m: Model) Prop* (beg, end: INTEGER): Properties.Property, NEW, ABSTRACT;
- PROCEDURE (m: Model) Modify* (beg, end: INTEGER; old, p: Properties.Property), NEW, ABSTRACT;
- PROCEDURE (m: Model) ReplaceView* (old, new: Views.View), ABSTRACT;
- PROCEDURE (m: Model) Append* (m0: Model), NEW, ABSTRACT;
- (*
- BEGIN
- ASSERT(m # m0, 20);
- m.Insert(m.Length(), m0, 0, m0.Length())
- END Append;
- *)
- PROCEDURE (m: Model) Replace* (beg, end: INTEGER; m0: Model; beg0, end0: INTEGER),
- NEW, ABSTRACT;
- (*
- VAR script: Stores.Operation; delta: INTEGER;
- BEGIN
- Models.BeginScript(m, "#System:Replacing", script);
- m.Delete(beg, end);
- IF beg0 >
- m.Insert(beg, m0, beg0, end0);
- Models.EndScript(m, script)
- END Replace;
- *)
- (** Attributes **)
- PROCEDURE (a: Attributes) CopyFrom- (source: Stores.Store), EXTENSIBLE;
- (** pre: ~a.init, source.init **)
- (** post: a.init **)
- BEGIN
- WITH source: Attributes DO
- ASSERT(~a.init, 20); ASSERT(source.init, 21); a.init := TRUE;
- a.color := source.color; a.font := source.font; a.offset := source.offset
- END
- END CopyFrom;
- PROCEDURE (a: Attributes) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
- (** pre: ~a.init **)
- (** post: a.init **)
- VAR thisVersion: INTEGER;
- fprint: INTEGER; face: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
- BEGIN
- ASSERT(~a.init, 20); a.init := TRUE;
- a.Internalize^(rd);
- IF rd.cancelled THEN RETURN END;
- rd.ReadVersion(minVersion, maxAttrVersion, thisVersion);
- IF rd.cancelled THEN RETURN END;
- rd.ReadInt(a.color);
- rd.ReadInt(fprint);
- rd.ReadXString(face); rd.ReadInt(size); rd.ReadSet(style); rd.ReadXInt(weight);
- a.font := Fonts.dir.This(face, size, style, weight);
- IF a.font.IsAlien() THEN Stores.Report("#System:AlienFont", face, "", "")
- (*
- ELSIF a.font.Fingerprint() # fprint THEN Stores.Report("#System:AlienFontVersion", face, "", "")
- *)
- END;
- rd.ReadInt(a.offset)
- END Internalize;
- PROCEDURE (a: Attributes) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
- (** pre: a.init **)
- VAR f: Fonts.Font;
- BEGIN
- ASSERT(a.init, 20);
- a.Externalize^(wr);
- wr.WriteVersion(maxAttrVersion);
- wr.WriteInt(a.color);
- f := a.font;
- (*
- wr.WriteInt(f.Fingerprint());
- *)
- wr.WriteInt(0);
- wr.WriteXString(f.typeface); wr.WriteInt(f.size); wr.WriteSet(f.style); wr.WriteXInt(f.weight);
- wr.WriteInt(a.offset)
- END Externalize;
- PROCEDURE (a: Attributes) InitFromProp* (p: Properties.Property), NEW, EXTENSIBLE;
- (** pre: ~a.init **)
- (** post: a.init, x IN p.valid => x set in a, else x defaults in a **)
- VAR def: Fonts.Font; face: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
- BEGIN
- ASSERT(~a.init, 20); a.init := TRUE;
- def := Fonts.dir.Default();
- face := def.typeface$; size := def.size; style := def.style; weight := def.weight;
- a.color := Ports.defaultColor; a.offset := 0;
- WHILE p # NIL DO
- WITH p: Properties.StdProp DO
- IF Properties.color IN p.valid THEN a.color := p.color.val END;
- IF Properties.typeface IN p.valid THEN face := p.typeface END;
- IF (Properties.size IN p.valid)
- & (Ports.point <= p.size) & (p.size <= 32767 * Ports.point) THEN
- size := p.size
- END;
- IF Properties.style IN p.valid THEN
- style := style - p.style.mask + p.style.val * p.style.mask
- END;
- IF (Properties.weight IN p.valid) & (1 <= p.weight) & (p.weight <= 1000) THEN
- weight := p.weight
- END
- | p: Prop DO
- IF offset IN p.valid THEN a.offset := p.offset END
- ELSE
- END;
- p := p.next
- END;
- a.font := Fonts.dir.This(face, size, style, weight)
- END InitFromProp;
- PROCEDURE (a: Attributes) Equals* (b: Attributes): BOOLEAN, NEW, EXTENSIBLE;
- (** pre: a.init, b.init **)
- BEGIN
- ASSERT(a.init, 20); ASSERT((b # NIL) & b.init, 21);
- RETURN (a = b)
- OR (Services.SameType(a, b))
- & (a.color = b.color) & (a.font = b.font) & (a.offset = b.offset)
- END Equals;
- PROCEDURE (a: Attributes) Prop* (): Properties.Property, NEW, EXTENSIBLE;
- (** pre: a.init **)
- VAR p: Properties.Property; sp: Properties.StdProp; tp: Prop;
- BEGIN
- ASSERT(a.init, 20);
- NEW(sp);
- sp.known := {Properties.color .. Properties.weight}; sp.valid := sp.known;
- sp.color.val := a.color;
- sp.typeface := a.font.typeface$;
- sp.size := a.font.size;
- sp.style.mask := {Fonts.italic, Fonts.underline, Fonts.strikeout};
- sp.style.val := a.font.style * sp.style.mask;
- sp.weight := a.font.weight;
- NEW(tp);
- tp.known := {offset}; tp.valid := tp.known;
- tp.offset := a.offset;
- Properties.Insert(p, tp); Properties.Insert(p, sp);
- RETURN p
- END Prop;
- PROCEDURE (a: Attributes) ModifyFromProp- (p: Properties.Property), NEW, EXTENSIBLE;
- (** pre: ~a.init **)
- VAR face: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
- valid: SET;
- BEGIN
- face := a.font.typeface; size := a.font.size;
- style := a.font.style; weight := a.font.weight;
- WHILE p # NIL DO
- valid := p.valid;
- WITH p: Properties.StdProp DO
- IF Properties.color IN valid THEN a.color := p.color.val END;
- IF Properties.typeface IN valid THEN
- face := p.typeface
- END;
- IF (Properties.size IN valid)
- & (Ports.point <= p.size) & (p.size <= 32767 * Ports.point) THEN
- size := p.size
- ELSE EXCL(valid, Properties.size)
- END;
- IF Properties.style IN valid THEN
- style := style - p.style.mask + p.style.val * p.style.mask
- END;
- IF (Properties.weight IN valid) & (1 <= p.weight) & (p.weight <= 1000) THEN
- weight := p.weight
- ELSE EXCL(valid, Properties.weight)
- END;
- IF valid - {Properties.typeface .. Properties.weight} # valid THEN
- a.font := Fonts.dir.This(face, size, style, weight)
- END
- | p: Prop DO
- IF offset IN valid THEN a.offset := p.offset END
- ELSE
- END;
- p := p.next
- END
- END ModifyFromProp;
- PROCEDURE ReadAttr* (VAR rd: Stores.Reader; VAR a: Attributes);
- VAR st: Stores.Store; alien: AlienAttributes;
- BEGIN
- rd.ReadStore(st); ASSERT(st # NIL, 20);
- IF st IS Stores.Alien THEN
- NEW(alien); alien.store := st(Stores.Alien); Stores.Join(alien, alien.store);
- alien.InitFromProp(NIL); a := alien;
- Stores.Report("#Text:AlienAttributes", "", "", "")
- ELSE a := st(Attributes)
- END
- END ReadAttr;
- PROCEDURE WriteAttr* (VAR wr: Stores.Writer; a: Attributes);
- BEGIN
- ASSERT(a # NIL, 20); ASSERT(a.init, 21);
- WITH a: AlienAttributes DO wr.WriteStore(a.store) ELSE wr.WriteStore(a) END
- END WriteAttr;
- PROCEDURE ModifiedAttr* (a: Attributes; p: Properties.Property): Attributes;
- (** pre: a.init **)
- (** post: x IN p.valid => x in new attr set to value in p, else set to value in a **)
- VAR h: Attributes;
- BEGIN
- ASSERT(a.init, 20);
- h := Stores.CopyOf(a)(Attributes); h.ModifyFromProp(p);
- RETURN h
- END ModifiedAttr;
- (** AlienAttributes **)
- PROCEDURE (a: AlienAttributes) Externalize- (VAR wr: Stores.Writer);
- BEGIN
- HALT(100)
- END Externalize;
- PROCEDURE (a: AlienAttributes) CopyFrom- (source: Stores.Store);
- BEGIN
- a.CopyFrom^(source);
- a.store := Stores.CopyOf(source(AlienAttributes).store)(Stores.Alien);
- Stores.Join(a, a.store)
- END CopyFrom;
- PROCEDURE (a: AlienAttributes) Prop* (): Properties.Property;
- BEGIN
- RETURN NIL
- END Prop;
- PROCEDURE (a: AlienAttributes) ModifyFromProp- (p: Properties.Property);
- END ModifyFromProp;
- (** Prop **)
- PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
- VAR valid: SET;
- BEGIN
- WITH q: Prop DO
- valid := p.valid * q.valid; equal := TRUE;
- IF p.offset # q.offset THEN EXCL(valid, offset) END;
- IF p.code # q.code THEN EXCL(valid, code) END;
- IF p.valid # valid THEN p.valid := valid; equal := FALSE END
- END
- END IntersectWith;
- (** Context **)
- PROCEDURE (c: Context) ThisModel* (): Model, ABSTRACT;
- PROCEDURE (c: Context) Pos* (): INTEGER, NEW, ABSTRACT;
- PROCEDURE (c: Context) Attr* (): Attributes, NEW, ABSTRACT;
- (** Reader **)
- PROCEDURE (rd: Reader) Base* (): Model, NEW, ABSTRACT;
- PROCEDURE (rd: Reader) SetPos* (pos: INTEGER), NEW, ABSTRACT;
- PROCEDURE (rd: Reader) Pos* (): INTEGER, NEW, ABSTRACT;
- PROCEDURE (rd: Reader) Read*, NEW, ABSTRACT;
- PROCEDURE (rd: Reader) ReadPrev*, NEW, ABSTRACT;
- PROCEDURE (rd: Reader) ReadChar* (OUT ch: CHAR), NEW, ABSTRACT;
- (*
- BEGIN
- rd.Read; ch := rd.char
- END ReadChar;
- *)
- PROCEDURE (rd: Reader) ReadPrevChar* (OUT ch: CHAR), NEW, ABSTRACT;
- (*
- BEGIN
- rd.ReadPrev; ch := rd.char
- END ReadPrevChar;
- *)
- PROCEDURE (rd: Reader) ReadView* (OUT v: Views.View), NEW, ABSTRACT;
- (*
- BEGIN
- REPEAT rd.Read UNTIL (rd.view # NIL) OR rd.eot;
- v := rd.view
- END ReadView;
- *)
- PROCEDURE (rd: Reader) ReadPrevView* (OUT v: Views.View), NEW, ABSTRACT;
- (*
- BEGIN
- REPEAT rd.ReadPrev UNTIL (rd.view # NIL) OR rd.eot;
- v := rd.view
- END ReadPrevView;
- *)
- PROCEDURE (rd: Reader) ReadRun* (OUT attr: Attributes), NEW, ABSTRACT;
- (** post: rd.eot OR a # NIL, rd.view = ViewAt(rd.Pos() - 1) **)
- (*
- VAR a: Attributes;
- BEGIN
- a := rd.attr;
- REPEAT rd.Read UNTIL (rd.attr # a) OR (rd.view # NIL) OR rd.eot;
- IF rd.eot THEN attr := NIL ELSE attr := rd.attr END
- END ReadRun;
- *)
- PROCEDURE (rd: Reader) ReadPrevRun* (OUT attr: Attributes), NEW, ABSTRACT;
- (** post: rd.eot OR a # NIL, rd.view = ViewAt(rd.Pos()) **)
- (*
- VAR a: Attributes;
- BEGIN
- a := rd.attr;
- REPEAT rd.ReadPrev UNTIL (rd.attr # a) OR (rd.view # NIL) OR rd.eot;
- IF rd.eot THEN attr := NIL ELSE attr := rd.attr END
- END ReadPrevRun;
- *)
- (** Writer **)
- PROCEDURE (wr: Writer) Base* (): Model, NEW, ABSTRACT;
- PROCEDURE (wr: Writer) SetPos* (pos: INTEGER), NEW, ABSTRACT;
- PROCEDURE (wr: Writer) Pos* (): INTEGER, NEW, ABSTRACT;
- (* PROCEDURE (wr: Writer) WriteSChar* (ch: SHORTCHAR), NEW, ABSTRACT; *)
- PROCEDURE (wr: Writer) WriteChar* (ch: CHAR), NEW, ABSTRACT;
- PROCEDURE (wr: Writer) WriteView* (view: Views.View; w, h: INTEGER), NEW, ABSTRACT;
- PROCEDURE (wr: Writer) SetAttr* (attr: Attributes), NEW(*, EXTENSIBLE*);
- BEGIN
- ASSERT(attr # NIL, 20); ASSERT(attr.init, 21); wr.attr := attr
- END SetAttr;
- (** Directory **)
- PROCEDURE (d: Directory) New* (): Model, NEW, ABSTRACT;
- PROCEDURE (d: Directory) NewFromString* (s: ARRAY OF CHAR): Model, NEW, EXTENSIBLE;
- VAR m: Model; w: Writer; i: INTEGER;
- BEGIN
- m := d.New(); w := m.NewWriter(NIL);
- i := 0; WHILE s[i] # 0X DO w.WriteChar(s[i]); INC(i) END;
- RETURN m
- END NewFromString;
- PROCEDURE (d: Directory) SetAttr* (attr: Attributes), NEW, EXTENSIBLE;
- BEGIN
- ASSERT(attr.init, 20); d.attr := attr
- END SetAttr;
- (* StdModel - foundation *)
- PROCEDURE OpenSpill (s: SpillFile);
- BEGIN
- s.file := Files.dir.Temp(); s.len := 0;
- s.writer := s.file.NewWriter(NIL)
- END OpenSpill;
- PROCEDURE Find (t: StdModel; VAR pos: INTEGER; VAR u: Run; VAR off: INTEGER);
- (* post: 0 <= pos <= t.len, 0 <= off < u.len, Pos(u) + off = pos *)
- (* Read/Write rely on Find to force pos into the legal range *)
- VAR v: Run; m: INTEGER;
- BEGIN
- IF pos < 0 THEN pos := 0 END;
- IF pos >= t.len THEN
- u := t.trailer; off := 0; t.pc.prev := t.trailer; t.pc.org := 0
- ELSE
- v := t.pc.prev.next; m := pos - t.pc.org;
- IF m >= 0 THEN
- WHILE m >= v.len DO DEC(m, v.len); v := v.next END
- ELSE
- WHILE m < 0 DO v := v.prev; INC(m, v.len) END
- END;
- u := v; off := m; t.pc.prev := v.prev; t.pc.org := pos - m
- END
- END Find;
- PROCEDURE Split (off: INTEGER; VAR u, un: Run);
- (* pre: 0 <= off <= u.len *)
- (* post: u.len = off, u.len + un.len = u'.len, Pos(u) + u.len = Pos(un) *)
- VAR lp: LPiece; sp: Piece;
- BEGIN
- IF off = 0 THEN un := u; u := un.prev (* "split" at left edge of run *)
- ELSIF off < u.len THEN (* u.len > 1 => u IS LPiece; true split *)
- WITH u: Piece DO
- NEW(sp); sp^ := u^; INC(sp.org, off);
- un := sp
- ELSE (* u IS LPiece) & ~(u IS Piece) *)
- NEW(lp);
- lp.prev := u.prev; lp.next := u.next; lp.len := u.len; lp.attr := u.attr;
- lp.file := u(LPiece).file; lp.org := u(LPiece).org;
- INC(lp.org, 2 * off);
- un := lp
- END;
- DEC(un.len, off); DEC(u.len, un.len);
- un.prev := u; un.next := u.next; un.next.prev := un; u.next := un
- ELSIF off = u.len THEN un := u.next (* "split" at right edge of run *)
- ELSE HALT(100)
- END
- END Split;
- PROCEDURE Merge (t: StdModel; u: Run; VAR v: Run);
- VAR p, q: LPiece;
- BEGIN
- WITH u: Piece DO
- IF (v IS Piece) & ((u.attr = v.attr) OR u.attr.Equals(v.attr)) THEN
- p := u; q := v(Piece);
- IF (p.file = q.file) & (p.org + p.len = q.org) THEN
- IF t.pc.prev = p THEN INC(t.pc.org, q.len)
- ELSIF t.pc.prev = q THEN t.pc.prev := t.trailer; t.pc.org := 0
- END;
- INC(p.len, q.len); v := v.next
- END
- END
- | u: LPiece DO (* ~(u IS Piece) *)
- IF (v IS LPiece) & ~(v IS Piece) & ((u.attr = v.attr) OR u.attr.Equals(v.attr)) THEN
- p := u(LPiece); q := v(LPiece);
- IF (p.file = q.file) & (p.org + 2 * p.len = q.org) THEN
- IF t.pc.prev = p THEN INC(t.pc.org, q.len)
- ELSIF t.pc.prev = q THEN t.pc.prev := t.trailer; t.pc.org := 0
- END;
- INC(p.len, q.len); v := v.next
- END
- END
- ELSE (* ignore: can't merge ViewRef runs *)
- END
- END Merge;
- PROCEDURE Splice (un, v, w: Run); (* (u, un) -> (u, v ... w, un) *)
- VAR u: Run;
- BEGIN
- IF v # w.next THEN (* non-empty stretch v ... w *)
- u := un.prev;
- u.next := v; v.prev := u; un.prev := w; w.next := un
- END
- END Splice;
- PROCEDURE NewContext (r: ViewRef; text: StdModel): StdContext;
- VAR c: StdContext;
- BEGIN
- NEW(c); c.text := text; c.ref := r;
- Stores.Join(text, r.view);
- RETURN c
- END NewContext;
- PROCEDURE CopyOfPiece (p: LPiece): LPiece;
- VAR lp: LPiece; sp: Piece;
- BEGIN
- WITH p: Piece DO NEW(sp); sp^ := p^; RETURN sp
- ELSE
- NEW(lp);
- lp.prev := p.prev; lp.next := p.next; lp.len := p.len; lp.attr := p.attr;
- lp.file := p(LPiece).file; lp.org := p(LPiece).org;
- RETURN lp
- END
- END CopyOfPiece;
- PROCEDURE CopyOfViewRef (r: ViewRef; text: StdModel): ViewRef;
- VAR v: ViewRef;
- BEGIN
- NEW(v); v^ := r^;
- v.view := Views.CopyOf(r.view, Views.deep);
- v.view.InitContext(NewContext(v, text));
- RETURN v
- END CopyOfViewRef;
- PROCEDURE InvalCache (t: StdModel; pos: INTEGER);
- VAR n: INTEGER;
- BEGIN
- n := t.id MOD cacheWidth;
- IF cache[n].id = t.id THEN
- IF pos <= cache[n].beg THEN cache[n].beg := 0; cache[n].end := 0
- ELSIF pos < cache[n].end THEN cache[n].end := pos
- END
- END
- END InvalCache;
- PROCEDURE StdInit (t: StdModel);
- VAR u: Run;
- BEGIN
- IF t.trailer = NIL THEN
- NEW(u); u.len := MAX(INTEGER); u.attr := NIL; u.next := u; u.prev := u;
- t.len := 0; t.id := nextId; INC(nextId); t.era := 0; t.trailer := u;
- t.pc.prev := u; t.pc.org := 0;
- IF t.spill = NIL THEN NEW(t.spill) END
- END
- END StdInit;
- PROCEDURE CopyOf (src: StdModel; beg, end: INTEGER; dst: StdModel): StdModel;
- VAR buf: StdModel; u, v, r, z, zn: Run; ud, vd: INTEGER;
- BEGIN
- ASSERT(beg < end, 20);
- buf := Containers.CloneOf(dst)(StdModel);
- ASSERT(buf.Domain() = NIL, 100);
- Find(src, beg, u, ud); Find(src, end, v, vd);
- z := buf.trailer; r := u;
- WHILE r # v DO
- WITH r: LPiece DO (* Piece or LPiece *)
- zn := CopyOfPiece(r); DEC(zn.len, ud);
- IF zn IS Piece THEN INC(zn(LPiece).org, ud) ELSE INC(zn(LPiece).org, 2 * ud) END
- | r: ViewRef DO
- zn := CopyOfViewRef(r, buf)
- ELSE (* ignore *)
- END;
- z.next := zn; zn.prev := z; z := zn; r := r.next; ud := 0
- END;
- IF vd > 0 THEN (* v IS LPiece *)
- zn := CopyOfPiece(v(LPiece)); zn.len := vd - ud;
- IF zn IS Piece THEN INC(zn(LPiece).org, ud) ELSE INC(zn(LPiece).org, 2 * ud) END;
- z.next := zn; zn.prev := z; z := zn
- END;
- z.next := buf.trailer; buf.trailer.prev := z;
- buf.len := end - beg;
- RETURN buf
- END CopyOf;
- PROCEDURE ProjectionOf (src: Model; beg, end: INTEGER; dst: StdModel): StdModel;
- (* rider-conversion to eliminate covariance conflicts in binary operations *)
- VAR buf: StdModel; rd: Reader; wr: Writer;
- BEGIN
- rd := src.NewReader(NIL); rd.SetPos(beg);
- buf := Containers.CloneOf(dst)(StdModel); ASSERT(buf.Domain() = NIL, 100);
- wr := buf.NewWriter(NIL);
- WHILE beg < end DO
- INC(beg);
- rd.Read; wr.SetAttr(rd.attr);
- IF rd.view # NIL THEN
- wr.WriteView(Views.CopyOf(rd.view, Views.deep), rd.w, rd.h)
- ELSE
- wr.WriteChar(rd.char)
- END
- END;
- RETURN buf
- END ProjectionOf;
- PROCEDURE Move (src: StdModel; beg, end: INTEGER; dest: StdModel; pos: INTEGER);
- VAR pc: PieceCache; view: Views.View;
- u, un, v, vn, w, wn: Run; ud, vd, wd: INTEGER;
- (*initDom: BOOLEAN; newDom, dom: Stores.Domain;*)
- upd: UpdateMsg; neut: Models.NeutralizeMsg;
- BEGIN
- Models.Broadcast(src, neut);
- Find(src, beg, u, ud); Split(ud, u, un); pc := src.pc;
- Find(src, end, v, vd); Split(vd, v, vn); src.pc := pc;
- Merge(src, u, vn); u.next := vn; vn.prev := u;
- DEC(src.len, end - beg);
- InvalCache(src, beg);
- INC(src.era);
- upd.op := delete; upd.beg := beg; upd.end := beg + 1; upd.delta := beg - end;
- Models.Broadcast(src, upd);
- IF src = dest THEN
- IF pos > end THEN DEC(pos, end - beg) END
- ELSE
- (*newDom := dest.Domain(); initDom := (src.Domain() = NIL) & (newDom # NIL);*)
- w := un;
- WHILE w # vn DO
- (*
- IF initDom THEN
- dom := w.attr.Domain();
- IF (dom # NIL) & (dom # newDom) THEN w.attr := Stores.CopyOf(w.attr)(Attributes) END;
- Stores.InitDomain(w.attr, newDom)
- END;
- *)
- IF ~Stores.Joined(dest, w.attr) THEN
- IF ~Stores.Unattached(w.attr) THEN w.attr := Stores.CopyOf(w.attr)(Attributes) END;
- Stores.Join(dest, w.attr)
- END;
- WITH w: ViewRef DO
- view := w.view;
- (*IF initDom THEN Stores.InitDomain(view, newDom) END;*)
- Stores.Join(dest, view);
- view.context(StdContext).text := dest
- ELSE
- END;
- w := w.next
- END
- END;
- Find(dest, pos, w, wd); Split(wd, w, wn); Splice(wn, un, v);
- v := wn.prev; Merge(dest, v, wn); v.next := wn; wn.prev := v;
- wn := w.next; Merge(dest, w, wn); w.next := wn; wn.prev := w;
- INC(dest.len, end - beg);
- InvalCache(dest, pos);
- INC(dest.era);
- upd.op := insert; upd.beg := pos; upd.end := pos + end - beg; upd.delta := end - beg;
- Models.Broadcast(dest, upd)
- END Move;
- (* StdModel - operations *)
- PROCEDURE (op: MoveOp) Do;
- VAR src, dest: StdModel; beg, end, pos: INTEGER; neut: Models.NeutralizeMsg;
- BEGIN
- src := op.src; beg := op.beg; end := op.end; dest := op.dest; pos := op.pos;
- IF src = dest THEN
- IF pos < beg THEN
- op.pos := end; op.beg := pos; op.end := pos + end - beg
- ELSE
- op.pos := beg; op.beg := pos - (end - beg); op.end := pos
- END
- ELSE
- Models.Broadcast(op.src, neut); (* destination is neutralized by sequencer *)
- op.dest := src; op.src := dest;
- op.pos := beg; op.beg := pos; op.end := pos + end - beg
- END;
- Move(src, beg, end, dest, pos)
- END Do;
- PROCEDURE DoMove (name: Stores.OpName;
- src: StdModel; beg, end: INTEGER;
- dest: StdModel; pos: INTEGER
- );
- VAR op: MoveOp;
- BEGIN
- IF (beg < end) & ((src # dest) OR ~((beg <= pos) & (pos <= end))) THEN
- NEW(op);
- op.src := src; op.beg := beg; op.end := end;
- op.dest := dest; op.pos := pos;
- Models.Do(dest, name, op)
- END
- END DoMove;
- PROCEDURE (op: EditOp) Do;
- VAR text: StdModel; (*newDom, dom: Stores.Domain;*) pc: PieceCache;
- u, un, v, vn: Run; sp: Piece; lp: LPiece; r: ViewRef;
- ud, vd, beg, end, pos, len: INTEGER; w, h: INTEGER;
- upd: UpdateMsg;
- BEGIN
- text := op.text;
- CASE op.mode OF
- deleteRange:
- beg := op.beg; end := op.end; len := end - beg;
- Find(text, beg, u, ud); Split(ud, u, un); pc := text.pc;
- Find(text, end, v, vd); Split(vd, v, vn); text.pc := pc;
- Merge(text, u, vn); u.next := vn; vn.prev := u;
- DEC(text.len, len);
- InvalCache(text, beg);
- INC(text.era);
- op.mode := moveBuf; op.canBunch := FALSE;
- op.pos := beg; op.first := un; op.last := v; op.len := len;
- upd.op := delete; upd.beg := beg; upd.end := beg + 1; upd.delta := -len;
- Models.Broadcast(text, upd)
- | moveBuf:
- pos := op.pos;
- Find(text, pos, u, ud); Split(ud, u, un); Splice(un, op.first, op.last);
- INC(text.len, op.len);
- InvalCache(text, pos);
- INC(text.era);
- op.mode := deleteRange;
- op.beg := pos; op.end := pos + op.len;
- upd.op := insert; upd.beg := pos; upd.end := pos + op.len; upd.delta := op.len;
- Models.Broadcast(text, upd)
- | writeSChar:
- pos := op.pos;
- InvalCache(text, pos);
- Find(text, pos, u, ud); Split(ud, u, un);
- IF (u.attr = op.attr) & (u IS Piece) & (u(Piece).file = text.spill.file)
- & (u(Piece).org + u.len = op.len) THEN
- INC(u.len);
- IF text.pc.org >= pos THEN INC(text.pc.org) END
- ELSE
- (*
- newDom := text.Domain();
- IF newDom # NIL THEN
- dom := op.attr.Domain();
- IF (dom # NIL) & (dom # newDom) THEN
- op.attr := Stores.CopyOf(op.attr)(Attributes)
- END;
- Stores.InitDomain(op.attr, newDom)
- END;
- *)
- IF ~Stores.Joined(text, op.attr) THEN
- IF ~Stores.Unattached(op.attr) THEN op.attr := Stores.CopyOf(op.attr)(Attributes) END;
- Stores.Join(text, op.attr)
- END;
- NEW(sp); u.next := sp; sp.prev := u; sp.next := un; un.prev := sp;
- sp.len := 1; sp.attr := op.attr;
- sp.file := text.spill.file; sp.org := op.len;
- IF text.pc.org > pos THEN INC(text.pc.org) END
- END;
- INC(text.len); INC(text.era);
- op.mode := deleteRange;
- upd.op := insert; upd.beg := pos; upd.end := pos + 1; upd.delta := 1;
- Models.Broadcast(text, upd)
- | writeChar:
- pos := op.pos;
- InvalCache(text, pos);
- Find(text, pos, u, ud); Split(ud, u, un);
- IF (u.attr = op.attr) & (u IS LPiece) & ~(u IS Piece) & (u(LPiece).file = text.spill.file)
- & (u(LPiece).org + 2 * u.len = op.len) THEN
- INC(u.len);
- IF text.pc.org >= pos THEN INC(text.pc.org) END
- ELSE
- (*
- newDom := text.Domain();
- IF newDom # NIL THEN
- dom := op.attr.Domain();
- IF (dom # NIL) & (dom # newDom) THEN
- op.attr := Stores.CopyOf(op.attr)(Attributes)
- END;
- Stores.InitDomain(op.attr, newDom)
- END;
- *)
- IF ~Stores.Joined(text, op.attr) THEN
- IF ~Stores.Unattached(op.attr) THEN op.attr := Stores.CopyOf(op.attr)(Attributes) END;
- Stores.Join(text, op.attr)
- END;
- NEW(lp); u.next := lp; lp.prev := u; lp.next := un; un.prev := lp;
- lp.len := 1; lp.attr := op.attr;
- lp.file := text.spill.file; lp.org := op.len;
- IF text.pc.org > pos THEN INC(text.pc.org) END
- END;
- INC(text.len); INC(text.era);
- op.mode := deleteRange;
- upd.op := insert; upd.beg := pos; upd.end := pos + 1; upd.delta := 1;
- Models.Broadcast(text, upd)
- | writeView:
- pos := op.pos; r := op.first(ViewRef);
- InvalCache(text, pos);
- Find(text, pos, u, ud); Split(ud, u, un);
- u.next := r; r.prev := u; r.next := un; un.prev := r;
- INC(text.len); INC(text.era);
- r.view.InitContext(NewContext(r, text));
- (* Stores.InitDomain(r.view, text.Domain()); *)
- Stores.Join(text, r.view);
- w := r.w; h := r.h; r.w := defW; r.h := defH;
- Properties.PreferredSize(r.view, minWidth, maxWidth, minHeight, maxHeight, defW, defH,
- w, h
- );
- r.w := w; r.h := h;
- op.mode := deleteRange;
- upd.op := insert; upd.beg := pos; upd.end := pos + 1; upd.delta := 1;
- Models.Broadcast(text, upd)
- END
- END Do;
- PROCEDURE GetWriteOp (t: StdModel; pos: INTEGER; VAR op: EditOp; VAR bunch: BOOLEAN);
- VAR last: Stores.Operation;
- BEGIN
- last := Models.LastOp(t);
- IF (last # NIL) & (last IS EditOp) THEN
- op := last(EditOp);
- bunch := op.canBunch & (op.end = pos)
- ELSE bunch := FALSE
- END;
- IF bunch THEN
- INC(op.end)
- ELSE
- NEW(op); op.canBunch := TRUE;
- op.text := t; op.beg := pos; op.end := pos + 1
- END;
- op.pos := pos
- END GetWriteOp;
- PROCEDURE SetPreferredSize (t: StdModel; v: Views.View);
- VAR minW, maxW, minH, maxH, w, h: INTEGER;
- BEGIN
- t.GetEmbeddingLimits(minW, maxW, minH, maxH);
- v.context.GetSize(w, h);
- Properties.PreferredSize(v, minW, maxW, minH, maxH, w, h, w, h);
- v.context.SetSize(w, h)
- END SetPreferredSize;
- PROCEDURE (op: SetAttrOp) Do;
- VAR t: StdModel; attr: Attributes; z: AttrList; (*checkDom: BOOLEAN;*)
- pc: PieceCache; u, un, v, vn: Run; ud, vd, pos, next: INTEGER;
- upd: UpdateMsg;
- BEGIN
- t := op.text; z := op.list; pos := op.beg; (*checkDom := t.Domain() # NIL;*)
- WHILE z # NIL DO
- next := pos + z.len;
- IF z.attr # NIL THEN
- Find(t, pos, u, ud); Split(ud, u, un); pc := t.pc;
- Find(t, next, v, vd); Split(vd, v, vn); t.pc := pc;
- attr := un.attr;
- WHILE un # vn DO
- un.attr := z.attr;
- (*
- IF checkDom & (un.attr.Domain() # t.Domain()) THEN
- IF un.attr.Domain() # NIL THEN un.attr := Stores.CopyOf(un.attr)(Attributes) END;
- Stores.InitDomain(un.attr, t.Domain())
- END;
- *)
- IF ~Stores.Joined(t, un.attr) THEN
- IF ~Stores.Unattached(un.attr) THEN un.attr := Stores.CopyOf(un.attr)(Attributes) END;
- Stores.Join(t, un.attr)
- END;
- Merge(t, u, un);
- WITH un: ViewRef DO SetPreferredSize(t, un.view) ELSE END;
- IF u.next = un THEN u := un; un := un.next ELSE u.next := un; un.prev := u END
- END;
- Merge(t, u, un); u.next := un; un.prev := u;
- z.attr := attr
- END;
- pos := next; z := z.next
- END;
- INC(t.era);
- upd.op := replace; upd.beg := op.beg; upd.end := pos; upd.delta := 0;
- Models.Broadcast(t, upd)
- END Do;
- PROCEDURE (op: ResizeViewOp) Do;
- VAR r: ViewRef; w, h: INTEGER; upd: UpdateMsg;
- BEGIN
- r := op.ref;
- w := op.w; h := op.h; op.w := r.w; op.h := r.h; r.w := w; r.h := h;
- INC(op.text.era);
- upd.op := replace; upd.beg := op.pos; upd.end := op.pos + 1; upd.delta := 0;
- Models.Broadcast(op.text, upd)
- END Do;
- PROCEDURE (op: ReplaceViewOp) Do;
- VAR new: Views.View; upd: UpdateMsg;
- BEGIN
- new := op.new; op.new := op.ref.view; op.ref.view := new;
- INC(op.text.era);
- upd.op := replace; upd.beg := op.pos; upd.end := op.pos + 1; upd.delta := 0;
- Models.Broadcast(op.text, upd)
- END Do;
- (* StdModel *)
- PROCEDURE (t: StdModel) InitFrom (source: Containers.Model);
- BEGIN
- WITH source: StdModel DO
- ASSERT(source.trailer # NIL, 20);
- t.spill := source.spill; (* reduce no of temp files: share spill files among clones *)
- StdInit(t)
- END
- END InitFrom;
- PROCEDURE WriteCharacters (t: StdModel; VAR wr: Stores.Writer);
- VAR r: Files.Reader; u: Run; len: INTEGER;
- (*
- sp: Properties.StorePref;
- *)
- buf: ARRAY 1024 OF BYTE;
- BEGIN
- r := NIL;
- u := t.trailer.next;
- WHILE u # t.trailer DO
- WITH u: Piece DO
- r := u.file.NewReader(r); r.SetPos(u.org);
- len := u.len;
- WHILE len > LEN(buf) DO
- r.ReadBytes(buf, 0, LEN(buf)); wr.rider.WriteBytes(buf, 0, LEN(buf));
- DEC(len, LEN(buf))
- END;
- r.ReadBytes(buf, 0, len); wr.rider.WriteBytes(buf, 0, len)
- | u: LPiece DO (* ~(u IS Piece) *)
- r := u.file.NewReader(r); r.SetPos(u.org);
- len := 2 * u.len;
- WHILE len > LEN(buf) DO
- r.ReadBytes(buf, 0, LEN(buf)); wr.rider.WriteBytes(buf, 0, LEN(buf));
- DEC(len, LEN(buf))
- END;
- r.ReadBytes(buf, 0, len); wr.rider.WriteBytes(buf, 0, len)
- | u: ViewRef DO
- (*
- sp.view := u.view; Views.HandlePropMsg(u.view, sp);
- IF sp.view # NIL THEN wr.WriteSChar(viewcode) END
- *)
- IF Stores.ExternalizeProxy(u.view) # NIL THEN
- wr.WriteSChar(viewcode)
- END
- END;
- u := u.next
- END
- END WriteCharacters;
- PROCEDURE WriteAttributes (VAR wr: Stores.Writer; t: StdModel;
- a: Attributes; VAR dict: AttrDict
- );
- VAR k, len: BYTE;
- BEGIN
- len := dict.len; k := 0; WHILE (k # len) & ~a.Equals(dict.attr[k]) DO INC(k) END;
- wr.WriteByte(k);
- IF k = len THEN
- IF len < dictSize THEN dict.attr[len] := a; INC(dict.len) END;
- (* ASSERT(Stores.Joined(t, a)); but bkwd-comp: *)
- (* IF a.Domain() # d THEN always copy: bkwd-comp hack to avoid link *)
- a := Stores.CopyOf(a)(Attributes); (* Stores.InitDomain(a, d); *) Stores.Join(t, a);
- (* END; *)
- WriteAttr(wr, a)
- END
- END WriteAttributes;
- PROCEDURE (t: StdModel) Externalize (VAR wr: Stores.Writer);
- VAR (*dom: Stores.Domain;*) u, v, un: Run;
- attr: Attributes; dict: AttrDict;
- org, runlen, pos: INTEGER; lchars: BOOLEAN;
- inf: InfoMsg;
- BEGIN
- t.Externalize^(wr);
- StdInit(t); (*dom := t.Domain();*)
- wr.WriteVersion(0);
- wr.WriteInt(0); org := wr.Pos();
- u := t.trailer.next; v := t.trailer; dict.len := 0; lchars := FALSE;
- WHILE u # v DO
- attr := u.attr;
- WITH u: Piece DO
- runlen := u.len; un := u.next;
- WHILE (un IS Piece) & un.attr.Equals(attr) DO
- INC(runlen, un.len); un := un.next
- END;
- WriteAttributes(wr, t, attr, dict); wr.WriteInt(runlen)
- | u: LPiece DO (* ~(u IS Piece) *)
- runlen := 2 * u.len; un := u.next;
- WHILE (un IS LPiece) & ~(un IS Piece) & un.attr.Equals(attr) DO
- INC(runlen, 2 * un.len); un := un.next
- END;
- WriteAttributes(wr, t, attr, dict); wr.WriteInt(-runlen);
- lchars := TRUE
- | u: ViewRef DO
- IF Stores.ExternalizeProxy(u.view) # NIL THEN
- WriteAttributes(wr, t, attr, dict); wr.WriteInt(0);
- wr.WriteInt(u.w); wr.WriteInt(u.h); Views.WriteView(wr, u.view)
- END;
- un := u.next
- END;
- u := un
- END;
- wr.WriteByte(-1);
- pos := wr.Pos();
- wr.SetPos(org - 5);
- IF lchars THEN wr.WriteVersion(maxStdModelVersion)
- ELSE wr.WriteVersion(noLCharStdModelVersion) (* version 0 did not support LONGCHAR *)
- END;
- wr.WriteInt(pos - org);
- wr.SetPos(pos);
- WriteCharacters(t, wr);
- inf.op := store; Models.Broadcast(t, inf)
- END Externalize;
- PROCEDURE (t: StdModel) Internalize (VAR rd: Stores.Reader);
- VAR u, un: Run; sp: Piece; lp: LPiece; v: ViewRef;
- org, len: INTEGER; ano: BYTE; thisVersion: INTEGER;
- attr: Attributes; dict: AttrDict;
- BEGIN
- ASSERT(t.Domain() = NIL, 20); ASSERT(t.len = 0, 21);
- t.Internalize^(rd); IF rd.cancelled THEN RETURN END;
- rd.ReadVersion(minVersion, maxStdModelVersion, thisVersion);
- IF rd.cancelled THEN RETURN END;
- StdInit(t);
- dict.len := 0; u := t.trailer;
- rd.ReadInt(len); org := rd.Pos() + len;
- rd.ReadByte(ano);
- WHILE ano # -1 DO
- IF ano = dict.len THEN
- ReadAttr(rd, attr); Stores.Join(t, attr);
- IF dict.len < dictSize THEN dict.attr[dict.len] := attr; INC(dict.len) END
- ELSE
- attr := dict.attr[ano]
- END;
- rd.ReadInt(len);
- IF len > 0 THEN (* piece *)
- NEW(sp); sp.len := len; sp.attr := attr;
- sp.file := rd.rider.Base(); sp.org := org; un := sp;
- INC(org, len)
- ELSIF len < 0 THEN (* longchar piece *)
- len := -len; ASSERT(~ODD(len), 100);
- NEW(lp); lp.len := len DIV 2; lp.attr := attr;
- lp.file := rd.rider.Base(); lp.org := org; un := lp;
- INC(org, len)
- ELSE (* len = 0 => embedded view *)
- NEW(v); v.len := 1; v.attr := attr;
- rd.ReadInt(v.w); rd.ReadInt(v.h); Views.ReadView(rd, v.view);
- v.view.InitContext(NewContext(v, t));
- un := v; INC(org)
- END;
- INC(t.len, un.len); u.next := un; un.prev := u; u := un;
- rd.ReadByte(ano)
- END;
- rd.SetPos(org);
- u.next := t.trailer; t.trailer.prev := u
- END Internalize;
- (*
- PROCEDURE (t: StdModel) PropagateDomain;
- VAR u: Run; dom: Stores.Domain;
- BEGIN
- IF t.Domain() # NIL THEN
- u := t.trailer.next;
- WHILE u # t.trailer DO
- dom := u.attr.Domain();
- IF (dom # NIL) & (dom # t.Domain()) THEN u.attr := Stores.CopyOf(u.attr)(Attributes) END;
- Stores.InitDomain(u.attr, t.Domain());
- WITH u: ViewRef DO Stores.InitDomain(u.view, t.Domain()) ELSE END;
- u := u.next
- END
- END
- END PropagateDomain;
- *)
- PROCEDURE (t: StdModel) GetEmbeddingLimits (OUT minW, maxW, minH, maxH: INTEGER);
- BEGIN
- minW := minWidth; maxW := maxWidth; minH := minHeight; maxH := maxHeight
- END GetEmbeddingLimits;
- PROCEDURE (t: StdModel) Length (): INTEGER;
- BEGIN
- StdInit(t);
- RETURN t.len
- END Length;
- PROCEDURE (t: StdModel) NewReader (old: Reader): Reader;
- VAR rd: StdReader;
- BEGIN
- StdInit(t);
- IF (old # NIL) & (old IS StdReader) THEN rd := old(StdReader) ELSE NEW(rd) END;
- IF rd.base # t THEN
- rd.base := t; rd.era := -1; rd.SetPos(0)
- ELSIF rd.pos > t.len THEN
- rd.SetPos(t.len)
- END;
- rd.eot := FALSE;
- RETURN rd
- END NewReader;
- PROCEDURE (t: StdModel) NewWriter (old: Writer): Writer;
- VAR wr: StdWriter;
- BEGIN
- StdInit(t);
- IF (old # NIL) & (old IS StdWriter) THEN wr := old(StdWriter) ELSE NEW(wr) END;
- IF (wr.base # t) OR (wr.pos > t.len) THEN
- wr.base := t; wr.era := -1; wr.SetPos(t.len)
- END;
- wr.SetAttr(dir.attr);
- RETURN wr
- END NewWriter;
- PROCEDURE (t: StdModel) InsertCopy (pos: INTEGER; t0: Model; beg0, end0: INTEGER);
- VAR buf: StdModel;
- BEGIN
- StdInit(t);
- ASSERT(0 <= pos, 21); ASSERT(pos <= t.len, 22);
- ASSERT(0 <= beg0, 23); ASSERT(beg0 <= end0, 24); ASSERT(end0 <= t0.Length(), 25);
- IF beg0 < end0 THEN
- WITH t0: StdModel DO buf := CopyOf(t0, beg0, end0, t)
- ELSE buf := ProjectionOf(t0, beg0, end0, t)
- END;
- (* IF t.Domain() # NIL THEN Stores.InitDomain(buf,t.Domain()) END; *)
- Stores.Join(t, buf);
- DoMove("#System:Copying", buf, 0, buf.len, t, pos)
- END
- END InsertCopy;
- PROCEDURE (t: StdModel) Insert (pos: INTEGER; t0: Model; beg, end: INTEGER);
- BEGIN
- StdInit(t);
- ASSERT(0 <= pos, 21); ASSERT(pos <= t.len, 22);
- ASSERT(0 <= beg, 23); ASSERT(beg <= end, 24); ASSERT(end <= t0.Length(), 25);
- IF beg < end THEN
- IF (t.Domain() # NIL) & (t0 IS StdModel) & (t0.Domain() = t.Domain()) THEN
- DoMove("#System:Moving", t0(StdModel), beg, end, t, pos)
- ELSE (* moving across domains *)
- t.InsertCopy(pos, t0, beg, end); t0.Delete(beg, end)
- END
- END
- END Insert;
- PROCEDURE (t: StdModel) Append (t0: Model);
- VAR len0: INTEGER;
- BEGIN
- StdInit(t);
- ASSERT(t # t0, 20);
- len0 := t0.Length();
- IF len0 > 0 THEN
- IF (t.Domain() # NIL) & (t0 IS StdModel) & (t0.Domain() = t.Domain()) THEN
- DoMove("#Text:Appending", t0(StdModel), 0, len0, t, t.len)
- ELSE (* moving across domains *)
- t.InsertCopy(t.len, t0, 0, len0); t0.Delete(0, len0)
- END
- END
- END Append;
- PROCEDURE (t: StdModel) Delete (beg, end: INTEGER);
- VAR op: EditOp;
- BEGIN
- StdInit(t);
- ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
- IF beg < end THEN
- NEW(op); op.mode := deleteRange; op.canBunch := FALSE;
- op.text := t; op.beg := beg; op.end := end;
- Models.Do(t, "#System:Deleting", op)
- END
- END Delete;
- PROCEDURE (t: StdModel) SetAttr (beg, end: INTEGER; attr: Attributes);
- VAR op: SetAttrOp; zp, z: AttrList;
- u, v, w: Run; ud, vd: INTEGER; modified: BOOLEAN;
- BEGIN
- StdInit(t);
- ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
- IF beg < end THEN
- NEW(op); op.text := t; op.beg := beg;
- Find(t, beg, u, ud); Find(t, end, v, vd);
- IF vd > 0 THEN w := v.next ELSE w := v END;
- zp := NIL; modified := FALSE;
- WHILE u # w DO
- IF u = v THEN INC(ud, v.len - vd) END;
- NEW(z); z.len := u.len - ud; z.attr := attr;
- IF zp = NIL THEN op.list := z ELSE zp.next:= z END;
- zp := z;
- modified := modified OR ~u.attr.Equals(attr);
- u := u.next; ud := 0
- END;
- IF modified THEN Models.Do(t, "#Text:AttributeChange", op) END
- END
- END SetAttr;
- PROCEDURE (t: StdModel) Prop (beg, end: INTEGER): Properties.Property;
- VAR p, q: Properties.Property; tp: Prop;
- u, v, w: Run; ud, vd: INTEGER; equal: BOOLEAN;
- rd: Reader;
- BEGIN
- StdInit(t);
- ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
- IF beg < end THEN
- Find(t, beg, u, ud); Find(t, end, v, vd);
- IF vd > 0 THEN w := v.next ELSE w := v END;
- p := u.attr.Prop();
- u := u.next;
- WHILE u # w DO
- Properties.Intersect(p, u.attr.Prop(), equal);
- u := u.next
- END;
- IF beg + 1 = end THEN
- t.rd := t.NewReader(t.rd); rd := t.rd;
- rd.SetPos(beg); rd.Read;
- IF (rd.view = NIL) OR (rd.char # viewcode) THEN
- q := p; WHILE (q # NIL) & ~(q IS Prop) DO q := q.next END;
- IF q # NIL THEN
- tp := q(Prop)
- ELSE NEW(tp); Properties.Insert(p, tp)
- END;
- INCL(tp.valid, code); INCL(tp.known, code); INCL(tp.readOnly, code);
- tp.code := rd.char
- END
- END
- ELSE p := NIL
- END;
- RETURN p
- END Prop;
- PROCEDURE (t: StdModel) Modify (beg, end: INTEGER; old, p: Properties.Property);
- VAR op: SetAttrOp; zp, z: AttrList;
- u, v, w: Run; ud, vd: INTEGER; equal, modified: BOOLEAN;
- q: Properties.Property;
- BEGIN
- StdInit(t);
- ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
- IF (beg < end) & (p # NIL) THEN
- NEW(op); op.text := t; op.beg := beg;
- Find(t, beg, u, ud); Find(t, end, v, vd);
- IF vd > 0 THEN w := v.next ELSE w := v END;
- zp := NIL; modified := FALSE;
- WHILE u # w DO
- IF u = v THEN INC(ud, v.len - vd) END;
- IF old # NIL THEN
- q := u.attr.Prop();
- Properties.Intersect(q, old, equal); (* q := q * old *)
- Properties.Intersect(q, old, equal) (* equal := q = old *)
- END;
- NEW(z); z.len := u.len - ud;
- IF (old = NIL) OR equal THEN
- z.attr := ModifiedAttr(u.attr, p);
- modified := modified OR ~u.attr.Equals(z.attr)
- END;
- IF zp = NIL THEN op.list := z ELSE zp.next := z END;
- zp := z;
- u := u.next; ud := 0
- END;
- IF modified THEN Models.Do(t, "#System:Modifying", op) END
- END
- END Modify;
- PROCEDURE (t: StdModel) ReplaceView (old, new: Views.View);
- VAR c: StdContext; op: ReplaceViewOp;
- BEGIN
- StdInit(t);
- ASSERT(old.context # NIL, 20); ASSERT(old.context IS StdContext, 21);
- ASSERT(old.context(StdContext).text = t, 22);
- ASSERT((new.context = NIL) OR (new.context = old.context), 24);
- IF new # old THEN
- c := old.context(StdContext);
- IF new.context = NIL THEN new.InitContext(c) END;
- (* Stores.InitDomain(new, t.Domain()); *)
- Stores.Join(t, new);
- NEW(op); op.text := t; op.pos := c.Pos(); op.ref := c.ref; op.new := new;
- Models.Do(t, "#System:Replacing", op)
- END
- END ReplaceView;
- PROCEDURE (t: StdModel) CopyFrom- (source: Stores.Store);
- BEGIN
- StdInit(t);
- WITH source: StdModel DO t.InsertCopy(0, source, 0, source.len) END
- END CopyFrom;
- PROCEDURE (t: StdModel) Replace (beg, end: INTEGER; t0: Model; beg0, end0: INTEGER);
- VAR script: Stores.Operation;
- BEGIN
- StdInit(t);
- ASSERT(0 <= beg, 20); ASSERT(beg <= end, 21); ASSERT(end <= t.len, 22);
- ASSERT(0 <= beg0, 23); ASSERT(beg0 <= end0, 24); ASSERT(end0 <= t0.Length(), 25);
- ASSERT(t # t0, 26);
- Models.BeginScript(t, "#System:Replacing", script);
- t.Delete(beg, end); t.Insert(beg, t0, beg0, end0);
- Models.EndScript(t, script)
- END Replace;
- (* StdContext *)
- PROCEDURE (c: StdContext) ThisModel (): Model;
- BEGIN
- RETURN c.text
- END ThisModel;
- PROCEDURE (c: StdContext) GetSize (OUT w, h: INTEGER);
- BEGIN
- w := c.ref.w; h := c.ref.h
- END GetSize;
- PROCEDURE (c: StdContext) SetSize (w, h: INTEGER);
- VAR t: StdModel; r: ViewRef; op: ResizeViewOp;
- BEGIN
- t := c.text; r := c.ref;
- IF w = Views.undefined THEN w := r.w END;
- IF h = Views.undefined THEN h := r.h END;
- Properties.PreferredSize(r.view, minWidth, maxWidth, minHeight, maxHeight, r.w, r.h, w, h);
- IF (w # r.w) OR (h # r.h) THEN
- NEW(op); op.text := t; op.pos := c.Pos(); op.ref := r; op.w := w; op.h := h;
- Models.Do(t, "#System:Resizing", op)
- END
- END SetSize;
- PROCEDURE (c: StdContext) Normalize (): BOOLEAN;
- BEGIN
- RETURN FALSE
- END Normalize;
- PROCEDURE (c: StdContext) Pos (): INTEGER;
- VAR t: StdModel; u, r, w: Run; pos: INTEGER;
- BEGIN
- t := c.text; r := c.ref;
- IF t.pc.prev.next # r THEN
- u := t.trailer.next; w := t.trailer; pos := 0;
- WHILE (u # r) & (u # w) DO INC(pos, u.len); u := u.next END;
- ASSERT(u = r, 20);
- t.pc.prev := r.prev; t.pc.org := pos
- END;
- RETURN t.pc.org
- END Pos;
- PROCEDURE (c: StdContext) Attr (): Attributes;
- BEGIN
- RETURN c.ref.attr
- END Attr;
- (* StdReader *)
- PROCEDURE RemapView (rd: StdReader);
- VAR p: Pref;
- BEGIN
- p.opts := {}; Views.HandlePropMsg(rd.view, p);
- IF maskChar IN p.opts THEN rd.char := p.mask ELSE rd.char := viewcode END
- END RemapView;
- PROCEDURE Reset (rd: StdReader);
- VAR t: StdModel;
- BEGIN
- t := rd.base;
- Find(t, rd.pos, rd.run, rd.off); rd.era := t.era
- END Reset;
- PROCEDURE (rd: StdReader) Base (): Model;
- BEGIN
- RETURN rd.base
- END Base;
- PROCEDURE (rd: StdReader) SetPos (pos: INTEGER);
- BEGIN
- ASSERT(pos >= 0, 20); ASSERT(rd.base # NIL, 21); ASSERT(pos <= rd.base.len, 22);
- rd.eot := FALSE; rd.attr := NIL; rd.char := 0X; rd.view := NIL;
- IF (rd.pos # pos) OR (rd.run = rd.base.trailer) THEN
- rd.pos := pos; rd.era := -1
- END
- END SetPos;
- PROCEDURE (rd: StdReader) Pos (): INTEGER;
- BEGIN
- RETURN rd.pos
- END Pos;
- PROCEDURE (rd: StdReader) Read;
- VAR t: StdModel; u: Run; n, pos, len: INTEGER; lc: ARRAY 2 OF BYTE;
- BEGIN
- t := rd.base;
- n := t.id MOD cacheWidth;
- IF rd.era # t.era THEN Reset(rd) END;
- u := rd.run;
- WITH u: Piece DO
- rd.attr := u.attr;
- pos := rd.pos MOD cacheLen;
- IF ~((cache[n].id = t.id) & (cache[n].beg <= rd.pos) & (rd.pos < cache[n].end)) THEN
- (* cache miss *)
- IF cache[n].id # t.id THEN cache[n].id := t.id; cache[n].beg := 0; cache[n].end := 0 END;
- len := cacheLine;
- IF len > cacheLen - pos THEN len := cacheLen - pos END;
- IF len > u.len - rd.off THEN len := u.len - rd.off END;
- rd.reader := u.file.NewReader(rd.reader); rd.reader.SetPos(u.org + rd.off);
- rd.reader.ReadBytes(cache[n].buf, pos, len);
- IF rd.pos = cache[n].end THEN
- cache[n].end := rd.pos + len;
- (*
- INC(cache[n].end, len);
- *)
- IF cache[n].end - cache[n].beg >= cacheLen THEN
- cache[n].beg := cache[n].end - (cacheLen - 1)
- END
- ELSE cache[n].beg := rd.pos; cache[n].end := rd.pos + len
- END
- END;
- rd.char := CHR(cache[n].buf[pos] MOD 256); rd.view := NIL;
- INC(rd.pos); INC(rd.off);
- IF rd.off = u.len THEN rd.run := u.next; rd.off := 0 END
- | u: LPiece DO (* ~(u IS Piece) *)
- rd.attr := u.attr;
- rd.reader := u.file.NewReader(rd.reader); rd.reader.SetPos(u.org + rd.off * 2);
- rd.reader.ReadBytes(lc, 0, 2);
- rd.char := CHR(lc[0] MOD 256 + 256 * (lc[1] + 128)); rd.view := NIL;
- IF (cache[n].id = t.id) & (rd.pos = cache[n].end) THEN
- cache[n].end := cache[n].end + 1;
- IF cache[n].end - cache[n].beg >= cacheLen THEN cache[n].beg := cache[n].beg + 1 END;
- (*
- INC(cache[n].end);
- IF cache[n].end - cache[n].beg >= cacheLen THEN INC(cache[n].beg) END
- *)
- END;
- INC(rd.pos); INC(rd.off);
- IF rd.off = u.len THEN rd.run := u.next; rd.off := 0 END
- | u: ViewRef DO
- rd.attr := u.attr;
- rd.view := u.view; rd.w := u.w; rd.h := u.h; RemapView(rd);
- IF (cache[n].id = t.id) & (rd.pos = cache[n].end) THEN
- cache[n].end := cache[n].end + 1;
- IF cache[n].end - cache[n].beg >= cacheLen THEN cache[n].beg := cache[n].beg + 1 END;
- (*
- INC(cache[n].end);
- IF cache[n].end - cache[n].beg >= cacheLen THEN INC(cache[n].beg) END
- *)
- END;
- INC(rd.pos); rd.run := u.next; rd.off := 0
- ELSE
- rd.eot := TRUE; rd.attr := NIL; rd.char := 0X; rd.view := NIL
- END
- END Read;
- PROCEDURE (rd: StdReader) ReadPrev;
- VAR t: StdModel; u: Run; n, pos, len: INTEGER; lc: ARRAY 2 OF BYTE;
- BEGIN
- t := rd.base;
- n := t.id MOD cacheWidth;
- IF rd.era # t.era THEN Reset(rd) END;
- IF rd.off > 0 THEN DEC(rd.off)
- ELSIF rd.pos > 0 THEN
- rd.run := rd.run.prev; rd.off := rd.run.len - 1
- ELSE rd.run := t.trailer
- END;
- u := rd.run;
- WITH u: Piece DO
- rd.attr := u.attr;
- DEC(rd.pos);
- pos := rd.pos MOD cacheLen;
- IF ~((cache[n].id = t.id) & (cache[n].beg <= rd.pos) & (rd.pos < cache[n].end)) THEN
- (* cache miss *)
- IF cache[n].id # t.id THEN cache[n].id := t.id; cache[n].beg := 0; cache[n].end := 0 END;
- len := cacheLine;
- IF len > pos + 1 THEN len := pos + 1 END;
- IF len > rd.off + 1 THEN len := rd.off + 1 END;
- rd.reader := u.file.NewReader(rd.reader);
- rd.reader.SetPos(u.org + rd.off - (len - 1));
- rd.reader.ReadBytes(cache[n].buf, pos - (len - 1), len);
- IF rd.pos = cache[n].beg - 1 THEN
- cache[n].beg := cache[n] .beg - len;
- (*
- DEC(cache[n].beg, len);
- *)
- IF cache[n].end - cache[n].beg >= cacheLen THEN
- cache[n].end := cache[n].beg + (cacheLen - 1)
- END
- ELSE cache[n].beg := rd.pos - (len - 1); cache[n].end := rd.pos + 1
- END
- END;
- rd.char := CHR(cache[n].buf[pos] MOD 256); rd.view := NIL
- | u: LPiece DO (* ~(u IS Piece) *)
- rd.attr := u.attr;
- rd.reader := u.file.NewReader(rd.reader);
- rd.reader.SetPos(u.org + 2 * rd.off);
- rd.reader.ReadBytes(lc, 0, 2);
- rd.char := CHR(lc[0] MOD 256 + 256 * (lc[1] + 128)); rd.view := NIL;
- IF (cache[n].id = t.id) & (rd.pos = cache[n].beg) THEN
- cache[n].beg := cache[n].beg - 1;
- IF cache[n].end - cache[n].beg >= cacheLen THEN cache[n].end := cache[n].end - 1 END
- (*
- DEC(cache[n].beg);
- IF cache[n].end - cache[n].beg >= cacheLen THEN DEC(cache[n].end) END
- *)
- END;
- DEC(rd.pos)
- | u: ViewRef DO
- rd.attr := u.attr;
- rd.view := u.view; rd.w := u.w; rd.h := u.h; RemapView(rd);
- IF (cache[n].id = t.id) & (rd.pos = cache[n].beg) THEN
- cache[n].beg := cache[n].beg - 1;
- IF cache[n].end - cache[n].beg >= cacheLen THEN cache[n].end := cache[n].end - 1 END
- (*
- DEC(cache[n].beg);
- IF cache[n].end - cache[n].beg >= cacheLen THEN DEC(cache[n].end) END
- *)
- END;
- DEC(rd.pos)
- ELSE
- rd.eot := TRUE; rd.attr := NIL; rd.char := 0X; rd.view := NIL
- END
- END ReadPrev;
- PROCEDURE (rd: StdReader) ReadChar (OUT ch: CHAR);
- BEGIN
- rd.Read; ch := rd.char
- END ReadChar;
- PROCEDURE (rd: StdReader) ReadPrevChar (OUT ch: CHAR);
- BEGIN
- rd.ReadPrev; ch := rd.char
- END ReadPrevChar;
- PROCEDURE (rd: StdReader) ReadView (OUT v: Views.View);
- VAR t: StdModel; u: Run;
- BEGIN
- t := rd.base;
- IF rd.era # t.era THEN Reset(rd) END;
- DEC(rd.pos, rd.off);
- u := rd.run;
- WHILE u IS LPiece DO INC(rd.pos, u.len); u := u.next END;
- WITH u: ViewRef DO
- INC(rd.pos); rd.run := u.next; rd.off := 0;
- rd.attr := u.attr; rd.view := u.view; rd.w := u.w; rd.h := u.h; RemapView(rd)
- ELSE (* u = t.trailer *)
- ASSERT(u = t.trailer, 100);
- rd.run := u; rd.off := 0;
- rd.eot := TRUE; rd.attr := NIL; rd.char := 0X; rd.view := NIL
- END;
- v := rd.view
- END ReadView;
- PROCEDURE (rd: StdReader) ReadPrevView (OUT v: Views.View);
- VAR t: StdModel; u: Run;
- BEGIN
- t := rd.base;
- IF rd.era # t.era THEN Reset(rd) END;
- DEC(rd.pos, rd.off);
- u := rd.run.prev;
- WHILE u IS LPiece DO DEC(rd.pos, u.len); u := u.prev END;
- rd.run := u; rd.off := 0;
- WITH u: ViewRef DO
- DEC(rd.pos);
- rd.attr := u.attr; rd.view := u.view; rd.w := u.w; rd.h := u.h; RemapView(rd)
- ELSE (* u = t.trailer *)
- ASSERT(u = t.trailer, 100);
- rd.eot := TRUE; rd.attr := NIL; rd.char := 0X; rd.view := NIL
- END;
- v := rd.view
- END ReadPrevView;
- PROCEDURE (rd: StdReader) ReadRun (OUT attr: Attributes);
- VAR t: StdModel; a0: Attributes; u, trailer: Run; pos: INTEGER;
- BEGIN
- t := rd.base;
- IF rd.era # t.era THEN Reset(rd) END;
- a0 := rd.attr; u := rd.run; pos := rd.pos - rd.off; trailer := t.trailer;
- WHILE (u.attr = a0) & ~(u IS ViewRef) & (u # trailer) DO
- INC(pos, u.len); u := u.next
- END;
- rd.run := u; rd.pos := pos; rd.off := 0;
- rd.Read;
- attr := rd.attr
- END ReadRun;
-
- PROCEDURE (rd: StdReader) ReadPrevRun (OUT attr: Attributes);
- VAR t: StdModel; a0: Attributes; u, trailer: Run; pos: INTEGER;
- BEGIN
- t := rd.base;
- IF rd.era # t.era THEN Reset(rd) END;
- a0 := rd.attr; u := rd.run; pos := rd.pos - rd.off; trailer := t.trailer;
- IF u # trailer THEN u := u.prev; DEC(pos, u.len) END;
- WHILE (u.attr = a0) & ~(u IS ViewRef) & (u # trailer) DO
- u := u.prev; DEC(pos, u.len)
- END;
- IF u # trailer THEN
- rd.run := u.next; rd.pos := pos + u.len; rd.off := 0
- ELSE
- rd.run := trailer; rd.pos := 0; rd.off := 0
- END;
- rd.ReadPrev;
- attr := rd.attr
- END ReadPrevRun;
- (* StdWriter *)
- PROCEDURE WriterReset (wr: StdWriter);
- VAR t: StdModel; u: Run; uo: INTEGER;
- BEGIN
- t := wr.base;
- Find(t, wr.pos, u, uo); Split(uo, u, wr.run); wr.era := t.era
- END WriterReset;
- PROCEDURE (wr: StdWriter) Base (): Model;
- BEGIN
- RETURN wr.base
- END Base;
- PROCEDURE (wr: StdWriter) SetPos (pos: INTEGER);
- BEGIN
- ASSERT(pos >= 0, 20); ASSERT(wr.base # NIL, 21); ASSERT(pos <= wr.base.len, 22);
- IF wr.pos # pos THEN
- wr.pos := pos; wr.era := -1
- END
- END SetPos;
- PROCEDURE (wr: StdWriter) Pos (): INTEGER;
- BEGIN
- RETURN wr.pos
- END Pos;
- PROCEDURE WriteSChar (wr: StdWriter; ch: SHORTCHAR);
- VAR t: StdModel; u, un: Run; p: Piece; pos, spillPos: INTEGER;
- op: EditOp; bunch: BOOLEAN;
- BEGIN
- t := wr.base; pos := wr.pos;
- IF t.spill.file = NIL THEN OpenSpill(t.spill) END;
- t.spill.writer.WriteByte(SHORT(ORD(ch))); spillPos := t.spill.len; t.spill.len := spillPos + 1;
- IF (t.Domain() = NIL) OR (t.Domain().GetSequencer() = NIL) THEN
- (* optimized for speed - writing to unbound text *)
- InvalCache(t, pos);
- IF wr.era # t.era THEN WriterReset(wr) END;
- un := wr.run; u := un.prev;
- IF (u.attr # NIL) & u.attr.Equals(wr.attr) & (u IS Piece) & (u(Piece).file = t.spill.file)
- & (u(Piece).org + u.len = spillPos) THEN
- INC(u.len);
- IF t.pc.org >= pos THEN INC(t.pc.org) END
- ELSE
- NEW(p); u.next := p; p.prev := u; p.next := un; un.prev := p;
- p.len := 1; p.attr := wr.attr;
- p.file := t.spill.file; p.org := spillPos;
- IF t.pc.org > pos THEN INC(t.pc.org) END;
- IF ~Stores.Joined(t, p.attr) THEN
- IF ~Stores.Unattached(p.attr) THEN p.attr := Stores.CopyOf(p.attr)(Attributes) END;
- Stores.Join(t, p.attr)
- END
- END;
- INC(t.era); INC(t.len);
- INC(wr.era)
- ELSE
- GetWriteOp(t, pos, op, bunch);
- IF (op.attr = NIL) OR ~op.attr.Equals(wr.attr) THEN op.attr := wr.attr END;
- op.mode := writeSChar; (*op.attr := wr.attr;*) op.len := spillPos;
- IF bunch THEN Models.Bunch(t) ELSE Models.Do(t, "#System:Inserting", op) END
- END;
- wr.pos := pos + 1
- END WriteSChar;
- PROCEDURE (wr: StdWriter) WriteChar (ch: CHAR);
- VAR t: StdModel; u, un: Run; lp: LPiece; pos, spillPos: INTEGER;
- fw: Files.Writer; op: EditOp; bunch: BOOLEAN;
- BEGIN
- IF (ch >= 20X) & (ch < 7FX)
- OR (ch = tab) OR (ch = line) OR (ch = para)
- OR (ch = zwspace) OR (ch = digitspace)
- OR (ch = hyphen) OR (ch = nbhyphen) OR (ch >= 0A0X) & (ch < 100X) THEN
- WriteSChar(wr, SHORT(ch)) (* could inline! *)
- ELSIF ch = 200BX THEN wr.WriteChar(zwspace)
- ELSIF ch = 2010X THEN wr.WriteChar(hyphen)
- ELSIF ch = 2011X THEN wr.WriteChar(nbhyphen)
- ELSIF ch >= 100X THEN
- t := wr.base; pos := wr.pos;
- IF t.spill.file = NIL THEN OpenSpill(t.spill) END;
- fw := t.spill.writer;
- fw.WriteByte(SHORT(SHORT(ORD(ch))));
- fw.WriteByte(SHORT(SHORT(ORD(ch) DIV 256 - 128)));
- spillPos := t.spill.len; t.spill.len := spillPos + 2;
- IF (t.Domain() = NIL) OR (t.Domain().GetSequencer() = NIL) THEN
- (* optimized for speed - writing to unbound text *)
- InvalCache(t, pos);
- IF wr.era # t.era THEN WriterReset(wr) END;
- un := wr.run; u := un.prev;
- IF (u.attr # NIL) & u.attr.Equals(wr.attr) & (u IS LPiece) & ~(u IS Piece) & (u(LPiece).file = t.spill.file)
- & (u(LPiece).org + 2 * u.len = spillPos) THEN
- INC(u.len);
- IF t.pc.org >= pos THEN INC(t.pc.org) END
- ELSE
- NEW(lp); u.next := lp; lp.prev := u; lp.next := un; un.prev := lp;
- lp.len := 1; lp.attr := wr.attr;
- lp.file := t.spill.file; lp.org := spillPos;
- IF t.pc.org > pos THEN INC(t.pc.org) END;
- IF ~Stores.Joined(t, lp.attr) THEN
- IF ~Stores.Unattached(lp.attr) THEN lp.attr := Stores.CopyOf(lp.attr)(Attributes) END;
- Stores.Join(t, lp.attr)
- END
- END;
- INC(t.era); INC(t.len);
- INC(wr.era)
- ELSE
- GetWriteOp(t, pos, op, bunch);
- IF (op.attr = NIL) OR ~op.attr.Equals(wr.attr) THEN op.attr := wr.attr END;
- op.mode := writeChar; (*op.attr := wr.attr;*) op.len := spillPos;
- IF bunch THEN Models.Bunch(t) ELSE Models.Do(t, "#System:Inserting", op) END
- END;
- wr.pos := pos + 1
- END
- END WriteChar;
- PROCEDURE (wr: StdWriter) WriteView (view: Views.View; w, h: INTEGER);
- VAR t: StdModel; u, un: Run; r: ViewRef; pos: INTEGER;
- op: EditOp; bunch: BOOLEAN;
- BEGIN
- ASSERT(view # NIL, 20); ASSERT(view.context = NIL, 21);
- t := wr.base; pos := wr.pos;
- Stores.Join(t, view);
- IF (t.Domain() = NIL) OR (t.Domain().GetSequencer() = NIL) THEN
- (* optimized for speed - writing to unbound text *)
- IF wr.era # t.era THEN WriterReset(wr) END;
- InvalCache(t, pos);
- NEW(r); r.len := 1; r.attr := wr.attr; r.view := view; r.w := defW; r.h := defH;
- un := wr.run; u := un.prev; u.next := r; r.prev := u; r.next := un; un.prev := r;
- IF t.pc.org > pos THEN INC(t.pc.org) END;
- INC(t.era); INC(t.len);
- view.InitContext(NewContext(r, t));
- Properties.PreferredSize(view, minWidth, maxWidth, minHeight, maxHeight, defW, defH,
- w, h
- );
- r.w := w; r.h := h;
- INC(wr.era)
- ELSE
- NEW(r); r.len := 1; r.attr := wr.attr; r.view := view; r.w := w; r.h := h;
- GetWriteOp(t, pos, op, bunch);
- op.mode := writeView; op.first := r;
- IF bunch THEN Models.Bunch(t) ELSE Models.Do(t, "#System:Inserting", op) END
- END;
- INC(wr.pos)
- END WriteView;
- (* StdDirectory *)
- PROCEDURE (d: StdDirectory) New (): Model;
- VAR t: StdModel;
- BEGIN
- NEW(t); StdInit(t); RETURN t
- END New;
- (** miscellaneous procedures **)
- (*
- PROCEDURE DumpRuns* (t: Model);
- VAR u: Run; n, i, beg, end: INTEGER; name: ARRAY 64 OF CHAR; r: Files.Reader; b: BYTE;
- BEGIN
- Sub.synch := FALSE;
- WITH t: StdModel DO
- u := t.trailer.next;
- REPEAT
- WITH u: Piece DO
- Sub.String("short");
- Sub.Int(u.len);
- Sub.Char(" "); Sub.IntForm(SYSTEM.ADR(u.file^), 16, 8, "0", FALSE);
- Sub.Int(u.org); Sub.Char(" ");
- r := u.file.NewReader(NIL); r.SetPos(u.org); i := 0;
- WHILE i < 16 DO r.ReadByte(b); Sub.Char(CHR(b)); INC(i) END;
- Sub.Ln
- | u: LPiece DO (* ~(u IS Piece) *)
- Sub.String("long");
- Sub.Int(-u.len);
- Sub.Char(" "); Sub.IntForm(SYSTEM.ADR(u.file^), 16, 8, "0", FALSE);
- Sub.Int(u.org); Sub.Char(" ");
- r := u.file.NewReader(NIL); r.SetPos(u.org); i := 0;
- WHILE i < 16 DO r.ReadByte(b); Sub.Char(CHR(b)); INC(i) END;
- Sub.Ln
- | u: ViewRef DO
- Sub.String("view");
- Services.GetTypeName(u.view, name);
- Sub.String(name); Sub.Int(u.w); Sub.Int(u.h); Sub.Ln
- ELSE
- Sub.Char("?"); Sub.Ln
- END;
- u := u.next
- UNTIL u = t.trailer;
- n := t.id MOD cacheWidth;
- IF cache[n].id = t.id THEN
- beg := cache[n].beg; end := cache[n].end;
- Sub.Int(beg); Sub.Int(end); Sub.Ln;
- Sub.Char("{");
- WHILE beg < end DO Sub.Char(CHR(cache[n].buf[beg MOD cacheLen])); INC(beg) END;
- Sub.Char("}"); Sub.Ln
- ELSE Sub.String("not cached"); Sub.Ln
- END
- END
- END DumpRuns;
- *)
- PROCEDURE NewColor* (a: Attributes; color: Ports.Color): Attributes;
- BEGIN
- ASSERT(a # NIL, 20); ASSERT(a.init, 21);
- stdProp.valid := {Properties.color}; stdProp.color.val := color;
- RETURN ModifiedAttr(a, stdProp)
- END NewColor;
- PROCEDURE NewFont* (a: Attributes; font: Fonts.Font): Attributes;
- BEGIN
- ASSERT(a # NIL, 20); ASSERT(a.init, 21);
- stdProp.valid := {Properties.typeface .. Properties.weight};
- stdProp.typeface := font.typeface$;
- stdProp.size := font.size;
- stdProp.style.val := font.style;
- stdProp.style.mask := {Fonts.italic, Fonts.underline, Fonts.strikeout};
- stdProp.weight := font.weight;
- RETURN ModifiedAttr(a, stdProp)
- END NewFont;
- PROCEDURE NewOffset* (a: Attributes; offset: INTEGER): Attributes;
- BEGIN
- ASSERT(a # NIL, 20); ASSERT(a.init, 21);
- prop.valid := {0 (*global constant offset masked by param :-( *)}; prop.offset := offset;
- RETURN ModifiedAttr(a, prop)
- END NewOffset;
- PROCEDURE NewTypeface* (a: Attributes; typeface: Fonts.Typeface): Attributes;
- BEGIN
- ASSERT(a # NIL, 20); ASSERT(a.init, 21);
- stdProp.valid := {Properties.typeface}; stdProp.typeface := typeface;
- RETURN ModifiedAttr(a, stdProp)
- END NewTypeface;
- PROCEDURE NewSize* (a: Attributes; size: INTEGER): Attributes;
- BEGIN
- ASSERT(a # NIL, 20); ASSERT(a.init, 21);
- stdProp.valid := {Properties.size}; stdProp.size := size;
- RETURN ModifiedAttr(a, stdProp)
- END NewSize;
- PROCEDURE NewStyle* (a: Attributes; style: SET): Attributes;
- BEGIN
- ASSERT(a # NIL, 20); ASSERT(a.init, 21);
- stdProp.valid := {Properties.style}; stdProp.style.val := style; stdProp.style.mask := -{};
- RETURN ModifiedAttr(a, stdProp)
- END NewStyle;
- PROCEDURE NewWeight* (a: Attributes; weight: INTEGER): Attributes;
- BEGIN
- ASSERT(a # NIL, 20); ASSERT(a.init, 21);
- stdProp.valid := {Properties.weight}; stdProp.weight := weight;
- RETURN ModifiedAttr(a, stdProp)
- END NewWeight;
- PROCEDURE WriteableChar* (ch: CHAR): BOOLEAN;
- (* must be identical to test in (StdWriter)WriteChar - inlined there for efficiency *)
- BEGIN
- RETURN
- (ch >= 20X) & (ch < 7FX) OR
- (ch = tab) OR (ch = line) OR (ch = para) OR
- (ch = zwspace) OR (ch = digitspace) OR
- (ch = hyphen) OR (ch = nbhyphen) OR
- (ch >= 0A0X) (* need to augment with test for valid Unicode *)
- END WriteableChar;
- PROCEDURE CloneOf* (source: Model): Model;
- BEGIN
- ASSERT(source # NIL, 20);
- RETURN Containers.CloneOf(source)(Model)
- END CloneOf;
- PROCEDURE SetDir* (d: Directory);
- BEGIN
- ASSERT(d # NIL, 20); ASSERT(d.attr # NIL, 21); ASSERT(d.attr.init, 22);
- dir := d
- END SetDir;
- PROCEDURE Init;
- VAR d: StdDirectory; a: Attributes;
- BEGIN
- NEW(a); a.InitFromProp(NIL);
- NEW(stdProp); stdProp.known := -{};
- NEW(prop); prop.known := -{};
- NEW(d); stdDir := d; dir := d; d.SetAttr(a)
- END Init;
- BEGIN
- Init
- END TextModels.
|