-- N.Wirth  June 1, 1977
				-- S.Andler  August 24, 1977  10:56 PM
DIRECTORY
  InlineDefs: FROM "InlineDefs",
  IODefs: FROM "IODefs",
  KeyDefs: FROM "KeyDefs",
  ProcessDefs: FROM "ProcessDefs",
  RectangleDefs: FROM "RectangleDefs",
  SegmentDefs: FROM "SegmentDefs",
  StreamDefs: FROM "StreamDefs",
  SystemDefs: FROM "SystemDefs",
  TeleSilDefs: FROM "TeleSilDefs";

DEFINITIONS FROM
  InlineDefs,  -- BITAND, BITOR, BITXOR, BITNOT, BITSHIFT
  TeleSilDefs;

--------------------------------------------------------------------
TeleSilResident: PROGRAM[typeScriptDCB: RectangleDefs.DCBptr]=
BEGIN
  -- External procedures --
    -- From an unknown! package --
      Zero: EXTERNAL PROCEDURE[POINTER,INTEGER];
    -- From TeleSilDisplay --
      SetBM: EXTERNAL PROCEDURE[newBM: RectangleDefs.BMptr];
    -- From TeleSilMain --
      Rebuild: EXTERNAL PROCEDURE;

--------------------------------------------------------------------
-- THE MOUSE
-- defines MouseValue, MouseEvent, SetMousePosition
  pMouseCoord: POINTER TO Coord= @MEMORY[424B];
  MouseLoc: POINTER TO WORD= @MEMORY[177030B];

  MouseValue: PUBLIC PROCEDURE RETURNS[INTEGER]=
  BEGIN RETURN[BITXOR[BITAND[MouseLoc^, 7], 7]] END ;

  MouseEvent: PUBLIC PROCEDURE[m: CARDINAL] RETURNS[CARDINAL]=
  BEGIN e: CARDINAL;
      -- 8 for Red button (left or upper)
      -- 4 for Yellow button (middle)
      -- 0 for Blue button (right or lower)
      -- add 1 for LeftShift key and/or 2 for Ctrl key
    IF m=1 THEN e _ 4 ELSE IF m=2 THEN e _ 0 ELSE e _ 8;
    IF KeyDefs.Keys.LeftShift=down THEN e _ e+1;
    IF KeyDefs.Keys.Ctrl=down THEN e _ e+2;
    RETURN [e]
  END ;

  SetMousePosition: PUBLIC PROCEDURE[point: Coord]=
  BEGIN pMouseCoord^ _ point END;

