cnCalc计算器论坛 [原fx-es(ms)论坛]

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 52|回复: 0

[纯编程、古董] 发现 Sharp PC-G850 的一个有趣的内置程序 BASE-n

[复制链接]
发表于 2018-9-14 19:23:54 | 显示全部楼层 |阅读模式

最近在研究手头的 `Sharp PC-G850VS`, 今天发现一个特别有趣的内置程序, 这台机器有个数制转换的功能, 就是最右边那列键里的 `)`键的第二键位 `BASE-n`, 通过 `SHIFT` + `)` 来调用,  结果发现原来按这个功能键的作用是把一段进行数制转换的 `BASIC` 程序加载到 `PROGRAM MODE` 模式下那个编辑区了, 可以过去查看, 大概100行左右的代码, 其中的乱码是日文, 就是下面这段:

```
100*INIT
110DT=7.13:DT$="0":BS$="10"
120*MENU
130KY$=""
140*MENU2
150LOCATE 0,0:PRINT " ***** n o› ¥›afi› ***** "
160PRINT "   1:∆≠≥ÿÆ∏   2:Õ›∂›    "
170PRINT "   3:ŒΩ≥      4:π≤a›    "
172PRINT "                        "
174LOCATE 0,5:PRINT "                        "
180IF DT=7.13 THEN DT=0:LOCATE 0,4:PRINT "(1,2,3,4)?              ":GOTO *KEY
190LOCATE 0,4:PRINT "["+BS$+"o›]="
200IF KY$<>"" GOTO 270
210GOSUB *FROMDT
220LOCATE 7,4:PRINT "                ":LOCATE 24- LEN DT$,4:PRINT DT$
230*KEY
240IF INKEY$ <>"" THEN *KEY
250*KEY2
260GOSUB *GETKEY
270ON ASC KY$-&H30 GOTO *INDATA,*ROT,*REV,*CALC
280IF KY$="+" OR KY$="-" OR KY$="*" OR KY$="/" OR KY$="A" OR KY$="O" OR KY$="X" THEN *CALC2
290IF KY$="N" GOTO 810
300GOTO *KEY2
310*INDATA
320LOCATE 0,4:PRINT "["+BS$+"o›]                  ":LOCATE 6,4:INPUT "=";DT$
330GOSUB *TTDT:IF CC=0 THEN *MENU
340GOSUB *ERROR:KY$="1":GOTO *MENU2
350*REV
360DT=-DT:GOTO *MENU
370*ROT
380IF BS$="10" THEN BS$="16":GOTO *MENU
390IF BS$="16" THEN BS$=" 2":GOTO *MENU
400BS$="10":GOTO *MENU
410*FROMDT
420LOCATE 7,4:PRINT "                 "
430GOSUB *ADJUST:CC=DT:DT$="":II= VAL BS$
440IF BS$="10" THEN DT$= STR$ CC:RETURN
450IF CC<0 THEN CC=CC+&H10000
460JJ=CC- INT (CC/II)*II:CC=(CC-JJ)/II
470IF JJ>9 THEN JJ=JJ+7
480DT$= CHR$ (48+JJ)+DT$
490IF CC>0 THEN 460
500IF BS$="16" THEN DT$= RIGHT$ ("0000"+DT$,4):RETURN
510DT$= RIGHT$ ("0000000000000000"+DT$,16):RETURN
520*TTDT
530CC=1:IF BS$<>"10" THEN 560
540IF LEFT$ (DT$,1)="+" THEN DT$= RIGHT$ (DT$, LEN DT$-1):GOTO 560
550IF LEFT$ (DT$,1)="-" THEN DT$= RIGHT$ (DT$, LEN DT$-1):CC=-1
560DT=0:FOR II= LEN DT$-1 TO 0 STEP -1:JJ= ASC MID$ (DT$, LEN DT$-II,1)-&H30
570IF 0<=JJ AND JJ< VAL BS$ AND JJ<10 THEN 600
580JJ=JJ-7:IF 10<=JJ AND JJ<16 AND JJ< VAL BS$ THEN 600
590CC=1:II=0:NEXT II:RETURN
600DT=DT* VAL BS$+JJ
610NEXT II
620IF ABS DT>=1E10 THEN CC=1:RETURN
630DT=DT*CC:CC=0:GOSUB *ADJUST:RETURN
640*CALC
650KY$=""
660*CALC2
670LOCATE 0,0:PRINT " ***** n o› ¥›afi› ***** "
672PRINT "   1:∆≠≥ÿÆ∏   2:Õ›∂›    "
674PRINT "   3:ŒΩ≥      4:π≤a›    "
676PRINT "                        "
680PRINT "["+BS$+"o›]                  "
690LOCATE 24- LEN DT$,4:PRINT DT$
700IF KY$<>"" THEN 740
710LOCATE 0,5:PRINT "(+,-,*,/,A,O,N,X)?      "
720GOSUB *GETKEY
730IF KY$<>"+" AND KY$<>"-" AND KY$<>"*" AND KY$<>"/" AND KY$<>"A" AND KY$<>"O" AND KY$<>"N" AND KY$<>"X" THEN 720
740LOCATE 0,5:PRINT "                        ":LOCATE 0,5:TD=DT:TD$=DT$
750IF KY$="+" THEN INPUT "+";DT$
760IF KY$="-" THEN INPUT "-";DT$
770IF KY$="*" THEN INPUT "*";DT$
780IF KY$="/" THEN INPUT "/";DT$
790IF KY$="A" THEN INPUT "AND";DT$
800IF KY$="O" THEN INPUT "OR";DT$
810IF KY$="N" THEN DT= NOT DT:GOTO 930
820IF KY$="X" THEN INPUT "XOR";DT$
830GOSUB *TTDT:IF CC=0 THEN 850
840DT=TD:DT$=TD$:GOSUB *ERROR2:GOTO 660
850IF KY$="+" THEN DT=TD+DT
860IF KY$="-" THEN DT=TD-DT
870IF KY$="*" THEN DT=TD*DT
880IF (KY$="/") AND (DT=0) THEN 840
890IF KY$="/" THEN DT=TD/DT
900IF KY$="A" THEN DT=TD AND DT
910IF KY$="O" THEN DT=TD OR DT
920IF KY$="X" THEN DT=(TD AND ( NOT DT)) OR (( NOT TD) AND DT)
930GOSUB *ADJUST:GOTO *MENU
940*ADJUST
950DT= SGN DT* INT ABS DT
960IF DT>&HFFFF THEN DT=DT- INT (DT/&H10000)*&H10000
970IF DT>&H7FFF THEN DT=DT-&H10000
980IF DT<-&HFFFF THEN DT=DT+ INT (-DT/&H10000)*&H10000
990IF DT<-&H8000 THEN DT=DT+&H10000
1000RETURN
1010*ERROR
1020LOCATE 7,4:PRINT "ERROR            ":BEEP 2:RETURN
1030*ERROR2
1040LOCATE 0,5:PRINT "ERROR                   ":BEEP 2:RETURN
1050*GETKEY
1060II=2773*12
1070II=II-1:IF II<0 END
1080KY$= INKEY$ :IF KY$="" THEN 1070
1090RETURN

```
好像只有这个功能是这么实现的, 感觉好像是 ROM 没有空间了, 于是临时打了一个补丁..
您需要登录后才可以回帖 登录 | 注册

本版积分规则

联系站长|Archiver|手机版|cnCalc计算器论坛  

GMT+8, 2018-9-25 19:49 , Processed in 0.021140 second(s), 21 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表