*	TD
*	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)
*  V1.1   02-Aug-91: Damned - why didn't anyone tell me that TD looked
*                    awful (strange) under kickstart 1.3. It thought it
*                    it was running under kickstart 2.x, and therefore
*                    changed its own appearance ! Not only didn't it look
*                    good - it also didn't work correctly as a trackdisplay
*                    because of differences between 1.3 and 2.x. Well, all
*                    that has been fixed now. TD looks a lot better than the
*                    original 'TrackDisplay' when running under 2.x.
*         08-Aug-91: Now the opened window is as high as the dragbar of
*                    all the other windows on the WB-screen.
*  V2.0   09-Aug-91: Now TD only shows the drives which are available.
*         22-Aug-91: Now TD can perfecty emulate the 2.x way of using
*                    colors in windows.

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

		incdir		"AsmInc:"
		include		"P.i"
		include		"Detach.i"
		include		"relMacros.i"
		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"

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

DB		EQUR		A4

 dcDeclare	A4
 dcAPtr		TDProcess		; This process 
 dcAPtr		WBenchMsg		; Message from Workbench
 dcAPtr		GraphBase
 dcAPtr		IntuiBase
 dcAPtr		DWindow			; APtr to Window
 dcAPtr		Rp			; APtr to RastPort
 dcAPtr		Up			; APtr to UserPort
 dcAPtr		Font			; APtr to Topaz-80
 dcWord		StrLength
 dcArea		IOExtTD,IOTD_SIZE	; IOExtTD structure
 dcArea		TDPort,MP_SIZE		; MessagePort structure
 dcArea		TDInterrupt,IS_SIZE	; Interrupt structure
 dcArea		Drive0,MU_SIZE
 dcArea		Drive1,MU_SIZE
 dcArea		Drive2,MU_SIZE
 dcArea		Drive3,MU_SIZE
 dcWord		yPos			; y-position of text in window
 dcWord		Height			; Height of window
 dcWord		xPos			; x-position of text in window
 dcWord		Width			; Width of window
 dcWord		UOffset			; Offset into unit structure (to get to track indicator)
 dcWord		Version			; Kickstart version ID
 dcArea		TDDrives,32		; Yes, 32.
 dcEnd

Start		DetachSingle	<'TD'>,4000,0
		dcAlloc					; Allocate memory for variables
		dcReset					; Clear the memory
		lea		TxtAttr(PC),A0		; To avoid reloc32 hunks
		lea		FontName(PC),A1
		move.l		A1,(A0)
		Prepare		Exec_Call
		lea		Settings1.3H(PC),A0
		cmp.w		#34,LIB_VERSION(A6)
		ble.S		1$
		lea		Settings2.0H(PC),A0
1$		movem.l		(A0),D0-D1
		movem.l		D0-D1,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
		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		lea		GfxName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,GraphBase(DB)
		beq		Error
		lea		IntuiName(PC),A1
		CallLib		OldOpenLibrary
		move.l		D0,IntuiBase(DB)
		beq		Error
GetIOExtTD	moveq		#-1,D0
		CallLib		AllocSignal
		cmpi.b		#-1,D0
		beq		Error
		lea		TDPort(DB),A0
		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
GetUnits	lea		Drive0(DB),A2		; See which drives are available
		lea		TDDrives(DB),A3
		moveq		#0,D2
		moveq		#0,D3
1$;		clr.l		MU_Unit(A2)
		not.w		MU_Number(A2)		; Was 0, now -1
		move.l		D2,D0
		moveq		#0,D1
		lea		TrackName(PC),A0
		lea		IOExtTD(DB),A1
		CallLib		OpenDevice
		tst.l		D0
		bne.S		2$
		move.b		#'D',(A3)+		; Create 'DFx: ?? '
		move.b		#'F',(A3)+
		move.b		#'0',(A3)
		add.b		D2,(A3)+
		move.b		#':',(A3)+
		move.b		#' ',(A3)+
		addq.l		#2,A3
		move.b		#' ',(A3)+
		addq.w		#1,D3
		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$		subq.l		#MU_SIZE,A2
		addq.l		#1,D2
		cmp.w		#4,D2
		blt.S		1$
		move.w		D3,D0
		mulu		#7,D3
		subq.w		#1,D0
		bmi		Error
		add.w		D0,D3
		move.w		D3,StrLength(DB)
		mulu		#8,D3
		add.w		D3,Width(DB)
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
		moveq		#0,D1
		move.b		sc_BarHeight(A1),D1
		tst.w		Version(DB)
		beq.S		1$
		addq.w		#1,D1			; Because of newlook
