keep	FILE

****************************************************************
* 		           ChemiGS			       *
****************************************************************
* A Drawing Program for Chemical Structures		       *
* (c) 1992-93 by Urs Hochstrasser			       *
* Buendtenweg 6			       *
* 5105 AUENSTEIN (SWITZERLAND)			       *
****************************************************************

* Module FILE


****************************************************************
*
* USES ...
*
	mcopy	File.macros
	copy	equates.asm

****************************************************************
*
* File Stuff
*

OpenDlog	start
	using Globals
	using Parms
	~SFGetFile2 #120,#40,#RefIsPointer,#prompt,#0,#typeList,#gReplyRec
	lda	gReplyRec
	rts
prompt	dw	'Open Chemix File:'
typeList	dc	i2'1'	numEntries
	dc	i2'$8000'	flags cf.p. 48-10 TB III
	dc	i2'$00F4'	fileType
	dc	i4'$00005548'	auxType; ='UH'
	end

DoOpen	start
	using Globals
	using Parms
	jsr OpenDlog
	bne	l1	user cancelled the open dlog
	brl	exit
l1	anop
	lda	gRRpath
	ldx	gRRPath+2
	jsr Deref
	sta	Opath
	stx	Opath+2
	~HUnlock gRRpath
         inc4	Opath	convert Cl1output to Cl1InputString
	inc4	Opath
Open2	entry
	inc	fFullAccess	assume full R/W access allowed
	lda	#3	try R/W access
	sta	OreqAcc
	OpenGS OpenParm
	bcc	opened	no Error --> OK
	sta	gToolErr
	stz	fFullAccess	sorry, no full R/W access...
	cmp	#invalidAccess	(R/O)
	bne	exit2
	jsr	alertRO	inform user of read only access
	beq	exit	User cancelled OPEN
	lda	#1	try read only
	sta	OreqAcc
	OpenGS OpenParm
	sta	gToolErr
	bcs	exit2
opened	anop
	~WaitCursor
	lda	OpenParm+2
	sta	CloseParm+2
	sta	ReadParm+2
	sta	RSegRec+2
	jsr	DoNew2
	jsr	OpenWindow
	inc	gDataWNum
	jsr	NewData
	lda	OpenParm+2	...				*
	sta	gRefNum	besser hier...			*
	jsr	ReadFile
	bcs	exit4	close window if READ fails
	lda	fFirstFile
	bne	l2
	jsr	NewTitle
l2	stz	fFirstFile
	inc	fSaved
	inc	fNamed                       
	lda	fFullAccess
	beq	exit3
         brl	exit

exit4	jsr	DoClose
	bra	exit2
exit3	CloseGS CloseParm	close if R/O
exit2	jsr	Error
exit	~InitCursor
	rts

alertRO	anop		inform user that file is read only
	pha
	~AlertWindow #4,#0,#kAlertRO	refIsResource,no SubstStrings,ResID
	pla
	rts

NewTitle	entry
	inc	fNamed	set 'named' flag
	move4	gRRname,gTitleH
	lda	gTitleH
	ldx	gTitleH+2
	jsr	Deref
	sta	0
	stx	2
	ldy	#2	Convert Cl2 Output to...
	lda	[0],y
	xba
	sta	[0],y
	move4	0,gTitlePtr
	inc4	gTitlePtr
	inc4	gTitlePtr
	inc4	gTitlePtr	...Pascal string
	~SetWTitle gTitlePtr,gDataWin
	rts
	end

ReadFile	start	
	using Globals
	using Parms
	move4	#FileHeader,RdBuf
	ReadGS ReadParm
	sta	gToolErr
	bcs	rdExit
	jsr	ReadData
rdExit	rts		check for errors in calling pgm only

ReadData	anop
	ph4	#0
	~NewHandle #segSize,gMyID,#0,#0
	pl4	gNewLink
	ReadGS RSegRec
	sta	gToolErr
	bcs	exit
	lda	sLink
	ora	sLink+2
	beq	exit
	move4	gNewLink,sLink
	~PtrToHand #TheSegment,gLink,#segSize	*
	move4 gNewLink,gLink
	bra ReadData
