2008年9月23日火曜日

任意桁数の実数計算 


#module
#defcfunc comp_h int a,int b
if a<b :return b
return a
#defcfunc comp_l int a,int b
if a<b :return a
return b

#deffunc fteki var keka_,var size1_,var ten1_
k1=size1_-ten1_-1-1
sdim keka_2,size1_
sik=0
sij=0
repeat
 if peek(keka_,k1+ten1_+1)=0:sik+:else:break
 k1-
loop
k1=-ten1_-1
repeat
 if peek(keka_,k1+ten1_+1)=0:sij+:else:break
 k1+
loop

size1_-=sik+sij
ten1_=sij

memcpy keka_2,keka_,size1_,0,sij
memcpy keka_,keka_2,size1_,0,0

return
#deffunc fzetai  var hiki2_,int size2_,int ten2_,int sehu2_,  var hiki3_,int size3_,int ten3_,int sehu3_
size1_=comp_h(ten2_+1,ten3_+1)+comp_h(size2_-ten2_-1,size3_-ten3_-1)+1
ten1_=comp_h(ten2_,ten3_)+1


k1=size1_-ten1_-1-1

repeat

st1=0
st2=0
if k1<=size2_-ten2_-1-1&&k1>=-ten2_-1{
 
 st1=((sehu2_!1)*2-1)*peek(hiki2_,k1+ten2_+1)
 
}
if k1<=size3_-ten3_-1-1&&k1>=-ten3_-1{
 st2=((sehu3_!1)*2-1)*peek(hiki3_,k1+ten3_+1)
}
st3=st1+st2+kuri
kuri=0
if st3>=10:st3-=10:kuri=1
if st3<0:st3+=10:kuri=-1


k1-
if k1<-(ten1_+1):break
loop

if kuri!=0:return 1
return


return
#deffunc fplus var keka_3,var size1,var ten1,var sehu1,  var hiki2,int size2,int ten2,int sehu2,  var hiki3,int size3,int ten3,int sehu3

fzetai hiki2, size2, ten2, sehu2,  hiki3, size3, ten3, sehu3
han=1
if stat=1:han=-1

size1=comp_h(ten2+1,ten3+1)+comp_h(size2-ten2-1,size3-ten3-1)+1
ten1=comp_h(ten2,ten3)+1
sdim keka_3,size1
sdim keka,size1
k1=size1-ten1-1-1
kuri=0
repeat

st1=0
st2=0
if k1<=size2-ten2-1-1&&k1>=-ten2-1{
 
 st1=han*((sehu2!1)*2-1)*peek(hiki2,k1+ten2+1)
 
}
if k1<=size3-ten3-1-1&&k1>=-ten3-1{
 st2=han*((sehu3!1)*2-1)*peek(hiki3,k1+ten3+1)
}
st3=st1+st2+kuri
kuri=0
if st3>=10:st3-=10:kuri=1
if st3<0:st3+=10:kuri=-1
poke keka,k1+ten1+1,st3

k1-
if k1<-(ten1+1):break
loop


sehu1=((han+1)/2!1)

fteki keka ,size1 ,ten1

;if kuri!=0:dialog "エラー"
memcpy keka_3,keka,size1,0,0
return
#global
a=""
size2=30
ten2=0//1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679 
sdim suti1,size2
//配列にデータをいれます　（π）
poke suti1,0,3
poke suti1,1,1
poke suti1,2,4
poke suti1,3,1
poke suti1,4,5
poke suti1,5,9
poke suti1,6,2
poke suti1,7,6
poke suti1,8,5
poke suti1,9,3
poke suti1,10,5
poke suti1,11,8
poke suti1,12,9
poke suti1,13,0
poke suti1,14,9
poke suti1,15,3
poke suti1,16,2
poke suti1,17,3
poke suti1,18,8
poke suti1,19,4
poke suti1,20,6
poke suti1,21,2
poke suti1,22,6
poke suti1,23,4
poke suti1,24,3
poke suti1,25,3
poke suti1,26,8
poke suti1,27,3
poke suti1,28,0
poke suti1,29,0

size3=2
sdim suti3,size3 
poke suti1,0,3
ten3=0
sehu3=0

sehu2=0


//fplus 代入される変数,サイズ,小数点位置   足す変数,サイズ,小数点位置　足される変数,サイズ,小数点位置
fplus suti,size,ten,sehu,suti1,size2,ten2,sehu2,suti3,size3,ten3,sehu3
//結果はデバッグウィンドウのメモリダンプで・・・

mes size1
mes ten1
投稿者 時刻: 0 件のコメント:

2008年9月21日日曜日

自作RADツール（HSP）　途中断念・・・　再開の可能性あり？

