*	PicSaver V1.0
*	By Preben Nielsen
*
*	  This is a little utility that lets you cut-out a rectangular
*	piece of any screen much in the save way as brushes are cut-out
*	in Deluxe Paint and other paint-programs. The piece can then be
*	saved on disk as an IFF-ILBM file (can then be used in most
*	paint-programs).
*
*	NOTE:	There's no need to 'RUN' or 'RUNBACK' this program from the
*		CLI. It is auto-detaching.
*
*HISTORY
*          Made with Hisoft V2.12
*
*  V1.0   26-Mar-91: Can now draw/resize/erase the rectangle correctly.
*         26-Mar-91: Now it opens a window.
*         27-Mar-91: Saving screen as IFF-ILBM now works. (Unbuffered Output)
*         28-Mar-91: Cleaned up a bit.
*         31-Mar-91: Added the cross-hair. Still unbuffered Output !
*         31-Mar-91: Drawing rectangles was not perfect. When the rectangle
*                    is only one pixel on either side, it became invisible
*                    because I drew the same line twice in 'Complement' mode.
*                    Now I only draw one line in these cases.
*         05-Apr-91: Added 'AutoRequester'.
*         06-Apr-91: Added a few features. You can now easily save a window
*                    or an entire screen. Also little change in the
*                    'SaveILBM' routine.
                   
	OPT O+
	OPT O1+			; Tells when a branch could be optimised to short
	OPT i+			; Tells when '#' is probably missing

		incdir		"AsmInc:"
		include		"exec/exec_lib.i"
		include		"exec/io.i"
		include		"exec/memory.i"
		include		"exec/interrupts.i"
		include		"devices/input.i"
		include		"devices/inputevent.i"
		include		"libraries/dosextens.i"
		include		"libraries/dos_lib.i"
		include		"graphics/graphics_lib.i"
		include		"intuition/intuition_lib.i"
		include		"intuition/intuition.i"
		include		"intuition/intuitionbase.i"

* These are the signals sent from the input-handler to the process
SIGBASE		=20
QUAL_RELEASE_B	=SIGBASE
QUAL_PRESS_B	=SIGBASE+1
LMB_RELEASE_B	=SIGBASE+2
LMB_PRESS_B	=SIGBASE+3
MOVE_B		=SIGBASE+4
WINDOW_B	=SIGBASE+5
SCREEN_B	=SIGBASE+6
QUIT_B		=SIGBASE+7
PORT_B		=SIGBASE+8
QUAL_RELEASE_F	=1<<QUAL_RELEASE_B
QUAL_PRESS_F	=1<<QUAL_PRESS_B
LMB_RELEASE_F	=1<<LMB_RELEASE_B
LMB_PRESS_F	=1<<LMB_PRESS_B
MOVE_F		=1<<MOVE_B
WINDOW_F	=1<<WINDOW_B
SCREEN_F	=1<<SCREEN_B
QUIT_F		=1<<QUIT_B
PORT_F		=1<<PORT_B
WaitMask	=QUAL_RELEASE_F|LMB_RELEASE_F|LMB_PRESS_F|MOVE_F|WINDOW_F|SCREEN_F|QUIT_F|QUAL_PRESS_F

RECTANGLE	=0
CROSSHAIR	=1
DISABLED	=2

FileBufSIZE	=50

Prepare		MACRO
		IFC		'\1','Exec_Call'
		movea.l		4.W,A6
		ENDC
		IFC		'\1','Intuition_Call'
		movea.l		IntBase(DB),A6
		ENDC
		IFC		'\1','Gfx_Call'
		movea.l		GfxBase(DB),A6
		ENDC
		IFC		'\1','Dos_Call'
		movea.l		DosBase(DB),A6
		ENDC
		ENDM
CallLib		MACRO
		jsr		_LVO\1(A6)
		ENDM
Call		MACRO
		bsr		\1
		ENDM
CallS		MACRO
		bsr.S		\1
		ENDM
Push		MACRO
		movem.l		\1,-(SP)
		ENDM
Pop		MACRO
		movem.l		(SP)+,\1
		ENDM
rAPtr		MACRO		name
DefSiz		set		DefSiz+4
DefPtr		set		DefPtr-4
\1		=		DefPtr
		ENDM
rLong		MACRO		name
DefSiz		set		DefSiz+4
DefPtr		set		DefPtr-4
\1		=		DefPtr
		ENDM
rWord		MACRO		name
DefSiz		set		DefSiz+2
DefPtr		set		DefPtr-2
\1		=		DefPtr
		ENDM
rByte		MACRO		name
DefSiz		set		DefSiz+1
DefPtr		set		DefPtr-1
\1		=		DefPtr
		ENDM
rStorage	MACRO		name,size	; Define storage
DefSiz		set		DefSiz+\2
DefPtr		set		DefPtr-\2
\1		=		DefPtr
		ENDM
rEVEN		MACRO				; Word boundary
		IFNE		DefPtr&1
DefPtr		set		DefPtr-1
DefSiz		set		DefSiz+1
		ENDC
		ENDM
rStart		MACRO				; Define var section
DefPtr		set		0
DefSiz		set		0
		ENDM
rEnd		MACRO				; End var section
RelSize		=		DefSiz
		ENDM
rAlloc		MACRO				; Allocate vars
		link		DB,#-RelSize
		ENDM
rFree		MACRO				; Deallocate vars
		unlk		DB
		ENDM
rClear		MACRO				; Reset all vars
		movem.l		D0/DB,-(SP)
		move.w		#RelSize-1,D0
rClr.\@		clr.b		-(DB)
		dbf		D0,rClr.\@
		movem.l		(SP)+,D0/DB
		ENDM
Gadget		MACRO
		dc.l		\1
		dc.w		\2,\3,\4,\5,\6,\7,\8
		ENDM
Gadget2		MACRO
		dc.l		\1,\2,\3,\4,\5
		dc.w		\6
		dc.l		\7
		ENDM
Border		MACRO
		dc.w		\1,\2
		dc.b		\3,\4,\5,\6
		dc.l		\7,\8
		ENDM
Image		MACRO
		dc.w		\1,\2,\3,\4,\5
		dc.l		\6
		dc.b		\7,\8
		dc.l		\9
		ENDM
IntuiText	MACRO
		dc.b		\1,\2,\3,0
		dc.w		\4,\5
		dc.l		TxtAttr,\6,\7
		ENDM
Detach		MACRO		; Detach <'process name'>,stacksize,processpri
		SECTION		SingleSplit,CODE
Start		Prepare		Exec_Call
		suba.l		A1,A1
		CallLib		FindTask		; Find us
		move.l		D0,A2
		tst.l		pr_CLI(A2)
		bne.S		SegSplit
		jmp		ProcessStart		; from WorkBench
SegSplit	CallLib		Forbid			; From Dos
		lea		DName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,D5
		beq.S		3$
		moveq		#ML_SIZE+1*ME_SIZE,D0
		move.l		#MEMF_PUBLIC|MEMF_CLEAR,D1
		CallLib		AllocMem		; Allocate Memlist
		move.l		D0,A2
		tst.l		D0
		beq.S		2$
		move.l		#ProcessName,D1
		moveq		#\3,D2			; Priority
		move.l		Start-4(PC),D3
		move.l		#\2,D4			; StackSize
		move.l		D5,A6
		CallLib		CreateProc
		Prepare		Exec_Call
		tst.l		D0
		beq.S		1$
		move.l		D0,A0
		lea		-pr_MsgPort(A0),A0	; Now we have process
		not.l		pr_CLI(A0)		; All MY programs will now think they were started from the CLI
		lsl.l		#2,D3
		subq.l		#4,D3
		move.l		D3,A1
		move.w		#1,ML_NUMENTRIES(A2)	; MemList -> ml_NumEntries	= 1
		move.l		A1,ML_ME+ME_ADDR(A2)	; MemList -> ml_me[0].me_Addr	= Segment
		move.l		(A1),ML_ME+ME_LENGTH(A2); MemList -> ml_me[0].me_Length	= Length
		lea		TC_MEMENTRY(A0),A0
		move.l		A2,A1
		CallLib		AddTail			; AddTail(&Process->pr_Task.tc_MemEntry,&MemList->ml_Node);
		lea		Start-4(PC),A0
		clr.l		(A0)			; Split the segments
		bra.S		2$