exit	brl	exit3
	lda	fCacheWins
	bne	drawOff
	brl	exit3
******************* NEW: DRAW INTO OFFSCREEN PORT ***********************
drawOff	~PtrToHand #TheSegment,gLink,#4	****
	ph4	#0
	~GetPort
	pl4	thePort
	ph4	#0
	~GetWRefCon gDataWin
	pl4	theHandle
	~HandToPtr theHandle,#theData,#40
	~SetPort offPort
loop	~HandToPtr theData,#TheSegment,#segSize
	~SetPenSize sPenSize+2,sPenSize
	lda	sCMD
	bne	l7
	brl	exit2
l7	cmp	#6
	bcs	l1
	asl	a
	tax
	jsr	(toolTable,x)
	brl	l4
l1	cmp	#11
	bcs	l2
	bra	exit2
l2	cmp	#17
	bcc	l3
	bra	exit2
l3	sec
	sbc	#11
	asl	a
	tax
	jsr	(toolTable2,x)
l4	move4	sLink,theData
	lda	theData
	ora	theData+2
	beq	exit2
	brl	loop
exit2	anop
	~SetPort thePort
exit3	rts

theData	ds	4	Handle to linked segment list
theText	ds	4	Handle to linked AtomText list
theObj	ds	4	Handle to linked object list
	ds	4	handle to hor. scroll bar         (ID 5)
	ds	4	handle to vert. scroll bar        (ID 6)
	ds	4	handle to display size control    (ID 8)
	ds	4	handle to size box control        (ID 9)
	dc i2'18,0,156,531'	Window's Content Rect (own terminology)
offPort	ds	4
theWindow ds	4
thePort	ds	4
theHandle ds	4
	end


DoNew	start
	using Globals
	ph4	#0	create Title string
	~NewHandle #12,gmyID,#0,#0
	pl4	gTitleH
	lda	gTitleH
	ldx	gTitleH+2
	jsr	Deref
	sta	gTitlePtr
	stx	gTitlePtr+2
	~Int2Hex fileCount,#winTitle+10,#2
	~BlockMove #winTitle,gTitlePtr,#12

	jsr	doNew2
	jsr	OpenWindow
	sed		increment file count...
	clc
	lda	fileCount
	adc	#1
	sta	fileCount
	cld		in decimal mode!
**** initialize new FileInfo Record ****
	inc	fSaved	set 'saved' flag
	jsr	NewData
	inc	gDataWNum
	stz	fNamed	clear 'named' flag
	rts

doNew2	entry
	lda	gDataWNum	if no window there...
	beq	l1	don't save its File Info!
	ph4	#0
	~GetWRefCon gDataWin
	pl4	theHandle
	~PtrToHand #FileInfo,theHandle,#FInfoSize
l1	rts

NewData	entry
	ph4	#0
	~NewHandle #segSize,gMyID,#0,#0 ;Create Link to first data item
	pl4	gLink
	move4	gLink,gTheData
	~PtrToHand #NewSegment,gLink,#segSize
	ph4	#0
	~NewHandle #FInfoSize,gmyID,#0,#0
	pl4	theHandle
	~PtrToHand #FileInfo,theHandle,#FInfoSize
	~SetWRefCon theHandle,gDataWin
	ph4	#0
	~NewHandle #8,gMyID,#0,#0	;Create Link to first text item
	pl4	gTXLink
	move4	gTXLink,gTheText
	~PtrToHand #NewText,gTXLink,#8	;8=Size of empty text item
	ph4	#0
	~NewHandle #8,gMyID,#0,#0	;Create Link to first object
	pl4	gObjLink
	move4	gObjLink,gTheObj
	~PtrToHand #NewObj,gObjLink,#8	;8=size of empty object
	rts
theHandle ds	4
fileCount dc	i2'1'
winTitle	dw	'Untitled.xx'	number at titlePtr+10
	end

DoClose	start
	using Globals
	using Parms
	inc	answer	???
	ph4	#0
	~FrontWindow
	pl4	theWindow
	lda	theWindow
	ora	theWindow+2
	bne	l3
	sec
	brl	exit
l3	cmp4	theWindow,gToolWin
	bne	l4
	brl	exit
