// September 11, 1980  3:57 PM by Ramshaw		*** "UNDERLAY" ***
//Edited by Lyle Ramshaw September 8, 1980  3:24 PM: changed header
//  message to Draw 5.0...
 
// Compile with X/M to set versionX (i.e. no color menu) to true

get "zpDefs.bcpl"

get "sysDefs.d"
get "AltoDefs.d"


// outgoing procedures:

external [
	drawJunta
	needBlock
	]
  

// outgoing statics:

external [
	// overlay stuff
	@overlayTable
	// display area stuff
	@switchDCB
	@bitmap
	@bitmap00
	@height
	@width
	@scanlineWidth
	@bitmapSize
	@Xmax
	@Ymax
	@Xref0
	@Yref0
	@gridSpacing
	// global tables
	@splineTable
	@textTable
	@fontDefTable
	@fontFile
	@newSplineXYtable
	@transformXYtable
	@transformModeTable
	@selectionTable
	@deletionTable
	@commandTable
	@actionTable
	@DTTstack
	@DTTstackTop
	@freeStorageZone
	@lineThicknessTable
	// table counters
	@maxSplineID
	@maxTextID
	@maxKnots
	@maxItem
	@maxDTTstack
	//text stuff
	@textOK
	@textString
	@textWidth
	@textTop
	@textBottom
	@textHeight
	@textBitmap
	@textBitmapSize
	// global information
	@freeStorageSize
	@font
	@dspFont
	@dspFontAddress
	@brush
	@color
	@versionX
	]

static [
	// overlay stuff
	@overlayTable
	// display area stuff
	@switchDCB
	@bitmap
	@bitmap00
	@height=defaultHeight
	@width=defaultWidth
	@scanlineWidth
	@bitmapSize
	@Xmax
	@Ymax
	@Xref0
	@Yref0
	@gridSpacing=0
	// global tables
	@splineTable
	@textTable
	@fontDefTable
	@fontFile
	@newSplineXYtable
	@transformXYtable
	@transformModeTable
	@selectionTable
	@deletionTable
	@commandTable
	@actionTable
	@DTTstack
	@DTTstackTop=0
	@freeStorageZone
	@lineThicknessTable
	// table counters
	@maxSplineID=0
	@maxTextID=0
	@maxKnots=0
	@maxItem=0
	@maxDTTstack
	//text stuff
	@textOK=0
	@textString
	@textWidth
	@textTop
	@textBottom
	@textHeight
	@textBitmap
	@textBitmapSize
	// global information
	@freeStorageSize=0
	@font=0
	@dspFont=0
	@dspFontAddress=0
	@defaultFont
	@color=black
	@brush=4		// square brush is the default
	@versionX= not newname X
	]


// incoming procedures:

external [
	Resets			// SYSTEM
	Gets
	Endofs
	Closes
	OpenFile
	CreateDiskStream
	CreateDisplayStream
	ShowDisplayStream
	FileLength
	FilePos
	SetFilePos
	PositionPage
	JumpToFa
	ReadBlock
	SetBlock
	Zero
	MoveBlock
	DoubleAdd
	Usc

	SetEndCode
	Junta

	GetFixed
	FixedLeft
	InitializeZone
	Allocate

	initEventTable		// ZPINIT2

	drawMain		// ZPEDIT
	drawFinish

	MakeFontEntry		// ZPFONTIO

	typeForm		// ZPUTIL
	FPerror
	equal

	PSerror			// SPLINE

	giveUp			// ZPBLOCK
	CheckPSerror
	maxBlockSize

	ReadUserCmItem		// READUSERCMITEM

	LoadPackedRAM		// READPRAM
	MicroFloatRamImage
	]



// incoming statics:

external [
	@dashOn			// ZPDRAW
	@dashOff

	FPerrprint		// microFLOAT

	PSzone			// PSPLINE

	@sampleBuffer		// ZPFREEHAND
	@maxSampleCount

	dsp			// SYSTEM
	sysZone
	lvSysZone
	fpSysFont
	lvUserFinishProc
	OsVersion
	]


// local static:

static [
	@checkFreeStorage=false
	@tempOverlayTable
	]


// definitions