RADツールを製作していましたが行き詰っていました。
ソースを公開します
ソースを実行するときは　main_test.hsp　を実行してください。
EXEを実行するときは　！試作！.exe　を実行して下さい。

ダウンロード　－＞http://begriff.web.fc2.com/radtool.zip
投稿者 時刻: 1 件のコメント:

式評価とポーランド記法化 


screen 0,700,600
;mes 12 + 24 * limit ( 68 ,36+48*sin(85), 120+64 ) * 59 +( 63>=23)
buf="12 + 24 * limit ( 68+89 ,36+48*sin(85), 120+64 ) * 59 +( 63>=23)"
;buf="24 * limit ( 68+89 ,48*aa(85+77,99*2), 120+64 )"
mes buf
len=strlen(buf)
sdim buf2,len

repeat
data=peek(buf,c)
if (data=' '||data=9)=0{
 poke buf2,c2,data
 c2+
}

c+
if c=len:c=0:c2=0:break
loop//--------------------------

mes buf2

len=strlen(buf2)
sdim buf,len
buf=buf2
sdim buf2,len

repeat
data=peek(buf,c)
if data='+'||data='-'||data='*'||data='/'||data='\\'||data='|'||data='&'||data='^'||data='='||data='>'||data='<'||data='!'{
 poke buf2,c,'C'
}else : if data='('{
 poke buf2,c,'B'
}else : if data=')'{
 poke buf2,c,'D'
}else : if data=','{
 poke buf2,c,'K'
}else : poke buf2,c,'A'
c+
if c=len:c=0:break
loop//--------------------------

mes buf2

len=strlen(buf2)

repeat
data=peek(buf2,c)
if data='A'{
 c2=c
 func=0
 repeat
 data=peek(buf2,c2)
 if data!='A'{
  if  data='B':func=1
  break
 }
 c2+
 if c2=len:break
 loop
 c2=0

 if func{
  repeat
  data=peek(buf2,c)
  if data ! 'A':break
  poke buf2,c,'F'
  c+
  if c=len:c=0:break
  loop
 }
}

c+
if c>=len:c=0:break
loop//--------------------------
mes "シンボル化"
mes buf2

len=strlen(buf2)
sdim buf3,len
sdim ad,len,len
sdim cd,len,len

repeat
data=peek(buf2,c)
if data='A'{
 poke buf3,c3,'A'
 c3+
 repeat
 if peek(buf2,c+c2)!'A':break
 data2=peek(buf,c+c2)
 poke ad(ac),c2,data2
 c2+
 loop
 c2-
 c=c+c2
 c2=0
 ac+
}else :if data='C'{
 poke buf3,c3,'C'
 c3+
 repeat
 if peek(buf2,c+c2)!'C':break
 data2=peek(buf,c+c2)
 poke cd(cc),c2,data2
 c2+
 loop
 c2-
 c=c+c2
 c2=0
 cc+
}else : if data='F'{
 poke buf3,c3,'F'
 c3+
 repeat
 if peek(buf2,c+c2)!'F':break
 data2=peek(buf,c+c2)
 poke cd(cc),c2,data2
 c2+
 loop
 c2-
 c=c+c2
 c2=0
 cc+
}else {
 poke buf3,c3,data
 c3+
}
c+
if c>=len:c=0:break
loop//--------------------------
c3=0
cc=0
ac=0

buf2=buf3
mes "シンボル簡易化"
mes buf2

len=strlen(buf2)
dim bk,len
dim ck,len


repeat//--------------------------
data=peek(buf2,c)
if data='B':lv+

if data='C'||data='F'{
 ck(cc)=lv
 cc+
}  
if data='B'||data='D'||data='K'{
 bk(bc)=lv
 bc+
}
if data='D':lv-
c+
if c>=len:c=0:break
loop
bc=0
cc=0


