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.Z80 < prev    next >
Text File  |  1993-04-12  |  26KB  |  1,128 lines
  1. ;;; Mods by Al Hawley/Terry Hazen 02/05/92
  2.  
  3. ; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  4. ; *                                  *
  5. ; *                 ZDB                  *
  6. ; *                                  *
  7. ; *             The Z-System Database              *
  8. ; *               Name/Address File Manager          *
  9. ; *                                  *
  10. ; *         (C) 1990, 1991 by Joseph I. Mortensen          *
  11. ; *                                  *
  12. ; *                                  *
  13. ; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  14. ;
  15. ;
  16. ;    Original Author:    Joseph I. Mortensen
  17. ;                4214 Chelsea Ct.
  18. ;                Midland, MI
  19. ;                517-835-6923
  20. ;                Compuserve 70037,3161
  21. ;                GEnie J.MORTENSEN3
  22. ;                Ladera Z-Node
  23. ;
  24. ;    Major Collaborator
  25. ;    and Co-Author:        Terry Hazen
  26. ;
  27. ;    Assembler/Linker:    ZMAC/ZML or Z80ASM/SLRNKP
  28. ;
  29. ;    For documentation see ZDBxx.HLP
  30. ;
  31. vers    equ    18        ; version
  32. suffix    equ    'C'        ; suffix character or ' ' if none
  33. month    equ    04        ; revision month
  34. day    equ    12        ; day
  35. year    equ    92        ; year
  36. ;
  37. ;  the usual equates
  38. ;
  39. ctrla    equ    'A'-40h        ; move cursor one word left
  40. ctrld    equ    'D'-40h        ; move cursor right
  41. ctrle    equ    'E'-40h        ; move cursor up one field
  42. ctrlf    equ    'F'-40h        ; move cursor one word right
  43. ctrlg    equ    'G'-40h        ; delete character
  44. ctrlq    equ    'Q'-40h        ; quit add/edit without saving changes
  45. ctrlr    equ    'R'-40h        ; refresh screen
  46. ctrls    equ    'S'-40h        ; move cursor left
  47. ctrlt    equ    'T'-40h        ; delete word right
  48. ctrlv    equ    'V'-40h        ; insert character mode
  49. ctrlw    equ    'W'-40h        ; quit add/edit and save changes
  50. ctrlx    equ    'X'-40h        ; move cursor down one field
  51. ctrly    equ    'Y'-40h        ; delete from cursor to end of field
  52. ;
  53. bdos    equ    05h
  54. bel    equ    07h
  55. bs    equ    08h
  56. tab    equ    09h
  57. lf    equ    0ah
  58. ff    equ    0ch
  59. cr    equ    0dh
  60. esc    equ    1bh
  61. del    equ    7fh
  62. fcb    equ    5ch
  63. false    equ    00h
  64. true    equ    0ffh
  65. on    equ    true
  66. lstat    equ    15
  67. ;
  68. ; jthlib routines
  69.     .request jthlib
  70.     ext    fnamz
  71. ;
  72. ; zplib routines
  73.     .request zplib
  74.     ext    vprint,vpstr,gxymsg,gotoxy
  75. ;
  76. ; zslib routines
  77.     .request zslib
  78.     ext    mdata1,binbcd
  79. ;
  80. ; dslip routines
  81.     .request dslib
  82.     ext    timini,rclock
  83. ;
  84. ; vlib routines
  85.     .request vlib
  86.     ext    stndout,stndend,at        ;,gxymsg,vprint,vpstr
  87.     ext    cls,ereol,gz3init,@ghl    ;gotoxy
  88.     ext    tinit,dinit,@goxy,curon,curoff,grxon,grxoff
  89.     
  90. ;
  91. ; z3lib routines
  92.     .request z3lib
  93.     ext    zsyschk,gzmtop,waitp1s
  94. ;
  95. ; syslib routines
  96.     .request syslib        
  97.     ext    fxo$open,fxo$close,fx$put
  98.     ext    f$make,f$open,f$close,f$write,getfs
  99.     ext    f$exist,r$write,r$read,setdma,mfn2,f$rename,f$delete
  100.     ext    codend,condin,logud,bios    ; fname,
  101.     ext    isctrl,compb,acase3,ssbini,sort
  102.     ext    capin,cin,cout,pa2hc,phldc,phlfdc,mafdc
  103.     ext    lout,lcrlf,comphd,eval10,pout
  104. ;
  105. ; Program begins here
  106. ;
  107.     jp    start
  108.     db    'Z3ENV'        ; standard z3 header
  109.     db    1        ; type 1 program
  110. z3addr:    dw    0
  111. ;
  112. ; Bios printer ready check flag.  Normally set to on (0ffh) to call the
  113. ; bios list status routine to check for printer ready.    If your system
  114. ; hangs on a call to the bios list status routine, set this flag to 0:
  115. ;
  116. pchkf:    db    on        ; set to 0 to skip bios printer check
  117. ;
  118. ; Character used to terminate data fields
  119. ;
  120. termf:    db    '<'        ; char to terminate fields, 00h if none
  121. ;
  122. ; Default implied CFG filename at 010Dh for use with ZCFNG (8 characters):
  123. ;
  124.     db    'ZDB',vers/10+ '0',vers    mod 10 + '0'
  125.     db    suffix
  126.     db    '  '
  127.     db    0        ; termination
  128. ;
  129. ; Default data file name (16 characters - fill unused positions with
  130. ; spaces):
  131. ;        'duu:filename.typ'
  132. deffn:    db    'ZDB.DTA         '    ; default data file name
  133.     db    0            ; termination
  134. ;
  135. ;; Formfeed Flag -- set to zero for no form feed at end of label printing
  136. ;; session
  137. ;;ffflg:    db    on    ; eliminated in V. 1.8
  138. ;
  139. ; Spare configuration patch space
  140. ;
  141.     ds    2        ; spare configuration patch bytes
  142. ;
  143. ; Printer string patches go here.  Each string must have a length byte.
  144. ; Extra space is provided for longer printer codes.   To eliminate any
  145. ; of these strings, make the first byte 0.  The following are epson
  146. ; fx-85 compatible codes.
  147. ;
  148. ; Printer reset string, sent at start and end of each label/envelope
  149. ; printing session (4 characters maximum):
  150. ;
  151. reset:    db    2        ; length byte
  152.     db    esc,'@'        ; printer reset string
  153.     ds    2        ; extra space
  154. ;
  155. ; Set printer for printing return address.  This string is sent to the
  156. ; printer after it is reset each time the return address is printed
  157. ; (12 characters maximum):
  158. ;
  159. rin:    db    7
  160.     db    0fh        ; set condensed print
  161.     db    esc,'x',1    ; set nlq mode
  162.     db    esc,'p',1    ; set proportional print
  163.     ds    5        ; extra space
  164. ;
  165. ; Set printer for printing main address.  Cancel any return address
  166. ; settings that may require it.  Do NOT use reset, as it will cancel
  167. ; the label form length (12 characters maximum):
  168. ;
  169. ain:    db    9
  170.     db    12h        ; cancel condensed print
  171.     db    esc,'E'        ; set emphasized print
  172.     db    esc,'x',1    ; set nlq mode
  173.     db    esc,'p',1    ; set proportional print
  174.     ds    3        ; extra space
  175. ;
  176. ; Set column for envelope address left margin:
  177. ;
  178. lemarg:    db    40        ; start address at column 40
  179. ;
  180. ; Set column for label address left margin:
  181. ;
  182. llmarg:    db    0        ; 0 for flush left
  183. ;
  184. ; Use return address in label (only if labels are large enough):
  185. ;
  186. lra:    db    0        ; 0 if no return address is desired
  187. ;
  188. ; Set number of lines per label (8 characters maximum):
  189. ;
  190. labln:    db    3
  191.     db    esc,'C',6    ; set lines per label
  192.     ds    5        ; extra space
  193. ;
  194. ; Return address patch goes here.  Space is provided for up to 80
  195. ; characters.  If you plan on using a return address on your labels,
  196. ; add enough line feeds at the end of the return address to bring
  197. ; you to the first line of the label address.  The rest of the
  198. ; line feeds required for an envelope are at 'addrsp'.    For
  199. ; normal business size envelopes, the total number of line feeds
  200. ; must remain 14 and the string must be 0-terminated.  To
  201. ; eliminate the return address, change retadr to a terminating
  202. ; null (00h) and put 14 line feeds at 'addrsp'.
  203. ;
  204. retadr:
  205. line1:    db    'Joseph I. Mortensen'
  206.     db    cr,lf
  207. line2:    db    '4214 Chelsea Ct.'
  208.     db    cr,lf
  209. line3:    db    'Midland, MI 48640'
  210.     db    cr,lf,lf
  211. ;
  212. ; Pad the remainder of the address space with 0's
  213. ;
  214.      rept    80-($-retadr)
  215.     db    0
  216.      endm
  217. ;
  218. ; Space from return address to address.  For normal business
  219. ; envelopes, the total number of line feeds in the return address
  220. ; and addrsp should be 14.  If the number of line feeds in the
  221. ; return address -> first label address line is the normal three
  222. ; lines, addrsp should be set to 10 line feeds.
  223. ;
  224. addrsp:    db    10
  225. ;
  226. ; command line help message
  227. ;
  228. hlpmsg:    call    vprint
  229.     db    'ZDB vers ',vers/10+ '0','.',vers mod 10 + '0'
  230.     db    suffix
  231.     db    ' Name/Addr Database'
  232.     db    cr,lf
  233.     db    '   Syntax:  ZDB [[dir:]datafile.typ] ',cr,lf
  234.     dc    '      Default datafile:  '
  235.     ld    hl,deffn    ; display default filename
  236.     call    vpstr
  237.     call    vprint
  238.     dc    cr,lf
  239.     jp    exit2
  240. ;
  241. ; program starts here
  242. ;
  243. start:    ld    (stack),sp
  244.     ld    sp,stack    ; set up internal stack
  245. ;
  246.     xor    a
  247.     ld    hl,data        ; initialize data area
  248.     ld    de,data+1
  249.     ld    (hl),a
  250.     ld    bc,datalen
  251.     ldir
  252. ;
  253.     ld    hl,(z3addr)    ; check for z3 system
  254.     call    zsyschk
  255.     jp    nz,exit2    ; not present, exit
  256.     call    gz3init        ; initialize vlib stuff
  257.     ld    de,90h        ; add TCAP offset from env
  258.     add    hl,de        ; and 
  259.     ld    (tcap),hl    ; store it for use by edloop
  260.     call    tinit        ; initialize terminal
  261. ;
  262.     ld    a,(fcb+1)    ; check command tail
  263.     cp    '/'        ; asking for help?
  264.     jp    z,hlpmsg    ; yes, print help message
  265.     call    gettim        ; get the time
  266.     jr    z,clkok        ; if ok, jump
  267. nclk:    call    noclk        ; otherwise get date from manual entry
  268. clkok:    ld    a,(fcb)        ; get drive
  269.     call    chkdrv
  270.     ld    (fdrv),a    ; store it
  271.     ld    (datafil),a    ; and in header
  272. ;
  273.     ld    a,(fcb+13)    ; get user for file
  274.     ld    (fusr),a    ; store it
  275. ;
  276. ; if no data file specified, use default datafile name
  277. ;
  278.     ld    a,(fcb+1)    ; check first filename character
  279.     cp    ' '
  280.     jr    nz,reopen    ; filename specified
  281.     ld    de,fcb        ; no filename, use default
  282.     ld    hl,deffn
  283.     call    fnamz        ; parse filename to fcb
  284.     jr    clkok        ;;;aeh
  285. ;
  286. ; after writing a new sorted file, program loops to reopen
  287. ;
  288. reopen:    ld    a,(fusr)    ; set user area for file
  289.     call    setua
  290.     ld    (fcb+12),a    ; set extent to 0
  291.     ld    (fcb+32),a    ; likewise w/ current record
  292.     ld    a,(fdrv)
  293.     sub    a,41h
  294.     ld    b,a
  295.     ld    a,(fusr)
  296.     ld    c,a
  297.     call    logud
  298.     ld    de,datafil+1    ; save user in header
  299.     call    mafdc
  300.     ex    de,hl
  301.     ld    a,':'
  302.     ld    (hl),a        ; store colon
  303.     inc    hl
  304.     push    hl        ; save header pointer
  305. ;
  306. ;  open file
  307. ;
  308.     ld    de,fcb
  309.     call    f$exist        ; check to see if it exists
  310.     jr    nz,open
  311.     call    f$make        ; if not, create and open it
  312.     inc    a
  313.     jp    z,nogood
  314. open:    call    f$open
  315.     jp    nz,nogood
  316.     ld    de,fcb+1    ; save original name in buffer
  317.     ld    hl,nambuf
  318.     call    mfn2
  319.     pop    hl        ; restore header pointer
  320.     call    mfn2        ; save filename
  321. ;
  322.     ld    de,fcb
  323.     call    getfs        ; get file size in records
  324.     ld    (recs),hl
  325.     call    frame        ; do frame and screen layout
  326.     call    index        ; create index
  327. ;
  328.     ld    hl,(recs)    ; save it
  329.     ld    a,h        ; check for empty file
  330.     or    l
  331.     jr    nz,dotop    ; not empty
  332. ;
  333. doadd:    call    curtim        ; display time and date
  334.     ld    a,'A'        ; empty file, so adding new record
  335.     jr    menua        ; is the only choice!
  336. ;
  337. dotop:    call    firstr        ; display first record and wait for cmd
  338. ;
  339. menu:    call    clrmnu        ; main menu line
  340.     db    1,'A=Add C=Call D=Del E=Ed F=Find X=Xfind <>=Prv/Nxt '
  341.     dc    'O=Outp I=Idx ^S=Sort'
  342.     call    qquit
  343. ;
  344. ;  main program loop
  345. ;
  346. main:    call    curtim        ; display current time & date
  347.     call    at
  348.     db    24,79        ; position cursor at '?' in menu line
  349.     call    getchar        ; wait for command
  350. menua:    ld    de,cmdtbl    ; run command thro' command table
  351.     call    acase3
  352.     jr    main
  353. ;
  354. ;  end of main loop
  355. ;
  356. ;
  357. ;  command table
  358. ;
  359. cmdtbl:    db    18        ; no. of entries in command table
  360.     dw    menu
  361.     db    'Q'
  362.     dw    exit
  363.     db    esc
  364.     dw    exit
  365.     db    'A'
  366.     dw    new
  367.     db    'E'
  368.     dw    edit
  369.     db    'D'
  370.     dw    delete
  371.     db    'F'
  372.     dw    find
  373.     db    ','
  374.     dw    prev
  375.     db    '<'
  376.     dw    prev
  377.     db    '.'
  378.     dw    next
  379.     db    '>'
  380.     dw    next
  381.     db    'O'
  382.     dw    output
  383.     db    ctrlr        ; ^r to refresh screen if it gets out of whack
  384.     dw    refscr
  385.     db    ctrls        ; ^s for sort
  386.     dw    asksrt
  387.     db    'I'
  388.     dw    settyp
  389.     db    'T'
  390.     dw    firstr
  391.     db    'X'
  392.     dw    qfind
  393.     db    'B'
  394.     dw    last
  395.     db    'C'
  396.     dw    dial
  397. ;
  398. ;    exit routines
  399. ;
  400. exit:    ld    de,fcb
  401.     call    f$close
  402.     call    curon
  403.     call    dinit
  404. exit2:    ld    sp,(stack)
  405.     ret
  406. ;
  407. ;  main subroutines
  408. ;
  409. ;    screen display routines
  410. ;
  411. frame:    call    curoff        ; turn off cursor
  412.     call    cls        ; clear screen
  413.     call    at        ; do standout header
  414.     db    1,1
  415.     ld    b,66        ; do standout bar
  416.     call    pad
  417.     call    at
  418.     db    2,1
  419.     call    grxon
  420.     ld    b,79
  421.     ld    a,(@ghl)
  422. frloop:    call    cout
  423.     djnz    frloop
  424.     call    at
  425.     db    23,1
  426.     ld    b,79
  427. frlp0:    call    cout
  428.     djnz    frlp0
  429.     call    grxoff
  430. ;
  431.     ld    hl,panel
  432.     ld    b,(hl)        ; enter with hl=panel pointer
  433.     inc    hl
  434. ;
  435. scrnloop:
  436.     call    @goxy
  437.     call    vpstr
  438.     djnz    scrnloop
  439.     ret
  440. ;
  441. refscr:    call    frame        ; refreshes entire screen
  442.     call    currec
  443.     jp    menu
  444. ;
  445. ; display current record number and total
  446. ;
  447. bldisp:
  448. currec:    ld    hl,(recptr)
  449.     call    lhlhl        ; get record number of current record
  450.     call    divhl2        ; divide by 2
  451.     inc    hl        ; make it rel 1
  452. currec0:call    gxymsg
  453.     db    1,45,1,0
  454.     call    phldc
  455.     call    vprint
  456.     dc    ' of '
  457.     ld    hl,(recs)    ; get total number of records
  458.     call    divhl2        ; divide by 2
  459.     call    phlfdc
  460.     call    vprint        ; terminate field and end standout
  461.     dc    '    ',2
  462.     call    clrdis        ; and fall through to displa
  463. ;
  464. ; display current record
  465. ;
  466. displa:    ld    hl,pospanel    ; point to cursor position panel
  467.     ld    de,fieldpanel    ; point to field panel
  468.     ld    b,(hl)
  469.     inc    hl
  470. displaloop:
  471.     call    @goxy        ; position cursor to field start
  472.     inc    hl        ; point to next field
  473.     call    stndout
  474.     ex    de,hl        ; hl=field address
  475.     push    hl        ; save field address pointer
  476.     call    lhlhl        ; get field addr in hl
  477.     call    vpstr        ; display field
  478.     call    stndend
  479.     pop    hl
  480.     inc    hl        ; point to next field
  481.     inc    hl
  482.     ex    de,hl
  483.     djnz    displaloop
  484. ;
  485. newdat:    call    gxymsg        ; displays date
  486.     db    3,66,1,0    ; date location
  487.     ld    hl,datmod+1    ; get month
  488.     call    paslsh
  489.     inc    hl        ; get day
  490.     call    paslsh
  491.     dec    hl
  492.     dec    hl        ; get year
  493.     ld    a,(hl)
  494.     call    pa2hc
  495.     jp    stndend
  496. ;
  497. divhl2:    srl    h        ; divide hl by 2, result in hl
  498.     rr    l
  499.     ret
  500. ;
  501. curtim:    call    gxymsg        ; displays current date and time
  502.     db    1,63,1,0
  503.     ld    hl,today+1
  504.     call    paslsh
  505.     inc    hl
  506.     call    paslsh
  507.     dec    hl
  508.     dec    hl
  509.     ld    a,(hl)
  510.     call    pa2hc
  511.     call    gettim
  512.     jr    nz,notime
  513.     ld    a,' '
  514.     call    cout
  515.     inc    hl
  516.     inc    hl
  517.     inc    hl
  518.     ld    a,(hl)
  519.     call    pa2hc
  520.     ld    a,':'
  521.     call    cout
  522.     inc    hl
  523.     ld    a,(hl)
  524.     call    pa2hc
  525. notime:    jp    stndend
  526. ;
  527. gettim:    call    timini        ; see if there is a clock
  528.     jr    nz,clkfnd
  529.     inc    a
  530.     ret    
  531. clkfnd:    push    hl
  532.     ld    hl,today    ; point to clock buffer
  533.     call    rclock
  534.     pop    hl
  535.     ret    
  536. ;
  537. paslsh:    ld    a,(hl)
  538.     call    pa2hc        ; print date with slash
  539.     ld    a,'/'
  540.     jp    cout
  541. ;    
  542. ; fill record display fields with blanks
  543. ;
  544. clrdis:    ld    hl,pospanel    ; point to cursor position panel
  545.     ld    b,(hl)
  546.     inc    hl
  547. clrloop:
  548.     call    @goxy        ; position cursor to field start
  549.     push    bc        ; save count
  550.     ld    b,(hl)        ; get field length
  551.     call    pad        ; pad field with blanks
  552.     pop    bc        ; restore count
  553.     inc    hl        ; point to next field
  554.     djnz    clrloop
  555.     ret
  556. ;
  557. ;
  558. ; routines for adding, editing, and deleting records
  559. ;
  560. edit:    xor    a        ; edit existing data record
  561.     ld    (newflg),a
  562.     call    decfptr
  563.     call    edita
  564.     jp    wrecs        ; write data record and resort index
  565. ;
  566. new:                ; adding a new record
  567.     call    chkmem        ; check to see if enough memory left        
  568.     jp    c,nomem        ; out of memory, jump to out of memory message
  569.     call    clrdis        ; ok, continue
  570.     call    iniblk        ; initialize edblk
  571.     ld    a,true        ; set "new" flag
  572.     ld    (newflg),a
  573. ;
  574. edita:    ld    hl,today    ; get date from "today"
  575.     ld    de,datmod    ; and move to datmod
  576.     ld    bc,3
  577.     ldir
  578.     call    newdat        ; get the date and display it
  579.     call    clrmnu
  580.     db    1,'^X/TAB/RET=nxt fld  ^E=prv fld  ^S/^D=char l/r'
  581.     dc    '  ^Y=era cursor rt  ESC=exit',2
  582. ;
  583. edfields:
  584.     ld    hl,pospanel    ; point to cursor position panel
  585.     ld    de,fieldpanel    ; point to field address panel
  586.     ld    b,(hl)        ; number of fields
  587.     inc    hl
  588. ;
  589. efloop:    ld    a,(hl)        ; save row position
  590.     ld    (lpos),a
  591.     call    @goxy        ; position cursor
  592.     push    bc        ; save count
  593.     ld    b,(hl)        ; get field length
  594.     dec    hl        ; save column position
  595.     ld    a,(hl)
  596.     ld    (cpos),a
  597.     inc    hl        ; point to next field
  598.     inc    hl
  599.     ex    de,hl        ; hl=field address
  600.     push    hl
  601.     call    lhlhl        ; get field pointer in hl
  602.     push    de
  603.     call    edloop        ; edit field
  604.     pop    de
  605.     pop    hl
  606.     inc    hl        ; point to next field address
  607.     inc    hl
  608.     ex    de,hl        ; hl=next field cursor position
  609.     pop    bc
  610.     cp    esc        ; quit edloop?
  611.     jr    z,term        ; yes, go to end
  612.     cp    ctrlw        ; ^W same as esc
  613.     jr    z,term
  614.     cp    ctrlq        ; ^Q to quit without saving edit
  615.     jr    z,term
  616.     cp    ctrle        ; if ^e, go to previous field
  617.     jr    z,prevf
  618.     djnz    efloop        ; else do next field
  619.     jr    term        ; done
  620. ;
  621. prevf:    or    a        ; clear carry
  622.     push    bc        ; save count
  623.     ld    bc,6        ; back up to previous field cursor pos
  624.     sbc    hl,bc
  625.     ex    de,hl
  626.     ld    bc,4        ; back up to previous field
  627.     sbc    hl,bc
  628.     ex    de,hl
  629.     pop    bc        ; restore count
  630.     inc    b        ; back up one field
  631.     ld    a,(pospanel)    ; get number of fields
  632.     cp    b        ; test for first field
  633.     jr    nc,efloop    ; loop or fall thru if past first field
  634. ;
  635. term:    push    af
  636.     call    delins        ; delete insert msg
  637.     pop    af
  638.     cp    ctrlq        ; exit without saving?
  639.     jr    nz,term1
  640. ;
  641.     ld    a,(newflg)    ; editing an existing record?
  642.     or    a
  643.     jr    nz,xadd        ; add abort
  644.     pop    hl        ; if edit abort, discard return address
  645.     jr    xedit
  646. xadd:    call    ckdel        ; quit if no non-deleted records
  647.     call    decfptr        ; if add abort, back up one
  648. xedit:    call    current        ; redisplay current record
  649.     jp    menu
  650. ;
  651. term1:    
  652.     call    clrmnu
  653.     dc    1,'TAB=restart/[SAVE] ?',2,bs
  654.     call    cin
  655.     cp    tab
  656.     jp    z,edita
  657.     call    curoff        ;;;jth
  658.     ld    a,(newflg)    ; editing an existing record?
  659.     or    a
  660.     ret    z        ; yes, we're done here
  661. ;
  662.     ld    hl,(recs)    ; get number of index records
  663.     ld    (xfptr),hl    ; save it for updinx and to
  664.     ld    (fptr),hl    ; keep track of appended records
  665.     ld    hl,(n)
  666.     ld    (count),hl    ; save number of index records
  667.     call    rwrtblk
  668.     
  669.     call    updinx        ; add new key to index table
  670.     call    inxsrt        ; rebuild order table and sort index
  671.     ld    hl,(recs)    ; increment record count
  672.     inc    hl
  673.     inc    hl
  674.     ld    (recs),hl
  675. ;
  676.     call    clrmnu
  677.     dc    1,'Add another record? [Y]/n ?',2,bs
  678.     call    getchar
  679.     cp    'N'
  680.     jp    nz,new
  681. ;
  682. ; since the index may have been resorted and we only know the
  683. ; current fptr, we need to find the corresponding recptr to properly
  684. ; redisplay the current record at its new location in the index
  685. ;
  686. getrp:    call    decfptr        ; back up one
  687. getrp0:    ld    hl,(first)    ; start of index
  688.     ld    de,14        ; record number offset
  689. ;
  690. recplp:    add    hl,de        ; hl=recptr
  691.     push    hl        ; save recptr
  692.     call    lhlhl        ; hl=fptr for index record
  693.     ld    de,(fptr)    ; de=fptr
  694.     call    comphd        ; does this record have the right fptr?
  695.     pop    hl        ; restore recptr
  696.     ld    de,16        ; offset to next
  697.     jr    nz,recplp    ; not this index record, check next
  698.     ld    (recptr),hl    ; save record pointer
  699.     call    current        ; display record
  700.     jp    menu
  701. ;
  702. ; write 256 bytes to random record
  703. ;
  704. rwrtblk:ld    hl,edblk
  705.     call    rwrite        ; write new record
  706.     ld    hl,edblk1
  707.     jp    rwrite
  708.     
  709. ; delete record
  710. ;
  711. delete:    
  712.     call    clrmnu
  713.     dc    bel,1,'Are you sure?  y/[N] ?',2,bs
  714.     call    getchar
  715.     cp    'Y'
  716.     jp    nz,menu
  717. ;
  718.     ld    a,'D'
  719.     ld    (newflg),a
  720.     call    iniblk        ; fill current record w/ nulls
  721.     ld    hl,edblk
  722.     ld    (hl),on        ; make first byte 0ffh
  723.     call    decfptr        ; decrement file record
  724. ;
  725. wrecs:    call    rwrtblk        ; write 256 bytes to file
  726.     ld    hl,(recptr)    ; get record pointer
  727.     ld    de,14
  728.     sbc    hl,de        ; back up to index pointer
  729.     ex    de,hl        ; pointer in de for movkey
  730.     call    movkey        ; update index key
  731.     ld    de,ssb
  732.     call    sort        ; sort index
  733. ;
  734.     ld    a,(newflg)    ; deleting a record?
  735.     cp    'D'
  736.     jp    nz,getrp    ; exit from edit, so get record pointer
  737.     call    ckdel        ; quit if no non-deleted records
  738.     call    next
  739.     jp    menu
  740. ;
  741. ;    file movement routines
  742. ;
  743. ; find and display next record
  744. ;
  745. next:    call    ckeoi        ; check for end of index
  746.     jr    nz,oknxt    ; not eoi
  747. ;
  748. firstr:    call    gotop        ; set pointer to beginning of file
  749. current:call    rread        ; read current record
  750.     jr    ckrec
  751. ;
  752. oknxt:    call    riread        ; increment pointers, read next record
  753. ckrec:    call    delrec        ; check for deleted record
  754.     jp    nz,bldisp    ; ok, display it
  755.     jr    next        ; deleted, so get next record
  756. ;
  757. ; move to and display last record
  758. ;
  759. last:    ld    hl,(xrecptr)    ; get last index record pointer in hl
  760.     call    savptr
  761.     jr    current
  762. ;
  763. ; move to and display previous record
  764. ;
  765. prev:    call    backup        ; move pointer back
  766.     call    rread        ; read a record
  767.     ld    hl,edblk    ; check first byte to see if it's a
  768.     ld    a,(hl)        ; valid record.  0ffh = deleted record.
  769.     inc    a
  770.     jr    z,prev        ; if deleted, try the previous one
  771.     jp    bldisp
  772. ;
  773. ; get first index record number
  774. ;
  775. gotop:    ld    hl,(first)    ; get start of index table
  776. getpt0:    ld    de,14        ; offset to record number
  777. getptr:    add    hl,de
  778. savptr:    ld    (recptr),hl    ; save record pointer
  779.     call    lhlhl
  780.     ld    (fptr),hl    ; save record number
  781.     ret
  782. ;
  783. ; back up to previous record
  784. ;
  785. backup:    ld    hl,(recptr)    ; get current index record
  786.     or    a        ; clear carry
  787.     ld    de,16        ; back up one index record
  788.     sbc    hl,de        ; get new record pointer
  789.     ld    de,(first)    ; check if past first
  790.     call    comphd
  791.     jr    nc,savit
  792.     ld    hl,(xrecptr)    ; point to last record pointer
  793. savit:    jr    savptr        ; save pointers
  794. ;
  795. ; Increment record pointers
  796. ;
  797. mvrptr:    call    ckeoi        ; check for end of index table
  798.     jr    z,gotop        ; yes, start over
  799. ;
  800. mxrptr:    ld    hl,(recptr)    ; get index record pointer
  801.     ld    de,16        ; point to next
  802.     jr    getptr
  803. ;
  804. ; get contents of hl in hl
  805. ;
  806. lhlhl:    ld    a,(hl)        ; get record number
  807.     inc    hl
  808.     ld    h,(hl)
  809.     ld    l,a
  810.     ret
  811. ;
  812. ; decrement record pointer
  813. ;
  814. decfptr:ld    hl,(fptr)
  815.     dec    hl
  816.     dec    hl
  817.     ld    (fptr),hl
  818.     ret
  819. ;
  820. ; search routines.  uses a revised 'scanner' from syslib which eliminates
  821. ; case sensitivity.  QFIND uses an index in RAM to find file pointers for
  822. ; last names or zip codes, depending on which index is selected.  FIND
  823. ; runs through the file, top to bottom, to do its search.
  824. ;
  825. scanner:
  826. ; main loop
  827. ;
  828. scan:    ld    a,b        ; done if b<c
  829.     cp    c        ; done?
  830.     ret    c
  831. ;
  832. ; scan hl for de for c bytes
  833. ;
  834.     push    bc        ; save registers
  835.     push    de
  836.     push    hl
  837. ;
  838. scanl:    ld    a,(de)        ; get field byte
  839.     cp    'a'        ; capitalize if necessary
  840.     jr    c,scanx
  841.     cp    'z'+1
  842.     jr    nc,scanx
  843.     and    05fh
  844.  
  845. scanx:    cp    (hl)        ; compare with search string character
  846.     jp    nz,nexthl    ; no match
  847. ;
  848. scan2:    inc    de        ; pt to next
  849.     inc    hl
  850.     dec    c        ; count down
  851.     jp    nz,scanl
  852. ;
  853. ;  match
  854. ;
  855.     pop    hl        ; restore registers
  856.     pop    de
  857.     pop    bc        ; old bc
  858.     ret            ; zero flag is set
  859. ;
  860. ; not found yet
  861. ;
  862. nexthl:    pop    hl        ; restore registers
  863.     pop    de
  864.     pop    bc        ; get count
  865.     inc    de        ; point to next in scanned vector
  866.     djnz    scan        ; continue scanning
  867. ;
  868. ; no match!
  869. ;
  870. not$found:
  871.     or    0ffh
  872.     ret
  873. ;
  874. keeplk:    
  875.     call    clrmnu
  876.     dc    1,'Continue search? y/[N] ?',2,bs
  877.     call    getchar
  878.     cp    'Y'
  879.     ret    z
  880.     cp    'C'        ; also allow C for continue
  881.     ret
  882. ;
  883. ; Express search routine
  884. ;
  885. qfind:    call    getkeyf
  886.     ld    hl,(first)    ; point to index base address
  887.     ld    (inxptr),hl    ; store in index pointer
  888.     ld    de,(count)    ; get count
  889.     dec    de        ; subtract one
  890.     ld    (xcount),de    ; save it
  891. ;
  892. qloop:
  893.     push    bc        ; save c=length of search string
  894.     ld    b,14        ; b=length of index key first/last names
  895.     ld    de,srch        ; get search string
  896.     push    hl        ; save index pointer
  897.     ex    de,hl
  898.     call    scanner        ; scan the target
  899.     pop    hl        ; restore index pointer
  900.     jr    nz,nomatch    ; jump if no match
  901.     call    getpt0        ; get file pointer
  902.     call    rread        ; read the record
  903.     call    bldisp        ; display it
  904.     call    keeplk        ; keep looking?
  905.     jr    z,nomatch
  906.     pop    bc
  907.     jp    menu
  908. ;
  909. nomatch:pop    bc
  910.     ld    de,(xcount)    ; get count of records
  911.     ld    a,d
  912.     or    e        ; zero? quit if xcount = 0
  913.     jr    z,nofind    ; no, go again
  914. ;
  915.     dec    de
  916.     ld    (xcount),de    ; decrement record count
  917.     ld    hl,(inxptr)    ; increment index pointer
  918.     ld    de,16
  919.     add    hl,de
  920.     ld    (inxptr),hl    ; save new pointer
  921.     jr    qloop
  922. ;
  923. ; scans the entire record for a match
  924. ;
  925. find:    call    getkeyf
  926.     ld    hl,0        ; set to top of file
  927.     ld    (fptr),hl
  928. ;
  929. rloop:                ; check for end of file
  930.     ld    hl,(recs)
  931.     ld    de,(fptr)
  932.     call    comphd
  933.     jr    nz,okgo
  934. ;
  935. nofind:    call    clrmnu
  936.     dc    bel,1,'Not Found....Press Any Key',2
  937.     call    cin
  938.     call    firstr
  939.     jp    menu
  940. ;
  941. okgo:    call    rread        ; b=no. of bytes to search
  942.     push    bc
  943.     ld    b,253        ; c=length of target
  944.     ld    hl,srch        ; hl points to search string
  945.     ld    de,edblk    ; de points to target
  946.     call    scanner        ; scanner does the job
  947.     jr    nz,lloop    ; z=match
  948.     ld    hl,(fptr)    ; get file pointer
  949.     call    divhl2        ; divide by 2
  950.     call    currec0        ; display record
  951.     call    keeplk        ; continue search?
  952.     jr    nz,loopnd    ; no, quit
  953. lloop:    pop    bc        ; yes, go on
  954.     jr    rloop
  955. ;
  956. loopnd:    pop    bc
  957.     jp    getrp
  958. ;    
  959. ; sort routines
  960. ;
  961. ; set index type        ; do index type as toggle function
  962. ;
  963. settyp:    ld    a,(srttyp)    ; get original type
  964.     or    a        ; is it null (name)?
  965.     cpl            ; toggle it
  966.     ld    (srttyp),a    ; Save new type
  967.     ld    hl,lntyp    ; name index msg
  968.     jr    nz,set0        ; zip, make name
  969.     ld    hl,ziptyp    ; zip index msg
  970. set0:    ld    de,inxtyp    ; move index type to header message
  971.     ld    bc,9
  972.     ldir
  973.     ld    hl,inxmsg    ; point to index message
  974.     call    @goxy        ; position cursor
  975.     call    vpstr        ; display message
  976.     call    index        ; do new index
  977.     jp    firstr        ; and display new first record
  978. ;
  979. ; create index
  980. ;
  981. index:    call    codend        ; get end of code
  982.     ld    (order),hl    ; save in ssb as start of order table
  983.     ld    (first),hl    ; and as address of first record
  984.     ld    hl,0        ; start with first file record
  985.     ld    (fptr),hl
  986.     ld    (count),hl    ; zero the counter
  987. ;
  988. inxlp:    ld    hl,(recs)    ; get number of records
  989.     ld    de,(fptr)    ; check for end of file
  990.     call    comphd
  991.     jr    z,inxsrt    ; we're done, so sort index
  992. ;
  993.     ex    de,hl
  994.     ld    (xfptr),hl    ; save it as last record
  995.     call    rread        ; read next record and increment pointer
  996.     call    updinx        ; update index
  997.     jr    inxlp        ; repeat until done
  998. ;
  999. ; Add new record to index table
  1000. ;
  1001. updinx:    ld    de,(order)    ; point to end of index table
  1002.     call    movkey        ; add key
  1003.     ld    (xrecptr),de    ; save last record number pointer
  1004.     ld    hl,xfptr
  1005.     ld    bc,2        ; move record number to index
  1006.     ldir
  1007.     ld    (order),de    ; save start of next index entry
  1008. ;
  1009. inccnt:    ld    hl,(count)    ; bump counter
  1010.     inc    hl
  1011.     ld    (count),hl
  1012.     ret
  1013. ;
  1014. ; create sorted index
  1015. ;
  1016. inxsrt:    ld    hl,(count)    ; get count
  1017.     ld    (n),hl        ; store in ssb as total
  1018.     ld    hl,(order)    ; pointer to end of index table
  1019.     ld    de,ssb        ; pointer to ssb
  1020.     call    ssbini        ; create order table
  1021.     jp    sort        ; sort index
  1022. ;
  1023. ; Add new key to index table.
  1024. ; On entry, de points to start of next index entry
  1025. ;
  1026. movkey:    ld    a,(srttyp)    ; check index type
  1027.     or    a        ; zip?
  1028.     jr    nz,movzip    ; yes
  1029. ;
  1030.     ld    hl,lname    ; de automatically increments in hmovb
  1031.     ld    bc,9        ; index on first 9 bytes of lname
  1032.     ldir
  1033.     ld    hl,fstnm
  1034. mov5:    ld    bc,5        ; then on first 5 bytes of fstnm
  1035.     ldir
  1036.     ret
  1037. ;
  1038. movzip:    ld    hl,zip
  1039.     ld    bc,9        ; index on 9 zip bytes
  1040.     ldir
  1041.     ld    hl,lname    ; then on first 5 bytes of last name
  1042.     jr    mov5
  1043. ;
  1044. ; Ask if we want to write sorted file
  1045. ;
  1046. asksrt:    
  1047.     call    clrmnu
  1048.     dc    1,'Write Sorted File? y/[N] ?',2,bs
  1049.     call    getchar
  1050.     cp    'Y'
  1051.     jp    nz,menu
  1052.     call    dwf        ; display writing file message
  1053.     ld    hl,srtfnm    ; get sort file name into its fcb
  1054.     ld    de,srtfcb
  1055.     call    fnamz        ;fname
  1056.     ld    a,(fusr)    ; get user for file
  1057.     ld    (sfusr),a    ; store it
  1058.     ld    a,(srtfcb)    ; get drive
  1059.     call    chkdrv
  1060.     ld    (sfdrv),a    ; store it
  1061.     ld    a,(sfusr)    ; set user area for file
  1062.     call    setua
  1063.     ld    (srtfcb+12),a    ; set extent to 0
  1064.     ld    (srtfcb+32),a    ; likewise w/ current record
  1065.     ld    de,srtfcb    ; open sort output file
  1066.     call    f$make
  1067.     jp    nz,nogood
  1068.     ld    hl,0
  1069.     ld    (count),hl    ; zero the count
  1070.     call    gotop        ; get starting record number
  1071. ;
  1072. getrec:    call    rread        ; read record
  1073.     call    mxrptr        ; increment pointers
  1074.     ld    hl,edblk
  1075.     call    setdma
  1076.     ld    a,(hl)        ; skip deleted records
  1077.     inc    a        ; if first byte = 0ffh it's an erased
  1078.     jr    z,nowrt        ; record.
  1079.     ld    de,srtfcb    ; write a record
  1080.     call    f$write
  1081.     ld    hl,edblk1
  1082.     call    setdma
  1083.     ld    de,srtfcb
  1084.     call    f$write        ; write a record
  1085. nowrt:    call    inccnt        ; increment the count
  1086.     ld    de,(n)
  1087.     call    comphd
  1088.     jr    nz,getrec
  1089. ;
  1090. finsrt:    ld    de,srtfcb    ; close sorted file
  1091.     call    f$close
  1092.     ld    de,fcb        ; close original file
  1093.     call    f$close
  1094. ;
  1095.     ld    de,bakfcb    ; check to see if there's a previous
  1096.     ld    hl,bakfil    ; backup file
  1097.     call    fnamz        ; fname
  1098.     call    f$delete
  1099. ;
  1100.     ld    de,fcb        ; give original file the name
  1101.     ld    hl,bakfcb    ; 'backup.dta'
  1102.     call    f$rename
  1103. ;
  1104.     ld    de,fcb        ; put original file name back into
  1105.     ld    hl,nambuf    ; fcb
  1106.     call    fnamz        ; fname
  1107.     ex    de,hl        ; rename the sorted file with the
  1108.     ld    de,srtfcb    ; original file name
  1109.     call    f$rename
  1110. ;
  1111.     jp    reopen        ; reopen the newly sorted file
  1112. ;
  1113. ; compare de.vector to hl.vector for b bytes
  1114. ;    return C if de.vector < hl.vector
  1115. ;
  1116. compv:    ex    de,hl
  1117.     ld    b,16
  1118.     call    compb
  1119.     ex    de,hl
  1120.     ret
  1121. ;
  1122.                 ; file split in two because of ZDE's
  1123.                 ; memory limitations
  1124.     include    zdb18.a        ; remainder of source code
  1125.     include zdb18.b        ; phone dialer module
  1126.     include zdb18.d        ; data area
  1127.     
  1128.     end