// DiExInit.bcpl
// All the code that can be thrown away after using once
// Last modified March 27, 1982 7:42 PM by Boggs
get "Streams.d"
//get "AltoFileSys.d"
get "DiEx.defs"
external [ CreateDisplayStream; ShowDisplayStream; GetScanLinePos; MyFrame ]// OS statics
external [ InitializeZone; SetKeyboardProc; gacha10 ]
manifest
[ ParamLines = 10; BTsize = ((9*5*407)/8) - 1
EndCode = #335
]
static
[
wbuff; rbuff; DAs; CAs; CbZone; CurrentPS; T
MsgS; HintS; char; HeaderBuff; LabelBuff; TriexHandeling=0
errTable; ETsize=maxEntries*lET*8
FirstDr=0; LastDr=0; Mtable; maxEC=5; PackType=0
WriteEnable = 0; DiexPageId; DiexZone
]
structure VERS [ eng bit 4; blank bit 12 ]
structure DCB: // Display Control Block
[
next word // -> next DCB; 0 if last
parwd word =
[
resolution bit 1 // 0 = high; 1 = low
background bit 1 // 0 = white; 1 = black
indwidth bit 14 =
[
indentation bit 6 // indent 16*indentation bits on the left
width bit 8 // in words; must be even; zero is OK
]
]
bitmap word // -> bit map; must be even
height word // scan lines = 2*height (height in each field)
]
structure StreamCB [ fdcb word; ldcb word; @DCB ]
manifest lStreamCB = size StreamCB/16
let InitFunction() be
[
@EndCode = InitFunction
wbuff = MyGetFixed(1000) //Dont zero this buffer yet, it is this code!!!!!
rbuff = MyGetFixed(300*blks) //Same Here!
if (table [ 61014b; 1401b ])()<<VERS.eng gr 3 then nSectors = 14 //drb 3/27/82
DiexZone = InitializeZone(MyGetFixed(1000), 1000)
CAs = MyGetFixed(100)
DAs = MyGetFixed(100)
CbZone = MyGetFixed(400)
errTable = MyGetFixed(ETsize); initCounters()
T = 10 + MyGetFixed((TableSize*5) + 10)
HeaderBuff = MyGetFixed(32)
LabelBuff = MyGetFixed(32)
let DispBuffLength = (38*FontHeight+6)*2
let DispBuff = MyGetFixed(DispBuffLength)
let Title = CreateDisplayStream(3,DispBuff,DispBuffLength,gacha10,0,0,DiexZone)
ShowDisplayStream(Title,DSalone)
PutTemplate(Title,"*n*n DIablo EXerciser -- DiEx")
PutTemplate(Title," -- version 1.7 (April 24, 1982)")
let DispBuff = MyGetFixed(DispBuffLength)
HintS = CreateDisplayStream(2,DispBuff,DispBuffLength,gacha10,0,DSstopright,DiexZone)
ShowDisplayStream(HintS,DSbelow,Title)
let Dstream = CreatDisplayArea(0,10)
ShowDisplayStream(Dstream,DSabove,HintS)
Dstream = CreatDisplayArea(0,4,0,1)
ShowDisplayStream(Dstream,DSabove,HintS)
PutTemplate(HintS,"*n WARNING - Writing with DIEX will destroy data on your Diablo pack.")
PutTemplate(HintS,"*n Type the character '←' if you wish to enable writing.")
if GetChar() eq #137 then WriteEnable = true
test WriteEnable
ifso PutTemplate(HintS,"*n WARNING - Writing Enabled.*n")
ifnot PutTemplate(HintS,"*n Writing Disabled.*n")
Mtable = InitParam(ParamLines,HintS,gacha10)
InitPtable()
let Yposn = GetScanLinePos(Mtable!-1,ParamLines)
let MsgLines = (770-Yposn)/FontHeight
DispBuffLength = MyFrame()-@EndCode-2000
DispBuff = MyGetFixed(DispBuffLength)
MsgS = CreateDisplayStream(MsgLines,DispBuff,DispBuffLength,gacha10,0,0,DiexZone)
ShowDisplayStream(MsgS,DSbelow,Mtable!-1)
Dstream = CreatDisplayArea(0,2,0,1)
ShowDisplayStream(Dstream,DSabove,MsgS)
SetKeyboardProc(ButtonTrap,MyGetFixed(30),30)
//Msg("*nDispBuffLength = $D*n",DispBuffLength)
Hint(0)
Hint("Welcome to DiEx! ")
char = false
LF(0)
Msg("Use the mouse to point to items in the above menu.")
LF(0)
Msg("Items such as 'Do Test' are activated be pointing to and hitting left button on the mouse")
LF(1)
Msg("(some items need a second mouse click to confirm).")
LF(0)
Msg("Items with a 'Yes/No' flag may be changed by pointing and hitting the left button.")
LF(0)
Msg("Items with numbers may be altered by pointing to and THEN typing a new number.")
LF(1)
Msg("All numbers are decimal.")
LF(1)
Msg("New values are in decimal unless preceded with a '#' for octal.")
LF(1)
Msg("Hitting the left mouse button will enter the last value typed.")
LF(1)
Msg("Hitting the middle mouse button will enter the minimum permissible value.")
LF(1)
Msg("Hitting the right mouse button will enter the maximum permissible value.")
LF(0)
Msg("Actual testing is done by selecting 'Do Test'.")
LF(1)
Msg("The test can be suspended be typing something or hitting any mouse button.")
LF(2)
Msg("Then terminate with character 'N' or middle mouse button.")
LF(2)
Msg("Otherwise you will continue.*n*n")
LF(0)
Msg("Good luck - here is the current disk status:*n*n>>")
ResetDisk(0)
DiskStatus()
]
and LF(lev) be
[
if lev eq 0 then [ Msg("*n*n>> "); return ]
Msg("*n"); for i = 0 to lev do Msg(" ")
]
and MyGetFixed(words) = valof //replaces MyGetFixed that was in operating system
[ let result = @EndCode; @EndCode = result+words+2; resultis result ]
and InitPtable() be
[
T!-1 = nHeads; T!-2 = nSectors; T!-3 = nTracks; T!-4 = 0; T!-5 = 0
Zero(T,5*TableSize) //now I only have to set non-zero parameters
let Tx = nil
for i = 1 to 5 do
[
Tx = T + i*TableSize
Tx>>P.MsgEnable = true
Tx>>P.Repeats = 1
Tx>>P.CylInc = 1
Tx>>P.LastCyl = #7777
Tx>>P.LastHd = #77
Tx>>P.LastSec = #77
Tx>>P.ErrRes = 3
Tx>>P.maxEC = 5
Tx>>P.Chain = true
]
CurrentPS = 0
Tx = T + 1*TableSize //set initial parameters for "Full Test"
Tx>>P.nRandom = 100
Tx>>P.Waction.header = diskCheck
Tx>>P.Waction.label = diskWrite
Tx>>P.Waction.data = diskWrite
Tx>>P.Raction.header = diskCheck
Tx>>P.Raction.label = diskCheck
Tx>>P.Raction.data = diskCheck
Tx>>P.Repeats = 10
Tx>>P.PattR = 1
Tx = T + 2*TableSize //set initial parameters for "Init Labels"
Tx>>P.Patt000 = 1
Tx>>P.Waction.header = diskWrite
Tx>>P.Waction.label = diskWrite
Tx>>P.Waction.data = diskWrite
Tx>>P.Raction.header = diskCheck
Tx>>P.Raction.label = diskRead
Tx>>P.Raction.data = diskRead
Tx = T + 3*TableSize //set initial parameters for "Verify disk"
Tx>>P.Waction.header = diskSkip
Tx>>P.Raction.header = diskCheck
Tx>>P.Raction.label = diskRead
Tx>>P.Raction.data = diskRead
Tx = T + 4*TableSize //set initial parameters for "Custom Comm"
Tx>>P.Waction.header = diskWrite
Tx>>P.Waction.label = diskWrite
Tx>>P.Waction.data = diskWrite
Tx>>P.Raction.header = diskCheck
Tx>>P.Raction.label = diskRead
Tx>>P.Raction.data = diskRead
Tx>>P.Chain = false
Tx>>P.FirstSec = 100
Tx>>P.PattA = 1
test WriteEnable
ifso MoveBlock(T,T+TableSize,TableSize) //set current parameters to Full Test
ifnot MoveBlock(T,T+3*TableSize,TableSize) //set current parameters to Verify disk
]
//The following proceedure is copied from "menu.bcpl" so it can be discarded after init
and InitParam(lines,AboveStream,Font) = valof
[
external [ SetLinePos; lMF ]
let DCB = @#420
//let fontheight = 2*(DCB>>DCB.height)//get height of sysfont
//if Font then fontheight = Font!-2
let stream,Mbuff = nil,nil
if AboveStream then
[
Mbuff = MyGetFixed(lMF*lines*6+2)+2;Zero(Mbuff,lMF*lines*6)
let DispBuffLength = (38*FontHeight + 6)*lines
let DispBuff = MyGetFixed(DispBuffLength)
stream = CreateDisplayStream(lines, DispBuff, DispBuffLength, Font, 0, DSstopright+DSstopbottom,DiexZone)
ShowDisplayStream(stream,DSbelow,AboveStream)
let Dstream = CreatDisplayArea(0,2,0,1)
ShowDisplayStream(Dstream,DSabove,stream)
Mbuff!-1 = stream
Mbuff!-2 = lines
]
stream = Mbuff!-1
for i=1 to lines do //Send enough char's to fill each line in the stream
[ for c=0 to 120 do Puts(stream,#40)
if i ne lines do Puts(stream,$*n)
]
SetLinePos(stream,0)
resultis Mbuff
]
and CreatDisplayArea(buff,nlines,width,background,indent,resolution; numargs nargs) = valof
[
if nargs ls 5 then indent = 0
if nargs ls 4 then background = 0
if nargs ls 3 then width = 0
if nargs ls 4 then nlines = 2
if nargs ls 5 then resolution = 0
let stream = (MyGetFixed(lStreamCB+1) + 1) & #177776
Zero(stream,lStreamCB); Zero(buff,nlines*width)
stream>>StreamCB.fdcb = lv stream>>StreamCB.next
stream>>StreamCB.ldcb = lv stream>>StreamCB.next
stream>>StreamCB.width = width
stream>>StreamCB.indentation = indent
stream>>StreamCB.background = background
stream>>StreamCB.resolution = resolution
stream>>StreamCB.bitmap = buff
stream>>StreamCB.height = nlines/2
resultis stream
]