1$		move.w		D1,Height(DB)
		subq.w		#7,D1
		lsr.w		#1,D1
		addq.w		#6,D1
		move.w		D1,yPos(DB)
		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
		moveq		#0,D0			; Assume 1.3 colors
		moveq		#1,D2
		tst.w		Version(DB)
		beq.S		2$
		exg		D0,D2			; Well, use 2.0 colors
2$		move.l		A2,A1
		CallLib		SetAPen
		move.l		A2,A1
		move.w		D2,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
SetInterrupt	Prepare		Exec_Call
		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		FreeIntui
		move.l		A2,A1
		CallLib		RemPort
		moveq		#0,D0
		move.b		MP_SIGBIT(A2),D0
		CallLib		FreeSignal
FreeIntui	move.l		IntuiBase(DB),D0
		beq.S		FreeGfx
		move.l		D0,A1
		CallLib		CloseLibrary
FreeGfx		move.l		GraphBase(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		dcFree
		moveq		#0,D0
		rts

Main
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+5(DB),A1
		lea		Drive0(DB),A0
		moveq		#'0',D2
		moveq		#0,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)
		addq.l		#8,A1
2$		subq.l		#MU_SIZE,A0
		addq.w		#1,D1
		cmp.w		#4,D1
		blt.S		1$
		Call		UpdateDisplay
		bra.S		EventLoop

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$
		Call		GetBackColor
		move.w		D0,D2
		Call		GetFrontColor
		bra.S		2$
1$		cmp.l		#INACTIVEWINDOW,D2
		bne.S		3$
		moveq		#0,D2
		moveq		#1,D0
2$		Prepare		Gfx_Call
		move.l		Rp(DB),A1
		CallLib		SetAPen
		move.w		D2,D0
		move.l		Rp(DB),A1
		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(DB),A0
		move.l		Rp(DB),A1
		move.w		StrLength(DB),D0
		CallLib		Text
		rts

*»»» Call:	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


*»»» These routines return the colors that Kickstart 2.x uses for
*»»» title-text and window-frames in active windows. Perhaps I
*»»» am using system-private values here - I didn't have access
*»»» Kickstart 2.x includes and autodocs when I wrote this.
*»»»
*»»» Return:	D0 = Color used for title-text in active windows.
GetFrontColor	moveq		#12,D0
		bra.S		GetColor
*»»» Return:	D0 = Color used for window-frames in active windows.
GetBackColor	moveq		#10,D0
GetColor	move.l		DWindow(DB),A0
		move.l		wd_WScreen(A0),A0
		move.l		$1DE+4(A0),A0
		move.w		0(A0,D0.W),D0
		rts

GfxName		dc.b		'graphics.library',0
IntuiName	dc.b		'intuition.library',0
TrackName	dc.b		'trackdisk.device',0
TDIntName	dc.b		'TD Interrupt',0
ScrTitle	dc.b		'TD V2.0 1991 by Preben Nielsen.',0
		EVEN

Kick1		=0
*»»» Defines for hires under kickstart 1.2-1.3 (and below ?)
Offset1.3	=74
Width1.3H	=85		; Gadget size
xPos1.3H	=30

Kick2		=1
*»»» Defines for hires under kickstart 2.0 (and up ?)
Offset2.0	=54
Width2.0H	=51		; Gadget size
xPos2.0H	=23

Settings1.3H	dc.w		Kick1,Offset1.3,Width1.3H,xPos1.3H
Settings2.0H	dc.w		Kick2,Offset2.0,Width2.0H,xPos2.0H

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		0
		dc.w		TOPAZ_EIGHTY
		dc.b		FS_NORMAL,FPB_ROMFONT
FontName	dc.b		'topaz.font',0
		END