// Condense.bcpl
// Copyright Xerox Corporation 1981
//   Converts SWAT/SWATEE screen images into Press or AIS files
//    by Keith Knox
//   Last modified February 5, 1981

//   bldr Condense BitTable CondenseTables Menu MenuBox MenuBoxUtils MenuKeyboard DCBPress MDI

get "MenuDefs.d"
get "CondenseNames.d"
get "AltoDefs.d"
get "Disks.d"

external 
	[
	// OS procedures
	Timer
	Allocate
	InitializeZone
	GetFixed
	Free
	Zero
	OpenFile
	OpenFileFromFp
	Closes
	Gets
	Endofs
	Ws
	MoveBlock
	SetBlock
	SetEndCode
	ActOnDiskPages
	VirtualDiskDA
	GetCurrentFa
	WriteBlock
	PositionPage

	// OS statics
	keys
	sysDisk
	fpSysDir

	// BitTable
	BitTable

	// DCBPress
	DCBPress

	// MDI
	LookupEntries
	]



static
	[
	input
	zone
	dcb
	addr
	cursorON=false
	savedcursor
	DA
	DAswat=0
	DAswatee=0
	DAother=0
	array
	presentpage
	FP
	FPswat=0
	FPswatee=0
	FPother=0
	menu
	rastervec
	namechanged
	OtherFileName
	PressFileName
	AISFileName
	SysDirStream
	MenuLength
	OtherFlag=true
	SwatFlag=true
	SwateeFlag=true
	]

structure
	[
	leftbyte byte
	rightbyte byte
	]

structure INPUT:
	[
	swatfile word		// swat file default is swatee
	mode word			// mode default is disk
	name word			// file name default is Condense.press
	filetype word		// type default is Press
	]

manifest lINPUT=(size INPUT/16)


let main() be
	[
	// perform initialization
	initworld()

	// set up the menu
	initmenu()

	// scan the menu
		[
		let selection=ScanMenu(menu)
		switchon selection into
			[
			case start:			Start() ; endcase
			case quit:			finish
			case other:
			case swat:
			case swatee:		Group(selection,lv input>>INPUT.swatfile); endcase
			case Infilename:	InBox(selection) ; endcase
			case display:
			case disk:			ModeBoxes(selection) ; endcase
			case cursor:		Cursor() ; endcase
			case ais:
			case press:			TypeBoxes(selection) ; endcase
			case Outfilename:	OutBox(selection) ; endcase
			]
		] repeat
	]

