// SwatKeyboard.bcpl - Keyboard Input
// Copyright Xerox Corporation 1979
// Last modified February 24, 1979 3:24 PM by Boggs
get "Swat.decl"
get "Streams.d"
get "AltoFileSys.d"
external
[
// outgoing procedures
InitRead
ReadSwapOut; ReadSwapIn
ReadChar; ReadLine; ReadString
ReadFromFile; ReadFromKeys; Confirm
// incoming procedures from OS
OpenFile; Closes; Endofs; Gets; Puts
CreateDiskStream; GetCompleteFa; JumpToFa
MoveBlock; SetBlock; Allocate; Free
EraseBits; CharWidth
// incoming procedures from Swat
CheckInterruptSystem; ReportFail; Fail
PutTemplate; Ws
// incoming statics
sysZone; keys; dsp
]
static
[
fileCFA // -> cfa for command file
fileStream = 0 // -> disk stream or 0 to read from keys
]
//----------------------------------------------------------------------------
let InitRead() be
//----------------------------------------------------------------------------
[
fileCFA = Allocate(sysZone, lCFA)
// an uninitialized fp of zeros matches page 0's label and can clobber it!
SetBlock(fileCFA, 125252b, lCFA)
]
//----------------------------------------------------------------------------
and ReadChar() = valof
//----------------------------------------------------------------------------
[
test fileStream eq 0
ifso resultis Gets(keys)
ifnot test Endofs(fileStream)
ifso
[
ReadFromKeys()
resultis Gets(keys)
]
ifnot
[
let char = Gets(fileStream)
GetCompleteFa(fileStream, fileCFA)
resultis char
]
]
//----------------------------------------------------------------------------
and ReadString(prompt) = valof
//----------------------------------------------------------------------------
[
let cr(c) = c eq $*n
let fname = ReadLine(prompt, cr, true)
fname>>String.length = fname>>String.length -1 // remove *n
if fname>>String.length ne 0 resultis fname
Free(sysZone, fname)
resultis 0
]
//----------------------------------------------------------------------------
and Confirm(string, arg0, arg1, arg2; numargs na) = valof
//----------------------------------------------------------------------------
[
test na gr 0
ifso PutTemplate(dsp, string, arg0, arg1, arg2)
ifnot Ws(" [Confirm] ")
switchon ReadChar() into
[
case $*n: case $y: case $Y:
[ Ws("Yes*n"); resultis true ]
case $N: case $n: case $*177:
[ Ws("No*N"); resultis false ]
default:
[ Ws("Yes or No? "); endcase ]
] repeat
]
//----------------------------------------------------------------------------
and ReadLine(prompt, stop, pack; numargs na) = valof
//----------------------------------------------------------------------------
[
if na ls 3 then pack = false
let b = vec 200
CheckInterruptSystem(true) // check it and reenable
Ws(prompt)
let count = 0
[
let char = ReadChar(); switchon char into
[
case $*001: // ↑A
if stop(char) docase -1
case $*010: // BS
[
if count ne 0 then
[
let char = b!count
test char ls 40b
ifnot EraseBits(dsp, -CharWidth(dsp, char))
ifso test char eq $*033
ifso EraseBits(dsp, -CharWidth(dsp, $$))
ifnot
[
EraseBits(dsp, -CharWidth(dsp, char+100b))
EraseBits(dsp, -CharWidth(dsp, $↑))
]
count = count -1
]
endcase
]
case $*177: // DEL
[ Ws(" XXX*N"); Fail() ]
case -1:
default:
[
if count ge 200 then ReportFail("Line too long (>200)")
count = count +1
b!count = char
test char ls 40b
ifnot Puts(dsp, char)
ifso test char eq $*033
ifso Puts(dsp, $$)
ifnot test char eq $*N
ifso Puts(dsp, $*N)
ifnot [ Puts(dsp, $↑); Puts(dsp, char+100b) ]
if stop(char) break
endcase
]
]
] repeat
let result = nil
test pack
ifso
[
result = Allocate(sysZone, count rshift 1 +1)
result>>String.length = count
for i = 1 to count do result>>String.char↑i = b!i
]
ifnot
[
result = Allocate(sysZone, count+1)
result!0 = count
for i = 1 to count do result!i = b!i
]
resultis result
]
//----------------------------------------------------------------------------
and ReadFromFile() be // $↑Y command - read from command file
//----------------------------------------------------------------------------
[
let name = ReadString("Command file: ")
if name eq 0 return
fileStream = OpenFile(name, ksTypeReadOnly, charItem)
test fileStream eq 0
ifso PutTemplate(dsp, "$S not found*N", name)
ifnot GetCompleteFa(fileStream, fileCFA)
Free(sysZone, name)
]
//----------------------------------------------------------------------------
and ReadFromKeys() be
//----------------------------------------------------------------------------
if fileStream ne 0 then [ Closes(fileStream); fileStream = 0 ]
//----------------------------------------------------------------------------
and ReadSwapOut() be
//----------------------------------------------------------------------------
if fileStream ne 0 then Closes(fileStream)
//----------------------------------------------------------------------------
and ReadSwapIn(ok) be
//----------------------------------------------------------------------------
test ok & fileStream ne 0
ifso
[
fileStream = CreateDiskStream(lv fileCFA>>CFA.fp,
ksTypeReadOnly, charItem)
test fileStream ne 0
ifso JumpToFa(fileStream, lv fileCFA>>CFA.fa)
ifnot Ws("Can't reopen command file*N")
]
ifnot fileStream = 0