\ file_elmnts_mac
\
\ ob.mac.file.elmnts (subclass of ob.file.elmnts) that supports mac specific
\ features.
\
\
\ additional methods:
\
\	PUT.CREATOR:	( ostype | 0 --  , set mac creator id )
\	PUT.TYPE:		( ostype | 0 --  , set mac file type )
\
\ setting either of these to 0 will make the object use the default values.
\ The defaults are 'HMSL' for the creator and 'TEXT' for the file type.
\
\
\ code: Han-earl Park
\ copyright 2004 buster & friends' C-ALTO Labs
\ (Southampton, April 2004 -
\
\ MOD: HeP 04-29-04	Split off mac specific support to new class (remove mac
\					specific code from file_elmnts). Add support for Mac
\					volume reference number.
\					Trial and error implementation of the SFGetFile (which
\					replaces the h4th built in version).
\ MOD: HeP 05-14-04	File names are stored in object so are no longer
\					overwritten by an external process.
\ MOD: HeP 05-15-04	Access to file name is exclusively via late bound calls to
\					GET/PUT.FILE.NAME: (makes subclass overriding easier).
\ MOD: HeP 05-19-04	Move the error report in SAVE: to handle it before
\					the call to SAVE.AS: self.
\ MOD: HeP 06-18-04	Add variable fcancel.
\ MOD: HeP 06-27-04	Consistently clear error flags at the start of all methods
\					that check for errors.
\					Report file errors in REVERT:
\
\ ToDo: What's the deal with the position of the sfgetfile and sfputfile
\		dialogues?

include?  task-file_elmnts  myt:file_elmnts


anew task-file_elmnts_mac


.NEED SFGetFile()
	
	: SFGetFile()	( xy $prompt filter #types typeList dlgHook &reply --  )
		0002			\ routine selector
		pass: 44424442
		trap: A9EA
	;
	
	: SFGetFile+ ( x y -- $filaname vrefnum true | 0 )
		swap 16 shift OR	\  -- xy
		pad					\  -- $prompt (ignored)
		0					\  -- fileFilter
		1					\  -- numTypes
		file-type			\  -- typeList
		0					\  -- dlgHook
		mySFReply			\  -- &reply
		SFGetFile()
	\
		mySFReply ..@ sfr_good
		IF
			mySFReply .. sfr_fName
			mySFReply ..@ sfr_vRefNum
			true
		ELSE
			0
		THEN
	;
	
	: SFGetFile	(  -- $filaname vrefnum true | 0 )
		20 20  SFGetFile+
	;
	
.THEN


variable  fcancel	\ true if last action was canceled by user


method  PUT.CREATOR:
method  PUT.TYPE:


:class  OB.MAC.FILE.ELMNTS  <super  OB.FILE.ELMNTS
	
	iv.long  iv-felm-vrefnum
	
	iv.long  iv-felm-file-creator
	iv.long  iv-felm-file-type
	
	
	
:m INIT:	(  --  )
	init: super
\
	0  iv=> iv-felm-vrefnum
	0  iv=> iv-felm-file-creator
	0  iv=> iv-felm-file-type
;m


\ creator and file type

" TEXT" ostype: 'TEXT'

: FELM.SET.FILE.TYPE	(  --  )
	iv-felm-file-creator
	IF	iv-felm-file-creator  ELSE  'HMSL'
	THEN
	file-creator !
\
	iv-felm-file-type 
	IF	iv-felm-file-type  ELSE  'TEXT'
	THEN
	file-type !
;

:m PUT.CREATOR:	( ostype | 0 --  )
	iv=> iv-felm-file-creator
;m

:m PUT.TYPE:	( ostype | 0 --  )
	iv=> iv-felm-file-type
;m


\ create, open and close files

:m NEW:	( #elm #dim --  , create new file without saving )
	new: super
\
	0  iv=> iv-felm-vrefnum
;m

:m OPEN:	(  -- flag , open file and read contents )
	felm.clear.errors
	felm.set.file.type
\
	sfgetfile			\  -- $fname vrefnum true | false
\
	dup not  fcancel !
	dup
	IF	drop
	\	
		2dup
		$fopen.vr		\ $fname vrefnum -- file_Id | false
		dup
		IF
			iv=> iv-felm-file-ptr
		\
			iv=> iv-felm-vrefnum
		\
			self  put.file.name: []
		\
			true iv=> iv-felm-open?
			true iv=> iv-felm-saved?
		\
			self READ: []		\  -- flag
		ELSE
			nip	nip		\ $fname vrefnum false -- false
		THEN
	THEN
\
	dup  felm.error
;m


\ save and write files

:m SAVE.AS:	(  -- flag , save to a new file )
	felm.clear.errors
	felm.set.file.type
\
	self  get.file.name: []
\
	20 20
	" Save this document as:"
	sfputfile	\ $original x y $promt -- $fname vrefnum true | false
\
	dup not  fcancel !
	dup
	IF	drop
	\
		2dup
		NEW  $fopen.vr		\ $fname vrefnum -- file_Id | false
		dup
		IF
			iv=> iv-felm-file-ptr
		\
			iv=> iv-felm-vrefnum
		\
			self  put.file.name: []
		\
			true iv=> iv-felm-open?
			true iv=> iv-felm-saved?
		\
			self WRITE: []		\  -- flag
		ELSE
			nip nip			\ $fname vrefnum false -- false
		THEN
	THEN
\
	dup  felm.error
;m

:m SAVE:	(  -- flag , save changes if exists )
	felm.clear.errors
	felm.set.file.type
\
	false  fcancel !	\ set this in just in case
\
	iv-felm-vrefnum
	iv-felm-open? 0=  AND
	IF
		self  get.file.name: []
	\
		iv-felm-vrefnum
		$fopen.vr		\ $fname vrefnum -- file_Id | false
		dup
		IF
			iv=> iv-felm-file-ptr
		\
			true iv=> iv-felm-open?
		ELSE
			felm.error	\ catch it here instead of at save.as: self below
			felm.clear.errors
		THEN
	THEN
\
	iv-felm-file-ptr
	iv-felm-open?  AND
	IF
		true iv=> iv-felm-saved?
	\
		self WRITE: []		\  -- flag
	ELSE
		save.as: self		\  -- flag
	THEN
;m


\ open from and save to specified directory

:m OPEN.FROM:	( $dir | 0 -- flag , open at specified or default directory )
	felm.set.file.type
\
	open.from: super
;m

:m SAVE.TO:	( $dir | 0 -- flag , save to specified or default directory )
	felm.set.file.type
\
	save.to: super
;m

:m REVERT:	(  -- flag )
	felm.clear.errors
\
	iv-felm-vrefnum
	iv-felm-open? 0=  AND
	IF
		self  get.file.name: []
	\
		iv-felm-vrefnum
		$fopen.vr		\ $fname vrefnum -- file_Id | false
		?dup
		IF
			iv=> iv-felm-file-ptr
		\
			true iv=> iv-felm-open?  
		THEN
	THEN
\
	iv-felm-file-ptr
	iv-felm-open?  AND
	IF
		true iv=> iv-felm-saved?
	\
		self READ: []		\  -- flag
	ELSE
		false
	THEN
\
	dup  felm.error
;m


\ print

: PRINT.OSTYPE	( ostype --  , mac specific )
	dup  -24 shift  emit
	dup  -16 shift  emit
	dup   -8 shift  emit
	emit
;

:m PRINT:	(  --  )
	print: super
\
	."      Vrefnum = " iv-felm-vrefnum          4 .r  cr
\
	."      Creator = "
	iv-felm-file-creator
	dup 0=
	IF	drop 'HMSL'
	THEN
	print.ostype  cr
	."      Type    = "
	iv-felm-file-type
	dup 0=
	IF	drop 'TEXT'
	THEN
	print.ostype  cr
;m

;class



\ test

false .IF
	
	ob.mac.file.elmnts  macfet-1
	
	: MACFET.SCRAMBLE	(  --  )
		0  set.many: macfet-1
	\
		max.elements: macfet-1 choose  0
		DO	10 choose
			dup  10 *
			swap 100 *
			add: macfet-1
		LOOP
	;
	
	
	: (MACFE.TEST)	(  --  )
		BEGIN
			print: macfet-1
			>newline
			." qwerty:"  cr
			." S  =      save: macfet-1"  cr
			." A  =   save.as: macfet-1"  cr
			." T  =   save.to: macfet-1"  cr
			." O  =      open: macfet-1"  cr
			." F  = open.from: macfet-1"  cr
			." C  =     close: macfet-1"  cr
			." R  =    revert: macfet-1"  cr
			." P  =     print: macfet-1"  cr
			." BL =   randomize data"     cr
			." Q  =             quit"     cr
			key  toupper
			CASE
				ascii S  OF  save: macfet-1        .  false  ENDOF
				ascii A  OF  save.as: macfet-1     .  false  ENDOF
				ascii T  OF  0 save.to: macfet-1   .  false  ENDOF
				ascii O  OF  open: macfet-1        .  false  ENDOF
				ascii F  OF  0 open.from: macfet-1 .  false  ENDOF
				ascii C  OF  close: macfet-1          false  ENDOF
				ascii R  OF  revert: macfet-1      .  false  ENDOF
				ascii P  OF  print: macfet-1          false  ENDOF
				BL       OF  macfet.scramble          false  ENDOF
				ascii Q  OF	 true                            ENDOF
			\
				false swap
			ENDCASE
		UNTIL
	;
	
	
	: MACFET.INIT	(  --  )
		8 2  new: macfet-1
	\
		max.elements: macfet-1 0
		DO	i 10 *
			i 100 *
			add: macfet-1
		LOOP
	;
	
	: MACFET.TERM	(  --  )
		free: macfet-1
	;
	
	if.forgotten  MACFET.TERM
	
	
	: MACFE.TEST	(  --  )
		macfet.init  (macfe.test)  macfet.term
	;
	
	
	cr ." Enter MACFE.TEST to test the mac.file.elmnts class..." cr cr
	
.THEN