// 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<<VERS.eng
if machine eq 4 % machine eq 5 then  // Dolphin or Dorado?
   [
   let SDC = table [ 61032B; 1401B ]
   let oldTrap = trapVector!2
   trapVector!2 = SDC+1  // if trap occurs, return from SDC
   let newWidth = SDC(wide)
   trapVector!2 = oldTrap
   resultis newWidth eq 64
   ]
resultis false
]

//-----------------------------------------------------------------------------------------
and UserFinishProc(code) be
//-----------------------------------------------------------------------------------------
[
@lvUserFinishProc = savedUserFinishProc
@displayListHead = 0
SetDisplayConfig(false)
]