Japanese Abacus Soroban 2

'Soroban - Japanese Abacus - SKH302-2
'Harry Hardjono
'August 2012
'
'Apparently, moving shapes is faster than show/hide shapes.

InitLoop:
GraphicsWindow.MouseUp=OnMouse
GraphicsWindow.Title="Small Basic Abacus"
GraphicsWindow.Width = 400
GraphicsWindow.Height=400
GraphicsWindow.FontSize=20
GraphicsWindow.FontName="Courier"
GraphicsWindow.Clear()
GraphicsWindow.Show()
GraphicsWindow.BrushColor="white"
GraphicsWindow.FillRectangle(0,0,GraphicsWindow.Width,GraphicsWindow.Height)
GraphicsWindow.BrushColor="black"

DoBG()
SetBead()
For i=0 To 14
BB[i]=0
SB[i]=0
EndFor
DoBead()
DoDigit()
IBB=BB
ISB=SB

DrawLoop:
BB=IBB
SB=ISB
x= GraphicsWindow.MouseX
y= GraphicsWindow.MouseY

DoMouse()
DoBead()
DoDigit()


Program.Delay(150) 'Wait 150 miliseconds
Goto DrawLoop

Sub DoBG
  GraphicsWindow.BrushColor="Black" 'Draw Frame
  GraphicsWindow.FillRectangle(0,0,399,212)
  GraphicsWindow.BrushColor="White"
  GraphicsWindow.FillRectangle(12,12,375,188)
  GraphicsWindow.BrushColor="Brown"
  For i=0 to 14
  GraphicsWindow.FillRectangle(23+(i*25),12,3,188)
  endfor
  GraphicsWindow.BrushColor="Black" 'Draw Slate & Rod
  GraphicsWindow.FillRectangle(0,62,399,13)

EndSub

Sub SetBead
'BigBead
  For i=0 to 14
  GraphicsWindow.BrushColor=GraphicsWindow.GetRandomColor()
  SSBB[0][i]=Shapes.AddEllipse(25,25)
  Shapes.Move(SSBB[0][i],12+(i*25),12)
  EndFor

'SmallBead
For j=0 To 3
  For i=0 to 14
  GraphicsWindow.BrushColor=GraphicsWindow.GetRandomColor()
  SSSB[j][i]=Shapes.AddEllipse(25,25)
  Shapes.Move(SSSB[j][i],12+(i*25),75+(j*25))
  EndFor
endfor

'Digits
  For i=0 to 14
  GraphicsWindow.BrushColor=GraphicsWindow.GetRandomColor()
  SSDG[i]=Shapes.AddText("0")
  Shapes.Move(SSDG[i],17+(i*25),212)
  EndFor

EndSub

Sub DoDigit
  For i=0 to 14
      Shapes.SetText(SSDG[i],(5*BB[i]+SB[i]))
endFor
EndSub


Sub DoBead
  For i=0 to 14
        Shapes.Move(SSBB[0][i],12+(i*25),12+(BB[i]*25))
EndFor

    For i=0 to 14
     For j=0 to 3
      If (SB[i]<=j) then
        Shapes.Move(SSSB[j][i],12+(i*25),75+((j+1)*25))
        Else
        Shapes.Move(SSSB[j][i],12+(i*25),75+((j)*25))
    endif  
    EndFor
EndFor

EndSub