--------------------------------------------------------------------
-- THE CURSOR
-- defines SetCursorIcon, CursorPosition, SetGridSpacing

  IntMask: POINTER TO WORD= @MEMORY[421B];
  pCursorCoord: POINTER TO Coord= @MEMORY[426B];
  pCursorBM: POINTER TO CursorBitMap= @MEMORY[431B];
  CursorBitMap: TYPE= ARRAY[0 .. 15] OF WORD;
  cursorIcon: CursorIcon;
  gridMask: WORD _ 177777B;

  CursorIcons: ARRAY CursorIcon OF CursorBitMap _
    [[177400B, 101000B, 102000B, 101000B,  -- arrow
      100400B, 120200B, 150100B, 104040B,
      002020B, 001010B, 000404B, 000202B,
      000101B, 000042B, 000024B, 000010B],
     [177400B, 177000B, 176000B, 177000B,  -- blackArrow
      177400B, 177600B, 157700B, 107740B,
      003760B, 001770B, 000774B, 000376B,
      000177B, 000076B, 000034B, 000010B],
     [177400B, 125000B, 152000B, 125000B,  -- greyArrow
      152400B, 125200B, 152500B, 105240B,
      002520B, 001250B, 000524B, 000252B,
      000125B, 000052B, 000024B, 000010B],
     [177777B, 100001B, 100001B, 107741B,  -- rebuild
      107761B, 106061B, 106061B, 107761B,
      107741B, 106141B, 106061B, 106061B,
      106061B, 100001B, 100001B, 177777B],
     [177777B, 100001B, 100001B, 103741B,  -- input
      103741B, 100601B, 100601B, 100601B,
      100601B, 100601B, 100601B, 103741B,
      103741B, 100001B, 100001B, 177777B]];

  SetCursorIcon: PUBLIC PROCEDURE[icon: CursorIcon] RETURNS[oldCursorIcon: CursorIcon]=
  BEGIN
    oldCursorIcon _ cursorIcon;
    pCursorBM^ _ CursorIcons[cursorIcon _ icon]
  END;

  CursorPosition: PUBLIC PROCEDURE RETURNS[Coord]=
  BEGIN RETURN[pCursorCoord^] END;

  SetGridSpacing: PUBLIC PROCEDURE[gridSpacing: GridSpacing]=
  -- e.g. gridSpacing= 3 makes gridMask= -8= 177770B
  BEGIN gridMask _ - BITSHIFT[1, gridSpacing] END;

  TrackCursor: PROCEDURE=
  BEGIN  -- This is a process running at interrupt level 3 (every 1/60 sec)
    DO
      pMouseCoord^ _ [MAX[0, MIN[pMouseCoord.x, xMax]], MAX[0, MIN[pMouseCoord.y, yMax]]];
      pCursorCoord^ _ [BITAND[pMouseCoord.x, gridMask], BITAND[pMouseCoord.y, gridMask]];
      ProcessDefs.BLOCK
    ENDLOOP
  END ;

