* Sinclair QL World DIY TOOLKIT - VOCAB extension * Ver. 0.8, Copyright Simon N Goodwin, March 1992 * start lea.l define,a1 Point at name details move.w $110.w,a2 Use the BP.INIT vector jmp (a2) Link VOCAB to BASIC * * VOCAB [ # CHANNEL% , ] [ NAME_TYPE% ] * vocab moveq #8,d5 Assume type #8 (RES PROC) moveq #1,d7 Assume channel #1 cmpa.l a3,a5 Any parameters? beq.s defaults tst.b 1(a3,a6.l) Is there a # prefix? bpl.s no_hash moveq #-1,d7 Flag it for later no_hash move.w $112.w,a2 CA.GTINT - get integers jsr (a2) bne.s bad_exit Return D0 error code subq.w #2,d3 Check parameter count bhi.s bad_param Too many parameters? bne.s one_param move.w 2(a1,a6.l),d5 Pick up the name type pick_chan move.w 0(a1,a6.l),d7 Pick up the channel # bpl.s check_type It should be positive * bad_param moveq #-15,d0 BAD PARAMETER error bra.s bad_exit chan_error moveq #-6,d0 CHANNEL NOT OPEN error bad_exit rts All errors exit here * one_param tst.l d7 Was there a # prefix? bmi.s pick_chan Parameter is channel # move.w 0(a1,a6.l),d5 Parameter is name type check_type cmp.w #1,d5 Check for expressions beq.s bad_param Reject, no name * defaults mulu #40,d7 Find offset in table add.l 48(a6),d7 Add base to offset cmp.l 52(a6),d7 Check not beyond end bge.s chan_error Number is too high move.l 0(a6,d7.l),d0 ID for output window bmi.s chan_error Channel is closed chan_open movea.l d0,a0 Set up Channel ID * get_width movea.l (a6),a1 Point A1 at BASIC Buffer moveq #-1,d3 Wait indefinitely long moveq #11,d0 SD.CHENQ trap key trap #4 A1 is an A6 offset trap #3 Call Qdos tst.l d0 Z signals ERR.OK beq.s window move.w 34(a6,d7.l),d6 Pick up CH.WIDTH move.w 32(a6,d7.l),d0 Pick up CH.CHPOS bra.s get_ready Are we on a new line? * window move.l (a6),d0 Find the buffer again move.w 0(a6,d0.l),d6 Fetch the window width tst.w 4(a6,d0.l) Is the cursor at left? get_ready beq.s got_width bsr.s do_newline No; move to a new line bne.s bad_exit * * D6 is output line width, D5 is name type, A0 is ID * got_width movea.l 24(a6),a3 A3 -> Start of Name Table move.l 28(a6),a4 A4 -> End of Name Table moveq #16,d7 Column width (1..127) move.w d6,d4 D4 is room left on line * check_name cmp.b 0(a3,a6.l),d5 Check the type of name bne.s next_name moveq #0,d1 Clear high word of D1 move.w 2(a3,a6.l),d1 Find Name List offset bne.s not_null tst.w 0(a3,a6.l) Is this a null entry? beq.s next_name not_null add.l 32(a6),d1 + Name List base address move.b 0(a6,d1.l),d0 Get name length (1+) cmp.b d0,d7 bhi.s easy_fit It fits the column width move.b d7,d0 Emulate Procrustes subq.b #1,d0 Allow at least one space easy_fit move.b d7,d2 sub.b d0,d2 D2 is number of spaces move.l (a6),a2 A2 is buffer offset * * D0 is length to copy to buffer from 1(A6,D1.L) * copy_name move.b 1(a6,d1.l),0(a2,a6.l) addq.l #1,d1 Advance through Name List addq.l #1,a2 Advance through buffer subq.b #1,d0 Count one less character bhi.s copy_name pad_spaces move.b #32,0(a2,a6.l) Add one space to buffer addq.l #1,a2 Advance through buffer subq.b #1,d2 Count one less space bhi.s pad_spaces * * There are D7 bytes ready to be output from offset (A6) * sub.w d7,d4 Will these fit the line? bpl.s they_fit bsr.s do_newline Take a new line bne bad_exit move.w d6,d4 Start a new line sub.w d7,d4 they_fit movea.l (a6),a1 Point at the text move.w d7,d2 Indicate the length moveq #7,d0 IO.SSTRG trap key trap #4 Note A1 is an offset trap #3 Send the string tst.l d0 Did that work? bne bad_exit next_name addq.l #8,a3 Advance down Name Table cmpa.l a3,a4 Have we reached the end? bhi.s check_name Keep going if A4 > A3 do_newline moveq #10,d1 Newline ASCII code moveq #5,d0 IO.SBYTE trap key trap #3 tst.l d0 Flag the error code rts * define dc.w 1 One new PROCedure dc.w vocab-* dc.b 5,'VOCAB' dc.w 0,0,0 End of PROCs, no FNs end