SimpleTerminalImpl.mesa
Copyright Ó 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
Derived from SimpleTTY.mesa last edited by Forrest January 6, 1981 7:28 PM
McGregor on April 22, 1982 4:23 pm
Birrell, July 7, 1983 3:20 pm
MBrown, September 17, 1983 8:18 pm
Levin on January 17, 1984 11:13:07 am PST
Russ Atkinson (RRA) February 20, 1985 3:38:56 pm PST
Willie-Sue, June 11, 1985 1:17:50 pm PDT
Hal Murray, January 21, 1986 9:01:44 pm PST
Doug Wyatt, January 17, 1987 4:50:01 pm PST
Mike Spreitzer March 4, 1987 12:05:10 pm PST
DIRECTORY
Ascii USING [BS, CR, DEL, ESC, FF, LF, SP, TAB],
Basics USING [bitsPerWord],
BasicTime USING [earliestGMT, TimeNotKnown, FromPupTime, GMT, Now, Period],
Convert USING [RopeFromTime],
File USING [GetVolumeName, SystemVolume, Volume],
IO USING [card, CreateStream, CreateStreamProcs, PutFR, STREAM, StreamProcs, time],
PrincOps USING [BBptr, BBTable, BBTableSpace, BitAddress],
PrincOpsUtils USING [AlignedBBTable, BITBLT, Codebase, MyGlobalFrame],
Process USING [Abort, DisableTimeout, Pause, priorityForeground, priorityRealTime, SecondsToTicks, SetPriority, SetTimeout, Ticks],
Rope USING [Cat, Fetch, Length, ROPE],
SimpleTerminal USING [],
SimpleTerminalBackdoor USING [Impl, ImplRep],
SystemVersion USING [bootFileDate, release],
Terminal USING [Current, GetBWBitmapState, GetBWFrameBuffer, GetKeys, GetMousePosition, FrameBuffer, Position, RegisterNotifier, Select, SetBWBackground, SetBWBitmapState, SetBWCursorPosition, SetMousePosition, SwapNotifier, Virtual, WaitForBWVerticalRetrace],
ThisMachine USING [Address, Name, ProcessorID],
TerminalDefs USING [KeyName, KeyState];
SimpleTerminalImpl: MONITOR LOCKS m USING m: POINTER TO MONITORLOCK
IMPORTS BasicTime, Convert, File, IO, PrincOpsUtils, Process, Rope, SystemVersion, Terminal, ThisMachine
EXPORTS SimpleTerminal, SimpleTerminalBackdoor
= BEGIN
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Impl: TYPE = SimpleTerminalBackdoor.Impl;
ImplRep: TYPE = SimpleTerminalBackdoor.ImplRep;
Constraints to satisfy externally:
A statevector is needed at priority 6 for the keyboard watching process, at least until facilities exist to let it allocate one itself.
If keyboard watcher is to avoid faults, its code and global frame should be pinned.
State: TYPE = {off, turningOn, on, turningOff, joining};
Global variables protected by "simpleTerminalLock"
simpleTerminalLock: MONITORLOCK;
curImpl: Impl;
state: State ← off;
stateChange: CONDITION ← [timeout: 0];
turnOnCount: NAT ← 0;
inStream, outStream: STREAM ← NIL;
Exported to SimpleTerminal and SimpleTerminalBackdoor
SetImpl: PUBLIC SAFE PROC [impl: Impl] RETURNS [ok: BOOL] ~ TRUSTED {
SetImplEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] ~ {
SELECT state FROM
off => IF (ok ← curImpl=defaultImpl) THEN curImpl ← impl;
turningOn, on, turningOff, joining => ok ← FALSE;
ENDCASE => ERROR;
};
SetImplEntry[@simpleTerminalLock];
};
UnsetImpl: PUBLIC SAFE PROC [impl: Impl] ~ TRUSTED {
UnsetImplEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] ~ {
UNTIL state = off DO WAIT stateChange ENDLOOP;
IF curImpl # impl THEN RETURN WITH ERROR CallerError[];
curImpl ← defaultImpl;
};
UnsetImplEntry[@simpleTerminalLock];
};
CallerError: ERROR = CODE;
TurnOn: PUBLIC SAFE PROC [nameStripe: ROPE ← NIL] RETURNS [in, out: STREAM] = CHECKED {[in, out] ← FullTurnOn[nameStripe, NIL]};
FullTurnOn: PUBLIC SAFE PROC [bannerLeft, bannerRight: ROPE ← NIL] RETURNS [in, out: STREAM] = TRUSTED {
TurnOnEntryA: ENTRY PROC [m: POINTER TO MONITORLOCK]
RETURNS [turnOnNeeded: BOOL] = -- INLINE -- {
oldState: State = state;
DO
SELECT state FROM
off => {
IF turnOnCount ~= 0 THEN ERROR;
curImpl.CaptureOriginalState[curImpl];
state ← turningOn;
EXIT
};
turningOff => {
Shutdown was deferred and is still pending. We simply cancel it.
state ← on;
EXIT
};
on => EXIT;
ENDCASE;
WAIT stateChange;
ENDLOOP;
curImpl.ReStart[curImpl];
turnOnCount ← turnOnCount.SUCC;
IF oldState ~= state THEN BROADCAST stateChange;
RETURN[state ~= on]
};
TurnOnEntryB: ENTRY PROC [m: POINTER TO MONITORLOCK] = -- INLINE -- {
state ← on;
BROADCAST stateChange;
};
IF TurnOnEntryA[@simpleTerminalLock] THEN {
IF bannerLeft = NIL THEN bannerLeft ← DefaultBannerLeft[];
IF bannerRight = NIL THEN bannerRight ← DefaultBannerRight[];
[inStream, outStream] ← curImpl.Start[curImpl, bannerLeft, bannerRight];
TurnOnEntryB[@simpleTerminalLock];
};
RETURN [inStream, outStream]
};
DefaultBannerLeft: PUBLIC SAFE PROC RETURNS [ROPE] ~ CHECKED {
RETURN [IO.PutFR["Cedar %g.%g.%g of %t",
IO.card[SystemVersion.release.major],
IO.card[SystemVersion.release.minor],
IO.card[SystemVersion.release.patch],
IO.time[BasicTime.FromPupTime[SystemVersion.bootFileDate]]
]];
};
DefaultBannerRight: PUBLIC SAFE PROC RETURNS [ROPE] ~ CHECKED {
systemVolume: File.Volume = File.SystemVolume[];
volumeLabel: ROPE ←
IF systemVolume = NIL THEN "No System Volume"
ELSE File.GetVolumeName[systemVolume];
name: ROPE;
name ← Rope.Cat[name, ThisMachine.Name[]];
name ← Rope.Cat[name, " (", ThisMachine.Address[]];
name ← Rope.Cat[name, ", ", ThisMachine.ProcessorID[$ProductSoftware], ")"];
RETURN [volumeLabel.Cat[" on ", name]];
};
TurnOff: PUBLIC SAFE PROC = TRUSTED {
ShutdownNeeded: SAFE PROC RETURNS [BOOL] ~ TRUSTED {
TurnOffEntry: ENTRY PROC [m: POINTER TO MONITORLOCK]
RETURNS [shutdown: BOOL] = -- INLINE -- {
DO
SELECT state FROM
off => RETURN[FALSE];
on => EXIT;
ENDCASE => WAIT stateChange;
ENDLOOP;
IF (shutdown ← ((turnOnCount ← turnOnCount.PRED) = 0)) THEN {
state ← turningOff;
BROADCAST stateChange;
};
};
RETURN [TurnOffEntry[@simpleTerminalLock]]};
curImpl.TurnOff[curImpl, ShutdownNeeded];
};
StartShutdown: PUBLIC SAFE PROC RETURNS [needed: BOOL] ~ TRUSTED {
DoShutDownEntryA: ENTRY PROC [m: POINTER TO MONITORLOCK]
RETURNS [needed: BOOL] = INLINE {
IF (needed ← state = turningOff) THEN {
state ← joining;
BROADCAST stateChange;
};
};
needed ← DoShutDownEntryA[@simpleTerminalLock];
};
ShuttingDown: PUBLIC SAFE PROC RETURNS [BOOL] ~ TRUSTED {
GoAway: ENTRY PROC [m: POINTER TO MONITORLOCK] RETURNS [BOOLEAN] = INLINE {
RETURN[state = joining]};
RETURN [GoAway[@simpleTerminalLock]];
};
FinishShutdown: PUBLIC SAFE PROC ~ TRUSTED {
DoShutDownEntryB: ENTRY PROC [m: POINTER TO MONITORLOCK] = INLINE {
state ← off;
BROADCAST stateChange;
};
inStream ← outStream ← NIL;
DoShutDownEntryB[@simpleTerminalLock];
};
InputTimeout: PUBLIC SAFE SIGNAL = CODE;
SetInputTimeout: PUBLIC SAFE PROC [ticks: Process.Ticks] = CHECKED {
curImpl.SetInputTimeout[curImpl, ticks];
};
EnableCursorTracking: PUBLIC SAFE PROC = TRUSTED {
curImpl.EnableCursorTracking[curImpl];
};
DisableCursorTracking: PUBLIC SAFE PROC = TRUSTED {
curImpl.DisableCursorTracking[curImpl];
};
Default Implementation
terminal: Terminal.Virtual ← NIL;
originalTerminal: Terminal.Virtual;
keyboardWatcher, timePainter: PROCESS;
defaultImpl: PUBLIC Impl ← NEW [ImplRep ← [
CaptureOriginalState: CaptureOriginalTerminalState,
Start: TerminalStart,
ReStart: TerminalReStart,
TurnOff: TerminalTurnOff,
SetInputTimeout: SetTerminalInputTimeout,
DisableCursorTracking: DisableTerminalCursorTracking,
EnableCursorTracking: EnableTerminalCursorTracking,
data: NIL]];
CaptureOriginalTerminalState: SAFE PROC [impl: Impl] ~ CHECKED {
originalTerminal ← Terminal.Current[];
};
TerminalStart: SAFE PROC [impl: Impl, bannerLeft, bannerRight: ROPE] RETURNS [in, out: STREAM] ~ TRUSTED {
InitScreen[bannerLeft, bannerRight];
keyboardWatcher ← FORK ProcessKeyboard[];
in ← IO.CreateStream[inStreamProcs, NIL];
out ← IO.CreateStream[outStreamProcs, NIL];
};
TerminalReStart: SAFE PROC [impl: Impl] ~ CHECKED {
[] ← terminal.Select[];
};
TerminalTurnOff: SAFE PROC [impl: Impl, ShutdownNeeded: SAFE PROC RETURNS [BOOL]] ~ CHECKED {
selected: BOOL = Terminal.Current[] = terminal;
The following is intended to be TRUE when the terminal that was current at the time TurnOn was called has a screen displayed. It is therefore more interesting than ours and we should shut our screen down now and make its visible again. If there wasn't a visible screen when TurnOn was called and we are still the current terminal, we leave our screen visible until someone else invokes Terminal.Select.
wantPreviousTerminal: BOOL =
selected AND
originalTerminal ~= terminal AND originalTerminal.GetBWBitmapState[] = displayed;
IF ShutdownNeeded[] AND (~selected OR wantPreviousTerminal) THEN {
DoShutDown[terminal, going, NIL];
IF wantPreviousTerminal THEN [] ← originalTerminal.Select[];
};
};
DoShutDown: Terminal.SwapNotifier = TRUSTED {
IF action = going AND StartShutdown[] THEN {
Process.Abort[keyboardWatcher];
JOIN keyboardWatcher;
JOIN timePainter;
[] ← terminal.SetBWBitmapState[none];
frameBuffer ← NIL;
FinishShutdown[];
};
};
SetTerminalInputTimeout: SAFE PROC [impl: Impl, ticks: Process.Ticks] ~ TRUSTED {
SetInputTimeoutEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = INLINE {
IF ticks = 0 THEN Process.DisableTimeout[@charactersAvailable]
ELSE Process.SetTimeout[@charactersAvailable, ticks];
};
SetInputTimeoutEntry[@keyboardLock];
};
DisableTerminalCursorTracking: SAFE PROC [impl: Impl] ~ TRUSTED {
DisableEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = INLINE {
IF (noTrack ← noTrack + 1) ~= 0 THEN doBlink ← FALSE;
};
DisableEntry[@screenLock];
};
EnableTerminalCursorTracking: SAFE PROC [impl: Impl] ~ TRUSTED {
EnableEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = INLINE {
IF (noTrack ← noTrack - 1) = 0 THEN doBlink ← TRUE;
};
EnableEntry[@screenLock];
};
Keyboard Definitions
KeyState: TYPE = TerminalDefs.KeyState;
KeyName: TYPE ~ TerminalDefs.KeyName;
KeyItem: TYPE ~ RECORD[normal, shift: CHAR] ← [0C, 0C];
KeyTable: ARRAY KeyName OF KeyItem ~ [
COMPLETE--ESC--: [Ascii.ESC, Ascii.ESC], -- Alto ESC, DLion CENTER
One: ['1, '!], -- 1 and !
Two: ['2, '@], -- 2 and @
Three: ['3, '#], -- 3 and #
Four: ['4, '$], -- 4 and $
Five: ['5, '%], -- 5 and %
Six: ['6, '~], -- 6 and ~
Seven: ['7, '&], -- 7 and &
Eight: ['8, '*], -- 8 and *
Nine: ['9, '(], -- 9 and (
Zero: ['0, ')], -- 0 and )
Dash: ['-, '—], -- Alto - and —, DLion -
Equal: ['=, '+], -- = and +
BackSlash: ['\\, '|], -- Alto \ and |, DLion DEFAULTS (top row, right end)
PASTE--LF--: [Ascii.LF, Ascii.LF], -- Alto LF (upper right), DLion COPY (left group)
DELETE--DEL--: [Ascii.DEL, Ascii.DEL], -- Alto DEL, DLion DELETE (left group)
TAB: [Ascii.TAB, Ascii.TAB], -- Alto TAB, DLion <paratab> (large key left of Q)
Q: ['q, 'Q],
W: ['w, 'W],
E: ['e, 'E],
R: ['r, 'R],
T: ['t, 'T],
Y: ['y, 'Y],
U: ['u, 'U],
I: ['i, 'I],
O: ['o, 'O],
P: ['p, 'P],
LeftBracket: ['[, '{], -- [ and {
RightBracket: ['], '}], -- ] and }
Arrow: ['←, '^], -- Alto ← and ^, DLion open quotes
BS: [Ascii.BS, Ascii.BS], -- Alto BS (upper right), DLion ← (large key, upper right)
A: ['a, 'A],
S: ['s, 'S],
D: ['d, 'D],
F: ['f, 'F],
G: ['g, 'G],
H: ['h, 'H],
J: ['j, 'J],
K: ['k, 'K],
L: ['l, 'L],
SemiColon: [';, ':], -- ; and :
Quote: ['\', '\"], -- ' and " (close quotes on DLion)
Return: [Ascii.CR, Ascii.CR], -- Alto RETURN, DLion <newpara> (double-height key, right side)
Z: ['z, 'Z],
X: ['x, 'X],
C: ['c, 'C],
V: ['v, 'V],
B: ['b, 'B],
N: ['n, 'N],
M: ['m, 'M],
Comma: [',, '<], -- , and <
Period: ['., '>], -- . and >
Slash: ['/, '?], -- / and ?
Space: [Ascii.SP, Ascii.SP] -- the space bar
];
Keyboard Implementation
Global variables protected by "keyboardLock"
keyboardLock: MONITORLOCK;
charactersAvailable: CONDITION;
in, out: NAT;
buffer: PACKED ARRAY NAT[0..50) OF CHAR;
ProcessKeyboard: PROC = {
old, new: KeyState ← [bits[ALL[up]]];
blinkCount: NAT ← 33;
TrackCursor: ENTRY PROC[m: POINTER TO MONITORLOCK] = INLINE {
mouse: Terminal.Position ← terminal.GetMousePosition[];
IF noTrack > 0 THEN RETURN;
mouse.x ← MIN[MAX[0, mouse.x], terminal.bwWidth];
mouse.y ← MIN[MAX[0, mouse.y], terminal.bwHeight];
terminal.SetBWCursorPosition[mouse];
terminal.SetMousePosition[mouse]
};
AddToBuffer: ENTRY PROC[m: POINTER TO MONITORLOCK, c: CHAR] = INLINE {
newin: NAT ← in + 1;
IF newin = buffer.LENGTH THEN newin ← 0;
IF newin ~= out THEN {buffer[in] ← c; in ← newin};
};
NotifyCharsAvailable: ENTRY PROC[m: POINTER TO MONITORLOCK] = INLINE {
BROADCAST charactersAvailable;
};
in ← out ← 0;
Process.SetPriority[Process.priorityRealTime];
old.bits ← terminal.GetKeys[];
UNTIL ShuttingDown[] DO
charsSeen: BOOL ← FALSE;
terminal.WaitForBWVerticalRetrace[ ! ABORTED => CONTINUE];
new.bits ← terminal.GetKeys[];
TrackCursor[@screenLock];
IF (blinkCount ← blinkCount - 1) = 0 THEN {BlinkCursor[]; blinkCount ← 34};
FOR i: NAT IN[0..NAT[SIZE[KeyState]]) DO
IF old.words[i] ~= new.words[i] THEN
FOR b: NAT IN[i*Basics.bitsPerWord..(i+1)*Basics.bitsPerWord) DO
k: KeyName ~ VAL[b];
IF old.bits[k]=up AND new.bits[k]=down THEN {
entry: KeyItem ~ KeyTable[k];
char: CHAR ← entry.normal;
IF char#0C THEN {
SELECT TRUE FROM
new.bits[CONTROL--Ctrl--]=down => char ← VAL[ORD[char] MOD 40B];
new.bits[LeftShift]=down, new.bits[RightShift]=down => char ← entry.shift;
new.bits[LOCK]=down AND char IN['a..'z] => char ← entry.shift;
ENDCASE;
AddToBuffer[@keyboardLock, char];
charsSeen ← TRUE;
};
};
ENDLOOP;
ENDLOOP;
IF charsSeen THEN NotifyCharsAvailable[@keyboardLock];
old ← new;
ENDLOOP;
};
Font Definitions
FontRecord: TYPE = MACHINE DEPENDENT RECORD [
newStyle(0:0..0): BOOL,
indexed(0:1..1): BOOL,
fixed(0:2..2): BOOL,
kerned(0:3..3): BOOL,
pad(0:4..15): [0..7777B],
min(1): CHAR, -- limits of chars in font
max(2): CHAR, -- limits of chars in font
maxwidth(3): NAT,
length(4): NAT,
ascent(5): NAT,
descent(6): NAT,
xoffset(7): NAT,
raster(8): NAT,
chars(9:0..63): SELECT OVERLAID * FROM
hasBoundingBox => [
boundingBox(9:0..63): RECORD [FontBBox, FontBBoy, FontBBdx, FontBBDy: INTEGER],
BBBitmap(13): ARRAY [0..0) OF WORD],
noBoundingBox => [bitmap(9): ARRAY [0..0) OF WORD],
ENDCASE
];
font: LONG POINTER TO FontRecord = GetFont[];
bitmap: LONG POINTER = IF font.kerned THEN @font.BBBitmap ELSE @font.bitmap;
height: NAT = font.ascent + font.descent;
xInSegment: LONG POINTER TO ARRAY CHAR [0C..0C) OF NAT =
bitmap + font.raster*height - (font.min-0C);
GetFont: PROC RETURNS [LONG POINTER] = {
Note: Even though it doesn't say so in its strike header, this is a fixed-width
font. Bitter experience has shown that not all Gacha10.strike font files are, in
fact, fixed width. You need to painstakingly examine the xInSegment table for
the truth.
Gacha10Strike: ARRAY [0..1142B) OF WORD = [
-- 0-- 100000B, 000040B, 000176B, 000007B, 001136B, 000010B, 000004B, 000000B,
-- 10-- 000052B, 000000B, 000001B, 000000B, 000000B, 000000B, 000000B, 000000B,
-- 20-- 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
-- 30-- 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
-- 40-- 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
-- 50-- 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
-- 60-- 000000B, 000000B, 017000B, 000040B, 120243B, 106204B, 004010B, 040100B,
-- 70-- 000000B, 000002B, 034040B, 160701B, 107616B, 037070B, 070000B, 000200B,
-- 100-- 010034B, 034041B, 140707B, 107637B, 016104B, 070162B, 022010B, 110434B,
-- 110-- 074161B, 160707B, 144221B, 021104B, 104761B, 141007B, 000000B, 000200B,
-- 120-- 000040B, 001600B, 020010B, 010401B, 140000B, 000000B, 000000B, 000000B,
-- 130-- 000000B, 000000B, 000060B, 103000B, 017000B, 000040B, 120245B, 052412B,
-- 140-- 004020B, 020520B, 000000B, 000002B, 042141B, 011042B, 104021B, 001104B,
-- 150-- 104000B, 000400B, 004042B, 042121B, 021044B, 044020B, 021104B, 020022B,
-- 160-- 042015B, 114442B, 042211B, 011041B, 004221B, 021104B, 104021B, 001001B,
-- 170-- 000000B, 000200B, 000040B, 002000B, 020000B, 000400B, 040000B, 000000B,
-- 200-- 000000B, 000400B, 000000B, 000000B, 000100B, 100400B, 017000B, 000040B,
-- 210-- 121765B, 054412B, 004020B, 020340B, 100000B, 000004B, 046241B, 010042B,
-- 220-- 104020B, 002104B, 104100B, 101000B, 002042B, 056121B, 021044B, 044020B,
-- 230-- 021104B, 020022B, 102015B, 114442B, 042211B, 011041B, 004221B, 025050B,
-- 240-- 050041B, 000401B, 002010B, 034260B, 160643B, 107415B, 026070B, 070440B,
-- 250-- 043313B, 007054B, 032260B, 161704B, 044221B, 021104B, 174100B, 100400B,
-- 260-- 017000B, 000040B, 000503B, 001004B, 000040B, 010520B, 100000B, 000004B,
-- 270-- 052040B, 020704B, 107436B, 002070B, 104100B, 102017B, 101004B, 052121B,
-- 300-- 161004B, 047436B, 020174B, 020023B, 102012B, 112442B, 042211B, 160601B,
-- 310-- 004212B, 025020B, 050101B, 000401B, 007020B, 002311B, 011144B, 042023B,
-- 320-- 031010B, 010500B, 042514B, 110462B, 046311B, 010404B, 044221B, 012104B,
-- 330-- 010100B, 100406B, 057000B, 000040B, 000501B, 101012B, 100040B, 010103B,
-- 340-- 160017B, 100010B, 052040B, 040044B, 104221B, 004104B, 074000B, 002000B,
-- 350-- 001010B, 052211B, 011004B, 044020B, 027104B, 020022B, 042012B, 112442B,
-- 360-- 074211B, 040101B, 004212B, 025020B, 020101B, 000201B, 012476B, 036211B,
-- 370-- 001047B, 142021B, 021010B, 010600B, 042510B, 110442B, 042200B, 140404B,
-- 400-- 042425B, 004104B, 020100B, 100411B, 117000B, 000000B, 003745B, 042321B,
-- 410-- 000040B, 010000B, 100000B, 000010B, 062040B, 100047B, 140221B, 004104B,
-- 420-- 004000B, 001017B, 102000B, 056371B, 011044B, 044020B, 021104B, 020422B,
-- 430-- 042012B, 111442B, 040211B, 021041B, 004212B, 012050B, 020201B, 000201B,
-- 440-- 002020B, 042211B, 001044B, 002021B, 021010B, 010500B, 042510B, 110442B,
-- 450-- 042200B, 020404B, 042425B, 004050B, 020600B, 100300B, 017000B, 000040B,
-- 460-- 001205B, 042521B, 000040B, 010000B, 101400B, 002020B, 042041B, 001040B,
-- 470-- 104221B, 010104B, 104101B, 100400B, 004010B, 040211B, 011044B, 044020B,
-- 500-- 021104B, 020422B, 022012B, 111442B, 040211B, 011041B, 004204B, 012104B,
-- 510-- 020401B, 000101B, 002010B, 042311B, 011144B, 042023B, 021010B, 010440B,
-- 520-- 042510B, 110462B, 046201B, 010444B, 141012B, 012050B, 040100B, 100400B,
-- 530-- 017000B, 000040B, 001203B, 104616B, 100040B, 010000B, 000400B, 002020B,
-- 540-- 034371B, 170700B, 103416B, 010070B, 070100B, 100200B, 010010B, 036211B,
-- 550-- 160707B, 107620B, 016104B, 070342B, 023710B, 110434B, 040161B, 010701B,
-- 560-- 003404B, 012104B, 020761B, 000101B, 002000B, 036260B, 160643B, 102015B,
-- 570-- 021010B, 010420B, 042510B, 107054B, 032200B, 160303B, 041012B, 021020B,
-- 600-- 174100B, 100400B, 000000B, 000000B, 000001B, 000000B, 000020B, 020000B,
-- 610-- 000400B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 100000B,
-- 620-- 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
-- 630-- 000040B, 000000B, 000000B, 000000B, 000001B, 000001B, 000000B, 000000B,
-- 640-- 000000B, 000001B, 000000B, 110000B, 000000B, 000040B, 002000B, 000000B,
-- 650-- 000000B, 000020B, 000100B, 100400B, 000000B, 000000B, 000000B, 000000B,
-- 660-- 000020B, 020000B, 001000B, 000000B, 000000B, 000000B, 000000B, 000000B,
-- 670-- 000001B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
-- 700-- 000000B, 000000B, 000030B, 000000B, 000000B, 000000B, 000001B, 000001B,
-- 710-- 000000B, 000000B, 000000B, 000016B, 000000B, 060000B, 000000B, 000040B,
-- 720-- 002000B, 000000B, 000000B, 000140B, 000100B, 100400B, 000000B, 000000B,
-- 730-- 000000B, 000000B, 000010B, 040000B, 000000B, 000000B, 000000B, 000000B,
-- 740-- 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
-- 750-- 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
-- 760-- 000001B, 140007B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
-- 770-- 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000060B, 103000B,
--1000-- 012602B, 000000B, 000007B, 000016B, 000025B, 000034B, 000043B, 000052B,
--1010-- 000061B, 000070B, 000077B, 000106B, 000115B, 000124B, 000133B, 000142B,
--1020-- 000151B, 000160B, 000167B, 000176B, 000205B, 000214B, 000223B, 000232B,
--1030-- 000241B, 000250B, 000257B, 000266B, 000275B, 000304B, 000313B, 000322B,
--1040-- 000331B, 000340B, 000347B, 000356B, 000365B, 000374B, 000403B, 000412B,
--1050-- 000421B, 000430B, 000437B, 000446B, 000455B, 000464B, 000473B, 000502B,
--1060-- 000511B, 000520B, 000527B, 000536B, 000545B, 000554B, 000563B, 000572B,
--1070-- 000601B, 000610B, 000617B, 000626B, 000635B, 000644B, 000653B, 000662B,
--1100-- 000671B, 000700B, 000700B, 000707B, 000716B, 000725B, 000734B, 000743B,
--1110-- 000752B, 000761B, 000770B, 000777B, 001006B, 001015B, 001024B, 001033B,
--1120-- 001042B, 001051B, 001060B, 001067B, 001076B, 001105B, 001114B, 001123B,
--1130-- 001132B, 001141B, 001150B, 001157B, 001166B, 001175B, 001204B, 001213B,
--1140-- 001222B, 001230B];
The following hack finds the address of constant array Gacha10Strike in the code segment and returns it. This is slightly unethical, but it saves duplicate allocation.
p: LONG POINTER TO ARRAY [0..1142B) OF WORD ←
LOOPHOLE[PrincOpsUtils.Codebase[PrincOpsUtils.MyGlobalFrame[]]];
DO
IF p[0] = Gacha10Strike[0] AND p^ = Gacha10Strike THEN RETURN[p];
p ← p+1;
ENDLOOP;
};
Display Implementation
Global variables protected by "screenLock"
screenLock: MONITORLOCK;
noTrack: CARDINAL ← 0;
doBlink: BOOL ← FALSE;
frameBuffer: Terminal.FrameBuffer ← NIL;
bbTable: PrincOps.BBTableSpace;
bbPtr: PrincOps.BBptr = PrincOpsUtils.AlignedBBTable[@bbTable];
charPos, line, nCharPos, nLines: NAT;
usableHeight, usableWidth: NAT;
firstLine, thisLine: PrincOps.BitAddress;
bitsPerTextLine: NAT; -- = screenWidth*font.height
nameStripeOrg: PrincOps.BitAddress;
nameStripeWidth: NAT;
GetBitAddress: PROC [p: LONG POINTER, o: LONG CARDINAL] RETURNS [PrincOps.BitAddress] = {
RETURN[[p+o/16, 0, o MOD 16]]
};
GetBitBltTable: PROC [frameBuffer: Terminal.FrameBuffer] RETURNS [bb: PrincOps.BBTable] = {
bb ← [dst: [word: NIL, bit: 0], dstBpl: 0,
src: [word: NIL, bit: 0], srcDesc: [srcBpl[0]],
width: 0, height: 0, flags: []];
IF frameBuffer.bitsPerPixel#1 THEN ERROR;
bb.dst ← bb.src ← [word: frameBuffer.base, bit: 0];
bb.dstBpl ← bb.srcDesc.srcBpl ← frameBuffer.wordsPerLine*Basics.bitsPerWord;
bb.width ← frameBuffer.width;
bb.height ← frameBuffer.height;
};
InitScreen: PROC [bannerLeft, bannerRight: ROPE] = {
borderWidth: NAT = 16;
boxWidth: NAT = 1;
marginWidth: NAT = 8;
org: PrincOps.BitAddress;
InitBitmap: PROC = {
zero: CARDINAL ← 0;
bbPtr.dst, bbPtr.height, and bbPtr.width are set up
bbPtr.src ← [@zero, 0, 0];
bbPtr.srcDesc ← [gray[[0, 0, 0, 0]]];
bbPtr.flags ← [gray: TRUE];
PrincOpsUtils.BITBLT[bbPtr];
};
MakeBorder: PROC [w: NAT] = {
stipple: ARRAY [0..3] OF CARDINAL ← [104210B, 104210B, 021042B, 021042B];
bbPtr.dstBpl never changes
bbPtr.src ← [@stipple, 0, 0];
bbPtr.srcDesc ← [gray[[yOffset: 0, widthMinusOne: 0, heightMinusOne: 3]]];
bbPtr.flags ← [gray: TRUE];
top stripe
bbPtr.dst ← org;
bbPtr.width ← usableWidth;
bbPtr.height ← w;
PrincOpsUtils.BITBLT[bbPtr];
bottom stripe
bbPtr.dst ← GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*(usableHeight-w)];
PrincOpsUtils.BITBLT[bbPtr];
left side
bbPtr.dst ← GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*w];
bbPtr.width ← w;
bbPtr.height ← usableHeight - w - w;
PrincOpsUtils.BITBLT[bbPtr];
right side
bbPtr.dst ← GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*w+usableWidth-w];
PrincOpsUtils.BITBLT[bbPtr];
org ← GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*w+w];
usableHeight ← usableHeight - w - w;
usableWidth ← usableWidth - w - w;
};
MakeBox: PROC [w: NAT] = {
black: CARDINAL ← 177777B;
bbPtr.src ← [@black, 0, 0];
bbPtr.srcDesc ← [gray[[yOffset: 0, widthMinusOne: 0, heightMinusOne: w-1]]];
bbPtr.flags ← [gray: TRUE];
top stripe
bbPtr.dst ← org;
bbPtr.width ← usableWidth;
bbPtr.height ← w;
PrincOpsUtils.BITBLT[bbPtr];
bottom stripe
bbPtr.dst ← GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*(usableHeight-w)];
PrincOpsUtils.BITBLT[bbPtr];
left side
bbPtr.dst ← GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*w];
bbPtr.width ← w;
bbPtr.height ← usableHeight-w-w;
PrincOpsUtils.BITBLT[bbPtr];
right side
bbPtr.dst ← GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*w+usableWidth-w];
PrincOpsUtils.BITBLT[bbPtr];
org ← GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*w+w];
usableHeight ← usableHeight - w - w;
usableWidth ← usableWidth - w - w;
};
MakeNameStripe: PROC [bannerLeft, bannerRight: ROPE] = {
black: CARDINAL ← 177777B;
numSign: ROPE = "#";
nameStripeOrg ← org;
nameStripeWidth ← usableWidth;
paint version text
bbPtr.dst ← GetBitAddress[org.word, org.bit+marginWidth];
bbPtr.srcDesc ← [srcBpl[font.raster*16]];
bbPtr.height ← height;
bbPtr.width ← font.maxwidth;
bbPtr.flags ← [];
FOR i: CARDINAL IN CARDINAL[0..bannerLeft.Length[]) DO
bbPtr.src ← GetBitAddress[bitmap, xInSegment[bannerLeft.Fetch[i]]];
PrincOpsUtils.BITBLT[bbPtr];
bbPtr.dst ← GetBitAddress[bbPtr.dst.word, bbPtr.dst.bit+font.maxwidth];
ENDLOOP;
paint volume name
bbPtr.dst ← GetBitAddress[org.word,
org.bit+usableWidth-marginWidth-bannerRight.Length[]*font.maxwidth];
FOR i: CARDINAL IN CARDINAL[0..bannerRight.Length[]) DO
bbPtr.src ← GetBitAddress[bitmap, xInSegment[bannerRight.Fetch[i]]];
PrincOpsUtils.BITBLT[bbPtr];
bbPtr.dst ← GetBitAddress[bbPtr.dst.word, bbPtr.dst.bit+font.maxwidth];
ENDLOOP;
overlay with stripe
bbPtr.src ← [@black, 0, 0];
bbPtr.srcDesc ← [gray[[yOffset: 0, widthMinusOne: 0, heightMinusOne: 0]]];
bbPtr.flags ← [gray: TRUE, dstFunc: xor];
bbPtr.dst ← org;
bbPtr.width ← usableWidth;
bbPtr.height ← height;
PrincOpsUtils.BITBLT[bbPtr];
org ← GetBitAddress[org.word, org.bit+LONG[bbPtr.dstBpl]*height];
usableHeight ← usableHeight - height;
timePainter ← FORK MaintainTime[];
};
[] ← terminal.SetBWBackground[white];
[] ← terminal.SetBWBitmapState[allocated];
frameBuffer ← terminal.GetBWFrameBuffer[];
bbPtr^ ← GetBitBltTable[frameBuffer];
org ← bbPtr.dst;
usableHeight ← bbPtr.height;
usableWidth ← bbPtr.width;
InitBitmap[];
MakeBorder[borderWidth];
MakeBox[boxWidth];
MakeNameStripe[bannerLeft, bannerRight];
now display the bitmap
[] ← terminal.SetBWBitmapState[displayed];
usableHeight ← usableHeight - 2*marginWidth;
usableWidth ← usableWidth - 2*marginWidth;
bitsPerTextLine ← bbPtr.dstBpl*height;
firstLine ←
GetBitAddress[org.word, org.bit+LONG[marginWidth]*bbPtr.dstBpl+marginWidth];
nCharPos ← usableWidth/font.maxwidth;
nLines ← usableHeight/height;
InitPainting[];
};
MaintainTime: PROC = {
bbTable: PrincOps.BBTableSpace;
bbPtr: PrincOps.BBptr = PrincOpsUtils.AlignedBBTable[@bbTable];
black: CARDINAL ← 177777B;
date: ROPE ← NIL;
dateLength: NAT ← 0;
secondsOrg: PrincOps.BitAddress;
lastMinutes: INT ← 0;
SetToBlacken: PROC = {
bbPtr.src ← [@black, 0, 0];
bbPtr.srcDesc ← [gray[[yOffset: 0, widthMinusOne: 0, heightMinusOne: 0]]];
bbPtr.flags ← [gray: TRUE]};
PaintTime: PROC = {
current: BasicTime.GMT = BasicTime.Now[ ! BasicTime.TimeNotKnown => GOTO noTime];
secondsSinceGenesis: INT = BasicTime.Period[from: BasicTime.earliestGMT, to: current];
minutesSinceGenesis: INT = secondsSinceGenesis/60;
IF lastMinutes = minutesSinceGenesis THEN {
seconds: [0..59] ← secondsSinceGenesis MOD 60;
SetToBlacken[];
bbPtr.dst ← secondsOrg;
bbPtr.width ← 2*font.maxwidth;
bbPtr.height ← height;
PrincOpsUtils.BITBLT[bbPtr];
bbPtr.dst & bbPtr.height still OK
bbPtr.srcDesc ← [srcBpl[font.raster*16]];
bbPtr.width ← font.maxwidth;
bbPtr.flags ← [srcFunc: complement];
bbPtr.src ← GetBitAddress[bitmap, xInSegment['0+seconds/10]];
PrincOpsUtils.BITBLT[bbPtr];
bbPtr.dst ← GetBitAddress[bbPtr.dst.word, bbPtr.dst.bit+font.maxwidth];
bbPtr.src ← GetBitAddress[bitmap, xInSegment['0+seconds MOD 10]];
PrincOpsUtils.BITBLT[bbPtr]}
ELSE {
SetToBlacken[];
bbPtr.dst ← GetBitAddress[nameStripeOrg.word,
nameStripeOrg.bit+(nameStripeWidth-dateLength*font.maxwidth)/2];
bbPtr.width ← dateLength*font.maxwidth;
bbPtr.height ← height;
PrincOpsUtils.BITBLT[bbPtr];
date ← Convert.RopeFromTime[from: current, start: years, end: seconds,
includeDayOfWeek: TRUE, useAMPM: FALSE, includeZone: FALSE];
dateLength ← date.Length[];
bbPtr.dst ← GetBitAddress[nameStripeOrg.word,
nameStripeOrg.bit+(nameStripeWidth-dateLength*font.maxwidth)/2];
secondsOrg ← GetBitAddress[bbPtr.dst.word, bbPtr.dst.bit+(dateLength-2)*font.maxwidth];
bbPtr.srcDesc ← [srcBpl[font.raster*16]];
bbPtr.width ← font.maxwidth;
bbPtr.flags ← [srcFunc: complement];
FOR i: CARDINAL IN [0..dateLength) DO
bbPtr.src ← GetBitAddress[bitmap, xInSegment[date.Fetch[i]]];
PrincOpsUtils.BITBLT[bbPtr];
bbPtr.dst ← GetBitAddress[bbPtr.dst.word, bbPtr.dst.bit+font.maxwidth];
ENDLOOP;
};
lastMinutes ← minutesSinceGenesis;
EXITS
noTime => NULL;
};
Process.SetPriority[Process.priorityForeground];
bbPtr^ ← GetBitBltTable[terminal.GetBWFrameBuffer[]];
UNTIL ShuttingDown[] DO
PaintTime[];
Process.Pause[Process.SecondsToTicks[1]];
ENDLOOP;
};
InitPainting: PROC = {
set up standard arguments for character painting
charPos ← 0; line ← 1;
bbPtr.dstBpl already set up
bbPtr.src set when proc called
bbPtr.dst ← thisLine ← firstLine;
bbPtr.srcDesc ← [srcBpl[font.raster*16]];
bbPtr.height ← height;
bbPtr.width ← font.maxwidth;
bbPtr.flags ← [];
};
ClearThisChar: INTERNAL PROC = {
zero: CARDINAL ← 0;
bbPtr.src ← [@zero, 0, 0];
bbPtr.srcDesc ← [gray[[0, 0, 0, 0]]];
bbPtr.flags ← [gray: TRUE];
PrincOpsUtils.BITBLT[bbPtr];
bbPtr.srcDesc ← [srcBpl[font.raster*16]];
bbPtr.flags ← [];
};
DisplayChar: INTERNAL PROC [c: CHAR] = {
Backup: INTERNAL PROC = {
t: NAT = bbPtr.dst.bit+16-font.maxwidth;
IF charPos=0 THEN RETURN;
charPos ← charPos - 1;
bbPtr.dst.word ← bbPtr.dst.word + t/16 - 1;
bbPtr.dst.bit ← t MOD 16;
};
ClearScreen: PROC = {
zero: CARDINAL ← 0;
bbPtr.dst ← firstLine;
bbPtr.src ← [@zero, 0, 0];
bbPtr.srcDesc ← [gray[[0, 0, 0, 0]]];
bbPtr.flags ← [gray: TRUE];
bbPtr.height ← usableHeight;
bbPtr.width ← usableWidth;
PrincOpsUtils.BITBLT[bbPtr];
InitPainting[];
};
Newline: INTERNAL PROC = {
IF line < nLines THEN
{thisLine ← GetBitAddress[thisLine.word, thisLine.bit+bitsPerTextLine]; line ← line+1}
ELSE {
zero: CARDINAL ← 0;
sBBTable: PrincOps.BBTableSpace;
sbbPtr: PrincOps.BBptr = PrincOpsUtils.AlignedBBTable[@sBBTable];
sbbPtr^ ← [
dst: firstLine, dstBpl: bbPtr.dstBpl,
src: GetBitAddress[firstLine.word, firstLine.bit+bitsPerTextLine],
srcDesc: [srcBpl[bbPtr.dstBpl]], flags: [direction: forward],
width: nCharPos*font.maxwidth, height: height*(nLines-1)];
PrincOpsUtils.BITBLT[sbbPtr];
sbbPtr^ ← [
dst: thisLine, src: [@zero, 0, 0],
dstBpl: bbPtr.dstBpl, srcDesc: [gray[[0, 0, 0, 0]]],
width: nCharPos*font.maxwidth, height: height,
flags: [gray: TRUE]];
PrincOpsUtils.BITBLT[sbbPtr];
};
bbPtr.dst ← thisLine;
charPos ← 0;
};
SELECT c FROM
IN (Ascii.SP..'~] => {
IF ~(c IN [font.min..font.max]) THEN c ← font.max + 1;
bbPtr.src ← GetBitAddress[bitmap, xInSegment[c]];
PrincOpsUtils.BITBLT[bbPtr];
};
Ascii.SP => NULL;
Ascii.CR => {Newline[]; RETURN};
Ascii.BS => {Backup[]; ClearThisChar[]; RETURN};
Ascii.TAB => {UNTIL charPos MOD 8 = 0 DO DisplayChar[Ascii.SP]; ENDLOOP; RETURN};
Ascii.FF => {ClearScreen[]; RETURN};
IN [0C..Ascii.SP) => {DisplayChar['^]; DisplayChar[c+('A-1C)]; RETURN};
ENDCASE => RETURN;
IF (charPos ← charPos + 1) >= nCharPos THEN Newline[]
ELSE bbPtr.dst ← GetBitAddress[bbPtr.dst.word, bbPtr.dst.bit + font.maxwidth];
};
BlinkCursor: PROC = {
BlinkCursorEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = {
blinker: CARDINAL ← 60000B;
IF doBlink THEN {
bbPtr.src ← [@blinker, 0, 0];
bbPtr.srcDesc ← [gray[[0, 0, 0, 0]]];
bbPtr.flags ← [gray: TRUE, dstFunc: xor];
PrincOpsUtils.BITBLT[bbPtr];
bbPtr.srcDesc ← [srcBpl[font.raster*16]];
bbPtr.flags ← [];
};
};
IF doBlink THEN BlinkCursorEntry[@screenLock];
};
IO Streams implementation
CreateStreams: PROC = {
};
CharsAvail: SAFE PROC [self: STREAM, wait: BOOL] RETURNS [n: INT] = TRUSTED {
CharsAvailEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = {
WHILE wait AND in = out DO WAIT charactersAvailable ENDLOOP;
n ← in - out;
IF n < 0 THEN n ← n + buffer.LENGTH;
};
CharsAvailEntry[@keyboardLock];
};
EndOf: SAFE PROC [self: STREAM] RETURNS [BOOL] = CHECKED {RETURN[FALSE]};
GetChar: SAFE PROC [self: STREAM] RETURNS [c: CHAR] = TRUSTED {
GetEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] RETURNS [BOOL] = INLINE {
ENABLE UNWIND => NULL;
WHILE in = out DO
WAIT charactersAvailable;
IF in = out THEN RETURN[FALSE];
ENDLOOP;
c ← buffer[out];
IF (out ← out + 1) = buffer.LENGTH THEN out ← 0;
RETURN[TRUE]
};
UNTIL GetEntry[@keyboardLock] DO SIGNAL InputTimeout; ENDLOOP;
};
PutChar: SAFE PROC [self: STREAM, char: CHAR] = TRUSTED {
PutCharEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = INLINE {
doBlink ← FALSE;
ClearThisChar[]; -- to get rid of possible blinker
DisplayChar[char];
doBlink ← TRUE;
};
PutCharEntry[@screenLock];
};
EraseChar: SAFE PROC [self: STREAM, char: CHAR] = TRUSTED {
EraseCharEntry: ENTRY PROC [m: POINTER TO MONITORLOCK] = INLINE {
doBlink ← FALSE;
ClearThisChar[]; -- to get rid of possible blinker
DisplayChar[Ascii.BS];
doBlink ← TRUE;
};
EraseCharEntry[@screenLock];
};
Initialization
inStreamProcs: REF IO.StreamProcs;
outStreamProcs: REF IO.StreamProcs;
Initialize: ENTRY PROC [m: POINTER TO MONITORLOCK] = {
IF ~font.newStyle OR font.indexed OR ~(font.min IN [0C..177C])
OR ~(font.max+1 IN [0C..177C]) THEN ERROR;
inStreamProcs ← IO.CreateStreamProcs[
variety: $input, class: $SimpleTerminal,
getChar: GetChar,
endOf: EndOf,
charsAvail: CharsAvail
];
outStreamProcs ← IO.CreateStreamProcs[
variety: $output, class: $SimpleTerminal,
putChar: PutChar,
eraseChar: EraseChar
];
terminal ← Terminal.Current[];
curImpl ← defaultImpl;
terminal.RegisterNotifier[DoShutDown];
};
Initialize[@simpleTerminalLock];
END.
ChangeLog
WSO, July 30, 1984: catch BasicTime.TimeNotKnown in call to BasicTime.Now.