1 line
11 KiB
NASM
1 line
11 KiB
NASM
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
|