dim cy,len
dim ch,len
repeat//--------------------------
data=peek(buf2,c)
if data='C'{
 data2=cd(cc)
 h=0
 if data2="*":cy(cc)=5:ch(cc)=2:h=1
 if data2="/":cy(cc)=5:ch(cc)=2:h=1
 if data2="\\":cy(cc)=5:ch(cc)=2:h=1
 if data2="+":cy(cc)=4:ch(cc)=2:h=1
 if data2="-":cy(cc)=4:ch(cc)=2:h=1
 if data2="<<":cy(cc)=3:ch(cc)=2:h=1
 if data2=">>":cy(cc)=3:ch(cc)=2:h=1
 if data2="=":cy(cc)=2:ch(cc)=2:h=1
 if data2="==":cy(cc)=2:ch(cc)=2:h=1
 if data2="!":cy(cc)=2:ch(cc)=2:h=1
 if data2="!=":cy(cc)=2:ch(cc)=2:h=1
 if data2=">":cy(cc)=2:ch(cc)=2:h=1
 if data2="<":cy(cc)=2:ch(cc)=2:h=1
 if data2=">=":cy(cc)=2:ch(cc)=2:h=1
 if data2="<=":cy(cc)=2:ch(cc)=2:h=1
 if data2="&":cy(cc)=1:ch(cc)=2:h=1
 if data2="&&":cy(cc)=1:ch(cc)=2:h=1
 if data2="|":cy(cc)=1:ch(cc)=2:h=1
 if data2="||":cy(cc)=1:ch(cc)=2:h=1
 if data2="^":cy(cc)=1:ch(cc)=2:h=1
 if h=0:dialog "式の記述が無効です。  不明な演算子  \" "+data2+" \""
 cc+
}
if data='F'{
 cy(cc)=6
 cc+
}
c+
if c>=len:c=0:break
loop
h=0
fhm=0
cc=0
dim cf,len
repeat//--------------------------
data=peek(buf2,c)
if data='B'||data='D'||data='K'{
 bc+
}
if data='F'{
 k=bk(bc)
 c2=2
 repeat
 data2=peek(buf2,c+c2)
 if data2='B'||data2='D'||data2='K'{
  bc2+


 }
 if k=bk(bc+bc2){
  if data2='A':d=1
  if data2='K':fh+
  if data2='D':break
 }
 c2+
 if c+c2>=len:c2=0:break
 loop
 bc2=0
 c2=0
 fh+
 if d=0:fh=0
 d=0
 if fhm<fh:fhm=fh
 ch(cc)=fh
 cf(cc)=1
 fh=0
 cc+
 poke buf2,c,'C'
}
if data='C'{
 cf(cc)=0
 cc+
}
c+
if c>=len:c=0:break
loop
cc=0
bc=0
mes buf2

sdim buf3,len
dim c_st,len
dim ca,len
c_sa=0
c3=0
repeat//--------------------------
data=peek(buf2,c)
if data='C'{
 data2=peek(buf2,c+1)
 repeat
 if c_sa!0&&(ck(c_st(c_sa))>ck(cc)||((ck(c_st(c_sa))=ck(cc)&&cy(c_st(c_sa))>=cy(cc)))){
  ca(c4)=c_st(c_sa)
  poke buf3,c3,'C'
  c3+
  c4+
  c_sa-
 }else : break
 loop
 if data2='A'{
  poke buf3,c3,'A'
  c3+
  c+
  data2=peek(buf2,c+1)
 }
 if data2='B'{
  c_sa+
  c_st(c_sa)=cc
 }
 if data2='C'{
  if (ck(cc+1))>ck(cc)||(ck(cc+1)=ck(cc)&&cy(cc+1)>=cy(cc)){
   c_sa+
   c_st(c_sa)=cc
  }else{
   ca(c4)=cc
   poke buf3,c3,'C'
   c3+
   c4+
  }
 }
 if data2='K'||data2='D'||data2=0{
  ca(c4)=cc
  poke buf3,c3,'C'
  c3+
  c4+
 }
 
 cc+
}

if data='K'||data='D'||data=0{
 lv=bk(bc)
 if data=0:lv=0
 repeat
 if c_sa!0&&lv=ck(c_st(c_sa)){
  ca(c4)=c_st(c_sa)
  poke buf3,c3,'C'
  c3+
  c4+
  c_sa-
 }else :break
 loop
}

if data='B'||data='K'||data='D'{
 bc+
}

if data='A'{
 poke buf3,c3,'A'
 c3+
}
c+
if c>=len+1:c=0:break
loop
bc=0
c2=0
c3=0
c4=0
cc=0
mes "\n逆ポーランド記法化(シンボル)"
mes buf3
/*いらない↓*/
sdim buf4,512
len=strlen(buf3)
repeat//--------------------------
data=peek(buf3,c)
if data='A'{
 buf4+=ad(ac)+" "
 ac+
}
if data='C'{
 buf4+=cd(ca(cc))
 if cf(ca(cc)):buf4+="()"
 buf4+=" "
 cc+
}
c+
if c>=len+1:c=0:break
loop
mes "\n逆ポーランド記法化(人間が認識できるようにするだけなので内部処理的にはいらない　上と同じ)"
mes buf4
/*いらない↑*/
cc=0
ac=-1
dim a_st,len//各数値がどのスタックにあるか
sdim st_st,fhm//引数に渡す値の配列
sdim buf5,512
st2=0//引数の順番
ac=-1
c2=0