1$		move.l		A2,A1			; CreateProc failed. Can't do anything then
		moveq		#ML_SIZE+1*ME_SIZE,D0
		CallLib		FreeMem
2$		move.l		D5,A1
		CallLib		CloseLibrary
3$		CallLib		Permit
		moveq		#0,D0
		rts
DName		dc.b		'dos.library',0
ProcessName	dc.b		\1,0			; CreateProc makes a copy of this name
		SECTION		ProcessCode,CODE
ProcessStart
		ENDM

DB		EQUR		A4

InitProcess	Detach		<'PicSaver Process'>,4000,0
		rAlloc					; Allocate memory for variables
		rClear					; Clear the memory
		lea		FileInfo(PC),A1
		lea		FBuffer(DB),A2
		move.l		A2,si_Buffer(A1)
		move.w		#FileBufSIZE,si_MaxChars(A1)
		Prepare		Exec_Call
		suba.l		A1,A1
		CallLib		FindTask		; Find us
		move.l		D0,PProcess(DB)
		movea.l		D0,A2
		tst.l		pr_CLI(A2)
		bne.S		GetLibs
WBStart		lea		pr_MsgPort(A2),A0
		CallLib		WaitPort		; wait for a message
		lea		pr_MsgPort(A2),A0
		CallLib		GetMsg			; then get it
		move.l		D0,WBMsg(DB)		; save it for later reply
GetLibs		CallLib		Forbid
		lea		IHS+ihs_PortName(PC),A1
		CallLib		FindPort
		move.l		D0,D2
		CallLib		Permit
		tst.l		D2
		beq.S		1$
		move.l		D2,A1			; PicSaver was already installed ! 
		move.l		MP_SIGTASK(A1),A1
		move.l		#QUIT_F,D0
		CallLib		Signal			; Signal task to quit and then exit
		bra.S		Exit
1$		lea		DosName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,DosBase(DB)
		beq.S		Error
		lea		GfxName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,GfxBase(DB)
		beq.S		Error
		lea		IntName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,IntBase(DB)
		beq.S		Error
* Allocate 9 signal-bits
		moveq		#8,D2
2$		moveq		#SIGBASE,D0
		add.w		D2,D0
		CallLib		AllocSignal
		dbf		D2,2$
		bra.S		Main

Error
Exit		Prepare		Exec_Call
FreeInt		move.l		IntBase(DB),D0
		beq.S		FreeGfx
		move.l		D0,A1
		CallLib		CloseLibrary
FreeGfx		move.l		GfxBase(DB),D0
		beq.S		FreeDos
		move.l		D0,A1
		CallLib		CloseLibrary
FreeDos		move.l		DosBase(DB),D0
		beq.S		ReplyWB
		move.l		D0,A1
		CallLib		CloseLibrary
ReplyWB		move.l		WBMsg(DB),D2
		beq.S		AllDone
		CallLib		Forbid			; We were started from WB
		movea.l		D2,A1
		CallLib		ReplyMsg		; Reply WBMessage
AllDone		rFree
		moveq		#0,D0
		rts

Main		bset		#DISABLED,Status(DB)
		lea		IHS(PC),A0
		lea		PSPrepIHS1(PC),A1
		lea		PSPrepIHS2(PC),A2
		Call		InstallHandler
		beq.S		1$
		moveq		#CANTINSTALL,D0
		Call		CONMsg
		bra.S		Error
1$		moveq		#INSTALLED,D0
		Call		CONMsg
		bclr		#DISABLED,Status(DB)
EventLoop	moveq		#0,D0
		move.l		Up(DB),D1
		beq.S		1$
		move.l		D1,A0
		moveq		#0,D1
		move.b		MP_SIGBIT(A0),D1
		bset		D1,D0
1$		ori.l		#WaitMask,D0
		Prepare		Exec_Call
		CallLib		Wait
		move.l		D0,D5
		move.l		Up(DB),D1
		beq		CheckIHS
		move.l		D1,A0
		moveq		#0,D0
		move.b		MP_SIGBIT(A0),D0
		btst		D0,D5
		beq		CheckIHS
GetNextMsg	move.l		Up(DB),D1		; Recieved an IDCMP-message
		beq		CheckIHS
		move.l		D1,A0
		Prepare		Exec_Call
		CallLib		GetMsg
		tst.l		D0
		beq		CheckIHS
		move.l		D0,A1
		move.l		im_Class(A1),D2
		move.l		im_IAddress(A1),A2
		CallLib		ReplyMsg
		cmp.l		#ACTIVEWINDOW,D2
		beq.S		ActivateFS
		cmp.l		#GADGETUP,D2
		bne.S		GetNextMsg
GJ		move.w		gg_GadgetID(A2),D0	; GadgetID is offset from GJ
		jmp		GJ(PC,D0.W)
DoSave		Call		CloseW
		move.l		WWindow(DB),D0
		beq.S		1$
		move.l		D0,A0
		Prepare		Intuition_Call
		CallLib		WindowToFront
		clr.l		WWindow(DB)
1$		Call		SaveRect
		beq.S		2$
		suba.l		A0,A0
		suba.l		A2,A2
		lea		ITxtAUTOBody(PC),A1
		lea		ITxtAUTOOk(PC),A3
		moveq		#0,D0
		moveq		#0,D1
		move.w		#248,D2
		moveq		#46,D3
		Prepare		Intuition_Call
		CallLib		AutoRequest
		bra.S		DoCS
2$		suba.l		A0,A0
		Prepare		Intuition_Call
		CallLib		DisplayBeep
		bra.S		DoCS
DoCancel	Call		CloseW
DoCS		bclr		#DISABLED,Status(DB)
		bra		GetNextMsg
ActivateFS	Prepare		Intuition_Call
		lea		Gad1(PC),A0
		move.l		PWindow(DB),A1
		suba.l		A2,A2
		CallLib		ActivateGadget
		bra		GetNextMsg

CheckIHS
TestQUIT	btst		#QUIT_B,D5
		beq.S		TestMOUSE
* User pressed the qualifiers + the 'Quit_Key'
		Call		DrawIt
		Call		CloseW			; Close window if it is open
		bset		#DISABLED,Status(DB)
		moveq		#REMOVED,D7
		lea		IHS(PC),A0
		lea		PSEndIHS1(PC),A1
		lea		PSEndIHS2(PC),A2
		Call		RemoveHandler
		beq.S		1$
		moveq		#CANTREMOVE,D0
		Call		CONMsg
		bra		EventLoop		; Help !!
1$		move.l		D7,D0
		Call		CONMsg
		bra		Exit			; Hmm
TestMOUSE	btst		#DISABLED,Status(DB)	; Are most things disabled ?
		bne		EventLoop

TestQ_PRESS	btst		#QUAL_PRESS_B,D5
		beq.S		TestQ_RELEASE
* User pressed the qualifiers
		Prepare		Intuition_Call
		move.l		ib_ActiveScreen(A6),D0
		beq.S		TestQ_RELEASE
		move.l		D0,A0
		move.w		sc_MouseY(A0),D0
		bmi.S		TestQ_RELEASE
		move.w		sc_MouseX(A0),D1
		bmi.S		TestQ_RELEASE
		movem.w		D0-D1,ey(DB)		; (x,y) >= (0,0)
		move.w		sc_Width(A0),sw(DB)	; Get starting point
		move.w		sc_Height(A0),sh(DB)	; Get screen width/height
		move.l		A0,WScreen(DB)
		lea		sc_RastPort(A0),A0	; Get screen Rastport
		move.l		A0,Rp(DB)
		bset		#CROSSHAIR,Status(DB)
		bclr		#RECTANGLE,Status(DB)
		Call		DrawIt			; Draw cross-hair

