-- N.Wirth  June 1, 1977
				-- S.Andler  August 24, 1977  10:56 PM
				-- C.Geschke  August 30, 1977  2:54 PM
				-- E.Satterthwaite  September 12, 1977 3:35 PM
				-- R.Johnsson  September 19, 1977  9:52 AM
				-- J.Sandman  October 19, 1977  10:42 AM
				-- R.Johnsson  October 20, 1977  9:18 AM
DIRECTORY
  ControlDefs: FROM "ControlDefs",
  DisplayDefs: FROM "DisplayDefs",
  FontDefs: FROM "FontDefs",
  InlineDefs: FROM "InlineDefs",
  IODefs: FROM "IODefs",
  KeyDefs: FROM "KeyDefs",
  MiscDefs: FROM "MiscDefs",
  ProcessDefs: FROM "ProcessDefs",
  RectangleDefs: FROM "RectangleDefs",
  SchedDefs: FROM "SchedDefs",
  SegmentDefs: FROM "SegmentDefs",
  StreamDefs: FROM "StreamDefs",
  SystemDefs: FROM "SystemDefs",
  TeleSilDefs: FROM "TeleSilDefs",
  TeleSilProcDefs: FROM "TeleSilProcDefs";

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

--------------------------------------------------------------------
TeleSilResident: PROGRAM
  IMPORTS
    DisplayDefs, FontDefs, IODefs, MiscDefs, ProcessDefs,
    SegmentDefs, StreamDefs, SystemDefs, TeleSilProcDefs
  EXPORTS SchedDefs, TeleSilProcDefs =
BEGIN
OPEN TeleSilDefs;

--------------------------------------------------------------------
-- 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 -- 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
  e: CARDINAL;
  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];
cursorIcon: CursorIcon;
gridMask: WORD _ 177777B;

CursorIcons: DESCRIPTOR FOR ARRAY CursorIcon OF CursorBitMap;

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

GrayToneCode: DESCRIPTOR FOR ARRAY GrayTone OF GrayToneMap;

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
Fonts: DESCRIPTOR FOR ARRAY OF FontDesc;
DCBorg: POINTER TO RectangleDefs.DCBptr= @MEMORY[420B];
displayDCB: RectangleDefs.DCBptr;
OutOfStorage: SIGNAL= CODE;

BitBlt: MACHINE CODE [POINTER TO BBT] = LOOPHOLE[RectangleDefs.HardwareBitBlt];

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 _ Fonts[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]=
  BEGIN -- allocate n words with even address
  p: POINTER _ 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

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

  DisplayDefs.InitDisplay[0,0,0,FontDefs.CreateFont[Fonts[0].fsh]];
  pBBT.dadr _ BM
  END;

TypeScriptWindow: PUBLIC PROCEDURE=
  BEGIN
  DCBorg^ _ RectangleDefs.DCBnil;
  DisplayDefs.SetDummyDisplaySize[72];
  DisplayDefs.SetSystemDisplaySize[6,4];
  END;

BitMapDisplay: PUBLIC PROCEDURE=
  BEGIN
  clock: POINTER TO INTEGER = LOOPHOLE[430B];
  now: INTEGER _ clock^;
  UNTIL clock^ - now >= 39 DO NULL ENDLOOP;
  DisplayDefs.SetDummyDisplaySize[0];
  DisplayDefs.SetSystemDisplaySize[0,0];
  DCBorg^ _ displayDCB;
  END;

ShrinkBM: PUBLIC PROCEDURE=
  BEGIN
  chunk: CARDINAL= 48; -- Bitmap height decrement in scan lines
  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

  --------------------------------------------------------------------
  -- 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^ _ [next: RectangleDefs.DCBnil, resolution: high,
			background: black, indenting: 0, width: 0,
			bitmap: NIL, height: chunk/2]
    END;

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

LockFonts: PUBLIC PROCEDURE[FD: DESCRIPTOR FOR ARRAY OF FontDesc]=
  BEGIN
  i: FontNumber; fsa: RectangleDefs.Fptr;
  Fonts _ FD; -- save a copy of the pointer
  -- If first time swapping in fonts, then touch them so Segments is not swapped in
  IF firstTimeFontsIn THEN
    BEGIN
    FOR i IN FontNumber DO
      OPEN s: FD[i].fsh, SegmentDefs;
      SwapIn[@s]; Unlock[@s]; SwapOut[@s];
      firstTimeFontsIn _ FALSE;
      ENDLOOP;
    END;
  -- Swap everything out before locking the file segments in core
  SwapEverythingOut;
  FOR i IN FontNumber DO
    IF FD[i].name.length#0 THEN
      BEGIN
      IF FD[i].fsh.lock = 0 THEN SegmentDefs.SwapIn[FD[i].fsh]; -- Swap in and lock font segment
      fsa _ SegmentDefs.AddressFromPage[FD[i].fsh.VMpage];
      FD[i].height _ fsa.FHeader.MaxHeight;
      FD[i].fnt _ @fsa.FCDptrs
      END
    ENDLOOP;
  END;

firstTimeFontsIn: BOOLEAN _ TRUE;

--------------------------------------------------------------------
  -- Scheduler code, copied from Sched.mesa
--------------------------------------------------------------------
-- all the blocks are chained around in a ring
slot: SchedDefs.SchedHandle;  -- points to the currently active one
main: SchedDefs.SchedObject;  -- one for the normal mesa "main" process

ScheduleeCreate: PUBLIC PROCEDURE [proc:PROCEDURE[UNSPECIFIED], arg: UNSPECIFIED] =
  BEGIN OPEN ControlDefs, SchedDefs;
  self: FrameHandle _ REGISTER[Lreg];
  sched: SchedObject;
  slot.returnlink _ self.returnlink;
  self.returnlink _ [frame[NULLFrame]];
  sched.next _ slot.next;
  sched.previous _ slot;
  slot.next.previous _ @sched;
  slot.next _ @sched;
  slot _ @sched;
  proc[arg];
  sched.previous.next _ sched.next;
  sched.next.previous _ sched.previous;
  slot _ sched.next;
  self.returnlink _ slot.returnlink;
  END;

Yield, ScheduleeYields: PUBLIC PROCEDURE =
  BEGIN OPEN ControlDefs, SchedDefs;
  self: FrameHandle _ REGISTER[Lreg];
  slot.returnlink _ self.returnlink;
  slot _ slot.next;
  self.returnlink _ slot.returnlink;
  END;

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

pBBT _ New[16];
pBBT.dwidth _ BMWordsPerLine;

-- scheduler initialization
slot _ @main;
slot.next _ slot.previous _ slot;

-- cursor and graytone initialization

CursorIcons _ TeleSilProcDefs.GetCursorIcons[];
GrayToneCode _ TeleSilProcDefs.GetGrayToneCode[];

END.
(1799)\846b6B2b5B2b6B2b6B2b8B71b15B333b11B35b8B38b10B92b10B405b16B209b7B35b12B36b9B43b10B14b8B19b11B52b13B165b14B70b14B151b11B528b12B49b3B679b4B18b2B39b8B58b6B63b4B29b4B48b5B36b6B50b10B24b12B17b6B75b11B673b14B100b14B79b4B220b9B818b12B332b10B333b3B193b17B178b11B575b16B150b13B254b8B1173b9B1260b15B519b22B