//R E A D O P S
//functions for ReadPress
// Copyright Xerox Corporation 1979

//outgoing routines
external [
	ReadPart;ReadEntity;ReadObject;ReadFont
	]

//incoming routines
external [
	DoubleShr;DoubleCop;DoubleSub;MulFull
	GetByte;GetWord;OddByte;GetReset
	ShowFloat;Show;Shown;Showch;Error;DLEven	//from readpress

	ReadBlock		//OS
	Gets
	SetFilePos
	FilePos
	DoubleAdd
	Usc
	]

//incoming statics
external [
	PressFile
	]

//internal manifest and structure declarations
structure str:
	[
	n byte
	ch^1,255 byte
	]

structure
	[
	lh	byte
	rh	byte
	]

let ReadPart(n) be
 [
	let PartDir=vec 4
	for i=1 to n do ReadBlock(PressFile,PartDir,4)

	let Type=PartDir!0
	let Start=PartDir!1
	let Len=PartDir!2
	let padding=PartDir!3

	Show("*nPart ");Shown(n)
	Show(":*n   Type=")
	switchon Type into
		[
		case 0: Show("Page*n");endcase
		case 1: Show("Font*n");endcase
		case 2: Show("External File Directory*n");endcase
		default: Show("Unknown (");Shown(Type);Show(")*n");endcase
		]
	Show("*n   Record Start=");Shown(Start)
	Show("*n   Length (in records)=");Shown(Len)
	Show("*n   Padding Length=");Shown(padding)

	if Type eq 0 then //show commands
	[
	let dataPos=vec 1
	MulFull(Start,512,dataPos)
	let partPos=vec 1
	MulFull(Len,512,partPos)
	DoubleAdd(partPos,dataPos)
	let doublePadding=vec 1
	doublePadding!0=0;doublePadding!1=padding*2+2
	DoubleSub(partPos,doublePadding)
	SetFilePos(PressFile,partPos)
	let entityLen=Gets(PressFile)
	until entityLen eq 0 do
	 entityLen=ReadEntity(entityLen,partPos,dataPos)
	]

	if Type eq 2 then //show files needed
	 [ let partPos=vec 1
	   MulFull(Start,512,partPos)
	   SetFilePos(PressFile,partPos)
	   let name=vec 40
	   ReadBlock(PressFile,name,1)
	   Show("*nFiles required:*n")
	   until name!0 eq 0 do
	    [ let wordLen=name>>str.n/2
	      ReadBlock(PressFile,name+1,wordLen)
	      Show("   ");Show(name);Show("*n")
	      ReadBlock(PressFile,name,1)
	    ]
	 ]


 ]