TestQ_RELEASE	btst		#QUAL_RELEASE_B,D5
		beq.S		TestLMB_RELEASE
* User released the qualifiers
		Call		DrawIt			; Erase cross-hair/rectangle
		bclr		#CROSSHAIR,Status(DB)
		bclr		#RECTANGLE,Status(DB)

TestLMB_RELEASE	btst		#LMB_RELEASE_B,D5
		beq.S		TestLMB_PRESS
* User released the LMB while holding down the qualifiers
		Call		DrawIt			; Erase cross-hair/rectangle
		bclr		#CROSSHAIR,Status(DB)
		bclr		#RECTANGLE,Status(DB)
		movem.w		ey(DB),D0-D3
		cmp.w		D0,D2
		ble.S		1$
		exg		D0,D2
1$		cmp.w		D1,D3
		ble.S		2$
		exg		D1,D3
2$		sub.w		D3,D1
		sub.w		D2,D0
		addq.w		#1,D1
		addq.w		#1,D0
		movem.w		D0-D3,ph(DB)
		lea		RTitle(PC),A0
		move.l		A0,PTitle(DB)
		bra		ContactTheUser

TestLMB_PRESS	btst		#LMB_PRESS_B,D5
		beq.S		TestMOVE
* User pressed the LMB while holding down the qualifiers
		Call		DrawIt			; Erase cross-hair
		bclr		#CROSSHAIR,Status(DB)
		move.l		WScreen(DB),A0
		move.w		sc_MouseY(A0),D0
		bmi.S		TestMOVE
		move.w		sc_MouseX(A0),D1
		bmi.S		TestMOVE
		movem.w		D0-D1,sy(DB)
		movem.w		D0-D1,ey(DB)
		bset		#RECTANGLE,Status(DB)
		Call		DrawIt			; Draw rectangle

TestMOVE	btst		#MOVE_B,D5
		beq.S		TestWINDOW
* User moved the mouse while holding down the qualifiers and the LMB
		move.l		WScreen(DB),A0
		move.w		sc_MouseY(A0),D0	; If Y < 0
		bge.S		1$
		moveq		#0,D0			; then Y = 0
1$		move.w		sc_MouseX(A0),D1	; If X < 0
		bge.S		2$	
		moveq		#0,D1			; then X = 0
2$		cmp.w		ey(DB),D0		; Did mouse actually move ?
		bne.S		3$
		cmp.w		ex(DB),D1
		beq.S		TestWINDOW
3$		Call		DrawIt			; Erase old cross-hair/rectangle
		movem.w		D0-D1,ey(DB)
		Call		DrawIt			; Draw new cross-hair/rectangle

TestWINDOW	btst		#WINDOW_B,D5
		beq.S		TestSCREEN
* User pressed the qualifiers + the 'Window_Key'
		Call		DrawIt			; Erase cross-hair/rectangle
		bclr		#CROSSHAIR,Status(DB)
		bclr		#RECTANGLE,Status(DB)
		Prepare		Intuition_Call
		move.l		ib_ActiveWindow(A6),D0
		beq.S		TestSCREEN
		move.l		D0,A0
		movem.w		wd_LeftEdge(A0),D0-D1
		move.w		D0,px(DB)
		move.w		D1,py(DB)
		move.w		wd_Width(A0),pw(DB)
		move.w		wd_Height(A0),ph(DB)
		move.l		wd_Flags(A0),D0
		andi.w		#BACKDROP,D0
		bne.S		ContactTheUser
		move.l		A0,WWindow(DB)
		lea		WTitle(PC),A0
		move.l		A0,PTitle(DB)
		bra.S		ContactTheUser

TestSCREEN	btst		#SCREEN_B,D5
		beq.S		DoneTest
* User pressed the qualifiers + the 'Screen_Key'
		Call		DrawIt			; Erase cross-hair/rectangle
		bclr		#CROSSHAIR,Status(DB)
		bclr		#RECTANGLE,Status(DB)
		move.l		WScreen(DB),A0
		movem.w		sc_LeftEdge(A0),D0-D1
		move.w		D0,px(DB)
		move.w		D1,py(DB)
		move.w		sc_Width(A0),pw(DB)
		move.w		sc_Height(A0),ph(DB)
		lea		STitle(PC),A0
		move.l		A0,PTitle(DB)
ContactTheUser	Call		OpenW
		beq		EventLoop
		bset		#DISABLED,Status(DB)
		bra		EventLoop
DoneTest	bra		EventLoop

DrawIt		btst		#RECTANGLE,Status(DB)
		bne.S		DoDraw
		btst		#CROSSHAIR,Status(DB)
		bne.S		DoDraw
		rts
DoDraw		Push		D0-D5/A0-A1/A6
		Prepare		Gfx_Call
		move.l		Rp(DB),A2
		moveq		#2,D0
		move.l		A2,A1
		CallLib		SetDrMd
		btst		#RECTANGLE,Status(DB)
		bne.S		DrawRect
DrawCross	moveq		#0,D0
		move.w		ey(DB),D1
		move.l		A2,A1
		CallLib		Move
		move.w		sw(DB),D0
		move.w		ey(DB),D1
		move.l		A2,A1
		CallLib		Draw
		move.w		ex(DB),D0
		moveq		#0,D1
		move.l		A2,A1
		CallLib		Move
		move.w		ex(DB),D0
		move.w		sh(DB),D1
		move.l		A2,A1
		CallLib		Draw
		bra.S		EndDrawIt
DrawRect	move.w		sx(DB),D2	; Always draw lines clockwice
		move.w		ex(DB),D4
		cmp.w		D2,D4
		bge.S		1$
		exg		D2,D4
1$		move.w		sy(DB),D3
		move.w		ey(DB),D5
		cmp.w		D3,D5
		bge.S		2$
		exg		D3,D5
2$		move.w		D2,D0
		move.w		D3,D1
		move.l		A2,A1
		CallLib		Move
		cmp.w		D2,D4		; If same x-coordinate then only draw one line
		bne.S		3$
		move.w		D2,D0
		move.w		D5,D1
		move.l		A2,A1
		CallLib		Draw
		bra.S		EndDrawIt
3$		move.w		D4,D0
		move.w		D3,D1
		move.l		A2,A1
		CallLib		Draw
		cmp.w		D3,D5		; If same y-coordinate then only draw one line
		beq.S		EndDrawIt
		move.w		D4,D0		; Draw the rest of the rectangle
		move.w		D5,D1
		move.l		A2,A1
		CallLib		Draw
		move.w		D2,D0
		move.w		D5,D1
		move.l		A2,A1
		CallLib		Draw
		move.w		D2,D0
		move.w		D3,D1
		addq.w		#1,D1		; Prevent 'round' corner
		move.l		A2,A1
		CallLib		Draw
EndDrawIt	moveq		#1,D0
		move.l		A2,A1
		CallLib		SetDrMd
		Pop		D0-D5/A0-A1/A6
		rts

* Call:  A0 = where to put it, D0 = number, D1 = count
DecStr		subq.w		#1,D1
		bra.S		2$
1$		move.b		#' ',(A0)+
2$		dbf		D1,1$
		moveq		#'0',D1
		move.b		D1,(A0)+
		ext.l		D0
3$		tst.l		D0
		beq.S		4$
		divu		#10,D0
		swap		D0
		add.w		D1,D0
		move.b		D0,-(A0)
		clr.w		D0
		swap		D0
		bra.S		3$
4$		rts


* Open a window on the Workbench screen and bring it to the front
OpenW		Push		D0-D7/A0-A6
		move.w		pw(DB),D0
		moveq		#4,D1
		lea		TxtSize+6(PC),A0
		Call		DecStr
		move.w		ph(DB),D0
		moveq		#4,D1
		lea		TxtSize+13(PC),A0
		Call		DecStr
		moveq		#0,D0
		move.l		WScreen(DB),A0
		move.b		sc_BitMap+bm_Depth(A0),D0
		moveq		#2,D1
		lea		TxtSize+20(PC),A0
		Call		DecStr
		Prepare		Intuition_Call
		lea		NW(PC),A0
		CallLib		OpenWindow
		move.l		D0,PWindow(DB)
		beq.S		1$
		move.l		D0,A0
		move.l		wd_UserPort(A0),Up(DB)
		move.l		PTitle(DB),A1
		lea		ScrTitle(PC),A2
		CallLib		SetWindowTitles
		move.l		PWindow(DB),A0
		move.l		wd_WScreen(A0),A0
		CallLib		ScreenToFront
