; SELSCN.M68 - SELECT SEQUENTIAL FILE RECORDS, OUTPUT TO SCREEN
; 03/05/87 Evan Oulashin, Portland Radio Supply
;
;       Uploaded to AMUS 06/01/87
;       This version adapted from original SEL.M68 which always writes
;       to output file SELECT.OUT.  Since it was required to do this
;       from within a basic program, we created this version which outputs
;       only to the screen.
;
; Usage: SELSCN Filename String - as in SEL ORDERS.TXT COMPLETE
;        or use from Basic by using XCALL AMOS,"SELSCN filename string".
;
; Additional files required: (all on Network system)
;               AAA.M68
;               AMOS.M68
;               MACLIB.M68

       SEARCH  AAA
       SEARCH  MACLIB
       SEARCH  SYS
       SEARCH  SYSSYM
       SEARCH  TRM
;
       .OFINI                  ; define impure (variable) area
       .OFDEF  DCOUNT,2        ; count of lines displayed
       .OFDEF  EOFFLG,1        ; end of input file flag
       .OFDEF  MFLG,1          ; flags that a match (selection) was made
       .OFDEF  INBUF,200.      ; buffers 'filename' input a line at a time
       .OFDEF  MCOUNT,4        ; number of matches (selections)
       .OFDEF  SPOINT,4        ; points at current 'search string' letter
       .OFDEF  INFIL,D.DDB     ; input file ddb
       .OFSIZ  MEMSIZ

       BUFPT = A1
       SRCPT = A2
;
DEFINE  SETINP
       LEA     BUFPT,INBUF(A5)         ; reset input buffer pointer
       DEC     BUFPT                   ; subtract 1 since we pre-bump
ENDM                                    ; prior to writing to @BUFPT.
;
DEFINE  SETSRC                          ; reset search string pointer
       MOV     SPOINT(A5),SRCPT
ENDM
DEFINE  SETSCN
       MOVW    #21.,DCOUNT(A5)
       CRT     #0
       TYPECR  Searching...
ENDM
;
START:  PHDR    -2,0,PH$REE!PH$REU      ; program is reentrant/reusable
       GETIMP  MEMSIZ,A5               ; allocate impure area for variables
       ONEKEY                          ; set to image mode
       CALL    OFIL                    ; open files
       BYP                             ; bypass blanks in command buffer
       MOV     SRCPT,SPOINT(A5)        ; save search string pointer
       SETSCN
BEGIN:  SETINP                          ; reset input buffer pointer
SETSRC: SETSRC                          ; reset search string pointer
RDLOOP: CALL    RDBUF                   ; read next byte to buffer
       TSTB    EOFFLG(A5)              ; eof?
       JNE     EOF                     ; yes...quit out
       TSTB    MFLG(A5)                ; have we had a match yet?
       BNE     RDLOOP                  ; if so just get rest of line
       UCS                             ; make uppercase if lc
       CMPB    D1,(SRCPT)              ; does this char match?
       BNE     SETSRC                  ; nope - reset pointer & loop
BMPPT:  INC     SRCPT                   ; yup - bump to next char in srch
       LIN
       BNE     RDLOOP                  ; nope...keep on going
       SETB    MFLG(A5)                ; yup - set MFLG to show match
       JMP     RDLOOP                  ; and loop
RDBUF:  FILINB  INFIL(A5)               ; next byte from file
       TST     INFIL+D.SIZ(A5)         ; are we at eof?
       BEQ     SETEOF                  ; if so set the flag
       INC     BUFPT                   ; bump input buffer pointer
       MOVB    D1,@BUFPT               ; put character there
       CMPB    D1,#15                  ; CR?
       BEQ     WRTCHK                  ; if so, check and write or skip
       RTN
SETEOF: SETB    EOFFLG(A5)              ; set eof flag
       RTN
WRTCHK: FILINB  INFIL(A5)               ; get lf (clear it out of input file)
       TSTB    MFLG(A5)                ; has there been a match yet?
       BEQ     SETEM                   ; nope, go reset pointers
       SETINP                          ; yes - reset input buffer to write
       INC     BUFPT                   ; need one more since it was dec'ed
WRLOOP: MOVB    (BUFPT)+,D1             ; get next char to write
       TTY
       CMPB    D1,#15                  ; end of line?
       BNE     WRLOOP                  ; keep writing if not
       CRLF
       INC     MCOUNT(A5)              ; keep track of number of matches
       DECW    DCOUNT(A5)              ; screen full?
       BEQ     CALRET                  ; yup - get a cr from 'em
CMF:    CLRB    MFLG(A5)                ; reset match flag
SETEM:  SETINP                          ; reset input buffer
       SETSRC                          ; reset search string buffer
       CTRLC   ABORT                   ; if ^C just bag it
       RTN
CALRET: CALL PRSRET
;       CMPB    D1,#88.
;       BEQ     EOF
       SETSCN
       BR      CMF
PRSRET: CRT     #24.,#1.
       TYPESP  [Press RETURN to continue...]
       KBD
       CRT     #24.,#1.
       CRT     #9.
       RTN
EOF:    CLOSE   INFIL(A5)               ; close the files
       CLR     D1                      ; clear D1 to receive match count
       MOV     MCOUNT(A5),D1           ; move match count to D1
       CRLF
       TYPESP
       TYPESP  Displayed               ; final message
       DCVT    0,OT$TRM                ; and convert it again
       TYPESP                          ; a space
       CMP     D1,#1.
       BNE     PLURAL
       TYPECR  record.
       BR      ALLDON
PLURAL: TYPECR  records.
ALLDON: CALL    PRSRET
BYEBYE: MLTKEY                          ; set to normal mode
       EXIT
OFIL:   FSPEC   INFIL(A5)               ; open input file
       INIT    INFIL(A5)               ; init the buffer
       LOOKUP  INFIL(A5)               ; already exist?
       JNE     NOFILE                  ; no such file message
       OPENI   INFIL(A5)               ; open file for input
       RTN
COMAND: ASCII   \TYPE SELECT.OUT/P\     ; the final command
       BYTE    0                       ; a terminator
       EVEN
NOFILE: TYPECR  No such file.           ; bad news
       BR      BYEBYE
ABORT:  CLOSE   INFIL(A5)               ; close the files
       BR      BYEBYE
       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.