// Oedit.bcpl 
// Copyright Xerox Corporation 1979,1980


// Oedit was rewritten by Lyle Ramshaw in November/December, 1979,
//	to put in Trident drives other than drive #0
//	Each file now has an optional <disk>: in front of the file
//	name, as in "TP3:name.ext" or "DP1:name.ext".  Default
//	disk is DP0.
// In addition, the new OEdit allows input in modes other than octal,
//	and a iterative find/replace command;  check out the documentation
//	in the standard place, <altodocs>oedit.tty.
// OEdit has the two files OEdit and OEditCom;  one defs files for the
//	mode conventions, OEdit.D.  In addition, the system needs UtilDP,
//	GP, Template, InterDisk, Trident file stuff, Diablo file stuff.

get "streams.d"
get "oedit.d"

external [
//import from the OS
	Gets; Puts; dsp; keys; Wss; SetFilePos;
	Resets; Closes; Endofs; fpComCm
	CreateDisplayStream; ShowDisplayStream;
	TruncateDiskStream
	FileLength; Usc; Ws; CallSwat
	DoubleAdd; OpenFile;  ReadBlock;  MoveBlock
	InitializeZone; GetFixed; FixedLeft

//import from GP
	SetupReadParam; ReadParam; AddItem

//import from Template
	PutTemplate

//import from UtilDP
	SetUpDP
	DoubleUsc; AssignDP;  NegateDP;  DoubleLShift;  DoubleRShift
	zeroDP;  oneDP;  minusOneDP

//import from InterDisk
	SetUpInterDisk
	InterDiskOpenFile
	OverwriteLoadRam

//import from OEditCom
	ReadAndDoCommand
        ]

external [
//export to OEditCom
	data; addr; lastVal; outstream
	dataFlag; writeFlag; standard; files; modes
	GetKeys; PutbackKeys; Display; DisplayValue
	WriteFile; PositionFile
	AsciiToEbcdic; EbcdicToAscii
	]

manifest [
	diskZoneSize = 10000	//Should be enough for 5 files on 5
				//different Tridents;  what do you want?
	numInputFiles = 50
	]

static [ modes ]
static [ files; fLens; addr; data; firstName; lastVal = 0 ]
static [ writeFlag=false; dataFlag; outstream; dispStream ]
static [ dribbleFlag = false;  dribbleFile ]
static [ putbackInForce = false;  putbackChar ]

static [ standard = octal+halfOctal+halfAscii ]