--------------------------------------------------------------------
-- THE DISPLAY
-- defines PaintString, PaintRectangle, EraseRectangle, Mark, New,
--   DisplayTicks, EraseTicks, TypeScriptWindow, BitMapDisplay

  GrayToneMap: TYPE= ARRAY [0..4) OF WORD;

  GrayToneCode: ARRAY GrayTone OF GrayToneMap _
    [[000000B, 000000B, 000000B, 000000B],  -- white
     [010421B, 000000B, 000000B, 000000B],  -- 0
     [010421B, 042104B, 000000B, 000000B],  -- 1
     [010421B, 010421B, 042104B, 042104B],  -- 2
     [010421B, 021042B, 042104B, 104210B],  -- 3
     [104210B, 042104B, 021042B, 010421B],  -- 4
     [114631B, 114631B, 063146B, 063146B],  -- 5
     [052525B, 125252B, 052525B, 125252B],  -- gray
     [177777B, 177777B, 177777B, 177777B]]; -- black

  BBT: TYPE= MACHINE DEPENDENT RECORD[  -- BitBltTable
    func, unused: CARDINAL,
      -- BitBlt function codes:
      -- BBoperation:		BBsourcetype:
      -- 0: d _ s'  (replace) 	0: s' = s  (block)
      -- 1: d _ s' ior d  (paint)	4: s' = ~s  (complement)
      -- 2: d _ s' xor d  (invert)	8: s' = s & g  (andgray)
      -- 3: d _ ~s' & d  (erase)	12: s' = g  (gray)
    dadr: RectangleDefs.BMptr,  -- destination address
    dwidth: CARDINAL,  -- dest. bitmap width
    d: Zone,  -- destination zone
    sadr: RectangleDefs.BMptr,  -- source address
    swidth: CARDINAL,  -- source bitmap width
    s: Coord,  -- source zone coordinates
    g: GrayToneMap];  -- gray block g

  pBBT: POINTER TO BBT;
  BM: RectangleDefs.BMptr;  -- main BitMap
  BMHeight: CARDINAL _ BMMaxHeight; -- display height in scan lines
  BMSize: CARDINAL _ BMWordsPerLine*BMHeight; -- display size in words
  xMax: INTEGER= BMBitsPerLine-16;
  yMax: INTEGER _ BMHeight-16; -- changed in ShrinkBM
  smallBMSize: CARDINAL;
  pFonts: POINTER TO ARRAY FontNumber OF FontDesc;
  DCBorg: POINTER TO RectangleDefs.DCBptr= @MEMORY[420B];
  displayDCB: RectangleDefs.DCBptr;
  OutOfStorage: SIGNAL= CODE;

  BitBlt: EXTERNAL PROCEDURE[POINTER TO BBT];

  PaintString: PUBLIC PROCEDURE[s: STRING, z: Zone, fno: FontNumber] RETURNS [CARDINAL]=
  BEGIN i: CARDINAL; w, dw: CARDINAL;
    dwa: RectangleDefs.BMptr;  -- destination word address
    dba: [0..15];  -- destination bit address
    fnt: RectangleDefs.FAptr _ pFonts[fno].fnt;

    IF z.point.x ~IN [0..LOOPHOLE[BMBitsPerLine-z.w, INTEGER]]
      OR z.point.y ~IN [0..LOOPHOLE[BMHeight-z.h, INTEGER]]
      THEN RETURN[0];

    dwa _ BM+(BMWordsPerLine*(z.point.y-1)+z.point.x/16);
    dba _ 15-(z.point.x MOD 16);
    i _ w _ 0;
    WHILE i<s.length AND w<z.w DO
      [dw, dba, dwa] _ RectangleDefs.CONVERT[s[i], fnt, dwa, BMWordsPerLine, dba];
      i _ i+1; w _ w+dw
    ENDLOOP ;
    RETURN [w]
  END ;

  PaintRectangle: PUBLIC PROCEDURE[f: CARDINAL, z: Zone, g: GrayTone]=
  BEGIN pBBT.func _ f;
    PaintZone[z, g]
  END ;

  EraseRectangle: PUBLIC PROCEDURE[z: Zone]=
  BEGIN pBBT.func _ 12;
    PaintZone[z, white]
  END;

  Mark: PUBLIC PROCEDURE[point: Coord, icon: CursorIcon]=
  BEGIN
    pBBT.func _ 2; -- d _ s xor d
    pBBT.d _ [point, 16, 16];
    pBBT.sadr _ LOOPHOLE[@CursorIcons[icon]]; pBBT.swidth _ 1; pBBT.s _ [0,0];
    BitBlt[pBBT]
  END;

  PaintZone: PROCEDURE[z: Zone, g: GrayTone]=
  BEGIN
    x, y, absX, absY: CARDINAL;
    pGTM: POINTER TO GrayToneMap;
    i: [0..4);

    IF z.point.x >= 0 THEN x _ z.point.x
    ELSE
      BEGIN
        absX _ -z.point.x;
        x _ 0;
        z.w _ IF z.w>absX THEN z.w-absX ELSE 0
      END;

    IF z.point.y >= 0 THEN y _ z.point.y
    ELSE
      BEGIN
        absY _ -z.point.y;
        y _ 0;
        z.h _ IF z.h>absY THEN z.h-absY ELSE 0
      END;

    IF x+z.w >= BMBitsPerLine
    THEN IF x >= BMBitsPerLine THEN z.w _ 0 ELSE z.w _ BMBitsPerLine-x;

    IF y+z.h >= BMHeight
    THEN IF y >= BMHeight THEN z.h _ 0 ELSE z.h _ BMHeight-y;

    IF z.w#0 AND z.h#0 THEN
      BEGIN
        pBBT.d _ [[x,y], z.w, z.h]; pBBT.s _ [0,0];
        pGTM _ @GrayToneCode[g];
        FOR i IN [0..4) DO
          pBBT.g[i] _ pGTM[InlineDefs.BITAND[y+i, 3]]
        ENDLOOP;
        BitBlt[pBBT]
      END
  END;

  DisplayTicks: PUBLIC PROCEDURE=
  BEGIN OPEN InlineDefs;  -- BITOR
    line, word: CARDINAL;
    pLine, pWord: POINTER TO WORD;
    FOR line _ 0, line+16 WHILE line<BMHeight DO
      pLine _ BM+line*BMWordsPerLine;
      FOR word IN [0..BMWordsPerLine) DO
        pWord _ pLine+word;
        pWord^ _ BITOR[pWord^, 100000B]
      ENDLOOP
    ENDLOOP
  END;

  EraseTicks: PUBLIC PROCEDURE=
  BEGIN OPEN InlineDefs;  -- BITAND
    line, word: CARDINAL;
    pLine, pWord: POINTER TO WORD;
    FOR line _ 0, line+16 WHILE line<BMHeight DO
      pLine _ BM+line*BMWordsPerLine;
      FOR word IN [0..BMWordsPerLine) DO
        pWord _ pLine+word;
        pWord^ _ BITAND[pWord^, 77777B]
      ENDLOOP
    ENDLOOP
  END;

  New: PROCEDURE[n: CARDINAL] RETURNS[POINTER]=
  -- allocate n words with even address
  BEGIN p: POINTER;
    p _ SystemDefs.AllocateHeapNode[n+1];
    p _ p + BITAND[LOOPHOLE[p], 1];
    RETURN[p]
  END ;

  SwapEverythingOut: PROCEDURE=
  BEGIN
    tooMany: SegmentDefs.PageCount= 250;
    [] _ SegmentDefs.NewDataSegment[SegmentDefs.DefaultBase, tooMany
      ! SegmentDefs.InsufficientVM => CONTINUE]
  END;

  InitDisplay: PUBLIC PROCEDURE=
  BEGIN  -- Simulate DisplayOn with our own bitmap and fontsegment
    defaultBM: RectangleDefs.BMHandle _ RectangleDefs.GetDefaultBitmap[];
    defaultDS: StreamDefs.DisplayHandle _ StreamDefs.GetDefaultDisplayStream[];
    rectangle: RectangleDefs.Rptr _ defaultBM.rectangles;
    smallBMSize _ defaultBM.words;