1$		tst.l		PWindow(DB)
		Pop		D0-D7/A0-A6
		rts

* Close the window on the Workbench screen if it is open
CloseW		Push		D0-D7/A0-A6
		Prepare		Intuition_Call
		move.l		PWindow(DB),D0
		beq.S		1$
		move.l		D0,A0
		lea		NW(PC),A1
		movem.w		wd_LeftEdge(A0),D0-D1
		movem.w		D0-D1,nw_LeftEdge(A1)
		CallLib		CloseWindow
		clr.l		Up(DB)
		clr.l		PWindow(DB)
		move.l		WScreen(DB),A0
		CallLib		ScreenToFront
1$		Pop		D0-D7/A0-A6
		rts

FHandle		EQUR		D5
* Call: D0 = Msg-number
CONMsg		Push		D0-D7/A0-A6
		Prepare		Dos_Call
		move.l		D0,D4
		moveq		#0,D6
		CallLib		Output
		move.l		D0,FHandle
		bne.S		1$
		moveq		#1,D6
		lea		CONName(PC),A0
		move.l		A0,D1
		move.l		#MODE_OLDFILE,D2
		CallLib		Open
		move.l		D0,FHandle
		beq.S		2$
1$		moveq		#INFOMSG,D0
		Call		SendMsg
		move.l		D4,D0
		Call		SendMsg
		tst.l		D6
		beq.S		2$
		moveq		#127,D1
		CallLib		Delay
		move.l		FHandle,D1
		CallLib		Close
2$		Pop		D0-D7/A0-A6
		rts

* Call: D0 = Msg-number
SendMsg		neg.l		D0
		lsl.l		#1,D0
		lea		MsgTable(PC),A0
		add.w		0(A0,D0),A0
		move.l		A0,D2
		moveq		#-1,D3
1$		addq.l		#1,D3
		tst.b		(A0)+
		bne.S		1$
		move.l		FHandle,D1
		Prepare		Dos_Call
		CallLib		Write
		rts

INFOMSG		=0
INSTALLED	=-1
REMOVED		=-2
CANTINSTALL	=-3
CANTREMOVE	=-4

MsgText		MACRO
		dc.w		\1-MsgTable
		ENDM
MsgTable	MsgText		Msg
		MsgText		Msg1
		MsgText		Msg2
		MsgText		Msg3
		MsgText		Msg4

CONName		dc.b		'CON:100/60/330/63/PicSaver',0
Msg		dc.b		10,$9B,'0;33m PicSaver V1.0',10
		dc.b		$9B,'0;31m 1991 by ',$9B,'0;33mPreben Nielsen',$9B,'0;31m',10,' ',0
Msg1		dc.b		'has just been installed...',10,0
Msg2		dc.b		'has just been removed...',10,0
Msg3		dc.b		'Error: Cannot install handler',10,0
Msg4		dc.b		'Error: Cannot remove handler',10,0
		EVEN

rtsValue	EQUR		D7
* This is general-purpose inputhandler removal-routine
* It only needs an ihs with a port-name to remove the handler
* Call:   A0 = ihs
*	  A1 = first ihs-installation-routine or NULL
*	  A2 = second ihs-installation-routine or NULL
* Return: D0 = 0 means succes
RemoveHandler	Push		D1/rtsValue/A0-A3/A6
		moveq		#-1,rtsValue
		move.l		A2,A3
		move.l		A0,A2
		move.l		A1,D1
		beq.S		1$
		jsr		(A1)		; A0 = ihs
		beq.S		2$
		move.l		D0,A2
1$		move.l		A2,A0
		Prepare		Exec_Call
		moveq		#IND_REMHANDLER,D0
		Call		TellInputDevice
		move.l		D0,rtsValue
		bne.S		2$
		lea		ihs_Port(A2),A1
		CallLib		RemPort
		moveq		#0,D0
		bra.S		3$
2$		moveq		#-1,D0
3$		move.l		A3,D1
		beq.S		4$
		move.l		A2,A0
		jsr		(A3)		; A0 = ihs, D0 = 0 means succes
4$		move.l		rtsValue,D0
		Pop		D1/rtsValue/A0-A3/A6
		rts

* This is general-purpose inputhandler installation-routine
* It only needs an ihs with a port-name to install the handler
* Call:   A0 = ihs
*	  A1 = first ihs-installation-routine or NULL
*	  A2 = second ihs-installation-routine or NULL
* Return: D0 = 0 means succes
InstallHandler	Push		D1/rtsValue/A0-A3/A6
		moveq		#-1,rtsValue
		move.l		A2,A3
		move.l		A0,A2
		move.l		A1,D1
		beq.S		1$
		jsr		(A1)		; A0 = ihs
		beq.S		2$
		move.l		D0,A2
1$		move.l		A2,A0
		moveq		#IND_ADDHANDLER,D0
		Call		TellInputDevice
		move.l		D0,rtsValue
		bne.S		2$
		lea		ihs_Port(A2),A1
		lea		ihs_PortName(A2),A0
		move.l		A0,MP+LN_NAME(A1)		;MsgPort->mp_Node.ln_Name=Name;
		clr.b		MP+LN_PRI(A1)			;MsgPort->mp_Node.ln_Pri =0;
		move.b		#NT_MSGPORT,MP+LN_TYPE(A1)	;MsgPort->mp_Node.ln_Type=NT_MSGPORT;
		move.b		#PA_IGNORE,MP_FLAGS(A1)		;MsgPort->mp_Flags	 =PA_IGNORE;
		Prepare		Exec_Call
		CallLib		AddPort
		moveq		#0,D0
		bra.S		3$
2$		moveq		#-1,D0
3$		move.l		A3,D1
		beq.S		4$
		move.l		A2,A0
		jsr		(A3)		; A0 = ihs, D0 = 0 means succes
4$		move.l		rtsValue,D0
		Pop		D1/rtsValue/A0-A3/A6
		rts

* Open the input device. Set up the I/O block to add or remove the
* input handler, and send the request to the input device. Finally,
* close the device
* Call:   A0 = ihs
*	  D0 = Function to perform (IND_ADDHANDLER/IND_REMHANDLER)
* Return: D0 = 0 means succes
TellInputDevice	Push		D1-D2/rtsValue/A0-A3/A6
		Prepare		Exec_Call
		moveq		#-1,rtsValue
		move.l		D0,D2
		move.l		A0,A2
		lea		IReq(DB),A0
		moveq		#IOSTD_SIZE,D0
		Call		MemClear
		lea		IPort(DB),A0
		moveq		#MP_SIZE,D0
		Call		MemClear
		move.l		A0,A3
		move.b		#NT_MSGPORT,MP+LN_TYPE(A3)	; mp_Node.ln_Type=NT_MSGPORT;
		move.b		#PA_SIGNAL,MP_FLAGS(A3)		; mp_Flags	=PA_SIGNAL;
		moveq		#-1,D0
		CallLib		AllocSignal
		move.b		D0,MP_SIGBIT(A3)		; mp_SigBit	=MPSigBit;
		bmi.S		2$
		suba.l		A1,A1
		CallLib		FindTask
		move.l		D0,MP_SIGTASK(A3)		; mp_SigTask 	=FindTask(0);
		lea		IReq(DB),A1
		move.l		A3,IO+MN_REPLYPORT(A1)		; ExtReq->io_Message.mn_ReplyPort   =taskReplyPort;
		move.b		#NT_MESSAGE,IO+MN+LN_TYPE(A1)	; ExtReq->io_Message.mn_Node.ln_Type=NT_MESSAGE;
		lea		InputName(PC),A0		; input.device
		moveq		#0,D0				; unit#
		moveq		#0,D1				; flags
		CallLib		OpenDevice
		tst.w		D0				; flag: error if > 0
		bne.S		1$
		lea		IReq(DB),A1
		move.w		D2,IO_COMMAND(A1)
		lea		ihs_Interrupt(A2),A0
		move.l		A0,IO_DATA(A1)
		CallLib		DoIO
		move.l		D0,rtsValue
		lea		IReq(DB),A1
		CallLib		CloseDevice