repeat//--------------------------
data=peek(buf3,c)
if data='A'{

 ac+
}
if data='C'{
 retn=ch(ca(cc))
 st_itiml=0
 st_itims=0
 st2=0
 
 syu=0
 repeat retn//引数に渡す値を配列に収納

  st_iti=a_st(ac-c2)
  if st_iti=0{

   st_st(st2)=ad(ac-c2)
   st2+
   c2+
   
  }else{

   st_st(st2)="st"+a_st(ac-c2)
   st2+
   c2+
   if st_itims>st_iti || st_itims=0:st_itims=st_iti
   if st_itiml<st_iti:st_itiml=st_iti
   ;dialog st_itims
  }
   repeat
   if (ac-c2)<0:syu=1:break
   st_iti2=a_st(ac-c2)
   
   if st_iti2=0:break
   if st_iti!=st_iti2:break
   c2+
   loop
   if syu=1:break
  
 loop
 
 if st_itims=0{
  st+
 }else{
  st=st_itims
 }

 repeat c2
 a_st(ac-cnt)=st
 loop
 
 buf5+="st"+st+" = "
 if cf(ca(cc)){
  buf5+=cd(ca(cc))+"( "
  repeat retn
  if retn!1&&cnt!0 :buf5+=", "
  f=retn-cnt
  buf5+=st_st(retn-cnt-1)
  loop
  buf5+=" )"
 }else{
  buf5+=st_st(1)+" "+cd(ca(cc))+" "+st_st(0)

 }
 buf5+="\n"
c2=0 
st2=0
cc+
}

c+
if c>=len:c=0:break
loop
buf5+="ans = st1"

mes "\n\n変換前の数式"
mes buf
mes "\n変換後の数式\n"
mes buf5

投稿者 時刻: 0 件のコメント:

2008年9月20日土曜日

ベジェ曲線 


#module
#deffunc Beziers int x1,int y1,int x2, int y2, int x3 ,int y3,int x4,int y4,double rate
 t=0.0
 line x1,y1,x1,y1
 repeat
  x=(1.0-t)*(1.0-t)*(1.0-t)*x1+3.0*(1.0-t)*(1.0-t)*t*x2+3.0*(1.0-t)*t*t*x3+t*t*t*x4
  y=(1.0-t)*(1.0-t)*(1.0-t)*y1+3.0*(1.0-t)*(1.0-t)*t*y2+3.0*(1.0-t)*t*t*y3+t*t*t*y4
  line x,y
  t+=rate
  if t>1:break
 loop
 line x4,y4
 line x4,y4,x4,y4
return
#global 

k=4
f=4

onclick gosub *click

x(0)=300:y(0)=300
x(1)=300:y(1)=100
x(2)=100:y(2)=300
x(3)=100:y(3)=100

gosub *draw

stop
*click
 i=0
 repeat 4
 if x(i)-k< mousex&&mousex< x(i)+k&&y(i)-k< mousey&&mousey< y(i)+k{
  repeat
  x(i)=mousex
  y(i)=mousey
  gosub *draw
  getkey key,1
  if key=0:break
  wait 0
  loop
 }
 i+
 loop
 return
*draw 
redraw 0
color 255,255,255
boxf 

color 192,192,255
line x(0),y(0),x(1),y(1)
line x(2),y(2),x(3),y(3)
color 0,0,0

Beziers x(0),y(0),x(1),y(1),x(2),y(2),x(3),y(3),0.01

color 255,,
circle x(0)-f,y(0)-f,x(0)+f,y(0)+f,0
circle x(3)-f,y(3)-f,x(3)+f,y(3)+f,0

color ,,255
circle x(1)-f,y(1)-f,x(1)+f,y(1)+f,0
circle x(2)-f,y(2)-f,x(2)+f,y(2)+f,0
redraw 1
return
投稿者 時刻: 0 件のコメント:

2008年9月13日土曜日

難航^^

自作言語について色々と思いめぐらせるこのごろです。
初期案は変数と言う概念を持たず
直接メモリアドレスを参照すると言う形でした。
しかし問題が出てきました。
たとえばユーザー関数を別ファイルで汎用化させようとした場合、
関数間でメモリエリアの干渉が起こってしまうのです。
つまり、現状のままでは変数と言う概念が必要不可欠なのです。

言語仕様を一掃しようと思います。
まず言語的にサポートする機能は最低限のものであるというコンセプトは残します。
ではその機能を列挙します。

一般文

変数定義
ラベル定義
演算文（一項式）
条件分岐
無条件分岐

プリプロセス文

インクルード
ディファイン
外部DLL指定　外部関数指定
投稿者 時刻: 0 件のコメント:
登録: 投稿 (Atom)