***********************************************************
*	Degas snapshot utility v1 - Save screen if:	  *
*	Control+Alternate+both Shift keys held down	  *
*	Written using HiSoft Devpac			  *
*	Last modified 22/02/90	(c) 1990 by M.Murray	  *
***********************************************************

* Display start-up message
	PEA message(PC)		string address
	MOVE #9,-(A7)		c_conws
	TRAP #1			GEMDOS
	ADDQ.L #6,A7		tidy stack
	MOVE #500,D0		delay loop
delay1	MOVE #1000,D1		waste time by doing sums!
delay2	MOVE #-1,D2
	MULU D2,D2
	DBRA D1,delay2
	DBRA D0,delay1

* Call revect in supervisor mode to alter TRAP #13 vector
	PEA revect(PC)		stack address of subroutine
	MOVE #$26,-(SP)		superx
	TRAP #14		XBIOS
	ADDQ.L #6,A7		restore stack

* Exit to desktop, but keep program in memory
	MOVE.L 4(A7),A5		Get basepage address in A5
	MOVE.L $C(A5),D0	get text segment size in D0
	ADD.L $14(A5),D0	add data segment size
	ADD.L $1C(A5),D0	add uninitialised bit
	ADD.L #$100,D0		add basepage size
	CLR -(A7)		exit code = 0
	MOVE.L D0,-(A7)		number of bytes to keep
	MOVE #49,-(A7)		p_termres
	TRAP #1			GEMDOS

* Revector TRAP #13 through my code (in supervisor mode)
revect	LEA oldtrap(PC),A0
	MOVE.L $B4,(A0)		copy TRAP #13 vector to oldtrap
	LEA code(PC),A0
	MOVE.L A0,$B4		insert code address into TRAP #13
	RTS

* All TRAP #13 calls now pass through here
code	MOVEM.L D0-D3/A0-A3,-(A7)	Save registers
	LEA flag(PC),A3		A0 -> flag
	TAS (A3)		routine on or off?
	BNE exit		IF flag<>0 THEN exit
	MOVE #-1,-(A7)		read keyboard shift bits
	MOVE #11,-(A7)		kbshift
	TRAP #13		Gem Bios
	ADDQ.L #4,A7		tidy stack
	ANDI #15,D0		bits 0/1/2/3 are key status
	CMPI #15,D0		all pressed?
	BNE quit		quit if not

* This code is executed if all keys are pressed
	MOVE #4,-(A7)		_getrez...in D0
	TRAP #14		XBIOS
	ADDQ.L #2,A7		tidy stack
	LEA header(PC),A0	A0 -> header
	MOVE D0,(A0)		put resolution in 1st word of header
	LEA name(PC),A0		A0 -> filename
	ADDQ.B #1,5(A0)		increment letter in filename SNAP_?.PI?
	ADDI #49,D0		make res into '1'/'2'/'3'
	MOVE.B D0,9(A0)		put resolution in name...PI1-PI3

	CLR -(A7)		filespec = 0 = read/write
	PEA name(PC)		filename
	MOVE #60,-(A7)		f_create.....create file
	TRAP #1			GEMDOS
	ADDQ.L #8,A7		tidy stack
	MOVE D0,D3		save file handle in D3

	PEA palette(PC)		get palette in supervisor mode
	MOVE #38,-(A7)		superx
	TRAP #14		XBIOS
	ADDQ.L #6,A7		tidy stack

	PEA header(PC)		address of memory to save
	MOVE.L #34,-(A7)	34 bytes to write
	MOVE D3,-(A7)		file handle
	MOVE #64,-(A7)		f_write.....save header
	TRAP #1			GEMDOS
	ADDA.L #12,A7		tidy stack

	MOVE #2,-(A7)		_physbase...in D0
	TRAP #14		XBIOS
	ADDQ.L #2,A7		tidy stack
	MOVE.L D0,-(A7)		screen address
	MOVE.L #32000,-(A7)	32k to save
	MOVE D3,-(A7)		file handle
	MOVE #64,-(A7)		f_write.....save screen
	TRAP #1			GEMDOS
	ADDA.L #12,A7		tidy stack

	MOVE D3,-(A7)		file handle
	MOVE #62,-(A7)		f_close.....close file
	TRAP #1			GEMDOS
	ADDQ.L #4,A7		tidy stack

quit	CLR.B (A3)		reset flag to turn routine back on
exit	MOVEM.L (A7)+,D0-D3/A0-A3	Restore registers
	DC.W $4EF9		JMP $xxxxxxxx - old vector address
oldtrap	DC.L 0

***********************************************************
* Subroutine to get the palette in supervisor mode
***********************************************************
palette	LEA header+2(PC),A0	A1 -> header+2
	LEA $FF8240,A1
	MOVE #7,D0
ploop	MOVE.L (A1)+,(A0)	copy palette into header
	ANDI.L #$07770777,(A0)+	mask off unwanted bits
	DBRA D0,ploop
	RTS

flag	DC.W 0			flag for switching routine on/off
name	DC.B 'SNAP_@.PI1',0	filename
	EVEN
header	DS.W 17			Degas header...34 bytes
message	DC.B 13,10,' Snap v1.0 is now installing...',13,10
	DC.B 13,10,' Press: Control + Alternate + both'
	DC.B 13,10,' Shift keys to save the screen...',0