// KeyTest.bcpl - Nate Tobol and David Boggs
// Copyright Xerox Corporation 1979
// Last modified January 12, 1980 4:56 PM by Boggs
get "AltoDefs.d"
external
[
// incoming procedures
SetBlock; Zero; MoveBlock; BitBlt; Min; Max
// incoming statics
gacha10; alto1Kbd; alto2Kbd; teak3Kbd; keyset
]
static [ kbd; bitMap; bbt; version ]
manifest
[
xMax = 606
yMax = 808
nWords = 38
lenBitMap = nWords * yMax
stkLim = 335b
// cursor shapes
box = 1
arrow = 2
]
structure Strike: // Strike font with xPosTable slapped on front
[
xPosTable word // -> table of x positions
blank word // flags
min word // lowest char code
max word // highest char code
blank word 2 // maxWidth and length
ascent word // number of words above baseline
descent word // number of words below baseline
blank word // xoffset for kerning
raster word // for bitmap
bitmap word // begins here is raster*(descent+ascent) long
// then comes the xPosTable pointed to above
]
structure Box:
[
lX word // left x
tY word // top y
rX word // right x
bY word // bottom y
]
structure Key:
[
b1: @Box
b2: @Box
char word
]
manifest lenKey = size Key/16
structure Kbd:
[
numKeys word
keyset word
key↑0,0 @Key
]
//----------------------------------------------------------------------------
let KeyTest() be
//----------------------------------------------------------------------------
[
let dcb = (@stkLim+1) & -2; Zero(dcb, lenBitMap+lDCB)
@stkLim = @stkLim + lenBitMap + lDCB +1
bitMap = dcb + lDCB
dcb>>DCB.width = nWords
dcb>>DCB.bitmap = bitMap
dcb>>DCB.height = yMax/2
@displayListHead = dcb
let v = vec 16; bbt = (v+1) & -2; Zero(bbt, 16)
bbt>>BBT.dbca = bitMap
bbt>>BBT.dbmr = nWords
SetBlock(lv bbt>>BBT.gray, -1, 4)
gacha10>>Strike.xPosTable = lv gacha10>>Strike.bitmap +
gacha10>>Strike.raster * (gacha10>>Strike.ascent + gacha10>>Strike.descent)
gacha10>>Strike.max = gacha10>>Strike.max - gacha10>>Strike.min
kbd = alto1Kbd
version = table [ 61014b; 1401b ]()<<VERS.eng
DoIt()
]
//----------------------------------------------------------------------------
and DoIt() be
//----------------------------------------------------------------------------
[
// keyset
if kbd>>Kbd.keyset then
for i = 0 to 4*8 -1 by 4 do
[
let b = keyset+i
DoArea(b>>Box.lX, b>>Box.tY, b>>Box.rX, b>>Box.tY, 0) //top
DoArea(b>>Box.rX, b>>Box.tY, b>>Box.rX, b>>Box.bY, 0) //right
DoArea(b>>Box.lX, b>>Box.tY, b>>Box.lX, b>>Box.bY, 0) //left
DoArea(b>>Box.lX, b>>Box.bY, b>>Box.rX, b>>Box.bY, 0) //bottom
]
// keyboard
for i = 0 to kbd>>Kbd.numKeys-1 do
[
let key = lv kbd>>Kbd.key↑i
let b1 = lv key>>Key.b1
let b2 = lv key>>Key.b2
if b1>>Box.lX eq 0 loop
DoArea(b1>>Box.lX, b1>>Box.tY, b1>>Box.rX, b1>>Box.tY, 0) //top
DoArea(b1>>Box.rX, b1>>Box.tY, b1>>Box.rX, b1>>Box.bY, 0) //right
DoArea(b1>>Box.lX, b1>>Box.tY, b1>>Box.lX, b1>>Box.bY, 0) //left
test b2>>Box.lX ne 0
ifso
[
DoArea(b2>>Box.rX, b2>>Box.tY, b2>>Box.rX, b2>>Box.bY, 0) //right
DoArea(b2>>Box.lX, b2>>Box.tY, b2>>Box.lX, b2>>Box.bY, 0) //left
DoArea(b2>>Box.lX, b2>>Box.bY, b2>>Box.rX, b2>>Box.bY, 0) //bottom
]
ifnot DoArea(b1>>Box.lX, b1>>Box.bY, b1>>Box.rX, b1>>Box.bY, 0) //bot
if key>>Key.char ne 0 then DisplayChar(b1, key>>Key.char)
]
// KeyTest (cont'd)
let newKey, oldKey = vec 5, vec 5; SetBlock(oldKey, -1, 6) //all keys up
let oldUtilIn, newUtilIn = -1, nil
let cursorShape = 0
[ //program main loop
newUtilIn = @utilIn
MoveBlock(newKey, kbdAd, 6)
//mouse
if @mouseX gr xMax-16 then @mouseX = xMax-16
if @mouseX ls 0 then @mouseX = 0
@cursorX = @mouseX
if @mouseY gr yMax-16 then @mouseY = yMax-16
if @mouseY ls 0 then @mouseY = 0
@cursorY = @mouseY
test @cursorY gr 700
ifnot
[
if cursorShape ne box then
[
MoveBlock(cursorBitMap,(table [
177777b; 177777b; 140003b; 140003b; 140003b;
140003b; 140003b; 140003b; 140003b; 140003b;
140003b; 140003b; 140003b; 140003b; 177777b;
177777b ]), 16)
cursorShape = box
]
if oldUtilIn<<UtilIn.mouse ne newUtilIn<<UtilIn.mouse then
[
let mouse = 140003b
if newUtilIn<<UtilIn.red eq 0 then mouse = mouse % 14000b
if newUtilIn<<UtilIn.yellow eq 0 then mouse = mouse % 600b
if newUtilIn<<UtilIn.blue eq 0 then mouse = mouse % 30b
for i = 4 to 9 do cursorBitMap!i = mouse
]
]
ifso
[
if cursorShape ne arrow then
[
MoveBlock(cursorBitMap,(table [
100000b; 140000b; 160000b; 170000b; 174000b;
176000b; 177000b; 170000b; 154000b; 114000b;
006000b; 006000b; 003000b; 003000b; 001400b;
001400b ]), 16)
cursorShape = arrow
]
if (newUtilIn & 7) ne 7 break
]
// DoIt (Cont'd)
// keyset
if oldUtilIn<<UtilIn.keyset ne newUtilIn<<UtilIn.keyset then
for i = 0 to 4 do
[
let new = 1-((newUtilIn rshift (7-i)) & 1)
let old = 1-((oldUtilIn rshift (7-i)) & 1)
if new ne old then
[
let b = keyset + (i*4)
DoArea(b>>Box.lX+2, b>>Box.tY+2, b>>Box.rX-2, b>>Box.bY-2,
(new eq 1? 0, 3))
]
]
// keyboard
for i = 0 to kbd>>Kbd.numKeys/16 -1 do
if newKey!i ne oldKey!i then //some keys changed
[
let diff = newKey!i xor oldKey!i
for j = 0 to 15 do
if (diff & (1b15 rshift j)) ne 0 then
[
let key = lv kbd>>Kbd.key↑(16*i+j)
let b1 = lv key>>Key.b1
DoArea(b1>>Box.lX+2, b1>>Box.tY+2, b1>>Box.rX-2,
b1>>Box.bY-2, 2)
let b2 = lv key>>Key.b2
unless b2>>Box.lX eq 0 do
[
DoArea(Max(b1>>Box.lX, b2>>Box.lX)+2, b1>>Box.bY-1,
Min(b1>>Box.rX, b2>>Box.rX)-2, b2>>Box.tY+1, 2)
DoArea(b2>>Box.lX+2, b2>>Box.tY+2, b2>>Box.rX-2,
b2>>Box.bY-2, 2)
]
]
]
oldUtilIn = newUtilIn
MoveBlock(oldKey, newKey, 6)
] repeat
kbd = kbd eq alto1Kbd? alto2Kbd,
(kbd eq alto2Kbd & version eq 4)? teak3Kbd, alto1Kbd
Zero(bitMap, lenBitMap)
] repeat
//----------------------------------------------------------------------------
and DoArea(lX, tY, rX, bY, op) be
//----------------------------------------------------------------------------
// op = 0 to set to black
// 2 to compliment
// 3 to set to white
[
bbt>>BBT.sType = 3 //gray
bbt>>BBT.op = op
bbt>>BBT.dlx = lX
bbt>>BBT.dty = tY
bbt>>BBT.dw = rX-lX +1
bbt>>BBT.dh = bY-tY +1
BitBlt(bbt)
]
//----------------------------------------------------------------------------
and DisplayChar(box, char) be
//----------------------------------------------------------------------------
[
char = char-gacha10>>Strike.min
if char ls 0 % char gr gacha10>>Strike.max then //show black box
char = gacha10>>Strike.max +1
let xpos = gacha10>>Strike.xPosTable
let width = xpos!(char+1)-xpos!char
let height = gacha10>>Strike.ascent + gacha10>>Strike.descent
bbt>>BBT.sType = 0
bbt>>BBT.op = 1
bbt>>BBT.dlx = box>>Box.lX + (box>>Box.rX-box>>Box.lX)/2 - width/2
bbt>>BBT.dty = box>>Box.tY + (box>>Box.bY-box>>Box.tY)/2 - height/2
bbt>>BBT.dw = width
bbt>>BBT.dh = height
bbt>>BBT.sbca = lv gacha10>>Strike.bitmap
bbt>>BBT.sbmr = gacha10>>Strike.raster
bbt>>BBT.slx = xpos!char
bbt>>BBT.sty = 0
BitBlt(bbt)
]