;*; Updated on 22-Mar-88 at 10:49 am by Tom Faust; edit time: 1:33:41
;*; Created on 04-Feb-88 at 9:55 pm by Tom Faust; edit time: 1:38:36
VEDIT = 4
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;*									   *
;*	Copyright (c) 1988 by Software Designs.  All rights reserved.	   *
;*	Software Designs, PO Box 1131, Woodinville, WA 98072-1131	   *
;*	Written by Tom Faust.  (206) 788-6161				   *
;*									   *
;*	Permission is granted for use of this program to any individual	   *
;*	for private use only.  For commercial purposes please contact	   *
;*	Tom Faust at the address or phone number above.			   *
;*									   *
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;
;   Pgm Name:	PPN.LIT
;
;   Pgm Desc:	Display project/programmer numbers for any device
;
;   Author:	Tom Faust
;
;   Version:	1.0(4)
;
;   Hash Total:	203-450-072-174
;
;   Usage:	PPN [ device-drive: | drive ]
;
;		if device-drive: is specified, use it
;		if drive only is specified, use current device, that drive
;		if nothing is specified, use current device and drive
;
; Patch Log
;  Ver	Sub	   Date    Who 	Description of Change
; ------------	---------  ---	---------------------------------------------
;  1.0	(1)	 4 Feb 88  TGF	New.
;	(2)	 5 Feb 88  TGF	Deal with < 3 char device name.
;	(3)	20 Mar 88  TGF	Some asthetic clean up.
;				Fix default of drive number.
;	(4)	21 Mar 88  TGF	Allow conditional assembly for TRMRST stuff
;

	SEARCH	SYS
	SEARCH	SYSSYM
	SEARCH	TRM
	COPY	QTYPE.MAC

	OS.VER	= 0	; set to 0 if prior to 1.3B(151) else set to 1

	RADIX	16.

	VMAJOR = 1.
	VMINOR = 0.

	DEFINE	XTAB	ROW,COL,REG
	  IF	NB,REG
		MOVW	REG,D1
	  IFF
	    IF	B,COL
		MOVW	#<0FF00!ROW>,D1
	    IFF
		MOVW	#<ROW_8.!COL>,D1
	    ENDC
	  ENDC
		TCRT
	ENDM

	$CLS	= 0.			; clear screen
	$EOL	= 9.			; clear to end of line
	$EOS	= 10.			; clear to end of screen
	$DIM	= 11.			; half intensity
	$BRT	= 12.			; full intensity
	$ON	= 28.			; cursor on
	$OFF	= 29.			; cursor off
	$REV	= 32.			; reverse video
	$NRM	= 33.			; normal video

	$$ESC	= 27.			; escape character
	$$SP	= 32.			; space character

	A.TOP	= 0302			; row 3, column 2 (top)
	A.NEW	= 0300			; row 3
	A.ROW	= 0100			; another row
	A.COL	= 000A			; another 10 columns
	A.BOT	= 1700			; row 23
	A.MAX	= 0051			; column 81 (too far)

	P.SIZ	= 8.			; size of each PPN entry
	P.MAX	= 63.			; maximum PPN's per MFD block

	.OFINI
	.OFDEF	DDB,D.DDB		; ddb for reading MFD
	.OFDEF	BUFFER,10.		; buffer for building device spec
	.OFDEF	SAVTYP,2		; save job type during processing
	.OFSIZ	IMPSIZ


BASE:
	PHDR	-1,0,PH$REE!PH$REU

START:
	CMPB	@A2,#'/			; switch specified?
	BNE	5$
	INC	A2			; bypass /
