home *** CD-ROM | disk | FTP | other *** search
- * 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
-
-