l4	pha
	~GetWKind theWindow
	pla
	bne	l1
	lda	fSaved
	bne	l2
	jsr	AskClose
	sta	answer
	beq	exit
	cmp	#1
	beq	l2
	jsr	DoSave
	beq	exit	don't close if 'save' is cancelled
l2	~CloseWindow theWindow
	~DisposeHandle PicHandle	**** hier richtig???
	dec	gDataWNum
*** New Stuff
	lda	fNamed
	beq	exit
	lda	gRefNum
	sta	CloseParm+2
	CloseGS CloseParm
*** End new Stuff
	bra	exit
l1	~CloseNDAByWinPtr theWindow
exit	jsr	AdjustCursor	***
	lda	answer
	rts
theWindow ds	4
answer	ds	2

AskClose	entry		ask 'Save Changes?'
	~InitCursor	*** new
	pha
	~AlertWindow #4,#0,#kSaveChID	refIsResource,no SubstStrings,ResID
	pla
	rts
	end


DoRevert	start
	using	Globals
	using	Parms
	rts
	end

DoSave	start
	using Globals
	using	Parms
	lda	fNamed
	bne	sOK
	jsr	DoSaveAs
	brl	sExit
sOK	anop

*	get pathname from fileInfo

WriteFile entry
	lda	wKind
	sta	fileKind
	~HandToPtr gPrintHndl,gPrintRec,#140
	lda	gRefNum
	sta	setEOFRec+2
	sta	writeRec+2
	sta	WSegRec+2
	sta	flushRec+2
	SetEOFGS setEOFRec
	sta	gToolErr
	jsr	Error
	WriteGS writeRec	Write the header...
	sta	gToolErr
	jsr	Error
         jsr	WriteData	...and the data
	FlushGS flushRec
	sta	gToolErr
	jsr	Error
	inc	fSaved
sExit	rts

WriteData anop
	move4 gTheData,theData
loop	anop
	~HandToPtr theData,#TheSegment,#segSize
	sta	gToolErr
	bcs	Exit
	WriteGS WSegRec
	sta	gToolErr
	bcs	exit
	move4	sLink,theData
	lda	theData
	ora	theData+2
	beq	exit
	brl	loop
exit	jsr	Error
	rts
theData	ds	4
*theHandle ds	4

DoSaveAs	entry
	ph4	#0
	~GetWTitle gDataWin
	pl4	gTitlePtr
	lda	gTitlePtr	convert Pascal string from Window
	ldx	gTitlePtr+2	title into a GS/OS C1inputString
	sta	0
	stx	2
	lda	[0]
	and	#$FF
	inc	a
	sta	origLen
	~BlockMove gTitlePtr,#origName+1,origLen
	lda	origLen
	dec	a
	sta	origName
	~SFPutFile2 #120,#40,#RefIsPointer,#svPrompt,#RefIsPointer,#origName,#gReplyRec
	lda	gReplyRec
	bne	svOK
	brl	svExit
svOK	anop
	~WaitCursor
* Code for saving file
	lda	fNamed	If file not named...
	beq	notOpen	...it's not open, so skip
	dec4	gPathPtr	get Handle for current pathname...
	dec4	gPathPtr
	ph4	#0
	~FindHandle gPathPtr
	pl4	theHandle
	~DisposeHandle theHandle	...and get rid of it
	lda	gRefNum	Close old file
	sta	CloseParm+2
	CloseGS CloseParm
	sta	gToolErr	***test
	jsr	Error	***test
notOpen	anop
	lda	gRRPath	get new Pathname Handle
	ldx	gRRPath+2	 deref it, and...
	jsr	Deref
	sta	gPathPtr
	stx	gPathPtr+2
	inc4	gPathPtr	...convert to Cl1InputString
	inc4	gPathPtr
	move4	gPathPtr,destroyRec+2
	DestroyGS destroyRec	delete old version on disk...
	sta	gToolErr
	bcc	desOK
	cmp	#$10	devNotFound
	beq	desOK
	cmp	#$46	fileNotFound
	beq	desOK
	jsr	Error
	brl	svExit