manifest [
	// 6 lines for dsp stream
	nLines=6
	dspWidth=3*38
	// 1 disk stream
	diskStream= lKS+256
	systemPoolSize=diskStream+150
	// horizontal margin
	horMargin=16
	]



//*****************************************************************
// initialization and the like
//*****************************************************************

let drawJunta(loadVec, cfa) be [drawJunta
	// load & initialize floating point microcode:
//	LoadPackedRAM(MicroFloatRamImage)
	// get overlay information & set EndCode:
	let endOfCode=loadVec!($E-$A)
	tempOverlayTable=endOfCode
	endOfCode=endOfCode+lOVT
	Zero(tempOverlayTable, lOVT)
	MoveBlock(lv(tempOverlayTable>>OVT.fp), lv(cfa>>CFA.fp), lFP)
	let runFile=CreateDiskStream(lv(cfa>>CFA.fp), ksTypeReadOnly)
	JumpToFa(runFile, lv(cfa>>CFA.fa))
	let pageNumber=cfa>>CFA.fa.pageNumber
	for i=1 to numberOfOverlays do [
		PositionPage(runFile, pageNumber)
		tempOverlayTable>>OVT.pn↑i=pageNumber
		// 4th word of overlay header is length (in words)
		let ovl=vec 16
		ReadBlock(runFile, ovl, 16)
		let endOfOverlay=ovl!0 + ovl!4
		if Usc(endOfCode, endOfOverlay) eq -1 then
			endOfCode=endOfOverlay
		tempOverlayTable>>OVT.end↑i=endOfOverlay
		tempOverlayTable>>OVT.free↑i=endOfCode-endOfOverlay
		// file page number for next overlay
		pageNumber=pageNumber + (ovl!4+255)/256
		]
	Closes(runFile)
	SetEndCode(endOfCode)
	Junta(levMain, drawInit)
	]drawJunta



