HSPで作ったきわめて雑な珠算エミュレータ
code:tamakuro.hsp
title "タマクロ"
;ウインドウ0を確保する。
screen 0 ,300 ,140 ,8
;画像とそのサイズを読み込む
buffer 2 ,1 ,1
picload "tama5.bmp", 0
tama5y=ginfo_winy
buffer 3 ,1 ,1
picload "hari.bmp", 0
sany=ginfo_winy
sanx=ginfo_winx
buffer 4 ,1 ,1
picload "tama1.bmp"
tama1y=ginfo_winy
buffer 5 ,1 ,1
picload "tama4.bmp"
tama4y=ginfo_winy
buffer 6 ,1 ,1
picload "teiiten.bmp"
teiiteny=ginfo_winy
buffer 7 ,600 ,100
;ウインドウ0をアクティフにする
gsel 0, 1
font "MS ゴシック", 12, 16
;内部数値をリセット
gosub *gohasan
*main
repeat
for b,0,30,1
onkey gosub *encodeinput
if kei not 0 : goto *kasan
await 30
gmode 3,,,32
for a,9,-1,-1
pos sanx*a,genten
gcopy 7 ,0 ,0 ,sanx ,tama5y
pos , ginfo_cy+tama5y
; gcopy 7 ,0 ,0 ,sanx ,teiiteny
pos , ginfo_cy+teiiteny
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama4y
next
next
for b,0,32,1
onkey gosub *encodeinput
if kei not 0 : goto *kasan
await 50
gmode 3,,,32
for a,9,-1,-1
pos sanx*a,genten
gcopy 2
pos sanx*a, ginfo_cy+tama5y
if a\3=0 {
gcopy 6
pos sanx*a, ginfo_cy+teiiteny
}
else {
gcopy 3
pos sanx*a, ginfo_cy+sany
}
gcopy 4
pos sanx*a, ginfo_cy+tama1y
gcopy 4
pos sanx*a, ginfo_cy+tama1y
gcopy 4
pos sanx*a, ginfo_cy+tama1y
gcopy 5
next
next
loop
*encodeinput
switch wparam
;backspace -> 訂正
case 8
if vartype(en) not 2 : en = en / 10
swbreak
;esc -> 御破算
case 27
gosub *gohasan
swbreak
;enter -> 加算
case 13
if vartype(en)!2 {
if kei+en>999999999 {
sta="桁が溢れます. 最大9桁."
}
else {
startadd=1
keia=str(kei)
dim keib,10
e=strlen(keia)-1
for c,9,9-strlen(keia),-1
keib(c)=int(strmid(keia,e,1))
e=e-1
next
ena=str(en)
e=strlen(ena)-1
dim enb,10
for d,9,9-strlen(ena),-1
enb(d)=int(strmid(ena,e,1))
e=e-1
next
kei=kei+en
en="+"+en
}
}
swbreak
default
if wparam>=48 and wparam<=57 {
enput=wparam-48
gosub *processenput
}
swend
gsel 0
gmode 0
posback_x = ginfo_cx
posback_y = ginfo_cy
pos 7,0
color 255,255,255
boxf 7,0,300,genten
pos 7,0
color 0,0,0
mes en
mes kei
mes sta
pos posback_x ,posback_y
return
*gohasan
en=0
kei=0
sta="正常に御破算を完了しました."
gsel 0
gmode 0
pos 7,0
color 255,255,255
boxf 7,0,300,genten
pos 7,0
color 0,0,0
pos 7,0
mes en
mes kei
mes sta
genten=ginfo_cy
gogohasan =1
font "MS ゴシック", 12, 16
return
*processenput
;enが文字列型だ
if vartype(en)==2 {
en=enput
}
else {
if en>=100000000 {
sta="最大9桁まで."
}
else {
en=en*10+enput
}
}
return
*kasan
startadd=0
step=12
ck=0
goagarik=-1
kuriagarik=-1
gsel 0
gmode 0
pos 7,0
color 255,255,255
boxf 7,0,300,genten
pos 7,0
color 0,0,0
pos 7,0
mes en
mes kei
mes sta
gmode 3,,,32
repeat
;計算中に次の計算が入力されてしまった場合、
;次の計算のアニメーションに移る。
onkey gosub *encodeinput
await 15
if startadd=1 {
break
}
if gogohasan=1{
break
}
if cnt \ step=0 {
if goagarik!-1 {
if keib(goagarik)>=5 {
keib(goagarik)=keib(goagarik)-5
kuriagarik=goagarik-1
}
else {
keib(goagarik)=keib(goagarik)+5
}
goagarik=-1
goto *l
}
else {
if kuriagarik!-1 {
keib(kuriagarik) = keib(kuriagarik)+1
if keib(kuriagarik)=10 {
keib(kuriagarik)=0
kuriagarik=kuriagarik-1
}
else {
kuriagarik=-1
}
goto *l
}
else {
repeat
if ck>9 : break
if enb(ck)=0 {
ck=ck+1
}
else {
break
}
loop
if ck>9 : goto *l
if keib(ck)>=5 {
keibi = keib(ck) - 5
keibgo = 5
}
else {
keibi = keib(ck)
keibgo = 0
}
if enb(ck)>=5 {
enbi = enb(ck) -5
enbgo = 5
}
else {
enbi = enb(ck)
enbgo = 0
}
if enbgo=0 or keibgo=0 {
if keibi+enbi>4 {
keib(ck)=keib(ck)+enb(ck)
if keib(ck)>=10 {
if keibgo=5 {
goagarik=ck
keib(ck)=keib(ck)-5
}
else {
kuriagarik=ck-1
keib(ck)=keib(ck)-10
}
ck=ck+1
}
else {
if keib(ck)>=5 {
if keibgo=0 {
keib(ck)=keib(ck)-5
goagarik=ck
}
}
ck=ck+1
}
}
else {
keib(ck) = keib(ck)+enb(ck)
ck=ck+1
}
}
else {
kuriagarik=ck-1
keib(ck)=keib(ck)+enb(ck)
if keib(ck)>=10 {
keib(ck)=keib(ck)-10
}
ck=ck+1
}
}
}
}
*l
for a,9,-1,-1
pos sanx*a,genten
switch keib(a)
case 0
gcopy 7 ,0 ,0 ,sanx ,tama5y
pos sanx*a, ginfo_cy+tama5y
if a\3=0 {
gcopy 6
}
pos , ginfo_cy+teiiteny
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama4y
swbreak
case 1
gcopy 7 ,0 ,0 ,sanx ,tama5y
pos sanx*a, ginfo_cy+tama5y
if a\3=0 {
gcopy 6
}
pos , ginfo_cy+teiiteny
gcopy 4
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama4y
swbreak
case 2
gcopy 7 ,0 ,0 ,sanx ,tama5y
pos sanx*a, ginfo_cy+tama5y
if a\3=0 {
gcopy 6
}
pos , ginfo_cy+teiiteny
gcopy 4
pos , ginfo_cy+tama1y
gcopy 4
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama4y
swbreak
case 3
gcopy 7 ,0 ,0 ,sanx ,tama5y
pos sanx*a, ginfo_cy+tama5y
if a\3=0 {
gcopy 6
}
pos , ginfo_cy+teiiteny
gcopy 4
pos , ginfo_cy+tama1y
gcopy 4
pos , ginfo_cy+tama1y
gcopy 4
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama4y
swbreak
case 4
gcopy 7 ,0 ,0 ,sanx ,tama5y
pos sanx*a, ginfo_cy+tama5y
if a\3=0 {
gcopy 6
}
pos , ginfo_cy+teiiteny
gcopy 4
pos , ginfo_cy+tama1y
gcopy 4
pos , ginfo_cy+tama1y
gcopy 4
pos , ginfo_cy+tama1y
gcopy 5
swbreak
case 5
gcopy 2
pos sanx*a, ginfo_cy+tama5y
if a\3=0 {
gcopy 6
}
pos , ginfo_cy+teiiteny
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama4y
swbreak
case 6
gcopy 2
pos sanx*a, ginfo_cy+tama5y
if a\3=0 {
gcopy 6
}
pos , ginfo_cy+teiiteny
gcopy 4
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama4y
swbreak
case 7
gcopy 2
pos sanx*a, ginfo_cy+tama5y
if a\3=0 {
gcopy 6
}
pos , ginfo_cy+teiiteny
gcopy 4
pos , ginfo_cy+tama1y
gcopy 4
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama1y
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama4y
swbreak
case 8
gcopy 2
pos sanx*a, ginfo_cy+tama5y
if a\3=0 {
gcopy 6
}
pos , ginfo_cy+teiiteny
gcopy 4
pos , ginfo_cy+tama1y
gcopy 4
pos , ginfo_cy+tama1y
gcopy 4
pos , ginfo_cy+tama1y
gcopy 7 ,0 ,0 ,sanx ,tama4y
swbreak
case 9
gcopy 2
pos sanx*a, ginfo_cy+tama5y
if a\3=0 {
gcopy 6
}
pos , ginfo_cy+teiiteny
gcopy 4
pos , ginfo_cy+tama1y
gcopy 4
pos , ginfo_cy+tama1y
gcopy 4
pos , ginfo_cy+tama1y
gcopy 5
swbreak
swend
next
loop
if gogohasan=1{
gogohasan=0
goto *main
}
if startadd=1{
goto *kasan
}