--------------------------------------------------------------------
  -- Initialization of display
--------------------------------------------------------------------
    IF NOT sandBarOK THEN SwapEverythingOut;
    BM _ SystemDefs.AllocatePages[SystemDefs.PagesForWords[BMSize]];
    displayDCB _ New[4];  -- Full display bitmap 
    displayDCB^ _ RectangleDefs.DCB[next: RectangleDefs.DCBnil,
      resolution: high, background: white, indenting: 0, width: BMWordsPerLine,
      bitmap: LOOPHOLE[BM], height: BMHeight/2];
    Zero[BM, BMSize];
    DCBorg^ _ displayDCB;
    DisplayTicks;

--------------------------------------------------------------------
    -- Simulate ReallocateBitmap
--------------------------------------------------------------------
    defaultBM.addr _ BM;
    defaultBM.width _ defaultBM.wordsperline*16;
    defaultBM.height _ defaultBM.words/defaultBM.wordsperline;
    IF InlineDefs.BITAND[defaultBM.height,1]=1 THEN
      defaultBM.height _ defaultBM.height-1;
    [] _ RectangleDefs.UpdateBitmap[defaultBM];
    rectangle.visible _ TRUE;
    defaultDS.pfont _ pFonts[0].fnt;

    pBBT.dadr _ BM;
    SetBM[BM]
  END;

  TypeScriptWindow: PUBLIC PROCEDURE=
  BEGIN
    DCBorg^ _ RectangleDefs.DCBnil;
    Zero[BM, smallBMSize];
    DCBorg^ _ typeScriptDCB;
    IF NOT IODefs.NewLine[] THEN IODefs.WriteChar[IODefs.CR]
  END;

  BitMapDisplay: PUBLIC PROCEDURE=
  BEGIN
    IF NOT IODefs.NewLine[] THEN IODefs.WriteChar[IODefs.CR];
    IODefs.WriteLine["[type any character to continue]"];
    [] _ IODefs.ReadChar[];
    DCBorg^ _ RectangleDefs.DCBnil;
    Zero[BM, BMSize];
    DCBorg^ _ displayDCB;
    Rebuild
  END;

  ShrinkBM: PUBLIC PROCEDURE=
  BEGIN
    chunk: CARDINAL= 48; -- Bitmap height decrement in scan lines
    defaultBM: RectangleDefs.BMHandle;
    oldDCB: RectangleDefs.DCBptr _ DCBorg^;

    BMHeight _ BMHeight-chunk; -- chop some scan lines off the bottom
    yMax _ BMHeight-16; -- used in TrackCursor
    BMSize _ BMWordsPerLine*BMHeight; -- display size in words
    IF BMSize<smallBMSize THEN SIGNAL OutOfStorage;

