path: root/support/qfig/src/qfigsub4.bas

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