Shareware Overload/ShartewareOverload.cdr/progm/dpl.zip/LIST.D

Text File | 1988-07-11 | 11KB | 545 lines

PROG    LIST
;
; Sample DPL program which lists text files to the screen. The file may
;    contain up to "MAX_TBL_LENGTH" pages of text. Any more pages
;    will be ignored. This program requires ANSI.SYS to be loaded in
;    order to highlight "HIT"s in text searchs.
;
; Doug's Programming Language  -- DPL, Version 2.22
; Copyright (c) 1988 Douglas S. Cody, All rights reserved.
;
FILE    CONSL,'CON'
FILE    AFILE,'                                                  ',A,BUFFA
;
BUFFER    BUFFA,1024
;
DEFINE    M00,'(V2.22) ENTER THE FILE NAME: '
DEFINE    M01,'** CANNOT OPEN THE FILE, TRY AGAIN **'
DEFINE    M02,'ONE MOMENT PLEASE...'
DEFINE    M03,' Again Find Goto Left Next Prev Right Quit 7-bits '
DEFINE    M04,'PG='
DEFINE    M05,'MXPG='
;
DEFINE    M10,'ENTER A PAGE NUMBER: '
DEFINE    M11,'FIND>'
;
DEFINE    AA,'A'
DEFINE    FF,'F'
DEFINE    GG,'G'
DEFINE    LL,'L'
DEFINE    NN,'N'
DEFINE    PP,'P'
DEFINE    RR,'R'
DEFINE    QQ,'Q'
DEFINE    X7,<37H AND 05FH>    ; ASCII 7 AS MODIFIED FOR COMPARISON
;
DEFINE    BLANKS,'                                                                               '
DEFINE    BRIGHT,<1BH,'[31;40m'>    ; ANSI.SYS RED FORGROUND, BLACK BACKGROUND
DEFINE    DIM,<1BH,'[0m'>        ; ANSI.SYS NORMAL ATTRIBUTES
;
STRING    STR,132
STRING    MATCH_STR,132
STRING    PADDED,256
;
SET    EOF,1
SET    @SUBSCRIPT,0
SET    @WORKN1,0
SET    @WORKN2,0
SET    LEFT_MARGIN,0
SET    BIT_7_FLAG,0
SET    FIND_LINE,0
SET    FOUND_STATE,0
;
; Create an array structure. The routines TBLGET & TBLPUT will
; maintain the table. Integer INDX will be the subscript
;
MAX_TBL_LENGTH    EQU    1024
;
PNTR    DD    00
    DD    MAX_TBL_LENGTH dup(0)
SET    INDX,0
SET    MAX_PAGES,MAX_TBL_LENGTH
;
FIND_PNTR    DD    00
;
BEGIN    LIST
    EXTRN    FMOVE:NEAR, FSTRNG:NEAR
    EXTRN    CLRSCR:NEAR, CMDLN:NEAR
    EXTRN    _STRLEN:NEAR
;
    CALL    CMDLN STR        ; GET THE FILE NAME FROM THE CMD LINE
    OPEN    IO,CONSL
;
A00:
    CALL    GET_FILE
    IF WORD STATUS EQ EOF GOTO Z00
    CALL    LOAD_FILE
;
    INDX    = ZERO
    CALL    TBLGET
;
B00:
    CALL    DISPLAY_PAGE        ; DISPLAY THE CURRENT PAGE
    CALL    PROMPT_OPERATOR        ; DISPLAY THE PROMPT...
    IF STRING STR NE NN GOTO B10
        CALL    ADVANCE_PAGE
    GOTO    B00
;
B10:
    IF STRING STR NE PP GOTO B20
    CALL    BACKUP_PAGE
    GOTO    B00
;
B20:
    IF STRING STR NE GG GOTO B30
    CALL    GOTO_PAGE
    GOTO    B00
;
B30:
    IF STRING STR NE LL GOTO B40
    CALL    MOVE_LEFT
    GOTO    B00
;
B40:
    IF STRING STR NE RR GOTO B50
    CALL    MOVE_RIGHT
    GOTO    B00
;
B50:
    IF STRING STR NE GG GOTO B60
    CALL    GOTO_PAGE
    GOTO    B00
;
B60:
    IF STRING STR NE FF GOTO B70
    CALL    FIND_TEXT
    GOTO    B00
;
B70:
    IF STRING STR NE AA GOTO B80
    CALL    CONTINUE_SEARCH
    GOTO    B00
;
B80:
    IF STRING STR NE X7 GOTO B90
    XOR    BYTE PTR [BIT_7_FLAG],0FFH    ; TOGGLE THE FLAG
    GOTO    B00
;
B90:
    IF STRING STR NE QQ GOTO B00