5$:	CMPB	@A2,#'?			; request usage?
	JEQ	USAGE

	; get impure memory area

	GETIMP	IMPSIZ,A4		; get impure memory needed
	CLEAR	@A4,IMPSIZ		; preclear impure area
	INIT	@A4			; initialize the ddb (get buffer)
	ORB	#D$ERC,D.FLG(A4)	; no abort on error

	; set image mode & echo suppress

    IF EQ,OS.VER

	; This version is for systems 1.3B and later which support the
	; new monitor calls. If using earlier version, use code below by
	; setting OS.VER to 0.

	TRMRST	D5			; read terminal status
	ORW	#T$IMI!T$ECS,D5		; set image mode, echo suppress
	TRMWST	D5			; write terminal status

    IFF

	; This version is for systems 1.3 and earlier which don't support
	; the new monitor calls, above. If using later version you may
	; use code above by setting OS.VER to 1.

	JOBIDX
	MOV	JOBTRM(A6),A6
	ORW	#T$IMI!T$ECS,@A6	; set image mode, echo suppress
    ENDC

	; set octal

	JOBIDX	A0			; index job table entry
	MOVW	JOBTYP(A0),D6		; get current jobtype
	ANDW	#J.HEX,D6		; --but only hex/octal setting
	MOVW	D6,SAVTYP(A4)		; --save it
	ANDW	#~J.HEX,JOBTYP(A0)	; set octal

	; set up device spec based upon parameter format

	LIN				; any parameter?
	BEQ	10$			;   no, use device and drive
	NUM				; drive only specified?
	BEQ	20$
	CMPB	@A2,#':			; colon only = same as nothing
	BNE	30$			; else must be full device spec

10$:	CALL	CURDEV			; get current device and drive spec
	CALL	CURDRV
	LEA	A2,BUFFER(A4)		; index it
	BR	30$			; process it

20$:	GTDEC				; get specified drive number
	CALL	CURDEV			; get current device spec, etc.
	DCVT	0,OT$MEM		; output requested drive number
	BR	40$

30$:	LEA	A1,BUFFER(A4)
	PACK				; pack requested device
	NUM				; any number specified?
	BEQ	33$
	MOV	#-1,D1
	BR	34$

33$:	GTDEC				; get requested drive
34$:	LEA	A1,BUFFER(A4)
	MOV	A1,A2
	UNPACK				; unpack in place into buffer

35$:	CMPB	-(A2),#$$SP		; strip trailing spaces
	BEQ	35$
	INC	A2			; readjust after last non space
	TST	D1			; need current as default?
	BMI	37$
	DCVT	0,OT$MEM
	BR	40$

37$:	CALL	CURDRV			; default current driver number

40$:	MOVB	#':,(A2)+		; fix end of buffer
	CLRB	@A2
	LEA	A2,BUFFER(A4)		; index buffer and go
	FSPEC	@A4			; process command line parameter
	JNE	DONE
	CLR	D2			; preclear for ppn count

	; display screen header

	XTAB	$OFF
	XTAB	$CLS			; clear screen
	XTAB	$DIM
	MOVW	#79.-1,D0
	MOVB	#32.,D1
50$:	TTY				; output dim spaces for $REV
	DBF	D0,50$
	XTAB	$NRM
	XTAB	1.,1.
	XTAB	$REV
	TYPESP	< Account Listing for>
	PFILE	@A4
	XTAB	1.,48.
	QTYPE	<Copyright 1988 Software Designs_>
	XTAB	,,#A.TOP

	; Check for known illegal device names

	MOVW	D.DEV(A4),D7
	CMPW	D7,#[VCR]
	BEQ	100$
	CMPW	D7,#[TRM]
	BEQ	100$
	CMPW	D7,#[RES]
	BEQ	100$
	CMPW	D7,#[MEM]
	BNE	200$

100$:	QTYPE	<%_>
	PFILE	@A4
	QTYPE	< is not file structured.>
	TTYI
	BYTE	7,0
	JMP	DONE

200$:	MOV	#1,D.REC(A4)		; prepare to read MFD
	READ	@A4			; read it
	JNE	DONE
	MOV	D.BUF(A4),A3		; index buffer

;
; Start new page of PPNs
;
NEWPAGE:
	MOVW	#P.MAX,D0		; to count down ppn's in block
	MOVW	#A.TOP,D3		; start row/column
	XTAB	,,D3
	XTAB	$EOS

;
; See if another MFD block needs to be read and do so if necessary
;
NEXTPPN:
	TCKI				; any input waiting?
	BNE	10$
	KBD
	CMPB	D1,#$$ESC		; if escape hit, abort
	JEQ	90$