let Oedit(v, switches) be [

	let staticDPwords = vec 6
	SetUpDP(staticDPwords)

	modes =  table [
		0; halfAscii; 0; halfAscii; decimal; halfEbcdic; 0; 0;
		halfOctal; 0; 0; 0; 0; 0; halfDecimal; octal;
		0; 0; 0; halfAscii; 0; 0; 0; 0; halfHex; 0; 0 ]

	let zoneVec = vec diskZoneSize
	let zone = InitializeZone(zoneVec, diskZoneSize)
	SetUpInterDisk(zone)

//Read the switches on the command name OEdit, which can reset the
// standard display mode:
	let val = true
	for i = 1 to 999 do
	         [
	         switchon switches!i into
		[ case $T: case $t: AnnounceNewTri()
		  case $W: case $w: writeFlag = val; endcase
		  case $O: case $o: SetStd(octal, val); endcase
		  case $H: case $h: SetStd(halfOctal, val); endcase
		  case $A: case $a: SetStd(halfAscii, val); endcase
		  case $S: case $s: SetStd(halfAscii, val); endcase
		  case $C: case $c: SetStd(halfAscii, val); endcase
		  case $X: case $x: SetStd(halfHex, val); endcase
		  case $E: case $e: SetStd(halfEbcdic, val); endcase
		  case $D: case $d: SetStd(decimal, val); endcase
		  case $N: case $n: SetStd(halfDecimal, val); endcase
		  case $F: case $f:
		   case $L: case $l: dribbleFlag = val; endcase
		  case $-: val = not val; loop
		  case 0: break;  default: endcase ]
	          val = true
	          ]

	let name = vec 256; let sw=vec 128
	SetupReadParam(name, sw)
	let firstNameVec = vec 256;  firstName=firstNameVec

	Ws("This is OEdit of November 23, 1980.*N")

//open the input files:
	let filesVec=vec numInputFiles; files=filesVec
	files!0=0
	let fLensVec=vec 2*numInputFiles; fLens=fLensVec
	for cnt=1 to numInputFiles do
		[
		let f=ReadParam("P", -1)
		if f eq -1 then break
		let acc=nil
		test (cnt eq 1)& writeFlag 
			ifso acc=ksTypeReadWrite
			ifnot acc=ksTypeReadOnly
		if cnt eq 1 then MoveBlock(firstName, name, 256)
		f=InterDiskOpenFile(name, acc, wordItem)
		if f eq 0 then
			[
			PutTemplate(dsp,"$S not found, ignored*N",name)
			loop
			]
		AddItem(files, f)
		]

//now that all files are open, the LoadRam stuff can be
//  overlaid;  we will steal the rest of core for display purposes
	OverwriteLoadRam()

//first, try for the font Gacha10.al
	let fontFile = OpenFile("Gacha10.al",ksTypeReadOnly,wordItem)
	let font = nil
	if fontFile then
		[
		let fontLen = vec 1
		FileLength(fontFile, fontLen)
		let fontLenWords = (fontLen!1+1) rshift 1
		font = GetFixed(fontLenWords)
		Resets(fontFile)
		ReadBlock(fontFile, font, fontLenWords)
		font = font+2
		]
	let dispSize = FixedLeft()-2000
	let dispVec = GetFixed(dispSize)
	test fontFile
	 ifso	dispStream = CreateDisplayStream(#60, dispVec, dispSize, font)
	 ifnot	dispStream = CreateDisplayStream(#60, dispVec, dispSize)
	ShowDisplayStream(dispStream)

//now, check if we should be dribbling
//and construct the outstream accordingly
	let outstreamVec = vec lST;  outstream = outstreamVec
	test dribbleFlag ifso
		[
		dribbleFile = OpenFile("OEdit.lst", ksTypeReadWrite, charItem)
		outstream>>ST.puts = PutsOutstream
		outstream>>ST.reset = ResetsOutstream
		outstream>>ST.close = ClosesOutstream
		let commandLine =
		   OpenFile("Com.Cm", ksTypeReadOnly, charItem, 0, fpComCm)
		if commandLine ne 0 then
			until Endofs(commandLine) do
				Puts(dribbleFile, Gets(commandLine))
		]
	  ifnot
		outstream = dispStream

// find lengths and print them
	PutTemplate(outstream,"*N*N  Length (bytes)   ")
	for i=1 to files!0 do
		[
		let bytepos=vec 1
		FileLength(files!i, bytepos)
		PutTemplate(outstream,"$9EO", bytepos)
//Now to change the length from bytes to words, rounding up, and
// store the word length in fLens
		DoubleAdd(bytepos, oneDP)
		DoubleRShift(lv fLens>>DPV.Elt^i, bytepos, 1)
		]
	PutTemplate(outstream,"*N  Length (words)   ")
	for i=1 to files!0 do
		PutTemplate(outstream,"$9EO", lv fLens>>DPV.Elt^i)
	Puts(outstream,$*N)

	let addrVec = vec 1;  addr=addrVec
	AssignDP(addr, zeroDP)
	let dataVec = vec 1;  data=dataVec

//now, go into the main command loop
	let fullPageDisplay=false
	fullPageDisplay = ReadAndDoCommand(fullPageDisplay)  repeat
]

and Display(modeWord) be
[
Puts(outstream, $*N)
PutTemplate(outstream,"$UEO", addr)
LJust(outstream,addr,9)

for i=1 to files!0 do
   test PositionFile(i, addr)
    ifnot PutTemplate(outstream, "           overflow       ")
    ifso [
	lastVal=Gets(files!i)
	let left, right = lastVal<<left, lastVal<<right
	if (octal & modeWord) ne 0
		 then PutTemplate(outstream, "$8UO  ",lastVal)
	if (halfOctal & modeWord) ne 0
		 then PutTemplate(outstream, "$3O $3O  ", left, right)
	if (halfAscii & modeWord) ne 0
	 then
	    PutTemplate(outstream, "$P $P  ", ShowChar, left, ShowChar, right)
	if (halfHex & modeWord) ne 0 then
PutTemplate(outstream, "$P $P  ", ShowHex, left, ShowHex, right)
	if (halfEbcdic & modeWord) ne 0 then
PutTemplate(outstream, "$P $P  ", ShowEBCDIC, left, ShowEBCDIC, right)
	if (decimal & modeWord) ne 0
		then PutTemplate(outstream, "$8D  ", lastVal)
	if (halfDecimal & modeWord) ne 0
		then PutTemplate(outstream, "$3D $3D  ", left, right)
	]
Puts(outstream, $*S)
]

and DisplayValue() be
[
Puts(outstream, $*N)
PutTemplate(outstream,"     $EUOb = $ED.", data, data)
]

and SetStd(mask, sense) be
test sense
  ifso standard = standard % mask
  ifnot standard = standard & (not mask)

and WriteFile() be
[
if files!0 ls 1 then		//no file to write in!
	[
	Wss(outstream, "?*NNo first file to write in!")
	return
	]
if writeFlag eq false then
	[
	Wss(outstream, "*NOpen first file for writing [confirm with CR]")
	test GetKeys() eq $*N
	 ifso
	  [
	  Closes(files!1)
  	  let f=InterDiskOpenFile(firstName,ksTypeReadWrite,wordItem)
	  if f eq 0 then
		[
		Wss(dsp, "*NSorry, reopen not successful.")
		abort
		]
	  files!1=f
	  writeFlag = true
	  ]
	 ifnot
	  [
	  Wss(outstream, "?*nCancelling the write request!")
	  return
	  ]
	]
test PositionFile(1, addr)
 ifso Puts(files!1, data>>DP.Low)
 ifnot Wss(outstream,"  Overflow")
]

// f is a fileVec index.
// If p gr fLens>>DPV.Elt^i (double-precision) resultis false and no
// positioning is done.  Otherwise resultis true

and PositionFile(f, p)=valof [
// check for overflow
	if DoubleUsc(p, lv fLens>>DPV.Elt^f) ge 0 then resultis false
	f=files!f
	let pBytes = vec 1
	DoubleLShift(pBytes, p, 1)
	SetFilePos(f, pBytes)
	resultis true
	]

and ClosesOutstream(s) be
	[
	Closes(dispStream)
	TruncateDiskStream(dribbleFile)
	Closes(dribbleFile)
	]

and PutsOutstream(s, c) be
	[
	Puts(dispStream, c)
	Puts(dribbleFile, c)
	]

and ResetsOutstream(s) be
	Resets(dispStream)

and LJust(s, dA, fL) be
	[
	for i = 1 to fL-(dA!0? 5+LJHigh(dA!0), LJLow(dA!1)) do Puts(s,$*S)
	]

and LJLow(n) = (n&#100000) ne 0? 6, (n&#70000) ne 0? 5, (n&#7000) ne 0? 4,
		(n&#700) ne 0? 3, (n&#70) ne 0? 2, 1

and LJHigh(n) = (n&#140000) ne 0? 6, (n&#34000) ne 0? 5, (n&#3400) ne 0? 4,
		(n&#340) ne 0? 3, (n&#34) ne 0? 2, 1

and ShowChar(s, c) be
   PutTemplate(s, (c ge #177? "  ", c>#37? "*S$C", "^$C"), (c>#37? c, c+#100))

and ShowHex(s, c) be for i = 0 to 1 do
	[ let b = (c rshift 4)&#17; Puts(s, b<10? $0+b, ($A-10)+b); c = c lshift 4 ]

and ShowEBCDIC(s, c) be Puts(s, EbcdicToAscii(c))

and EbcdicToAscii(c) =
(c ls #100? $~, ( table [
	$*S;$~;$~;$~;$~;$~;$~;$~;  $~;$~;$\;$.;$<;$(;$+;$|;
	$&;$~;$~;$~;$~;$~;$~;$~;  $~;$~;$!;$$;$**;$);$;;$^;
	$-;$/;$~;$~;$~;$~;$~;$~;  $~;$~;$~;$,;$%;$_;$>;$?;
	$~;$~;$~;$~;$~;$~;$~;$~;  $~;$~;$:;$#;$@;$';$=;$";
	$~;$a;$b;$c;$d;$e;$f;$g;  $h;$i;$~;$~;$~;$~;$~;$~;
	$~;$j;$k;$l;$m;$n;$o;$p;  $q;$r;$~;$~;$~;$~;$~;$~;
	$~;$~;$s;$t;$u;$v;$w;$x;  $y;$z;$~;$~;$~;$~;$~;$~;
	$~;$~;$~;$~;$~;$~;$~;$~;  $~;$~;$~;$~;$~;$~;$~;$~;
	$~;$A;$B;$C;$D;$E;$F;$G;  $H;$I;$~;$~;$~;$~;$~;$~;
	$~;$J;$K;$L;$M;$N;$O;$P;  $Q;$R;$~;$~;$~;$~;$~;$~;
	$~;$~;$S;$T;$U;$V;$W;$X;  $Y;$Z;$~;$~;$~;$~;$~;$~;
	$0;$1;$2;$3;$4;$5;$6;$7;  $8;$9;$~;$~;$~;$~;$~;$~ ] ) ! (c-#100) )

and AsciiToEbcdic(c) = valof
[
if c eq $~ then resultis 0
for ind = #100 to #377 do 
	if EbcdicToAscii(ind) eq c then resultis ind
resultis 0
]

and GetKeys() = valof
	test putbackInForce
	  ifso
		[
		putbackInForce = false
		resultis putbackChar
		]
	  ifnot
		resultis Gets(keys)

and PutbackKeys(char) be
[
if putbackInForce then CallSwat("Attempt to putback with a putback in force.")
putbackInForce = true
putbackChar = char
]

and AnnounceNewTri() be
	[
	Ws("OEdit no longer allows the /T switch.*n")
	Ws("Instead, precede each file name by a drive specification*n")
	Ws(" of the form *"DPi:*" or *"TPi:*".*n")
	abort
	]