and drawInit() be [drawInit
	// make new system zone
	sysZone=InitializeZone(GetFixed(systemPoolSize), systemPoolSize, 0, 0)
	@lvSysZone=sysZone
	// errors & finish
	FPerrprint=FPerror
	PSerror=CheckPSerror
	@ lvUserFinishProc=drawFinish
	// initialize all the DRAW stuff
	let dcb1=initDisplayAndStorage()
	initEventTable()
	overlayTable=needBlock(lOVT)
	MoveBlock(overlayTable, tempOverlayTable, lOVT)
	sampleBuffer=overlayTable>>OVT.end↑freeHandOverlay
	maxSampleCount=overlayTable>>OVT.free↑freeHandOverlay
	initUSERCM()
	// make display
	let pt=@ lvDisplayHeader
	switchDCB=dcb1>>DCB.next
	dcb1>>DCB.next=pt
	while pt>>DCB.next do pt=pt>>DCB.next
	pt>>DCB.next=switchDCB
	@ lvDisplayHeader=dcb1
	//now the magic numbers!
	Xmax,Ymax=width-1,height-1
	Xref0=64
	Yref0=height + 2*horMargin + nLines*((@(dspFontAddress-2)+1)&#177776)
	// video camera
	if camera>>CAMERA.present then [
		camera>>CAMERA.top=Yref0-height+cameraYoffset
		camera>>CAMERA.bottom=Yref0+cameraYoffset
		camera>>CAMERA.left=Xref0+cameraXoffset
		camera>>CAMERA.right=Xref0+width+cameraXoffset
		camera>>CAMERA.insideMode=altoOnly
		camera>>CAMERA.outsideMode=altoOnly
		]
	// all set
	maxBlockSize()
	drawMain()
	]drawInit



and initDisplayAndStorage() = valof [initDisplayAndStorage
	// get big block for display
	// display area is width * height with a 4*16 bit margin
		height=defaultHeight
		width=defaultWidth
	[ scanlineWidth=width/16 + margin
	  bitmapSize=height*scanlineWidth
	  bitmap=GetFixed(bitmapSize+1)
	  if bitmap break
	  width=width-32
	 ] repeat
	// must be an even location, damn it!
	bitmap=(bitmap+1) & #177776
	bitmap00=bitmap + bitmapSize - scanlineWidth + margin
	Zero(bitmap, bitmapSize)

	// get the remainder for free storage zone
	freeStorageSize=FixedLeft() - 1300
	freeStorageZone=GetFixed(freeStorageSize)
	test checkFreeStorage
	ifso InitializeZone(freeStorageZone, freeStorageSize, 0)
	ifnot InitializeZone(freeStorageZone, freeStorageSize, 0, 0)
	PSzone=freeStorageZone

	textBitmapSize=maxTextHeight*scanlineWidth
	textBitmap=needEvenBlock(textBitmapSize)
	Zero(textBitmap, textBitmapSize)

	//get display control blocks
	let DCB1=needEvenBlock(5*lDCB)
	let DCB2=DCB1+lDCB
	let DCB3=DCB2+lDCB
	let DCB4=DCB3+lDCB
	let DCB5=DCB4+lDCB

	//set up display control blocks
	Zero(DCB1, 5*lDCB)
		//top margin
	DCB1>>DCB.height=horMargin/2
		//system display area (for messages)
		//second top margin
	DCB2>>DCB.height=horMargin/2
		//curve area & margin
	DCB3>>DCB.bitmap=bitmap
	DCB3>>DCB.width=scanlineWidth
	DCB3>>DCB.height=height/2
		// another margin
	DCB4>>DCB.height=horMargin/2
		// text display
	DCB5>>DCB.indentation=4
	DCB5>>DCB.height=maxTextHeight/2
	DCB5>>DCB.bitmap=textBitmap
	DCB5>>DCB.width=scanlineWidth
		//link DCBs
	DCB1>>DCB.next=DCB2
	DCB2>>DCB.next=DCB3
	DCB3>>DCB.next=DCB4
	DCB4>>DCB.next=DCB5
	DCB5>>DCB.next=0

	// decide about the size of tables
	readCOMCMparameters()
	let gridSpacDef= versionX ? XgridSpacingDefault, gridSpacingDefault
	if maxSplineID le 0 % maxSplineID gr 10*maxSplineIDdefault then
		maxSplineID=maxSplineIDdefault
	if maxTextID le 0 % maxTextID gr 10*maxTextIDdefault then
		maxTextID=maxTextIDdefault
	if maxKnots le 0 % maxKnots gr 10*maxKnotsDefault then
		maxKnots=maxKnotsDefault
	if dashOn le 0 % dashOn gr 10*dashOnDefault then
		dashOn=dashOnDefault
	if dashOff le 0 % dashOff gr 10*dashOffDefault then
		dashOff=dashOffDefault
	if gridSpacing le 0 % gridSpacing gr 10*gridSpacDef then
		gridSpacing=gridSpacDef
	maxItem=maxSplineID + maxTextID
	maxDTTstack=maxItem + 2*maxTransfPoints + 1

	// spline table [length maxSplineID+1] & text table [length maxTextID+1] :
	//	word 0 is a counter
	//	words 1 through maxSplineID (maxTextID) are pointers
	//		to SPLINE (TEXT) structures
	let blockSize=(maxSplineID+1)+(maxTextID+1)+(maxChar/2+1)
	splineTable=needBlock(blockSize)
	Zero(splineTable, blockSize)
	textTable=splineTable+maxSplineID+1
	textString=textTable+maxTextID+1

	// XY tables for new spline & transform, and transform mode table
	blockSize=transformModeMax+TRANSFORMtableSize+(2+maxKnots*2)
	transformModeTable=needBlock(blockSize)
	transformXYtable=transformModeTable+transformModeMax
	newSplineXYtable=transformXYtable+TRANSFORMtableSize
	Zero(transformModeTable, blockSize)
	transformModeTable!0=mTransf2Mode
	transformModeTable!1=cTransf2Mode
	transformModeTable!2=mTransf4Mode
	transformModeTable!3=cTransf4Mode
	transformModeTable!4=mTransf6Mode
	transformModeTable!5=cTransf6Mode

	// selection/deletion table:
	blockSize=2*maxItem+2
	selectionTable=needBlock(blockSize)
	Zero(selectionTable, blockSize)
	deletionTable=selectionTable+maxItem+1

	// stack for deleted items
	DTTstack=needBlock(maxDTTstack)

//	let FPacs=needBlock(4*32+1)
//	FPacs!0=32
//	FPSetup(FPacs)
//
	resultis DCB1
	]initDisplayAndStorage



and needBlock(n) = valof [
	let b=Allocate(freeStorageZone, n)
	unless b finish
	resultis b
	]


and needEvenBlock(n) = valof [
	let b=Allocate(freeStorageZone, n, -1, true)
	unless b finish
	resultis b
	]


and readCOMCMparameters() be [
	// (simple minded scanning of COM.CM)
	let comcm=OpenFile("COM.CM", ksTypeReadOnly, charItem)
	let number, savedNumber= 0,0
	until Endofs(comcm) do [
		let c=Gets(comcm)
		if (c ge $0) & (c le $9) then [
			number= number*10 + (c-$0)
			loop
			]
		switchon c into [
		case $/: savedNumber=number; number=0; endcase
		case $d:
		case $D: dashOn=savedNumber; endcase
		case $o:
		case $O: dashOff=savedNumber; endcase
		case $k:
		case $K: maxKnots=savedNumber; endcase
		case $g:
		case $G: gridSpacing=savedNumber; endcase
		case $s:
		case $S: maxSplineID=savedNumber; endcase
		case $t:
		case $T: maxTextID=savedNumber; endcase
		default: savedNumber=0; number=0; endcase
			]
		]
	Closes(comcm)
	]



and initUSERCM() be [initUSERCM
	// make font & lineThickness tables from USER.CM entries
	let blockSize=FONTFILElength+maxFont*(FONTDEFlength+1)+4
	lineThicknessTable=needBlock(blockSize)
	Zero(lineThicknessTable, blockSize)
	fontFile=lineThicknessTable+4
	fontDefTable=fontFile+FONTFILElength
	for f=0 to maxFont-1 do fontDefTable!f=fontDefTable+maxFont+f*FONTDEFlength

	// get stuff from User.CM (font names, line thickness)
	let fontNamesVec=vec 10*maxFont
	Zero(fontNamesVec, 10*maxFont)
	let fontNames=vec maxFont
	for f=0 to maxFont-1 do fontNames!f=fontNamesVec+10*f
	let fontSet=vec maxFont
	Zero(fontSet, maxFont)
	readUSERCM(fontSet, fontNames)

	// read fonts
	font=-1
	for f=0 to maxFont-1 do [
		if fontFileInit(fontSet!f, f) eq 0 then fontSet!f=0
		if fontSet!f ne 0 & font eq -1 then font=f
		]

	// if no fonts are there, get system font
	if font eq -1 then [
		fontSet!0="SYSFONT.AL"
		fontFileInit(fontSet!0, 0)
		font=0
		]

	// find largest font file
	let maxLength=0
	for f=0 to maxFont-1 do
		if maxLength ls fontFile>>FONTFILE.length↑f then
			maxLength=fontFile>>FONTFILE.length↑f

	// pick smallest font as message display font
	let minHeight=1000
	for f=0 to maxFont-1 do
		if fontFile>>FONTFILE.length↑f ne 0 then
			if fontFile>>FONTFILE.height↑f ls minHeight then [
				minHeight=fontFile>>FONTFILE.height↑f
				dspFont=f
				]
	let dspFontLength=fontFile>>FONTFILE.length↑dspFont
	let fontStream=CreateDiskStream(lv(fontFile>>FONTFILE.fp↑dspFont),
				ksTypeReadOnly)
	dspFontAddress=needBlock(dspFontLength)
	ReadBlock(fontStream, dspFontAddress, dspFontLength)
	Closes(fontStream)
	dspFontAddress=dspFontAddress+2
	fontFile>>FONTFILE.length↑dspFont=0

	// make system display stream
	let dspSize=nLines * lDCB + dspWidth * @(dspFontAddress-2)
	dsp=CreateDisplayStream(nLines, Allocate(freeStorageZone,dspSize),
			dspSize, dspFontAddress)
	ShowDisplayStream(dsp, DSalone)

	// all permanent storage should have been allocated by now
	// get font buffer
	if maxLength ne 0 then 
		fontFile>>FONTFILE.buffer=needBlock(maxLength)
	fontFile>>FONTFILE.current=-1
	fontFile>>FONTFILE.bufferLength=maxLength

	// initialization message
	test versionX
	ifso typeForm(0,"*NDDRAW  5.2.X    [November 23, 1980]*N")
	ifnot typeForm(0,"*NDDRAW  5.2    [November 23, 1980]*N",
		0, "Documentation update on <AltoDocs>DRAW-news.press*N")
	typeForm(0, "Fonts 0 to 3 are: ")
	for f=0 to maxFont-1 do
		typeForm(0, ((fontSet!f) ? fontSet!f, "none"),
			0, ((f eq (maxFont-1)) ? "*N", ", "))
	]initUSERCM



and fontFileInit(fontName, f) = valof [fontFileInit
	// procedure similar to readFontFile (in ZPIO)
	if fontName eq 0 resultis 0
	let file=OpenFile(fontName, ksTypeReadOnly, 0, 0, lv(fontFile>>FONTFILE.fp↑f))
	if file eq 0 then [
		fontFile>>FONTFILE.length↑f=0
		resultis 0
		]
	fontFile>>FONTFILE.length↑f=FileLength(file)/2+1
	Resets(file)
	let ALheader=vec 2
	ReadBlock(file, ALheader, 2)
	fontFile>>FONTFILE.height↑f=ALheader>>AL.height
	fontFile>>FONTFILE.baseline↑f=ALheader>>AL.baseline
	Closes(file)
	//check font name
	resultis MakeFontEntry(fontName, fontDefTable!f, f)
	]fontFileInit



and readUSERCM(fontSet, fontNames) = valof [readUSERCM
	let fCount=0
	let lwCount=0
	let forMe=false
	let str=vec 128
	let usercm=OpenFile("USER.CM", ksTypeReadOnly, charItem)
	switchon ReadUserCmItem(usercm, str) into [
	case $E:
		Closes(usercm)
		break
	case $L:
		if forMe & equal(str, "FONT") then
			fCount=fCount + readUSERCMfont(usercm, str, fontSet, fontNames)
		if forMe & equal(str, "LINEWIDTH") then
			lwCount=lwCount + readUSERCMlineWidth(usercm, str)
		loop
	case $N:
		forMe=equal(str, "DRAW")
		loop
	case $P:
	case $S:
		loop
		] repeat
	if fCount eq 0 then [
		fontSet!0="HELVETICA12.AL"
		fontSet!1="HELVETICA12B.AL"
		fontSet!2="HELVETICA8.AL"
		fontSet!3="ARROWS10.AL"
		]
	// if nothing in USER.CM, use default values (see ZPPRESS.SR)
	if lwCount eq 0 then lineThicknessTable=0
	]readUSERCM



and readUSERCMfont(usercm, str, fontset, fontNames) = valof [readUSERCMfont
	if ReadUserCmItem(usercm, str) ne $P resultis 0
	let f=str>>STRING.char↑1 - $0
	if (f ls 0) % (f ge maxFont) resultis 0
	let length=str>>STRING.length
	let istart, iend= 2, length
	for i=2 to length do
		if str>>STRING.char↑i ne $*S then [ istart=i; break ]
	for i=istart to length do
		if str>>STRING.char↑i eq $*S then [ iend=i-1; break ]
	let name=fontNames!f
	for i=istart to iend do
		name>>STRING.char↑(i-istart+1)=str>>STRING.char↑i
	name>>STRING.length=iend-istart+1
	fontset!f=name
	resultis 1
	]readUSERCMfont


and readUSERCMlineWidth(usercm, str) = valof [readUSERCMlineWidth
	if ReadUserCmItem(usercm, str) ne $P resultis 0
	let f=str>>STRING.char↑1 - $0
	if (f ls 0) % (f gr 3) resultis 0
	let length=str>>STRING.length
	let istart, iend= 2, length
	for i=2 to length do
		if str>>STRING.char↑i ne $*S then [ istart=i; break ]
	for i=istart to length do
		if str>>STRING.char↑i eq $*S then [ iend=i-1; break ]
	let num=0
	for i=istart to iend do [
		let c=str>>STRING.char↑i - $0
		if c ls 0 % c gr 9 resultis 0
		num=num*10 + c
		]
	lineThicknessTable!f=num
	resultis 1
	]readUSERCMlineWidth