1$		move.b		MP_SIGBIT(A3),D0
		CallLib		FreeSignal
2$		move.l		rtsValue,D0
		Pop		D1-D2/rtsValue/A0-A3/A6
		rts

* Call: A0    = Memory area
*	D0:16 = Count
MemClear	Push		D0-D1/A0
		moveq		#0,D1
		bra.S		2$
1$		move.b		D1,(A0)+
2$		dbf		D0,1$
		Pop		D0-D1/A0
		rts

* Call: A0   = Source
*	A1   = Destination
*	D0:16= Count
MemCopy		Push		D0/A0-A1
		bra.S		2$
1$		move.b		(A0)+,(A1)+
2$		dbf		D0,1$
		Pop		D0/A0-A1
		rts

* Each handler should have such a pair of installation-routine
* The first one is passed to InstallHandler in A1 and it
* is called immediately when entering InstallHandler
* The second one is passed to InstallHandler in A2 and it
* is called if installation of handler and message-port succeds
* -----------------------------------------------------------------
* Call:   A0 = ihs
* Return: D0 has to point to ihs to be used when installation proceeds
*	  If D0 = 0 then installation is aborted
PSPrepIHS1	Push		A0-A1
		move.b		#PORT_B,ihs_Port+MP_SIGBIT(A0)	;MsgPort->mp_SigBit	 =MPSigBit;
		move.l		PProcess(DB),ihs_Port+MP_SIGTASK(A0);MsgPort->mp_SigTask =FindTask(0);
		move.l		#HandlerSize,ihs_Length(A0)	; This will enable removal by other programs
		lea		HandlerCode-IHS(A0),A1
		move.l		A1,ihs_Interrupt+IS_CODE(A0)	; HandlerBlock.HInterrupt.is_Code = Handler
		move.l		DB,ihs_Interrupt+IS_DATA(A0)	; HandlerBlock.HInterrupt.is_Data = DB
		move.b		#HPRI,ihs_Interrupt+LN_PRI(A0)	; HandlerBlock.HInterrupt.is_Node.ln_Pri = PRI
		move.l		A0,D0
		Pop		A0-A1
		rts
* Call:   A0 = ihs
PSPrepIHS2	rts

* Each handler should have such a pair of ending-routine
* The first one is passed to RemoveHandler in A1 and it
* is called immediately when entering RemoveHandler
* The second one is passed to RemoveHandler in A2 and it
* is called if removal of handler and message-port succeds
* -----------------------------------------------------------------
* Call:   A0 = ihs
* Return: D0 has to point to ihs to be used when removal proceeds
*	  If D0 = 0 then removal is aborted
PSEndIHS1	Push		D1-D2/A0-A1/A6
		Prepare		Exec_Call
		CallLib		Forbid
		lea		ihs_PortName(A0),A1
		CallLib		FindPort
		move.l		D0,D2
		CallLib		Permit
		move.l		D2,D0			; Does Forbid/Permit destroy scratch-registers ?
		Pop		D1-D2/A0-A1/A6
		rts
* Call:   A0 = ihs
PSEndIHS2	rts

*====================== Input-handler start =========================
ihs_Port	=0
ihs_Interrupt	=MP_SIZE
ihs_ID		=MP_SIZE+IS_SIZE
ihs_Length	=MP_SIZE+IS_SIZE+4
ihs_Flags	=MP_SIZE+IS_SIZE+8
ihs_PortName	=MP_SIZE+IS_SIZE+10

ihs_Start	MACRO
		dcb.b		MP_SIZE		; Message-Port structure
		dcb.b		IS_SIZE		; Interrupt structure
		dc.l		'P_IH'		; ID
		dc.l		0		; Length of handler 
		dc.w		0		; Flags
		dc.b		\1,0
		EVEN
		ENDM

HPRI		=51
HDisabled	=0
HNoExtRemoval	=1

* This is the handler-block
IHS		ihs_Start	<'PicSaver V1.0 Port'>
* Local variables
Chain		dc.l		0
* For each event in the event list:
*  If we were waiting for this event then signal the task.
* When all the events have been checked, return the event list so that
* others can do their things.
PEvent		EQUR	A3				; Previous Event
Event		EQUR	A5				; This Event
Signals		EQUR	D7
Next		=ie_NextEvent
Class		=ie_Class
Code		=ie_Code
Qual		=ie_Qualifier
* These are the qualifier-keys the input-handler waits for
QUALIFIERS	=IEQUALIFIER_LALT|IEQUALIFIER_LSHIFT|IEQUALIFIER_CONTROL
* This is the key the input-handler exits on
Quit_Key	=$45					; ESC
Window_Key	=$11					; w
Screen_Key	=$21					; s

* Call:  A0 = List of InputEvents, A1 = HandlerData
HandlerCode	Push		D1/Signals/A0-A1/PEvent/DB/Event/A6
		moveq		#0,Signals
		move.l		A1,DB
		move.w		IHS+ihs_Flags(PC),D0
		btst		#HDisabled,D0		; Future feature
		bne		NoMoreEvents
		lea		Chain(PC),PEvent
		move.l		A0,Next(PEvent)
ieLoop		move.l		Next(PEvent),Event
		move.l		Event,D0
		beq		NoMoreEvents
		cmpi.b		#IECLASS_NULL,Class(Event)
		beq		DontRemove
		cmpi.b		#IECLASS_TIMER,Class(Event)
		beq		DontRemove
		move.w		Qual(Event),D0
		andi.w		#QUALIFIERS,D0
		cmp.w		#QUALIFIERS,D0
		bne		NoQual
		cmpi.b		#IECLASS_RAWKEY,Class(Event)
		bne.S		1$
		cmp.w		#Quit_Key,Code(Event)
		beq.S		DoQuit
		cmp.w		#Window_Key,Code(Event)
		beq.S		DoWindow
		cmp.w		#Screen_Key,Code(Event)
		beq.S		DoScreen
		bra.S		IsQual
		bra.S		DontRemove
1$		btst		#DISABLED,Status(DB)
		bne.S		DontRemove
		cmpi.b		#IECLASS_RAWMOUSE,Class(Event)
		bne.S		DontRemove
		cmpi.w		#IECODE_LBUTTON,Code(Event)
		beq.S		DoStart
		cmpi.w		#IECODE_UP_PREFIX|IECODE_LBUTTON,Code(Event)
		beq.S		DoEnd
		move.w		Qual(Event),D0
	        andi.w		#IEQUALIFIER_RELATIVEMOUSE,D0
		beq.S		DontRemove
DoMove		move.b		Status(DB),D0
		andi.b		#1<<RECTANGLE|1<<CROSSHAIR,D0
		beq.S		DontRemove
		bset		#MOVE_B,Signals
		bra.S		DontRemove
DoEnd		btst		#RECTANGLE,Status(DB)
		beq.S		DontRemove
		bset		#LMB_RELEASE_B,Signals
		bra.S		DontRemove
DoStart		bset		#LMB_PRESS_B,Signals
		bra.S		Remove
DoWindow	bset		#WINDOW_B,Signals
		bra.S		Remove
DoScreen	bset		#SCREEN_B,Signals
		bra.S		Remove
DoQuit		bset		#QUIT_B,Signals
		bra.S		Remove
IsQual		move.b		Status(DB),D0
		andi.b		#1<<RECTANGLE|1<<CROSSHAIR,D0
		bne.S		DontRemove
		bset		#QUAL_PRESS_B,Signals
		bra.S		DontRemove