;
Z00:
    CALL    CLRSCR
    STOP
;
;
;=====================
;   ROUTINE SECTION
;    LEVEL 1
;=====================
;
;
;--------------------------------------------
; ADVANCE_PAGE -- INCREMENT THE PAGE COUNTER
;          TO DISPLAY THE NEXT PAGE
;
ADVANCE_PAGE    PROC    NEAR
    IF WORD INDX GE MAX_PAGES GOTO ADVPG_05
    INDX    = INDX + 1
    CALL    TBLGET
    RETURN
;
ADVPG_05:
    WRITE    CONSL,BEEP
    POINT    AFILE,PNTR
    RETURN

ADVANCE_PAGE    ENDP
;
;
;--------------------------------------------
; BACKUP_PAGE -- DECREMENT THE PAGE COUNTER
;         TO DISPLAY THE PREVIOUS PAGE
;
BACKUP_PAGE    PROC    NEAR
    IF WORD INDX LE ZERO GOTO BKPG_05
    INDX    = INDX - 1
    CALL    TBLGET
    RETURN
;
BKPG_05:
    WRITE    CONSL,BEEP
    RETURN

BACKUP_PAGE    ENDP
;
;
;-----------------------------------------
; CONTINUE_SEARCH -- CONTINUE THE TEXT MATCH
;
CONTINUE_SEARCH    PROC    NEAR
    IF STRING MATCH_STR EQ NULL GOTO CNTSRCH_05
    CALL    FIND_IN_FILE
;
CNTSRCH_05:
    RETURN

CONTINUE_SEARCH    ENDP
;
;
;
;-----------------------------------------
; DISPLAY_PAGE -- WRITE ONE PAGE WORTH OF THE FILE
;          TO THE SCREEN.
;
DISPLAY_PAGE    PROC    NEAR
    CALL    CLRSCR            ; CLEAR THE SCREEN
    WRITE    CONSL,,CR        ; MOVE DOWN ONE LINE
    POINT    AFILE,PNTR
    @WORKN1    = 23
    @WORKN2 = INDX * 23
    @WORKN2 = FIND_LINE - @WORKN2 + FOUND_STATE
;
DSPPG_05:
    READ    AFILE,STR,132
    IF WORD STATUS NE ZERO GOTO DSPPG_10
    CALL    PREP_STRING        ; PAD THE TABS
;
    @WORKN2 = @WORKN2 - 1
    IF WORD @WORKN2 NE ZERO GOTO DSPPG_06
    WRITE    CONSL,BRIGHT
;
DSPPG_06:
    MOV    BX,[LEFT_MARGIN]
    MOV    SI,OFFSET PADDED
    CALL    _STRLEN            ; GET THE LENGTH
    CMP    BX,CX            ; BX GT LENGTH?
    JLE    DSPPG_07        ; NO, CONTINUE ON...
    MOV    BX,CX            ; YES, SO STOP AT THE END
;
DSPPG_07:
    ADD    SI,BX
    MOV    BYTE PTR [SI+79],0    ; SET A TERMINATOR TO TRUNCATE THE LINE
    MOV    DI,OFFSET CONSL
    MOV    AL,0FFH
    CALL    _FWRT
;
    IF WORD @WORKN2 NE ZERO GOTO DSPPG_09
    WRITE    CONSL,DIM
;
DSPPG_09:
    @WORKN1    = @WORKN1 - 1
    IF WORD @WORKN1 GT ZERO GOTO DSPPG_05
;
DSPPG_10:
    RETURN

DISPLAY_PAGE    ENDP
;
;
;-----------------------------------------
; FIND_TEXT -- SEARCH THE FILE FOR SOME TEXT
;
FIND_TEXT    PROC    NEAR
    CURSOR    0,0
    WRITE    CONSL,BLANKS
    CURSOR    0,0
    WRITE    CONSL,M11
    READ    CONSL,MATCH_STR,132
    FIND_LINE = INDX * 23
    MOV    AX, WORD PTR [PNTR+0]
    MOV    WORD PTR [FIND_PNTR+0],AX
    MOV    AX, WORD PTR [PNTR+2]
    MOV    WORD PTR [FIND_PNTR+2],AX
    CALL    FIND_IN_FILE
    RETURN

FIND_TEXT    ENDP
;
;
;-----------------------------------------
; GET_FILE -- GET THE NAME OF A TEXT FILE FROM THE OPERATOR
;
GET_FILE    PROC    NEAR
    IF STRING STR NE NULL GOTO GTFI_02
;
GTFI_00:
    WRITE    CONSL,,CR
    WRITE    CONSL,M00
    READ    CONSL,STR,50
    IF STRING STR EQ NULL GOTO GTFI_10
