DECLARE SUB MouseHide () DECLARE SUB MouseInit () DECLARE SUB MousePoll (row%, col%, lbutton%, rbutton%) '$INCLUDE: 'QB.BI' '$INCLUDE: 'QFIG.BI' '---------------------------------------------------- SUB G.Group1 (kth%) 'if kth% = 0, then kill. If = 1 then change thickness. ' get several objects grouped job% = 13 KeySwitch 0 SetInst job% ' Marking 1, n% IF n% = 0 THEN Marking 1, n%: GOTO donegrouping c% = 0 GOTO From.Kill DO CursorMotion keyin% SELECT CASE keyin% CASE 4 ggroup% = 100 * group% FOR i% = 0 TO nobj% - 1 IF obj%(i%, 0) <> fnoo%(i%) THEN IF obj%(i%, 0) - fnoo%(i%) = ggroup% THEN Marking.One 1, i% obj%(i%, 0) = fnoo%(i%) Marking.One 1, i% END IF END IF NEXT i% GOTO donegrouping CASE 3 ' ---------------------------------------------------------------------- From.Kill: total% = 0 sx% = px%: sy% = py%: pxold% = px%: pyold% = py% DO CursorMotion keyin% CursorDisplay px%, py% LINE (sx%, sy%)-(pxold%, pyold%), 0, B IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO donegrouping LINE (sx%, sy%)-(px%, py%), 2, B CursorDisplay px%, py% pxold% = px%: pyold% = py% LOOP UNTIL keyin% = 3 selh% = 0 CursorDisplay px%, py% LINE (sx%, sy%)-(px%, py%), 0, B CursorDisplay px%, py% Marking.Reg sx%, sy%, px%, py%, total% IF total% < 0 THEN GOTO donegrouping IF total% > UBOUND(mobj%) OR nobj% + total% > UBOUND(obj%, 1) THEN GOTO no.way.to.move ' group check FOR k% = 0 TO total% obj%(mobj%(k%), 0) = 100 * group% + obj%(mobj%(k%), 0) c% = c% + 1 NEXT k% '-------------------- ipy% = py%: ipx% = px%: L.Text ipx%, ipy% '************** sobj1% = mobj%(0) grp1% = obj%(sobj1%, 0) - fnoo%(sobj1%) FOR i% = 0 TO nobj% - 1 IF obj%(i%, 0) - fnoo%(i%) = grp1% THEN SetObject i%, 3, 1 NEXT i% '************** PRINT "Sure(y/n)??"; bkey$ = yesno$ L.Text ipx%, ipy%: PRINT SPACE$(12); IF bkey$ = "y" THEN CursorDisplay px%, py% sobj% = mobj%(0) grp% = obj%(sobj%, 0) - fnoo%(sobj%) '*******if change thickness then IF kth% = 1 THEN L.Text ipx%, ipy% PRINT "Edit text font/type in area (y/n)??"; bkey$ = yesno$ L.Text ipx%, ipy%: PRINT SPACE$(17); FOR i% = 0 TO nobj% - 1 IF obj%(i%, 0) - fnoo%(i%) = grp1% THEN IF fnoo%(i%) <> 10 THEN 'If not string (text) obj%(i%, 4) = thick% ELSEIF bkey$ = "y" THEN 'If string (text) obj%(i%, 5) = chartype% END IF ' Changing arrow thickness in Group Edit SELECT CASE fnoo%(i%) CASE 1, 3, 6 i1% = i% DO UNTIL i1% = nobj% - 1 i1% = i1% + 1 IF fnoo%(i1%) = 11 AND obj%(i1%, 5) = i% THEN obj%(i1%, 4) = thick% END IF LOOP END SELECT ' ' Change Line type in Group Edit SELECT CASE fnoo%(i%) CASE 1, 2, 3, 4, 8 obj%(i%, 5) = ltype% END SELECT obj%(i%, 0) = fnoo%(i%) END IF NEXT i% EXIT SUB END IF '************then return******** DO Marking.One 1, sobj% i% = sobj% 'arrow deleting DO UNTIL i% = nobj% - 1 i% = i% + 1 IF fnoo%(i%) = 11 AND obj%(i%, 5) = sobj% THEN Killer i%, sobj% i% = i% - 1 END IF LOOP Killer sobj%, sobj% 'kill THAT object sobj% = -1 IF grp% <> 0 THEN 'group killing FOR i% = 0 TO nobj% - 1 IF obj%(i%, 0) - fnoo%(i%) = grp% THEN sobj% = i%: EXIT FOR NEXT i% END IF LOOP UNTIL sobj% < 0 ELSE ' Marking.Chk 1, sobj%, snode% sobj% = mobj%(0) IF sobj% >= 0 THEN Marking.One 1, sobj% IF fnoo%(sobj%) <> obj%(sobj%, 0) THEN ggroup% = obj%(sobj%, 0) - fnoo%(sobj%) IF ggroup% = 100 * group% THEN c% = 0 obj%(sobj%, 0) = fnoo%(sobj%) FOR i% = 0 TO nobj% - 1 IF obj%(i%, 0) <> fnoo%(i%) THEN IF obj%(i%, 0) - fnoo%(i%) = ggroup% THEN Marking.One 1, i% obj%(i%, 0) = fnoo%(i%) Marking.One 1, i% END IF END IF NEXT i% ELSE obj%(sobj%, 0) = 100 * group% + obj%(sobj%, 0) c% = c% + 1 END IF Marking.One 1, sobj% END IF Marking 1, n%: GOTO donegrouping END IF '------------------------------ ' GOTO end.new.grouping no.way.to.move: Marking 1, n% COLOR 14: LOCATE 2, 25 PRINT CHR$(7); " No way to move/copy that many... "; COLOR 7 end.new.grouping: ' '------------------------------------------------------------------------- END SELECT LOOP UNTIL keyin% = 3 donegrouping: Marking 1, n% SetInst job% CL.R.edraw 0, 0 LOCATE 2, 2: COLOR 0: PRINT SPACE$(25); : COLOR 7 KeySwitch 1 job% = 0 ' END SUB SUB ptext (ix%, iy%, s$, c%, m%) x! = ix%: y! = iy% DIM tarry1(256), tarry2(256), tarry3(256) IF m% = 1 THEN viewmax% = windowy%(0) ELSE viewmax% = winpy% - 5 END IF 'determine if the window is "screen" type or not IF PMAP(0, 3) < PMAP(10, 3) THEN 'this is a "screen" type window 'determine if the destination coordinates will be legal. IF s$ <> "" AND PMAP(x! - LEN(s$) * 4 + 1, 0) >= 0 AND PMAP(y! - 7, 1) >= 0 AND PMAP(x! + LEN(s$) * 4, 0) <= 639 AND PMAP(y! + texth% - 5, 1) <= viewmax% THEN 'back up the work area GET (PMAP(0, 2), PMAP(texth%, 3))-(PMAP(8 * LEN(s$) - 1, 2), PMAP(2 * texth% - 1, 3)), tarry1 'make the mask LOCATE 2, 1: COLOR 7 PRINT s$; GET (PMAP(0, 2), PMAP(texth%, 3))-(PMAP(8 * LEN(s$) - 1, 2), PMAP(2 * texth% - 1, 3)), tarry3 PUT (PMAP(0, 2), PMAP(texth%, 3)), tarry3, PRESET GET (PMAP(0, 2), PMAP(texth%, 3))-(PMAP(8 * LEN(s$) - 1, 2), PMAP(2 * texth% - 1, 3)), tarry3 'make the color characters to print LOCATE 2, 1: COLOR c% PRINT s$; GET (PMAP(0, 2), PMAP(texth%, 3))-(PMAP(8 * LEN(s$) - 1, 2), PMAP(2 * texth% - 1, 3)), tarry2 'restore the work area with the backup PUT (PMAP(0, 2), PMAP(texth%, 3)), tarry1, PSET 'mask out the area for the characters PUT (x! + 4 - LEN(s$) * 4 + 1, y! + 6 - 7), tarry3, AND 'put the color characters in the masked out spot PUT (x! + 4 - LEN(s$) * 4 + 1, y! + 6 - 7), tarry2, OR END IF END IF COLOR 7 ERASE tarry1, tarry2 END SUB '---------------------------------------------------- SUB QUIT0 qfigtitle$ = "qfig Ver.1.1a (3/24/1997)" qfigtitle2$ = "by: William Ofosu-Amaah" qfigtitle5$ = "(XI6W-OFSA@asahi-net.or.jp)" quit: CLS 0: COLOR 14 rowold% = row%: colold% = col% KeySwitch 0 KEY(8) OFF: KEY(9) OFF: KEY(10) OFF: KEY(17) OFF: KEY(19) OFF ' first check LOCATE 12, 30: PRINT " Are you sure (Y/[N]) " '; CHR$(7); DO: a$ = KeyIsTouched$ LOOP UNTIL a$ = CHR$(CR) OR (a$ <> "" AND INSTR("YyNn", a$) <> 0) IF a$ = CHR$(CR) OR UCASE$(a$) = "N" THEN IF seljob% <> 0 THEN VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0)) CL.R.edraw 0, 0: row% = rowold%: col% = colold% IF seljob% <> 0 AND py% > pymax2% THEN py% = pymax2% CursorDisplay px%, py% KeyDisplay SetInst 0 SELECT CASE seljob% CASE 0 linesel% = 0 CASE 1 TO 5 wx1% = (seljob% * 7 - 4) * 8 - 8 wx2% = (seljob% * 7 - 4) * 8 + 40 wy1% = (line2% + linesel%) * texth% - texth% wy2% = (line2% + linesel%) * texth% CASE 6 TO 9 wx1% = (5 + seljob% * 7) * 8 - 8 wx2% = (5 + seljob% * 7) * 8 + 40 wy1% = (line2% + linesel%) * texth% - texth% wy2% = (line2% + linesel%) * texth% END SELECT COLOR 11 IF seljob% <> 0 THEN LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky$(seljob% + linesel% * 10), 0, 1 COLOR 7 VIEW SCREEN (0, 0)-(windowx%(0), winpy%) END IF IF selh% = 1 THEN Marking 1, n% help% = 1 KeySwitch 1 KEY(8) ON: KEY(9) ON: KEY(10) ON: KEY(17) ON: KEY(19) ON EXIT SUB END IF ' second check COLOR 11 LOCATE 12, 24: PRINT " Need to save this figure (Y/[N]) " '; CHR$(7); DO: a$ = KeyIsTouched$ LOOP UNTIL a$ = CHR$(CR) OR (a$ <> "" AND INSTR("YyNn", a$) <> 0) IF UCASE$(a$) = "Y" THEN CLOSE : SCREEN scrtype% ', , 0, 1 INPUT "Enter Filename [default is $_qfig_$.qfg]:", nfile$ IF nfile$ = "" THEN nfile$ = "$_qfig_$.qfg" OPEN nfile$ FOR OUTPUT AS #1 IO.Save 3: CLOSE END IF ' no way to recover COLOR 7: GOSUB quit1: GOSUB title1: KEY ON: END ' quit1: IF mouswitch% THEN MouseHide: MouseInit '<=== when Mouse is used KeySwitch 0: KEY(8) OFF: KEY(9) OFF: KEY(10) OFF: KEY(17) OFF: KEY(19) OFF RETURN title1: CLS 0: LOCATE 8, 40 - LEN(qfigtitle$) / 2: COLOR 7: PRINT qfigtitle$; COLOR 10 LOCATE 12, 40 - LEN(qfigtitle2$) / 2: PRINT qfigtitle2$; LOCATE 14, 40 - LEN(qfigtitle5$) / 2: PRINT qfigtitle5$; COLOR 3 COLOR 7: SLEEP 2: CLS 0: RETURN END SUB SUB whelp PRINT PRINT TAB(3); " qfig [/e] [/s] [/f] " '[/nc] " PRINT PRINT TAB(5); "/e"; : PRINT TAB(10); "Use for EGA (default is VGA)" PRINT TAB(5); "/s"; : PRINT TAB(10); "For Special Characters in output .TEX file" PRINT TAB(5); "/f"; : PRINT TAB(10); "To use user data settings (qfig_set.dat)" PRINT TAB(11); "instead of default settings" END SUB FUNCTION yesno$ KEY(17) OFF save$ = Ins(0).R LOCATE line3%, 42: PRINT "L-but=y|R-but=n"; bkey$ = "X" DO bkey$ = KeyIsTouched$ LOOP UNTIL bkey$ = "y" OR bkey$ = "n" OR lbut% <> 0 OR rbut% <> 0 ' which key has been typed so far ' 1:motion 2:space or left button ' 3:return or right button 4:delete or both button (sensitive) IF bkey$ <> "" THEN yesno$ = bkey$ KEY(17) ON EXIT FUNCTION ELSEIF mouswitch% THEN IF lbut% <> 0 THEN yesno$ = "y" DO MousePoll row%, col%, lbut%, rbut% '<=== when Mouse is used LOOP UNTIL lbut% = 0 END IF IF rbut% <> 0 THEN yesno$ = "n" DO MousePoll row%, col%, lbut%, rbut% '<=== when Mouse is used LOOP UNTIL rbut% = 0 END IF END IF LOCATE line3%, 42: PRINT save$; KEY(17) ON END FUNCTION