NoQual		move.b		Status(DB),D0
		andi.b		#1<<RECTANGLE|1<<CROSSHAIR,D0
		beq.S		DontRemove
		bset		#QUAL_RELEASE_B,Signals
* Just move on to next Event
DontRemove	move.l		Event,PEvent
		bra		ieLoop
* Remove event from chain and move on to next Event
Remove		move.l		Next(Event),Next(PEvent)
		bra		ieLoop
* Lets return
NoMoreEvents	move.l		Signals,D0
		beq.S		1$
		Prepare		Exec_Call
		movea.l		PProcess(DB),A1
		CallLib		Signal
1$		Pop		D1/Signals/A0-A1/PEvent/DB/Event/A6
		move.l		Chain(PC),D0		; Return (shortened ?) chain
		rts
HandlerSize	=		*-IHS
*====================== Input-handler end ===========================

*====================== Picture-saver start =========================
PicScreen	=0
PicName		=4
PicX		=8
PicY		=10
PicWidth	=12
PicHeight	=14
PicCompression	=16
Pic_SIZE	=18

PicDefine	dc.l	0,0
		dc.w	0,0,0,0,0

SaveRect	Push		D0-D1/A0-A1
		lea		PicDefine(PC),A1
		lea		FBuffer(DB),A0
		move.l		A0,PicName(A1)
		move.l		WScreen(DB),PicScreen(A1)
		move.w		px(DB),PicX(A1)
		move.w		pw(DB),PicWidth(A1)
		move.w		py(DB),PicY(A1)
		move.w		ph(DB),PicHeight(A1)
		move.w		#1,PicCompression(A1)
		lea		PicDefine(PC),A0
		Call		SaveILBM
		Pop		D0-D1/A0-A1
		rts

ILBMHDSize	=20
BMHDSize	=20
ILBMHeader	dc.b		'FORM'
		dc.l		0
		dc.b		'ILBM'
		dc.b		'BMHD'
		dc.l		BMHDSize
BMHeader	dc.w		0,0	; raster width, height in pixels
		dc.w		0,0	; x,y pixel position for this image
		dc.b		0	; # source bitplanes
		dc.b		0	; masking
		dc.b		0	; compression
		dc.b		0	; unused; for consistency, put 0 here
		dc.w		0	; transparent 'color number'
		dc.b		1,1	; pixel aspect, a ratio width : height
		dc.w		0,0	; source 'page' size in pixels
CAMGHDSize	=8
CAMGHeader	dc.b		'CAMG'
		dc.l		4
		dc.l		0
CMAPHDSize	=8
CMAPHeader	dc.b		'CMAP'
		dc.l		0
BODYHDSize	=8
BODYHeader	dc.b		'BODY'
		dc.l		0

* Call:   A0 = PicDefine
* Return: D0 = 0 means succes
SaveILBM	Push		D1-D7/A0-A6
		clr.l		Pic_Total(DB)
		move.l		PicScreen(A0),Pic_Screen(DB)
		move.l		PicName(A0),Pic_FileName(DB)
		move.w		PicCompression(A0),Pic_Compression(DB)
		move.w		PicX(A0),D0
		move.w		D0,Pic_x(DB)
		move.w		PicWidth(A0),D1
		move.w		D1,Pic_Width(DB)
		add.w		D1,D0
		move.w		D0,Pic_EndCol(DB)
		move.w		PicY(A0),D0
		move.w		D0,Pic_y(DB)
		move.w		PicHeight(A0),D1
		move.w		D1,Pic_Height(DB)
		add.w		D1,D0
		move.w		D0,Pic_EndRow(DB)
		move.w		Pic_x(DB),D0
		ext.l		D0
		divu		#8,D0
		move.w		D0,Pic_SkipBytes(DB)	; How many bytes should I skip at the beginning of each row
		swap		D0
		move.w		D0,Pic_LShift(DB)	; How often should I shift bits to the left
		move.w		Pic_Width(DB),D0	; Calculate bytes per line (word aligned)
		add.w		#15,D0
		lsr.w		#3,D0
		bclr		#0,D0
		move.w		D0,Pic_BytesPerRow(DB)
		lsl.w		#3,D0
		sub.w		Pic_Width(DB),D0
		ext.l		D0
		moveq		#-1,D1
		lsl.w		D0,D1
		move.w		D1,Pic_EndMask(DB)	; Bits to cut of at the end of each line
		move.l		Pic_Screen(DB),A0
		lea		sc_BitMap(A0),A1
		move.l		A1,Pic_BitMap(DB)
		move.b		bm_Depth(A1),Pic_Depth+1(DB)
		move.w		bm_BytesPerRow(A1),Pic_BMBytesPerRow(DB)
		lea		sc_ViewPort(A0),A1
		move.l		A1,Pic_ViewPort(DB)
		move.w		vp_Modes(A1),D0
		and.w		#V_HIRES|V_HAM|V_LACE,D0
		move.w		D0,Pic_ViewMode(DB)
		move.l		vp_ColorMap(A1),A1
		move.l		cm_ColorTable(A1),Pic_ColorTable(DB)
		lea		PBuffer1(DB),A0
		move.l		A0,Pic_ByteBuffer(DB)
		lea		PBuffer2(DB),A0
		move.l		A0,Pic_PackBuffer(DB)
		lea		BMHeader(PC),A0
		move.w		Pic_Width(DB),(A0)
		move.w		Pic_Height(DB),2(A0)
		move.w		Pic_Width(DB),16(A0)
		move.w		Pic_Height(DB),16+2(A0)
		move.b		Pic_Depth+1(DB),8(A0)
		move.b		Pic_Compression+1(DB),10(A0)
		Prepare		Dos_Call
		move.l		Pic_FileName(DB),D1
		move.l		#MODE_NEWFILE,D2
		CallLib		Open
		move.l		D0,Pic_FileHandle(DB)
		beq		NoPicFile
		lea		CAMGHeader(PC),A0
		move.w		Pic_ViewMode(DB),2+8(A0)
		lea		ILBMHeader(PC),A0	; Write ILBM File Header
		moveq		#ILBMHDSize+BMHDSize+CAMGHDSize+4+CMAPHDSize-4,D0
		Call		WriteBytes
		bne		WriteError
		move.w		Pic_Depth(DB),D1
		moveq		#0,D3
		bset		D1,D3			; Number of colours (2^depth)
		move.l		D3,D4
		mulu		#3,D4
		move.l		Pic_ByteBuffer(DB),A0	; Write CMAP
		move.l		D4,(A0)+
		move.l		Pic_ColorTable(DB),A1
		moveq		#$F0-256,D5		; Tricky way to make D5=FFF0
		bra.S		2$
1$		move.w		(A1)+,D0		; Copy colours into buffer
		move.w		D0,D1
		move.w		D0,D2
		lsr.w		#4,D0
		lsl.w		#4,D2
		and.w		D5,D0
		and.w		D5,D1
		and.w		D5,D2
		move.b		D0,(A0)+
		move.b		D1,(A0)+
		move.b		D2,(A0)+
2$		dbra		D3,1$
		move.l		Pic_ByteBuffer(DB),A0
		move.l		D4,D0
		addq.l		#4,D0
		Call		WriteBytes
		bne		WriteError
		Call		WritePad		; Unnecessary
		bne		WriteError
		move.l		Pic_Total(DB),Pic_BODYPos(DB)	; We have to get back here
		lea		BODYHeader(PC),A0
		moveq		#BODYHDSize,D0
		Call		WriteBytes
		bne		WriteError
		move.w		Pic_y(DB),D7		; Current row = D7
		subq.w		#1,D7
RowLoop		addq.w		#1,D7
		cmp.w		Pic_EndRow(DB),D7	; Last row ?
		beq.S		DonePlanes
		move.l		Pic_BitMap(DB),A2
		lea		bm_Planes(A2),A2	; Get pointer to bitplane
		move.w		Pic_Depth(DB),Pic_Looper(DB)