;
GTFI_02:
    CALL    FMOVE STR AFILE
    OPEN    INPUT,AFILE
    IF WORD STATUS EQ ZERO GOTO GTFI_05
    WRITE    CONSL,BEEP
    WRITE    CONSL,M01,CR
    GOTO    GTFI_00
;
GTFI_05:
    STATUS    = ZERO
    RETURN
;
GTFI_10:
    STATUS    = EOF
    RETURN

GET_FILE    ENDP
;
;
;--------------------------------------------
; GOTO_PAGE -- GO TO A SPECIFIC PAGE
;
GOTO_PAGE    PROC    NEAR
    CURSOR    0,0
    WRITE    CONSL,BLANKS
    CURSOR    0,0
    WRITE    CONSL,M10
    READ    CONSL,STR,6
    IF STRING STR EQ NULL GOTO GTPG_05
    DECODE    @WORKN1,STR
    IF WORD STATUS NE ZERO GOTO GOTO_PAGE
    IF WORD @WORKN1 LT ZERO GOTO GOTO_PAGE
    IF WORD @WORKN1 GT MAX_PAGES GOTO GOTO_PAGE
    INDX    = @WORKN1
    CALL    TBLGET
;
GTPG_05:
    RETURN

GOTO_PAGE    ENDP
;
;
;-------------------------------------------
; LOAD_FILE  -- LOAD THE TABLE WITH FILE POINTERS
;        TO THE TEXT FILE
;
LOAD_FILE    PROC    NEAR
    WRITE    CONSL,M02
    INDX      = ZERO
    MAX_PAGES = MAX_TBL_LENGTH
;
LDFI_05:
    @WORKN1    = 23
    NOTE    AFILE,PNTR
    CALL    TBLPUT
    INDX    = INDX + 1
;
LDFI_10:
    READ    AFILE,STR,132
    IF WORD STATUS NE ZERO GOTO LDFI_15
    @WORKN1    = @WORKN1 - 1
    IF WORD @WORKN1 GT ZERO GOTO LDFI_10
    GOTO    LDFI_05
;
LDFI_15:
    MAX_PAGES = INDX - 1
    RETURN

LOAD_FILE    ENDP
;
;
;-------------------------------------------
; MOVE_LEFT  --  MOVE THE SCREEL LEFT 8 COLUMNS
;
MOVE_LEFT    PROC    NEAR
    IF WORD LEFT_MARGIN EQ ZERO RETURN
    LEFT_MARGIN = LEFT_MARGIN - 8
    RETURN

MOVE_LEFT    ENDP
;
;
;-------------------------------------------
; MOVE_RIGHT  --  MOVE THE SCREEL RIGHT 8 COLUMNS
;
MOVE_RIGHT    PROC    NEAR
    IF WORD LEFT_MARGIN EQ 256-80 RETURN
    LEFT_MARGIN = LEFT_MARGIN + 8
    RETURN

MOVE_RIGHT    ENDP
;
;
;-------------------------------------------
; PROMPT_OPERATOR -- GIVE THE OPERATOR THE CURRENT PAGE
;             NUMBER AND THE OPTIONS PROMPT
;
PROMPT_OPERATOR    PROC    NEAR
    ENCODE    STR,INDX
    CURSOR    0,0
    WRITE    CONSL,M04
    WRITE    CONSL,STR
    ENCODE    STR,MAX_PAGES
    WRITE    CONSL,M05
    WRITE    CONSL,STR
    WRITE    CONSL,M03
    INKEY    STR,WAIT        ; PROMPT THE OPERATOR FOR ACTION
    AND    BYTE PTR [STR],05FH    ; CONVERT TO UPPERCASE
    RETURN

PROMPT_OPERATOR    ENDP
;
;
;=====================
;   ROUTINE SECTION
;    LEVEL 2
;=====================
;
;
;-----------------------------------------
; FIND_IN_FILE  -- SEARCH THE TEXT FILE FOR A STRING MATCH
;
FIND_IN_FILE    PROC    NEAR
    POINT    AFILE,FIND_PNTR
;
FNDINF_05:
    READ    AFILE,STR,132
    IF WORD STATUS NE ZERO GOTO FNDINF_20
    FIND_LINE = FIND_LINE + 1
    CALL    FSTRNG MATCH_STR STR
    JC    FNDINF_05
    NOTE    AFILE,FIND_PNTR
    INDX    = FIND_LINE - 1 / 23
    CALL    TBLGET
    POINT    AFILE,PNTR
    STATUS    = ZERO
    FOUND_STATE = ZERO
    RETURN
;
FNDINF_20:
    POINT    AFILE,PNTR
    STATUS    = EOF
    FOUND_STATE = -1
    RETURN

