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$ = "([email protected])"

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

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.