'======================================== 'BASIC interpreter for PasocomMini MZ-80C ' by AKIKAWA, Hisashi 2018.2.27 '======================================== option strict option defint '-------- 'constant '-------- var TYPE_NONE=0 var TYPE_NUM=1 var TYPE_STR=2 var MZ_WIDTH=40 var MZ_HEIGHT=25 var MZMEM_GETL =&h0003 'get line input var MZMEM_GETKEY=&h001b 'get key input var MZMEM_MSTART=&h0030 'music start var MZMEM_MSTOP =&h0047 'music stop var MZMEM_HOT =&h0082 'hot start var MZMEM_DACN =&h0bce 'convert display code to ascii code var MZMEM_TEMPO =&h119e 'set tempo var MZMEM_DSPX =&h1171 'x position var MZMEM_DSPY =&h1172 'y position var MZMEM_WORK =&h1200 'work area var MZMEM_VRAM =&hd000 'VRAM '---------------- 'system variables '---------------- var speed,ms_old,keytime1,keytime2 var keybuf var line,pos dim linenum[0],list$[0] dim cmdstr$[&h100],cmdlbl$[&h100],cmdfnc$[&h100] dim varname$[0],vartype[0],vardim[0],varsize1[0],varsize2[0],varp[0] dim varnum#[0],varstr$[0] dim forp[16],forto[16],forstep[16],forline[16],forpos[16] var nfor var dataline,datapos dim gosubline[0],gosubpos[0] dim fnname$[0],fnarg$[0],fnline[0],fnpos[0] var nfn var start_h,start_m,start_s '------------------- 'temporary variables '------------------- var i,j var x,y var c$ var p var addr var value#,value$ var name$,type '------------- 'BASIC command '------------- cmdstr$[&h80]="REM" :cmdlbl$[&h80]=@rem cmdstr$[&h81]="DATA" :cmdlbl$[&h81]=@data cmdstr$[&h82]="LIST" :cmdlbl$[&h82]=@list cmdstr$[&h83]="RUN" :cmdlbl$[&h83]=@run cmdstr$[&h84]="NEW" :cmdlbl$[&h84]=@new cmdstr$[&h85]="PRINT" :cmdlbl$[&h85]=@print cmdstr$[&h86]="LET" :cmdlbl$[&h86]=@let cmdstr$[&h87]="FOR" :cmdlbl$[&h87]=@for cmdstr$[&h88]="IF" :cmdlbl$[&h88]=@if cmdstr$[&h89]="GOTO" :cmdlbl$[&h89]=@goto cmdstr$[&h8a]="READ" :cmdlbl$[&h8a]=@read cmdstr$[&h8b]="GOSUB" :cmdlbl$[&h8b]=@gosub cmdstr$[&h8c]="RETURN" :cmdlbl$[&h8c]=@return cmdstr$[&h8d]="NEXT" :cmdlbl$[&h8d]=@next cmdstr$[&h8e]="STOP" :cmdlbl$[&h8e]=@stop cmdstr$[&h8f]="END" :cmdlbl$[&h8f]=@end cmdstr$[&h90]="ON" :cmdlbl$[&h90]=@on cmdstr$[&h91]="LOAD" :cmdlbl$[&h91]=@load cmdstr$[&h92]="SAVE" :cmdlbl$[&h92]=@save cmdstr$[&h93]="VERIFY" :cmdlbl$[&h93]=@verify cmdstr$[&h94]="POKE" :cmdlbl$[&h94]=@poke cmdstr$[&h95]="DIM" :cmdlbl$[&h95]=@dim cmdstr$[&h96]="DEF FN" :cmdlbl$[&h96]=@deffn cmdstr$[&h97]="INPUT" :cmdlbl$[&h97]=@input cmdstr$[&h98]="RESTORE":cmdlbl$[&h98]=@restore cmdstr$[&h99]="CLR" :cmdlbl$[&h99]=@clr cmdstr$[&h9a]="MUSIC" :cmdlbl$[&h9a]=@music cmdstr$[&h9b]="TEMPO" :cmdlbl$[&h9b]=@tempo cmdstr$[&h9c]="USR" :cmdlbl$[&h9c]=@usr cmdstr$[&h9d]="WOPEN" :cmdlbl$[&h9d]=@wopen cmdstr$[&h9e]="ROPEN" :cmdlbl$[&h9e]=@ropen cmdstr$[&h9f]="CLOSE" :cmdlbl$[&h9f]=@close cmdstr$[&ha0]="BYE" :cmdlbl$[&ha0]=@bye cmdstr$[&ha1]="LIMIT" :cmdlbl$[&ha1]=@limit cmdstr$[&ha2]="CONT" :cmdlbl$[&ha2]=@cont cmdstr$[&ha3]="SET" :cmdlbl$[&ha3]=@set cmdstr$[&ha4]="RESET" :cmdlbl$[&ha4]=@reset cmdstr$[&ha5]="GET" :cmdlbl$[&ha5]=@get cmdstr$[&ha6]="INP" :cmdlbl$[&ha6]=@inp cmdstr$[&ha7]="OUT" :cmdlbl$[&ha7]=@out cmdstr$[&had]="THEN" :cmdlbl$[&had]=@then cmdstr$[&hae]="TO" :cmdlbl$[&hae]=@to cmdstr$[&haf]="STEP" :cmdlbl$[&haf]=@step cmdstr$[&hb0]="><" :cmdfnc$[&hb0]="opr_ne" cmdstr$[&hb1]="<>" :cmdfnc$[&hb1]="opr_ne" cmdstr$[&hb2]="=<" :cmdfnc$[&hb2]="opr_le" cmdstr$[&hb3]="<=" :cmdfnc$[&hb3]="opr_le" cmdstr$[&hb4]="=>" :cmdfnc$[&hb4]="opr_ge" cmdstr$[&hb5]=">=" :cmdfnc$[&hb5]="opr_ge" cmdstr$[&hb6]="=" :cmdfnc$[&hb6]="opr_eq" cmdstr$[&hb7]=">" :cmdfnc$[&hb7]="opr_gt" cmdstr$[&hb8]="<" :cmdfnc$[&hb8]="opr_lt" cmdstr$[&hb9]="AND" :cmdfnc$[&hb9]="opr_and" cmdstr$[&hba]="OR" :cmdfnc$[&hba]="opr_or" cmdstr$[&hbb]="NOT" :cmdfnc$[&hbb]="opr_not" cmdstr$[&hbc]="+" :cmdfnc$[&hbc]="opr_add" cmdstr$[&hbd]="-" :cmdfnc$[&hbd]="opr_sub" cmdstr$[&hbe]="*" :cmdfnc$[&hbe]="opr_mul" cmdstr$[&hbf]="/" :cmdfnc$[&hbf]="opr_div" cmdstr$[&hc0]="LEFT$(" :cmdfnc$[&hc0]="fnc_left$" cmdstr$[&hc1]="RIGHT$(":cmdfnc$[&hc1]="fnc_right$" cmdstr$[&hc2]="MID$(" :cmdfnc$[&hc2]="fnc_mid$" cmdstr$[&hc3]="LEN(" :cmdfnc$[&hc3]="fnc_len" cmdstr$[&hc4]="CHR$(" :cmdfnc$[&hc4]="fnc_chr$" cmdstr$[&hc5]="STR$(" :cmdfnc$[&hc5]="fnc_str$" cmdstr$[&hc6]="ASC(" :cmdfnc$[&hc6]="fnc_asc" cmdstr$[&hc7]="VAL(" :cmdfnc$[&hc7]="fnc_val" cmdstr$[&hc8]="PEEK(" :cmdfnc$[&hc8]="fnc_peek" cmdstr$[&hc9]="TAB(" :cmdfnc$[&hc9]="fnc_tab" cmdstr$[&hca]="SPC(" :cmdfnc$[&hca]="fnc_spc" cmdstr$[&hcb]="SIZE" :cmdfnc$[&hcb]="fnc_size" cmdstr$[&hcf]="^" :cmdfnc$[&hcf]="opr_pow" cmdstr$[&hd0]="RND(" :cmdfnc$[&hd0]="fnc_rnd" cmdstr$[&hd1]="SIN(" :cmdfnc$[&hd1]="fnc_sin" cmdstr$[&hd2]="COS(" :cmdfnc$[&hd2]="fnc_cos" cmdstr$[&hd3]="TAN(" :cmdfnc$[&hd3]="fnc_tan" cmdstr$[&hd4]="ATN(" :cmdfnc$[&hd4]="fnc_atn" cmdstr$[&hd5]="EXP(" :cmdfnc$[&hd5]="fnc_exp" cmdstr$[&hd6]="INT(" :cmdfnc$[&hd6]="fnc_int" cmdstr$[&hd7]="LOG(" :cmdfnc$[&hd7]="fnc_log" cmdstr$[&hd8]="LN(" :cmdfnc$[&hd8]="fnc_ln" cmdstr$[&hd9]="ABS(" :cmdfnc$[&hd9]="fnc_abs" cmdstr$[&hda]="SGN(" :cmdfnc$[&hda]="fnc_sgn" cmdstr$[&hdb]="SQR(" :cmdfnc$[&hdb]="fnc_sqr" cmdstr$[&hf2]="CURSOR" :cmdlbl$[&hf2]=@cursor '--- 'TI$ '--- push varname$,"TI" push vartype,TYPE_STR push vardim,0 push varsize1,1 push varsize2,1 push varp,0 push varnum#,0 push varstr$,"000000" c$=TIME$ start_h=val(left$(c$,2)) start_m=val(mid$(c$,3,2)) start_s=val(right$(c$,2)) '------------- 'sound setting '------------- i=volume() volume 0 beep wait 8 volume i emumem MZMEM_TEMPO,4 '------------------------- 'input speed and file name '------------------------- emustop speed=5 repeat input "speed(default=5,fastest=0)";speed until speed>=0 loadfile '----------------- 'command execution '----------------- puts chr$(&h0d) for line=0 to len(linenum)-1 pos=0 while pos0 && !eos() then snerr waittime wend next goto @end '----------- 'REM command '----------- @rem while !eos() inc pos wend return '------------ 'DATA command '------------ @data while !eos() c$=list$[line][pos] inc pos if c$==chr$(&h22) then while pos=0 then puts " "+str$(value#) else puts str$(value#) endif elseif type==TYPE_STR then puts value$ elseif c$==";" then inc pos if eos() then break elseif c$=="," then inc pos puts left$(" ",10-(dspx() mod 10)) if eos() then break elseif c$==chr$(&hc9) then 'TAB( inc pos x=floor(getnumarg()) if x<0 || 380 && varnum#[p]>forto[i] then dec nfor if nextchr$()=="," then inc pos:goto @next elseif forstep[i]<0 && varnum#[p]0 then snerr next push varname$,name$ push vartype,type push vardim,1 push varsize1,1 push varsize2,1 if i then push varp,varp[i-1]+varsize1[i-1]*varsize2[i-1] else push varp,0 endif value#=floor(getnumarg()) varsize1[i]=value#+1 if nextchr$()=="," then inc pos value#=floor(getnumarg()) varsize2[i]=value#+1 vardim[i]=2 endif if nextchr$()!=")" then snerr inc pos for j=0 to varsize1[i]*varsize2[i] push varnum#,0.0 push varstr$,"" next if nextchr$()=="," then inc pos:goto @dim return '-------------- 'DEF FN command '-------------- @deffn if !isalpha(nextchr$()) then snerr getvar out name$,type if type!=TYPE_NUM then mmerr for i=0 to len(fnname$)-1 if name$==fnname$[i] then break next if i==len(fnname$) then push fnname$,"" push fnarg$,"" push fnline,0 push fnpos,0 endif fnname$[i]=name$ if nextchr$()!="(" then snerr inc pos if !isalpha(nextchr$()) then snerr getvar out name$,type if type!=TYPE_NUM then mmerr if nextchr$()!=")" then snerr inc pos if nextchr$()!=chr$(&hb6) then snerr '= inc pos if eos() then snerr fnarg$[i]=name$ fnline[i]=line fnpos[i]=pos while !eos() inc pos wend return '------------- 'INPUT command '------------- @input if nextchr$()==chr$(&h22) then value$=getstrarg$() if nextchr$()!=";" then snerr inc pos puts value$ endif if !isalpha(nextchr$()) then snerr getvar out name$,type if type==TYPE_NONE then snerr if type!=TYPE_STR then mmerr p=searchvar(name$,type) emureg #Z80_DE,MZMEM_WORK i=z80call(MZMEM_GETL) varstr$[p]="" for i=0 to &hff j=emumem(MZMEM_WORK+i) if j==&h0d || j==&h1b then break inc varstr$[p],chr$(j) next return '--------------- 'RESTORE command '--------------- @restore if eos() then dataline=0 else i=getln() if i==-1 then dterr dataline=i endif datapos=0 return '----------- 'CLR command '----------- @clr while len(varname$)>1 c$=pop(varname$) i=pop(vartype) i=pop(vardim) i=pop(varsize1) i=pop(varsize2) i=pop(varp) wend while len(varnum#)>1 i=pop(varnum#) c$=pop(varstr$) wend return '------------- 'MUSIC command '------------- @music value$=getstrarg$()+chr$(&h0d) for i=0 to len(value$)-1 emumem MZMEM_WORK+i,asc(value$[i]) next emureg #Z80_DE,MZMEM_WORK i=z80call(MZMEM_MSTART) return '------------- 'TEMPO command '------------- @tempo value#=floor(getnumarg()) if value#<1 then value#=1 if value#>7 then value#=7 emumem MZMEM_TEMPO,8-value# return '----------- 'USR command '----------- @usr if nextchr$()!="(" then snerr inc pos if nextchr$()=="$" then value#=gethex() else value#=floor(getnumarg()) endif if value#<-&hffff || &hffff>8 sp=(sp-1) and &hffff emumem sp,MZMEM_WORK and &hff emureg #Z80_SP,sp emubp 0,MZMEM_WORK emujump addr emurun repeat emubkst out type,id until type!=#EMUIO_NONE && emureg(#Z80_PC)==MZMEM_WORK && emureg(#Z80_SP)==(sp+2) and &hffff emubc 0 return emureg(#Z80_A) end '------------ 'clear screen '------------ def mzcls for i=0 to MZ_WIDTH*MZ_HEIGHT-1 emumem MZMEM_VRAM+i,0 next end '------ 'scroll '------ def mzscroll for i=0 to MZ_WIDTH*(MZ_HEIGHT-1)-1 emumem MZMEM_VRAM+i,emumem(MZMEM_VRAM+I+MZ_WIDTH) next for i=0 to MZ_WIDTH-1 emumem MZMEM_VRAM+MZ_WIDTH*(MZ_HEIGHT-1)+i,0 next end '---------------------- 'calculate VRAM address '---------------------- def xy2addr(x,y) return floor(x)+floor(y)*40+MZMEM_VRAM end '----------------- 'X cursor posision '----------------- def dspx() return emumem(MZMEM_DSPX) end '----------------- 'Y cursor posision '----------------- def dspy() return emumem(MZMEM_DSPY) end '------------------- 'set cursor position '------------------- def setloc x,y emumem MZMEM_DSPX,x emumem MZMEM_DSPY,y end '------------------------ 'write a character string '------------------------ def puts string$ var i,c$ for i=0 to len(string$)-1 c$=string$[i] if c$==chr$(&h0d) then 'CR if dspy()0 then setloc dspx(),dspy()-1 elseif c$==chr$(&h13) then 'right if dspx()0 then setloc dspx()-1,dspy() elseif dspy()>0 then setloc MZ_WIDTH-1,dspy()-1 endif elseif c$==chr$(&h15) then 'H setloc 0,0 elseif c$==chr$(&h16) then 'C setloc 0,0 mzcls else emumem xy2addr(dspx(),dspy()),adcn(asc(c$)) puts chr$(&h13) endif next end '------------ 'SYNTAX ERROR '------------ def snerr print "SYNTAX ERROR IN ";linenum[line] exit end '---------- 'DATA ERROR '---------- def dterr print "DATA ERROR IN ";linenum[line] exit end '-------------- 'MISMATCH ERROR '-------------- def mmerr print "MISMATCH ERROR IN ";linenum[line] exit end '----------- '16FOR ERROR '----------- def forerr print "16FOR ERROR IN ";linenum[line] exit end '------------- '16GOSUB ERROR '------------- def gserr print "16GOSUB ERROR IN ";linenum[line] exit end '--------- '6FN ERROR '--------- def fnerr print "6FN ERROR IN ";linenum[line] exit end '---- 'exit '---- def exit var i i=z80call(MZMEM_MSTOP) puts "READY" emujump MZMEM_HOT emurun stop end '--------- 'operators '--------- def opr_ne(x,y) return -(x!=y) end def opr_le(x,y) return -(x<=y) end def opr_ge(x,y) return -(x>=y) end def opr_eq(x,y) return -(x==y) end def opr_gt(x,y) return -(x>y) end def opr_lt(x,y) return -(x6 then fnerr value#=getnumarg() dec nfn pos=posbak line=linebak varnum#[p]=varnumbak# return value# end '----------------------- 'convert UTF-16 to ascii '----------------------- def utf2asc(c$) var a$,a if " "<=c$ && c$<="^" || c$==chr$(&h0a) then return c$ elseif chr$(&he200)<=c$ && c$<=chr$(&he2ff) then restore @e200data for i=&he200 to asc(c$) read a next return chr$(a) elseif chr$(&he800)<=c$ && c$<=chr$(&he8ff) then emureg #Z80_A,asc(c$) and &hff a=z80call(MZMEM_DACN) return chr$(emureg(#Z80_A)) endif restore @utfdata repeat read a$,a if a$==c$ then return chr$(a) until a$=="end" return " " @e200data data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h68 '00-07 data &h67,&h20,&h20,&h20,&h20,&h20,&h60,&h20 '08-0f data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 '10-17 data &h20,&h20,&h20,&h69,&h20,&h5f,&h5e,&h20 '18-1f data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 '20-27 data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 '28-2f data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 '30-37 data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 '38-3f data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 '40-47 data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 '48-4f data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 '50-57 data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 '58-5f data &h20,&h20,&h20,&h20,&hd1,&hd2,&hcb,&hfb '60-67 data &hd3,&he0,&hfd,&hd0,&hce,&hcd,&hdd,&h20 '68-6f data &h20,&h20,&h20,&hd1,&hd2,&hd1,&hd2,&hcb '70-77 data &hfb,&hd3,&hcb,&hfb,&hd3,&h20,&h20,&h20 '78-7f data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 '80-87 data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 '88-8f data &hd1,&hd2,&hcb,&hfb,&hd3,&he0,&hfd,&hc8 '90-97 data &hd0,&hce,&hcd,&hdd,&hf5,&he9,&hfe,&hc9 '98-9f data &h20,&hc4,&hcf,&hd9,&hc2,&h20,&h20,&h20 'a0-a7 data &hc8,&h20,&hc5,&hd4,&h20,&hd5,&h20,&h20 'a8-af data &h20,&hc8,&h20,&h20,&h20,&h20,&h20,&h20 'b0-b7 data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 'b8-bf data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 'c0-c7 data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 'c8-cf data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 'd0-d7 data &h20,&h20,&h20,&h20,&h20,&h20,&h20,&h20 'd8-df data &hc8,&hf1,&h20,&h20,&h20,&hf7,&h20,&h20 'e0-e7 data &h20,&h20,&h20,&h20,&h62,&h61,&h20,&h20 'e8-ef data &he1,&hf3,&hfa,&hf8,&h63,&h65,&h66,&h64 'f0-f7 data &hc3,&hc5,&hc7,&hc4,&hee,&hed,&hf6,&hc6 'f8-ff @utfdata data "下",&h11 data "上",&h12 data "右",&h13 data "左",&h14 data " ",&h20 data "!",&h21 data "“",&h22 data "”",&h22 data "#",&h23 data "$",&h24 data "%",&h25 data "&",&h26 data "‘",&h27 data "’",&h27 data "(",&h28 data ")",&h29 data "*",&h2a data "+",&h2b data ",",&h2c data "—",&h2d data ".",&h2e data "/",&h2f data "0",&h30 data "1",&h31 data "2",&h32 data "3",&h33 data "4",&h34 data "5",&h35 data "6",&h36 data "7",&h37 data "8",&h38 data "9",&h39 data ":",&h3a data ";",&h3b data "<",&h3c data "=",&h3d data ">",&h3e data "?",&h3f data "@",&h40 data "A",&h41 data "a",&h41 data "B",&h42 data "b",&h42 data "C",&h43 data "c",&h43 data "D",&h44 data "d",&h44 data "E",&h45 data "e",&h45 data "F",&h46 data "f",&h46 data "G",&h47 data "g",&h47 data "H",&h48 data "h",&h48 data "I",&h49 data "i",&h49 data "J",&h4a data "j",&h4a data "K",&h4b data "k",&h4b data "L",&h4c data "l",&h4c data "M",&h4d data "m",&h4d data "N",&h4e data "n",&h4e data "O",&h4f data "o",&h4f data "P",&h50 data "p",&h50 data "Q",&h51 data "q",&h51 data "R",&h52 data "r",&h52 data "S",&h53 data "s",&h53 data "T",&h54 data "t",&h54 data "U",&h55 data "u",&h55 data "V",&h56 data "v",&h56 data "W",&h57 data "w",&h57 data "X",&h58 data "x",&h58 data "Y",&h59 data "y",&h59 data "Z",&h5a data "z",&h5a data "[",&h5b data "\",&h5c data "]",&h5d data "^",&h5e data "↑",&h5e data "←",&h5f data "日",&h70 data "月",&h71 data "火",&h72 data "水",&h73 data "木",&h74 data "金",&h75 data "土",&h76 data "生",&h77 data "年",&h78 data "時",&h79 data "分",&h7a data "秒",&h7b data "円",&h7c data "。",&h81 data "「",&h82 data "」",&h83 data "、",&h84 data "・",&h85 data "ヲ",&h86 data "ァ",&h87 data "ィ",&h88 data "ゥ",&h89 data "ェ",&h8a data "ォ",&h8b data "ャ",&h8c data "ュ",&h8d data "ョ",&h8e data "ッ",&h8f data "ー",&h90 data "ア",&h91 data "イ",&h92 data "ウ",&h93 data "エ",&h94 data "オ",&h95 data "カ",&h96 data "キ",&h97 data "ク",&h98 data "ケ",&h99 data "コ",&h9a data "サ",&h9b data "シ",&h9c data "ス",&h9d data "セ",&h9e data "ソ",&h9f data "タ",&ha0 data "チ",&ha1 data "ツ",&ha2 data "テ",&ha3 data "ト",&ha4 data "ナ",&ha5 data "ニ",&ha6 data "ヌ",&ha7 data "ネ",&ha8 data "ノ",&ha9 data "ハ",&haa data "ヒ",&hab data "フ",&hac data "ヘ",&had data "ホ",&hae data "マ",&haf data "ミ",&hb0 data "ム",&hb1 data "メ",&hb2 data "モ",&hb3 data "ヤ",&hb4 data "ユ",&hb5 data "ヨ",&hb6 data "ラ",&hb7 data "リ",&hb8 data "ル",&hb9 data "レ",&hba data "ロ",&hbb data "ワ",&hbc data "ン",&hbd data "゛",&hbe data "゜",&hbf data "網",&hc6 data "■",&hc8 data "├",&hcb data "┣",&hcb data "┝",&hcb data "┠",&hcb data "□",&hcc data "└",&hcd data "┗",&hcd data "┐",&hce data "┓",&hce data "_",&hcf data "_",&hcf data "┌",&hd0 data "┏",&hd0 data "┴",&hd1 data "┻",&hd1 data "┷",&hd1 data "┸",&hd1 data "┬",&hd2 data "┳",&hd2 data "┯",&hd2 data "┰",&hd2 data "┤",&hd3 data "┫",&hd3 data "┥",&hd3 data "┨",&hd3 data "~",&hd7 data "〜",&hd7 data "┘",&hdd data "┛",&hdd data "─",&he0 data "━",&he0 data "▲",&he1 data "●",&hf1 data "▼",&hf3 data "×",&hf6 data "○",&hf7 data "★",&hf8 data "◆",&hfa data "┼",&hfb data "╋",&hfb data "┿",&hfb data "╂",&hfb data "│",&hfd data "┃",&hfd data "π",&hff data "end" end '---------------------------------- 'convert ASCII code to display code '---------------------------------- def adcn(x) var i,a if x<0 || x>&hff then return 0 restore @adcntbl for i=0 to x read a next return a @adcntbl data &hf0,&hf0,&hf0,&hf0,&hf0,&hf0,&hf0,&hf0 '00-07 data &hf0,&hf0,&hf0,&hf0,&hf0,&hf0,&hf0,&hf0 '08-0f data &hf0,&hc1,&hc2,&hc3,&hc4,&hc5,&hc6,&hf0 '10-17 data &hf0,&hf0,&hf0,&hf0,&hf0,&hf0,&hf0,&hf0 '18-1f data &h00,&h61,&h62,&h63,&h64,&h65,&h66,&h67 '20-27 data &h68,&h69,&h6b,&h6a,&h2f,&h2a,&h2e,&h2d '28-2f data &h20,&h21,&h22,&h23,&h24,&h25,&h26,&h27 '30-37 data &h28,&h29,&h4f,&h2c,&h51,&h2b,&h57,&h49 '38-3f data &h55,&h01,&h02,&h03,&h04,&h05,&h06,&h07 '40-47 data &h08,&h09,&h0a,&h0b,&h0c,&h0d,&h0e,&h0f '48-4f data &h10,&h11,&h12,&h13,&h14,&h15,&h16,&h17 '50-57 data &h18,&h19,&h1a,&h52,&h59,&h54,&h50,&h45 '58-5f data &hc7,&hc8,&hc9,&hca,&hcb,&hcc,&hcd,&hce '60-67 data &hcf,&hdf,&he7,&he8,&he9,&hea,&hec,&hed '68-6f data &hd0,&hd1,&hd2,&hd3,&hd4,&hd5,&hd6,&hd7 '70-77 data &hd8,&hd9,&hda,&hdb,&hdc,&hdd,&hde,&hc0 '78-7f data &h00,&hbd,&h9d,&hb1,&hb5,&hb9,&hb4,&h9e '80-87 data &hb2,&hb6,&hba,&hbe,&h9f,&hb3,&hb7,&hbb '88-8f data &hbf,&ha3,&h85,&ha4,&ha5,&ha6,&h94,&h87 '90-97 data &h88,&h9c,&h82,&h98,&h84,&h92,&h90,&h83 '98-9f data &h91,&h81,&h9a,&h97,&h93,&h95,&h89,&ha1 'a0-a7 data &haf,&h8b,&h86,&h96,&ha2,&hab,&haa,&h8a 'a8-af data &h8e,&hb0,&had,&h8d,&ha7,&ha8,&ha9,&h8f 'b0-b7 data &h8c,&hae,&hac,&h9b,&ha0,&h99,&hbc,&hb8 'b8-bf data &h00,&h3b,&h3a,&h70,&h3c,&h71,&h5a,&h3d 'c0-c7 data &h43,&h56,&h3f,&h1e,&h4a,&h1c,&h5d,&h3e 'c8-cf data &h5c,&h1f,&h5f,&h5e,&h37,&h7b,&h7f,&h36 'd0-d7 data &h7a,&h7e,&h33,&h4b,&h4c,&h1d,&h6c,&h5b 'd8-df data &h78,&h41,&h35,&h34,&h74,&h30,&h38,&h75 'e0-e7 data &h39,&h4d,&h6f,&h6e,&h32,&h77,&h76,&h72 'e8-ef data &h73,&h47,&h7c,&h53,&h31,&h4e,&h6d,&h48 'f0-f7 data &h46,&h7d,&h44,&h1b,&h58,&h79,&h42,&h60 'f8-ff end '----------------------- 'check operator priority '----------------------- def chkprio(opr1,opr2) var i,j dim priority[&h100] restore @priolist for i=&hb0 to &hbf read priority[i] next read priority[&hcf] '^ return priority[opr1]< <> =< <= => >= = > < AND OR NOT + - * / ^ data 4, 4, 4, 4, 4, 4, 4,4,4,2, 1, 3, 6,6,7,7,8 end '---------------------- 'check end of statement '---------------------- def eos() while pos23 || time_m>59 || time_s>59 then dterr varstr$[p]=c$ c$=TIME$ start_h=val(left$(c$,2))-time_h start_m=val(mid$(c$,3,2))-time_m start_s=val(right$(c$,2))-time_s if start_s<0 then inc start_s,60:dec start_m if start_m<0 then inc start_m,60:dec start_h if start_h<0 then inc start_h,24 endif varstr$[p]=c$ endif return p end '----------------- 'get variable name '----------------- def getvar out name$,type type=TYPE_NUM name$=list$[line][pos]+chr$(0) for pos=pos+1 to len(list$[line])-1 c$=nextchr$() if isalpha(c$) || isdigit(c$) then if name$[1]==chr$(0) then name$[1]=c$ endif elseif c$=="$" then type=TYPE_STR inc pos break else break endif next end '--------------- 'search variable '--------------- def searchvar(name$,type) var p,ivar,c$ var time_h,time_m,time_s if name$=="FN" then snerr for ivar=0 to len(varname$)-1 if (nextchr$()=="(") xor (vardim[ivar]>0) then continue if name$==varname$[ivar] && type==vartype[ivar] then break next if ivar==len(varname$) then if nextchr$()=="(" then snerr push varname$,name$ push vartype,type push vardim,0 push varsize1,1 push varsize2,1 push varnum#,0.0 push varstr$,"" if ivar then push varp,varp[ivar-1]+varsize1[ivar-1]*varsize2[ivar-1] else push varp,0 endif endif p=varp[ivar] if nextchr$()=="(" then if vardim[ivar]==0 then snerr inc pos value#=floor(getnumarg()) if value#>=varsize1[ivar]*varsize2[ivar] then dterr p=varp[ivar]+value# if nextchr$()=="," then if vardim[ivar]==1 then snerr inc pos value#=floor(getnumarg()) p=p+value#*varsize1[ivar] endif if nextchr$()!=")" then snerr inc pos endif if p==0 then 'TI$ c$=TIME$ time_h=val(left$(c$,2))-start_h time_m=val(mid$(c$,3,2))-start_m time_s=val(right$(c$,2))-start_s if time_s<0 then inc time_s,60:dec time_m if time_m<0 then inc time_m,60:dec time_h if time_h<0 then inc time_h,24 varstr$[0]=format$("%02d%02d%02d",time_h,time_m,time_s) endif return p end '---------------------- 'get numerical argument '---------------------- def getnumarg() var type,value#,value$ getarg out type,value#,value$ if type==TYPE_NONE then snerr if type==TYPE_STR then mmerr return value# end '------------------- 'get string argument '------------------- def getstrarg$() getarg out type,value#,value$ if type==TYPE_NONE then snerr if type==TYPE_NUM then mmerr return value$ end '------------ 'get argument '------------ def getarg out type,value#,value$ var i,j,c$ dim oprtype[0],operand#[0],operand$[0] var operand1#,operand2#,operand1$,operand2$ push oprtype,TYPE_NONE 'start mark repeat c$=nextchr$() 'decimal if isdigit(c$) || c$=="." then getnum line,pos out pos,value# push operand#,value# push oprtype,TYPE_NUM 'string elseif c$==chr$(&h22) then value$="" for pos=pos+1 to len(list$[line])-1 c$=list$[line][pos] if c$==chr$(&h22) then inc pos break else inc value$,c$ endif next push operand$,value$ push oprtype,TYPE_STR elseif isalpha(c$) then i=pos inc pos 'FN if c$=="F" && nextchr$()=="N" then push operand#,fnc_fn() push oprtype,TYPE_NUM 'variable else pos=i getvar out name$,type p=searchvar(name$,type) if type==TYPE_NUM then push operand#,varnum#[p] push oprtype,TYPE_NUM else push operand$,varstr$[p] push oprtype,TYPE_STR endif endif 'pi elseif c$==chr$(&hff) then inc pos push operand#,pi() push oprtype,TYPE_NUM 'function elseif chr$(&hc0)<=c$ && c$<=chr$(&hcb) && c$!=chr$(&hc9) || chr$(&hd0)<=c$ && c$<=chr$(&hdb) then inc pos if right$(cmdfnc$[asc(c$)],1)=="$" || asc(c$)==&hca then push operand$,call(cmdfnc$[asc(c$)]) push oprtype,TYPE_STR else push operand#,call(cmdfnc$[asc(c$)]) push oprtype,TYPE_NUM endif if c$!=chr$(&hcb) then if nextchr$()!=")" then snerr inc pos endif '() elseif c$=="(" then inc pos getarg out type,value#,value$ if nextchr$()!=")" then snerr inc pos if type==TYPE_NUM then push operand#,value# push oprtype,TYPE_NUM elseif type==TYPE_STR then push operand$,value$ push oprtype,TYPE_STR else snerr endif 'operator else if c$==chr$(&hbb) || c$==chr$(&hbc) || c$==chr$(&hbd) then '+,-,NOT inc pos if oprtype[len(oprtype)-1]!=TYPE_NUM && oprtype[len(oprtype)-1]!=TYPE_STR then push operand#,0.0 push oprtype,TYPE_NONE endif elseif chr$(&hb0)<=c$ && c$<=chr$(&hbf) || c$==chr$(&hcf) then inc pos else c$=chr$(TYPE_NONE) 'end mark endif i=oprtype[len(oprtype)-1] if i!=TYPE_NUM && i!=TYPE_STR && i!=TYPE_NONE then snerr push oprtype,asc(c$) endif i=oprtype[len(oprtype)-1] j=oprtype[len(oprtype)-2] 'after operand if (i==TYPE_NUM || i==TYPE_STR) then if (j==TYPE_NUM || j==TYPE_STR) then snerr 'after operator else j=pop(oprtype) while len(oprtype)>3 if chkprio(oprtype[len(oprtype)-2],j) then break i=pop(oprtype) if i==TYPE_NUM then operand2#=pop(operand#) i=pop(oprtype) if pop(oprtype)==TYPE_STR then mmerr operand1#=pop(operand#) push operand#,call(cmdfnc$[i],operand1#,operand2#) push oprtype,TYPE_NUM elseif i==TYPE_STR then operand2$=pop(operand$) i=pop(oprtype) if pop(oprtype)==TYPE_NUM then mmerr operand1$=pop(operand$) if i==&hbc then '+ then push operand$,call(cmdfnc$[i],operand1$,operand2$) push oprtype,TYPE_STR elseif &hb0<=i && i<=&hb8 then push operand#,call(cmdfnc$[i],operand1$,operand2$) push oprtype,TYPE_NUM else mmerr endif elseif i==TYPE_NONE then '+,-,NOT after operator push oprtype,TYPE_NUM break else snerr endif wend push oprtype,j endif until c$==chr$(TYPE_NONE) i=pop(oprtype) value#=0.0 value$="" type=pop(oprtype) if type==TYPE_NUM then value#=pop(operand#) i=pop(oprtype) 'start mark elseif type==TYPE_STR then value$=pop(operand$) i=pop(oprtype) 'start mark endif if len(oprtype) then snerr end '-------------- 'load text file '-------------- def loadfile var i,j var c$ var ascii,asciicnt var fname$,txt$ var lf,lf_old while TRUE input "file name";fname$ if fname$=="" then continue if chkfile(fname$)==1 then break wend txt$=load("txt:"+fname$) for i=0 to len(txt$)-1 'small letters if "a"<=txt$[i] && txt$[i]<="z" then txt$[i]=chr$(asc(txt$[i]) and &hdf) 'ascii code elseif txt$[i]=="{" then asciicnt=0 for j=i+1 to len(txt$)-1 if txt$[j]=="}" then break if txt$[j]==chr$(&h0a) then print"illegal expression":exit if instr("0123456789abcdefABCDEF",txt$[j])==-1 then continue if asciicnt==0 then ascii=val("&H"+txt$[j])*&h10 asciicnt=1 else ascii=ascii+val("&H"+txt$[j]) asciicnt=0 txt$=left$(txt$,i)+chr$(ascii)+right$(txt$,len(txt$)-j-1) inc i j=i-1 endif next if i>len(txt$)-1 then print "illegal expression":exit txt$=left$(txt$,i)+right$(txt$,len(txt$)-j-1) dec i 'kana else j=instr("をぁぃぅぇぉゃゅょっあいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわんがぎぐげござじずぜぞだぢづでどばびぶべぼぱぴぷぺぽ",txt$[i]) if j!=-1 then txt$[i]=mid$("ヲァィゥェォャュョッアイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワンガギグゲゴザジズゼゾダヂヅデドバビブベボパピプペポ",j,1) endif j=instr("ヴガギグゲゴザジズゼゾダヂヅデドバビブベボ",txt$[i]) if j!=-1 then txt$[i]=mid$("ウカキクケコサシスセソタチツテトハヒフヘホ",j,1)+"゛" endif j=instr("パピプペポ",txt$[i]) if j!=-1 then txt$[i]=mid$("ハヒフヘホ",j,1)+"゜" endif txt$[i]=utf2asc(txt$[i]) endif next lf=-1 while lfABCDEFGILMNOPRSTUVW^",c$[i])!=-1 then for j=&h80 to &hf2 if cmdstr$[j]=="" then continue if c$[i]!=cmdstr$[j][0] then continue if mid$(c$,i,len(cmdstr$[j]))==cmdstr$[j] then c$=left$(c$,i)+chr$(j)+right$(c$,len(c$)-len(cmdstr$[j])-i) if j==&h80 then 'REM while i(speed+4)*20 then keybuf=0 if MILLISEC-keytime1>50 then i=z80call(MZMEM_GETKEY) keytime1=MILLISEC if i then keybuf=i keytime2=ms_old if i==&h64 then 'shift+break while z80call(MZMEM_GETKEY)!=&h64 wend endif endif endif while MILLISEC-ms_old