FIND_IN_FILE    ENDP
;
;
;-------------------------------------
; PREP_STRING  -- EXPAND THE TABS TO SPACES
;
; Entry conditions:
;    None
; Exit conditions:
;    PADDED holds the string to be printed
;
PREP_STRING    PROC    NEAR
    PUSH    ES
    PUSH    SI
    PUSH    DI
;
    PUSH    DS
    POP    ES        ; ES = DATA SEGMENT
    MOV    CX,256        ; SETUP THE MAX PAD COUNT
    MOV    SI,OFFSET STR
    MOV    DI,OFFSET PADDED
    CLD
    MOV    AH,09H
    MOV    BX,[BIT_7_FLAG]
;
PRPSTR_05:
    CMP    AH,[SI]        ; TAB?
    JZ    PRPSTR_20    ; YES, GO PAD IT
    LODSB            ; FETCH THE CHARACTER
    OR    BL,BL        ; TRIM THE 8TH BIT?
    JZ    PRPSTR_10    ; NO...
    AND    AL,07FH        ; TRIM THE 8TH BIT
;
PRPSTR_10:
    OR    AL,AL        ; TERMINATOR?
    JZ    PRPSTR_12     ; YES, STORE IT AS-IS
    CMP    AL,20H        ; TOO LOW TO PRINT?
    JA     PRPSTR_12    ; NO
    MOV    AL,20H        ; YES, SO FLUSH IT...
;
PRPSTR_12:
    STOSB            ; & SAVE IT IN THE TARGET STRING
    OR    AL,AL        ; IS IT THE TERMINATOR?
    LOOPNE    PRPSTR_05    ; LOOP UNTIL SO...
;
PRPSTR_15:
    POP    DI
    POP    SI
    POP    ES
    RETURN
;
PRPSTR_20:
    INC    SI        ; MOVE PAST THE TAB
    MOV    DX,0007H    ; DL=MASK
    AND    DL,CL
    XCHG    DX,CX        ; DX=REMAINING LENGTH, CX=PADDING COUNT
    JNZ    PRPSTR_21    ; SKIP IF VALUE = 1 - 7
    MOV    CX,08        ; PAD ALL 8 SPACES
;
PRPSTR_21:
    SUB    DX,CX        ; ADJUST FOR PADDING
    MOV    AL,20H        ; PAD WITH A SPACE
    REP    STOSB        ; STORE IT ALL
    MOV    CX,DX        ; RESTORE THE REMAINING LENGTH
    JCXZ    PRPSTR_15    ; EXIT IF NULL
    JMP    SHORT PRPSTR_05    ; GO PAD MORE...

PREP_STRING    ENDP
;
;
;=====================
;   ROUTINE SECTION
;    LEVEL 3
;=====================
;
;
;-------------------------------------
; TBLGET -- GET THE A TABLE ENTRY
;
; Entry conditions:
;    INDX holds the table subscript
; Exit conditions:
;    STATUS = EOF, index out of range
;    STATUS = 0, PNTR holds the table entry
;
TBLGET    PROC    NEAR
    STATUS    = EOF
    IF WORD INDX GT MAX_PAGES RETURN    ; EXIT IF INDX IS OUT OF BOUNDS
    IF WORD INDX LT ZERO RETURN
    @SUBSCRIPT = INDX * 4
    MOV    BX,[@SUBSCRIPT]            ; MOVE THE BYTES
    MOV    AX,WORD PTR PNTR+4+0[BX]
    MOV    WORD PTR PNTR+0,AX
    MOV    AX,WORD PTR PNTR+4+2[BX]
    MOV    WORD PTR PNTR+2,AX
    STATUS    = ZERO
    RETURN

TBLGET    ENDP
;
;
;-------------------------------------
; TBLPUT -- PUT THE ENTRY INTO THE TABLE
;
; Entry conditions:
;    INDX holds the table subscript
; Exit conditions:
;    STATUS = EOF, index out of range
;    STATUS = 0, PNTR holds the table entry
;
TBLPUT    PROC    NEAR
    STATUS    = EOF
    IF WORD INDX GT MAX_PAGES RETURN    ; EXIT IF INDX IS OUT OF BOUNDS
    IF WORD INDX LT ZERO RETURN
    @SUBSCRIPT = INDX * 4
    MOV    BX,[@SUBSCRIPT]            ; MOVE THE BYTES
    MOV    AX,WORD PTR PNTR+0
    MOV    WORD PTR PNTR+4+0[BX],AX
    MOV    AX,WORD PTR PNTR+2
    MOV    WORD PTR PNTR+4+2[BX],AX
    STATUS    = ZERO
    RETURN

TBLPUT    ENDP
;
ENDPGM    LIST
;