summaryrefslogtreecommitdiff
path: root/support/qfig/src/qfigsub4.bas
blob: 1f573b9240cfcffd76b7b437edeb6bd86bd8e2ed (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
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