*	TD V1.0
*	By Preben Nielsen
*
*	Based on 'TrackDisplay' on Fish-disk 399 by Olaf Barthel.
*
*	  TD is a program that continuously monitors and displays
*	the current track for each connected floppy disk.
*
*	  The size of the window and the use of colors in it depends on
*	the version of the Kickstart/Workbench (1.2/1.3 vs. 2.?).
*
*	NOTE:	There's no need to 'RUN' or 'RUNBACK' this program from the
*		CLI. It is auto-detaching.
*
*HISTORY
*          Made with Hisoft V2.12
* 
*           January: Recieved 'Trackdisplay' on Fish-disk 399.
*                    Nice program Olaf. Thanks.
*
*  V1.0   03-Mar-91: First working version.
*         04-Mar-91: Added auto-detaching code.
*         07-Mar-91: Uses 'PrintIText' instead of 'Move'/'Text'. Because of
*                    this, my version used nearly twice the amount of
*                    processor-time as the original (according to Xoper).
*         15-Mar-91: Now uses 'Move'/'Text'. Code is now larger but faster.
*         19-Apr-91: Made some modifications to make it look better
*                    under WB2.0 (haven't actually tried it yet)

	OPT O+
	OPT O1+			; Tells when a branch could be optimised to short
	OPT i+			; Tells when '#' is probably missing

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
Push		MACRO		Push <reg-list | All>
		IFC		'\1','All'
		movem.l		D0-D7/A0-A6,-(SP)
		ENDC
		IFNC		'\1','All'
		movem.l		\1,-(SP)
		ENDC
		ENDM
Pop		MACRO		Pop <reg-list | All>
		IFC		'\1','All'
		movem.l		(SP)+,D0-D7/A0-A6
		ENDC
		IFNC		'\1','All'
		movem.l		(SP)+,\1
		ENDC
		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 storage
		link		DB,#-RelSize
		ENDM
rFree		MACRO				; De-allocate storage
		unlk		DB
		ENDM
rClear		MACRO				; Reset all variables
		movem.l		D0/A0,-(SP)
		move.w		#RelSize-1,D0
		move.l		DB,A0
rClr.\@		clr.b		-(A0)
		dbf		D0,rClr.\@
		movem.l		(SP)+,D0/A0
		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

		incdir		"AsmInc:"
		include		"exec/exec_lib.i"
		include		"exec/memory.i"
		include		"exec/interrupts.i"
		include		"exec/ports.i"
		include		"intuition/intuition.i"
		include		"intuition/intuitionbase.i"
		include		"intuition/intuition_lib.i"
		include		"graphics/graphics_lib.i"
		include		"libraries/dos_lib.i"
		include		"libraries/dos.i"
		include		"libraries/dosextens.i"
		include		"hardware/intbits.i"
		include		"devices/trackdisk.i"

DB		EQUR		A4

InitProcess	Detach		<'TD Process'>,4000,0
		rAlloc					; Allocate memory for variables
		rClear					; Clear the memory
		Prepare		Exec_Call
		lea		Settings1.3H(PC),A0
		cmp.w		#34,LIB_VERSION(A6)
		blt.S		1$
		lea		Settings2.0H(PC),A0
1$		movem.l		(A0),D0-D4
		movem.l		D0-D4,Version(DB)	; Initialize variables
		suba.l		A1,A1
		CallLib		FindTask		; Find us
		move.l		D0,TDProcess(DB)
		move.l		D0,A2
		tst.l		pr_CLI(A2)
		bne.S		GetLibs			; Also works after segment-splitting
WBenchStartup	lea		pr_MsgPort(A2),A0
		CallLib		WaitPort		; wait for a message
		lea		pr_MsgPort(A2),A0
		CallLib		GetMsg			; then get it
		move.l		D0,WBenchMsg(DB)	; save it for later reply
GetLibs
GetGfx		lea		GfxName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,GfxBase(DB)
		beq		Error
GetIntuition	lea		IntName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,IntBase(DB)
		beq		Error
GetIOExtTD	moveq		#-1,D0
		CallLib		AllocSignal
		cmpi.b		#-1,D0
		beq		Error
		lea		TDPort(DB),A0
		lea		TDPortName(PC),A1
		move.l		A1,MP+LN_NAME(A0)		; MsgPort->mp_Node.ln_Name=Name
		clr.b		MP+LN_PRI(A0)			; MsgPort->mp_Node.ln_Pri =Pri
		move.b		#NT_MSGPORT,MP+LN_TYPE(A0)	; MsgPort->mp_Node.ln_Type=NT_MSGPORT
		move.b		#PA_SIGNAL,MP_FLAGS(A0)		; MsgPort->mp_Flags	  =PA_SIGNAL
		move.b		D0,MP_SIGBIT(A0)		; MsgPort->mp_SigBit	  =MPSigBit
		lea		TDPort(DB),A1
		move.l		TDProcess(DB),MP_SIGTASK(A1)	; MsgPort->mp_SigTask	 =FindTask(0)
		CallLib		AddPort
		lea		IOExtTD(DB),A1
		move.b		#NT_MESSAGE,IO+MN+LN_TYPE(A1)	; IOExtTD->io_Message.mn_Node.ln_Type=NT_MESSAGE
		clr.b		IO+MN+LN_PRI(A1)		; IOExtTD->io_Message.mn_Node.ln_Pri =0
		lea		TDPort(DB),A0
		move.l		A0,IO+MN_REPLYPORT(A1)		; IOExtTD->io_Message.mn_ReplyPort   =Rep
GetWindow	Prepare		Intuition_Call
		CallLib		OpenWorkBench
		tst.l		D0
		beq		Error
		move.l		D0,A1
		move.w		sc_Width(A1),D0
		sub.w		Width(DB),D0
		lsr.w		#1,D0
		lea		NW(PC),A0
		move.w		D0,nw_LeftEdge(A0)	; Center the window
		tst.w		Version(DB)
		beq.S		1$
		moveq		#0,D1
		move.b		sc_BarHeight(A1),D1
		move.w		D1,Height(DB)
		subq.w		#7,D1
		lsr.w		#1,D1
		addq.w		#6,D1
		move.w		D1,yPos(DB)
1$		move.w		Width(DB),nw_Width(A0)
		move.w		Height(DB),nw_Height(A0)
		CallLib		OpenWindow
		move.l		D0,DWindow(DB)
		beq		Error
		move.l		D0,A0
		move.l		wd_RPort(A0),Rp(DB)
		move.l		wd_UserPort(A0),Up(DB)	; UserPort
		move.l		DWindow(DB),A0
		suba.l		A1,A1
		lea		ScrTitle(PC),A2
		CallLib		SetWindowTitles
		Prepare		Gfx_Call
		move.l		Rp(DB),A2
		move.l		A2,A1
		move.w		AColor(DB),D0
		CallLib		SetAPen
		move.l		A2,A1
		move.w		BColorI(DB),D0
		CallLib		SetBPen
		move.l		A2,A1
		moveq		#RP_JAM2,D0
		CallLib		SetDrMd
		lea		TxtAttr(PC),A0
		CallLib		OpenFont
		move.l		D0,Font(DB)
		beq.S		Error
		move.l		D0,A0
		move.l		A2,A1
		CallLib		SetFont
GetUnits	Prepare		Exec_Call		; See which drives are available
		lea		Drive3(DB),A2
		moveq		#3,D2
1$		clr.l		MU_Unit(A2)
		not.w		MU_Number(A2)		; Was 0, now -1
		move.w		D2,D0
		moveq		#0,D1
		lea		TrackName(PC),A0
		lea		IOExtTD(DB),A1
		CallLib		OpenDevice
		tst.l		D0
		bne.S		2$
		lea		IOExtTD(DB),A1		; Oh yeah, drive is available
		move.l		IO_UNIT(A1),MU_Unit(A2)	; Store address of unit-structure
		CallLib		CloseDevice		; Close Unit again
2$		addq.l		#MU_SIZE,A2
		dbf		D2,1$
SetInterrupt	lea		TDInterrupt(DB),A1		; Start vertical-blanking interrupt-server
		move.b		#NT_INTERRUPT,LN_TYPE(A1)	; TDInterrupt->is_Node.ln_Type=NT_INTERRUPT
		lea		TDIntName(PC),A0
		move.l		A0,LN_NAME(A1)			; TDInterrupt->is_Node.ln_Name=TDIntName
		lea		TDIntServer(PC),A0
		move.l		A0,IS_CODE(A1)			; TDInterrupt->is_Code	      =TDIntServer
		move.l		DB,IS_DATA(A1)			; TDInterrupt->is_Data	      =DB
		moveq		#INTB_VERTB,D0
		CallLib		AddIntServer
		bra		Main

Exit
Error
FreeInterrupt	Prepare		Exec_Call
		lea		TDInterrupt(DB),A1
		tst.l		IS_CODE(A1)		; If this is set then server has been added
		beq.S		FreeFont
		moveq		#INTB_VERTB,D0
		CallLib		RemIntServer
FreeFont	Prepare		Gfx_Call
		move.l		Font(DB),D0
		beq.S		FreeWindow
		move.l		D0,A1
		CallLib		CloseFont
FreeWindow	Prepare		Intuition_Call
		move.l		DWindow(DB),D0
		beq.S		FreePort
		move.l		D0,A0
		CallLib		CloseWindow
FreePort	Prepare		Exec_Call
		lea		TDPort(DB),A2
		tst.b		MP_SIGBIT(A2)		; If we have bit we also have port
		beq.S		FreeIntuition
		move.l		A2,A1
		CallLib		RemPort
		moveq		#0,D0
		move.b		MP_SIGBIT(A2),D0
		CallLib		FreeSignal
FreeIntuition	move.l		IntBase(DB),D0
		beq.S		FreeGfx
		move.l		D0,A1
		CallLib		CloseLibrary
FreeGfx		move.l		GfxBase(DB),D0
		beq.S		ReplyWB
		move.l		D0,A1
		CallLib		CloseLibrary
ReplyWB		move.l		WBenchMsg(DB),D2
		beq.S		AllDone
		CallLib		Forbid
		move.l		D2,A1
		CallLib		ReplyMsg		; Reply WBenchMessage if we are started from WB
AllDone		rFree
		moveq		#0,D0
		rts

Main
Change		Call		UpdateDisplay
EventLoop	move.l		Up(DB),A0
		moveq		#0,D0
		moveq		#0,D1
		move.b		MP_SIGBIT(A0),D1
		bset		D1,D0
		bset		#SIGBREAKB_CTRL_D,D0
		Prepare		Exec_Call
		CallLib		Wait
		btst		#SIGBREAKB_CTRL_D,D0
		beq.S		GetNextMsg
		lea		TDDrives+29(PC),A1
		lea		Drive3(DB),A0
		moveq		#'0',D2
		moveq		#3,D1
1$		move.w		MU_Number(A0),D0
		bmi.S		2$
		ext.l		D0
		divu		#10,D0
		add.w		D2,D0
		move.b		D0,(A1)
		swap		D0
		add.w		D2,D0
		move.b		D0,1(A1)
2$		subq.l		#8,A1
		addq.l		#MU_SIZE,A0
		dbf		D1,1$
		bra.S		Change

GetNextMsg	move.l		Up(DB),A0
		Prepare		Exec_Call
		CallLib		GetMsg
		tst.l		D0
		beq.S		EventLoop
		move.l		D0,A1
		move.l		im_Class(A1),D2
		CallLib		ReplyMsg
		cmp.l		#CLOSEWINDOW,D2
		beq		Exit
		tst.w		Version(DB)		; No need to change color
		beq.S		3$			; under 1.2/1.3
		cmp.l		#ACTIVEWINDOW,D2
		bne.S		1$
		move.w		BColorA(DB),D0
		bra.S		2$
1$		cmp.l		#INACTIVEWINDOW,D2
		bne.S		3$
		move.w		BColorI(DB),D0
2$		move.l		Rp(DB),A1
		Prepare		Gfx_Call
		CallLib		SetBPen
3$		Call		UpdateDisplay		; Do some refreshing
		bra.S		GetNextMsg

UpdateDisplay	Prepare		Gfx_Call
		move.l		Rp(DB),A1
		move.w		xPos(DB),D0
		move.w		yPos(DB),D1
		CallLib		Move
		lea		TDDrives(PC),A0
		move.l		Rp(DB),A1
		moveq		#StringLength,D0
		CallLib		Text
		rts

* A1=DB
* Inside the server the registers D0-D1/A0-A1/A5-A6 can be used
* without restoring them on exit
TDIntServer	Push		D2/DB
		move.l		A1,DB
		moveq		#0,D2			; Don't signal
		lea		Drive3(DB),A0
		moveq		#3,D1
1$		move.l		MU_Unit(A0),D0
		beq.S		2$			; Does drive exist
		move.l		D0,A1
		add.w		UOffset(DB),A1
		move.w		(A1),D0
		asr.w		#1,D0
		cmp.w		MU_Number(A0),D0
		beq.S		2$
		move.w		D0,MU_Number(A0)
		moveq		#1,D2			; Do signal
2$		addq.l		#MU_SIZE,A0
		dbf		D1,1$
		tst.w		D2
		beq.S		3$
		move.l		TDProcess(DB),A1
		move.l		#SIGBREAKF_CTRL_D,D0
		Prepare		Exec_Call
		CallLib		Signal
3$		Pop		D2/DB
		rts

* My Unit structure
MU_Unit		=0			; Address of drive-unit
MU_Number	=4			; Track number
MU_SIZE		=6

* Stack variables
 rStart
 rAPtr		TDProcess		; This process 
 rAPtr		GfxBase
 rAPtr		IntBase
 rAPtr		WBenchMsg		; Message from Workbench
 rAPtr		DWindow			; APtr to Window
 rAPtr		Rp			; APtr to RastPort
 rAPtr		Up			; APtr to UserPort
 rAPtr		Font			; APtr to Topaz-80
 rStorage	IOExtTD,IOTD_SIZE	; IOExtTD structure
 rStorage	TDPort,MP_SIZE		; MessagePort structure
 rStorage	TDInterrupt,IS_SIZE	; Interrupt structure
 rStorage	Drive0,MU_SIZE
 rStorage	Drive1,MU_SIZE
 rStorage	Drive2,MU_SIZE
 rStorage	Drive3,MU_SIZE
 rWord		WordPad			; DON'T REMOVE (Setting are now 10 words)
 rWord		BColorI			; Background color (Inactive)
 rWord		BColorA			; Background color (Active)
 rWord		AColor			; Foreground color
 rWord		yPos			; y-position of text in window
 rWord		xPos			; x-position of text in window
 rWord		Height			; Height of window
 rWord		Width			; Width of window
 rWord		UOffset			; Offset into unit structure (to get to track indicator)
 rWord		Version			; Kickstart version ID
 rEnd

GfxName		dc.b		'graphics.library',0
IntName		dc.b		'intuition.library',0
TrackName	dc.b		'trackdisk.device',0
TDIntName	dc.b		'TD Interrupt',0
TDPortName	dc.b		'TD Port',0
TDDrives	dc.b		'DF0: -- DF1: -- DF2: -- DF3: --',0
ScrTitle	dc.b		'TD V1.0 1991 by Preben Nielsen. Thanks Olaf Barthel',0
		EVEN

StringLength	=31
StringSpace	=StringLength*8

Kick1		=0
* Defines for hires under kickstart 1.2-1.3 (and below ?)
Offset1.3	=74
Width1.3H	=1+84+StringSpace
Height1.3H	=10
xPos1.3H	=30
yPos1.3H	=7
AColor1.3H	=0
BColor1.3H	=1

Kick2		=1
* Defines for hires under kickstart 2.0 (and up ?)
Offset2.0	=54
Width2.0H	=51+StringSpace
Height2.0H	=11
xPos2.0H	=23
yPos2.0H	=8
AColor2.0H	=1
BColor2.0HA	=3		; Active background color
BColor2.0HI	=0		; Inactive background color

Settings1.3H	dc.w		Kick1,Offset1.3,Width1.3H,Height1.3H,xPos1.3H,yPos1.3H,AColor1.3H,BColor1.3H,BColor1.3H,0
Settings2.0H	dc.w		Kick2,Offset2.0,Width2.0H,Height2.0H,xPos2.0H,yPos2.0H,AColor2.0H,BColor2.0HA,BColor2.0HI,0

IDCMP_Flags	=		CLOSEWINDOW|INACTIVEWINDOW|ACTIVEWINDOW
Other_Flags	=		RMBTRAP|WINDOWCLOSE|WINDOWDEPTH|WINDOWDRAG
NW		dc.w		0,0,0,0
		dc.b		0,1
		dc.l		IDCMP_Flags,Other_Flags
		dc.l		0,0,0,0,0
		dc.w		0,0,0,0,WBENCHSCREEN

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