// CRTTest.bcpl -- Test pattern generator for height, width, // and pin-cushion adjustment // Copyright Xerox Corporation 1979, 1983 // Last modified August 25, 1983 3:07 PM by Boggs get "AltoDefs.d" external [ // incoming procedures Zero; BitBlt; SetBlock; MoveBlock; Usc // incoming statics AltoVersion; lvUserFinishProc ] static [ savedUserFinishProc ] manifest [ yMax = 808 stkLim = 335b ] structure XBBT: // extended BitBlt table [ @BBT = [ long bit 1 ] lsbca^0,1 word ldbca^0,1 word ] manifest lXBBT = size XBBT/16 structure XDCB: // extended DCB [ @DCB longBitMap^0,1 word ] manifest lXDCB = size XDCB/16 //----------------------------------------------------------------------------------------- let CrtTest() be //----------------------------------------------------------------------------------------- [ savedUserFinishProc = @lvUserFinishProc @lvUserFinishProc = UserFinishProc Zero(cursorBitMap, 16) let bitMapInXM = SetDisplayConfig(true) let nWords = bitMapInXM? 64, 38 let xMax = nWords*16 let lenBitMap = nWords * yMax let dcb = (@stkLim+1) & -2; Zero(dcb, lXDCB) @stkLim = dcb + lXDCB let bitMap = bitMapInXM? 0, dcb + lXDCB unless bitMapInXM do @stkLim = bitMap+lenBitMap dcb>>DCB.width = nWords dcb>>DCB.bitmap = bitMapInXM? 177423B, bitMap dcb>>DCB.height = bitMapInXM? 100000B+yMax/2, yMax/2 dcb>>XDCB.longBitMap^1 = 1 // bank 1, word 0 // Set up BitBlt table let bbt = vec lXBBT; bbt = (bbt+1) & -2; Zero(bbt, lXBBT) bbt>>XBBT.long = bitMapInXM bbt>>BBT.sType = 3 //gray, op is replace (0) bbt>>BBT.dbca = bitMap bbt>>BBT.dbmr = nWords bbt>>XBBT.ldbca^1 = 1 // bank 1, word 0 bbt>>XBBT.lsbca^1 = 1 let keys = vec 3; MoveBlock(keys, kbdAd, 4) while true do for i = 0 to 8 do [ // Zero the bit map Zero(lv bbt>>BBT.gray, 4) bbt>>BBT.dlx = 0 bbt>>BBT.dty = 0 bbt>>BBT.dw = nWords*16 bbt>>BBT.dh = yMax BitBlt(bbt) @displayListHead = dcb switchon i into [ case 0 to 3: [ SetBlock(lv bbt>>BBT.gray, -1, 4) let xSpacing, ySpacing = nil, nil switchon i into [ case 0: xSpacing = 10; ySpacing = 10; endcase case 1: xSpacing = xMax-2; ySpacing = yMax-2; endcase case 2: xSpacing = 25; ySpacing = 25; endcase case 3: xSpacing = 5; ySpacing = 5; endcase ] let xRem = (xMax-2) rem xSpacing let xLeft = xRem rshift 1 let xWidth = xMax-xRem let yRem = (yMax-2) rem ySpacing let yTop = yRem rshift 1 let yHeight = yMax-yRem bbt>>BBT.dlx = xLeft bbt>>BBT.dh = 2 bbt>>BBT.dw = xWidth bbt>>BBT.dty = yTop while bbt>>BBT.dty le yTop+yHeight do //horizontal lines [ BitBlt(bbt) bbt>>BBT.dty = bbt>>BBT.dty + ySpacing ] bbt>>BBT.dty = yTop bbt>>BBT.dh = yHeight bbt>>BBT.dw = 2 bbt>>BBT.dlx = xLeft while bbt>>BBT.dlx le xLeft+xWidth do //vertical lines [ BitBlt(bbt) bbt>>BBT.dlx = bbt>>BBT.dlx + xSpacing ] endcase ] case 4 to 6: [ switchon i into [ case 4: bbt>>BBT.gray^0 = 125252B; bbt>>BBT.gray^1 = 052525B bbt>>BBT.gray^2 = 125252B; bbt>>BBT.gray^3 = 052525B endcase case 5: bbt>>BBT.gray^0 = 146314B; bbt>>BBT.gray^1 = 146314B bbt>>BBT.gray^2 = 031463B; bbt>>BBT.gray^3 = 031463B endcase case 6: bbt>>BBT.gray^0 = 140300B; bbt>>BBT.gray^1 = 140300B bbt>>BBT.gray^2 = 006014B; bbt>>BBT.gray^3 = 006014B endcase ] bbt>>BBT.dh = yMax bbt>>BBT.dw = xMax bbt>>BBT.dty = 0 bbt>>BBT.dlx = 0 BitBlt(bbt) endcase ] case 7: [ SetBlock(lv bbt>>BBT.gray, -1, 4) bbt>>BBT.dty = 0 bbt>>BBT.dh = yMax bbt>>BBT.dw = 2 bbt>>BBT.dlx = xMax/2 BitBlt(bbt) endcase ] case 8: [ SetBlock(lv bbt>>BBT.gray, -1, 4) bbt>>BBT.dlx = 0 bbt>>BBT.dh = 2 bbt>>BBT.dw = xMax bbt>>BBT.dty = yMax/2 BitBlt(bbt) endcase ] ] let newKeys, oldKeys = vec 3, vec 3 MoveBlock(newKeys, kbdAd, 4) let foo = valof [ MoveBlock(oldKeys, newKeys, 4) MoveBlock(newKeys, kbdAd, 4) if (newKeys!2 & 40000B) eq 0 then finish // ESC gets us out for i = 0 to 3 if Usc(oldKeys!i, newKeys!i) gr 0 resultis true ] repeat ] ] //----------------------------------------------------------------------------------------- and SetDisplayConfig(wide) = valof //----------------------------------------------------------------------------------------- [ let machine = AltoVersion<