and Start() be
	[
	// check if file exists
	if input>>INPUT.swatfile eq swat then
		[
		if FileAbsent("SWAT",FPswat,DAswat,menu!swat,lv SwatFlag) then return
		]
	if input>>INPUT.swatfile eq swatee then
		[
		if FileAbsent("SWATEE",FPswatee,DAswatee,menu!swatee,lv SwateeFlag) then return
		]
	if input>>INPUT.swatfile eq other then
		[
		if FileAbsent(OtherFileName,FPother,DAother,menu!Infilename,lv OtherFlag) then return
		]

	// now start work
	fillupdisplay()
	test input>>INPUT.mode eq disk ifso outputdisplay()
		ifnot
		[
		// script 'Type Key' cursor
		MoveBlock(#431,table
								[
								#2000;#74000;#104000;#12767
								#12525;#53566;#111113;#163100
								#0;#0;#154000;#53520
								#62520;#53360;#155440;#140
								],16)
		while Endofs(keys) do loop
		MoveBlock(#431,savedcursor,16)
		Gets(keys)
		]
	initmenu()
	]

and FileAbsent(filename,fp,da,box,lvflag) = valof
	[
	FP=fp
	DA=da
	if @lvflag then		// have not checked yet
		[
		if OpenSwatFile(filename,fp,da) eq 0 then
			[
			initmenu()
			givewarning()
			FillBox(box,white)
			WriteBox(box,"No such file")
			resultis true
			]
		@lvflag=false
		]
	resultis false
	]


and givewarning() be
	[
	waitms(250)
	InvertScreen();waitms(250)
	InvertScreen()
	waitms(250)
	InvertScreen();waitms(250)
	InvertScreen()
	waitms(250)
	]

and ModeBoxes(selection) be
	[
	FillBox(menu!(input>>INPUT.mode),flip)
	if input>>INPUT.mode eq selection then return
	input>>INPUT.mode=selection 
	let active=selection eq display
	(menu!Outfilename)>>BOX.inactive=active
	(menu!press)>>BOX.inactive=active
	(menu!ais)>>BOX.inactive=active
	FillBox(menu!(input>>INPUT.filetype),flip)
	FillBox(menu!newfile,white)
	FillBox(menu!Outfilename,white)
	if selection eq disk then
		[
		WriteBox(menu!Outfilename,input>>INPUT.name)
		NewFile()
		]
	]

and Cursor() be
	[
	FillBox(menu!cursor,white)
	cursorON=not cursorON
	WriteBox(menu!cursor,cursorON ? "ON","OFF")
	]

and TypeBoxes(selection) be
	[
	FillBox(menu!(input>>INPUT.filetype),flip)
	if input>>INPUT.filetype eq selection then return
	input>>INPUT.filetype=selection 
	input>>INPUT.name=selection eq ais ? AISFileName,PressFileName
	FillBox(menu!Outfilename,white)
	WriteBox(menu!Outfilename,input>>INPUT.name)
	NewFile()
	]

and InBox(selection) be
	[
	OtherFileName=GetString(menu!selection,OtherFileName,zone)
	OtherFlag=true
	]

and OutBox(selection) be
	[
	// put name into appropriate place
	let name=input>>INPUT.filetype eq ais ? AISFileName, PressFileName
	input>>INPUT.name=GetString(menu!selection,name,zone)
	if input>>INPUT.name eq 0 then
		[
		test input>>INPUT.filetype eq ais ifso defaultAISname()
			ifnot defaultPRESSname()
		WriteBox(menu!selection,input>>INPUT.name)
		]
	test input>>INPUT.filetype eq ais
		ifso AISFileName=input>>INPUT.name
		ifnot PressFileName=input>>INPUT.name
	NewFile()
	]



and initworld() be
	[
	// initialize the screen
	dcb=GetFixed(30718)
	dcb=dcb+(dcb&1)
	dcb!0=0 ; dcb!1=#46 ; dcb!2=dcb+4 ; dcb!3=404

	// set up strings
	zone=InitializeZone(GetFixed(200),200)		// string zone
	OtherFileName=0
	defaultPRESSname()
	defaultAISname()

	// set up SysDir stream
	SysDirStream=OpenFileFromFp(fpSysDir)

	// set up header for AIS files
	rastervec=table
		[#102252;#2000;#2011;#1450;#1140;3;1;1;1;#46;-1;#6003;0;1 ]

	// initialize the menu
	MenuLength=MenuSize()
	menu=MenuData>>DATA.menu

	// set defaults
	let ptr=vec 3
	ptr>>INPUT.swatfile=swatee
	ptr>>INPUT.mode=display
	ptr>>INPUT.name=PressFileName
	ptr>>INPUT.filetype=press

	// inititalize storage arrays
	savedcursor=GetFixed(16)		// arrow cursor image
	MoveBlock(savedcursor,#431,16)
	input=GetFixed(lINPUT)			// INPUT data vector
	MoveBlock(input,ptr,4)
	array=GetFixed(266)				// array used in getblock

	// set up arrays for Other file
	FPother=GetFixed(lFA)
	DAother=GetFixed(266)

	// set up arrays for SWAT file
	FPswat=GetFixed(lFA)
	DAswat=GetFixed(266)

	// set up arrays for SWATEE file
	FPswatee=GetFixed(lFA)
	DAswatee=GetFixed(266)

	]

and OpenSwatFile(string,fp,da) = valof
	[
	if string>>STRING.length eq 0 % string eq 0 then resultis false
	let s=OpenFile(string,ksTypeReadOnly)
	if s then
		[
		GetCurrentFa(s,fp)
		SetBlock(da,fillInDA,257)
		da!1=fp>>FA.da
		ActOnDiskPages(sysDisk,0,da,
				fp,1,255,DCreadHLD,0,0,array)
		Closes(s)
		]
	resultis s
	]

and initmenu() be
	[
	// set up menu
	@#420=0
	CreateMenuDisplayStream(dcb+4,30704)

	// flip defaults
	FillBox(menu!(input>>INPUT.swatfile),flip)
	WriteBox(menu!Infilename,OtherFileName)
	FillBox(menu!(input>>INPUT.mode),flip)
	let active=input>>INPUT.mode eq display
	(menu!Outfilename)>>BOX.inactive=active
	(menu!press)>>BOX.inactive=active
	(menu!ais)>>BOX.inactive=active
	if input>>INPUT.mode eq disk then
		[
		FillBox(menu!(input>>INPUT.filetype),flip)
		WriteBox(menu!Outfilename,input>>INPUT.name)
		NewFile()
		]
	cursorON=not cursorON
	Cursor()
	ShowMenu()
	]

and NewFile() be
	[
	FillBox(menu!newfile,white)
	let string=input>>INPUT.name
	if string>>STRING.length eq 0 then return
	let v=vec lDV
	let buffer=dcb+4+MenuLength
	let length=30704-MenuLength
	let s=LookupEntries(SysDirStream,lv string,v,1,true,buffer,length)
	WriteBox(menu!newfile,s ? "{New File}","{Old File}")
	]


and fillupdisplay() be
	[
	// set up screen
	Zero(dcb+4,30704)
	@#420=dcb	

	// set up a few necessary variables
	let res,bkgnd,indent,width,bitmap,height=nil,nil,nil,nil,nil,nil
	let sdcb=vec 3
	let lines=0
	let dpointer=0
	let buffer=vec 37
	let loc=dcb+4

	// get address of first dcb 
	addr=#420		// display address
	getblock(lv addr,addr,1)

	// main loop
	[
	getblock(sdcb,addr,4)		// pull in first dcb
	addr=sdcb>>DCB.next		// get address of next dcb
	res=sdcb>>DCB.resolution
	bkgnd=sdcb>>DCB.background
	indent=sdcb>>DCB.indentation
	width=sdcb>>DCB.width
	bitmap=sdcb>>DCB.bitmap
	height=sdcb>>DCB.height
	for n=1 to (res?1,2)*height do
		[
		Zero(buffer,38)
		if width do getblock(buffer+indent,bitmap,width)
		bitmap=bitmap+width
		if bkgnd then for m=0 to 37 do buffer!m=not buffer!m
		if res then			// this section doubles the buffer
			[
			for m=18 to 0 by -1 do 
				[
				buffer!(2*m+1)=BitTable!(buffer!m & #377)
				buffer!(2*m)=BitTable!(buffer!m rshift 8)
				]
			]
		MoveBlock(loc+dpointer,buffer,38)
		dpointer=dpointer+38
		if res then
			[
			MoveBlock(loc+dpointer,buffer,38)
			dpointer=dpointer+38
			]
		lines=lines+1+res
		if lines ge 808 then break
		]
	] repeatwhile addr		// closes main loop

	// fill in the rest with background
	if lines ls 808 do SetBlock(loc+dpointer,bkgnd?-1,0,38*(808-lines))

	// include cursor if asked for
	let curmap=vec 15
	let curlocX,curlocY=nil,nil
	if cursorON then
		[
		getblock(lv curlocX,#426,1)
		getblock(lv curlocY,#427,1)
		getblock(curmap,#431,16)
		IncludeCursor(curlocX,curlocY,curmap)
		]

	// make sure that you must re-read first disk page again
	presentpage=260
	]

and IncludeCursor(curlocX,curlocY,curmap) be
	[
	// use BITBLT to OR in the cursor
	CallBitBlt(1,0,dcb+4,38,curlocX,curlocY,16,16,curmap,1,0,0)
	]


and outputdisplay() be
	[
	let file=nil
	let name=input>>INPUT.name
	switchon input>>INPUT.filetype into
		[
		case press: DCBPress(name,dcb) ; endcase
		case ais:
			file=OpenFile(name,ksTypeWriteOnly)
			WriteBlock(file,rastervec,14) ; PositionPage(file,5)	// header
			WriteBlock(file,dcb!2,30704)	// data
			Closes(file)
			endcase
		]
	]


and getblock(dest,wordpos,number) be
	[
	// see SubSystems Manual (BuildBoot) for structure of 'Swat' files
	let page=wordpos<<leftbyte
	if page ls 2 then page=255-page	// pages 0 and 1 at end of file
	let leftover=wordpos<<rightbyte
	let arraypos=leftover
	unless page eq presentpage then
		ActOnDiskPages(sysDisk,0,DA,
				FP,page,page,DCreadHLD,0,0,array)
	POINT:
	test arraypos+number gr 256
		ifso
			[
			MoveBlock(dest,array+arraypos,256-arraypos)
			number=number-256+arraypos
			dest=dest+256-arraypos
			arraypos=0
			// increment page number (pages 0,1 at end of file)
			test page le 253 ifso page=page+1
				ifnot page=(page eq 254 ? 2,254)
			ActOnDiskPages(sysDisk,0,DA,
				FP,page,page,DCreadHLD,0,0,array)
			goto POINT
			]
		ifnot MoveBlock(dest,array+arraypos,number)
	presentpage=page
	]

and waitms(time) be
	[
	let timevec=vec 1
	let timestart=Timer(timevec)
	while time gr (Timer(timevec)-timestart) do loop
	]

and InvertScreen() be
	[
	let nextdcb=@#420
	while nextdcb do
		[
		nextdcb>>DCB.background=not nextdcb>>DCB.background
		nextdcb=@nextdcb
		]
	]

and Group(selection,lvstatus) be
	[
	// A number of boxes are defined as a group
	// only one can be selected at a time
	// -- lvstatus is the address where the number identifying
	//  which member of the group is presently selected is stored
	// -- selection is the new selection
	// -- Group deselects the old and selects the new
	FillBox(menu!(@lvstatus),flip)
	@lvstatus=selection
	]

and defaultAISname() be
	[
	AISFileName=Allocate(zone,6)
	MoveBlock(AISFileName,"Screen.ais",6)
	if input then input>>INPUT.name=AISFileName
	]

and defaultPRESSname() be
	[
	PressFileName=Allocate(zone,7)
	MoveBlock(PressFileName,"Screen.press",7)
	if input then input>>INPUT.name=PressFileName
	]