and ReadEntity(entityLen,partPos,dataPos)=valof
 [
	let evec=vec 1
	evec!0=0
	evec!1=entityLen
	DoubleAdd(evec,evec)	//*2 for byte position
	DoubleSub(partPos,evec)
	if partPos!0 ls 0 then
		[
		Show("*n      ILLEGAL ENTITY LENGTH (=")
		Shown(entityLen)
		Show(")*n")
		resultis 0
		]
	SetFilePos(PressFile,partPos)
	let nextlen=Gets(PressFile)

	let edata=@#335
	@#335=edata+entityLen+1
	if Usc(@#335, lv edata) gr 0 then 
		Error("Entity too long for READPRESS to read*n")

	ReadBlock(PressFile,edata,entityLen)
	let thisData=vec 1
	DoubleCop(thisData,edata+entityLen-11)

	Show("*nEntity:  Length=");Shown(edata!(entityLen-1))
	Show("*n Trailer:*n")
	Show("   Type;Font=");Shown(edata!(entityLen-12))
	Show("*n   Begin-Byte=");Shown(thisData!0);
	Showch($;);Shown(thisData!1)
	Show("   Byte-Len=");Shown(edata!(entityLen-9))
	Showch($;);Shown(edata!(entityLen-8))
	Show("*n   Xe=");Shown(edata!(entityLen-7))
	Show("   Ye=");Shown(edata!(entityLen-6))
	Show("*n   left=");Shown(edata!(entityLen-5))
	Show("   bottom=");Shown(edata!(entityLen-4))
	Show("*n   width=");Shown(edata!(entityLen-3))
	Show("   height=");Shown(edata!(entityLen-2))

	Show("*n Commands:*n")   
	let numBytes=(entityLen-12)*2
	DoubleAdd(thisData,dataPos)
	let oddByte=(thisData!1)&1
	thisData!1=thisData!1&#177776	//position to word boundary
	SetFilePos(PressFile,thisData)
	GetReset()
	if oddByte then GetByte()
	PrintCommands(numBytes,edata,thisData)

	@#335=edata
	resultis nextlen
 ]

and Grab(b,v)=valof
 [
	let n=@b
	@b=n+1
	let Word=v!(n/2)
	resultis ((n&1) eq 1)?Word<<rh,Word<<lh
 ]

and GrabW(b,v) = Grab(b,v)*256+Grab(b,v)

and PrintCommands(numCommands,v,dataPos) be
 [
	let count=0
	let pv=vec 10
	let b=lv count

until count ge numCommands do
[	//grab next byte
	let c=Grab(b,v)
	let p=1			//num args, default is 1 arg
	pv!1=Grab(b,v)	//Get one argument ahead

	let s=nil
	switchon (c&#370)/#10 into
		[
		case 0: case 1: case 2: case 3: //show short
			s="Show-Characters-Short"
			pv!1=(c&#37)+1
			count=count-1
			c=#360
			endcase
		case 4: case 5: case 6: case 7:	//skip short
			s="Skip-Characters-Short"
			pv!1=(c&#37)+1
			count=count-1
			c=#361
			endcase
		case #10: case #11: case #12: case #13:
			s="Show-Characters-and-Skip"
			pv!1=(c&#37)+1
			count=count-1
			c=#100
			endcase
		case #14:
			s="Set-Space-X-Short"
			pv!1=(c&#7)*256+pv!1
			endcase
		case #15:
			s="Set-Space-Y-Short"
			pv!1=(c&7)*256+pv!1
			endcase
		case #16:
		case #17:
			s="Font"
			pv!1=c&#17
			count=count-1
			endcase
		default: 
			switchon c into
			[
		case #353: s="Skip-Control-Bytes-Immediate"
			for i=1 to pv!1 do Grab(b,v)
			endcase
		case #354: s="Alternative"
			pv!1=(pv!1)*256+Grab(b,v)	//EL types
			pv!2=GrabW(b,v)
			pv!3=GrabW(b,v)
			pv!4=GrabW(b,v)
			pv!5=GrabW(b,v)
			p=5;endcase
		case #355: s="Only-on-copy";endcase
		case #356: s="Set-X"
			pv!1=(pv!1)*256+Grab(b,v);endcase
		case #357: s="Set-Y"
			pv!1=(pv!1)*256+Grab(b,v);endcase
		case #360: s="Show-Characters";endcase
		case #361: s="Skip-Characters";endcase
		case #362: s="Skip-Control-Bytes"
			pv!1=(pv!1)*256+Grab(b,v)
			pv!2=Grab(b,v)	//type
			endcase
		case #363: s="Show-Character-Immediate        : "
			s>>str.ch^(s>>str.n-1)=pv!1
			endcase
		case #364: s="Set-Space-X"
			pv!1=(pv!1)*256+Grab(b,v);endcase
		case #365: s="Set-Space-Y"
			pv!1=(pv!1)*256+Grab(b,v);endcase
		case #366: s="Reset-Space";p=0;endcase
		case #367: s="Space";p=0;endcase
		case #370: s="Set-Brightness";endcase
		case #371: s="Set-Hue";endcase
		case #372: s="Set-Saturation";endcase
		case #373: s="Show-Object"
			pv!1=(pv!1)*256+Grab(b,v);endcase
		case #374: s="Show-Dots"
			pv!1=(pv!1)*256+Grab(b,v)
			pv!2=GrabW(b,v);p=2;endcase
		case #375: s="Show-Dots-Opaque"
			pv!1=(pv!1)*256+Grab(b,v)
			pv!2=GrabW(b,v);p=2;endcase
		case #376: s="Show-Rectangle"
			pv!1=(pv!1)*256+Grab(b,v)
			pv!2=GrabW(b,v);p=2;endcase
		case #377: s="Nop";p=0;endcase

		default:
			s=(c ge 200b & c le 237b)? "<..available..>","<..spare..>"
			count=count-1
			pv!1=c;endcase
			]
		]

//Now print out command name, and arguments:
	Show(s)
	test p eq 0 then count=count-1
	or for i=1 to p do
		[
		Show("  ")
		Shown(pv!i)
		]
	Show("*n")

//Now, if there's any data in DL, show it
	switchon c into
	[
	case #360: //Show Characters
		Show("      ")
		for i=1 to pv!1 do [ let ch=GetByte();Show(lv ch,1)]
		Show("*N")
		endcase
	case #361: case #362://Skip Characters (or Control Bytes)
		for i=1 to pv!1 do GetByte()
		endcase
	case #100: //Show Characters and Skip
		Show("      ")
		for i=1 to pv!1 do [ let ch=GetByte();Show(lv ch,1)]
		Show("*N")
		GetByte()
		endcase
	case #373: //Show Object
		ReadObject(pv!1)
		endcase
	case #374: //Show Dots
	case #375: //Show Dots Opaque
		DoubleAdd(pv+1,pv+1)	//num words to num bytes
		ReadDots(pv+1)
		endcase
	default:	
	]
]
]

and ReadObject(n) be
[
	DLEven()
[	n=n-1
	switchon GetWord() into
	[
	case 0: Show("*n      Moveto ")
		Shown(GetWord());Showch($*s)
		Shown(GetWord());n=n-2;endcase
	case 1: Show("*n      Drawto ")
		Shown(GetWord());Showch($*s)
		Shown(GetWord());n=n-2;endcase
	case 2: Show("*n      DrawCurve ")
		for i=1 to 6 do
		 [ let tempAC=vec 1
			tempAC!0=GetWord()
			tempAC!1=GetWord()
		     ShowFloat(tempAC)
			Showch($*s)
			n=n-2
		 ]
		endcase
	]
] repeatuntil n le 0
  Show("*n")
]

and ReadDots(nvec) be
 [
	DLEven()
	let n=nil
	let two=table [ 0;2]
	DoubleSub(nvec,two)
	switchon GetByte() into
		[
		case 0:	//full word command
		switchon GetByte() into
			[
			case 1: n=4	 //set-window
				Show("*n      Set Window ");endcase
			case 2: n=2	//set-size
				Show("*n      Set Size ");endcase
			case 3: n=0	//dots-follow
				Show("*n      Dots Follow*n");endcase
			case 4: //Get-dots-from-file
				Show("*n      Get Dots From File: ")
				[ let recS=GetWord();DoubleSub(nvec,two)
				  let len=GetByte()
				  let v=vec 1;v!0=0;v!1=((len/2)+1)*2;DoubleSub(nvec,v)
				  for i=1 to len do Showch(GetByte())
				  if (len&1) eq 0 then GetByte()
				  Show(" (record start=");Shown(recS);Show(")*n")
				  n=0
				  endcase
				]				  
			case 5: n=-1	//get dots from press file
				endcase
			case 6: 
				n=GetWord()
				for i=0 to n do DoubleSub(nvec,two)
				Show("*n      Set Sampling Properties")
				while n gr 0 do switchon GetWord() into
					[
					case 0: Show("*n        SSP input intensity:   Min=")
					   Shown(GetWord());Show("  Max=")
					   Shown(GetWord())
					   n=n-3
					   endcase
					case 1: Show("*n        SSP output intensity:  ")
					   for i=1 to 3 do 
					    [ Shown(GetWord());Show("  ")]
					   n=n-4
					   endcase
					case 2: Show("*n        SSP screen*n")
					   Show("           Angle  ");Shown(GetWord())
					   Show("   Amplitude ");Shown(GetWord())
					   Show("   Lines/Inch  ");Shown(GetWord())
					   n=n-4
					   endcase
					case 3: Show("*n        SSP dot definition:  (")
					   [ let nCells=GetWord()
					     Shown(nCells);Showch($,)
					     Shown(GetWord());Showch($,)
					     Shown(GetWord());Showch($))
					     for i=1 to nCells do GetWord()
					     n=n-(1+3+nCells)
					     endcase
					  ]
					default: Show("*n        Unknown command...")
					    for i=2 to n do GetWord()
					    n=0
					    endcase
					]
				loop	//back to top of routine
			 ] //end of "switchon GetByte() into"
			if n le 0 then	//Dots coming now
				[
				let fp=vec 1
				FilePos(PressFile,fp)
				DoubleAdd(fp,nvec)
				SetFilePos(PressFile,fp)
				return
				]
			for i=1 to n do
				[
				Shown(GetWord());Showch($*s)
				DoubleSub(nvec,two)
				]
			endcase
		case 1:	//set coding
			Show("*n      Set Coding ")
			Shown(GetByte());Showch($;)
			Shown(GetWord());Showch($;)
			Shown(GetWord())
			DoubleSub(nvec,table [ 0;4])
			endcase
		case 2: 	//set  mode
			Show("*n      Set Mode ")
			Shown(GetByte())
			endcase
	 ]
 ] repeat
(1270)