home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ENTERPRS / CPM / UTILS / S / ZDB18C.LBR / ZDB18SRC.LYR / ZDB18.A < prev    next >
Text File  |  1993-03-31  |  21KB  |  1,053 lines
  1. ;;; Mods by Terry Hazen 02/04/92
  2.  
  3. ;; This is ZDB18.A, part of the source code to ZDB18, a continuation of
  4. ;; ZDB18.Z80
  5. ;; 01/29/92
  6. ;;
  7. ;    output routines
  8. ;
  9. output:    call    clrmnu
  10.     dc    1,'F=CDF File  W=WordStar File  P=Print '
  11.     call    qquit
  12.     call    getchar
  13.     cp    'F'
  14.     jp    z,dfile
  15.     cp    'W'
  16.     jp    z,dfile
  17.     cp    'P'
  18.     jp    nz,menu
  19. ;
  20. poutput:ld    a,(pchkf)    ; check bios printer test flag
  21.     or    a
  22.     jr    z,prtrdy    ; skip bios test
  23. ;
  24. pout0:    ld    a,lstat        ; bios list status
  25.     call    bios        ; check for printer ready
  26.     or    a
  27.     jr    nz,prtrdy
  28.     call    clrmnu
  29.     db    bel
  30.     db    1,'Printer Off Line--Check, Then Press Any Key'
  31.     dc    ' (Q=Quit)',2
  32.     call    getchar
  33.     cp    'Q'        ; an escape route, if needed
  34.     jr    nz,pout0    ; try again
  35.     jp    menu        ;;;
  36. ;;;    ret
  37. ;
  38. prtrdy:    call    clrmnu
  39.     dc    1,'L=Labels  E=Envelopes '
  40.     call    qquit
  41.     call    getchar
  42.     ld    de,prttbl
  43.     call    acase3
  44.     jr    prtrdy
  45.  
  46. prttbl:    db    3
  47.     dw    prtrdy
  48.     db    'E'
  49.     dw    envel
  50.     db    'L'
  51.     dw    labels
  52.     db    'Q'
  53.     dw    menu
  54. ;
  55. labels:    ld    a,1        ; initialize the number of copies to 1
  56.     ld    (copies),a
  57.     call    clrmnu
  58.     dc    1,'F=Find X=Xfind <>=Prev/Nxt P=PrintCurrent K=Key A=All'
  59.     call    qquit
  60.     call    getchar
  61.     ld    de,lbmtbl
  62.     call    acase3
  63.     jr    labels
  64.  
  65. lbmtbl:    db    10
  66.     dw    labels
  67.     db    'Q'
  68.     dw    doff
  69.     db    'P'
  70.     dw    multi
  71.     db    'F'
  72.     dw    find
  73.     db    'X'
  74.     dw    qfind
  75.     db    '.'
  76.     dw    next
  77.     db    '>'
  78.     dw    next
  79.     db    '<'
  80.     dw    prev
  81.     db    ','
  82.     dw    prev
  83.     db    'K'
  84.     dw    lblkey
  85.     db    'A'
  86.     dw    fulset
  87. ;
  88. ; print entire file
  89. ;
  90. fulset:    call    gotop
  91. fullp:    call    ckeoi
  92.     jp    c,doff        ;
  93.     call    rread        ; read current record
  94.     call    mxrptr        ; increment pointers
  95.     call    delrec        ; check for deleted record
  96.     call    nz,prlbl    ; print if not deleted
  97.     jr    fullp        ; and repeat
  98. ;
  99. ; input for search
  100. ;
  101. getkeyf:ld    b,11        ; set length (b=11)
  102. getkey:    ld    c,0        ; initialize counter
  103.     push    bc        ; save count from gbox
  104.     push    bc        ; save count from pad
  105.     call    clrmnu
  106.     dc    1,'Find >',2
  107.     pop    bc        ; restore count for pad
  108.     call    pad
  109.     pop    bc        ; restore count
  110.     ld    hl,1807h    ; set cursor to 24,7
  111.     ld    (cpos),hl    ; save it
  112.     call    gotoxy
  113.     ld    hl,srch        ; point to search string buffer
  114.     call    curon
  115.     ld    a,on        ; set caps
  116.     jp    edlp0        ; get search string
  117.                 ; c=length of search string
  118. ;
  119. ; label output selection keys
  120. ;
  121. lblkey:    call    clrmnu
  122.     dc    1,'Key:  C=City S=State Z=Zip X=Cmnts1/2'
  123.     call    qquit
  124. ;
  125. keylp:    call    getchar
  126.     ld    de,keytbl
  127.     call    acase3
  128.     ld    a,(keyflg)
  129.     or    a
  130.     ret    nz
  131.     jp    labels
  132. ;
  133. keytbl:    db    5
  134.     dw    keylp
  135.     db    'Q'
  136.     dw    doff
  137.     db    'C'
  138.     dw    keyc
  139.     db    'S'
  140.     dw    keys
  141.     db    'Z'
  142.     dw    keyz
  143.     db    'X'
  144.     dw    keyx
  145. ;
  146. keyc:    ld    hl,city
  147.     ld    b,cilen
  148.     jr    getinp
  149. keys:    ld    hl,state
  150.     ld    b,stlen
  151.     jr    getinp
  152. keyz:    ld    hl,zip
  153.     ld    b,zilen
  154. getinp:    push    hl        ; save field to search
  155.     call    getkey        ; get input
  156.     ld    b,c        ; make it an exact match
  157.     jr    keyok
  158. keyx:    ld    hl,cmnts1    ; point to first comment line
  159.     ld    b,25        ;
  160.     push    hl        ; save field to search
  161.     call    getkey        ; get input for key
  162.     ld    b,c1len+c2len    ; search both comment lines
  163. ;
  164. keyok:    ld    (keylen),bc    ; save key length
  165.     pop    hl        ; get back field to search
  166.     ld    (prkey),hl    ; save it
  167.     call    gotop        ; search from beginning of file
  168.     xor    a
  169.     ld    (fndflg),a
  170.     ld    a,(keyflg)    ; is this a search for CDF routine?
  171.     or    a        ; if so, quit here
  172.     ret    nz
  173.  
  174. loopk:    call    ckeoi        ; quit at end of index table
  175.     jr    c,notfnd
  176.     call    rread        ; read record
  177.     call    mxrptr        ; increment pointers
  178.     ld    hl,srch        ; search string
  179.     ld    de,(prkey)    ; search target
  180.     push    bc
  181.     call    scanner        ; do search
  182.     jr    nz,noluck
  183.     ld    a,true
  184.     ld    (fndflg),a
  185.     call    prlbl        ; on a match, print label
  186. noluck:    pop    bc
  187.     jr    loopk        ; repeat
  188. notfnd:    ld    a,(fndflg)
  189.     or    a        ;
  190.     jp    z,nofind    ; give no find message, reset pointer to top
  191.     jp    firstr
  192. ;
  193. qquit:
  194.     call    vprint
  195.     db    ' Q=Quit ?',bs,2,0
  196.     ret
  197. ;
  198. envel:    call    clrmnu        ; find, next, print menu
  199.     dc    1,'F=Find X=Xfind <>=Prev/Nxt P=PrintCurrent'
  200.     call    qquit
  201.     call    getchar
  202.     ld    de,envtbl
  203.     call    acase3
  204.     jr    envel
  205.  
  206. envtbl:    db    8
  207.     dw    envel
  208.     db    'F'
  209.     dw    find
  210.     db    'X'
  211.     dw    qfind
  212.     db    '.'
  213.     dw    next
  214.     db    '>'
  215.     dw    next
  216.     db    ','
  217.     dw    prev
  218.     db    '<'
  219.     dw    prev
  220.     db    'P'
  221.     dw    prenv
  222.     db    'Q'
  223.     dw    doff
  224. ;
  225. ; print envelope
  226. ;
  227. prenv:    ld    a,true
  228.     ld    (envflg),a
  229.     call    prrta        ; print return address
  230.     ld    a,(addrsp)    ; space down to address
  231.     ld    b,a
  232.     ld    a,lf
  233. sendlfs:call    lout
  234.     djnz    sendlfs
  235.     call    pradr
  236.     jr    resetp
  237. ;
  238. ; print labels
  239. ;
  240. prlbl:    xor    a
  241.     ld    (envflg),a    ; turn off envelope flag
  242.     dec    a
  243.     ld    (prtflg),a    ; set print flag
  244.     ld    a,(copies)    ; get number of copies
  245.     or    a        ; if it's zero, quit
  246.     ret    z
  247. ;
  248.     ld    b,a        ; number in b
  249. prlbl1:    call    condin        ; a keypress will interrupt printing
  250.     ret    nz
  251.     push    bc        ; save number or pradr will lose it
  252.     call    prrtal
  253.     call    pradr
  254.     pop    bc        ; get number back
  255.     djnz    prlbl1        ; loop until b=0
  256. ;
  257. resetp:    ld    hl,reset    ; fall thru to reset printer
  258. ;
  259. ; send counted string to printer
  260. ;
  261. clpstr:    ld    a,(hl)
  262.     or    a
  263.     ret    z
  264.     ld    b,a
  265. clpst0:    inc    hl
  266.     ld    a,(hl)
  267.     call    lout
  268.     djnz    clpst0
  269.     ret
  270. ;
  271. ; send 0-terminated string to printer
  272. ;
  273. elpstr:    ld    a,(hl)
  274.     inc    hl
  275.     or    a
  276.     ret    z
  277.     call    lout
  278.     jr    elpstr
  279. ;
  280. lmargin:ld    hl,lemarg    ; point to envelope left margin string
  281.     ld    a,(envflg)    ; check if label, tho
  282.     or    a
  283.     jr    nz,margin
  284.     ld    hl,llmarg    ; if label, use label left margin
  285. ;
  286. ; send b spaces to printer
  287. ;
  288. margin:    ld    a,(hl)        ; get count
  289. margin0:ld    b,a        ; in b
  290.     or    a
  291.     ret    z        ; quit if none
  292.     ld    a,' '
  293. margl:    call    lout
  294.     djnz    margl
  295.     ret
  296. ;
  297. pradr:    ld    hl,ain        ; initialize printer for address
  298.     call    clpstr
  299.     call    lmargin        ; space over if envelope
  300.     ld    hl,fieldpanel
  301.     ld    b,8
  302. ;
  303. paloop:    push    bc        ; save field count
  304.     push    hl        ; save field address pointer
  305.     call    lhlhl        ; get field address in hl
  306.     ld    a,(hl)        ; skip empty fields
  307.     ld    (eflag),a    ; set empty flag
  308.     or    a
  309.     jr    z,pa00        ; empty, skip printing
  310. ;
  311.     call    elpstr        ; print field
  312.     ld    a,' '        ; and trailing space
  313.     call    lout
  314. ;
  315. pa00:    ld    de,patbl    ; decide about adding new line
  316.     ld    a,b        ; put field number in a
  317.     call    acase3
  318.     pop    hl        ; restore field address pointer
  319.     pop    bc        ; restore field count
  320.     inc    hl        ; point to next field address
  321.     inc    hl
  322.     djnz    paloop
  323. ;
  324. formfd:    ld    a,ff        ; send formfeed
  325.     jp    lout
  326. ;
  327. ; do formfeed at the end of label printing session
  328. ;
  329. doff:    ld    a,(prtflg)    ; if we've done any printing, do ff
  330.     or    a
  331.     jr    z,doffd        ; no ff required
  332.     xor    a
  333.     ld    (prtflg),a    ; reset flag
  334.     ;ld    a,(ffflg)
  335.     ;or    a
  336.     ;jr    z,doffr
  337.     ;call    formfd        ; do form feed on return to menu
  338. ;doffr: call    resetp
  339. doffd:    jp    menu
  340. ;
  341. ; Add new line if field is not empty
  342. ;
  343. neline:    ld    a,(eflag)
  344.     or    a
  345.     ret    z
  346. ;
  347. ; Add new line
  348. ;
  349. nline:    call    lcrlf        ; do new line
  350.     jp    lmargin
  351. ;
  352. nnline:    ret            ; skip new line
  353. ;
  354. ; special case table for new lines
  355. ;
  356. patbl:    db    5        ; number of table entries
  357.     dw    neline        ; default is new line if not empty
  358.     db    8        ;
  359.     dw    nnline        ; first name: no new line
  360.     db    7
  361.     dw    nline        ; last name: new line always
  362.     db    4
  363.     dw    nnline        ; city: no new line
  364.     db    3
  365.     dw    nnline        ; state: no new line
  366.     db    2
  367.     dw    nline        ; zip: new line always
  368. ;
  369. ; multiple copy option
  370. ;
  371. multi:    call    curon
  372.     call    clrmnu
  373.     dc    1,'How many copies? ',2
  374.     ld    c,0
  375.     ld    hl,xcopy
  376.     call    cin
  377.     cp    cr        ;
  378.     jr    nz,getnum0    ;
  379.     jr    z,cpyfin0        ;
  380.  
  381. getnum:call    cin
  382.     cp    cr
  383.     jr    z,cpyfin
  384. getnum0:call    cout
  385.     ld    (hl),a
  386.     inc    hl
  387.     inc    c
  388.     ld    a,c
  389.     cp    3        ; maximum 3 digits
  390.     jr    nz,getnum
  391.  
  392. cpyfin:    ld    (hl),0
  393.     ld    hl,xcopy
  394.     call    eval10        ; convert to binary
  395.     ld    (copies),a    ; store it
  396. cpyfin0:push    af
  397.     call    curoff
  398.     pop    af
  399.     or    a        ;
  400.     ret    z        ; no copies
  401.     jp    prlbl        ; print labels
  402. ;
  403. ; print return address on label
  404. ;
  405. prrtal:    call    resetp
  406.     ld    hl,labln    ; set label form length
  407.     call    clpstr
  408.  
  409.     ld    a,(lra)        ; check if return address is desired
  410.     or    a
  411.     ret    z        ; no
  412.     jr    prrta0
  413. ;
  414. ; print return address on envelope
  415. ;
  416. prrta:                ; reset printer
  417.     call    resetp
  418.  
  419. prrta0:    ld    hl,rin        ; initialize printer for return address
  420.     call    clpstr
  421.     ld    hl,retadr    ; point to return address
  422.     jp    elpstr        ; and print it
  423. ;
  424. allorkey:            ; do we do whole file or select by key?
  425.     call    clrmnu
  426.     dc    1,'[All]/K=Key ?',2,bs
  427.     call    getchar
  428.     cp    'K'        ; by key?
  429.     ret
  430. ;
  431. findmatch:            ; do search for match
  432.     ld    hl,srch
  433.     ld    de,(prkey)
  434.     ld    bc,(keylen)
  435.     jp    scanner
  436. ;
  437. chkmem:    ld    hl,(order)    ; get address of order table
  438.     ld    de,(recs)    ; get number of records
  439.     add    hl,de        ; add to addr of order table
  440.     inc    h        ; start buffer at next page boundary
  441.     ld    l,0
  442.     ld    (work),hl    ; save as address of file buffer
  443.     ex    de,hl
  444.     call    gzmtop        ; get top of TPA (hl=1st byte of CCP)
  445.     dec    h        ; safety zone of 256 bytes
  446.     jp    comphd        ; compare
  447. ;
  448. ;    Datafile Output
  449. ;
  450. dfile:    ld    (fflag),a    ; save 'F' or 'W' flag
  451. ;
  452. ; initialize i/o control block
  453. ;
  454.     ld    a,80h        ; set 16k buffer
  455.     ld    (ioctl),a
  456.     ld    hl,fcb+1    ; get default datafile name
  457.     ld    de,iocfc+1    ; point to io filename
  458.     ld    bc,8
  459.     ldir            ; move name to fcb
  460.     ld    a,(fflag)
  461.     cp    'F'
  462.     jr    nz,dfil0
  463.     ld    hl,cdftyp    ; make file type 'CDF'
  464.     jr    dfil1
  465. dfil0:    ld    hl,wstyp    ; make file type 'WSF'
  466. dfil1:    ld    bc,3
  467.     ldir
  468. ;
  469. ;    Check Memory
  470. ;
  471.     call    chkmem
  472.     jr    c,nomem
  473.     and    a
  474.     sbc    hl,de        ; hl=space available
  475.     ld    de,4000h    ; need 16K buffer
  476.     call    comphd        ; compare hl and de; if hl<de, carry is set
  477.     jr    nc,memok
  478. nomem:
  479.     call    clrmnu
  480.     dc    bel,1,'Out of Memory...Press Any Key',2
  481.     call    cin
  482.     jp    menu
  483. ;
  484. memok:    call    allorkey
  485.     jr    nz,doall    ; no, jump
  486.     ld    (keyflg),a
  487.     call    lblkey        ; get key for selection
  488. doall:    ld    de,ioctl    ; point to ioctl block
  489.     call    fxo$open    ; open file for output
  490.     call    gotop        ; set file pointer to beginning
  491.     call    dwf        ; display writing file message
  492.     ld    a,(fflag)
  493.     cp    'F'
  494.     jr    z,reclp
  495.     ld    hl,today    ; get today's date
  496.     ld    de,wsdatbuf
  497.     call    mdata1        ; save it in "January 1, 1991" form
  498.     ld    hl,wsdatbuf
  499. wsdatlp:ld    a,(hl)
  500.     inc    hl
  501.     or    a
  502.     jr    z,wsdat0
  503.     call    fout
  504.     jr    wsdatlp
  505. wsdat0:    ld    a,cr
  506.     call    fout
  507.     ld    a,lf
  508.     call    fout
  509.     ld    a,lf
  510.     call    fout
  511. reclp:    call    ckeoi        ; check for end of index
  512.     jr    c,dfdone    ; quit when done
  513.     call    rread        ; read input file
  514.     call    mxrptr        ; increment pointers
  515.     call    delrec        ; check for deleted records
  516.     jr    z,reclp        ; and don't write them
  517.     ld    a,(keyflg)    ; check for key flag
  518.     or    a
  519.     jr    z,reclp0    ; no, write all records
  520.     call    findmatch
  521.     jr    nz,reclp    ; if no match, go to next record
  522.     ld    a,true        ; if match, set fndflg to true
  523.     ld    (fndflg),a
  524. reclp0:    ld    hl,fieldpanel
  525.     ld    b,11        ; number of fields to process
  526.     ld    a,(fflag)
  527.     cp    'W'
  528.     jr    z,reclp1    ; skip over first name field
  529. fldlp:    push    bc        ; save number
  530.     push    hl
  531.     call    lhlhl
  532.     ld    a,(hl)
  533.     or    a        ; is field empty?
  534.     jr    z,efld
  535.     ld    a,(fflag)
  536.     cp    'W'
  537.     jr    nz,fldlp0
  538.     call    wpstr
  539.     jr    efld
  540. fldlp0:    call    fpstr        ; no, print it
  541. efld:    ld    a,b        ; put field count in a
  542.     dec    a
  543.     jr    z,fdone
  544.     ld    a,(fflag)
  545.     cp    'F'
  546.     jr    nz,efld0
  547.     ld    a,','
  548.     call    fout
  549. efld0:    pop    hl
  550.     pop    bc
  551. reclp1:    inc    hl
  552.     inc    hl
  553.     djnz    fldlp
  554. fdone:    ld    a,cr        ; yes, append cr & lf
  555.     call    fout
  556.     ld    a,lf
  557.     call    fout
  558. fdone1:    pop    hl
  559.     pop    bc
  560.     jr    reclp
  561.  
  562. dfdone:    ld    de,ioctl
  563.     call    fxo$close
  564.     ld    a,(keyflg)        ; was file selected by key?
  565.     or    a
  566.     jr    z,dfdon0        ; no, jump to end
  567.     xor    a            ; yes, reset flag
  568.     ld    (keyflg),a
  569.     ld    a,(fndflg)        ; any matching records found?
  570.     cp    true
  571.     jp    nz,nofind        ; no, display message
  572. dfdon0:    jp    dotop
  573. ;
  574. fpstr:    call    putquote
  575. fpstr1:    ld    a,(hl)
  576.     inc    hl
  577.     or    a
  578.     jr    z,putquote
  579.     call    fout
  580.     jr    fpstr1
  581. putquote:
  582.     ld    a,'"'
  583. fout:    ld    de,ioctl
  584.     jp    fx$put
  585. ;
  586. wpstr:    ld    a,(hl)
  587.     inc    hl
  588.     or    a
  589.     jr    z,wpstr1
  590.     call    fout
  591.     jr    wpstr
  592. wpstr1:    ld    a,b
  593.     ld    de,wstbl
  594.     call    acase3
  595. wpstr2:    ret
  596.  
  597. wstbl:    db    5
  598.     dw    deflt
  599.     db    10
  600.     dw    addfst
  601.     db    9
  602.     dw    punct
  603.     db    8
  604.     dw    punct
  605.     db    7
  606.     dw    punct
  607.     db    1
  608.     dw    wpstr2
  609.  
  610. addfst:    call    punct
  611.     ld    hl,fstnm
  612. addfst0:ld    a,(hl)
  613.     inc    hl
  614.     or    a
  615.     jr    z,punct
  616.     call    fout
  617.     jr    addfst0
  618.  
  619. punct:    ld    a,','
  620.     call    fout
  621. deflt:    ld    a,' '
  622.     jp    fout
  623.  
  624. dwf:    call    clrmnu
  625.     dc    1,'Writing File...',2
  626.     ret
  627. ;
  628. ;    support routines
  629. ;
  630. ;    edloop is a fairly complete line editor, using WordStar-like
  631. ;    editing commands.  maximum number of characters is passed in
  632. ;    b register.  esc will exit at any point and take you back
  633. ;    to the calling routine.  ^Q aborts edit.
  634. ;
  635. edloop:    call    curon
  636.     xor    a
  637.     ld    (capflag),a    ; set cap flag to no
  638.     ld    c,a        ; initialize character count
  639.     ld    a,b        ; get count
  640.     cp    3        ; state?
  641.     jr    nz,edlp1    ; no
  642. edlp0:    ld    (capflag),a    ; set caps flag
  643. ;
  644. edlp1:    ld    a,(capflag)    ; check caps flag
  645.     or    a
  646.     jr    z,edlp2        ; get exact input
  647.     call    capin        ; get caps input
  648.     jr    edlp3
  649. edlp2:    call    cin        ; get character
  650. edlp3:    call    isctrl        ; is it a control character?
  651.     jr    z,edcase    ; yes
  652. ;
  653. alpha:    push    af        ; no
  654.     inc    c
  655.     ld    a,c        ; check to see if you've reached the maximum
  656.     cp    b        ; number of characters
  657.     jr    z,noroom
  658.     call    stndout
  659.     ld    a,(insflg)    ; check for insert mode
  660.     or    a
  661.     jr    z,alpha1    ; no
  662. ;
  663.     push    hl        ; save string pointer
  664.     push    bc        ; save counter
  665.     ld    a,b        ; get max characters
  666.     sub    c        ; find number of characters to move
  667.  
  668.     dec    a
  669.     or    a
  670.     jr    z,alpha0
  671.  
  672.     ld    c,a
  673.     ld    b,0
  674.     add    hl,bc        ; hl = last byte in string
  675.     ld    d,h        ; de points to character destination
  676.     ld    e,l
  677.     dec    hl        ; hl points to character
  678.     lddr            ; shift line right
  679.     inc    hl
  680.     call    vpstr        ; display shifted line
  681.  
  682. alpha0:    pop    bc        ; restore counter
  683.     pop    hl        ; restore string pointer
  684.     call    movcur        ; restore cursor
  685. ;
  686. alpha1:    pop    af
  687.     ld    (hl),a        ; add to string
  688.     inc    hl        ; update string pointer
  689.     call    cout        ; handle alphanumeric characters normally
  690.     call    stndend
  691.     call    currt        ; update cursor position
  692.     jr    edlp1        ; get next character
  693. ;
  694. noroom:    pop    af
  695.     call    beep
  696.     dec    c
  697.     jr    edlp1
  698. ;
  699. ; parse edloop command table
  700. ;
  701. edcase:    ld    de,edtbl
  702.     call    acase3
  703.     jr    edlp1        ; return from match routines
  704. ;
  705. eddun:    ;;;push    af
  706.     ;;;call    curoff
  707.     ;;;pop    af
  708.     pop    iy        ; discard local return address
  709.     ret
  710. ;
  711. edtbl:    db    17        ; number of cases
  712.     dw    termky        ; no other match
  713.     db    esc        ; esc - finish add/edit
  714.     dw    eddun
  715.     db    ctrlw        ; ^W same as esc
  716.     dw    eddun
  717.     db    ctrlq        ; ^Q to exit without saving edit
  718.     dw    eddun
  719.     db    ctrle        ; ^E - move to previous field
  720.     dw    eddun
  721.     db    cr        ; cr - next field
  722.     dw    eddun
  723.     db    tab        ; tab - next field
  724.     dw    eddun
  725.     db    ctrlx        ; ^X - next field
  726.     dw    eddun
  727.     db    ctrlg        ; ^G - delete character at cursor, shift
  728.     dw    delchr        ;      rest of line left
  729.     db    ctrlt        ; ^T - delete word right
  730.     dw    delwrt
  731.     db    ctrlv        ; ^V - toggle insert character mode
  732.     dw    insert
  733.     db    ctrly        ; ^Y -- erases from cursor to end of line
  734.     dw    eralin
  735.     db    del        ; cursor left
  736.     dw    lcurs
  737.     db    ctrls        ; ^S - cursor left
  738.     dw    lcurs        ; BS - cursor left
  739.     db    bs        ; ^H - cursor left
  740.     dw    lcurs
  741.     db    ctrld        ; ^D - cursor right
  742.     dw    rcurs
  743.     db    ctrla        ; ^A - word left
  744.     dw    wrdlft
  745.     db    ctrlf        ; ^F - word right
  746.     dw    wrdrt
  747. ;
  748. ; check for terminal arrow keys
  749. ;
  750. termky:    push    hl        ; save pointer
  751.     ld    hl,(tcap)    ; get tcap address
  752.     cp    (hl)        ; is it up arrow?
  753.     jr    nz,termky0    ; no, jump
  754.     ld    a,ctrle        ; yes, convert to ^E and quit
  755.     pop    hl
  756.     jr    eddun
  757. termky0:inc    hl        ; move to next char in tcap
  758.     cp    (hl)        ; is it down arrow?
  759.     jr    nz,termky1    ; no, try next one
  760.     pop    hl        ; yes, quit
  761.     jr    eddun
  762. termky1:inc    hl        ; move to next char in tcap
  763.     cp    (hl)        ; is it right arrow?
  764.     jr    nz,termky2    ; now, try next one
  765.     pop    hl        ; yes, jump to rcurs
  766.     jr    rcurs
  767. termky2:inc    hl        ; move to next char in tcap
  768.     cp    (hl)        ; is it left arrow?
  769.     jr    nz,akdun    ; no, quit
  770.     pop    hl        ; yes, jump to lcurs
  771.     jr    lcurs
  772. akdun:    pop    hl        ; restore pointer
  773.     ret
  774. ;
  775. lcurs:    xor    a        ; move cursor left
  776.     cp    c        ; if c=0, beep
  777.     jp    z,beep        ; and quit
  778.     dec    c        ; else decrement character count
  779.     dec    hl        ; move pointer
  780.     jr    curlf        ; decrement cursor position
  781. ;
  782. insert:    ld    a,(insflg)
  783.     cpl
  784.     ld    (insflg),a
  785.     or    a        ; set?
  786.     jr    z,delins    ; cancel insert msg
  787.     call    gxymsg
  788.     db    01,40,1,'Ins',2,0 ; Insert message
  789.     jr    movcur        ; restore cursor
  790. ;
  791. delchr:    push    hl        ; save cursor position
  792.     push    bc        ; save count
  793.     call    stndout
  794.     ld    d,h
  795.     ld    e,l        ; position in de
  796.     inc    hl        ; point to next character
  797. dellp:    ld    a,(hl)        ; get next character
  798.     ldi            ; move it
  799.     call    cout        ; display it
  800.     or    a        ; check for end of field
  801.     jr    nz,dellp
  802. deldun:    ld    a,' '
  803.     call    cout        ; cover last moved character
  804.     call    stndend
  805.     pop    bc        ; restore count
  806.     pop    hl        ; restore cursor position and fall thru
  807. ;
  808. movcur:    push    hl        ; move cursor to position stored
  809.     ld    hl,(cpos)    ; in cpos
  810.     call    gotoxy
  811.     pop    hl
  812.     ret
  813. ;
  814. delwrt:    ld    a,(hl)        ; delete word right (^T)
  815.     cp    ' '        ; if a=space, delete it and quit
  816.     jr    z,delchr
  817.     or    a        ; quit if a=null
  818.     ret    z
  819.     call    delchr        ; otherwise delete character and repeat
  820.     jr    delwrt
  821. ;
  822. delins:    xor    a        ; delete insert msg and reset flag
  823.     ld    (insflg),a
  824.     call    gxymsg
  825.     db    01,40,1,'   ',2,0
  826.     jr    movcur
  827. ;
  828. rcurs:                ; cursor right
  829.     xor    a        ; check character at pointer (before it's
  830.     cp    (hl)        ; incremented).  Is it null (end of string)?
  831.     jp    z,beep        ; yes, so beep and quit
  832.     inc    c        ; no, so bump character count
  833.     inc    hl        ; increment pointer
  834. ;
  835. currt:    push    hl        ; increment cursor location in cpos
  836.     ld    hl,(cpos)
  837.     inc    l
  838.     jr    svcur
  839. ;
  840. curlf:    push    hl        ; decrement cursor location in cpos
  841.     ld    hl,(cpos)
  842.     dec    l
  843. svcur:    ld    (cpos),hl
  844.     pop    hl
  845.     jr    movcur
  846. ;
  847. eralin:                ; erase from cursor to end of line
  848.     push    bc        ; save bc
  849.     ld    a,b
  850.     sub    a,c        ; how many spaces to end of field?
  851.     ld    b,a        ; number of spaces to underscore
  852.     push    bc        ; save count
  853.     call    pad
  854.     pop    bc        ; restore count
  855.     push    hl        ; save field pointer
  856.     call    clean        ; fill remainder of field with 0's
  857.     pop    hl        ; restore field pointer
  858.     pop    bc
  859.     jr    movcur        ; restore cursor to original position
  860. ;
  861. wrdlft:    call    lcurs        ; move one char left
  862. wrdlf0:    xor    a
  863.     cp    c        ; if count = 0, stop
  864.     ret    z
  865.     call    lcurs        ; move again until space character found
  866.     ld    a,' '
  867.     cp    (hl)        ; if char=space, move cursor right one char
  868.     jr    z,rcurs        ; and quit
  869.     jr    wrdlf0        ; else keep going
  870. ;
  871. wrdrt:    xor    a        ; move cursor one word right
  872.     cp    (hl)        ; if char=null, quit
  873.     ret    z
  874.     ld    a,' '
  875.     cp    (hl)        ; if char=space, move cursor right one char
  876.     jr    z,rcurs        ; and quit
  877.     call    rcurs        ; else keep going
  878.     jr    wrdrt
  879. ;
  880. iniblk:    ld    hl,edblk    ; zeroes everything in the
  881.     ld    b,255        ; editing block
  882. clean:    ld    (hl),0
  883.     inc    hl
  884.     djnz    clean
  885.     ret
  886. ;
  887. ckeoi:    ld    de,(recptr)    ; get current index record pointer
  888.     ld    hl,(xrecptr)    ; get last index record pointer
  889.     jp    comphd
  890. ;
  891. ; exit from program if we don't have any non-deleted records
  892. ;
  893. ckdel:    ld    hl,(first)    ; first index record
  894.     ld    de,10        ; offset to deleted record byte
  895. cdloop:    add    hl,de        ; point to deleted record byte
  896.     ld    de,(order)
  897.     call    comphd        ; end of index without a match?
  898.     jp    nc,exit        ; file has all deleted records or is empty
  899.     ld    a,(hl)        ; get byte
  900.     cp    on        ; good record?
  901.     ret    nz        ; yes, we can continue
  902.     ld    de,16        ; point to next record
  903.     jr    cdloop
  904. ;
  905. ; check to see if record is deleted
  906. ;
  907. delrec:    ld    hl,edblk
  908.     ld    a,(hl)
  909.     inc    a
  910.     ret
  911. ;
  912. wrtinc:    call    setdma        ; hl points to dma
  913.     ld    de,fcb
  914.     call    f$write        ; writes one 128 byte record
  915.     jp    nz,wrterr
  916.     ld    a,(newflg)    ; is it a new record?
  917.     or    a        ; if not, don't inc fptr
  918.     ret    z
  919.     jr    incfptr        ; increment file pointer
  920. ;
  921. rwrite:    call    setdma
  922.     ld    hl,(fptr)
  923.     ld    de,fcb
  924.     call    r$write
  925.     jp    nz,ermgr1
  926. ;
  927. incfptr:ld    hl,(fptr)
  928.     inc    hl
  929.     ld    (fptr),hl    ; increment file pointer
  930.     ret
  931. ;
  932. ; read one data record (two file records)
  933. ; increment file record pointer
  934. ;
  935. riread:    call    mvrptr        ; increment record pointers
  936. ;
  937. ; (fptr) has record number
  938. ;
  939. rread:    ld    hl,edblk
  940.     call    rrdinc        ; read first record
  941.     ld    hl,edblk1    ; reset hl and fall through
  942. ;
  943. ; read one random record
  944. ;
  945. rrdinc:    call    setdma
  946.     ld    hl,(fptr)
  947.     ld    de,fcb
  948.     call    r$read
  949.     jp    nz,ermgr1
  950.     jr    incfptr        ; increment file pointer
  951. ;
  952. ; display b standout spaces
  953. ;
  954. pad:    call    stndout        ; set standout
  955.     ld    a,' '        ; character to pad
  956. padchr    equ    $-1
  957. pad0:    dec    b        ; b has byte count on entry
  958. ;
  959. ploop:    call    cout
  960.     djnz    ploop
  961.     call    stndend
  962.     ld    a,(termf)    ; check for termination character
  963.     or    a
  964.     ret    z
  965.     jp    cout
  966. ;
  967. ; chkdrv and setua
  968. ;
  969. chkdrv:    or    a        ; is it default?
  970.     jr    nz,gotdrv    ; (no)
  971.     ld    c,25        ; get default
  972.     call    bdos
  973.     inc    a        ; a=0 changed to a=1
  974. gotdrv:    add    a,40h        ; make it printable
  975.     ret
  976. ;
  977. setua:    ld    e,a
  978.     ld    c,32
  979.     call    bdos
  980.     xor    a        ; set a to 0
  981.     ret
  982. ;
  983. clrmnu:    call    at        ; clear menu line
  984.     db    24,1
  985.     call    ereol
  986.     jp    vprint        ; display trailing menu message
  987. ;
  988. getchar:call    curon        ; get keyboard input at prompt/message
  989.     call    capin
  990.     push    af
  991.     call    curoff
  992.     pop    af
  993.     ret
  994. ;
  995. ;
  996. beep:    ld    a,bel        ; beeps
  997.     jp    cout
  998. ;
  999. ;    error handlers and messages
  1000. ;
  1001. nogood:    call    vprint
  1002.     db    'Can''t open file',0
  1003.     jp    exit
  1004. ;
  1005. noclk:    call    vprint
  1006.     db    bel,'No clock/bad clock.',cr,lf,lf
  1007.     db    'Enter today''s date:',cr,lf
  1008.     dc    '  Month (MM): '
  1009.     ld    de,today+1        ; point to month
  1010.     call    getdat
  1011.     call    vprint
  1012.     dc    cr,lf,'    Day (DD): '
  1013.     inc    de            ; point to day
  1014.     call    getdat
  1015.     call    vprint
  1016.     dc    cr,lf,'   Year (YY): '
  1017.     dec    de            ; point to year
  1018.     dec    de
  1019. getdat:    ld    hl,datbuf
  1020.     ld    b,2
  1021. getdat0:call    cin
  1022.     cp    3
  1023.     jp    z,exit2
  1024.     call    cout
  1025.     ld    (hl),a
  1026.     inc    hl
  1027.     djnz    getdat0
  1028.     ld    (hl),0
  1029.     dec    hl
  1030.     dec    hl
  1031.     push    de
  1032.     call    eval10
  1033.     pop    de
  1034.     call    binbcd
  1035.     ld    (de),a
  1036.     ret
  1037. ;
  1038. ;
  1039. wrterr:    call    errmsg
  1040.     dc    'Write'
  1041.     jr    errend
  1042. ;
  1043. ermgr1:    call    errmsg        ; random read error handler
  1044.     dc    'Read'
  1045. ;
  1046. errend:    call    vprint
  1047.     dc    ' Error'
  1048.     jp    menu
  1049. ;
  1050. errmsg:    call    gxymsg        ; common error message
  1051.     dc    22,1,bel,0
  1052.     jp    vprint
  1053.