home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.whtech.com
/
ftp.whtech.com.tar
/
ftp.whtech.com
/
club100
/
bus
/
lucnv.ba
< prev
next >
Wrap
Text File
|
2006-10-19
|
7KB
|
113 lines
1 'LUCNV.BA by Dave Lapinski (c) 1987
2 CLEAR600:GOTO4
3 CA=0:D$="":DA=VARPTR(D$):POKE DA+1,186:POKE DA+2,249:POKE DA,19*11:CA=ASC(MID$(D$,IX+1,1))+256*ASC(MID$(D$,IX+2,1)):RETURN
4 MAXFILES=3:INPUT"ENTER NAME OF DEVICE FOR OUTPUT";DV$:IF DV$="" THEN DV$="RAM:"
5 A$="RAM: CAS: LCD: LPT: 0:": IF INSTR(1,A$,DV$) <> 0 THEN 7
6 PRINT"ERROR IN DEVICE NAME, MUST BE ";A$:PRINT" YOU ENTERED '";DV$:GOTO4
7 IF RIGHT$(DV$,1)<>":" THEN DV$=DV$+":"
8 DIM FN$(15),AL$(15),B(20),BC$(20),NX(20),ST(20): GOSUB7000
9 PS=HIMEM+1:PE=MAXRAM-1:P1=PS-1
10 CLS:PRINT"Convert Lucid file to VISICALC file.":CL$=CHR$(13)+CHR$(10)
20 INPUT"Enter Lucid File Name: ";CA$:IF CA$="" OR CA$="Menu" THEN MENU ELSE IF CA$="Files" THEN FILES:GOTO20
22 IF INSTR(CA$,".") THEN CA$=LEFT$(CA$,INSTR(CA$,".")-1)
30 GOSUB5000:IF CA=0 THENPRINT"Can't find ";CA$:GOTO20
40 CA$= DV$+CA$+".DO" :OPEN CA$ FOR OUTPUT AS 1
50 GOSUB3:IF PEEK(CA)<>255 OR PEEK(CA+1) <>255 THEN PRINT"Not a Lucid file, does not start with FFFF":CLOSE:RUN
60 GOSUB3:CL=PEEK(CA+2)+256*PEEK(CA+3):BE=CL+2:CS=157:PRINT"LENGTH OF FILE IS ";CL;" BYTES":PRINT"FREE SPACE =";FRE(0)-FRE("")
61 GOSUB3:IF PEEK(CA+CS-3)<>0 OR PEEK(CA+CS-2)<>0 OR PEEK(CA+CS-1)<>3 THEN CS=263
100 IF BE<=CS THEN 1010
110 GOSUB3:BL=PEEK(CA+BE):BB=BE-BL+1:CP=BB-1:VI$=">"
120 GOSUB6000:VI$=VI$+A$+":"
130 CP=CP+1:GOSUB3:IF(PEEK(CA+CP) AND 127) <> BL THEN PRINT"Error- block length inconsistent at: ";CP,CA:CLOSE:STOP
140 GOSUB3:IF (PEEK(CA+CP) AND 128) <>0 THEN GOTO150
141 TC$=CHR$(13):GOSUB4000:IF LEFT$(A$,1)=CHR$(34) THEN VI$=VI$+"/FR"+A$+CL$:GOTO1000
142 IF LEFT$(A$,1)=CHR$(39) THEN VI$=VI$+"/FL"+CHR$(34)+RIGHT$(A$,LEN(A$)-1)+CL$:GOTO1000
143 VI$=VI$+"/FD"+CHR$(34)+A$+CL$:GOTO1000
150 CP=CP+2:C1=PEEK(CA+CP-1):C2=PEEK(CA+CP)
151IF(C2 AND 16) <> 0 THEN VI$=VI$+"/F$" ELSE IF (C1 AND 240) =0 THEN VI$=VI$+"/FI" ELSE VI$=VI$+"/FD"
160 IF (C1 AND 15) =0 THEN TC$=CHR$(13):GOSUB4000:VI$=VI$+A$+CL$:GOTO1000
170 CP=BB+12:BE=BE-1:IF CP>BE THEN PRINT"Error in formula ";CP,VI$:CLOSE:STOP
180 SP=-1:BC$(0)=CHR$(13):GOSUB200:GOSUB3000:VI$=VI$+CL$:GOTO1000
200 SP=SP+1:ST(SP)=LEN(VI$)
210 CP=CP+1:IF CP>=BE THEN RETURN ELSE GOSUB3:A=PEEK(CA+CP)
211IF CHR$(A)=LEFT$(BC$(SP),1) THEN VI$=VI$+BC$(SP):RETURN
212IF(A AND 7) >6 THEN PRINT"Error-- formula prefix code out of range: ";A,CP,VI$:CLOSE:STOP
220 IF (A AND 7) >1 THEN VI$=VI$+MID$("+-*/^",(A AND 7) -1,1)
230 A=INT(A/16):IF A>11 THEN VI$=VI$+"-":A=A-4
240 IF A=8 THEN GOSUB6000:VI$=VI$+A$:GOTO210
250 IF A=9 THEN TC$=CHR$(13):GOSUB4010:VI$=VI$+A$:GOTO210
260 IF A=10 THEN CP=CP+1:GOSUB3:A=PEEK(CA+CP):B(SP)=A-128
261IF B(SP)>15 THEN PRINT"Error function code > 15: ";B(SP),CP,VI$:CLOSE:STOP
270 NX(SP)=0:IF B(SP)=1 AND RIGHT$(VI$,1)="+" THEN VI$=LEFT$(VI$,LEN(VI$)-1)
271 VI$=VI$+FN$(B(SP)):
275 NX(SP)=NX(SP)+1:IF NX(SP)>LEN(AL$(B(SP))) THEN 320
280 B$=MID$(AL$(B(SP)),NX(SP),1):IF B$="N" THEN BC$(SP+1)=")":GOSUB200:VI$=LEFT$(VI$,LEN(VI$)-1):CP=CP-1:SP=SP-1:GOTO275
290 IF B$="A" THEN TC$=",":GOSUB4000:VI$=VI$+CHR$(34)+A$+CHR$(34)+",":GOTO275
300 IF B$="R" THEN GOSUB6000:VI$=VI$+A$:GOTO275
310 VI$=VI$+B$:GOTO275
320 CP=CP+1:GOSUB3:A=PEEK(CA+CP):IF CHR$(A)<>")" THEN GOTO330
321 VI$=VI$+")":IF B(SP)=1 THEN GOSUB500 ELSE IF B(SP)=13 THEN GOSUB600
325 GOTO210
330 PRINT"ERROR IN FUNCTION, NO ) AT END, CP=";CP," VI$=";VI$:CLOSE:STOP
500 VI$=VI$+"*@RAND":RETURN
600 L1=INSTR(1,VI$,"`"):L2=INSTR(1,VI$,"~")
601IF L1=0 OR L2=0 OR L2<=L1 THEN PRINT"ERROR IN DECODING TABLE ";VI$,B(SP),CP:CLOSE:STOP
610 L3=LEN(VI$)-1:Y$=MID$(VI$,L1+1,L2-L1-1):C$=MID$(VI$,L2+1,L3-L2):VI$=LEFT$(VI$,L1-1)+","+C$+",@HLOOKUP("+Y$+","
620 L4=INSTR(1,C$,"."):A1$="":FOR I=L4-1 TO 1 STEP-1:A$=MID$(C$,I,1)
621IF A$<="9" AND A$>="0" THEN 622 ELSE 623
622A1$=A$+A1$:NEXT I:PRINT"CAN'T DECODE ADDRESS AT 620";C$,VI$:CLOSE:STOP
623 A1=VAL(A1$)
630 A1$="":FOR I=LEN(C$) TO L4+3 STEP-1:A$=MID$(C$,I,1)
631IF A$<="9" AND A$>="0" THEN A1$=A$+A1$:NEXT I:PRINT"CAN'T DECODE ADDRESS AT 630";C$,VI$:CLOSE:STOP
635 A2=VAL(A1$):A2=A2+1:A1$=STR$(A2):GOSUB690:VI$=VI$+LEFT$(C$,I)+A1$+","
640 A=A2-A1:A1$=STR$(A):GOSUB690:VI$=VI$+A1$+"))":RETURN
690 IF LEFT$(A1$,1)=" " THEN A1$=RIGHT$(A1$,LEN(A1$)-1):GOTO690 ELSE RETURN
1000 GOSUB2000:VI$="":BE=BB-1:GOTO100
1010 CLOSE :PRINT"End of conversion"
1080 STOP
2000 PRINT#1,VI$;:IF LEFT$(CA$,4)<>"LCD:" THEN PRINTVI$;:RETURN ELSE RETURN
3000 FOR OP=4 TO 2 STEP-1
3010 KL=ST(SP)+1
3020 L=INSTR(KL,VI$,MID$("+-*/^",OP+1,1)):IF L=0 THEN 3300
3030 PA=0:FOR M=L-1 TO ST(SP)+2 STEP-1:A$=MID$(VI$,M,1):IF A$=")" THEN PA=PA+1 ELSE IF A$="(" THEN PA=PA-1:IF PA<0 THEN GOTO3200
3040 IF PA>0 THEN 3100
3050 A=INSTR(1,"+-*/^",A$)-1:IF A<0 THEN 3100
3060 IF INT(A/2)=INT(OP/2) THEN GOTO3200
3070 IFINT(A/2)>INT(OP/2) THEN GOTO3100
3075 IF A<2 AND INSTR(1,"+-*/^(",MID$(VI$,M-1,1))<>0 THEN GOTO3100
3080 VI$=LEFT$(VI$,M)+"("+RIGHT$(VI$,LEN(VI$)-M):GOTO3110
3100 NEXTM:GOTO3200
3110 PA=0:FOR M=L+2 TO LEN(VI$):A$=MID$(VI$,M,1):IF A$="(" THEN PA=PA+1 ELSE IF A$=")" THEN PA=PA-1:IF PA<0 THEN GOTO3150
3120 IF PA>0 THEN 3190
3130 A=INSTR(1,"+-*/^",A$)-1:IF A<0 THEN 3190
3140 IF INT(A/2)>=INT(OP/2) THEN GOTO3190
3145 IF (INSTR(1,"+-*/^(",MID$(VI$,M-1,1))<>0) AND (A<2) THEN GOTO3190
3150 VI$=LEFT$(VI$,M-1)+")"+RIGHT$(VI$,LEN(VI$)-M+1):GOTO3200
3190 NEXTM :VI$=VI$+")"
3200 KL=L+1:IF KL>=LEN(VI$) THEN GOTO3300 ELSE GOTO3020
3300 NEXT OP:RETURN
4000 A$="":FOR I=CP+1 TO BE-1:GOSUB3:IF CHR$(PEEK(CA+I)) =TC$ THEN CP=I:RETURN
4001 A$=A$+CHR$(PEEK(CA+I) AND 127):NEXT I:RETURN
4010 A$="":FOR I=CP+1 TO BE:GOSUB3:IF INSTR("0123456789.+-",CHR$(PEEK(CA+I)))=0 THEN CP=I-1:RETURN
4011A$=A$+CHR$(PEEK(CA+I)):NEXT I
4012PRINT"Error - did not find terminal character from ";CP+1;" to ";BE;" A$=";A$;" TC$=";TC$:STOP
5000 FOR I=1 TO LEN(CA$):A$=MID$(CA$,I,1)
5001IF A$>"_" THEN MID$(CA$,I,1)=CHR$(ASC(A$) AND 95):NEXT I:CD$=LEFT$(CA$+" ",6)+"CA":GOTO5010
5002 NEXT I:CD$=LEFT$(CA$+" ",6)+"CA"
5010 CA=0:D$="":DA=VARPTR(D$):POKE DA+1,186:POKEDA+2,249:POKEDA,19*11
5020 FORI=1 TO 19*11 STEP11
5021IF ASC(MID$(D$,I))=128+32 THEN IF MID$(D$,I+3,8)=CD$ THEN CA=ASC(MID$(D$,I+1))+256*ASC(MID$(D$,I+2)):IX=I
5030 NEXT:RETURN
6000 CP=CP+2:GOSUB3:R=PEEK(CA+CP-1):C=PEEK(CA+CP)
6010 R$=STR$(R):AB=C AND 128:C=C AND 127
6020 IF LEFT$(R$,1)=" " THEN R$=RIGHT$(R$,LEN(R$)-1):GOTO6020
6030 C1=INT((C-1)/26):C2=C-26*C1:A$="":IF AB<>0 THEN A$="$"
6040 IF C1<>0 THEN A$=A$+CHR$(64+C1)+CHR$(64+C2) ELSE A$=A$+CHR$(64+C2)
6050 IF AB<>0 THEN A$=A$+"$"+R$: RETURN ELSE A$=A$+R$:RETURN
7000 DATA "(","N","+(","N","@SQRT(","N","@LN(","N"
7010 DATA "@EXP(","N","@COS(","N","@SIN(","N","@TAN(","N"
7020 DATA "@ATAN(","N","@INT(","N","@REF(","AR"
7030 DATA "@SUM(","R...R","@COUNT(","R...R","@VLOOKUP(","R`R~R...R"
7040 DATA "@MIN(","R...R","@MAX(","R...R"
7050 FOR I=0 TO 15:READ FN$(I),AL$(I):NEXTI:RETURN