--------------------------------------------------------------------
  -- Reinitialization of display
--------------------------------------------------------------------
    DCBorg^ _ RectangleDefs.DCBnil;
    SystemDefs.FreePages[BM];
    BM _ SystemDefs.AllocatePages[SystemDefs.PagesForWords[BMSize]];
    displayDCB.bitmap _ LOOPHOLE[BM];
    displayDCB.height _ BMHeight/2;
    IF displayDCB.next#RectangleDefs.DCBnil THEN
      displayDCB.next.height_displayDCB.next.height+chunk/2
    ELSE BEGIN
      displayDCB.next _ New[4];
      displayDCB.next^ _ RectangleDefs.DCB[next: RectangleDefs.DCBnil,
        resolution: high, background: black, indenting: 0, width: 0,
        bitmap: NIL, height: chunk/2]
    END;

--------------------------------------------------------------------
    -- Simulate ReallocateBitmap
--------------------------------------------------------------------
    defaultBM _ RectangleDefs.GetDefaultBitmap[];
    defaultBM.addr _ BM;
    defaultBM.height _ defaultBM.words/defaultBM.wordsperline;
    IF InlineDefs.BITAND[defaultBM.height,1]=1 THEN
      defaultBM.height _ defaultBM.height-1;
    [] _ RectangleDefs.UpdateBitmap[defaultBM];

    pBBT.dadr _ BM;
    SetBM[BM];
    TypeScriptWindow;
    IODefs.WriteLine["Storage released by shrinking bitmap"];
    IF oldDCB=displayDCB THEN BitMapDisplay
  END;

  LockFonts: PUBLIC PROCEDURE[pFD: POINTER TO ARRAY FontNumber OF FontDesc]=
  BEGIN i: FontNumber; fsa: RectangleDefs.Fptr;
    pFonts _ pFD; -- save a copy of the pointer

    -- Swap everything out before locking the file segments in core
    SwapEverythingOut;
    FOR i IN FontNumber DO
      IF pFD[i].name.length#0 AND pFD[i].fsh.lock=0 THEN -- if it's not already locked
      BEGIN
        SegmentDefs.SwapIn[pFD[i].fsh]; -- Swap in and lock font segment in low core
        fsa _ SegmentDefs.FileSegmentAddress[pFD[i].fsh];
        pFD[i].height _ fsa.FHeader.MaxHeight;
        pFD[i].fnt _ @fsa.FCDptrs
      END
    ENDLOOP;
  END;
--------------------------------------------------------------------
  -- Initialization code
--------------------------------------------------------------------
  ph: ProcessDefs.ProcessHandle;

  StreamDefs.CursorTrack[FALSE];  -- disable tracking by system
  ph _ ProcessDefs.CreateProcessFromProcedure[TrackCursor, 3];
  ProcessDefs.ActivateProcess[ph];
  IntMask^ _ BITOR[IntMask^, 10B];

  pBBT _ New[16];
  pBBT.dwidth _ BMWordsPerLine
END.
(2048)\413b6B2b5B2b6B2b6B2b8B86b15B123b4B71b9B83b7B255b10B94b10B427b16B1416b13B171b14B73b14B153b11B2233b12B19b6B41b11B701b14B109b14B87b4B230b9B906b12B348b10B349b3B206b17B189b11B1493b16B191b13B282b8B1763b9B