;------------------------------------------------ ; Control software for the Amstrad Scientific ; - Interface. ; 'WORD' (W)aveform (O)utput (R)ecording and ; (D)isplay. ; Copyright B.J.Frost, Mid 1986, Version 1.0 ; Construction ref 005,28/SEP/86. ;------------------------------------------------ ; equates: daport equ 0a2h ; d/a output address op8bit equ 0a1h ; 8-bit TTL output address ad8btr equ 0a0h ; 8-bit a/d trigger address ad8brd equ 0a2h ; 8-bit a/d data address ip8bit equ 0a1h ; 8-bit TTL input address dsadad equ 0a0h ; dual-slope a/d data address tbuff equ 80h ; default file DMA address begin jp start ;variables: rpstad defs 2 ; replay block start address rbsize defs 2 ; replay block size rcstad defs 2 ; recording start address rcsize defs 2 ; recording size msize defs 2 ; max allowed store size memtop defs 2 ; max allowed store address rptime defs 2 ; pointer to replay timebase array rctime defs 2 ; pointer to record timebase array delwrd defs 2 ; delay word stored from timebases rpmode defs 1 ; rep mode 0 = loop, not= single bgrflg defs 1 ; display background flag 0=dark. buffer defs 40 ; filename text entry buffer fcb defs 36 ; file control block fpoint defs 2 ; file text pointer fcount defs 2 ; file byte count cliney equ 13500 ; plot cursor at this y address shifts defs 1 ; plot scalar store ppoint defs 2 ; plot x pointer plsize defs 2 ; plot data length pstart defs 2 ; plot data start pend defs 2 ; plot right margin cpos defs 2 ; plot cursor data pointer cmov defs 2 ; plot cursor move increment pstep defs 2 ; plot address step ; program commences: start ld hl,(himem) ; pick up cp/m address dec hl ld sp,hl ; stack here ld de,-32 add hl,de ld (memtop),hl ; for 32 bytes, then my top ld de,spoint xor a sbc hl,de ; calc free memory ld (msize),hl call dark ; assume dark background call open ; open graphics workstation call setup ; load defaults call wipe ; clear memory to 128 jp menu ; and into menu ; here on exit request. exit ld de,exit1 ; clear, prompt and get key call clrpget cp "Y" jr nz,menu jp warms ; ok get out exit1 defm "Request exit, are you sure (Y)? " defb term ; ------------------------------------------------------- ; **** menu **** ; ------------------------------------------------------- ; front-panel re-write menu ld de, menu1 call pstr ; print menu call con ; cursor on ; warm return, only values updated menu2 ei ; interrupts on now xor a out (op8bit),a ; zero stimulus call vals ; show screen values ld de, prompt ; prompt and.. call pstr call uinch ; wait for user cp "A" ; alter replay timebase? jp z, rtim ; yes. cp "B" ; alter replay block start address? jp z, rbst ; yes. cp "C" ; alter replay block size? jp z, rbsz ; yes. cp "Z" ; file operation? jp z, file ; yes. cp "P" ; plot data? jp z, plot ; yes. cp "D" ; start replay? jp z, rstart ; yes. cp "E" ; alter replay mode? jp z, rmode ; yes. cp "F" ; alter record timebase? jp z, reptim ; yes. cp "J" ; arm for record? jp z, arm ; yes. cp "K" ; toggle background? jp z,togbak ; yes. cp 3 ; no. User wants exit? jp z, exit ; yes. ld a,bell call outch ; no, error. jr menu2 ; and loop back ; user prompt prompt defw pcurs defb 32+28,32 defw dline ; clear message line defw pcurs defb 32+24,32+6 defw dline ; clear prompt line defm "Enter option:" defb term ; main title text menu1 defw clear,pcurs defb 32+1,32+18 defw ulon defm "Waveform capture and display program. 'WORD' v1.0" defw uloff defw pcurs defb 32+4,32+10 defm " --- REPLAY ---" defw pcurs defb 32+7,32+5 defw rev defm " A " defw revoff defm " Replay timebase:" defw pcurs defb 32+9,32+5 defw rev defm " B " defw revoff defm " Replay from:" defw pcurs defb 32+11,32+5 defw rev defm " C " defw revoff defm " - block length:" defw pcurs defb 32+13,32+5 defw rev defm " Z " defw revoff defm " File handling." defw pcurs defb 32+15,32+5 defw rev defm " P " defw revoff defm " Graphics menu." defw pcurs defb 32+17,32+5 defw rev defm " D " defw revoff defm " Start replay." defw pcurs defb 32+19,32+5 defw rev defm " E " defw revoff defm " Replay mode:" defw pcurs defb 32+21,32+5 defw rev defm "'C " defw revoff defm " EXIT to CP/M" defw pcurs defb 32+4,32+54 defm " --- RECORD --- " defw pcurs defb 32+7,32+49 defw rev defm " F " defw revoff defm " Record Timebase:" defw pcurs defb 32+9,32+50 defm " Start address:" defw pcurs defb 32+11,32+50 defm " Recording size:" defw pcurs defb 32+13,32+50 defm " Max store length:" defw pcurs defb 32+17,32+49 defw rev defm " J " defw revoff defm " Arm for recording." defw pcurs defb 32+19,32+49 defw rev defm " K " defw revoff defm " Toggle background." defb term ; show all screen values vals call rectp ; print record timebase call rtp ; print replay timebase call rpst ; print replay start address call prpsz ; print replay sample size call pmode ; print replay mode call prstad ; print record start address call prsize ; print record size call prlen ; print max store length ret ; print max store length prlen ld de,0d48h call decurs ld hl,(msize) dec hl jp c4hex ; print record start address prstad ld de,0948h call decurs ld hl,(rcstad) jp c4hex ; print record size prsize ld de,0b48h call decurs ld hl,(rcsize) jp c4hex *Eject ; Users changes record timebase. Each call here causes prompt- ; '+' or '-'. Entry of either advances or retards timebase. Any- ; other character exits. ;Change record timebase: reptim ld de, rtimpr call pstr ; prompt user with +- etc call uinch ; get user cp "+" ; advance? jr z,rptim1 ; yes. cp "-" ; retard? jr z,rptim2 ; yes. jp menu2 ; no exit. ; advance timebase: rptim1 ld hl,(rctime) ; get pointer ld de,10 add hl,de ; skip to next element push hl xor a ; clear carry ld de,rctlim sbc hl,de ; reached end of array? pop hl jr z,reptim ; yes. do nothing ld (rctime),hl ; no, store new pointer call rectp ; print new timebase jr reptim ; and loop ; retard timebase rptim2 ld hl,(rctime) ; get pointer xor a ; clear carry ld de,10 sbc hl,de ; skip to last element push hl xor a ; clear carry ld de,rectar-10 sbc hl,de ; reached start of array? pop hl jr z,reptim ; yes. do nothing ld (rctime),hl ; no, store new pointer call rectp ; print new timebase jr reptim ; and loop ; print record timebase text on screen rectp ld de,0748h call decurs ; set cursor position ld de,(rctime) ; get timebase array pointer jp pgtt ; print text ; record timebase array: ; screen text accompanied by delay word used in recording ; routines. rectar defw 4 ; delay word defm "50 usec " ; 8 bytes text defw 10h defm "100 usec" defw 2ah defm "200 usec" defw 74h defm "500 usec" defw 1 defm "1 msec " defw 2 defm "2 msec " defw 5 defm "5 msec " defw 10 defm "10 msec " defw 20 defm "20 msec " defw 50 defm "50 msec " defw 100 defm "100 msec" defw 200 defm "200 msec" defw 500 defm "500 msec" defw 1000 defm "1 Sec " defw 2000 defm "2 Sec " defw 5000 defm "5 Sec " defw 10000 defm "10 Sec " defw 20000 defm "20 Sec " defw 50000 defm "50 Sec " rctlim defb 0 ; end of array *Eject ; here to swop background colour. togbak ld a,(bgrflg) ; get current background cpl ld (bgrflg),a cp 0 ; want dark? jr nz,tog1 ; no. call dark ; yes. jp menu2 tog1 call light ; light. jp menu2 ; and return *Eject ; here to start recording. recgo ld de,recgo1 call pstr ; tell of recording ld hl,(rctime) ; get timebase ptr call rprep ; load delay word, test usec/ms jr c,recgo2 ; usec so fast call aslow ; msec so slow jr recgo3 recgo2 call afast recgo3 ld hl,(rcsize) ld (rbsize),hl ; copy length ld hl,(rcstad) ; and start adr ld (rpstad),hl jp menu2 ; and out recgo1 defw pcurs defb 32+28,32+6 defm "Recording in progress, press switch D0/7 to stop." defb term ; program for recording with A/D for timebase <1mS afast di ; interrupts off ld a,0ffh out (op8bit),a ; +ve stimulus ld de,(rcstad) ; point recording start ld a,(delwrd) ; pick up delay word LSB ld c,a ; into c jr adfast4 ; start with trigger adfast1 in a,(ad8brd) ; read A/D ld (de),a ; store it adfast4 out (ad8btr),a ; trigger A/D inc de ; up store pointer xor a ld hl,(memtop) sbc hl,de ; max? jr z,adfast2 ; yes. out ld b,c ; fetch delay adfast3 djnz adfast3 ; delay in a,(ip8bit) ; user stop? and 81h jr z,adfast1 ; no. repeat adfast2 dec de ; form size ex de,hl ld de,(rcstad) xor a sbc hl,de ld (rcsize),hl ld a,bell call outch ; tell user with beep ret ; out ; program for recording with A/D for timebase 1mS or more. aslow di ; interrupts off ld a,0ffh out (op8bit),a ; +ve stimulus ld de,(rcstad) ; point recording start jr adslow4 ; start with trigger adslow1 in a,(ad8brd) ; read A/D ld (de),a ; store it adslow4 out (ad8btr),a ; trigger A/D inc de ; up store pointer xor a ld hl,(memtop) sbc hl,de ; max? jr z,adfast2 ; yes. out ld hl,(delwrd) ; fetch timebase adslow7 ld b,56h ; cal timebase adslow6 push af pop af ; (dummy delay) djnz adslow6 ; at 1mS per hl in a,(ip8bit) ; user stop? and 81h jr nz,adfast2 ; yes. exit as fast routine dec hl ld a,h or l jr nz,adslow7 ; loop ms jr adslow1 ; repeat *Eject ; User alters replay mode. Each access of this routine ; toggles mode loop or single, with screen update. rmode ld a,(rpmode) ; get mode cpl ; next mode. ld (rpmode),a call pmode ; print mode on screen jp menu2 ; return to command ; print mode on screen pmode ld de, 131bh ; position cursor call decurs ld de, modp0 ; print replay mode. ld a, (rpmode) cp 0 ; mode 0? jr z, pnt ; yes. ld de, modp1 ; no, so must be mode 1 pnt jp pstr modp0 defm "Loop " defb term modp1 defm "Single " defb term *Eject ; Users changes replay timebase. Each call here causes prompt- ; '+' or '-'. Entry of either advances or retards timebase. Any- ; other character exits. ;Change replay timebase: rtim ld de, rtimpr call pstr ; prompt user with +- etc call uinch ; get user cp "+" ; advance? jr z,rtim1 ; yes. cp "-" ; retard? jr z,rtim2 ; yes. jp menu2 ; no exit. ; advance timebase: rtim1 ld hl,(rptime) ; get pointer ld de,10 add hl,de ; skip to next element push hl xor a ; clear carry ld de,rptlim sbc hl,de ; reached end of array? pop hl jr z,rtim ; yes. do nothing ld (rptime),hl ; no, store new pointer call rtp ; print new timebase jr rtim ; and loop ; retard timebase rtim2 ld hl,(rptime) ; get pointer xor a ; clear carry ld de,10 sbc hl,de ; skip to last element push hl xor a ; clear carry ld de,rtarr-10 sbc hl,de ; reached start of array? pop hl jr z,rtim ; yes. do nothing ld (rptime),hl ; no, store new pointer call rtp ; print new timebase jr rtim ; and loop call rtp ; print timebase jr rtim ; loop repeat rtimpr defw pcurs defb 32+24,32+6 defw dline defm "Enter '+' to advance, '-' to retard else exit.." defb term ; print replay timebase text on screen rtp ld de,071bh call decurs ; set cursor position ld de,(rptime) ; get timebase array pointer ; print general timebase text on screen ; enter de points 8 bytes text. pgtt inc de inc de ; point at text ld b,8 pgtt1 ld a,(de) call outch inc de djnz pgtt1 ; print 8 bytes ret ; replay timebase array: ; array holds delay values for specified sample times, ; for slow routine is mS, fast routine is in lsb and calibrated. rtarr defw 1 ; delay word defm "34 usec " ; 8 bytes text defw 05h defm "50 usec " defw 12h defm "100 usec" defw 2bh defm "200 usec" defw 78h defm "500 usec" defw 1 defm "1 msec " defw 2 defm "2 msec " defw 5 defm "5 msec " defw 10 defm "10 msec " defw 20 defm "20 msec " defw 50 defm "50 msec " defw 100 defm "100 msec" defw 200 defm "200 msec" defw 500 defm "500 msec" defw 1000 defm "1 Sec " defw 2000 defm "2 Sec " defw 5000 defm "5 Sec " defw 10000 defm "10 Sec " defw 20000 defm "20 Sec " defw 50000 defm "50 Sec " rptlim defb 0 ; end of array *Eject ; user alters replay block start address. rbst ld de, sapr call pstr ; prompt user call in4hex ; get start address jr c, rbst1 ; error ld (rpstad),hl ; save result call rpst ; show result jp menu2 ; loop back rbst1 ld a, bell call outch ; error bell jr rbst sapr defw pcurs defb 32+24, 32+8 defw dline defm "Enter start address in 4 hex digits: " defb term ; print replay block start address on screen rpst ld de,091bh ; print start address ld hl,(rpstad) jp c4hex *Eject ; user alters replay block size. rbsz ld de, rbsz2 call pstr ; prompt user call in4hex ; get sample size jr c, rbsz1 ; error ld (rbsize),hl ; save result call prpsz ; print result jp menu2 ; loop rbsz1 ld a, bell call outch ; error bell jr rbsz rbsz2 defw pcurs defb 32+24, 32+8 defw dline defm "Enter sample size in 4 hex digits: " defb term ; print sample size on screen prpsz ld de,0b1bh ; print sample size ld hl,(rbsize) jp c4hex *Eject ; ***************** file operations ********************** ; file operation. file call dirp ; print file directory ld de,file1 call pstr ; mess call uinch ; get chr cp "R" ; want to read? jp z,lfile ; yes. cp "W" ; no. want to write? jp z,sfile ; yes cp 3 ; want out? jp z,menu ; yes. ld a,bell call outch ; error jr file file1 defw pcurs defb 32+5,32+5 defm "File options: Read (R), Write (W), Return ('C)." defb cr,lf,lf,lf defm "Enter option: " defb term ; save file on disk. sfile call owrite ; open for write jp c,lferr ; error ld a,(rbsize+1) call sfchr ; save MSB file size ld a,(rbsize) call sfchr ; save LSB file size ld hl,(rpstad) ; get start address ld bc,(rbsize) ; size sfile1 ld a,(hl) ; data byte call sfchr ; saved to file jp c,lferr ; error inc hl dec bc ld a,b or c jr nz,sfile1 ; loop saving call wrec ; write tail call fclose ; close file jp menu ; return ; BDOS call with my fcb bcall ld de,fcb jp bdos ; open file for write owrite call fget ; prompt, get filname, parse ld c,19 call bcall ; delete existing of this name ld c,22 ; want to make new file call bcall ; do it. ld a,0 ld (fcb+32),a ; zero current record no ld hl,tbuff ; reset file text pointer ld (fpoint),hl ret ; save chr in 'A' to file. sfchr push bc push de push hl ld hl,(fpoint) ; get data pointer ld (hl),a ; chr saved inc hl ld (fpoint),hl ld a,h cp 1 ; pointer overflow? scf ccf jr nz,sfchr1 ; no. call wrec ; yes. write record sfchr1 pop hl pop de pop bc ret ; write file record wrec ld hl,tbuff ld (fpoint),hl ; reset pointer ld c,21 call bcall ; write record cp 0 ; good write? scf jr nz,wrec1 ; no. ccf ; yes wrec1 ret ; close file. fclose ld c,16 jp bcall ; load file to waveform store. lfile call oread ; open file jr c,lferr ; error, no file call gfchr ; get MSB file size ld (rbsize+1),a ; stored call gfchr ; get LSB file size ld (rbsize),a ; stored ld de,spoint ; point start of store start1 call gfchr ; get file chr push af ld (de),a ; store it inc de ; up store ptr pop af jr nc,start1 ; loop next byte if not eof ld hl,(rbsize) ld (rcsize),hl ; copy size to recording data call fclose ; close file jp menu ; back on eof ; cant open file lferr ld a,bell call outch jp file ; read to input buffer at address 'DE' length 'A' getbuf push de ld (de),a ; update buffer with max length ld b,a ld a,0 inc de inc de getbuf1 ld (de),a inc de djnz getbuf1 ; wipe buffer clean pop de ld c,10 ; function call jp bdos ; go get ; open an existing file oread call fget ; prompt, get filename, parse ld c,15 call bcall ; open file cp 0ffh scf ret z ; no file. ld a,0 ld (fcb+32),a ; zero current record no ; now read record to buffer recrd ld hl,tbuff-1 ; reset file chr ptr ld (fpoint),hl ; saved ld c,20 call bcall ; read record cp 0 ; good read? scf ; assume not ret nz ccf ret ; file setup operation. Prompt, get filename, ; parse. fget ld de,fprompt call pstr ; prompt ld de,buffer ; point buffer for filename ld a,40h call getbuf ; get filename ld c,152 ld de,pfcb ; point parse fcb call bdos ; parse filename call wfix ; overwrite to '.wav' ld de,tbuff ; set DMA address ld c,26 jp bdos pfcb defw buffer+2 defw fcb ; prompt for filename fprompt defb cr,lf,lf defm "Enter filename: " defb term ; fetch chr from file in 'A'. Exit carry set if EOF. gfchr push hl push de push bc gfchr3 ld hl,(fpoint) ; get file pointer inc hl ; up pointer ld (fpoint),hl ; and save ld a,h cp 1 ; pointer overflow? jr z, gfchr1 ; yes. read next record ld a,(hl) ; no, get chr scf ccf gfchr2 pop bc pop de pop hl ret ; return gfchr1 call recrd ; read new record jr c,gfchr2 ; out if error jp gfchr3 ; and get chr ; fixes filetype at ".WAV" wfix ld a,"W" ld (fcb+9),a ; fix filetype ".WAV" ld a,"A" ld (fcb+10),a ld a,"V" ld (fcb+11),a ret ; print directory. dirp ld de,xdirp7 ; directory title call pstr ld b,8 ; set filename wildcard ld hl,fcb+1 ld a,"?" xdirp1 ld (hl),a inc hl djnz xdirp1 call wfix ; fix filetype at '.WAV' ld c,17 call bcall ; search for first cp 0ffh jr z,xdirp2 ; no files call xdirp4 ; print filename xdirp5 ld c,18 call bcall ; search for next cp 0ffh jr z,xdirp2 ; no files call xdirp4 ; print filename jr xdirp5 ; loop repeat xdirp2 ret ; print file details. xdirp4 add a,a add a,a add a,a add a,a add a,a ld l,a ld h,0 ; offset to FCB ld de,tbuff ; current DMA buffer add hl,de ; point at file name inc hl ld b,8 ; print filename xdirp3 ld a,(hl) call outch inc hl djnz xdirp3 ld b,10 xdirp6 ld a," " call outch djnz xdirp6 ; spaces ret xdirp7 defw clear defw pcurs defb 32+18,32+0 defw ulon defm "Default directory files :" defw uloff defb cr,lf,lf defb term ; ------------------------------------------------ *Eject ; start replay: rstart ld de,exmess call pstr ; print message ld hl,(rptime) call rprep ; fetch delay wrd, test usec/msec jr c, rstart2 ; is uS so fast routine call outsl ; not uS so 'slow' routine jp menu2 ; then back rstart2 call outf ; fast routine for uS jp menu2 ; and back ; prepare record / replay. Load delay word from hl pointer, ; test text for usec / msec. Exit carry set usec. rprep ld e,(hl) inc hl ld d,(hl) ; fetch it to de ld (delwrd),de ; save it inc hl rprep1 inc hl ld a,(hl) cp "u" ; usec? scf ; assume is, ret z cp term ; no, end of text? jr nz,rprep1 ; no, loop scf ccf ret exmess defw pcurs defb 32+28,32+6 defm "Trigger is +ve edge on D7 output, press switch D0/7 to stop." defb term *Eject ; memory clear wipes all to 128. wipe ld de,spoint+1 ; fetch start address ld hl,spoint ld bc,(msize) ; and size dec bc ld a,128 ld (hl),a ldir ret ; stored data out at timebase 1mS or more. ; assumes timebase word 'delwrd' set up to mS req. ; loops once or always on 'rpmode'. outsl di ld a,0ffh out (op8bit),a ; trigger ref ld bc,(rpstad) ; point start ld hl,(rbsize) ; get byte count outsl1 ld a,(bc) ; get byte out (daport),a ; send to D/A ld de,(delwrd) ; fetch timebase push bc outsl2 ld b,60h ; cal timebase outsl3 push af pop af ; (dummy delay) djnz outsl3 ; at 1mS per de dec de ; next mS count ld a,d or e jr nz, outsl2 ; until zero pop bc in a,(ip8bit) ; user pressed switch to stop? and 81h jr nz,uret ; yes. exit inc bc ; no. up pointer scf ld de,0 sbc hl,de ; down byte count jr nz, outsl1 ; loop till done ld a,0 out (op8bit),a ; trig low ld a,(rpmode) ; single or loop? cp 0 ; loop? jr z, outsl ; then repeat ; common return here for replay routines uret ei ld a,bell call outch ; tell user with beep ret ; out ; stored data out at timebase <1mS. ; assumes timebase word 'delwrd' lsb set up to delay req. ; loops once or always on 'rpmode'. outf di ld a,0ffh out (op8bit),a ; trigger ref ld bc,(rpstad) ; point start ld hl,(rbsize) ; get byte count outf1 ld a,(bc) ; get byte out (daport),a ; send to D/A ld a,(delwrd) ; fetch timebase outf3 dec a jr nz, outf3 ; loop fast in a,(ip8bit) ; user pressed switch to stop? and 81h jr nz,uret ; yes. exit inc bc ; up pointer scf ld de,0 sbc hl,de ; down byte count jr nz, outf1 ; loop till done ld a,0 out (op8bit),a ; trig low ld a,(rpmode) ; single or loop? cp 0 ; loop? jr z, outf ; then repeat ; set up default values on start up setup ld hl,spoint ; block start address ld (rpstad),hl ; for replay, ld (rcstad),hl ; and record ld hl,256 ; size of replay block ld (rbsize),hl ld hl,256 ; size of record block ld (rcsize),hl ld hl,rtarr ld (rptime),hl ; default replay timebase ptr ld hl,rectar ld (rctime),hl ; default record timebase ptr ld a,0 ld (rpmode),a ; default loop mode on replay ld a,0 ld (bgrflg),a ; assume dark background ret *Eject ; ***************** plot routines *************** ; plot data plot call grdef ; set default margins plot4 call coff ; cursor off call cscreen ; clear screen call pcon ; calc plot constants this plot call grid ; grid call graph ; plot waveform call grid ; plot clean grid call cinit ; ready cursor call ptext ; print text & values for this plot plot3 call curs ; show cursor call cval ; and its value plot1 call inkey ; fetch chr jr z,plot1 call lc2uc ; force upper case cp 3 ; want out? jr z,plot2 ; yes. cp ">" ; want move cursor right? jr z,curr ; yes. cp "<" ; want move cursor left? jr z,curl ; yes. cp "Z" ; want zoom? jr z,zoom ; yes. cp "P" ; want pan? jp z,pan ; yes, cp "R" ; want r.margin from cursor? jp z,rmfc ; yes. cp "L" ; want l.margin from cursor? jp z,lmfc ; yes. cp "D" ; want redraw? jp z, rdraw ; yes. ld a,bell call outch ; error jr plot1 ; loop get next chr plot2 call ptrup ; ask if use plot pointers jp menu ; and exit ; move cursor right. curr ld de,(cpos) ; get posn ld hl,(cmov) ; get increment add hl,de ; add movement call crchk ; check cursor jp plot3 ; back and replot cursor ; move cursor left. curl ld de,(cmov) ld hl,(cpos) xor a sbc hl,de ; calc new posn call crchk ; check cursor jp plot3 ; then replot ; check cursor after increment / decrement. ; if hl within limits 'cpos' updated else ; unchanged. crchk push hl ld de,(pstart) xor a sbc hl,de pop de jr c,crchk1 ; error. is right margin ld (cpos),de ; ok to update position crchk1 ret ; zoom. (Magnify by 2) zoom ld hl,(plsize) ; fetch plot length ld a,h cp 0 jr nz,zoom2 ; need >4 to zoom ld a,l cp 4 jr c,zoom1 zoom2 ld a,1 call ahlshr ld (plsize),hl ; half this is new plot length ld a,1 call ahlshr ; half this again ld de,(cpos) ; and cursor position ex de,hl xor a sbc hl,de ; forms new start address ld (pstart),hl zoom1 jp plot4 ; replot ; Pan. (Expand by 2). pan ld de,(plsize) ; plot length push de ; saved ld hl,(cpos) ; and cursor position xor a sbc hl,de ; forms new start address ex de,hl ld hl,spoint ; bound left margin xor a sbc hl,de jr c,pan1 ld de,spoint pan1 ld (pstart),de pop hl ; plot length ld a,1 call ashifts ; doubled (x2 pan) ld (plsize),hl ; new plot length jp plot4 ; replot ; set right margin from cursor rmfc ld hl,(cpos) ; fetch cursor ld de,(pstart) ; and l.margin rmfc1 xor a sbc hl,de ; made new size ld (plsize),hl jp plot4 ; and replot ; set left margin from cursor lmfc ld hl,(pend) ; fetch r.marg ld de,(cpos) ; fetch curs ld (pstart),de ; (is new l.margin) jr rmfc1 ; then as for r.margin ; replot and centre cursor rdraw ld hl,(plsize) ld a,1 call ahlshr ; use half new plot length ld de,(cpos) ; get cursor position ex de,hl xor a sbc hl,de ; form new start address ld (pstart),hl jp plot4 ; show cursor curs ld a,0 call smcol ; plot reverse call mark ; erase cursor ld hl,cliney ; y position of cursor ld (ptsin+2),hl ld hl,(cpos) ; fetch cursor data address ld de,(pstart) xor a sbc hl,de ; form cursor adr offset ld a,(shifts) call ashifts ; convert to x position ld (ptsin),hl ld a,1 call smcol ; polymark plot show ld a,2 call smtype ; set type cross call mark ; plot cursor ret ; set up default plotting values grdef ld hl,(rbsize) ld (plsize),hl ; define plotting length ld hl,(rpstad) ld (pstart),hl ; define data start ret ; set plotting values for this plot eg cursor increment, ; x scaling etc. pcon call xscale ; scale address values ld hl,(plsize) ; fetch plotting length ld a,1 call ahlshr ; shift hl div by 2 ld de,(pstart) ; fetch start address add hl,de ; calc cursor in middle ld (cpos),hl ld hl,(plsize) add hl,de ld (pend),hl ; calc r.margin ld hl,(plsize) ld a,10 call ahlshr ld (pstep),hl ; plotting step ld hl,(plsize) ld a,7 call ahlshr ; div by 128 total ld (cmov),hl ; this is allowed cursor move ret ; scale co-ords for plot data. Plot size is scaled ; until as close to 32767 as possible. Exit 'shifts' ; contains required data scaling and grid box corner ; 'pbox+4' set. xscale ld de,(plsize) ; fetch length dec de ld b,0 ; clear shift count xsc2 ld hl,7fffh ; full plotting range xor a ; clear carry sbc hl,de ; do full-input jr c,xsc1 ; too big. xor a rl e rl d ; de doubles inc b ; count shifts jr xsc2 ; loop ; here when input is >32767 so divide by 2. xsc1 dec b ld a,b ld (shifts),a ; save data address scale xor a rr d rr e ld (pbox+4),de ; deposit scalar as box corner ret ; graph position ready for erase cursor cinit ld hl,0 ld (ptsin),hl ; ready for cursor erase ld hl,cliney ld (ptsin+2),hl ret ; shift hl right 'a' times, exit hl=min of 1 ahlshr scf ccf cp 0 jr z,ahl1 rr h rr l dec a jr ahlshr ahl1 ld a,h or l ret nz ld hl,1 ret ; plot grid, assume 'pbox+4' set to width. grid ld de,pbox ld b,8 call trans ; move box co-ords call bar ; show box ld hl,(ptsin+2) ; fetch lly ld de,8192 add hl,de ld (ptsin+2),hl ld (ptsin+6),hl ld a,3 call sltype call line ; zero line at middle ld a,1 jp sltype ; plot data graph graph ld hl,0 ld (ptsin+4),hl ld hl,yorg+8192 ld (ptsin+6),hl ; start at middle, lhs ld hl, -1 ; plot pointer ld (ppoint),hl graph1 ld hl,ptsin+4 ; swop vertixes ld de,ptsin ld bc,4 ldir ld hl,(ptsin) ld a,h or l jr z,graph2 ; no marker at zero ld hl,(plsize) ld de, 32 xor a sbc hl,de jr nc,graph2 ; if size<32, plot markers ld a,4 call smtype call mark graph2 ld hl,(ppoint) ; fetch plot pointer ld de,(pstep) add hl,de ; plus plot step ld (ppoint),hl ; to nextplot point ld a,(shifts) call ashifts ; scale up ld (ptsin+4),hl ; deposit result ld hl,(ppoint) ld de,(pstart) add hl,de ; form data pointer ld a,(hl) ; fetch data byte ld h,0 ld l,a ld a,6 call ashifts ; bump up data too ld de,yorg add hl,de ; add in y shift ld (ptsin+6),hl ; deposit 'y' co-ord call line ; plot line, last pt to this ld hl,(ppoint) ; restore plot pointer ld de,(plsize) dec de xor a sbc hl,de ; done plot? jr c,graph1 ; no. loop ret ; yes ; shift hl left 'A' times except if A=ff, div by 2. ashifts cp 0 ; shifts required? ret z ; no cp 0ffh ; down scale? jr z,ash1 ; yes. div by 2 scf ccf rl l rl h ; double dec a jr ashifts ; loop till scaled ash1 ld a,1 jp ahlshr ; div by 2 pbox defw 0,yorg,0,yorg+16384 ; box co-ords yorg equ 15000 ; box is up the screen ; update screen text and values on new plot. ptext ld de, mess call pstr ld hl,(pstart) ; print start address ld de,161eh call c4hex ld hl,(plsize) ; print plot block size ld de,171eh call c4hex call cval ; print cursor address ret mess defw pcurs defb 32+20,32+10 defm "[--------- Data ---------]" defw pcurs defb 32+22,32+10 defm "Plot start address: " defw pcurs defb 32+23,32+10 defm "Plot data length: " defw pcurs defb 32+24,32+10 defm "Cursor at address: " defw pcurs defb 32+25,32+10 defm "Data at cursor is: " defw pcurs defb 32+20,32+52 defm "[------- Options --------]" defw pcurs defb 32+22,32+50 defm " < move plot cursor >" defw pcurs defb 32+23,32+50 defm "Z : zoom in, twice magnify" defw pcurs defb 32+24,32+50 defm "P : pan out to twice width" defw pcurs defb 32+25,32+50 defm "R : right margin from cursor" defw pcurs defb 32+26,32+50 defm "L : left margin from cursor" defw pcurs defb 32+27,32+50 defm "D : redraw around cursor" defw pcurs defb 32+29,32+49 defm "'C : return to main menu" defb term ; ask if user wants plot pointer to overwrite replay pointers- ; on return. ptrup ld de,ptrup1 call pstr ; print option call uinch cp "Y" ret nz ; user wants not. ld hl,(pstart) ld (rpstad),hl ; is wanted. Update start, ld hl,(plsize) ld (rbsize),hl ; and size ret ptrup1 defw pcurs defb 32+28,32+2 defm "Use plot window as replay addresses (Y/N) ?" defb term ; show cursor address and data. Called on cursor move. cval ld hl,(cpos) ; get position ld de,181eh ; position call c4hex ld hl,(cpos) ; print data at cursor ld de,191eh call decurs ld a,(hl) call pbyte ret ; recording arm routine. Displays moving trace, A/D value, ; and allows transfer to recording or back to menu. arm call open ; open graphics ld a,1 call smtype ; dot type call sltype ; line type arm1 call cscreen ; clear screen ld hl,32767 ld (pbox+4),hl ; define grid r.margin call grid ; write grid ld de,messy call pstr ; print instructions ld hl,1 ld (ppoint),hl ; init x-coord ld (ptsin+4),hl ; and 'last point' ld hl,yorg ld (ptsin+6),hl out (ad8btr),a ; trigger A/D arm2 ld hl,(ptsin) ld (ptsin+4),hl ld hl,(ptsin+2) ld (ptsin+6),hl ; recall last point ld hl,(ppoint) ; set x co-ord this point ld (ptsin),hl in a,(ad8brd) ; read A/D out (ad8btr),a ; trigger A/D push af ; print value in hex ld de,1543h call decurs pop af push af call pbyte pop af ld h,0 ; scale result to y co-ord ld b,6 arm3 scf ccf rla rl h djnz arm3 ld l,a ld de,yorg add hl,de ; y offset ld (ptsin+2),hl ld a,1 call slcol ; show line call line ; plot line ld hl,(ppoint) ld de,20h add hl,de ld (ppoint),hl ; move along xor a ld de,32768 sbc hl,de ; test for end of screen jr nc,arm1 ; at end call inkey ; any chr? jr z,arm2 ; no loop cp 3 ; yes. want return? jp z,menu ; yes cp " " ; no. want recording? jr nz,arm2 ; no. ignore ld de,menu1 call pstr ; rewrite menu call vals ; and values call con ; cursor on jp recgo ; then start recording ; screen text for this routine messy defw pcurs defb 32+20,32+0 defm "Adjust 8-bit A/D for scale and offset," defb cr,lf defm "Press 'C to return, SPACE to start recording." defw pcurs defb 32+21,32+53 defm "A/D value is: " defb term *Eject *include sysrot *include gsx ; data storage area: spoint defb 0 ; start of store end