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