Sub DoMouse
  map_var="mx1=12;mx2="+x+";mx3=387;my1=0;my3=15" 'Xcoord mapped to 0-14
  map()
  cx=Math.Floor(map_var["my2"])
  If (cx>=0 and cx<=14) then
    If (y>12 And y<62 p="p" then="then">      map_var="mx1=12;mx2="+y+";mx3=62;my1=2;my3=0" 'Ycoord mapped to 1-0
      map()
      cy=Math.Floor(map_var["my2"])
      If (cy>=0 And cy<=1) Then
        BB[cx]=cy
      EndIf
    EndIf

    If (y>75 And y<200 p="p" then="then">      map_var="mx1=75;mx2="+y+";mx3=200;my1=0;my3=5" 'Ycoord mapped to 4-0
      map()
      cy=Math.Floor(map_var["my2"])
      If (cy>=0 And cy<=4) Then
        SB[cx]=cy
      EndIf
    EndIf
  EndIf

EndSub

'----------------------------------------------
'map function
'----------------------------------------------
Sub map
  'x1-x2-x3 y1-y2-y3
  '(x2-x1)/(x3-x1)=(y2-y1)/(y3-y1)
  'y1+(y3-y1)*(x2-x1)/(x3-x1)=y2
  map_var["my2"]=((map_var["my3"]-map_var["my1"])*(map_var["mx2"]-map_var["mx1"])/(map_var["mx3"]-map_var["mx1"]))+map_var["my1"]
EndSub
 
'----------------------------------------------
'event function
'----------------------------------------------
Sub OnMouse
  if (BB<>IBB Or ISB<>SB) Then
    Sound.PlayClick()
  EndIf
  IBB=BB
  ISB=SB
EndSub

 

Small Basic Soroban Abacus

'Soroban - Japanese Abacus - SKH302
'Harry Hardjono
'August 2012
'
'These Unicode Characters draw Card Suits: Spade, Heart, Diamond,Club
'TestStr=Text.GetCharacter(9828)+Text.GetCharacter(9825)+Text.GetCharacter(9826)+Text.GetCharacter(9831)
'
'Over one hour is wasted because the Unicode characters for CharCL (empty bead) DO NOT LINE UP.
'


InitLoop:
GraphicsWindow.MouseUp=OnMouse
GraphicsWindow.Title="Small Basic Abacus"
GraphicsWindow.Width = 400
GraphicsWindow.Height=400
GraphicsWindow.FontSize=20
'GraphicsWindow.FontName="Courier"
GraphicsWindow.Clear()
GraphicsWindow.Show()
GraphicsWindow.BrushColor="white"
GraphicsWindow.FillRectangle(0,0,GraphicsWindow.Width,GraphicsWindow.Height)
GraphicsWindow.BrushColor="black"


CharCL=text.GetCharacter(9508)  '+text.GetCharacter(9474)+text.GetCharacter(9553)


SKB[0]=Text.GetCharacter(9556)
SKB[1]=Text.GetCharacter(9553)
SKB[2]=Text.GetCharacter(9553)
SKB[3]=Text.GetCharacter(9568)
SKB[4]=Text.GetCharacter(9553)
SKB[5]=Text.GetCharacter(9553)
SKB[6]=Text.GetCharacter(9553)
SKB[7]=Text.GetCharacter(9553)
SKB[8]=Text.GetCharacter(9553)
SKB[9]=Text.GetCharacter(9562)
DGT=" "


For i=1 To 15
  SKB[0]=Text.Append(SKB[0],Text.GetCharacter(9572))
  SKB[1]=Text.Append(SKB[1],Text.GetCharacter(9830))
  SKB[2]=Text.Append(SKB[2],Text.GetCharacter(9830))
  SKB[3]=Text.Append(SKB[3],Text.GetCharacter(9578))
  SKB[4]=Text.Append(SKB[4],Text.GetCharacter(9830))
  SKB[5]=Text.Append(SKB[5],Text.GetCharacter(9830))
  SKB[6]=Text.Append(SKB[6],Text.GetCharacter(9830))
  SKB[7]=Text.Append(SKB[7],Text.GetCharacter(9830))
  SKB[8]=Text.Append(SKB[8],Text.GetCharacter(9830))
  SKB[9]=Text.Append(SKB[9],Text.GetCharacter(9575))


IBB[i]=0
ISB[i]=0
DGT=Text.Append(DGT,(5*BB[i]+SB[i]))
EndFor


SKB[0]=Text.Append(SKB[0],Text.GetCharacter(9559))
SKB[1]=Text.Append(SKB[1],Text.GetCharacter(9553))
SKB[2]=Text.Append(SKB[2],Text.GetCharacter(9553))
SKB[3]=Text.Append(SKB[3],Text.GetCharacter(9571))
SKB[4]=Text.Append(SKB[4],Text.GetCharacter(9553))
SKB[5]=Text.Append(SKB[5],Text.GetCharacter(9553))
SKB[6]=Text.Append(SKB[6],Text.GetCharacter(9553))
SKB[7]=Text.Append(SKB[7],Text.GetCharacter(9553))
SKB[8]=Text.Append(SKB[8],Text.GetCharacter(9553))
SKB[9]=Text.Append(SKB[9],Text.GetCharacter(9565))




DrawLoop:
GraphicsWindow.FontSize=32
DKB=SKB
BB=IBB
SB=ISB
x= GraphicsWindow.MouseX
y= GraphicsWindow.MouseY
DGT=""


DoMouse()
DoBead()


For i=1 To 15
  DGT=Text.Append(DGT,(5*BB[i]+SB[i]))
EndFor


GraphicsWindow.FontSize=32
  GraphicsWindow.BrushColor="white"
  GraphicsWindow.FillRectangle(30,254,334,35)
  GraphicsWindow.BrushColor="black"
GraphicsWindow.DrawText(35,250,DGT)


GraphicsWindow.FontSize=40
For i=0 To 9
  If (ODKB[i]<>DKB[i]) Then
  GraphicsWindow.BrushColor="white"
  GraphicsWindow.FillRectangle(39,14+i*25,315,25)
  GraphicsWindow.BrushColor="black"
  EndIf
  GraphicsWindow.DrawText(20,i*25,DKB[i])
  ODKB[i]=DKB[i]
EndFor


Program.Delay(150) 'Wait 150 miliseconds
Goto DrawLoop


Sub DoBead
  For i=1 to 15
      DKB[2-BB[i]]=Text.Append(Text.Append(Text.GetSubText(DKB[2-BB[i]],1,i),text.GetCharacter(9553)),Text.GetSubTextToEnd(DKB[2-BB[i]],i+2))
      DKB[4+SB[i]]=Text.Append(Text.Append(Text.GetSubText(DKB[4+SB[i]],1,i),text.GetCharacter(9553)),Text.GetSubTextToEnd(DKB[4+SB[i]],i+2))  
  EndFor
EndSub




Sub DoMouse
  map_var="mx1=39;mx2="+x+";mx3=354;my1=1;my3=16" 'Xcoord mapped to 1-15
  map()
  cx=Math.Floor(map_var["my2"])
  If (cx>=1 and cx<=15) then
    If (y>39 And y < 85) Then
      map_var="mx1=39;mx2="+y+";mx3=85;my1=2;my3=0" 'Ycoord mapped to 1-0
      map()
      cy=Math.Floor(map_var["my2"])
      If (cy>=0 And cy<=1) Then
        BB[cx]=cy
      EndIf
    EndIf


    If (y>114 And y < 237) Then
      map_var="mx1=114;mx2="+y+";mx3=237;my1=0;my3=5" 'Ycoord mapped to 1-0
      map()
      cy=Math.Floor(map_var["my2"])
      If (cy>=0 And cy<=5) Then
        SB[cx]=cy
      EndIf
    EndIf
  EndIf


EndSub


'----------------------------------------------
'map function
'----------------------------------------------
Sub map
  'x1-x2-x3 y1-y2-y3
  '(x2-x1)/(x3-x1)=(y2-y1)/(y3-y1)
  'y1+(y3-y1)*(x2-x1)/(x3-x1)=y2
  map_var["my2"]=((map_var["my3"]-map_var["my1"])*(map_var["mx2"]-map_var["mx1"])/(map_var["mx3"]-map_var["mx1"]))+map_var["my1"]
EndSub
  
'----------------------------------------------
'event function
'----------------------------------------------
Sub OnMouse
IBB=BB
ISB=SB
EndSub