home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / bus / lucnv.ba < prev    next >
Text File  |  2006-10-19  |  7KB  |  113 lines
  1. 1 'LUCNV.BA by Dave Lapinski (c) 1987
  2. 2 CLEAR600:GOTO4
  3. 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. 4 MAXFILES=3:INPUT"ENTER NAME OF DEVICE FOR OUTPUT";DV$:IF DV$="" THEN DV$="RAM:"
  5. 5 A$="RAM: CAS: LCD: LPT: 0:": IF INSTR(1,A$,DV$) <> 0 THEN 7
  6. 6 PRINT"ERROR IN DEVICE NAME, MUST BE           ";A$:PRINT" YOU ENTERED '";DV$:GOTO4
  7. 7 IF RIGHT$(DV$,1)<>":" THEN DV$=DV$+":"
  8. 8 DIM FN$(15),AL$(15),B(20),BC$(20),NX(20),ST(20): GOSUB7000
  9. 9 PS=HIMEM+1:PE=MAXRAM-1:P1=PS-1
  10. 10 CLS:PRINT"Convert Lucid file to VISICALC file.":CL$=CHR$(13)+CHR$(10)
  11. 20 INPUT"Enter Lucid File Name: ";CA$:IF CA$="" OR CA$="Menu" THEN MENU ELSE IF CA$="Files" THEN FILES:GOTO20 
  12. 22 IF INSTR(CA$,".") THEN CA$=LEFT$(CA$,INSTR(CA$,".")-1)
  13. 30 GOSUB5000:IF CA=0 THENPRINT"Can't find ";CA$:GOTO20
  14. 40 CA$= DV$+CA$+".DO" :OPEN CA$ FOR OUTPUT AS 1
  15. 50 GOSUB3:IF PEEK(CA)<>255 OR PEEK(CA+1) <>255 THEN PRINT"Not a Lucid file, does not start with FFFF":CLOSE:RUN
  16. 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("")
  17. 61 GOSUB3:IF PEEK(CA+CS-3)<>0 OR PEEK(CA+CS-2)<>0 OR PEEK(CA+CS-1)<>3 THEN CS=263
  18. 100 IF BE<=CS THEN 1010
  19. 110 GOSUB3:BL=PEEK(CA+BE):BB=BE-BL+1:CP=BB-1:VI$=">"
  20. 120 GOSUB6000:VI$=VI$+A$+":"
  21. 130 CP=CP+1:GOSUB3:IF(PEEK(CA+CP) AND 127) <> BL THEN PRINT"Error- block length inconsistent at: ";CP,CA:CLOSE:STOP
  22. 140 GOSUB3:IF (PEEK(CA+CP) AND 128) <>0 THEN GOTO150 
  23. 141 TC$=CHR$(13):GOSUB4000:IF LEFT$(A$,1)=CHR$(34) THEN VI$=VI$+"/FR"+A$+CL$:GOTO1000 
  24. 142 IF LEFT$(A$,1)=CHR$(39) THEN VI$=VI$+"/FL"+CHR$(34)+RIGHT$(A$,LEN(A$)-1)+CL$:GOTO1000 
  25. 143 VI$=VI$+"/FD"+CHR$(34)+A$+CL$:GOTO1000 
  26. 150 CP=CP+2:C1=PEEK(CA+CP-1):C2=PEEK(CA+CP)
  27. 151IF(C2 AND 16) <> 0 THEN VI$=VI$+"/F$" ELSE IF (C1 AND 240) =0 THEN VI$=VI$+"/FI" ELSE VI$=VI$+"/FD"
  28. 160 IF (C1 AND 15) =0 THEN TC$=CHR$(13):GOSUB4000:VI$=VI$+A$+CL$:GOTO1000
  29. 170 CP=BB+12:BE=BE-1:IF CP>BE THEN PRINT"Error in formula ";CP,VI$:CLOSE:STOP
  30. 180 SP=-1:BC$(0)=CHR$(13):GOSUB200:GOSUB3000:VI$=VI$+CL$:GOTO1000
  31. 200 SP=SP+1:ST(SP)=LEN(VI$)
  32. 210 CP=CP+1:IF CP>=BE THEN RETURN ELSE GOSUB3:A=PEEK(CA+CP)
  33. 211IF CHR$(A)=LEFT$(BC$(SP),1) THEN VI$=VI$+BC$(SP):RETURN 
  34. 212IF(A AND 7) >6 THEN PRINT"Error-- formula prefix code out of range: ";A,CP,VI$:CLOSE:STOP
  35. 220 IF (A AND 7) >1 THEN VI$=VI$+MID$("+-*/^",(A AND 7) -1,1)
  36. 230 A=INT(A/16):IF A>11 THEN VI$=VI$+"-":A=A-4
  37. 240 IF A=8 THEN GOSUB6000:VI$=VI$+A$:GOTO210
  38. 250 IF A=9 THEN TC$=CHR$(13):GOSUB4010:VI$=VI$+A$:GOTO210
  39. 260 IF A=10 THEN CP=CP+1:GOSUB3:A=PEEK(CA+CP):B(SP)=A-128
  40. 261IF B(SP)>15 THEN PRINT"Error function code > 15: ";B(SP),CP,VI$:CLOSE:STOP
  41. 270 NX(SP)=0:IF B(SP)=1 AND RIGHT$(VI$,1)="+" THEN VI$=LEFT$(VI$,LEN(VI$)-1)
  42. 271 VI$=VI$+FN$(B(SP)):
  43. 275 NX(SP)=NX(SP)+1:IF NX(SP)>LEN(AL$(B(SP))) THEN 320
  44. 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
  45. 290 IF B$="A" THEN TC$=",":GOSUB4000:VI$=VI$+CHR$(34)+A$+CHR$(34)+",":GOTO275
  46. 300 IF B$="R" THEN GOSUB6000:VI$=VI$+A$:GOTO275
  47. 310 VI$=VI$+B$:GOTO275
  48. 320 CP=CP+1:GOSUB3:A=PEEK(CA+CP):IF CHR$(A)<>")" THEN GOTO330 
  49. 321 VI$=VI$+")":IF B(SP)=1 THEN GOSUB500 ELSE IF B(SP)=13 THEN GOSUB600
  50. 325 GOTO210
  51. 330 PRINT"ERROR IN FUNCTION, NO ) AT END,  CP=";CP," VI$=";VI$:CLOSE:STOP
  52. 500 VI$=VI$+"*@RAND":RETURN
  53. 600 L1=INSTR(1,VI$,"`"):L2=INSTR(1,VI$,"~")
  54. 601IF L1=0 OR L2=0 OR L2<=L1 THEN PRINT"ERROR IN DECODING TABLE ";VI$,B(SP),CP:CLOSE:STOP
  55. 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$+","
  56. 620 L4=INSTR(1,C$,"."):A1$="":FOR I=L4-1 TO 1 STEP-1:A$=MID$(C$,I,1)
  57. 621IF A$<="9" AND A$>="0" THEN 622 ELSE 623
  58. 622A1$=A$+A1$:NEXT I:PRINT"CAN'T DECODE ADDRESS AT 620";C$,VI$:CLOSE:STOP 
  59. 623 A1=VAL(A1$)
  60. 630 A1$="":FOR I=LEN(C$) TO L4+3 STEP-1:A$=MID$(C$,I,1)
  61. 631IF A$<="9" AND A$>="0" THEN A1$=A$+A1$:NEXT I:PRINT"CAN'T DECODE ADDRESS AT 630";C$,VI$:CLOSE:STOP 
  62. 635 A2=VAL(A1$):A2=A2+1:A1$=STR$(A2):GOSUB690:VI$=VI$+LEFT$(C$,I)+A1$+","
  63. 640 A=A2-A1:A1$=STR$(A):GOSUB690:VI$=VI$+A1$+"))":RETURN
  64. 690 IF LEFT$(A1$,1)=" " THEN A1$=RIGHT$(A1$,LEN(A1$)-1):GOTO690 ELSE RETURN
  65. 1000 GOSUB2000:VI$="":BE=BB-1:GOTO100
  66. 1010 CLOSE :PRINT"End of conversion"
  67. 1080 STOP
  68. 2000 PRINT#1,VI$;:IF LEFT$(CA$,4)<>"LCD:" THEN PRINTVI$;:RETURN ELSE RETURN
  69. 3000 FOR OP=4 TO 2 STEP-1
  70. 3010 KL=ST(SP)+1
  71. 3020 L=INSTR(KL,VI$,MID$("+-*/^",OP+1,1)):IF L=0 THEN 3300
  72. 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
  73. 3040 IF PA>0 THEN 3100
  74. 3050 A=INSTR(1,"+-*/^",A$)-1:IF A<0 THEN 3100
  75. 3060 IF INT(A/2)=INT(OP/2) THEN GOTO3200
  76. 3070 IFINT(A/2)>INT(OP/2) THEN GOTO3100
  77. 3075 IF A<2 AND INSTR(1,"+-*/^(",MID$(VI$,M-1,1))<>0 THEN GOTO3100
  78. 3080 VI$=LEFT$(VI$,M)+"("+RIGHT$(VI$,LEN(VI$)-M):GOTO3110
  79. 3100 NEXTM:GOTO3200
  80. 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
  81. 3120 IF PA>0 THEN 3190
  82. 3130 A=INSTR(1,"+-*/^",A$)-1:IF A<0 THEN 3190
  83. 3140 IF INT(A/2)>=INT(OP/2) THEN GOTO3190
  84. 3145 IF  (INSTR(1,"+-*/^(",MID$(VI$,M-1,1))<>0) AND (A<2) THEN GOTO3190
  85. 3150 VI$=LEFT$(VI$,M-1)+")"+RIGHT$(VI$,LEN(VI$)-M+1):GOTO3200
  86. 3190 NEXTM :VI$=VI$+")"
  87. 3200 KL=L+1:IF KL>=LEN(VI$) THEN GOTO3300 ELSE GOTO3020
  88. 3300 NEXT OP:RETURN
  89. 4000 A$="":FOR I=CP+1 TO BE-1:GOSUB3:IF CHR$(PEEK(CA+I)) =TC$ THEN CP=I:RETURN 
  90. 4001 A$=A$+CHR$(PEEK(CA+I) AND 127):NEXT I:RETURN
  91. 4010 A$="":FOR I=CP+1 TO BE:GOSUB3:IF INSTR("0123456789.+-",CHR$(PEEK(CA+I)))=0 THEN CP=I-1:RETURN 
  92. 4011A$=A$+CHR$(PEEK(CA+I)):NEXT I
  93. 4012PRINT"Error - did not find terminal character from ";CP+1;" to ";BE;" A$=";A$;" TC$=";TC$:STOP
  94. 5000 FOR I=1 TO LEN(CA$):A$=MID$(CA$,I,1)
  95. 5001IF A$>"_" THEN MID$(CA$,I,1)=CHR$(ASC(A$) AND 95):NEXT I:CD$=LEFT$(CA$+"      ",6)+"CA":GOTO5010
  96. 5002 NEXT I:CD$=LEFT$(CA$+"      ",6)+"CA"
  97. 5010 CA=0:D$="":DA=VARPTR(D$):POKE DA+1,186:POKEDA+2,249:POKEDA,19*11
  98. 5020 FORI=1 TO 19*11 STEP11
  99. 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
  100. 5030 NEXT:RETURN
  101. 6000 CP=CP+2:GOSUB3:R=PEEK(CA+CP-1):C=PEEK(CA+CP)
  102. 6010 R$=STR$(R):AB=C AND 128:C=C AND 127
  103. 6020 IF LEFT$(R$,1)=" " THEN R$=RIGHT$(R$,LEN(R$)-1):GOTO6020
  104. 6030 C1=INT((C-1)/26):C2=C-26*C1:A$="":IF AB<>0 THEN A$="$"
  105. 6040 IF C1<>0 THEN A$=A$+CHR$(64+C1)+CHR$(64+C2) ELSE A$=A$+CHR$(64+C2)
  106. 6050 IF AB<>0 THEN A$=A$+"$"+R$: RETURN ELSE A$=A$+R$:RETURN
  107. 7000 DATA "(","N","+(","N","@SQRT(","N","@LN(","N"
  108. 7010 DATA "@EXP(","N","@COS(","N","@SIN(","N","@TAN(","N"
  109. 7020 DATA "@ATAN(","N","@INT(","N","@REF(","AR"
  110. 7030 DATA "@SUM(","R...R","@COUNT(","R...R","@VLOOKUP(","R`R~R...R"
  111. 7040 DATA "@MIN(","R...R","@MAX(","R...R"
  112. 7050 FOR I=0 TO 15:READ FN$(I),AL$(I):NEXTI:RETURN
  113.