; White House Software, Inc, Extended Directory Program
;
;       TITLE   EDIR
;
; THIS PROGRAM MAY BE FREELY DISTRIBUTED TO AMUS MEMBERS
; COURTESY OF WHITE HOUSE SOFTWARE, INC.
;
;Edit History:
;
; 8/19/86 1.0(0) - David Greene
;       Written
;
; To use you must link with WLDSCN.OBJ which you may also get off the network
;
;       LNKLIT  EDIR,WLDSCN
;
VEDIT=0.

       SEARCH  SYS
       SEARCH  SYSSYM
       SEARCH  TRM

; Define Version Information
VMAJOR=1.
VMINOR=0.
VSUB=0.
VWHO=0.

;dedicated registers

       WILD=A4                         ; wildscan DDB index

;impure area used by EDIR

OFINI
OFDEF   PBUF,22.                        ; print buffer
OFDEF   DDB,D.DDB                       ; ddb used for comment line display
OFDEF   LINBUF,512.                     ; file input buffer
OFDEF   LSTDEV,2                        ; last device of last file accessed
OFDEF   LSTDRV,2                        ; last drive of last file accessed
OFDEF   LSTPPN,2                        ; last PPN of last file accessed
OFDEF   COUNT,2                         ; count of number of files on screen
OFDEF   BEGRTN,2                        ; return routine flag
OFSIZ   IMPSIZ


;These macros are used to call WLDSCN, the wildcard directory scanner
;These are defined in WLDSCN.UNV as well

DEFINE  WINIT
       IF      NDF,W.INIT,EXTERN W.INIT
       CALL    W.INIT
       ENDM

DEFINE  WSPEC   EXT
       IF      NDF,W.SPEC,EXTERN W.SPEC
       CALL    W.SPEC
       IF      B,EXT,ASCII /???/
       IF      NB,EXT,ASCII /'EXT/
       BYTE    0
       ENDM

DEFINE  WSCAN
       IF      NDF,W.SCAN,EXTERN W.SCAN
       CALL    W.SCAN
       ENDM

; define various ascii codes
TAB     =11
LF      =12
CR      =15
SPACE   =40

; macro to perform a CRT function
DEFINE  ACRT    ROW,COL
IF      NB,COL,MOVW     #<ROW_8.>!COL,D1
IF      B,COL,MOVW      #177400!ROW,D1
       TCRT
       ENDM

;start of code

; Initial set up area
START:
       PHDR    -1,PV$RPD!PV$RSM,PH$REE!PH$REU  ; program header
       GETIMP  IMPSIZ,A5               ; allocate local memory
       CLRW    DDB(A5)                 ; not inited yet
       INIT    DDB(A5)                 ; now it is
       WINIT                           ; initialize WLDSCN (sets up A4)
       JOBIDX  A1                      ; A1 -> my jcb
       MOV     JOBTRM(A1),A1           ; A1 -> my terminal status word
       ORW     #T$IMI!T$ECS,@A1        ; set echo suppress and image mode
       ACRT    29.                     ; turn off cursor

; Set up things for the program and wildcard scanner
CMDLIN:
       BYP                             ; bypass leading cmd line spaces
       WSPEC                           ; process wildcard file specification
       JNE     EXIT                    ; branch on invalid spec
       CLRW    LSTDEV(A5)              ; no last device yet
       CLRW    LSTDRV(A5)              ; no last drive yet
       CLRW    LSTPPN(A5)              ; no last ppn yet
       CLRW    COUNT(A5)               ; no files on screen yet
       CLRW    BEGRTN(A5)              ; flag no return first time through

; Main proceesing loop
LOOP:
       CTRLC   EXIT                    ; branch on ^C
       WSCAN                           ; get next file that matches spec
       JNE     EXIT

; Copy all pertinant info from wildcard scanner table
       MOVW    D.DEV(WILD),D.DEV+DDB(A5); copy spec
       MOVW    D.DRV(WILD),D.DRV+DDB(A5); from wildscan
       MOVW    D.PPN(WILD),D.PPN+DDB(A5);  DDB @A4 to
       MOV     D.FIL(WILD),D.FIL+DDB(A5);    our internal
       MOVW    D.EXT(WILD),D.EXT+DDB(A5);     table

; Check to see if screen is full
       CMMW    COUNT(A5),#20.          ; is the screen full ?
       BLOS    10$                     ;  no - continue