PlaneLoop	subq.w		#1,Pic_Looper(DB)
		bmi.S		RowLoop
		move.l		(A2)+,A0
		move.w		Pic_BMBytesPerRow(DB),D0; Offset
		mulu		D7,D0
		add.l		D0,A0
		add.w		Pic_SkipBytes(DB),A0	; Skip some bytes
		move.l		Pic_ByteBuffer(DB),A1	; Copy row to buffer
		move.w		Pic_BytesPerRow(DB),D0
		bra.S		2$
1$		move.b		(A0)+,(A1)+
2$		dbra		D0,1$
		moveq		#0,D2
		move.w		Pic_LShift(DB),D2	; Shift bits to the left
		beq.S		NoPicShift
		move.l		Pic_ByteBuffer(DB),A0
		move.w		Pic_BytesPerRow(DB),D0
		addq.w		#1,D0			; If you save byte alligned
		lsr.w		#1,D0
		bra.S		4$
3$		move.l		(A0),D1			; Copy four words to d1
		lsl.l		D2,D1			; Now move bits of 2nd word into the 1st word
		swap		D1
		move.w		D1,(A0)+		; Copy 1st word back to buffer
4$		dbra		D0,3$
		move.w		Pic_EndMask(DB),D0
		and.w		D0,-(A0)
NoPicShift	moveq		#0,D0
		move.w		Pic_BytesPerRow(DB),D0
		cmp.w		#1,Pic_Compression(DB)
		bne.S		NotPacked
		Call		Packer
NotPacked	move.l		Pic_PackBuffer(DB),A0
		Call		WriteBytes
		bne.S		WriteError
		bra.S		PlaneLoop		; Next bitplane
DonePlanes	Call		WritePad
		bne.S		WriteError
		move.l		Pic_FileHandle(DB),D1	; Write BODY size
		move.l		Pic_BODYPos(DB),D2
		moveq		#OFFSET_BEGINNING,D3
		CallLib		Seek
		lea		BODYHeader(PC),A0
		move.l		Pic_Total(DB),D0
		sub.l		Pic_BODYPos(DB),D0
		subq.l		#BODYHDSize,D0
		move.l		D0,4(A0)
		moveq		#BODYHDSize,D0
		Call		WriteBytes
		bne.S		WriteError
		move.l		Pic_FileHandle(DB),D1	; Write FORM size
		moveq		#0,D2
		moveq		#OFFSET_BEGINNING,D3
		CallLib		Seek
		lea		ILBMHeader(PC),A0
		move.l		Pic_Total(DB),D0
		sub.l		#8+BODYHDSize,D0
		move.l		D0,4(A0)
		moveq		#ILBMHDSize,D0
		Call		WriteBytes
		bne.S		WriteError
		move.l		Pic_FileHandle(DB),D1
		CallLib		Close
		moveq		#0,D0
		bra.S		DoneSaveILBM
WriteError	move.l		Pic_FileHandle(DB),D1
		CallLib		Close
		move.l		Pic_FileName(DB),D1
		CallLib		DeleteFile
NoPicFile	moveq		#-1,D0
DoneSaveILBM	tst.l		D0
		Pop		D1-D7/A0-A6
		rts

WritePad	btst		#0,Pic_Total+3(DB)
		beq.S		WRet
		move.l		Pic_ByteBuffer(DB),A0
		clr.b		(A0)
		moveq		#1,D0
* Write D0 bytes from A0
* A0 = Buffer, D0=Count
WriteBytes	move.l		Pic_FileHandle(DB),D1
		move.l		A0,D2
		move.l		D0,D3
		add.l		D0,Pic_Total(DB)
		CallLib		Write
		cmp.l		D3,D0
WRet		rts

Packer		Push		D1/A0-A3
		move.l		Pic_PackBuffer(DB),A0	; A0=buffer
		move.l		Pic_ByteBuffer(DB),A1	; A1=row
		move.l		A1,A3				
		add.w		Pic_BytesPerRow(DB),A3	; A3=end of row
PackLoop	cmp.l		A3,A1
		bge.S		PackExit
		move.l		A1,A2
1$		cmp.l		A3,A2
		bge.S		2$
		move.b		(A2)+,D0
		cmp.b		(A2),D0
		bne.S		1$
		subq.l		#1,A2
2$		move.l		A2,D1
		sub.l		A1,D1
		beq.S		PackIt			; Are there bytes between two parts of identical bytes
		subq.w		#1,D1			; Code = n-1
		move.b		D1,(A0)+
3$		move.b		(A1)+,(A0)+		; Copy bytes
		dbra		D1,3$
		bra.S		PackLoop
PackIt		move.l		A1,A2
1$		cmp.l		A3,A1
		beq.S		2$
		cmp.b		(A1)+,D0
		beq.S		1$
		subq.l		#1,A1
2$		move.l		A1,D1
		sub.l		A2,D1
		neg.w		D1			; Code = -n+1
		addq.w		#1,D1
		move.b		D1,(A0)+
		move.b		D0,(A0)+
		bra.S		PackLoop
PackExit	move.l		A0,D0
		sub.l		Pic_PackBuffer(DB),D0
1$		Pop		D1/A0-A3
		rts


*====================== Picture-saver end ===========================

*====================== Data-definition start =======================
 rStart
 rAPtr		PProcess
 rAPtr		WBMsg
 rAPtr		DosBase
 rAPtr		GfxBase
 rAPtr		IntBase
 rAPtr		Rp
 rAPtr		Up
 rAPtr		WScreen
 rAPtr		WWindow
 rAPtr		PWindow
 rAPtr		PTitle
 rWord		Status
 rWord		sh
 rWord		sw
 rWord		sx
 rWord		sy
 rWord		ex
 rWord		ey
 rWord		px
 rWord		py
 rWord		pw
 rWord		ph
 rStorage	IReq,IOSTD_SIZE
 rStorage	IPort,MP_SIZE
 rStorage	FBuffer,FileBufSIZE

 rAPtr		Pic_FileName
 rAPtr		Pic_FileHandle
 rAPtr		Pic_ByteBuffer
 rAPtr		Pic_PackBuffer
 rLong		Pic_BODYPos
 rWord		Pic_x
 rWord		Pic_y
 rWord		Pic_Width
 rWord		Pic_Height
 rWord		Pic_EndCol
 rWord		Pic_EndRow
 rWord		Pic_Depth
 rWord		Pic_BytesPerRow
 rWord		Pic_BMBytesPerRow
 rWord		Pic_SkipBytes
 rWord		Pic_LShift
 rWord		Pic_EndMask
 rWord		Pic_ViewMode
 rWord		Pic_Compression
 rAPtr		Pic_Screen
 rAPtr		Pic_BitMap
 rAPtr		Pic_ViewPort
 rAPtr		Pic_ColorTable
 rWord		Pic_Looper
 rLong		Pic_Total
 rStorage	PBuffer1,164
 rStorage	PBuffer2,164
 rEnd

DosName		dc.b		'dos.library',0
GfxName		dc.b		'graphics.library',0
IntName		dc.b		'intuition.library',0
InputName	dc.b		'input.device',0
STitle		dc.b		'Save Screen as...',0
WTitle		dc.b		'Save Window as...',0
RTitle		dc.b		'Save Rectangle as...',0
ScrTitle	dc.b		'PicSaver V1.0 1991 by Preben Nielsen',0
		EVEN

IDCMP_Flags	=		GADGETUP|ACTIVEWINDOW
Other_Flags	=		NOCAREREFRESH|ACTIVATE|RMBTRAP|WINDOWDEPTH|WINDOWDRAG
WW		=240
WH		=64
NW		dc.w		300,200-WH,WW,WH
		dc.b		0,1
		dc.l		IDCMP_Flags,Other_Flags,GadgetList,0,0,0,0
		dc.w		0,0,0,0,WBENCHSCREEN
GadgetList
Gad1		Gadget		Gad2,56,30,FWIDTH,FHEIGHT,GADGHCOMP,RELVERIFY,STRGADGET
		Gadget2		FBorder,0,ITxtFile,0,FileInfo,ActivateFS-GJ,0
