' 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