5$:
       CALL    RETURN                  ;  yes - wait for user
       CALL    HEADER                  ; redisplay header and clear screen
       CLRW    COUNT(A5)               ; no file now

; Check to see if we entered a new PPn
10$:
       CMMW    LSTDEV(A5),D.DEV+DDB(A5); are we still in the same account ?
       BNE     20$                     ;  no - we need to reset
       CMMW    LSTDRV(A5),D.DRV+DDB(A5);
       BNE     20$                     ;  no...
       CMMW    LSTPPN(A5),D.PPN+DDB(A5)
       BEQ     30$                     ;  yes - show this file
20$:
       MOVW    D.DEV+DDB(A5),LSTDEV(A5); set new current account number
       MOVW    D.DRV+DDB(A5),LSTDRV(A5)
       MOVW    D.PPN+DDB(A5),LSTPPN(A5)
       BR      5$

; Show file on screen
30$:
       CTRLC   EXIT                    ; allow ctrlc
       CALL    PFILE                   ; show file name
       CALL    SHWLIN                  ; show first comment line
       CRLF                            ; goto next line
       INCW    COUNT(A5)               ; bump count
       JMP     LOOP                    ; and continue

; Exit program
EXIT:
       JOBIDX  A1                      ; A1->my jcb
       ANDW    #^C<J.CCC>,JOBSTS(A1)   ; clear any pending CTRLC's
       ACRT    24.,1                   ; cursor at row 24 col 1
       ACRT    9.                      ; delete to end of line
       ACRT    28.                     ; cursor on
       EXIT                            ; back to AMOS/L...

;****************
;*    PFILE     *
;****************
; This routine prints the current file name on the screen
; in lower intensity without a dot
PFILE:
       SAVE    D1,A1,A2                ; save work registers
       LEA     A2,PBUF(A5)             ; index print work area
       LEA     A1,D.FIL+DDB(A5)        ; get filename
       UNPACK                          ; to ascii
       UNPACK
       MOVB    #40,(A2)+               ; add a space
       UNPACK                          ; then extension
       CLRB    @A2                     ; terminate correctly
       ACRT    11.                     ; low intensity
       TTYL    PBUF(A5)                ; display file name
       ACRT    12.                     ; back to high intensity
       REST    D1,A1,A2                ; restore work registers
       RTN                             ; return

;****************
;*   SHWLIN     *
;****************
; This routine trys to locate a valid comment character.  It ignores
; blank lines.  If it hits any thing other than '!', ';', '.;', or 'REM'
; it stops processing for the current file.  If it finds a valid comment
; string in the first part of the file it will load that line into a buffer
; so it can show it to the user.  If a non-printable ascii character is
; fount it stops processing the current file.
SHWLIN:
       SAVE    D1,D2,A2                ; save work register
       TYPE    <  >                    ; seperate from name

; Open file if possible
       ORB     #D$ERC!D$BYP,D.FLG+DDB(A5); no room for error messages
       OPENI   DDB(A5)                 ; open the file
       JNE     99$                     ;  no - mabey random or disk error

; Copy line into print buffer
10$:
       LEA     A2,LINBUF(A5)           ; index the line buffer
       CLR     D2                      ; no characters in line yet

; Main input loop
20$:
       FILINB  DDB(A5)                 ; get a character
       TST     D.SIZ+DDB(A5)           ; are we done ?
       JEQ     98$                     ;  yes -
       INC     D2                      ;  no - bump file count
       CMP     D2,#69.                 ; are we full ?
       BGE     30$                     ;  yes - we're done with this file
       CMPB    D1,#CR                  ;  no - hit a CR ?
       BEQ     20$                     ;   yes - don't load this
       CMPB    D1,#LF                  ; hit a line feed yet?
       BEQ     30$                     ;  no - get another byte
       CMPB    D1,#TAB                 ; hit a TAB ?
       BNE     25$                     ;  no - all is peaches
       MOVB    #SPACE,D1               ;  yes - replace with a space

; Check for validity and load into buffer
25$:
       ANDB    #177,D1                 ; limit to seven bits
       CMPB    D1,#40                  ; ASCII ?
       BLO     98$                     ;  no - forget displaying this one
       MOVB    D1,(A2)+                ; set it into the buffer
       BR      20$                     ; get another character

