summaryrefslogtreecommitdiff
path: root/support/qfig/src/qfigsub4.bas
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/qfig/src/qfigsub4.bas
Initial commit
Diffstat (limited to 'support/qfig/src/qfigsub4.bas')
-rw-r--r--support/qfig/src/qfigsub4.bas347
1 files changed, 347 insertions, 0 deletions
diff --git a/support/qfig/src/qfigsub4.bas b/support/qfig/src/qfigsub4.bas
new file mode 100644
index 0000000000..1f573b9240
--- /dev/null
+++ b/support/qfig/src/qfigsub4.bas
@@ -0,0 +1,347 @@
+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
+