10$:	CTRLC	DONE			; allow use abort
	DBF	D0,20$			; one less in this block
	MOV	@A3,D.REC(A4)		; next block link
	JEQ	DONE			;   block link = 0 = done
	READ	@A4			; read next block
	JNE	DONE
	MOV	D.BUF(A4),A3		; index block link (mfd buffer)
	MOVW	#P.MAX,D0		; reset ppn/block counter
	BR	NEXTPPN			; try again

;
; Display PPN -> A3 at proper screen position
;
20$:	TSTW	@A3			; end of MFD?
	BEQ	DONE
	XTAB	,,D3			; position cursor
	CALL	PRPPN			; output ppn number
	ADD	#P.SIZ,A3		; bump to next ppn
	INC	D2			; another ppn displayed
	ADDW	#A.ROW,D3		; next row
	CMPW	D3,#A.BOT		; too far?
	BLO	NEXTPPN
	ANDW	#0FF,D3			; clear row
	ORW	#A.NEW,D3		; force row three again
	ADDB	#A.COL,D3		; next column
	CMPB	D3,#A.MAX		; screen full?
	BLO	NEXTPPN
	XTAB	24.,1.
	QTYPESP	<Press _any key_ to continue or _ESC_ to quit:>
	KBD	DONE
	CMPB	D1,#$$ESC		; escape key hit?
	JNE	NEWPAGE			;  no, do next page, else done
90$:
	ORW	#J.CCC,@A0		;  else set user abort (^C)
;
; All PPN's displayed or user abort requested, wrap up and exit
;
DONE:
	XTAB	23.,2.
	XTAB	$EOS
	XTAB	$BRT			; hi intensity
	MOV	D2,D1			; get ppn count
	BNE	10$
	TYPE	<No>			; if zero, say No
	BR	20$
10$:	DCVT	0,OT$TRM		; output ppn count followed by space
20$:	QTYPE	< PPN>
	CMP	D1,#1			; if one, don't output 's
	BEQ	25$
	TYPE	<'s>
25$:	TYPE	< listed.>
	MOVW	@A0,D7			; get job status
	ANDW	#J.CCC,@A0		; user abort?
	BEQ	30$			;   nope
	QTYPE	<  _* User Abort_ - Listing not complete _*>
30$:	ANDW	#~J.CCC,@A0		; clear ^C waiting
	MOVW	SAVTYP(A4),D6		; get saved hex/octal setting
	ORW	D6,JOBTYP(A0)		; reset it
	CRLF
	XTAB	$BRT
	XTAB	$ON
	EXIT

;
; Get current device spec into BUFFER(A4)
;
CURDEV:
	LEA	A1,JOBDEV(A0)
	LEA	A2,BUFFER(A4)
	UNPACK				; get ascii device spec
10$:	CMPB	-(A2),#$$SP		; strip trailing spaces
	BEQ	10$
	INC	A2			; readjust after last non space
	RTN

;
; Get current drive # into @A2
;
CURDRV:
	CLR	D1
	MOVW	JOBDRV(A0),D1
	DCVT	0,OT$MEM		; get ascii drive number (decimal)
	RTN

;
; Display how to use this program
;
USAGE:
	QTYPECR	<Usage:	_PPN_ [ _DeviceDrive:_ | _Drive_ ]>
	QTYPECR	<	_DeviceDrive:_ will display accounts for _that device and drive_>
	QTYPECR	<	_Drive_ will display accounts for the _current device and that drive_>
	QTYPECR	<	_Blank_ parameter will display accounts for the _current device and drive_>
	QTYPECR	<	The _colon_ (_:_) is always _optional>
	CRLF
	QTYPECR	<	_Copyright 1988 Software Designs>
	EXIT

;
; Display PPN -> A3
;
PRPPN:
	QTYPE	<[_>
	CLR	D1
	MOVB	1(A3),D1
	OCVT	0,OT$TRM		; output project number
	QTYPE	<,_>
	MOVB	@A3,D1
	OCVT	0,OT$TRM		; output programmer number
	QTYPE	<]>
	RTN

	COPY	QTYPE.M68

	; Written by Tom Faust, Software Designs, Woodinville, WA 98072

	END

.