-- ALEText.mesa 
--    Edited by Sweet, September 29, 1980  3:03 PM

DIRECTORY
  ALEOps,
  AltoDefs,
  Ascii,
  BitBltDefs,
  Inline,
  Storage,
  StreamDefs,
  String,
  Table,
  UserTerminal,
  Window,
  WindowFont,
  WindowOps;

ALEText: PROGRAM IMPORTS ALEOps, BitBlt: BitBltDefs, Inline, Storage, StreamDefs, String, Table, UserTerminal, Window, WindowFont, WindowOps 
  EXPORTS ALEOps =
  BEGIN OPEN ALEOps;

 -- variables for building the symbol string

  ssw: PRIVATE Table.Index;

-- tables defining the current symbol table

  hashVec: ARRAY HVIndex OF HTIndex;
  ptb, ltb: Table.Base; -- used for writing out the file
  hrb, vrb: Table.Base;
  htb: Table.Base;
  ssb: STRING;
  ht: DESCRIPTOR FOR ARRAY HTIndex OF HTRecord;
  lbb: Table.Base;
  initialized: BOOLEAN ← FALSE;
  pictureChanged: PUBLIC BOOLEAN ← FALSE;

  UpdateBases: PUBLIC Table.Notifier = 
    BEGIN
    htb ← base[htType];
    ht ← DESCRIPTOR[htb, LENGTH[ht]];
    ssb ← LOOPHOLE[base[ssType], STRING];
    lbb ← base[lbType];
    ptb ← base[ptType];
    ltb ← base[ltType];
    hrb ← base[hrType];
    vrb ← base[vrType];
    END;

  ResetHash, InitHash: PUBLIC PROC =
    BEGIN
    IF initialized THEN Finalize[];
    hashVec ← ALL[HTNull];
    ht ← DESCRIPTOR[NIL, 0];
    Table.AddNotify[UpdateBases];
    ssw ← Table.Allocate[ssType, SIZE[StringBody]] + SIZE[StringBody];
    ssb↑ ← StringBody[length:0, maxlength:0, text:];
    IF AllocateHash[] # HTNull THEN ERROR;
    initialized ← TRUE;
    END;

  Finalize: PROC = {initialized ← FALSE; Table.DropNotify[UpdateBases]};

  SubString: TYPE = String.SubString;
  CharsPerWord: PRIVATE CARDINAL = AltoDefs.CharsPerWord;

  EnterString: PROC [s: SubString] RETURNS [hti: HTIndex] = {
    OPEN String;
    hvi: HVIndex = HashValue[s];
    desc: String.SubStringDescriptor;
    offset, length, nw: CARDINAL;
    ssi: Table.Index;
    FOR hti ← hashVec[hvi], ht[hti].link UNTIL hti = HTNull
      DO
      SubStringForHash[@desc, hti];
      IF String.EqualSubStrings[s, @desc] THEN RETURN [hti];
      ENDLOOP;
    offset ← ssb.length;  length ← s.length;
    nw ← (offset+length+(CharsPerWord-1) - ssb.maxlength)/CharsPerWord;
    IF nw # 0
      THEN {
	IF (ssi ← Table.Allocate[ssType, nw]) # ssw THEN ERROR;
	ssw ← ssw + nw;
	ssb↑ ← StringBody[
		length: ssb.length,
		maxlength: ssb.maxlength + nw*CharsPerWord,
		text: ]};
    String.AppendSubString[ssb, s];
    hti ← AllocateHash[];  ht[hti].link ← hashVec[hvi];  hashVec[hvi] ← hti;
    RETURN};

  AllocateHash: PRIVATE PROC RETURNS [HTIndex] = {
    hti: HTIndex = LENGTH[ht];
    [] ← Table.Allocate[htType, SIZE[HTRecord]];
    ht ← DESCRIPTOR[htb, LENGTH[ht]+1];
    ht[hti] ← HTRecord[
	anyInternal: FALSE, anyPublic: FALSE,
	link: HTNull,
	ssIndex: ssb.length];
    RETURN [hti]};

  HashBlock: PROC RETURNS [base: POINTER, length: CARDINAL] = {
    base ← BASE[hashVec]; length ← LENGTH[hashVec]; RETURN};


  HashValue: PROC [s: SubString] RETURNS [HVIndex] = {
    CharBits: PROC [CHARACTER, WORD] RETURNS [WORD] =
      LOOPHOLE[Inline.BITAND];
    Mask: WORD = 337B;		-- masks out ASCII case shifts
    n: CARDINAL = s.length;
    b: STRING = s.base;
    v: WORD;
    v ← CharBits[b[s.offset], Mask]*177B + CharBits[b[s.offset+(n-1)], Mask];
    RETURN [Inline.BITXOR[v, n*17B] MOD LENGTH[hashVec]]};

  SubStringForHash: PROC [s: SubString, hti: HTIndex] = {
    s.base ← ssb;
    IF hti = HTNull
      THEN s.offset ← s.length ← 0
      ELSE s.length ← ht[hti].ssIndex - (s.offset ← ht[hti-1].ssIndex)};

  -- labels

  AllLabels: PUBLIC PROC [action: LabelScan] RETURNS [lb: LBIndex] =
    BEGIN
    labelTableSize: CARDINAL = Table.Bounds[lbType].size;
    FOR lb ← FIRST[LBIndex], lb + SIZE[Label] WHILE 
	LOOPHOLE[lb, CARDINAL] < labelTableSize DO
      IF ~lbb[lb].free AND action[lb, @lbb[lb]] THEN RETURN;
      ENDLOOP;
    RETURN[LBNull]
    END;

  AllocateLabel: PROC RETURNS [lb: LBIndex] =
    BEGIN
    IF (lb ← header.freeLabel) # LBNull THEN
      BEGIN
      header.freeLabel ← lbb[LOOPHOLE[header.freeLabel, FNIndex]].next;
      RETURN
      END;
    lb ← Table.Allocate[lbType, SIZE[Label]];
    END;

  FreeLabel: PROC [lb: LBIndex] =
    BEGIN
    lbb[LOOPHOLE[lb, FNIndex]] ← [next: header.freeLabel];
    header.freeLabel ← lb;
    END;

  DeleteLabel: PUBLIC PROC [lb: LBIndex] =
    BEGIN
    Window.InvalidateBox[pictureWindow, BoxForLabel[lb]];
    IF lbb[lb].selected THEN UnSelChainLabel[lb];
    FreeLabel[lb];
    END;

  PosOfLabel: PUBLIC PROC [lb: LBIndex] RETURNS [APosition] =
    {RETURN [lbb[lb].pos]};

  DrawLabel: PUBLIC PROC [s: STRING, pos: APosition] =
    BEGIN
    desc: String.SubStringDescriptor ← [base:s, offset: 0, length: s.length];
    lb: LBIndex;
    hti: HTIndex = EnterString[@desc];
    ClearSelections[];
    lb ← InsertLabel[hti, pos, state.currentFont, state.currentLabelMode];
    header.selectedLabels ← lb;
    PaintLabel[lb];
    END;

  SSDrawLabel: PUBLIC PROC [ss: String.SubString, pos: APosition, font: FontSize, mode: LabelMode] =
    BEGIN
    lb: LBIndex;
    hti: HTIndex = EnterString[ss];
    lb ← InsertLabel[hti, pos, font, mode ];
    lbb[lb].selected ← FALSE;
    PaintLabel[lb];
    END;

  InsertLabel: PUBLIC PROC [hti: HTIndex, pos: APosition, font: FontSize, mode: LabelMode]
      RETURNS [lb: LBIndex] =
    BEGIN
    lb ← AllocateLabel[];
    lbb[lb] ← [hti: hti, pos: pos, thread: LBNull, font: font, mode: mode];
    END;

  BoxForLabel: PUBLIC PROC [lb: LBIndex] RETURNS [Window.Box] =
    BEGIN
    desc: String.SubStringDescriptor;
    place: Window.Place = PicturePlace[lbb[lb].pos];
    w, h: INTEGER;
    font: WindowFont.Handle =
      IF lbb[lb].font = small THEN smallFont ELSE largeFont;
    SubStringForHash[@desc, lbb[lb].hti];
    w ← 0;
    FOR i: CARDINAL IN [desc.offset..desc.offset+desc.length) DO
      w ← w + WindowFont.CharWidth[desc.base[i], font];
      ENDLOOP;
    h ← WindowFont.FontHeight[font];
    IF lbb[lb].mode = landscape THEN
      RETURN [[[x: place.x, y: place.y-w], [w: h, h: w]]]
    ELSE RETURN [[place, [w: w, h: h]]]
    END;

  SubStringForLabel: PUBLIC PROC [ss: String.SubString, lb: LBIndex] =
    BEGIN
    SubStringForHash[ss, lbb[lb].hti];
    END;

  PaintLabel: PUBLIC PROC [lb: LBIndex] =
    BEGIN
    IF lbb[lb].mode = landscape THEN PaintLandscapeLabel[lb]
    ELSE PaintPortraitLabel[lb];
    END;

  PaintPortraitLabel: PROC [lb: LBIndex] =
    BEGIN
    font: WindowFont.Handle =
      IF lbb[lb].font = small THEN smallFont ELSE largeFont;
    desc: String.SubStringDescriptor;
    place: Window.Place = PicturePlace[lbb[lb].pos];
    SubStringForHash[@desc, lbb[lb].hti];
    [] ← Window.DisplaySubstring[
      font: font,
      window: pictureWindow,
      ss: @desc,
      bbop: replace,
      place: place,
      source: IF lbb[lb].selected THEN complement ELSE block];
    END;

  PaintLandscapeLabel: PROC [lb: LBIndex] =
    BEGIN
    font: WindowFont.Handle =
      IF lbb[lb].font = small THEN smallFont ELSE largeFont;
    desc: String.SubStringDescriptor;
    place: Window.Place ← PicturePlace[lbb[lb].pos];
    box: Window.Box = BoxForLabel[lb];
    height: INTEGER ← WindowFont.FontHeight[font];
    i: CARDINAL ← 0;
    OneChar: PROC [h: Window.Handle] RETURNS [Window.Box, INTEGER] =
      BEGIN
      width: INTEGER;
      ch: CHARACTER;
      IF i = desc.length THEN RETURN [Window.NullBox, 0];
      ch ← desc.base[desc.offset+i];
      IF ch ~IN [font.min..font.max] THEN ch ← font.max+1;
      width ← font.width[ch];
      place.y ← place.y - width; i ← i+1;
      RETURN [ [place, [w: height, h: width]], (ch-font.min)*height];
      END;
    SubStringForHash[@desc, lbb[lb].hti];
    Window.Trajectory[
      window: pictureWindow,
      box: box,
      proc: OneChar,
      source: IF font = smallFont THEN smallLandBits ELSE largeLandBits,
      wpl: IF font = smallFont THEN smallLandRaster ELSE largeLandRaster,
      bbop: replace,
      bbsource: IF lbb[lb].selected THEN complement ELSE block];
    END;


  -- I/O stuff

  Rubout: PUBLIC SIGNAL = CODE;
  keyStream: StreamDefs.KeyboardHandle = StreamDefs.GetDefaultKey[];

  ReadChar: PUBLIC PROC RETURNS [CHARACTER] =
    {RETURN[keyStream.get[keyStream]]};

  textLine: STRING ← [80];
  overflow: CARDINAL ← 0;
  tdPlace: Window.Place;

  ClearText: PUBLIC PROC =
    BEGIN
    textLine.length ← overflow ← 0;
    Window.DisplayWhite[feedbackWindow, textBox];
    tdPlace ← textBox.place;
    END;

  PaintText: PUBLIC PROC =
    BEGIN
    place: Window.Place;
    place ← Window.DisplayString[
      window: feedbackWindow, 
      s: textLine, 
      place: textBox.place];
    IF place.x < textBox.place.x + textBox.dims.w THEN
      Window.DisplayWhite[
        feedbackWindow,
	[place, [
	  w: (textBox.place.x + textBox.dims.w) - place.x,
	  h: textBox.dims.h]]];
    END;

  OutChar: PUBLIC PROC [c: CHARACTER] =
    BEGIN
    IF textLine.length = textLine.maxlength THEN overflow ← overflow + 1
    ELSE
      BEGIN
      textLine[textLine.length] ← c;
      textLine.length ← textLine.length + 1;
      tdPlace ← Window.DisplayCharacter[
	window: feedbackWindow,
	char: c,
	place: tdPlace];
      END;
    END;
    
  OutString: PUBLIC PROC [s: STRING] =
    {FOR i: CARDINAL IN [0..s.length) DO OutChar[s[i]]; ENDLOOP};

  BackupChar: PROC [c: CHARACTER] =
    BEGIN
    IF overflow > 0 THEN overflow ← overflow - 1
    ELSE IF textLine.length > 0 THEN
      BEGIN
      cw: INTEGER;
      textLine.length ← textLine.length - 1;
      tdPlace.x ← tdPlace.x - (cw ← WindowFont.CharWidth[c]);
      Window.DisplayWhite[
	feedbackWindow,
	[tdPlace, [w: cw, h: textBox.dims.h]]];
      END;
    END;

  ReadString: PUBLIC PROC [s: STRING] =
    {ReadMoreString[s, ReadChar[], OutChar, BackupChar]};

  labelString: STRING ← [100];

  CollectLabel: PUBLIC PROC [c: CHARACTER, pos: APosition] =
    BEGIN
    IF state.currentLabelMode = landscape THEN CollectLandscapeLabel[c, pos]
    ELSE CollectPortraitLabel[c, pos];
    END;

  CollectPortraitLabel: PROC [c: CHARACTER, pos: APosition] =
    BEGIN
    ENABLE UNWIND => GiveBackKeys[];
    start: Window.Place = PicturePlace[pos];
    lbPlace: Window.Place ← start;
    xMax: INTEGER ← start.x;
    font: WindowFont.Handle = IF state.currentFont = small THEN smallFont ELSE largeFont;
    h: INTEGER = WindowFont.FontHeight[font];
    Out: PROC [ch: CHARACTER] =
      BEGIN
      lbPlace ← Window.DisplayCharacter[
	font: font,
	window: pictureWindow,
	place: lbPlace,
	char: ch];
      xMax ← MAX[lbPlace.x, xMax];
      END;
    Back: PROC [ch: CHARACTER] =
      BEGIN
      cw: INTEGER ← WindowFont.CharWidth[ch, font];
      lbPlace.x ← lbPlace.x - cw;
      Window.DisplayWhite[pictureWindow, [lbPlace, [w: cw, h: h]]];
      END;
    ReadMoreString[labelString, c, Out, Back ! 
      Rubout => {IF xMax # start.x THEN 
	Window.InvalidateBox[
	  pictureWindow, [start, [w: xMax-start.x, h: h]]]; GO TO done}];
    IF xMax # start.x THEN 
      {Window.InvalidateBox[pictureWindow, [start, [w: xMax-start.x, h: h]]];
      Window.ValidateTree[pictureWindow]};
    IF labelString.length # 0 THEN DrawLabel[labelString, pos];
    GO TO done;
    EXITS
      done => {ClearText[]; GiveBackKeys[]};
    END;

  CharBox: TYPE = ARRAY [0..32) OF PACKED ARRAY [0..32) OF BOOLEAN;
  smallLandRaster: CARDINAL;
  smallLandBits: POINTER;
  largeLandRaster: CARDINAL;
  largeLandBits: POINTER;

  SetupLand: PUBLIC PROC =
    BEGIN
    portBM, landBM, whiteBM: POINTER TO CharBox;
    bbsp1, bbsp2: POINTER;
    bbP: BitBlt.BBptr;
    bbP2: BitBlt.BBptr = BitBlt.AlignedBBTable[ bbsp1 ← Storage.Node[
      SIZE[BitBlt.BBTableSpace]]];

    GetLandChar: PROCEDURE [char: CHARACTER, font: WindowFont.Handle, height: CARDINAL]
        RETURNS [width: CARDINAL] =
      BEGIN -- font known to be locked in MDS
      portBM↑ ← whiteBM↑;
      width ← font.width[char];
      bbP.sbca ← Inline.LowHalf[font.bitmap];
      bbP.sbmr ← font.raster;
      bbP.slx ← WindowOps.XInSegment[char, font];
      bbP.dw ← width;
      bbP.dh ← height;
      BitBlt.BITBLT[bbP];
      landBM↑ ← whiteBM↑;
      FOR i: CARDINAL IN [0..width) DO
        FOR j: CARDINAL IN [0..height) DO
          IF portBM[j][i] THEN landBM[width-i][j] ← TRUE;
          ENDLOOP;
        ENDLOOP;
      END;

    portBM ← Storage.Node[SIZE[CharBox]];
    landBM ← Storage.Node[SIZE[CharBox]];
    whiteBM ← Storage.Node[SIZE[CharBox]];
    whiteBM↑ ← ALL[ALL[FALSE]];
    bbP ← BitBlt.AlignedBBTable[ bbsp2 ← Storage.Node[
      SIZE[BitBlt.BBTableSpace]]];
    bbP↑ ← [
      sourcetype: block, function: replace, unused: 0, dbmr: 2, dlx: 0, dty: 0,
      dw:, dh:, sbmr:, slx:,
      sty: 0, dbca: portBM, sbca:,
      gray0:, gray1:, gray2:, gray3:];
    smallLandRaster ←
      ((smallFont.max-smallFont.min+2)*smallFont.height + 15)/16;
    smallLandBits ← Storage.Node[smallLandRaster * smallFont.maxWidth];

    bbP2↑ ← [
      sourcetype: block, function: replace, unused: 0, dbmr: smallLandRaster,
      dlx: 0, dty: 0, dw: smallFont.height, dh:, sbmr: 2, slx: 0,
      sty: 0, dbca: smallLandBits, sbca: landBM,
      gray0:, gray1:, gray2:, gray3:];
    FOR c: CHARACTER IN [smallFont.min..smallFont.max + 1] DO
      width: INTEGER ← GetLandChar[c, smallFont, smallFont.height];
      bbP2.dh ← width;
      IF width # 0 THEN BitBlt.BITBLT[bbP2];
      bbP2.dlx ← bbP2.dlx + smallFont.height;
      ENDLOOP;
      
    largeLandRaster ←
      ((largeFont.max-largeFont.min+2)*largeFont.height + 15)/16;
    largeLandBits ← Storage.Node[largeLandRaster * largeFont.maxWidth];
    bbP2.dbmr ← largeLandRaster;
    bbP2.dlx ← 0;
    bbP2.dw ← largeFont.height;
    bbP2.dbca ← largeLandBits;
    FOR c: CHARACTER IN [largeFont.min..largeFont.max + 1] DO
      width: INTEGER ← GetLandChar[c, largeFont, largeFont.height];
      bbP2.dh ← width;
      IF width # 0 THEN BitBlt.BITBLT[bbP2];
      bbP2.dlx ← bbP2.dlx + largeFont.height;
      ENDLOOP;

    Storage.Free[bbsp1]; Storage.Free[bbsp2]; 
    Storage.Free[portBM]; Storage.Free[landBM]; Storage.Free[whiteBM];
    END;


  CollectLandscapeLabel: PROC [c: CHARACTER, pos: APosition] =
    BEGIN
    ENABLE UNWIND => GiveBackKeys[];
    start: Window.Place = PicturePlace[pos];
    lbPlace: Window.Place ← start;
    yMin: INTEGER ← start.y;
    font: WindowFont.Handle = IF state.currentFont = small THEN smallFont ELSE largeFont;
    bits: POINTER = IF state.currentFont = small THEN smallLandBits
      ELSE largeLandBits;
    raster: CARDINAL = IF state.currentFont = small THEN smallLandRaster
      ELSE largeLandRaster;
    height: INTEGER = WindowFont.FontHeight[font];
    Out: PROC [ch: CHARACTER] =
      BEGIN
      width: INTEGER ← WindowFont.CharWidth[ch, font];
      offset: INTEGER = IF ch IN [font.min..font.max] THEN ch-font.min
	ELSE font.max+1-font.min;
      lbPlace.y ← lbPlace.y - width;
      Window.DisplayOffsetData[
	window: pictureWindow,
	box: [lbPlace, [w: height, h: width]],
	data: bits,
	offset: offset*height,
	wpl: raster];
      yMin ← MIN[lbPlace.y, yMin];
      END;
    Back: PROC [ch: CHARACTER] =
      BEGIN
      cw: INTEGER ← WindowFont.CharWidth[ch, font];
      Window.DisplayWhite[pictureWindow, [lbPlace, [w: height, h: cw]]];
      lbPlace.y ← lbPlace.y + cw;
      END;
    ReadMoreString[labelString, c, Out, Back ! 
      Rubout => {IF yMin # start.y THEN 
	Window.InvalidateBox[
	  pictureWindow,
	  [[x: start.x, y: yMin], [w: height, h: start.y - yMin]]];
	GO TO done}];
    IF yMin # start.x THEN 
      {Window.InvalidateBox[pictureWindow,
	[[x: start.x, y: yMin], [w: height, h: start.y - yMin]]];
      Window.ValidateTree[pictureWindow]};
    IF labelString.length # 0 THEN DrawLabel[labelString, pos];
    GO TO done;
    EXITS
      done => {ClearText[]; GiveBackKeys[]};
    END;

  ReadMoreString: PROC [s: STRING, c: CHARACTER, out, back: PROC [CHARACTER]] =
    BEGIN OPEN Ascii;
    Undraw1: PROC =
      BEGIN
      ch: CHARACTER;
      s.length ← s.length - 1; ch ← s[s.length];
      IF s[s.length] < 40C THEN {back['↑]; ch ← 100b+ch};
      back[ch];
      END;
    IF c = ESC THEN
      {FOR i: CARDINAL IN [0..s.length) DO out[s[i]]; ENDLOOP;
      c ← ReadChar[]} ELSE s.length ← 0;
    WHILE c # CR DO
      SELECT c FROM
	ControlA, ControlH => IF s.length # 0 THEN Undraw1[];
        ControlW =>
	  BEGIN
	  WHILE s.length > 0 AND s[s.length-1] <= 40C DO Undraw1[]; ENDLOOP;
	  WHILE s.length > 0 AND s[s.length-1] > 40C DO Undraw1[]; ENDLOOP;
	  END;
	DEL => SIGNAL Rubout;
        ENDCASE => IF s.length = s.maxlength THEN 
	  UserTerminal.BlinkDisplay[]
	ELSE
	  BEGIN
	  s[s.length] ← c; s.length ← s.length + 1;
	  IF c < 40C THEN {out['↑]; out[100B+c]}
	  ELSE out[c];
	  END;
      c ← ReadChar[];
      ENDLOOP;
    END;

  END.