summaryrefslogtreecommitdiff
path: root/support/qfig/src/qfigsub3.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/qfigsub3.bas
Initial commit
Diffstat (limited to 'support/qfig/src/qfigsub3.bas')
-rw-r--r--support/qfig/src/qfigsub3.bas620
1 files changed, 620 insertions, 0 deletions
diff --git a/support/qfig/src/qfigsub3.bas b/support/qfig/src/qfigsub3.bas
new file mode 100644
index 0000000000..9232e56c5f
--- /dev/null
+++ b/support/qfig/src/qfigsub3.bas
@@ -0,0 +1,620 @@
+' qfigsub3.bas
+
+'$INCLUDE: 'QB.BI'
+'REM $INCLUDE: 'MOUSE.BI'
+'$INCLUDE: 'QFIG.BI'
+
+SUB IO.Eepic
+' eepic format
+PRINT #1, "% Output of qfig.bas in eepic format"
+PRINT #1, "% \hspace{"; fnor$(xmax% - xmin%, .25); "mm}"
+PRINT #1, "% \vspace{"; fnor$(ymax% - ymin% + 10, .25); "mm}"
+PRINT #1, "\unitlength=.25mm"
+IF emulation% = 0 AND nocheat% = 0 THEN 'define \shade[]
+ PRINT #1, "\makeatletter"
+ PRINT #1, "\def\shade{\@ifnextchar[{\shade@special}{\@killglue\special{sh}\ignorespaces}}"
+ PRINT #1, "\def\shade@special[#1]{\@killglue\special{sh #1}\ignorespaces}"
+ PRINT #1, "\makeatother"
+END IF
+PRINT #1, "\begin{picture}("; fnor$(xmax% - xmin%, 1!); ",";
+PRINT #1, fnor$(ymax% - ymin% + 10, 1!); ")(";
+PRINT #1, fnor$(xmin%, 1!); ","; fnor$(-5!, 1!); ")"
+PRINT #1, "\thinlines"
+PRINT #1, "\typeout{\space\space\space eepic-ture exported by 'qfig'.";
+IF emulation% = 0 THEN PRINT #1, "}" ELSE PRINT #1, " (emulated)}"
+PRINT #1, "\font\FonttenBI=cmbxti10\relax"
+PRINT #1, "\font\FonttwlBI=cmbxti10 scaled \magstep1\relax"
+FOR i% = 0 TO nobj% - 1
+ON fnoo%(i%) GOSUB eepline, eepline, eepline, eepline, eepcirc, eeparc, eepellps, eepbox, eepbox, eepmsgs, eepline
+NEXT i%: PRINT #1, "%"
+PRINT #1, "\end{picture}": EXIT SUB
+' line object
+eepline:
+PRINT #1, "% object #"; i%;
+SELECT CASE fnoo%(i%)
+ CASE 1, 2
+ PRINT #1, " (line)"
+ CASE 3, 4
+ PRINT #1, " (curve)"
+ CASE 11
+ PRINT #1, " (arrow of #"; STR$(obj%(i%, 5)); " at"; STR$(obj%(i%, 6)); ")"
+END SELECT
+GOSUB eeplinethickness
+IF fnoo%(i%) = 11 OR obj%(i%, 5) = 0 THEN
+ PRINT #1, "\path ";
+ELSE
+ PRINT #1, eepicpattern$(obj%(i%, 5));
+END IF
+IF fnoo%(i%) = 3 OR fnoo%(i%) = 4 THEN
+ FOR k% = 0 TO obj%(i%, 1) - 2
+ x0% = xx(i%, k%): x1% = xx(i%, k% + 1): x2% = xx(i%, k% + 2)
+ y0% = yy(i%, k%): y1% = yy(i%, k% + 1): y2% = yy(i%, k% + 2)
+ G.XYparam x0%, y0%, x1%, y1%, x2%, y2%, ax, bx, cx, ay, by, cy
+ jlast% = interpolcurve% - 1
+ IF k% = obj%(i%, 1) - 2 THEN jlast% = 2 * interpolcurve%
+ FOR j% = 0 TO jlast%: t = CSNG(j%) / CSNG(interpolcurve%)
+ sx = ax * t * t + bx * t + cx: sy = ay * t * t + by * t + cy
+ PRINT #1, "("; fnor$(sx, 1!); ","; fnor$(ymax% - sy, 1!); ")";
+ IF j% <> jlast% AND INT((j% + 1) / 5) * 5 = j% + 1 THEN PRINT #1,
+ NEXT j%: PRINT #1, : NEXT k%
+ELSE
+ FOR j% = 0 TO obj%(i%, 1)
+ PRINT #1, "("; fnor$(xx(i%, j%), 1!); ","; fnor$(ymax% - yy(i%, j%), 1!); ")";
+ IF j% <> obj%(i%, 1) AND INT((j% + 1) / 5) * 5 = j% + 1 THEN PRINT #1,
+ NEXT j%: PRINT #1,
+END IF
+GOSUB eepobjectdone: RETURN
+' circle object
+eepcirc: PRINT #1, "% object #"; i%; " (circle)": GOSUB eeplinethickness
+PRINT #1, "\put("; fnor$(xx(i%, 0), 1!); ","; fnor$(ymax% - yy(i%, 0), 1!); ")";
+PRINT #1, "{\circle{"; fnor$(xx(i%, 2), 2!); "}}"
+GOSUB eepobjectdone: RETURN
+' arc object
+eeparc: PRINT #1, "% object #"; i%; " (arc)": GOSUB eeplinethickness
+emu$ = "": IF nocheat% = 0 AND emulation% = 1 THEN emu$ = "%"
+rr13 = yy(i%, 4) - yy(i%, 3): IF rr13 < 0! THEN rr13 = 2! * pi + rr13
+PRINT #1, emu$; "\put("; fnor$(xx(i%, 1), 1!); ","; fnor$(ymax% - yy(i%, 1), 1!); ")";
+PRINT #1, "{\arc{"; fnor$(xx(i%, 3), 2!); "}{"; fnor$(2! * pi - yy(i%, 4), 1!);
+PRINT #1, "}{"; fnor$(2! * pi - yy(i%, 4) + rr13, 1!); "}}"
+IF nocheat% = 0 AND emulation% = 1 THEN
+ PRINT #1, "\path"; 'approximation
+ rad = xx(i%, 3): rr1 = yy(i%, 3): rr3 = yy(i%, 4)
+ IF rr1 > rr3 THEN rr1 = rr1 - 2! * pi
+ jj% = INT((rr3 - rr1) / (pi / CSNG(interpolang%))) 'every 5-degrees
+ FOR j% = 0 TO jj%: t = rr1 + j% * (rr3 - rr1) / jj%
+ x1 = xx(i%, 1) + rad * COS(t): y1 = yy(i%, 1) - rad * SIN(t)
+ PRINT #1, "("; fnor$(x1, 1!); ","; fnor$(ymax% - y1, 1!); ")";
+ IF j% <> jj% AND INT((j% + 1) / 4) * 4 = j% + 1 THEN PRINT #1,
+ NEXT j%: PRINT #1,
+END IF
+GOSUB eepobjectdone: RETURN
+' ellipse object
+eepellps: PRINT #1, "% object #"; i%; " (ellipse)": GOSUB eeplinethickness
+IF yy(i%, 2) > 1! THEN
+ rrty = xx(i%, 2): rrtx = xx(i%, 2) / yy(i%, 2)
+ELSE
+ rrtx = xx(i%, 2): rrty = xx(i%, 2) * yy(i%, 2)
+END IF
+emu$ = "": IF nocheat% = 0 AND emulation% = 1 THEN emu$ = "%"
+PRINT #1, emu$; "\put("; fnor$(xx(i%, 0), 1!); ","; fnor$(ymax% - yy(i%, 0), 1!); ")";
+PRINT #1, "{\ellipse{";
+IF emulation% = 0 THEN
+ PRINT #1, fnor$(rrtx, 2!); "}{"; fnor$(rrty, 2!);
+ELSE
+ PRINT #1, fno$(rrtx, 2!); "}{"; fno$(rrty, 2!);
+END IF
+PRINT #1, "}}"
+IF nocheat% = 0 AND emulation% = 1 THEN 'approximation
+ PRINT #1, "\path";
+ x1 = xx(i%, 0) + rrtx: y1 = yy(i%, 0)
+ FOR jj% = 0 TO 2 * interpolang%
+ t = jj% * pi / CSNG(interpolang%) 'every 5 degrees
+ x1 = xx(i%, 0) + rrtx * COS(t): y1 = yy(i%, 0) - rrty * SIN(t)
+ PRINT #1, "("; fnor$(x1, 1!); ","; fno$(ymax% - y1, 1!); ")";
+ IF jj% <> 2 * interpolang% AND INT((jj% + 1) / 5) * 5 = jj% + 1 THEN PRINT #1,
+ NEXT jj%: PRINT #1,
+END IF
+GOSUB eepobjectdone: RETURN
+' box object with or w/o filling
+eepbox: PRINT #1, "% object #"; i%; " (rectangle)";
+IF fnoo%(i%) = 8 THEN PRINT #1, ELSE PRINT #1, " with filling"
+GOSUB eeplinethickness
+IF fnoo%(i%) = 9 THEN
+ PRINT #1, "\shade";
+ IF emulation% = 0 AND nocheat% = 0 THEN PRINT #1, tpicshade$(tpicshade%);
+END IF
+IF obj%(i%, 5) = 0 THEN
+ PRINT #1, "\path ";
+ELSE
+ PRINT #1, eepicpattern$(obj%(i%, 5));
+END IF
+PRINT #1, "("; fnor$(xx(i%, 0), 1!); ","; fnor$(ymax% - yy(i%, 0), 1!); ")";
+PRINT #1, "("; fnor$(xx(i%, 0), 1!); ","; fnor$(ymax% - yy(i%, 1), 1!); ")"
+PRINT #1, "("; fnor$(xx(i%, 1), 1!); ","; fnor$(ymax% - yy(i%, 1), 1!); ")";
+PRINT #1, "("; fnor$(xx(i%, 1), 1!); ","; fnor$(ymax% - yy(i%, 0), 1!); ")";
+PRINT #1, "("; fnor$(xx(i%, 0), 1!); ","; fnor$(ymax% - yy(i%, 0), 1!); ")"
+'
+IF nocheat% = 0 AND fnoo%(i%) = 9 AND obj%(i%, 6) <> 0 THEN
+ emu$ = "": IF emulation% = 0 THEN emu$ = "%" 'for ecleepic.sty
+ ji% = 5 - obj%(i%, 6)
+ ij% = ji% * SGN(yy(i%, 1) - yy(i%, 0))
+ jj% = INT(ABS(yy(i%, 0) - yy(i%, 1)) / ji% - .4)
+ jk% = ji% * SGN(xx(i%, 1) - xx(i%, 0)) / 2
+ IF jj% <= 1 THEN
+ jj% = 1
+ ij% = (yy(i%, 1) - yy(i%, 0)) / 2
+ END IF
+ PRINT #1, emu$; "\thinlines % substitute for shade pattern"
+ FOR j% = 1 TO jj%
+ PRINT #1, emu$; "\dottedline{"; fno$(ji%, 1); "}";
+ PRINT #1, "("; fnor$(xx(i%, 0) + jk%, 1!); ","; fnor$(ymax% - yy(i%, 0) - j% * ij%, 1!); ")";
+ PRINT #1, "("; fnor$(xx(i%, 1) - jk%, 1!); ","; fnor$(ymax% - yy(i%, 0) - j% * ij%, 1!); ")"
+ NEXT j%
+END IF
+GOSUB eepobjectdone: RETURN
+' messages
+eepmsgs: PRINT #1, "% object #"; i%; " (string)"
+ams$ = "": kanji% = 0: special% = 0: script% = 0
+FOR j% = 1 TO obj%(i%, 1)
+ IF wspec% = 1 THEN
+ TeX.Characters i%, j%, ams$, kanji%, special%, script%
+ ELSE
+ IF yy(i%, j%) = 0! THEN
+ a$ = CHR$(xx(i%, j%))
+ ams$ = ams$ + a$
+ END IF
+ END IF
+ NEXT j%
+IF script% <> 0 THEN ams$ = ams$ + "}}$"
+IF kanji% = 0 THEN
+ xy% = eheight(obj%(i%, 5)) * obj%(i%, 4) * ptmm / .25
+ELSE
+ xy% = jheight(obj%(i%, 5)) * obj%(i%, 4) * ptmm / .25
+END IF
+PRINT #1, "\put("; fnor$(xx(i%, 0), 1!); ",";
+PRINT #1, fnor$(ymax% - yy(i%, 0) - xy%, 1!); ")";
+IF obj%(i%, 6) <> 0 THEN
+ PRINT #1, "{\makebox(0,0)[cc]{"; chartex$((obj%(i%, 4) - 10) / 2, obj%(i%, 5));
+ELSE
+ PRINT #1, "{{"; chartex$((obj%(i%, 4) - 10) / 2, obj%(i%, 5));
+END IF
+IF kanji% <> 0 THEN PRINT #1, charjtex$((obj%(i%, 4) - 10) / 2, obj%(i%, 5));
+PRINT #1, ams$; "}}"
+RETURN
+' line thickness / line pattern set
+eeplinethickness:
+IF fnoo%(i%) = 9 THEN tpicshade% = obj%(i%, 6)
+'
+IF obj%(i%, 4) = 0 THEN RETURN
+IF obj%(i%, 4) = 1 THEN PRINT #1, "\thicklines": RETURN
+PRINT #1, "\Thicklines": RETURN
+' object save done : it is tedious but ..... OK
+eepobjectdone:
+IF obj%(i%, 4) = 0 THEN RETURN
+PRINT #1, "\thinlines": RETURN
+'
+END SUB
+
+SUB IO.Export
+' PiCTeX format
+PRINT #1, "% Output of qfig.bas in PiCTeX format"
+PRINT #1, "% \hspace{"; fno$(xmax% - xmin%, .25); "mm}"
+PRINT #1, "% \vspace{"; fno$(ymax% - ymin% + 10, .25); "mm}"
+PRINT #1, "\mbox{\beginpicture"
+PRINT #1, "\setcoordinatesystem units <.25mm,.25mm>"
+PRINT #1, "\unitlength=.25mm"
+PRINT #1, "\linethickness = .5pt"
+PRINT #1, "\setplotsymbol({\fiverm .})"
+PRINT #1, "\setplotarea x from "; xmin%; " to "; xmax%; ", y from ";
+PRINT #1, "0 to "; ymax% - ymin% + 10 'approx. 7pt is added for spacing
+PRINT #1, "\typeout{\space\space\space Picture exported by 'qfig'.}"
+PRINT #1, "\font\FonttenBI=cmbxti10\relax"
+PRINT #1, "\font\FonttwlBI=cmbxti10 scaled \magstep1\relax"
+FOR i% = 0 TO nobj% - 1
+ON fnoo%(i%) GOSUB expline, expline, expline, expline, expcirc, exparc, expellps, expbox, expbox, expmsgs, expline
+NEXT i%: PRINT #1, "%"
+PRINT #1, "\endpicture}": EXIT SUB
+' line object
+expline:
+PRINT #1, "% object #"; i%;
+SELECT CASE fnoo%(i%)
+ CASE 1, 2
+ PRINT #1, " (line)"
+ CASE 3, 4
+ PRINT #1, " (curve)"
+ CASE 11
+ PRINT #1, " (arrow of #"; STR$(obj%(i%, 5)); " at"; STR$(obj%(i%, 6)); ")"
+END SELECT
+GOSUB linethickness
+IF fnoo%(i%) = 3 OR fnoo%(i%) = 4 THEN
+ PRINT #1, "\setquadratic": PRINT #1, "\plot ";
+ FOR k% = 0 TO obj%(i%, 1) - 2
+ x0% = xx(i%, k%): x1% = xx(i%, k% + 1): x2% = xx(i%, k% + 2)
+ y0% = yy(i%, k%): y1% = yy(i%, k% + 1): y2% = yy(i%, k% + 2)
+ G.XYparam x0%, y0%, x1%, y1%, x2%, y2%, ax, bx, cx, ay, by, cy
+ jlast% = 4: IF k% = obj%(i%, 1) - 2 THEN jlast% = 10
+ FOR j% = 0 TO jlast%
+ t = j% / 5!: sx = ax * t * t + bx * t + cx: sy = ay * t * t + by * t + cy
+ PRINT #1, sx; ymax% - sy;
+ IF INT((j% + 1) / 5) * 5 = j% + 1 THEN PRINT #1,
+ NEXT j%: NEXT k%: PRINT #1, "/"
+ELSE
+ PRINT #1, "\setlinear"
+ FOR j% = 0 TO obj%(i%, 1) - 1: k% = j% + 1
+ IF xx(i%, j%) = xx(i%, k%) OR yy(i%, j%) = yy(i%, k%) THEN
+ PRINT #1, "\putrule from "; xx(i%, j%); ymax% - yy(i%, j%); " to "; xx(i%, k%); ymax% - yy(i%, k%)
+ ELSE
+ PRINT #1, "\plot "; xx(i%, j%); ymax% - yy(i%, j%); xx(i%, k%); ymax% - yy(i%, k%); "/"
+ END IF
+ NEXT j%
+END IF
+GOSUB objectdone: RETURN
+' circle object
+expcirc: PRINT #1, "% object #"; i%; " (circle)": GOSUB linethickness
+PRINT #1, "\circulararc 360 degrees from "; xx(i%, 1); ymax% - yy(i%, 1);
+PRINT #1, " center at "; xx(i%, 0); ymax% - yy(i%, 0)
+GOSUB objectdone: RETURN
+' arc object
+exparc: PRINT #1, "% object #"; i%; " (arc)": GOSUB linethickness
+rr13 = (yy(i%, 4) - yy(i%, 3)) * 180! / pi
+IF rr13 < 0! THEN rr13 = 360! + rr13
+PRINT #1, "\circulararc "; rr13; " degrees from ";
+PRINT #1, xx(i%, 0); ymax% - yy(i%, 0); " center at ";
+PRINT #1, xx(i%, 1); ymax% - yy(i%, 1)
+GOSUB objectdone: RETURN
+' ellipse object
+expellps: PRINT #1, "% object #"; i%; " (ellipse)": GOSUB linethickness
+IF yy(i%, 2) > 1! THEN
+ rrtx = 1!: rrty = yy(i%, 2)
+ELSE
+ rrty = 1!: rrtx = 1! / yy(i%, 2)
+END IF
+PRINT #1, "\ellipticalarc axes ratio "; MID$(STR$(rrtx), 2); ":"; MID$(STR$(rrty), 2);
+PRINT #1, " 360 degrees from "; xx(i%, 1); ymax% - yy(i%, 1)
+PRINT #1, "center at "; xx(i%, 0); ymax% - yy(i%, 0)
+GOSUB objectdone: RETURN
+' box object with or w/o filling
+expbox: PRINT #1, "% object #"; i%; " (rectangle)";
+IF fnoo%(i%) = 8 THEN PRINT #1, ELSE PRINT #1, " with filling"
+GOSUB linethickness
+IF fnoo%(i%) = 9 THEN
+ PRINT #1, "\setshadegrid span <"; SQR(2 ^ (3 - obj%(i%, 6))); "pt>"
+ PRINT #1, "\shaderectangleson"
+END IF
+PRINT #1, "\putrectangle ";
+PRINT #1, "corners at "; xx(i%, 0); ymax% - yy(i%, 0); " and "; xx(i%, 1); ymax% - yy(i%, 1)
+IF fnoo%(i%) = 9 THEN PRINT #1, "\shaderectanglesoff"
+GOSUB objectdone: RETURN
+' messages
+expmsgs: PRINT #1, "% object #"; i%; " (string)"
+ams$ = "": kanji% = 0: special% = 0: script% = 0
+FOR j% = 1 TO obj%(i%, 1)
+ IF wspec% = 1 THEN
+ TeX.Characters i%, j%, ams$, kanji%, special%, script%
+ ELSE
+ IF yy(i%, j%) = 0! THEN
+ a$ = CHR$(xx(i%, j%))
+ ams$ = ams$ + a$
+ END IF
+ END IF
+NEXT j%
+IF script% <> 0 THEN ams$ = ams$ + "}}$"
+PRINT #1, "\put{{"; chartex$((obj%(i%, 4) - 10) / 2, obj%(i%, 5));
+IF kanji% <> 0 THEN PRINT #1, charjtex$((obj%(i%, 4) - 10) / 2, obj%(i%, 5));
+'bbbbbbbbbbbbbbbbbbb
+IF kanji% = 0 THEN
+ xy% = eheight(obj%(i%, 5)) * obj%(i%, 4) * ptmm / .25
+ELSE
+ xy% = jheight(obj%(i%, 5)) * obj%(i%, 4) * ptmm / .25
+END IF
+IF obj%(i%, 6) <> 0 THEN
+ PRINT #1, ams$; "}}[cc] at "; xx(i%, 0); ymax% - yy(i%, 0) - xy%
+ELSE
+ PRINT #1, ams$; "}}[lt] at "; xx(i%, 0); ymax% - yy(i%, 0)
+END IF
+RETURN
+' line thickness / line pattern set
+linethickness:
+IF obj%(i%, 4) = 0 THEN GOTO dashpattern
+x1 = obj%(i%, 4): IF x1 = 0 THEN x1 = .5
+PRINT #1, "\linethickness ="; x1; "pt"
+IF fnoo%(i%) = 8 OR fnoo%(i%) = 9 THEN GOTO dashpattern
+' plotsymbol stolen from "xfig" on UNIX
+PRINT #1, "\setplotsymbol({\makebox(0,0)[l]{\tencirc\symbol{'16";
+PRINT #1, RIGHT$(STR$(obj%(i%, 4) - 1), 1); "}}})"
+dashpattern:
+IF obj%(i%, 5) = 0 OR fnoo%(i%) = 11 THEN RETURN
+PRINT #1, "\setdashpattern < "; dpattern$(obj%(i%, 5)); " >"
+RETURN
+' object save done : it is tedious but ..... OK
+objectdone:
+IF obj%(i%, 4) = 0 THEN GOTO objectdone1
+PRINT #1, "\linethickness = .5pt"
+PRINT #1, "\setplotsymbol({\fiverm .})"
+objectdone1:
+IF obj%(i%, 5) <> 0 AND fnoo%(i%) <> 11 THEN PRINT #1, "\setsolid"
+RETURN
+'
+END SUB
+
+SUB IO.File
+' file operation
+STATIC nfilenoext$
+'
+KeySwitch 0
+KEY(17) OFF: KEY(19) OFF
+CursorDisplay px%, py%: SCREEN scrtype%
+CLS 0
+SCREEN scrtype%
+COLOR 7
+PRINT "File Operations: Select one or [ESC] to quit": PRINT
+FOR i% = 1 TO UBOUND(iomessages$)
+PRINT TAB(20); fno$(i%, 1); ". "; iomessages$(i%): NEXT i%
+'
+ifile% = 1: jfile% = 1
+rowold% = row%: colold% = col%
+savepx% = px%: savepy% = py%: savepxold% = pxold%: savepyold% = pyold%
+px% = pxo% + windowx%(wndwfctr%) / 2: py% = pyo% + windowy%(wndwfctr%) / 2
+col% = px%: row% = py%: rowrow% = row%
+'IF mouswitch% THEN MouseLocate py%, px% '<=== when Mouse is used
+'
+LOCATE 3, 19: COLOR 3: PRINT " 1.";
+COLOR 3: PRINT " "; iomessages$(1); : COLOR 7
+DO: a$ = KeyIsTouched$
+ IF jfile% <> ifile% THEN
+ LOCATE 2 + jfile%, 19: PRINT " "; fno$(jfile%, 1); ". "; iomessages$(jfile%);
+ LOCATE 2 + ifile%, 19: COLOR 3: PRINT " "; fno$(ifile%, 1); ".";
+ COLOR 3: PRINT " "; iomessages$(ifile%); : COLOR 7: jfile% = ifile%
+ END IF
+ SELECT CASE a$
+ CASE CHR$(&H0) + CHR$(UP)
+ IF ifile% > 1 THEN ifile% = ifile% - 1 ELSE ifile% = UBOUND(iomessages$)
+ CASE CHR$(&H0) + CHR$(DOWN)
+ IF ifile% < UBOUND(iomessages$) THEN ifile% = ifile% + 1 ELSE ifile% = 1
+ CASE CHR$(SP)
+ EXIT DO
+ CASE CHR$(CR)
+ EXIT DO
+ CASE IS >= CHR$(&H31)
+ IF a$ <= CHR$(&H37) THEN
+ ifile% = VAL(a$)
+ LOCATE 2 + jfile%, 19: PRINT " "; fno$(jfile%, 1); ". "; iomessages$(jfile%);
+ LOCATE 2 + ifile%, 19: COLOR 11: PRINT " "; fno$(ifile%, 1); ".";
+ COLOR 3: PRINT " "; iomessages$(ifile%);
+ COLOR 7: EXIT DO
+ END IF
+ CASE CHR$(&H1B)
+ GOTO filedone
+ CASE ""
+ IF mouswitch% THEN
+' MousePoll row%, col%, lbut%, rbut% '<=== when Mouse is used
+ IF lbut% <> 0 OR rbut% <> 0 THEN
+ EXIT DO
+ END IF
+ IF ABS(row% - rowrow%) > 4 THEN
+ IF row% > rowrow% THEN
+ IF ifile% < UBOUND(iomessages$) THEN ifile% = ifile% + 1 ELSE ifile% = 1
+ END IF
+ IF row% < rowrow% THEN
+ IF ifile% > 1 THEN ifile% = ifile% - 1 ELSE ifile% = UBOUND(iomessages$)
+ END IF
+ rowrow% = row%
+ END IF
+ END IF
+ END SELECT
+LOOP
+'
+LOCATE 4 + UBOUND(iomessages$), 1
+'
+SELECT CASE ifile%
+CASE 1 TO 3
+ shlcmd$ = "dir *.qfg /w"
+CASE 4 TO 6 'ELSE
+ shlcmd$ = "dir *.tex /w"
+CASE 7
+ QUIT0
+ EXIT SUB
+END SELECT
+'
+displaydirectory:
+SHELL shlcmd$
+PRINT : PRINT "Enter the file name : "; : Chr.Input nfilenoext$
+nfile$ = nfilenoext$
+IF nfile$ = "" THEN nfile$ = "$$gifq$$"
+i% = INSTR(nfile$, ":")
+pfile$ = LEFT$(nfile$, i%): nfile$ = MID$(nfile$, i% + 1)
+DO UNTIL INSTR(nfile$, "\") = 0
+ i% = INSTR(nfile$, "\")
+ pfile$ = pfile$ + LEFT$(nfile$, i%)
+ nfile$ = MID$(nfile$, i% + 1)
+LOOP
+i% = INSTR(nfile$, ".")
+IF i% <> 0 THEN
+ nfilenoext$ = LEFT$(LEFT$(nfile$, i% - 1), 8)
+ nfile$ = nfilenoext$ + LEFT$(MID$(nfile$, i%), 4)
+ IF ifile% >= 4 THEN nfile1$ = nfilenoext$: nfile1$ = nfile1$ + ".tex"
+ELSE
+ nfilenoext$ = LEFT$(nfile$, 8): nfile$ = nfilenoext$
+ nfile1$ = nfile$
+ IF ifile% >= 3 THEN nfile$ = nfile$ + ".qfg"
+ IF ifile% >= 4 THEN nfile1$ = nfile1$ + ".tex"
+END IF
+'
+nfilenoext$ = pfile$ + nfilenoext$: nfile$ = pfile$ + nfile$
+IF INSTR(nfile$, "*") <> 0 THEN
+ shlcmd$ = "dir /w " + nfile$
+ nfilenoext$ = nfile$
+ GOTO displaydirectory
+END IF
+'
+both% = 1
+ notexist% = 0: OPEN nfile$ FOR RANDOM AS #1 ' check the existence
+ IF LOF(1) = 0 THEN notexist% = 1: both% = 0 ' non-existent
+ CLOSE : IF notexist% = 1 THEN KILL nfile$
+
+ IF ifile% > 3 THEN
+ OPEN nfile1$ FOR RANDOM AS #1 ' check the existence
+ IF LOF(1) <> 0 THEN notexist% = 0: both% = both% + 2 ' existent
+ CLOSE : IF both% < 2 THEN KILL nfile1$
+ END IF
+
+IF notexist% = 0 AND ifile% < 3 THEN
+ OPEN nfile$ FOR INPUT AS #1
+ IO.Load ifile%: CLOSE
+ELSEIF ifile% > 2 THEN
+ IF notexist% = 0 THEN
+ PRINT : PRINT : PRINT TAB(10); "The file(s) '"; : COLOR 14
+ SELECT CASE both%
+ CASE 1
+ PRINT nfile$; : COLOR 7: PRINT "' already exists.": PRINT
+ CASE 2
+ PRINT nfile1$; : COLOR 7: PRINT "' already exists.": PRINT
+ CASE 3
+ PRINT nfile$; " & "; nfile1$; : COLOR 7: PRINT "' already exist.": PRINT
+ END SELECT
+ PRINT TAB(25); " ..... Do you want to overwrite (y/n)? ";
+ DO: res$ = INKEY$
+ LOOP UNTIL UCASE$(res$) = "Y" OR UCASE$(res$) = "N"
+ IF UCASE$(res$) = "N" THEN GOTO filedone
+ END IF
+ IF ifile% = 3 THEN
+ OPEN nfile$ FOR OUTPUT AS #1
+ IO.Save 3: CLOSE
+ ELSEIF ifile% >= 4 THEN
+ OPEN nfile$ FOR OUTPUT AS #1
+ IO.Save 3: CLOSE
+ OPEN nfile1$ FOR OUTPUT AS #1
+ IO.Save ifile%: CLOSE
+ END IF
+END IF
+filedone:
+row% = rowold%: col% = colold%
+px% = savepx%: py% = savepy%: pxold% = savepxold%: pyold% = savepyold%
+KeySwitch 1
+SCREEN scrtype%: CL.R.edraw 0, 0: CursorDisplay px%, py%
+KeyDisplay
+KEY(17) ON: KEY(19) ON
+'
+END SUB
+
+SUB IO.Load (ifile%)
+' load data
+
+IF nobj% <> 0 THEN
+ PRINT : PRINT CHR$(7); "Are you sure you don't want to save"
+ PRINT "current file...(y/n)"
+ DO: aaa$ = INKEY$: LOOP UNTIL (aaa$ <> "" AND INSTR("yYnN", aaa$))
+ IF (aaa$ = "n") OR (aaa$ = "N") THEN EXIT SUB
+END IF
+
+nobjstart% = 0: IF ifile% = 2 THEN nobjstart% = nobj%
+INPUT #1, aaa$
+IF aaa$ <> FILE.CHECK$ THEN
+ PRINT : PRINT CHR$(7); "This is not a QFIG file."
+ PRINT "hit any key...": CLOSE
+ DO: aaa$ = INKEY$: LOOP UNTIL aaa$ <> ""
+ELSE
+ nobj% = nobjstart%
+ CLS 0
+ IF ifile% = 2 THEN
+ INPUT #1, i%, j%, k%, L%
+' CLS 0
+ ELSE
+ INPUT #1, xmin%, xmax%, ymin%, ymax%
+ END IF
+ LOCATE 12, 30: COLOR 10: PRINT msgload$; : COLOR 7
+ SLEEP 1
+ DO UNTIL EOF(1)
+ INPUT #1, obj%(nobj%, 0), obj%(nobj%, 1), obj%(nobj%, 2), obj%(nobj%, 3), obj%(nobj%, 4), obj%(nobj%, 5), obj%(nobj%, 6)
+ IF obj%(nobj%, 0) = 11 THEN obj%(nobj%, 5) = obj%(nobj%, 5) + nobjstart%
+ 'check to see if loaded string is boxtext.
+ IF obj%(nobj%, 0) = 10 THEN
+ IF obj%(nobj%, 6) <> 0 THEN
+ obj%(nobj%, 6) = obj%(nobj%, 6) + nobjstart%
+ END IF
+ END IF
+ FOR i% = 0 TO obj%(nobj%, 1)
+ INPUT #1, xx(nobj%, i%), yy(nobj%, i%): NEXT i%
+ nobj% = nobj% + 1
+ LOOP
+END IF
+'
+END SUB
+
+SUB IO.Save (ifile%)
+' save data
+IF wrong% <> 1 THEN
+ CL.R.edraw -1, 1
+ CursorDisplay px%, py%
+END IF
+CLS 0
+LOCATE 12, 30: COLOR 10: PRINT msgsave$; : COLOR 7
+SELECT CASE ifile%
+ CASE 3
+' simple format
+ PRINT #1, FILE.CHECK$
+ PRINT #1, xmin%; xmax%; ymin%; ymax%
+ FOR i% = 0 TO nobj% - 1
+ PRINT #1, fnoo%(i%); obj%(i%, 1); obj%(i%, 2); obj%(i%, 3); obj%(i%, 4); obj%(i%, 5); obj%(i%, 6)
+ FOR j% = 0 TO obj%(i%, 1): PRINT #1, xx(i%, j%); yy(i%, j%): NEXT j%
+ NEXT i%
+ CASE 4
+ IO.Export
+ CASE 5
+ emulation% = 0
+ IO.Eepic
+ CASE 6
+ emulation% = 1
+ IO.Eepic
+END SELECT
+'
+END SUB
+
+SUB TeX.Characters (i%, j%, ams$, kanji%, special%, script%)
+' output TeX Special Characters
+kanji% = kanji% + INT(yy(i%, j%))
+IF yy(i%, j%) = 0! THEN
+ a$ = CHR$(xx(i%, j%))
+ IF special% = 0 AND a$ = "\" THEN special% = 1: EXIT SUB
+ IF INSTR("^\@_", a$) <> 0 THEN
+ IF special% = 0 AND INSTR("^@_", a$) <> 0 THEN
+ SELECT CASE a$
+ CASE "@"
+ IF script% = 0 THEN EXIT SUB
+ a$ = "}}$"
+ script% = 0
+ CASE ELSE
+ IF a$ = "^" AND script% = 1 THEN EXIT SUB
+ IF a$ = "_" AND script% = 2 THEN EXIT SUB
+ IF a$ = "^" THEN script% = 1 ELSE script% = 2
+ a$ = "$" + a$ + "{\mbox{"
+ IF obj%(i%, 4) = 10 THEN a$ = a$ + "\viipt " ELSE a$ = a$ + "\viiipt "
+ END SELECT
+ ELSE
+ special% = 0
+ IF a$ = "^" THEN
+ a$ = "{\tt\symbol{'136}}"
+ ELSEIF a$ = "\" THEN
+ a$ = "{\tt\symbol{'134}}"
+ ELSEIF a$ = "_" THEN
+ a$ = "\_"
+ END IF
+ END IF
+ ELSE
+ IF special% = 1 THEN special% = 0
+ IF INSTR("#$%&{}", a$) <> 0 THEN
+ a$ = "\" + a$
+ ELSEIF INSTR("<>-|", a$) <> 0 THEN
+ a$ = "$" + a$ + "$"
+ ELSEIF a$ = "~" THEN
+ a$ = "{\tt\symbol{'176}}"
+ END IF
+ END IF
+ IF ASC(a$) < &H20 OR ASC(a$) > &H7E THEN a$ = " "
+ ams$ = ams$ + a$
+ELSE
+ ams$ = ams$ + STRING$(1, VAL("&j" + HEX$(yy(i%, j%)) + HEX$(xx(i%, j%))))
+END IF
+'
+END SUB
+