//  Type.bcpl - Type a text file
//  last modified January 31, 1978
// Copyright Xerox Corporation 1979

//Run BLDR with "BLDR/f Type GP template

get "Streams.d"

external		//statics declared elsewhere
	[ keys; dsp ]


external		//procedures declared elsewhere
	[
	SetupReadParam; ReadParam; Wss; Ws; Wo; PutTemplate; Zero; GetFixed 
	Gets; Puts; Opens; Endofs; GetBitPos; Closes; FileLength; Resets; FilePos; SetFilePos 
	CreateDisplayStream; ShowDisplayStream; Putbacks; ResetLine 
	]

static
	[
	Warnings; Errors; screen; Nlines; Pointers; Position; Switch; char
	TabSet=0; BravoFormat=true; LineCnt; Cnt=false
	]

manifest [ ContC=3; Space=#40; TAB=#11; ESC = #33; DEL = #177; black=1; white=0 ] 

structure StreamCB [ fdcb word; ldcb word; @DCB	]
manifest lStreamCB = size StreamCB/16

let TypeProc() be
	[
	let xPointers = vec 2000
	Pointers = xPointers
	let DCB = @#420
	let fontHeight = DCB>>DCB.height*2
	Nlines = (750/fontHeight) - 6
	let v = vec 30000
	screen = CreateDisplayStream(Nlines,v,30000)
	ShowDisplayStream(screen,DSbelow)
	let Bar = CreatDisplayArea(0,4,0,black)//black line under system window
	ShowDisplayStream(Bar,DSbelow)
	Bar = CreatDisplayArea(0,2,0,white)//white space between system window and bar
	ShowDisplayStream(Bar,DSbelow)
	Bar = CreatDisplayArea(0,4,0,white)//white at the verry bottom of the screen
	ShowDisplayStream(Bar,DSbelow,screen)
	Bar = CreatDisplayArea(0,4,0,black)//black line under print out window
	ShowDisplayStream(Bar,DSbelow,screen)
	Ws("*n*n*n Type.run of January 31, 1978*n")

	let FileName = vec 40
	let Done,Command = nil,nil
	let SwitchVec = vec 20; Switch = SwitchVec
	Switch!1 = 0
	SetupReadParam(0,0,0,SwitchVec)
	for i = 1 to Switch!0 do
		[
		if (Switch!i ge $0) & (Switch!i le $9) then TabSet = Switch!i
		if (Switch!i & #137) eq $Z then BravoFormat = false
		if (Switch!i & #137) eq $L then Cnt = 1
		if (Switch!i & #137) eq $C then Cnt = 2
		]
//Now start the file loop
		[
		let Ptr = vec 4
		let file = ReadParam($I,-1,FileName)
		if file eq true then break
		let ReportLength = true
		LineCnt = 1
		PutTemplate(dsp,"*n  File: $S",FileName)
		Position = Pointers
		char = $*n
			[ Done = PrintLines(file)
			if ReportLength then
				[ FilePos(file,Position)
				let Length = FileLength(file,Ptr); SetFilePos(file,Position!0,Position!1)
				PutTemplate(dsp," (Length = $ED bytes)",Ptr); ReportLength = false
				]
			if Done then
				[ [ if Endofs(keys) then break; Gets(keys) ] repeat
				Wss(screen,"*n*nEnd of File- type any character when done")
				 ]
			Command = Gets(keys)
			if Command eq $↑ then
				[ Position = Position-6; if Position ls Pointers then Position = Pointers 
				SetFilePos(file,Position!0,Position!1); LineCnt = Position!2
				Wss(screen,"*n*n*n*n*n*n*n*n"); char = $*n;  Done = false
				]
			if (Command eq DEL) % (Command eq ContC) then break
			if (Command eq ESC) % Done then
				[ Wss(screen,"*n*n*n*n*n~~~~~~~~~~~~~~~~*n"); break ]
			] repeat
		Closes(file)
		if (Command eq DEL) % (Command eq ContC) then break
		] repeat
    ]

and PrintLines(file) = valof
	[
	let buff = vec 2
	let LineOvfl = false
	FilePos(file,Position);Position!2 = LineCnt; Position = Position+3
	let lines = 0
	let oldPosn,Posn = 0,0
		[
		if Endofs(file) then resultis true 
		if LineOvfl % (char eq $*n) then
			[
			if char eq $*n then switchon Cnt into
				[
				case 1: PutTemplate(screen,"$3UD:",LineCnt); endcase
				case 2:  FilePos(file,buff); PutTemplate(screen," $4EO:",buff); endcase
				default: Wss(screen, "  ")
				]
			if LineOvfl then Wss(screen, "~~")
			if (lines ge Nlines-4) then if (lines ge Nlines-3) % (char eq $*n) then
				[ Wss(screen,">"); char = 0; resultis false ]
			Wss(screen," ")
		]
		if not LineOvfl then char = Gets(file)
		if BravoFormat & (char eq ($Z&#37)) then
			[ if Endofs(file) then resultis true
			char=Gets(file);if char eq $*n then break
			] repeat
		test char eq TAB ifnot Puts(screen,char) ifso switchon TabSet into
			[
			case $9:	Puts(screen,Space)	//put 9 spaces 
			case $8:	Puts(screen,Space)	//put 8 spaces 
			case $7:	Puts(screen,Space)	//put 7 spaces 
			case $6:	Puts(screen,Space)	//put 6 spaces 
			case $5:	Puts(screen,Space)	//put 5 spaces 
			case $4:	Puts(screen,Space)	//put 4 spaces 
			case $3:	Puts(screen,Space)	//put 3 spaces 
			case $2:	Puts(screen,Space)	//put 2 spaces 
			case $1:	Puts(screen,Space)	//put 1 spaces 
			case $0:	endcase				//put 0 spaces 
			default:	Puts(screen,TAB)	//put a real tab character 
			]
		oldPosn = Posn; Posn = GetBitPos(screen)
		LineOvfl =  (Posn ls oldPosn) & (char ne $*n)? true,false
		if LineOvfl then ResetLine(screen)
		if LineOvfl % (char eq $*n) then lines = lines+1
		if char eq $*n then LineCnt = LineCnt+1
		] repeat
	]

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 = (GetFixed(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
	]