Gad2		Gadget		Gad3,15,46,BWIDTH,BHEIGHT,GADGHCOMP,RELVERIFY,BOOLGADGET
		Gadget2		BBorder,0,ITxtPos,0,0,DoSave-GJ,0
Gad3		Gadget		0,151,46,BWIDTH,BHEIGHT,GADGHCOMP,RELVERIFY,BOOLGADGET
		Gadget2		BBorder,0,ITxtNeg,0,0,DoCancel-GJ,0

FileInfo	dcb.b		si_SIZEOF,0

FWIDTH		=173
FHEIGHT		=11
FBorder		Border		-6,-3,1,0,1,9,FVectors,0
FVectors	dc.w		2,0,FWIDTH+1,0,FWIDTH+3,2,FWIDTH+3,FHEIGHT-1,FWIDTH+1,FHEIGHT+1,2,FHEIGHT+1,0,FHEIGHT-1,0,2,2,0
BWIDTH		=74
BHEIGHT		=11
BBorder		Border		-2,-1,1,0,1,9,BVectors,0
BVectors	dc.w		2,0,BWIDTH+1,0,BWIDTH+3,2,BWIDTH+3,BHEIGHT-1,BWIDTH+1,BHEIGHT+1,2,BHEIGHT+1,0,BHEIGHT-1,0,2,2,0

ITxtSize	IntuiText	1,0,1,-43,-15,TxtSize,0
ITxtFile	IntuiText	1,0,1,-43,0,TxtFile,ITxtSize
ITxtPos		IntuiText	1,0,1,21,2,TxtPos,0
ITxtNeg		IntuiText	1,0,1,14,2,TxtNeg,0
TxtSize		dc.b		'Size:    0 x    0 x  0',0
TxtFile		dc.b		'File',0
TxtPos		dc.b		'Save',0
TxtNeg		dc.b		'Cancel',0
		EVEN

ITxtAUTOBody	IntuiText	AUTOFRONTPEN,AUTOBACKPEN,AUTODRAWMODE,8,4,TxtAUTOBody,0
ITxtAUTOOk	IntuiText	AUTOFRONTPEN,AUTOBACKPEN,AUTODRAWMODE,6,3,TxtAUTOOk,0
TxtAUTOBody	dc.b		"PicSaver: Can't write file",0
TxtAUTOOk	dc.b		' Ok ',0

TxtAttr		dc.l		FontName
		dc.w		TOPAZ_EIGHTY
		dc.b		FS_NORMAL,FPB_ROMFONT
FontName	dc.b		'topaz.font',0
		END

* These defines are here for quick reference only
 --- InputEvent.ie_Class ---
IECLASS_NULL		0x00	A NOP input event
IECLASS_RAWKEY		0x01	A raw keycode from the keyboard device
IECLASS_RAWMOUSE	0x02	The raw mouse report from the game port device
IECLASS_EVENT		0x03	A private console event
IECLASS_POINTERPOS	0x04	A Pointer Position report
IECLASS_TIMER		0x06	A timer event
IECLASS_GADGETDOWN	0x07	select button pressed down over a Gadget (address in ie_EventAddress)
IECLASS_GADGETUP	0x08	select button released over the same Gadget (address in ie_EventAddress)
IECLASS_REQUESTER	0x09	some Requester activity has taken place.  See Codes REQCLEAR and REQSET
IECLASS_MENULIST	0x0A	this is a Menu Number transmission (Menu number is in ie_Code)
IECLASS_CLOSEWINDOW	0x0B	User has selected the active Window's Close Gadget
IECLASS_SIZEWINDOW	0x0C	this Window has a new size
IECLASS_REFRESHWINDOW	0x0D	the Window pointed to by ie_EventAddress needs to be refreshed
IECLASS_NEWPREFS	0x0E	new preferences are available
IECLASS_DISKREMOVED	0x0F	the disk has been removed
IECLASS_DISKINSERTED	0x10	the disk has been inserted
IECLASS_ACTIVEWINDOW	0x11	the window is about to be made active
IECLASS_INACTIVEWINDOW	0x12	the window is about to be made inactive
IECLASS_MAX		0x12	the last class

  --- InputEvent.ie_Code ---
IECLASS_RAWKEY
IECODE_UP_PREFIX	0x80
IECODE_KEY_CODE_FIRST	0x00
IECODE_KEY_CODE_LAST	0x77
IECODE_COMM_CODE_FIRST	0x78
IECODE_COMM_CODE_LAST	0x7F
  
IECLASS_ANSI
IECODE_C0_FIRST		0x00
IECODE_C0_LAST		0x1F
IECODE_ASCII_FIRST	0x20
IECODE_ASCII_LAST	0x7E
IECODE_ASCII_DEL	0x7F
IECODE_C1_FIRST		0x80
IECODE_C1_LAST		0x9F
IECODE_LATIN1_FIRST	0xA0
IECODE_LATIN1_LAST	0xFF
  
IECLASS_RAWMOUSE
IECODE_LBUTTON		0x68	also uses IECODE_UP_PREFIX
IECODE_RBUTTON		0x69
IECODE_MBUTTON		0x6A
IECODE_NOBUTTON		0xFF
  
IECLASS_EVENT
IECODE_NEWACTIVE	0x01	active input window changed

IECLASS_REQUESTER Codes
REQSET is broadcast when the first Requester (not subsequent ones) opens
in the Window

IECODE_REQSET		0x01
REQCLEAR is broadcast when the last Requester clears out of the Window
IECODE_REQCLEAR		0x00

 --- InputEvent.ie_Qualifier ---
IEQUALIFIER_LSHIFT		0x0001
IEQUALIFIER_RSHIFT		0x0002
IEQUALIFIER_CAPSLOCK		0x0004
IEQUALIFIER_CONTROL		0x0008
IEQUALIFIER_LALT		0x0010
IEQUALIFIER_RALT		0x0020
IEQUALIFIER_LCOMMAND		0x0040
IEQUALIFIER_RCOMMAND		0x0080
IEQUALIFIER_NUMERICPAD		0x0100
IEQUALIFIER_REPEAT		0x0200
IEQUALIFIER_INTERRUPT		0x0400
IEQUALIFIER_MULTIBROADCAST	0x0800
IEQUALIFIER_MIDBUTTON		0x1000
IEQUALIFIER_RBUTTON		0x2000
IEQUALIFIER_LEFTBUTTON		0x4000
IEQUALIFIER_RELATIVEMOUSE	0x8000

IEQUALIFIERB_LSHIFT		0
IEQUALIFIERB_RSHIFT		1
IEQUALIFIERB_CAPSLOCK		2
IEQUALIFIERB_CONTROL		3
IEQUALIFIERB_LALT		4
IEQUALIFIERB_RALT		5
IEQUALIFIERB_LCOMMAND		6
IEQUALIFIERB_RCOMMAND		7
IEQUALIFIERB_NUMERICPAD		8
IEQUALIFIERB_REPEAT		9
IEQUALIFIERB_INTERRUPT		10
IEQUALIFIERB_MULTIBROADCAST	11
IEQUALIFIERB_MIDBUTTON		12
IEQUALIFIERB_RBUTTON		13
IEQUALIFIERB_LEFTBUTTON		14
IEQUALIFIERB_RELATIVEMOUSE	15
  
struct InputEvent
{
 struct  InputEvent *ie_NextEvent	;the chronologically next event
 UBYTE   ie_Class			;the input event class
 UBYTE   ie_SubClass			;optional subclass of the class
 UWORD   ie_Code			;the input event code
 UWORD   ie_Qualifier			;qualifiers in effect for the event
 union
  {
   struct
    {
     WORD    ie_x			;the pointer position for the event
     WORD    ie_y
    } ie_xy
   APTR    ie_addr
  } ie_position
  struct timeval ie_TimeStamp		;the system tick at the event
};

ie_X			=ie_position.ie_xy.ie_x
ie_Y			=ie_position.ie_xy.ie_y
ie_EventAddress		=ie_position.ie_addr