desOK	anop
	move4	destroyRec+2,createRec+2	gPathPtr,createRec+2
	CreateGS createRec
	sta	gToolErr
	jsr	Error
	move4	gPathPtr,Opath
	lda	#3	R/W access
	sta	OreqAcc
	OpenGS OpenParm
	sta	gToolErr
	jsr	Error
	lda	OpenParm+2
	sta	gRefNum
	jsr	WriteFile

	~DisposeHandle gTitleH	get rid of old title handle
	jsr	NewTitle	get new title from replyRec
	brl	svExit

*	inc	fNamed	set 'named' flag
*	~DisposeHandle gTitleH	get rid of old title handle
*	move4	gRRname,gTitleH
*	lda	gTitleH
*	ldx	gTitleH+2
*	jsr	Deref
*	sta	0
*	stx	2
*	ldy	#2	Convert Cl2 Output to...
*	lda	[0],y
*	xba
*	sta	[0],y
*	move4	0,gTitlePtr
*	inc4	gTitlePtr
*	inc4	gTitlePtr
*	inc4	gTitlePtr	...Pascal string
*	~SetWTitle gTitlePtr,gDataWin
svExit	~InitCursor
	lda	gReplyRec	return status of PutFile dialog
	rts

svPrompt	dw	'Save Chemix File As:'
origLen	ds	4
origName	ds	257
theHandle ds	4
	end

DoQuit	start
	using	Globals
l1	jsr	DoClose
	beq	exit
	bcs	l2
	ph4	#0
	~FrontWindow
	pl4	theWindow
	ph4	#0
	~GetWRefCon theWindow
	pl4	theHandle
	~HandToPtr theHandle,#FileInfo,#FInfoSize
	brl	l1
l2	dec	gDone
exit	rts
theWindow ds	4
theHandle ds	4
	end


Parms	data
	using Globals

gReplyRec ds	8
	dc	i2'3'	nameRefDesc=RefIsNewHandle
gRRname	ds	4
	dc	i2'3'	pathRefDesc=RefIsNewHandle
gRRpath	ds	4	handle to Cl1OutputString (w Buffer size)

OpenParm	dc	i2'3'	pCount
	ds	2	refNum
Opath	ds	4	pathname pointer
OreqAcc	dc	i2'3'	requestAccess
	ds	2	resourceNumber
	ds	2	access
	ds	2	fileType
	ds	4	auxType
	ds	2	storageType
	ds	8	createDateTime
	ds	8	modDateTime
	ds	4	optionList
Oeof	ds	4	eof
	ds	4	blocksUsed
	ds	4	resourceEOF
	ds	4	resourceBlocks

ReadParm	dc	i2'4'	pCount
	ds	2	refNum
RdBuf	dc	i4'FileHeader'	dataBuffer
RrCount	dc	i4'256'	requestCount
	ds	4	transferCount
	ds	2	cachePriority

RSegRec	dc	i2'4'	pCount
	ds	2	refNum
	dc	i4'TheSegment'	dataBuffer
	dc	i4'SegSize'	requestCount
	ds	4	transferCount
	ds	2	cachePriority

writeRec	dc	i2'4'
	ds	2	refNum
	dc	i4'FileHeader'	dataBuffer
	dc	i4'256'	requestCount; current header size
	ds	4	transferCount
	ds	2	cachePriority; not used

wSegRec	dc	i2'4'
	ds	2	refNum
	dc	i4'TheSegment'	dataBuffer
	dc	i4'SegSize'	requestCount; current seg size
	ds	4	transferCount
	ds	2	cachePriority; not used

flushRec	dc	i2'1'
	ds	2	refnum

CloseParm dc	i2'1'
	ds	2	refNum

destroyRec dc	i2'1'
	ds	4

createRec dc	i2'4'
	ds	4	pathName
	dc	i2'$00C3'	access
	dc	i2'$00F4'	fileType
	dc	i4'$00005548'	auxType; 'UH'
	ds	2	storageType
	ds	4	eof
	ds	4	resourceEOF

setEOFRec dc	i2'3'
	ds	2	refNum
	dc	i2'0'	base; set EOF to displacement
	dc	i4'0'	displacement   war 1*****

	end