;Program name: ZCNFG ;ZCNFG is copyright by A. E. Hawley January, 1988. ;It may be freely distributed, but it must not be sold ;either separately or as part of a package without the ;written consent of the author. ;The author may be reached via electronic mail at the ;Ladera Znode (Znode 2) in Los Angeles, 213-670-9465 ;ZCNFG is released for distribution through the Z-system ;users group, ZSIG. Many Znodes include ZSIG releases ;among their programs available for download. ;Several such nodes are: ; Znode 3, Newton Centre, MA 617-965-7259 ; Znode 45 Houston, TX 713-937-8886 ;See ZCNFG.HST for previous version data and changes. vers equ 1 rev equ 6 ;version date month equ 7 day equ 21 year equ 90 ;Program Function: ;General purpose configuration program. Loads the first block ;of program code, displays current option values, accepts ;interactive user option selections, overwrites the program ;block to make the changes permanent. A configuration data ;file for the target program must be available for loading by ;ZCNFG to provide MENU and HELP screens. See ZCNFG.DOC and ;the sample .SRC files. ;References in CFGSUBS ext b2bcd,clsfil,cin,cout,cpstr,doftyp ext getdr,gua,opnfil, ext range,rdfile,rdrec,setdma,stordt,strcpy ext typlin,wrrec,vcout ;References in CFGLIB .request cfglib ext duscn,fill,fname,inifcb,mpy16,ntspcs,pkgoff ext putzdu,putzfn,putzfs,radbin,rjip,sdelm,sksp,ucase ;from Z3LIB .REQUEST Z3LIB ext getcrt ;from VLIB .REQUEST VLIB ext cls,z3vinit,tinit,dinit,at ;from SYSLIB .REQUEST SYSLIB ext bbline,ma2hc,madc,mafdc,mhl4hc,mhldc ext pa2hc,phl4hc,phlfdc,isprint,isalnum ;For use by other modules public z3env,defdu,colcnt,rowcnt ;For use by the linker public $memry ;For use during debug public begin,signon,init,help,quit,pgmini,badfil public filinit,exit,assist,menlst public ctsrch,ctlcs0,hlp0msg,stack public mnuhlp,sndhlp,sndh_1,end_hlp public gt_cfg,ovrlay,scr_ld,scr_l0 public gtcfg2,gtcfgx,namchk,ovlusr,ovlfcb,ovlfn public testid,tgtdu,tgtbuf public gotolm,gotonm,ldmenl,reloce,mnadj,mnumb,lmnumb public in_fn0,in_fn1,in_fn2,in_fn3,in_fn4 public in_fn5,in_fn6,in_fn7,in_fn8 public ld_fn0,ld_fn1,ld_fn2,ld_fn3,ld_fn4 public ld_fn5,ld_fn6,ld_fn7,ld_fn8 ;define program constants and data locations ;system addresses FCB EQU 5CH TBUF EQU 80H ;SYSTEM BUFFER CREC EQU 20H ;offset to Current Record in an FCB ;offsets in the first page of the target program. ;A 256-byte page is read in from the program to a ;buffer which starts at TGTBUF:. ;The target program header locations z3moff equ 03h ;'Z3ENV' identifies ZCPR3x Utility envtyp equ 08h ;Z3 environment type byte z3eoff equ 09h ;Z3 environment address (0000H) fidoff equ 0Dh ;program identifier, like 'ZCNFG' ;Target program-specific offsets are defined in the programs ;overlay file. idlen equ 5 ;length of 'Z3ENV' string (NOT an offset) ;ASCII definitions ctlc equ 3 bs equ 8 ;backspace ht equ 9 ;horizontal tab lf equ 10 ;line feed cr equ 13 ;carriage return esc equ 1bh ;escape key char spc equ 20h ;space char ;MACROS ;load bc indirect at hl ldbchl macro ld c,(hl) inc hl ld b,(hl) inc hl endm ;load de indirect at hl lddehl macro ld e,(hl) inc hl ld d,(hl) inc hl endm ;load hl indirect at hl ldhlhl macro ld a,(hl) inc hl ld h,(hl) ld l,a endm .SBTTL MAIN ROUTINE PAGE ;========================================================= ; START OF PROGRAM CODE ;========================================================= ezcnfg: jp begin z3mark: DB 'Z3ENV' ;identifies program as ZCPR3x utility DB 1 ;external environment Z3ENV: DW 0 ;this address set by Z3INS or ZCPR33/4 dw ezcnfg ;compatible with type 4 enviroment ;configuration block for THIS program. ZCNFG can ;alter is own default parameters. cnfgid: db 'ZCNFG' ;ID string, null terminated ds 4,0 ;room for 3 more char plus $ or null terminator vsnstr: ds 3 ;room for 3 ascii digit version number altusr: db -1 ;-1 = search default user altdrv: db -1 ;-1 = search default drive tgttyp: db 'COM' ;default tgt file type ovltyp: db 'CFG' ;default configuration data file type scrnln: db 24 ;lines per screen z3inst: db 0 ;install z3env in target if true deftrm: db 0 ;terminator for screen image in CFG file vsndat: ds 3 ;month,day,year - packed bcd timstr: ds 6,0ffh ;room for standard date/time, ;yy mm dd hr min sec ;========================================================= begin: ld (stack),sp ;save system stack pointer ld sp,stack ;set up local stack call init ;set current du, Test for Z3 ld de,signon call typlin call help ;provide help if requested & quit call pgmini ;Get file spec from FCB, open file ;abort with message if bad file spec call filinit ;identify & load the overlay file call scr_ld ;load screen image(s) ;select & set options interactively ;display the screen and the user prompt ;This is a loop whose exit is one of the cases setopt: call z3cls ;clear screen ld de,(simage) ;-> screen image call typlin ;display the screen ld a,(z3msgf) or a jr z,not1z3 call at atprpt: db 19,1 ;prompt near screen bottom not1z3: ld de,prmpt0 ;-> prompt line(s) call typlin ;get user input. Make changes as requested, update the ;screen image and the configuration block. getinp: call cin ;wait for & get user input jr z,getinp ;z = no input yet call ucase ;make upper case call isprint ;printable character? call z,cout ;echo it if so ld hl,(castbl) ;->case table call mcase ;do case, ret to here if no exit jr c,getinp ;on bad cmd, repeat prompt & retry jr setopt ;redisplay screen & prompt after update .SBTTL MENU MANAGEMENT PAGE ;========================================================= ; MENU MANAGEMENT ;========================================================= menlst: ;data which defines the current menu environment ;used by setopt. Changed by menu commands. ;Loaded initially by pgmini routine. lastm: ds 2 ;->previous menu list nextm: ds 2 ;->next menu list simage: ds 2 ;->screen image castbl: ds 2 ;->case table hlpscr: ds 2 ;->help screen emenlst: ;for calc list length ;MENU Environments - lastm,nextm,simage,castbl,hlpscr ;An instance of this 10 byte data structure occurs in ;in the overlay for each menu data item. The objects ;addressed are all located in the overlay. There is an ;overlay for each configuration target (like ZFILER, e.g.) ;========================================================= ;standard data block holds parameters for the current ;menu item. This data is copied from the case table ;and relocated each time a menu item is selected. offset: ds 2 ;->config block data to modify cfgd: ds 1 ;data used by function routine s_addr: ds 2 ;->screen location for this menu item s_list: ds 2 ;->data structure (alt. screen data, e.g) ;========================================================= ;Table of function routines accessed via MCASE, MAPPER ;The function# is an entry in every record of the case table. ;The init entry points are indirectly referenced through ;their positional relation to the update entries. ; update init function#, name, & use fntble: dw in_fn0, ld_fn0 ;0 switch, toggle a bit in a byte dw in_fn1, ld_fn1 ;1 text, change text string, length n dw in_fn2, ld_fn2 ;2 duspec, change default drive/user dw in_fn3, ld_fn3 ;3 hexrad, change a byte or word, HEX radix dw in_fn4, ld_fn4 ;4 decrad, change a byte or word, DECimal radix dw in_fn5, ld_fn5 ;5 textlc, change text, LCase OK, length n dw in_fn6, ld_fn6 ;6 filesp, change all or part of Z3-filespec dw in_fn7, ld_fn7 ;7 togl3, toggle among 001B, 010B, 100B dw in_fn8, ld_fn8 ;8 togltf, toggle a byte true/false (-1/0) fntblx: ;used for error checking on function # range ;========================================================= PAGE mcase: ;searches a case table for a match with the byte in A ;If found, jumps to the associated function routine. ;if not found, searches the built-in menu/control case ;table, the last entry for which is a default routine which ;is unconditionally executed for an unrecognized command. ;The case table structure is ; db n ;n = number of entries in list ; db m ;m = number of bytes per rcrd ;there are n records in the case table in addition to the default ;rcrd: db ; ds 2 ;target address for routine to execute ; ds m-3 ;data bytes passed to the routine ;CALL WITH ; A = char to match for case selection ; HL -> 'case' table ;Jump to Target routine with ; HL -> parameter list (if any) ; DE = Number of bytes in parm list ; BC = Target routine address call ctsrch ;search the case table for identifier jr nc,rfnd ;jump if found, ld hl,ctlcs0 ;..else -> built in command table call ctsrch ;search for control command rfnd: inc hl ;->target address dec de ;bytes remaining ld c,(hl) inc hl dec de ;bytes remaining ld b,(hl) ;bc contains target routine addr inc hl ;->balance of parameter list inc b dec b ;if high byte is 0, this is a call z,fnxlt ;function number to translate push bc ;target address on stack ;if e=0, then there are no parameters, so avoid ;the parameter block load in that case. dec e ;bytes left in record (parameters) ret z ;really a jump to (BC) ;transfer case parameters to standard parameter block push hl push de ld b,d ld c,e ld de,offset ldir call reloc ;add tgtbuf to offset, reloc addresses pop de ;do these need to be preserved???????? pop hl ret ;jump to service routine ;========================================================= PAGE ;========================================================= ;search a case table for a match with the character ;in A. Return HL-> entry if found, and CY reset. ;If NOT found, HL-> NEXT entry and CY is SET. The ;last table searched must be followed with a record ;indicating the routine to execute as a default. In ;the present case, that routine is BADCMD. ctsrch: ld b,(hl) ;number of entries in table inc hl ld e,(hl) ;entry length in de (>=2) inc hl ;->first record ld d,0 tsloop: cp a,(hl) ;is this the desired record? ret z ;..ret NC if so add hl,de ;->next record djnz tsloop ;repeat up to B times scf ;nothing found if CY set ret ;hl -> addr AFTER last table entry ;-------------------------------------------- ;Indexing routine to convert function numbers ;to subroutine addresses for MCASE and MAPPER ;MCASE uses the first address in each table entry, ;MAPPER uses the second for screen initialization. ;CALL WITH ; BC = function number ;RETURN WITH ; HL, DE are preserved ; BC = routine address fnxlti: push hl ;entry for MAPPER ld hl,(fntblx-fntble)/4 or a sbc hl,bc ;function # out of range? jp c,badovl ;oops, if so. CFG file error. ld hl,fntble+2 ;use second addr for init jr fnxlt0 fnxlt: push hl ;entry for MCASE ld hl,fntble ;uses first address fnxlt0: add hl,bc ;index to proper function addr add hl,bc ;..4 bytes per function add hl,bc add hl,bc ld c,(hl) inc hl ld b,(hl) ;routine addr in BC pop hl ret ;-------------------------------------------- ;relocate data as required in the standard ;data block starting at OFFSET ;called by MCASE and MAPPER after the block ;is loaded from the case table. reloc: ld bc,tgtbuf ld hl,(offset) add hl,bc ld (offset),hl ;if (offset) > 0ffh then we are outside the configuration ;block. This must be an erroneous value in the CFG file. or a sbc hl,bc ;recover offset value inc h dec h ;..in H if offset >0ffh jp nz,badovl ;after target pgm data is present as overlay, ;relocate address data at s_addr, s_list. ld de,(relocc) ;relocation constant ld hl,(s_addr) add hl,de ld (s_addr),hl ld hl,(s_list) add hl,de ld (s_list),hl ret ;========================================================= .SBTTL CONTROL ROUTINES PAGE ;========================================================= ; CONTROL ROUTINES EXECUTED FROM MCASE CALLS ;========================================================= gotolm: ;get previous menu ld hl,(lastm) ld e,-1 ;decrement menu number call mnadj ;track the menu number jr ldmenl gotonm: ;Get next menu ld hl,(nextm) ld e,1 ;increment menu number call mnadj ;track the menu number ;load the new menu descriptor at (HL) ldmenl: ld de,menlst ld bc,emenlst-menlst ldir ;relocate the words in menlst ld b,(emenlst-menlst)/2 ld de,(relocc) di ;interupts could mess up data area! ld (reloce+1),sp ld sp,menlst relocl: pop hl ;get an address add hl,de ;relocate reloc2: push hl ;put it back inc sp inc sp ;move to next one djnz relocl reloce: ld sp,0 ;filled in above ei ;allow interupts again ret mnadj: ld a,(lmnumb) ld d,a ld a,(mnumb) add e ;inc or dec, depending on E cp -1 ;going from menu0 to last menu? jr z,setlmn cp d ;going from last menu to menu0? jr z,mnadjx ;no, if z jr c,mnadjx ;no, if c ld d,0 ;..else yes, set menu0 setlmn: ld a,d ;d contains next menu number mnadjx: ld (mnumb),a ;new current menu number ret ;these are initialized at scr_ld mnumb: ds 1 ;current menu number, for error reports lmnumb: ds 1 ;last menu number (first is 0) ;========================================================= badcmd: ;This is the default routine when mcase cannot ;find the command letter in its case table or ;in the built-in menu/control case table. ld de,badmsg call typlin scf ret ;========================================================= ;Normal exit after changes are made and need to be ;saved. Assumes that tgtbuf has been updated before ;writing the first block back to the file. exit: ld a,(z3inst) or a ;allow Z3 installation? jr z,exit1 ;no, if logical false ld hl,(z3env) ;install current ENV address ld (tgtbuf+z3eoff),hl exit1: ld a,(fcb_cr) ;set current record for writing ld (fcb+crec),a ;back the configuration block ld de,tgtbuf call setdma ld de,fcb ;fcb pointer ; xor a,a ; ld (fcb+crec),a ;reset next record to 0 call wrrec ex de,hl ;preserve fcb pointer ld de,tgtbuf+80h call setdma ex de,hl call wrrec ;write second record ld a,(tgtdu) call clsfil ;close the file call z3cls ;clear the screen ;========================================================= quit: ;Here to exit without saving current changes. This is ;effectively an abort. Assumes that the saved stack pointer ;points to a safe execution address. This is the case when ;the program is executed as a normal .com file. ld a,(z3msgf) or a call nz,dinit ;deinit terminal ld sp,(stack) ret ;========================================================= ;Display the information screen in response to '?' ;entered at the menu level. mnuhlp: ld de,(hlpscr) ld hl,(relocc) or a ;reset cy sbc hl,de ;a zero entry? ex de,hl ;hlpscr in hl ret z ;ret if help screen not there. push hl ;preserve help msg pointer call z3cls ;clear screen if possible pop hl ;send text to the screen with prompted pageing ;CALL WITH HL-> null terminated message sndhlp: ld a,(scrnln) ;lines per screen dec a ;allow for prompt line dec a ;allow for prompt line ld b,a sndh_1: ld a,(hl) inc hl or a ;if terminator, jr z,end_hlp ;..then quit call vcout ;else send the byte cp lf jr nz,sndh_1 ;continue if not lf djnz sndh_1 ;else count & continue if not eos push hl ;save message pointer call hpause ;pause at End Of Screen pop hl cp ctlc ;control-c? ret z ;abort help if so jr sndhlp ;do another screen until 0 end_hlp: ;here on message terminator ld a,(z3msgf) or a jr z,hpause ;skip screen stuff if not Z3 call at ;position cursor hlpat: db 24,1 ;row,column (home=1,1) hpause: ld de,psemsg ;'SAK' message + CR call typlin ;send it hpausl: call cin ;wait for, get any char jr z,hpausl ;z = no char yet z3cls: push af ;save the char for caller ld a,(z3msgf) or a call nz,cls ;home & clear scren ld hl,rowcnt ld (hl),0 ;reseet line counter pop af or a ;clear flags ret ;========================================================= .SBTTL ERROR HANDLING PAGE ;========================================================= badovl: ld hl,ovlfn ld de,ovfnam call putzfs ld a,(mnumb) ld de,badmnu call mafdc ld de,ovlmsg call typlin jp quit ovlmsg: db cr,lf,'BAD DATA IN ' ovfnam: db ' ' db ' in the case table for menu #' badmnu: db ' , item ' curitm: db ' ' ;current menu choice dz cr,lf ;========================================================= ;========================================================= .SBTTL USER FUNCTION ROUTINES PAGE ;========================================================= ; FUNCTION ROUTINES EXECUTED FROM MCASE & MAPPER ;========================================================= ; FUNCTION 0 - TOGGLE A SINGLE BIT MAPPED OPTION in_fn0: ;toggles the bit defined by (cfgd) in the byte ;at (offset), then toggles the screen image at ;(s_addr) using the two member list at (s_list) ;CALL WITH HL -> parameter list ;RETURN WITH all registers undefined ld hl,(offset) ;config byte address ld a,(cfgd) ;bit mask ld c,a ;save bit mask in c xor a,(hl) ;toggle config byte into A ld (hl),a ;and put it back and c ;isolate new bit value in A jr togl0 ld_fn0: ;entry for initial screen load ;deposit one of two strings in the screen image, ;The choice of string is based on the value of ;the bit specified by the bit mask. ld hl,(offset) ;config byte address ld a,(cfgd) ;bit mask ld c,a ;save bit mask in c ld a,(hl) ;config byte and c ;isolate the bit togl0: ;shared with initialization ;on entry, A is zero except for one bit position ;which is significant. Z flag is set according to ;the contents of that bit. ld de,(s_addr) ld hl,(s_list) ;hl -> screen data pair call z,skip2z ;skip first data element if false jp move2z ;copy to screen image ;========================================================= ; FUNCTION 1 - PROCESS ASCII STRING ;user input is capitalized (LC is lost) ;get (cfgd) characters from the console. Deposit them in ;the configuration block at (offset) and in the screen image ;at (s_addr). If the entry is null (only a CR), then ;nothing is done. in_fn1: ld a,(cfgd) ;put field size in prompt ld de,ftmsg1 call mafdc ld de,ftmsg call typlin ;ask for new string ld de,tmpscr ld bc,(cfgd) ;string length in bc ld b,0 ld a,-1 ;specify caps to bbline push bc call xfrljn ;user input to temp buffer pop bc ;number of characters jp c,redraw ;for null entry ld hl,tmpscr ;->user input temp buffer ld de,(offset) ldir ;fall through to transfer the string into the screen image ;------------------------- ld_fn5: ;function 5 uses same load as function 1. ld_fn1: ;transfer a string of length C from a source ;in the configuration block to the screen image. ;CALLed from MAPPER ld hl,(offset) ;HL ->config data ld de,(s_addr) ;DE ->screen location ld bc,(cfgd) ;C=number of bytes inc c dec c jp z,badovl ;0 length field must be an error push de ;for justification push bc ;for justification ld b,0 ldir ;transfer the string pop bc ;field width in c pop hl ;->lj text field call ntspcs ;setup spaces, field size for RJIP call rjip ;right justify the text ret ;========================================================= ; FUNCTION 2 - UPDATE A DU SPEC ; Transfer a DU spec from bbline input to screen image, left ; justified in a field of 3. Error if illegal DU. ; Nothing done for a null string entry. in_fn2: ;get the new DU from the user ld de,dumsg call typlin ;send user prompt ld de,dumsg1 ;include '?' if 1-based drive code ld a,(cfgd) ;get flag byte or a ;is it 1-based? call nz,typlin ;if so, send '?' default msg ld de,prmpt1 call typlin ;finish the prompt ld de,tmpscr ;put duspec here push de ld bc,3 ;length of the DU field call xfrlj ;get user input in tmpscr pop hl ;src of duspec to convert jp c,redraw ;for null string entry call xltadu ;translate ascii to D,U in BC ;transfer the new DU to the config block ret nz ;error in d or u ld hl,(offset) ;->user/drive in config block ld (hl),c ;store User inc hl ld (hl),b ;..and the Drive dec hl ;recover pointer jr ldfn2a ld_fn2: ;get the alternate du from the configuration ;block. Translate from binary form to standard ;DU form in the screen. A 0ffh value for either ;D or U translates to '?' on the screen and means ;that the program being configured is to use the ;run-time current default DU. (NOT the Current ;default for EZCNFG!) ld hl,(offset) ;->user/drive in config block ldbchl ;drive in B, User in C ldfn2a: ld de,(s_addr) ;screen addr in DE ld a,(cfgd) ;if data byte is 0... or a ;..for Drv = 0...15, then.. ld a,41h ;for 0-based drive code, no 0ffh jr z,ldfn2b ld a,40h ;0ff+40='?', d+40='A'..'P' ldfn2b: add b ;convert drive to '?' or Drive ld (de),a ;install in screen inc de ;->loc for User number ;convert the user number to decimal and store in screen ld a,spc ;fill with spaces to erase ld (de),a ;previous data inc de ld (de),a dec de ;->user number area ld a,c ;bin user number cp 0ffh ;use default? call nz,mafdc ;store in decimal if not jp nz,redraw ;done if not 0ffh ld a,"?" ;indicate default ld (de),a inc de ld (de),a ret redraw: xor a ret ;========================================================= ; FUNCTION 3 - UPDATE HEX ASCII BYTE/WORD IN_FN3: ;Transfer either 2 max or 4 max characters from ;bbline input to 1 or 2 bytes in configuration ;block, interpreting the characters in HEXADECIMAL. ;Copy the input string to the screen image. ;(cfgd) specifies the number of bytes to be replaced ;in the configuration block, and is 1 or 2. When 2 ;bytes are specified, they are interpreted as a WORD, ;and stored in the standard low-byte-first order. A ;word (2 byte) is accepted from the terminal and ;displayed in the screen (at (s_addr)) in human-readable ;high-byte-first order. ld hl,hmmout ;set up routines to be called ld (route1+1),hl ;during xmmout execution ld (route2+1),hl ld de,prmph0 ;first part of prompt for HEX call typlin ;send it call xmmout ;send min/max if specified in ovly ld de,prmpt1 ;stuff after min/max if present call typlin ld de,tmpscr ld bc,4 call xfrlj ;user input, hex ascii jp c,redraw ;for null string entry ld hl,tmpscr ;convert to binary ld de,16 ;using hex radix call radbin ;the binary value is now in BC, hex ascii in tmpscr ld d,b ld e,c ;..and in DE for range test call rngtst ;test for within range if required jp c,redraw ;do nothing on range error ;binary value is in DE, asci hex is in tmpscr buffer hexin1: ld a,(cfgd) ;number of cfg bytes (1 or 2) ld b,a ;in counter ld hl,(offset) ;->1 or 2 cnfg bytes hexin2: ld (hl),e ;send one or two bytes ld e,d ;to the cnfg block inc hl djnz hexin2 ld bc,(cfgd) ;re-fetch number of bytes ld b,0 ;..in BC rlc c ;X2, for 2 char/byte ld hl,tmpscr ;->hex ascii ld de,(s_addr) ldir ;transfer asci to screen hexinx: xor a ;show no error ret ;--------------------------------------------------------- ; Get data from configuration block and store ; as ASCII HEX in the screen image. ;CALL (from mapper -- indirect call) ld_fn3: ld hl,(offset) ;hl->config byte(s) ld de,(s_addr) ;get screen loc ld a,(cfgd) ;number of cnfg bytes cp 1 jr z,ld1hex cp 2 jr z,ld2hex jp nz,badovl ;here for byte data ld1hex: ld a,(hl) ;get the data call ma2hc ;store 2 hex ascii in screen xor a ;mark no error ret ;here for word data ld2hex: ldhlhl call mhl4hc ;store 4 hex ascii in screen xor a ret ;========================================================= ; FUNCTION 4 - BYTE/WORD UPDATTE WITH DECIMAL RADIX ;get user ascii decimal input, convert to bin ;and store in config block and screen. ;The byte at cfgd: defines the number of bytes ;referenced in the configuration block. The ;pointer at s_list: identifies location of the ;16 bit min and max values permitted for the entry. If ;that pointers value is 0000 (before relocation) ;then no range testing is done; any value is OK. ;If the number entered by the user is outside the ;range specified by the min/max word pair, then ;nothing is done. in_fn4: ;get user input ld hl,phlfdc ;send up to 5 decimal digits ld (route1+1),hl ld (route2+1),hl ld de,prmpd0 ;first part of prompt for DEC call typlin ;send it call xmmout ;send min/max if specified in ovly ld de,prmpt1 ;stuff after min/max if present call in_dec ;ret with hl->ascii, a=e=bin jp c,redraw ;no input if cy set ;decimal input converted to bin in A, BC, and DE call rngtst ;test for within range if required jp c,redraw ;do nothing on range error ;value in DE, HL->input string ld a,(cfgd) ;get number of bytes to update ld b,a ;update the config block entry ld hl,(offset) ;config block destination fn4_1: ld (hl),e ;update it inc hl ;->next ld e,d ;in case high byte needed djnz fn4_1 ;fall through to ld_fn4 for screen update ;--------------------------------------------------------- ; Get data from configuration block and store ; as ASCII decimal in the screen. BYTE configuration ; data uses up to 3 screen bytes, WORD configuration ; data ( a 2 at cfgd: ) uses up to 5 screen bytes. ;CALL (from mapper -- indirect call) ld_fn4: ld hl,(offset) ;hl->config byte(s) ld de,(s_addr) ;get screen loc ld a,(cfgd) ;number of cnfg bytes cp 1 jr z,ld1dec cp 2 jr z,ld2dec jp nz,badovl ;here for byte data, stored in up to 3 bytes ld1dec: ld a,(hl) ;get the data call madc ;store decimal ascii in screen xor a ;mark no error ret ;here for word data, stored in up to 5 bytes ld2dec: ldhlhl call mhldc ;up to 5 digits, no space fill xor a ret ;========================================================= ; FUNCTION 5 - PROCESS ASCII INCLUDING LC ;same as function 1, except lower case allowed in_fn5: ld a,0 jp in_fn1+2 ;========================================================= ; FUNCTION 7 ; PROCESS 3 BIT FIELD AT LSB OF A BYTE ; toggle among 001b, 010b, and 100b ;Rotates a bit among the least significant 3 bits of the ;byte at (offset). The data at (cfgd) is a mask used to ;identify the 3 lsb. Its value must be 0111B. The corresponding ;3 null terminated strings at (s_list) provide the source ;for the screen image at (s_addr). ; Used for .LALL, .SALL, .XALL. ;This is a 'quick & dirty' routine that could be rewritten to ;handle the more general case of rotation of a bit in a ;field of m bits starting at location n in a byte. m and n ;would have to be the upper and lower nibls of (cfgd), and ;there would need to be m strings at (s_list). in_fn7: ld hl,(offset) ;get option byte address ld a,(cfgd) ld c,a ;bit mask in c ld a,(hl) ;get the byte ld b,a ;save in B and c ;mask significant bits ld c,2 cp 1 ;if 1, then 2 is next jr z,mtglx ld c,4 cp 2 ;if 2, then 4 is next jr z,mtglx ld c,1 ;anything else init to 1 mtglx: ld a,b ;new patern in c, old byte in a and 11111000b ;remove old pattern or c ;install new ld (hl),a ;update config byte jr mtogl0 ld_fn7: ;use bits 0,1, and 2 to transfer one of three ;data items to the screen. Only one bit of the ;three is used. If more or less than one bit is ;set, then assume bit 0. ;CALL with same input data as ld_fn0. ;this function is insensitive to (cfgd), but testing ;for (cfgd) >7 is a good error screen for proper CFG file ld a,(cfgd) cp 8 jp nc,badovl ld hl,(offset) ;config byte address ld b,(hl) ;get data byte and b mtogl0: ;shared with initialization ld de,(s_addr) ;DE -> screen destination ld hl,(s_list) ;HL -> data options for screen rrca ;first bit into cy jr c,macupd ;got it if cy set ex af,af' call skip2z ;..else -> next one ex af,af' rrca ;see if second bit is set jr c,macupd ex af,af' call skip2z ;-> third name. this is it ex af,af' macupd: call move2z ;hl->data, de->screen. copy 'til null. xor a ;reset carry - don't call an error! ret ;========================================================= ; FUNCTION 8 - TOGGLE BYTE BETWEEN TRUE & FALSE ;Toggle a byte in the configuration block at (offset) ;between 00 and 0ffh (=-1), then update the screen image ;at (s_addr) with the appropriate one of two choices of ;null terminated ascii strings at (s_list). in_fn8: ld hl,(offset) ;->configuration byte ld a,(hl) ;get it or a ;adjust flags jr z,bytog1 ;continue if zero ld a,-1 ;else be sure it's 0ffh bytog1: cpl ;toggle the byte ld (hl),a ;restore to config block or a ;adjust flags jp togl0 ;send ascii to screen ;load the screen according to the logic ;value in the configuration byte ld_fn8: ld a,(cfgd) ;not used, but partially identifies dec a ;proper function if its value is 1 jp nz,badovl ld hl,(offset) ;->configuration byte ld a,(hl) ;get it or a ;adjust flags jp togl0 ;send ascii to screen ;========================================================= ; FUNCTION 6 ; PROCESS ALL OR PART OF A Z3 FILESPEC ;The configuration block contains one of the forms: ; FN,FT (FCB format, 11 bytes blank filled) ; Drive (1 byte) ; user,drive (2 bytes) ; User,Drive,FN,FT (User, standard FCB - total 13 bytes) ;The cfgd byte contains 0..3 to identify these forms. This code ;is used to control transfer of all or portions of the filespec ;from user input to tmpfcb, and between tmpfcb and the cnfg block. ;Data transfer from tmpfcb to the screen image is also controlled ;by (cfgd) in the sense of selecting the appropriate PUTZ.. routine. ;Both configuration data and user input are transferred to tmpfcb. ;Transfer to and from the cnfg block is also controlled by bit 2 of ;(cfgd) which specifies interpretation of Drive byte values. If the ;bit is 1, then Drive A is represented by 1; bit 2 = 0 implies that ;Drive A=0. Thus (cfgd) may have values from 0..3 for 0-based drive ;specification and 4..7 for 1-based drive specs. (FNAME and the ;tmpfcb buffer always use 1-based drive designation) in_fn6: ld de,fn6msg call in_kbd ;input from keyboard, capitalized jp c,redraw ;null entry ld c,a ;length of input string call colon ;install terminating colon for fname parse ld bc,100h ;default DU=A0 for fname (1=A:) ld de,tmpfcb ;full fcb preceded by user byte ;a full fcb is required for fname to initialize call fname ;parse user input to tmpfcb ;fname data uses the A=1 convention for the drive byte call putfn6 ;update screen image, use A=1 ;convert to A=0 form unless A=1 is specified ld a,(cfgd) bit 2,a ;A=1 specified jr nz,inn61 ;jump if A=1 specified ld hl,tmpfcb dec (hl) ;convert to A=0 form ;copy the relevant portion of tmpfcb to cfg block inn61: call setup6 ;get source, dest, byte count ldir ret colon: ld a,(cfgd) ;check for colon required and 3 ret z ;not required for fn.ft cp 3 ;..or for full filespec ret z push hl ;save ptr to input string ld b,0 add hl,bc ;->terminating null dec hl ;->last char ld a,':' cp (hl) ;did user provide colon? jr z,colonx ;skip if so inc hl ;->terminator ld (hl),a ;provide colon inc hl ld (hl),0 ;..and new terminator colonx: pop hl ;hl -> colon terminated D or DU ret ;perform lookup of field length and location ;in tmpfcb structure for portions of Z3 filespec ;specified by the value (0..3) in cfgd:. setup6: ld a,(cfgd) cp 8 ;if >7, it's bad data jp nc,badovl ;error msg & abort if so and 3 ;remove A=1 flag ld c,a add a add c ld c,a ;for index to table of 3 byte records ld b,0 ld hl,tbli6 add hl,bc ld c,(hl) ;number of bytes to transfer inc hl ld a,(hl) ;get tmpfcb location inc hl ld h,(hl) ld l,a ld de,(offset) ;config block location ret tbli6: db 11 ;fn+ft dw tmpfcb+1 ;source db 1 ;Drive byte dw tmpfcb ;location db 2 ;U+D dw tmpfcb-1 db 13 ;U+D+FN+FT dw tmpfcb-1 ;load tmpfcb from the cnfg block ld_fn6: call setup6 ;de=source,hl=dest,bc=count ex de,hl ;hl=source, de=dest ldir ;convert to A=1 if necessary ld a,(cfgd) bit 2,a ;A=1 specified? jr nz,putfn6 ;jump if so. It's already correct ld hl,tmpfcb ;..else.. inc (hl) ;convert to A=1 for the screen load. ;fall through to load the screen ;load the screen image from tmpfcb putfn6: ld hl,tmpfcb+1 ;->file name field of parsed input ld de,(s_addr) ld a,(cfgd) and 3 ;remove A=0/1 flag jr z,putfnft ;0 = display . only dec a jr z,putzdd ;1 = display D: only dec a jp z,putzdu ;2 = display DU: only jr putfspec ;3 = display full filespec putzdd: dec hl ;->drive byte ld a,(hl) add 'A'-1 ;convert to ascii ld (de),a ret putfnft: call putzfn ;send FN.FT to screen dest, ld b,12 ;field width. C contains # of trailing spaces jr rjustify putfspec: call putzfs ;send full filespec to screen ld b,16 ;field width, C=trailing spaces rjustify: ld hl,(s_addr) call rjip xor a ret ;========================================================= .SBTTL SERVICE ROUTINES PAGE ;========================================================= ; MISC SERVICE ROUTINES ;========================================================= ;get user input using the message at DE ;CALL WITH: ; DE -> prompt message ;RETURN WITH: ; HL -> Input string ; A = number of characters in the string ; CY set = null string, else NC. in_kbd: call typlin ;ask for user input ld a,-1 call bbline ;get user input or a ;no input if Z ret nz ;hl -> input string scf ret ;nothing but CR input ;========================================================= ;get user input using the message at DE ;Convert ascii decimal input to bin in DE ;ret CY set if no input. ;CALL WITH: ; DE -> prompt message ;RETURN WITH: ; DE = BC = binary value of user input ; HL -> ascii input string in_dec: call in_kbd ret c ;no input except CR ld de,10 ;Decimal (base 10) conversion jr radix ;========================================================= ;get user input using the message at DE ;Convert HEX ascii input to bin in DE ;ret CY set if no input. ;CALL WITH: ; DE -> prompt message ;RETURN WITH: ; DE = BC = binary value of user input ; HL -> ascii input string in_hex: call in_kbd ;get user input ret c ;null string if Cy set ld de,16 ;HEX radix conversion ; jr radix ;========================================================= ;convert the ascii string to binary using ;the requested RADIX. ;CALL WITH: ; HL -> ASCII string, terminated by non-radix character ;RETURN WITH: ; HL is preserved ; DE = BC = binary value of the string radix: push hl ;save ptr to input string call radbin ;convert ascii dec to bin in BC ld d,b ld e,c ;..and in DE pop hl ;return pointer to ascii input or a ;clear carry ret ;========================================================= ;Test current numeric user input against min/max values ;pointed to by the address at s_list. If that pointer ;is equal to the relocation constant, then its original ;value was 0000h, and no range testing is required. i.e., ;any value is OK. Returns CY set if out of range, else NC. ;CALL WITH ; DE = value to be tested ;RETURN WITH ; DE, HL preserved, BC is munched ; CY SET = DE > MAX or DE < MIN rngtst: push hl push de ;value input by user ld de,(s_list) ;->range data ld hl,(relocc) or a ;reset cy sbc hl,de ;compare with reloc constant ex de,hl ;hl->range data pop de ;value from user to test jr z,rngx ;z = no range test ldbchl ;get min value in BC ldhlhl ;get max value in HL call range ;preserves DE (test value) rngx: pop hl ret ;========================================================= ;get user ASCII input. transfer left justified ;and space filled to the destination at (DE). ;CALL WITH ; BC = field length ; DE ->destination xfrlj: ld a,-1 ;specify capitalization ;entry with caps flag specified by caller xfrljn: call bbline ;get user input or a scf ;indicate null entry ret z ;do nothing if only CR input xfrl1: ld a,(hl) ;null terminator? or a jr nz,xfrl2 ld hl,spaces ;right fill with spaces xfrl2: ldi jp pe,xfrl1 ;repeat BC times ret ;========================================================= move2z: ;copy a null terminated string from (HL) ;to (DE). Don't copy the null. Ret HL->null ld a,(hl) or a ret z ldi jr move2z ;========================================================= skip2z: ;scan until binary zero. ;Return HL-> byte following the 0. ld a,(hl) inc hl or a jr nz,skip2z ret ;========================================================= ; Convert ASCII DU spec at HL to bin form in BC ; Replace '?' entries with -1 (0ffh) ;CALL WITH: ; HL -> text string (DU) ;RETURN WITH: ;exit: BC = binary DU (B=drive, C=user) ; NZ = error in DU, Z = no error xltadu: ld bc,0 ;mask bytes for '?' response ld a,(cfgd) ;if data byte is 0... cp c ;..for Drv = 0...15, then.. jr z,padu4 ;..skip '?' logic push hl ;source of ASCII D/U spec ld a,'?' ;for testing cp a,(hl) ;use default Drive at run time? jr nz,padu1 ;skip fake entry if not. ld (hl),'A' ;fake entry dec b ;0ffh will mask it padu1: inc hl ;second possible char cp (hl) ;'?' in user field? jr nz,padu3 ;jump if not padu2: dec c ;make mask = 0ffh ld (hl),'0' ;fake an entry to replace '?' pop hl ;recover pointer to Alt DU field push bc ;save mask for '?' choices jr padux padu3: inc hl ;->3rd char cp (hl) ;did he sneak in a '?' jr z,padu2 ;if yes, treat like the first one,else.. pop hl ;recover pointer to Alt DU field padu4: push bc ;save mask for '?' choices padux: call sksp ;<== is this needed? call duscn+2 ;resolve & return DU in BC ;duscn returns nz if D or U > 16 or 31 ;if user entered '?' for D or U, make corresponding ;byte into 0ffh, else use his specified values. pop de ;recover mask for D, U ret nz ;ret on error ld a,(cfgd) ;if data byte is 0... or a ;..for Drv = 0...15, then.. jr z,padu5 ld a,b or a,d ;make 0ff if user input a '?' ld b,a ld a,c or a,e ;make 0ff if user input a '?' ld c,a xor a ;mark no error ret ;BC contains new D/U padu5: dec b ;make drive byte 0 based xor a ret ;========================================================= xmmout: ld de,(s_list) ;-> possible min/max words ld hl,(relocc) ;relocation constant or a ;reset cy sbc hl,de ;originally zero? ret z ;yep. no min/max push de ;save min/max pointer ld de,fromp ;'from ' call typlin pop hl lddehl ;min val in DE ldhlhl ;max val in HL push hl ;save for route2 ex de,hl ;min val in HL route1: call 0 ;filled in by xmmout caller ld de,tomsg ;' to ' call typlin pop hl ;max value route2: call 0 ;filled in by xmmout caller ret hmmout: ;select the syslib routine to use for data transfer ld a,(cfgd) ;number of bytes dec a jp nz,PHL4HC ;for hex word data ld a,l jp PA2HC ;for hex byte data ;========================================================= .SBTTL INITIALIZATION ROUTINES PAGE ;========================================================= ; PROGRAM STARTUP & INITIALIZATION ;========================================================= init: call getdr ;get current drive push af ;save it, and call gua ;get current user pop bc ;drive in B ld c,a ;user in C inc b ;make drive 1..16 ld (defdu),bc ;store the default ld (ovlusr),bc ;init for file-specified default call fixalt ;replace defaults in alt DU ;initialize screen line and column counters ld hl,0 ld (colcnt),hl ;Install the version number in the signon message ld hl,vernum ld a,vers add '0' ;convert to ascii ld (hl),a inc hl ;skip the '.' inc hl ld a,rev add '0' ld (hl),a ;Install the version Date at VSNDAT and in the signon msg ld hl,vsndat+2 ;->year byte ld a,year call b2bcd ;convert to BCD ld (hl),a ;store vsndat field dec hl ld a,day call b2bcd ld (hl),a dec hl ld a,month call b2bcd ld (hl),a ld de,smon ld b,3 call stordt ;send formatted m,d,yr to signon msg ;test for ZCPR3 or ZCPR33 availability ld hl,(z3env) ;get env address into hl ld a,h ;see if environment implemented or l ld (z3msgf),a ;save as msg buffer flag ret z ;NZ=Z3ENV available, Z=use CP/M only call z3vinit ;init for vlib functions call tinit ;init terminal if required call getcrt inc hl ld a,(hl) ;get screen length ld (scrnln),a ;use this length instead of cnfg. ret ;========================================================= ;CALL WITH BC = default D/U fixalt: ld hl,altusr ;adjust alternate D/U to defaults ld a,0ffh ;..if specified by 0ffh value cp (hl) ;altusr = 0ffh? jr nz,init2 ;no if NZ, don't adjust ld (hl),c ;install default user init2: inc hl ;->alternate drive spec. cp (hl) ;default required? ret nz ;return if not, else ld (hl),b ;install default drive ret ;========================================================= ;provide the help screen if requested help: ld a,(fcb+1) call isalnum ;alphanumeric char present? ret z ; no help if so dohelp: call assist ;give help screen & quit jp quit ;print the Help screen assist: ld de,hlp0msg call typlin xor a ret ;========================================================= ;get the target file name, DU from the command ;line. Set up the system FCB as the target fcb. ;Store the DU in a safe place for opening and ;closing the target file. pgmini: ld a,(scrnln) ;install fixed screen addresses ld (hlpat),a ;for the standard prompts sub 5 ;depending on screen length ld (atprpt),a ld de,fcb ;use system fcb for target file ld hl,tbuf+1 ;->command tail call sksp ;skip spaces, tabs ld bc,(defdu) call fname ;parse the filename jp nz,baddu ;jmp to error if bad d/u ld (tgtdu),bc ;save for open/close push hl ;command tail pointer ld hl,tgttyp call doftyp ;set default file type if required pop hl ;->balance of command tail call sksp ;->next non-space, non-tab byte xor a or a,(hl) ;if null, no more arguments ld de,ovlfcb jr z,pgmin1 ;..skip if no more ld bc,(defdu) call fname ;parse a possible filespec jp nz,baddu ld (ovlusr),bc pgmin1: ld hl,ovltyp call doftyp ;install default filetype if needed ld de,ovlfn ld a,(de) cp spc ;if the fn field is still empty, jr nz,pgmin2 ;(it isn't if nz) ld hl,fcb+1 ld bc,8 ;length of fn field ldir ;use target fn for overlay name pgmin2: ld de,fcb ;use system fcb for target file ld a,(tgtdu) ;pass user area for the file call opnfil ;open the file ret nz ;NZ=file opened, Z=error jp badfil ;========================================================= ;here if FNAME finds a bad DU in cmd tail baddu: ld de,bdumsg call typlin jr dohelp ;========================================================= ;Here if a file cannot be opened. Usually a bad filename. ;CALL WITH DE->fcb for the attempted operation badfil: inc de ;->file name ld b,8 call badlop ;send filename to console ld a,'.' call cout ;send '.' in FN.FT ld b,3 call badlop ;send file type ld de,ermsg1 ;report not found call typlin jp quit ;send up to B characters to console, skipping spaces badlop: ld a,(de) inc de cp ' ' jr z,badskp call cout badskp: djnz badlop ret ;========================================================= filinit: call rpage ;get first 256 bytes of pgm ;look for the 'Z3ENV' marker at relative location 003 ld de,z3mark ld hl,tgtbuf+3 ld b,idlen ;length of strings call cpstr ;compare 2 strings jr z,zutil ;ok, check for env type ;if not found, it's not a ZCPR3x utility xor a ;logic false value ld (z3inst),a ;prevent zcpr installation jp gt_cfg ;------------------------------------------------------- zutil: ld hl,tgtbuf ld de,envtyp ;offset to env type byte add hl,de ld a,4 cp (hl) ;type four header? call z,rpage ;skip the header if so, and ;read in the first page of the pgm jr gt_cfg ;------------------------------------------------------- ;Read one page of 256 bytes from the target program ;into the local configuration block buffer ;save the Current Record byte in the FCB for restoration when ;the updated configuration block is rewritten rpage: ld a,(fcb+crec) ;get Current Record byte ld (fcb_cr),a ;save it ld de,tgtbuf ;cnfg block buffer call setdma ld de,fcb ;fcb pointer for target program call rdrec ;get first 128 bytes in tgtbuf ex de,hl ;preserve fcb pointer ld de,tgtbuf+80h call setdma ex de,hl jp rdrec ;get second 128 bytes and return fcb_cr: ds 1 ;current record index for the cfg block ;------------------------------------------------------- ;This routine loads the overlay. If the overlay was ;named in the command line, then that name is used. ;Otherwise the overlay name is assumed to be the same ;as the target program name. If the overlay cannot be ;found, then zcnfg tries offset 0DH of the target file ;for a name and attempts to load that file as a configuration ;overlay. In each case, the DU derived from the command tail ;is searched first, and then the alternate DU is searched. ;If not found, an error message is issued. gt_cfg: ld de,ovlfcb ld a,(ovlusr) ;get applicable user area call opnfil ;open the file (if present) jr nz,gtcfgx ;jump to load file if found call tryalt ;try again with alternate du jr nz,gtcfgx ;jump to load file if found ;here with DU from command tail restored, ;but file not found. Try for an ID string ;If ID string looks OK, search DU from cmd ;tail, and then the alternate du. gtcfg2: push de ;retain fcbfn ptr ld hl,fidoff+tgtbuf ;->potential ID string ld b,8 ;transfer to testid buffer, call namchk ;check for 8 AN characters pop de ;in case of bad string, use the fcb fn jp c,badfil ;quit if illegal filename string ld de,ovlfn ;transfer potential overlay file push de ;..name to the ovl fcb ld a,spc ld b,8 ;blank out fn field call fill pop de ;->ovlfn destination for strcpy ld hl,testid ;->verified ID string ld b,8 ;max length call strcpy ;copy the ID string to ovly fn ld de,ovlfcb ld a,(ovlusr) ;get applicable user area call opnfil ;open the file (if present) jr nz,gtcfgx ;jump to load file if found call tryalt ;try again with alternate du jp z,badfil ;SIGH! no overlay.... ;load overlay and return gtcfgx: ld hl,(ovrlay) ;place to load the file jp rdfile ;read in the entire .cfg file ;------------------------------------------------------- tryalt:ld hl,(ovlusr) ;get & save current DU push hl ld bc,(altusr) ;get alternate du or a sbc hl,bc ;same as just tried? jr z,xtryal ;skip the disk access if so. ld (ovlusr),bc ld a,c ;alt user for opnfil call opnfil ;try opening file xtryal: pop hl ;recover old DU, clear stack ret nz ;file opened if nz ld (ovlusr),hl ;restore original DU and.. ret ;..return Z if not found ;------------------------------------------------------- namchk: ld de,testid call strcpy ;copy ID string to testid ld hl,testid idloop: call sdelm ;any illegal FN characters? jr z,iderr ;error if so. call ucase ;ensure upper case ld (hl),a inc hl ld a,(hl) or a ;null terminator means 8 good chars jr z,id_ok cp spc ;otherwise, default space ends the name jr nz,idloop id_ok: xor a ;return NC for potential name ret iderr: scf ;return Cy set for illegal characters ret testid: ds 8,spc ;buffer for trial ID string db 0 ;terminator if needed ;========================================================= ;traverse the circular que of menu lists, ;loading the screen image for each menu ;from the configuration block. scr_ld: ld hl,(ovrlay) ;->config data just loaded inc hl ;skip over protective rst0 ld e,(hl) ;get assembled menu0 addr inc hl ld d,(hl) ;..in DE inc hl ;->first menu list ld b,h ;save in BC ld c,l or a ;clear carry flag sbc hl,de ;relocation constant ld (relocc),hl ;save for RELOCL & RELOC routines ld h,b ;recover menu0 location ld l,c ;initialize the internal counter to track menu number xor a ld (mnumb),a ;start with menu0 dec a ld (lmnumb),a ;count from -1 to allow for a ;final count that is one too much ;ldmenl will relocate the items in the menu list ;using the value in relocc. call ldmenl ;make first menu current ld hl,(nextm) ;mark head of circular que scr_l0: push hl ;save que head marker ld hl,(castbl) ;get current case table call mapper ;load the associated screen ld a,(lmnumb) ;bump last menu number inc a ld (lmnumb),a call gotonm ;next que member pop de ;nextm from que head ld hl,(nextm) ;nextm from current member or a ;reset cy for the sbc sbc hl,de ;equal? ex de,hl ;restore head of que marker jr nz,scr_l0 ;if not, load the screen xor a ;get zero ld (mnumb),a ;reinitialize menu number ret ;if yes, all menu screens have been ;loaded and first one is current. ;========================================================= .SBTTL SCREEN UPDATE FROM CFG BLOCK PAGE ;========================================================= ;ROUTINES TO TRANSFER CONFIGURATION BLOCK DATA TO THE ; SCREEN IMAGE ;========================================================= mapper: ;MAPPER traverses a list of records each of ;which contains the parameters required for ;maintaining one menu item. For each record, ;the maintenance routine is called after the ;balance of the parameter list has been copied ;to a standard location for use by the routine. ;The routines load the screen image from data ;in the configuration block. ;call with HL -> table of data made ;with the BITMAP or VECTOR macros. ld b,(hl) ;number of entries inc hl ld e,(hl) ;length of each entry inc hl ;->first record ld d,0 ld (maper3+1),de dec e dec e dec e ;de=length of parameter list ld (maper1+1),de ;visit each record, calling the function required ;to load the screen image for each menu item. maper0: push bc ;save record counter push hl ;..and start of current record ld a,(hl) ;get menu ID letter ld (curitm),a ;save for possible error report inc hl ld c,(hl) ;get function address inc hl ld b,(hl) ;...in BC inc hl ;->start of parameter list inc b dec b ;if high byte is 0, this is a call z,fnxlti ;function number to translate ;transfer the parameter list to the standard block push bc ld de,offset maper1: ld bc,0 ;parm list length entered above ldir ;copy to standard parm list call reloc ;add tgtbuf to offset, reloc addresses pop de ld hl,mappret ;prepare for indirect call push hl ;ret addr on stack push de ;routine addr ret ;make an indirect call ;The called routine uses data in the standard block ;as required, then returns to the following address. mappret: ;..and return to here pop hl ;recover the record pointer maper3: ld de,0 ;filled at run time add hl,de ;-> next table entry pop bc djnz maper0 ret ;========================================================= .SBTTL DATA & MESSAGES PAGE ;========================================================= ; **** DATA AREA **** ;========================================================= Z3MSGF: ds 1 defdu: ds 2 ;default DU at signon tgtdu: ds 2 ;DU of the source file ovrlay: ;overlay is loaded in free memory $memry: ds 2 ;filled in by linker relocc: ds 2,0 ;overlay relocation constant ovlusr: db 0 ;user area for overlay ovlfcb: db 0 ;overlay drive ovlfn: db ' ' ;overlay filename ovlft: db ' ' ;filetype ds 25 ;balance of fcb colcnt: ds 1 ;screen column counter rowcnt: ds 1 ;screen line counter tgtbuf: ds 100h ;working buffer for first ;two records from target file ;========================================================= ; MESSAGES signon: ;signon banner db cr,lf,lf,ht,' ZCNFG, Z-system Configuration Utility',cr,lf db ht,ht,'Version ' vernum: db ' . , ' smon: db ' / / ',cr,lf,0 wfmsg: db cr,lf,'This program only configures files for which a configuration',cr,lf db 'overlay (xxxx.CFG) file has been provided. See ZCNFG.DOC.',cr,lf db 0 badmsg: db cr,'Invalid command. Try Again: ',0 ftmsg: db ') -Enter up to ' ftmsg1: db '3 characters: ',0 prmpd0: db ') Enter a number ',0 prmph0: db ') Enter HEX ',0 prmpt1: db ' =>',0 fromp: db 'from ',0 tomsg: db ' to ',0 bdumsg: db cr,lf,'Check for possible Drive or user error..',cr,lf,lf dumsg: db ") New DU",0 dumsg1: db " ('?' for default) ",0 psemsg: ;prompt for next menu help screen db '(Space or CR to continue, ^C for Menu)',cr db 0 ermsg1: ;report not found db ' was not found.',cr,lf db 0 fn6msg: db ') Enter filespec option ',0 ;========================================================= spaces: db ' ' ;for an empty field.... db 0 ;string terminator tmpscr: ds 30,0 ;temporary input data buffer tmpusr: ds 1 ;user byte for temp fcb tmpfcb: ds 36 ;temp fcb for fname destination ;====================================================== .SBTTL CONTROL SCREEN IMAGE PAGE ;========================================================= ;screen image for menu & pgm control selections. ;This screen is always appended to target-specific ;menus provided by the configuration overlay. prmpt0: ;Title line db ht,ht,' ZCNFG INSTALLATION CONTROL' db cr,lf db ' X or Esc =Save changes & eXit ' db ' Q,^C =Quit with no changes saved' db cr,lf db ' / or ? =Explain Options > or ' db '. =Next Menu < or , =Previous Menu' db cr,lf,lf prompt: db ht,'Which choice? ' p0term: db 0 ;terminator ;========================================================= ;Menu & Pgm control options case table ;This table is searched last for program control ;options. If a match is not found, then the entry ;at CTLCSE is executed as a default. ctlcs0: db (ctlcse-ctlcs1)/(ctlcs2-ctlcs1) ;number of cases db ctlcs2-ctlcs1 ;bytes per record ctlcs1: db '/' ;explain menu items dw mnuhlp ctlcs2: db '?' ;explain menu items dw mnuhlp db 'Q' ;quit - no update dw quit db ctlc ;also quit on ^C dw quit db CR ;Redraw screen if CR dw redraw db '>' ;next menu dw gotonm db '.' ;next menu dw gotonm db '<' ;previous menu dw gotolm db ',' ;previous menu dw gotolm db 'X' ;quit with options updated dw exit db esc ;quit with options updated dw exit ctlcse: ;label used to calc number of entries db 0 ;dummy entry for default case dw badcmd ;default case, err msg & ret C PAGE ;========================================================= hlp0msg: ;The Help Screen db cr,lf,'Configures option data in Executable files.',cr,lf,lf db 'Syntax:',cr,lf,lf db ' ZCNFG [du/dir:][.] [du/dir:][][.]',cr,lf,cr,lf db ht,'du/dir: defaults to the current drive and user',cr,lf db ht,' is the Executable file to configure.',cr,lf db ht,' is the configuration overlay file.',cr,lf db ht,' defaults to COM, defaults to CFG',cr,lf,lf db 'Example: ZCNFG ZCNFG ;configures itself.',cr,lf,lf db 'A related configuration data file must be present to provide',cr,lf db 'Screen layout, Menus, and configuration data.',cr,lf,lf h0term: db 0 ;========================================================= ;local stack & system stack pointer ds 40 stack: dw 0 end