; Terminate line and look for comment string
30$:
       CLRB    @A2                     ;  terminate properly
       LEA     A2,LINBUF(A5)           ; A2 -> command
       BYP                             ; bypass spaces
       TSTB    @A2                     ;  no - blank line ?
       BEQ     10$                     ;   yes - get another one

; Check for ';'
       CMPB    @A2,#';                 ; commented out ?
       BEQ     50$                     ;  yes - get another line

; Check for '!'
       CMPB    @A2,#'!                 ; commented out ?
       BEQ     50$                     ;  yes - get another line

; Check for '.;' -- SuperVue file
       CMPB    (A2)+,#'.               ; half a comment spec ?
       BNE     40$                     ;  no - check next one
       CMPB    @A2,#';                 ;  yes - is other half there ?
       BEQ     50$                     ;    yes - whoopee

; Check for 'REM' statement from BASIC
40$:
       DEC     A2                      ; back up to correct place
       MOVB    (A2)+,D1                ; get a byte
       UCS                             ; to upper case
       CMPB    D1,#'R                  ; first part ?
       BNE     98$                     ;  no - we're done
       MOVB    (A2)+,D1                ; check second one
       UCS
       CMPB    D1,#'E
       BNE     98$
       MOVB    @A2,D1                  ; and the thrird
       UCS
       CMPB    D1,#'M
       BNE     98$

; Valid comment string found display line
50$:
       INC     A2                      ; bypass last comment character
       BYP                             ; ingnore leading spaces
       TTYL    @A2                     ; display line

; Close file
98$:
       CLOSE   DDB(A5)                 ; close file

; Return to main program
99$:
       REST    D1,D2,A2                ; and return
       RTN

;****************
;*   HEADER     *
;****************
; This routine displays the header with the current account info
HEADER:
       CTRLC   EXIT                    ; allow exit
       SAVE    D1,A0                   ; save work registers
       ACRT    0                       ; clear screen
       ACRT    12.                     ; low intensity
       TYPE    <White House Software>
       ACRT    11.                     ; high intensity
       TYPE    < Extended >
       ACRT    12.
       TYPE    <Directory>
       ACRT    11.
       TYPE    <..........................>
       ACRT    12.

; Save info we might modify
       PUSHW   D.DEV+DDB(A5)           ; save info so we can use PFILE
       PUSHW   D.DRV+DDB(A5)           ; and PRPPN to display the current
       PUSHW   D.PPN+DDB(A5)           ; login
       PUSH    D.FIL+DDB(A5)
       CLR     D.FIL+DDB(A5)           ; no file name will show only the dev:

; Check to make sure we have a device to pring
       JOBIDX  A0                      ; index my jcb
       TSTW    D.DEV+DDB(A5)           ; is there a DDB specified ?
       BNE     10$                     ;  yes - use it
       MOVW    JOBDEV(A0),D.DEV+DDB(A5);  no - use default
       MOVW    JOBDRV(A0),D.DRV+DDB(A5)

; Print device
10$:
       PFILE   DDB(A5)                 ; display device
       POP     D.FIL+DDB(A5)           ; restore file
       TYPE    <[>                     ; start of ppn area

; Check to se that we have a PPn to print
       TSTW    D.PPN+DDB(A5)           ; is one loaded ?
       BNE     20$                     ;  yes - use it
       MOVW    JOBUSR(A0),D.PPN+DDB(A5);  no - use default

; Print our PPn
20$:
       PRPPN   D.PPN+DDB(A5)           ; print the account number
       TYPECR  <]>                     ; end of PPn display
       POPW    D.PPN+DDB(A5)           ; restore info
       POPW    D.DRV+DDB(A5)
       POPW    D.DEV+DDB(A5)
       REST    D1,A0
       RTN

;****************
;*   RETURN     *
;****************
; This routine waits for user input
RETURN:
       TSTW    BEGRTN(A5)              ; is this the first time through ?
       BEQ     10$                     ;  yes - don't wait for user
       SAVE    D1                      ; save work register
       ACRT    24.,1.                  ; row 24 col 1
       ACRT    11.                     ; low
       TYPESP  <Press>                 ;
       ACRT    12.
       TYPESP  <any key>
       ACRT    11.
       TYPESP  <to continue:>
       ACRT    12.
       ACRT    28.                     ; cursor on
       KBD                             ; wait for a key stroke
       ACRT    29.                     ; cursor off
       REST    D1                      ; restore work register
10$:
       MOVW    #-1,BEGRTN(A5)          ; no longer first time through
       RTN


       END

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.