title RGEN generate report definition file ; ; ; equates for assembly ; INCLUDE RSOPT.INC ; entry imdos,fopen,fmake,dskset,eosdsk,defdma,curdma entry cfddt,cfccp,ixpret entry keydes,fldlns,decoff,snline,nmflds,slflds,formdk entry array2,array3,array4,array5,fnames,itmpl5,linem4 IF KANA entry kocahl ENDIF ; IOPACK ext ourwid ;screen width ext initio ;init the i/o package ext mycur ;cursor position ext wtline ;force line display ext endcur ext clears ;clear screen ; USER1 ext hite ;screen height ext pbgmem ;free space start ; ARRAY ext lcarr0 ;special locate item for Kana ext select,reselect ;select item from an array ext locate,locahl ;locate an item in an array ext sortarray ;sort array ext editarray ;edit array ext dsptxt ;display text ext getans ;display a message and get an answer ext copyhl,cmpde ext subde,movehl ext dsptch ext help,xhelp ;help toggles ext gtnisk,gtnlsk ;get number of items, lines to skip into ACC ext gtlncl ;get line and item number of cursor position ext linel0 ;get line length ext fldst ;point start of item that cursor is in ext error,error1 ;display error message ext error3 ext erchar ;put error into message and display ; RGMSG ext srcbuf ;search buffer ext helpm0 ;underline ext helpm1,helpm2 ;help lines ext helpm3,helpm4 ext helpm5,helpm6 ext helpm7,helpm8 ext helpm9 ext statm1,statm2 ;status line messages ext statm3 ext rptm01,rptm02 ;screen 0 text ext rptm03 ext filem1,filem2 ;screen 1 text ext filem3,filem4 ext fldm01,fldm02 ;screen 2 text ext fldm03,fldm04 ext fldm05,fldm07 ext fldm08,fldm09 ext summ01,summ02 ;screen 3 text ext summ03,summ04 ext summ05,summ06 ext exitm1,exitm2 ;screen 4 text ext ctinit ;initial value in count array ext chars1 ;ok character lists ext char2a,char2b ext char3a,char3b ext crlfms ext snameb ;summary name buffer ext rpfile,refile ;file name of other programs to chain ext nofldn,noname ; no field name ext intmsg ; (intermediate field) ; FIRST ext signon,idtex ext coprit ; FORMRG ext gtform ;get form name ext ckform ;check if form there ext ckfree ;check free space ext fncnt ;report name buffer length ext fname ;report name ext dsform ;read DataStar form ext indptr,addbase ;convert indirect message pointer and add message base ext stackp ;set stack pointer ext chain ;chain next program ext stkptr ;saved stack pointer ext curdsk ;current disk ext freest ;free space start ext nxfree ;next free space ext exit ;go back where you came from ext clused ;number of columns ext mkform ;make form ext upper ;convert to upper case ext setdsk ;set current disk ext rpname ;report name ext spaces ;32 spaces ext copyright ;long copyright page 60 ; ; equates ; bdos equ 5 selecf equ 14 openf equ 15 search equ 17 serchn equ 18 creatf equ 22 renamf equ 23 getdsk equ 25 setdma equ 26 defbuf equ 80H frn equ 32 escape equ 1BH cr equ 0DH hole equ '_' IF HILITE remvid equ 7FH ;true for HIGHLIGHTING fieldl equ 32 ;true for HIGHLIGHTING invbit equ 80H ;true for HIGHLIGHTING ENDIF IF ATEBIT remvid equ 0FFH ;true for 8 BIT CHAR SET fieldl equ 33 ;true for 8 BIT CHAR SET fldlen equ 32 ;true for 8 BIT CHAR SET invbit equ 0 ;true for 8 BIT CHAR SET ENDIF arrays equ 0FFH ;array start flag arraye equ 0FFH ;array end flag blinkc equ 0FEH ;code to blink on cursrc equ 0FDH ;code to put cursor on fnamel equ 8 summl equ 4 nitpl1 equ 8 ;number of items per line nitpl2 equ 2 nitpl3 equ 2 nitpl4 equ 1 keydsl equ 121 ;maximum size key descriptor block maxfld equ 250 ;maximum number of fields nmdsks equ 16 ;number of disk drives in CP/M flnmsk equ 3FH ;field name length mask mc equ 0 ;count, message al equ mc+1 ;another list sc equ al+1 ;set cursor position sa equ sc+1 ;set current array da equ sa+1 ;display array dr equ da+1 ;do routine ce equ dr+1 ;conditional end cs equ ce+1 ;clear to screen end & end list el equ cs+1 ;list end ctlc equ 3 ctll equ 0CH ctln equ 0EH ctlp equ 10H ctlt equ 14H ctlv equ 16H page ; ; come from external program ; ixpret: sta chainf ;set chain flag mov a,c call setdsk ;restore current disk jmp cfall ; ; come from ddt ; cfddt: xra a sta defbuf ;no command line ; ; come from ccp ; cfccp: xra a sta chainf ;clear/set chain flag cfall: call stackp call initio ;init i/o package shld freest ;free space start call initus ;init ourselves lxi h,scrn0 call dsptxt ;display screen 0 call wtline ;make sure signon displays lda chainf ora a cz copyright ;display copyright unless we chained jmp rgen01 ; ; get report name ; rgen0: call initus ;init ourselves lxi h,scrn0 call dsptxt ;display screen 0 call wtline ;make sure signon displays rgen01: call gtform ;get the form name call ckform ;check if there jz rgen01 ; ; select file to report on ; rgen1: call rdfrms ;read files available lxi b,scrn1 lxi d,filname ;where to put selection lhld macaddr ;cursor address in file name array call select ;select a file xra a sta defbuf ;clear for ^P mov a,c ;can be ^C, ^L, cr, or ^P cpi ctll jc exit jz logdsk cpi cr jnz rgen0 ;start over for ^P page ; ; select fields to report on ; rgen2: call rdflds ;read fields available jc rgen1 ;jif no fields in that file rgen21: call iscrn2 ;init screen 2 rgen22: lda entoff lxi b,scrn2 lhld putaddr xchg lhld macaddr call reselect ;select a field call ckchar ;check character in C and do what has to be done jz rgen22 ;do another push b ;save exit character call rmholes ;remove holes in array3, return Z set if no items pop b mov a,c ;get exit character, ^C, ^N, ^P jnz rgen23 ;jif at least one item selected cpi ctln jc exit ;^C => abort if no fields selected jnz rgen1 ;^P => go back to previous screen if no fields selected lxi h,fldm07 ;^N => error message if no fields selected call error jmp rgen21 ;continue ; ; at least on field selected, check command: ^C, ^P, ^N ; rgen23: cpi ctln jc rgen32 ;^C => exit jz rgen3 ;^N => go to summary/exit screen lxi h,fldm08 ;^P => previous screen, make sure it's ok mvi b,2 call getans jz rgen1 ;it's ok, do it jmp rgen21 ;it was a mistake, continue page ; ; select summaries to report on ; rgen3: lxi b,scrn3 lhld macaddr IF KANJI lxi d,defbuf ;use default buffer as destination buffer ENDIF call editarray mov a,c ;^C, ^N, ^P cpi ctlp jz rgen21 ; ; exit menu ; rgen32: lda slflds ora a jz exit ;no fields, just go away lxi h,exitm1 ;exit menu mvi b,1 ;line number call getans ;display and get answer lxi h,rgen4 jmp dsptch ;branch on answer ; rgen4: dw abandon ;A = abandon dw rgen21 ;F = return to field selection step dw chainis ;R = chain REPORT dw save ;S = save form and exit dw chainl ;L = chain REDIT in layout step dw chainr ;E = chain REDIT in file definition step page ; ; exit alternatives ; ; ; chain REPORT ; chaini: xra a lxi h,rpfile ;file to chain jmp chain2 ; ; chain REDIT in file edit step ; chainr: xra a jmp chain1 ; ; chain REDIT in layout step ; chainl: mvi a,1 chain1: lxi h,refile chain2: push psw ;save chain flag call mkform ;write the form pop psw jmp chain ;chain the next program ; ; save report and exit ; save: call mkform ;write the form call clears call initus xra a sta defbuf ;for save and abandon jmp rgen01 ;done ; ; abandon the whole thing ; abando: xra a sta defbuf ;for save and abandon mvi b,2 ;line number lxi h,exitm2 ;..are you sure? call getans jz rgen0 ;Z set if answer was Y jmp rgen3 ;continue page ; ; init ourselves ; initus: xra a sta help sta xhelp sta slflds ;this must be here so clused will work the first time lhld freest shld nxfree shld keydes lxi b,keydsl call ptfree ;allocate key descriptor block lxi b,maxfld ;maximum number of fields shld fldlns ;field length table call ptfree shld decoff call ptfree ;make decimal offset table for edit mask call ptflag ;put array flag shld array1 ;set array start shld fnames ;field names go here lda hite dcr a sta lstln1 sta lstln3 sta lstln4 sta lstln5 sta lstln6 lda ourwid dcr a sta lstcl1 sta lstcl2 sta lstcl3 sta lstcl4 sta lstcl5 sta lstcl6 ret page ;**************************************** ; ; get file name array ; ;**************************************** rdfrms: lhld array1 shld nxfree ;set for ^R lxi h,nline1 ;number of lines for file names mvi m,0 ;number of forms lxi d,0 ;count user 0 in E, total count in D (for MPM) push d ;keep on stack mvi b,1 mvi c,search rdfrm1: lxi d,srcbuf ;search buffer call imdos inr a jz rdfrm3 ;no more forms, put end marker dcr a ani 3 rrc rrc rrc ;shift into high bits mov e,a mvi d,0 lxi h,defbuf ;point file name dad d pop d inr d ;total count mov a,m ;get user number inx h ora a jnz rdfrm2 inr e ;user 0 count mov a,m ori invbit ;set high bit for user 0 mov m,a rdfrm2: push d ;restore conuters to stack call rdfrm8 ;put file name into array mvi c,serchn jmp rdfrm1 page ; ; file have been found, now sort them ; rdfrm3: pop d ;get D = number of files, E = number in user 0 mov a,d ora a lxi h,filem4 jz rdfrm9 ;change logged disk if no files call rdfrm6 ;if more than 1 user, put blank line between call ptflag ;put end flag lxi b,array1 call sortarray ;sort file name array call rdfrm4 ;remove high bits lxi b,array1 ;array to look in lxi h,rpname ;report name mvi a,fnamel ;length call locate ;find position in array that matches string @HL shld macaddr ;memory array cursor address mvi a,0FFH sta nskip1 ;number of lines to skip unknown ret ; ; remove high bits for user 0 ; rdfrm4: lhld array1 lxi d,fnamel rdfrm5: mov a,m inr a rz mov a,m ani remvid mov m,a dad d jmp rdfrm5 page ; ; if more than 1 user, put blank line between ; D = number of files ; E = number for user 0 ; B = number of items left on current line ; rdfrm6: mov a,e ora a rz ;no files in user 0 mov a,d sub e ;number in other user rz ;no files other user cma inr a ani 7 ;get number to fill to end of line adi nitpl1 ;plus another full line mov c,a ;count rdfrm7: lxi h,fldhole ;a field hole call rdfrm8 ;put an empty item dcr c jnz rdfrm7 ret ; ; put item into file name array ; rdfrm8: push b ;item count in B lxi b,fnamel ;form name length call ptfree ;put into free space pop b dcr b rnz lxi h,nline1 inr m mvi b,nitpl1 ;number of items per line ret ; ; no files on current disk, ; change logged disk ; rdfrm9: call chgdsk jmp rdfrms ; fldhol: IF HILITE db 0A0H,0A0H,0A0H,0A0H db 0A0H,0A0H,0A0H,0A0H ELSE db 020H,020H,020H,020H db 020H,020H,020H,020H ENDIF page ; ; put array flag ; ptflag: lxi h,flgptr lxi b,1 ; ; put number of bytes in BC at HL into free space at nxfree ; ptfree: push b ;count push h ;save what to put lhld nxfree ;next free space push h call ckfree ;check for enough free space pop d pop h pop b ;count mov b,c ;** assume < 256 for now (forever??) call copyhl xchg shld nxfree ;reset free space pointer ret ; ; change logged disk ; logdsk: lxi h,filem3 call chgdsk ;change logged disk jmp rgen1 ; ; change disks ; chgdsk: lxi b,100H call error3 ;display message and get responce mov a,c cpi cr rz cpi ctlc jz exit call upper ;convert to upper case sui 'A' cpi nmdsks jc setdsk ;set disk call erchar ;display error jmp chgdsk ;try again page ;**************************************** ; ; init for screen 2 ; ;**************************************** rdflds: lhld fnames shld nxfree ;set in case entered with ^P lxi h,formdk ;point disk drive call dsform ;read field names from DS form jc rdfld2 ;jif can't read call ptarr2 ;put array 2 into memory lda nuflds ;number of useable fields ora a jz rdfld1 ;no non-intermediate fields lhld keydes mov a,m ora a lxi h,fldm09 jz rdfld2 ;jif no key fields lhld array2 call skpint mov a,m cpi arraye jz rdfld1 ;jif all fields are intermediate call asummt ;alloacte summary tables call ptflag ;mark array 3 start shld array3 shld array6 ;same array call ptflag ;mark end xra a sta niskp4 ;number of items to skip sta niskp5 sta slflds ret ; ; no fields in selected file ; rdfld1: lxi h,fldm05 rdfld2: call error stc ret ; ; put array 2 into memory ; ptarr2: call ptflag ;mark array start shld array2 lxi h,nofldn ;no field number call indptr ;get pointer mvi m,'0' ;init field number for no field name inx h mvi m,'0' inx h mvi m,'1' shld noflde ;save end lhld fnames ;field name array mov c,m ;number of names mov a,c sta nmflds sta nuflds ;number of useable fields ora a rz ;jif no fields inx h ;point first field name ptar2a: call ptspaces ;put spaces into memory, return start in DE push h ;save pointer to field name call pntfld ;point to field name call indptr ;in case intermediate or no field name mov b,m ;count inx h ;name call copyhl ;move field name into array call bumpnm ;bump ascii field number pop h call nxtfld dcr c jnz ptar2a call ptflag ;put array end flag ret ; ; point to field name ; decrement nuflds if intermediate field ; pntfld: mov a,m ora a jm pntfl1 ;jif intermediate ora a rnz ;jif field named lxi h,noname ret ; pntfl1: lxi h,nuflds dcr m lxi h,intmsg ret ; ; point next field name ; bump ascii field number for no field name ; return Z set if no more ; nxtfld: mov a,m inx h ani flnmsk ;get rid of flag for intermediate field mov e,a mvi d,0 dad d ret ; ; bump ascii field number ; bumpnm: lhld noflde bumpn1: inr m mov a,m cpi '9'+1 rc mvi m,'0' dcx h jmp bumpn1 ; ; put spaces into free space ; return DE = start ; ptspac: push h ;save name pointer lhld nxfree ;save to return push h push b ;and count lxi h,spaces lxi b,fieldl call ptfree pop b pop d pop h ret page ; ; init for screen 2 ; iscrn2: xra a sta nskip2 ;number of lines to skip sta nskip3 sta nskip6 sta entoff call setvar ;set number of lines etc. in array2, array3 lhld array2 call skpint ;skip intermediate fields shld macaddr ;set cursor at array start ; ; check mode and set accordingly: ; ; vrhelp - variable help line ; okchr2 - ok characters for array 2 ; addfld - unless we're at a deleted item ; ckmode: lhld macaddr IF HILITE mov a,m ;get first byte from field to ACC (hi-bit = deleted) ELSE call getmem ;get deleted byte(33) from field to ACC ENDIF ora a jm ckmod2 ;jif in delete mode call ckmod0 xchg shld putaddr xchg ret ; IF ATEBIT ; ; get extra byte at end of field into ACC to test if the field ; has been blanked/deleted (hi-bit set if so) ; getmem: push h push b lxi b,fieldl-1 dad b ;address extra byte at end of field mov a,m ;load into ACC for testing pop b pop h ret ENDIF ; ckmod0: push h push b call addfld ;reset putaddr to first hole or add a hole pop b pop h ckmod1: push h lxi h,helpm8 shld vrhelp ;set variable help message lxi h,char2a shld okchr2 ;set okchars for array2 pop h xra a ;stay on this screen ret ; ckmod2: push h lxi h,helpm3 shld vrhelp lxi h,char2b shld okchr2 pop h xra a ;stay on this screen ret ; ; skip to next non-intermediate field ; skpint: mov a,m ani remvid cpi '(' rnz push d lxi d,fieldl dad d pop d jmp skpint ; ; add field where cursor is to end of field name array ; returns address in DE ; addfld: call lchole ;locate first hole in array 3 xchg ora a rz ;found a hole, don't have to add a field lhld nxfree dcx h ;array end marker shld nxfree push h ;save address lxi b,fieldl call ptfree pop h push h call clrhl ;clear it call ptflag lxi h,slflds inr m mov a,m pop d ; ; set number of lines for array 3 and array 6 ; setnln: lda slflds sta nline6 push h lhld itmpl3 call stnln1 ;get number of lines in ACC pop h sta nline3 ret ; ; for number of items in ACC ; and items per line in L ; get number of lines in ACC ; divide: stnln1: mvi h,0FFH ;count here add l dcr a ;add divisor minus one to round up stnln2: inr h sub l jnc stnln2 mov a,h ret ; ; set array 2 and array 3 variables ; setvar: lda itmpl2 stvar1: sta itmpl2 sta itmpl3 push h mov l,a lda nmflds call divide ;ACC = nmflds / itmpl2 sta nline2 call setnln ;set nline3 IF HILITE mvi a,fieldl*2 ;number of bytes for displaying fields in a line ELSE mvi a,fldlen*2 ;number of bytes for displaying fields in a line ENDIF call divide ;ACC = 64 / itmpl2 sta iteml2 ;should be 16 or 32 sta iteml3 lxi h,line2 ;assume 2 items per line IF HILITE cpi fieldl ELSE cpi fldlen ENDIF jz stvar2 lxi h,line3 ;line for 4 items per line stvar2: shld linem2 shld linem3 pop h ret ; ; locate first hole in array 3 ; lchole: lhld array3 lchol1: mov a,m cpi arraye rz sui hole ;clear ACC if found a hole rz lxi b,fieldl dad b jmp lchol1 page ; ; allocate summary tables ; ; the first table is array4, the count summaries selected ; there are k+2 entries, where k = number of key fields in the form ; there are summl bytes for each entry ; asummt: lxi d,dstbf1 ;count entry buffer call asumm7 ;init the count entry buffer call ptflag ;put array start flag shld array4 xchg lhld keydes mov a,m ;number of key fields inr a ;one for page inr a ;one for report sta itmpl4 ;set number of items/line mov c,a ;count asumm1: call asumm7 dcr c jnz asumm1 ; ; the next table is array5, the other summaries selected ; there are k+2 entries for each field, where k = number of key fields ; there are summl bytes for each entry ; xchg shld array5 lda itmpl4 sta itmpl5 mov c,a lda nmflds ;number of fields mov b,a xra a sta nskip5 mvi a,hole ;clear entry asumm2: push b ;save # entries per line asumm3: call ptfour ;put 4 characters dcr c jnz asumm3 pop b dcr b jnz asumm2 shld nxfree lxi h,dstbf2 call ptfour ;init the other summaries destination buffer push b ;save number of items in C, 0 in B call ptflag ;mark array end pop b page ; ; the next item is the line mask for the summary arrays ; ; this is the number of spaces between summary items ; shld linem4 shld linem5 push h call ckmem ;check for enough memory dad b ;point end ; ; the next item is the summary name line ; ; entries are the field names padded with 4 spaces ; there is one entry for each key field ; shld snline ;set pointer xchg lhld keydes ;key fields mov b,m ;number of fields asumm4: inx h mov a,m ;field number push h push b ;save number of fields in B lhld array2 lxi b,fieldl ora a cnz asumm8 ;point field name (in array2) xchg call ckmem xchg mov b,c call movehl ;move the field name xchg asumm5: dcr c ;skip padding at end dcx h mov a,m cpi ' ' jz asumm5 inr c inx h mvi a,' ' call ptfour ;put 4 characters mov a,c ;number of characters in name pop b ;restore number of key fields xchg pop h ;key descriptor pointer xthl mov m,a ;put name length into line mask inx h xthl inx h dcr b jnz asumm4 pop b ;line mask pointer lxi h,summ05 ;PAGE call asumm6 ;put into summary name line and line mask lxi h,summ06 ;REPORT call asumm6 xchg mvi m,0 inx h shld nxfree ret ; ; put name (@HL) into summary name line (@DE) and length into line mask (@BC) ; asumm6: call indptr mvi a,0FFH stax b asumm9: ldax b inr a stax b mov a,m stax d inx h inx d ora a jnz asumm9 dcx d xchg mvi a,' ' call ptfour xchg inx b ret ; ; copy count init ; asumm7: xchg call ckfour ;check for enough space xchg lxi h,ctinit ;count array initial string mvi b,summl call copyhl ret ; ; point to array item ; HL = array start ; BC = item length ; ACC = field number ; asumm8: dad b dcr a jnz asumm8 ret ; ptfour: call ckfour ;check for enough space mov m,a inx h mov m,a inx h mov m,a inx h mov m,a inx h ret ; ckfour: push b lxi b,4 call ckmem pop b ret ; ckmem: push h push d push psw call ckfree pop psw pop d pop h ret page ;**************************************** ; ; init for screen 3 ; ;**************************************** ; ; remove holes in select field array ; return Z set if none selected ; mark array5 end with arraye ; rmholes: IF HILITE mov a,m ;see if at a deleted item ELSE call getmem ;see if at a deleted item ENDIF ora a ;set P if must remove incomplete entry lhld putaddr rmhol1: cp dlitm0 ;delete item at HL call lchole ;locate hole ora a jz rmhol1 ;jif found a hole xra a sta nskip3 lxi h,itmpl5 call linel0 ;get line length into HL xchg lhld array5 lda slflds sta nline5 ;number of lines in array ora a rz ;none selected mov b,a ;number of lines rmhol2: mov a,m cpi arraye jnz rmhol3 mvi m,hole ;remove old array ends (in case added more) rmhol3: dad d ;point next line dcr b jnz rmhol2 mvi m,arraye ;mark end ora m ;set NZ lhld array4 shld macaddr ret page ; ; check character in C and do what needs to be done ; 0 = change mode ; ^C = abort ; cr = enter selection ; ^L = toggle length of fields displayed ; ^N = next screen ; ^P = previous screen ; ^T = delete item ; ^V = replace item ; ckchar: xchg shld putaddr xchg shld macaddr ;save current address in array sta entoff mov e,a ;entry offset mvi d,0 call subde ;point entry start mov a,c ;get character cpi ctll jz togdsp ;toggle number of columns in display cpi ctlt jz delitm ;delete item cpi ctlv jz repitm ;replace item cpi cr rnz ;next/previous screen ; ; enter selection ; xra a sta entoff shld macaddr ;reset cursor position call blankf ;blank out field in current array if doing an enter call srcfld ;search for a field not blanked out call ckmode ;change mods if no more fields to select ret ; ; blank out field in array2 ; HL = entry start in array 2 ; blankf: IF HILITE mvi b,fieldl bkfld1: mov a,m ori 080H mov m,a inx h dcr b jnz bkfld1 ELSE push b lxi b,fieldl-1 dad b ;address extra byte at end of field pop b mov a,m ori 080H ;set hi-bit to indicate field is blanked out mov m,a inx h ;leave H,L pointing to next field ENDIF ret ; ; search for first field not blanked out ; srcfld: call srfld1 rnz ;found lhld array2 srfld1: call skpint ;skip to next non-intermediate field mov a,m cpi arraye rz IF ATEBIT call getmem ;get extra byte at end of field ENDIF ora a xchg lxi h,fieldl dad d jm srfld1 xchg shld macaddr ret page ; ; toggle number of columns in display ; togdsp: lda itmpl2 xri 6 call stvar1 ;reset variables xra a ret ; ; delete item at putaddr ; ; remove line in summary array ; remove item from array3 ; restore entry into array 2 ; change modes ; delitm: push h lhld putaddr call dlitm0 ;delete item pop h call resitm ;restore item in array2 call ckmode ret ; ; delete item from array 3 ; HL = item to delete ; dlitm0: xchg call rmsumm ;remove line in summary array lxi h,fieldl dad d ;point next item dlitm1: mov a,m stax d inx h inx d cpi arraye jnz dlitm1 xchg shld nxfree lxi h,slflds dcr m call setnln ;set number of lines in array 3 for screen 2 ret ; ; replace item at putaddr ; repitm: call resitm jmp ckmod1 ; ; restore item at HL ; resitm: IF HILITE mvi b,fieldl rsitm1: mov a,m ani remvid mov m,a inx h dcr b jnz rsitm1 ELSE push b lxi b,fieldl-1 dad b ;address extra byte at end of field pop b mov a,m ani 7FH ;remove blanked/deleted bit mov m,a inx h ;leave H,L pointing to next field ENDIF ret ; ; remove line in summary array corresponding to item at DE ; rmsumm: push h push d push b lxi h,itmpl5 call linel0 ;get line length into HL mov b,h mov c,l lhld array6 mvi a,fieldl ;length to match IF HILITE call locahl ;get item number being removed ELSE call kocahl ;get item number being removed ENDIF ora a lhld array5 cnz asumm8 ;point to line start in array mov d,h mov e,l dad b ;point start of next line rmsmm1: mov a,m cpi arraye jz rmsmm2 ;jif at array end stax d inx h inx d jmp rmsmm1 ; rmsmm2: mvi a,hole rmsmm3: stax d ;clear last line inx d dcr c jnz rmsmm3 pop b pop d pop h ret page ;**************************************** ; ; special case routines ; ; HL = address of cursor in array ; DE = address of entry buffer ; BC = address in array that must be displayed ; ACC= entry offset ; ;**************************************** ; ; for screen 1, put entry into entry buffer ; sparm0: push h push b push psw mov b,a ;entry offset call fldst ;point array element start mvi a,fnamel call sprm01 ;put entry pop psw pop b pop h ret ; ; for screen 2, check for mode change, ; re-locate entry buffer if on a deleted item, ; put entry into entry buffer ; sparm1: push h push b push psw mov b,a ;entry offset call fldst ;point array element start call sprm11 ;returns DE perhaps different pop psw pop b pop h ret page ; ; HL = start of entry that cursor is located at ; DE = start of entry buffer ; B = entry offset ; sprm11: IF HILITE mov a,m ;byte under cursor ELSE call getmem ;get extra byte at end of field entry ENDIF push h lhld macaddr ;last cursor address in array IF HILITE xra m ;set M if moving changing modes ELSE push b lxi b,fieldl-1 dad b ;address extra byte at end of field entry xra m ;test if this or current field is blanked pop b ENDIF pop h cm sprm13 ;do a mode change shld macaddr IF HILITE mov a,m ELSE call getmem ;get extra byte at end of field entry ENDIF ora a jm sprm12 ;set destination buffer if at deleted item mvi a,fieldl sprm01: push d ;save to return sub b mov c,a ;number to clear mov a,b ora a cnz movehl ;move B bytes to destination buffer xchg pop d ;address to return mov a,c ora a rz clrhl: mvi m,hole inx h dcr c jnz clrhl ret ; ; get entry buffer address by locating matching entry in destination array ; sprm12: xchg ;entry start to match -> DE lhld array6 ;array to search IF HILITE mvi a,fieldl ;item length call locahl ;locate in put array ELSE mvi a,fieldl ;item length call kocahl ;locate in put array (KANA) ENDIF xchg ret IF ATEBIT ; ;locate string in DE for array in Hl ; Added here for KANA/HILITE - does not replace LOCAHL in ARRAY.MAC ; kocahl: push d push b mov b,a dcr b ;compare field length's minus KANA blank byte jmp lcarr0 ENDIF ; ; do a mode change ; sprm13: IF HILITE mov a,m ELSE call getmem ;get extra byte at end of field ENDIF ora a jp ckmod0 ;locate/create hole, change modes xchg mvi c,fieldl call clrhl ;clear old entry buffer call ckmod2 ;change modes xchg ret page ; ; for array 2: get lstln2 = last line array can be in ; sparm2: push h push d push b push psw lhld mycur lda hite ;number of lines on screen sub h ;less number used sui 3 ;less 3 lines for 'You have selected...' mov c,a ;number of lines left on screen for 2 arrays -> C lda nline2 mov b,a ; B=# lines in array 2 lda nline3 add b ;number of lines in 2 arrays cmp c cnc bcbya ;allocate in proportion to need (C = B*C/ACC) lhld mycur mov a,c add h dcr a sta lstln2 pop psw pop b pop d pop h ret page ; ; allocate in proportion to need ; i.e. C = B * C / ACC ; bcbya: mov e,a ;divide by xra a ;accumlate mov d,a ;result bcbya1: add b inr d ;assume trial subtract will work sbb e ;trial subtract jnc bcbya2 ;jif accumulation big enough dcr d ;nope ...restore add e bcbya2: dcr c jnz bcbya1 mov c,d ;result dcr d rp inr c ;must be at least 1 ret ; ; for array 3: reset display address in array ; sparm3: push d ;use entry buffer address pop b ret page ; ; init some stuff for screen 3 ; ptbuff = destination buffer ; vxhelp = extra help list ; snameb = summary name buffer ; sparm4: push h push b ;don't save D, we will reset it push psw call gtlncl ;get line number of cursor into B, item number into C push b ;save line number in B mov a,c call sprm51 ;get pointer into summary name line ldax d ;length of item mov b,a lxi d,snameb call copyhl ;move to summary name buffer xra a stax d ;mark end pop b mov a,b ora a lxi h,char3b ;assume we are in summary array lxi d,dstbf2 lxi b,summ02 jnz sprm41 ;jif in summary array lxi h,char3a ;we are in count array lxi d,dstbf1 lxi b,summ01 sprm41: shld okchr5 ;set ok character list xchg shld ptbuff ;set entry buffer xchg mov h,b mov l,c shld vxhelp ;set address of extra help line pop psw pop b pop h ret page ; ; for screen 3, set: ; smhead = summary heading line start ; cursrp = cursor position for summary array ; sparm5: push h push d push b push psw call gtnisk ;get number of items to skip to display the array sta niskp4 sta niskp5 call sprm51 ;skip number of summaries in ACC shld smhead lhld mycur inr h inr h inr h shld cursrp pop psw pop b pop d pop h ret ; ; skip number of summaries in ACC ; sprm51: mov b,a ;number of items to skip lhld linem4 ;line mask xchg mvi c,summl ;item length lhld snline ;summary name line inr b sprm52: dcr b rz ldax d ;spacing inx d add c ;item length push d mov e,a mvi d,0 dad d pop d jmp sprm52 page ; ; for status line, convert number of columns used ; sparm6: push h push d push b push psw call clused ;get number of columns used sta numcol ;save number of columns lxi h,coluse ;where to put call cnvasc ;convert to ascii pop psw pop b pop d pop h ret ; ; convert number in ACC to ascii and put at HL ; cnvasc: lxi d,3 ;3 digits dad d ;point end cnvas1: mvi c,0FFH cnvas2: inr c sui 10 jnc cnvas2 ;ACC/10 -> C, remainder in ACC adi 10+'0' ;convert remainder to digit dcx h mov m,a ;store mov a,c dcr e jnz cnvas1 ret ; ; set nskip6, nskip5 for screen 3 ; sparm7: push h push d push b push psw call gtnlsk ;get number of lines to skip to display the array 5 mov a,m ;get number of lines (nlskip) sta nskip6 sta nskip5 ;not needed but will save a little time pop psw pop b pop d pop h ret page ; ; do open and create in a reasonable way ; fopen: mvi c,openf jmp fstuff fmake: mvi c,creatf fstuff: call imdos ;do it cpi 245 jnc bad ;jif error push h lxi h,frn dad d ;point next record xra a ;set z for success mov m,a ;clear next record pop h ret bad: ora a ret page ; ; imdos simulator ; imdos: push h push b push d mov a,c cpi setdma cz imdos2 sui openf cpi renamf-openf+1 jnc imdos1 ldax d mov b,a ;save the disk call dskset push b call bdos ;do the function pop b pop h ;fcb mov m,b ;restore disk xchg ;put fcb in DE ora a ;test result pop b pop h ret imdos1: call bdos ora a pop d pop b pop h ret ; imdos2: xchg shld curdma ;save for keystroke capture xchg ret ; ; select disk (and clear byte in FCB) ; dskset: push h push d ;save fcb push b ;and function ldax d dcr a ;make into CP/M disk jp dskst1 lda curdsk dskst1: sta eosdsk ;in case error mov e,a mvi c,selecf call bdos ;select disk pop b pop d pop h xra a stax d ;clear disk ret ; defdma: push h push b push d mvi c,setdma lxi d,defbuf jmp imdos1 page ;**************************************** ; ; screen messages ; ; codes for flag word are: ; ; flag: (mc) count, message ; (al) another list ; (sc) set cursor position ; (da) display array ; (dr) do routine ; (ce) conditinal end list ; (cs) clear to screen end & end list ; (el) list end ; (ca) conditional abort ; ;**************************************** ; ; message list for screen 0 ; scrn0: dw sc,0000H dw crms ;line 0 dw signon,crms ;line 1 dw coprit,crms ;line 2 dw crms ;line 3 dw crms ;line 4 dw sc,040BH dw idtex dw cs ; ; message list for screen 1 ; scrn1: dw dr,sparm0 ;get entry buffer dw sc,0000H ;set cursor dw statm1 ;Report name: dw fname ;XXXXXXXX dw statm2 ; File name: dw filname ;XXXXXXXX dw al,helpb1 ;help menu 1 dw al,xhelp1 ;extra help 1 dw filem2 ;Your choice is... dw da,array1 ;file name array with cursor set dw cs ; ; message list for screen 2 ; scrn2: dw dr,sparm1 ;get entry buffer dw al,stline ;status line dw al,helpb2 ;help menu 2 dw al,xhelp2 ;extra help 2 dw fldm02 ;Your field choices are dw dr,sparm2 ;set parameters for array 2 dw da,array2 ;field name array with cursor set dw fldm03 ;You have selected dw dr,sparm3 ;set parameters for array 3 dw da,array3 ;field names selected dw sa,array2 ;set current array dw cs ; ; message list for screen 3 ; scrn3: dw sa,array4 ;set current array dw dr,sparm4 ;set chrlst, ptbuff, vxhelp dw al,stline ;status line dw al,helpb3 ;help menu 3 dw al,xhelp3 ;extra help 3 ptbuff: ds 2 ;current display buffer dw summ03 ;Summaries available dw dr,sparm5 ;set smhead, cursrp smhead: ds 2 ;heading line dw summ04 ;Record count dw da,array4 ;count array dw crlfms dw sa,array5 dw dr,sparm7 ;set nskip6,nskip5 dw da,array6 ;field name array dw sc ;set cursor cursrp: ds 2 ;cursor position dw da,array5 ;summaries selected dw cs ; ; status line ; stline: dw dr,sparm6 ;set columns used dw sc,0000H ;set cursor dw statm1 ;Report name: dw fname ;XXXXXXXX dw statm2 ; File name: dw filname ;XXXXXXXX dw statm3 ; Number of columns used: dw colused ;000,cr dw el ; ; help menu 1 ; helpb1: dw ce,help dw sc,0100H dw helpm0 dw helpm1,helpm2 dw helpm4,helpm6 dw helpm7,helpm0 dw el ; ; help menu 2 ; helpb2: dw ce,help dw sc,0100H dw helpm0 dw helpm1,helpm2 dw helpm5,helpm6 vrhelp: ds 2 ;** variable, helpm8/helpm3 dw helpm0 dw el ; ; help menu 3 ; helpb3: dw ce,help dw sc,0100H dw helpm0 dw helpm1,helpm2 dw helpm4,helpm6 dw helpm9 dw helpm0 dw el ; xhelp1: dw ce,xhelp dw filem1 ;Please make your file selection... dw el ; xhelp2: dw ce,xhelp dw fldm01 ;Please make your field selection... dw el xhelp3: dw ce,xhelp vxhelp: ds 2 ;variable extra help, summ01/summ02 dw el page ;**************************************** ; ; data ; ;**************************************** ; line mask for file name line1: db 2,2,2,2 db 2,2,2,0 ; line mask for 32 character field name line2: db 8,0 ; line mask for 16 character field name line3: db 4,4,4,0 ; ; entry buffers for screen 3 ; dstbf1: ds 4 ;for Y/N db 0 dstbf2: ds 4 ;for TALS db 0 ; formdk: db 0 ;disk drive for file name filnam: ds 8 ;file name buffer ** must follow disk drive ** db 0 coluse: ds 3 ;columns used crms: db cr,0 ;must follow coluse flgptr: db arrays ;array start and end pointer keydes: ds 2 ;key descriptor block fldlns: ds 2 ;field length table decoff: ds 2 ;decimal offset table for edit masks fnames: ds 2 ;pointer to field names table noflde: ds 2 ;pointer to ACSII field number end (for no field name) macadd: ds 2 ;address of cursor in array putadd: ds 2 ;where to put entry entoff: ds 1 ;offset in entry csnum: ds 1 ;current screen number curscn: ds 2 ;current screen address eosdsk: ds 1 ;disk in error chainf: ds 1 ;chain flag snline: ds 2 ;summary name line nmflds: ds 1 ;number of fields nuflds: ds 1 ;number of useable fields slflds: ds 1 ;number of selected fields numcol: ds 1 ;number of columns used curdma: dw defbuf ;for keystroke capture page ; ; array parameter blocks ; ; ; files available, screen 1 display ; array1: ds 3 ;array start and window nskip1: ds 1 ;number of lines to skip in display db 0 ;number of items to skip nline1: ds 1 ;number of lines in array db nitpl1 ;number of items per line db fnamel ;offset to next db fnamel ;item length dw line1 ;line mask dw chars1 ;ok character list lstln1: ds 1 ;last line lstcl1: ds 1 ;last column ; ; fields available, screen 2 display ; array2: ds 3 ;array start and window nskip2: ds 1 ;number of lines to skip in display db 0 ;number of items to skip nline2: ds 1 ;number of lines in array itmpl2: db 4 ;number of items per line (start with 4) db fieldl ;offset to next iteml2: ds 1 ;item length linem2: ds 2 ;line mask okchr2: ds 2 ;ok character list lstln2: ds 1 ;last line lstcl2: ds 1 ;last column ; ; fields selected, screen 2 display ; array3: ds 3 ;array start and window nskip3: ds 1 ;number of lines to skip in display db 0 ;number of items to skip nline3: ds 1 ;number of lines in array itmpl3: ds 1 ;number of items per line db fieldl ;offset to next iteml3: ds 1 ;item length linem3: ds 2 ;line mask dw 0FFFFH ;ok character list (not used) lstln3: ds 1 ;last line lstcl3: ds 1 ;last column ; ; fields selected, screen 3 display ; array6: ds 3 ;array start and window nskip6: ds 1 ;number of lines to skip in display db 0 ;number of items to skip nline6: ds 1 ;number of lines in array db 1 ;number of items per line db fieldl ;offset to next db fieldl ;item length dw line2 ;line mask dw 0FFFFH ;ok character list (not used) lstln6: ds 1 ;last line lstcl6: ds 1 ;last column page ; ; count summaries selected, screen 3 display ; array4: ds 3 ;array start and window db 0 ;number of lines to skip in display niskp4: ds 1 ;number of items to skip db 1 ;number of lines in array itmpl4: ds 1 ;number of items per line db summl ;offset to next db summl ;item length linem4: ds 2 ;line mask dw 0FFFFH ;ok character list (not used) lstln4: ds 1 ;last line lstcl4: ds 1 ;last column ; ; other summaries selected, screen 3 display ; array5: ds 3 ;array start and window nskip5: ds 1 ;number of lines to skip in display niskp5: ds 1 ;number of items to skip nline5: ds 1 ;number of lines in array itmpl5: ds 1 ;number of items per line db summl ;offset to next db summl ;item length linem5: ds 2 ;line mask okchr5: ds 2 ;ok character list lstln5: ds 1 ;last line lstcl5: ds 1 ;last column end