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  

Small Basic Auto Indent (with Subroutine lister)

'Indent - LDH635
'Harry Hardjono
'August 2012
'
CSD=0
indentlevel=0
indenttext="  "
indentarray=""
indentPlus=" sub for while if else elseif "
indentMin=" endsub endfor endwhile endif else elseif "


Filename=Program.Directory+"\indent1.sb"
FileSlurp()
For i=1 To Array.GetItemCount(FileData)
  SkipLeadSpace()
  CatalogSub()
  DoIndent()
  'TextWindow.WriteLine(OutData[i])
endfor


TextWindow.WriteLine("Sub List:")
For i=1 To Array.GetItemCount(SubData)
  TextWindow.Write(SubData[i])
  TextWindow.WriteLine("() ")
EndFor


Sub DoIndent
  StrIn=Text.ConvertToLowerCase(OutData[i])
  SpcInx=text.GetIndexOf(StrIn," ")
  If SpcInx=0 then
    SpcInx=Text.GetLength(StrIn)
  endif 
  StrIn=Text.GetSubText(OutData[i],1,SpcInx)
  StrIn=Text.ConvertToLowerCase(StrIn)
  If (text.GetLength(StrIn) > 1 And Text.GetIndexOf(indentMin,text.Append(" ",StrIn))>0) then
    indentlevel=indentlevel-1
    If indentlevel < 0 then
      indentlevel=0
    endif
    If indentlevel=0 then 
      indentarray[0]=""
    else
      indentarray[indentlevel]=text.Append(indentarray[indentlevel-1],indenttext)
    endif
    'TextWindow.WriteLine("DoIndentMin: "+StrIn)
  endif
  
  TextWindow.WriteLine(indentarray[indentlevel] + OutData[i])
  
  
  If (Text.GetIndexOf(indentPlus,StrIn) > 0) then
    indentlevel=indentlevel+1
    If indentlevel=0 then 
      indentarray[0]=""
    else
      indentarray[indentlevel]=text.Append(indentarray[indentlevel-1],indenttext)
    endif
    'TextWindow.WriteLine("DoIndentPlus: "+StrIn)
  endif
endsub




Sub CatalogSub
  StrIn=Text.ConvertToLowerCase(OutData[i])
  if text.StartsWith(StrIn,"sub ") then
    StrIn=Text.GetSubTextToEnd(StrIn,5)
    SpcInx=text.GetIndexOf(StrIn," ")
    If SpcInx=0 then
      SpcInx=Text.GetLength(StrIn)
    endif 
    StrOut=Text.GetSubText(OutData[i],1,SpcInx+4)
    
    CSD=CSD+1
    SubData[CSD]=StrOut
  endif
endsub


Sub SkipLeadSpace
  StrIn=FileData[i]
  StrOut=""
  For SLS_i=1 to Text.GetLength(StrIn)
    If (Text.GetCharacterCode(Text.GetSubText(StrIn,SLS_i,1))>32) then 'Non-space
      if (StrOut="") then  
        StrOut=Text.GetSubTextToEnd(StrIn,SLS_i)
      EndIf
    EndIf
  endfor  
  OutData[i]=StrOut
endsub




Sub FileSlurp
  'Read a file and assign it to an array
  'Input Filename (string)
  'Output FileData (array)
  FileLength=Text.GetLength(File.ReadContents(Filename))
  FileData=""
  FL=0
  FS_i=1
  While FL
    FileData[FS_i]=File.ReadLine(Filename,FS_i)
    FL=FL+Text.GetLength(FileData[FS_i])+2
    If FileData[FS_i]="" Then 'Fudge for blank lines in file
      FileData[FS_i]=" "
    EndIf
    FS_i=FS_i+1
  Endwhile
EndSub

Small Basic Programming Challenge#1

'Programming Challenge#1
'Microsoft Small Basic
'Harry Hardjono
'July 2012
'

text1="I'm singing in the rain!"
text2="The quick brown fox jumps over the lazy dog."
text3="a SMALL misfortune"

t1="abcdefghijklmnopqrstuvwxyz"
t2="ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Tin=text1
UpperLower()
Tin=text2
UpperLower()
Tin=text3
UpperLower()

Tin1=text3
Tin2=text2
Cin="SMALL"
CharIndex()
If Cout="" then
TextWindow.WriteLine("Not found!")
else
TextWindow.WriteLine(Cout)
endif

Tin1=text3
Tin2=text2
Cin="Small"
CharIndex()
If Cout="" then
TextWindow.WriteLine("Not found!")
else
TextWindow.WriteLine(Cout)
endif

Tin=text1
MakeAlpha()
TextWindow.WriteLine(Tout)
Tin=text2
MakeAlpha()
TextWindow.WriteLine(Tout)
Tin=text3
MakeAlpha()
TextWindow.WriteLine(Tout)

Tin=text1
IsPangram()
TextWindow.WriteLine(Tout)
Tin=text2
IsPangram()
TextWindow.WriteLine(Tout)
Tin=text3
IsPangram()
TextWindow.WriteLine(Tout)


Tin1=text1
Tin2="AEIOU"
StringOut()
TextWindow.WriteLine(Tout)
Tin1=text2
Tin2="aeiou"
StringOut()
TextWindow.WriteLine(Tout)
Tin1=text3
Tin2="qwrtypsdfghjklzxcvbmn"
StringOut()
TextWindow.WriteLine(Tout)


Filename=Program.Directory+"\hangman.txt"
FileSlurp()
For i=1 To Array.GetItemCount(FileData)
TextWindow.WriteLine(FileData[i])
endfor

Sub FileSlurp
'Read a file and assign it to an array
'Input Filename (string)
'Output FileData (array)
FileLength=Text.GetLength(File.ReadContents(Filename))
FileData=""
FL=0
FS_i=1
While FL < filelength
  FileData[FS_i]=File.ReadLine(Filename,FS_i)
  FL=FL+Text.GetLength(FileData[FS_i])+2
  If FileData[FS_i]="" Then 'Fudge for blank lines in file
    FileData[FS_i]=" "
  EndIf
  FS_i=FS_i+1
Endwhile
EndSub



Sub UpperLower
TextWindow.WriteLine(Tin)
Text_Lower()
TextWindow.WriteLine(Tout)
Text_Upper()
TextWindow.WriteLine(Tout)
EndSub


Sub Text_Lower
  'Make Tin string lowercase
  'Input Tin (string)
  'Output Tout (string)
  Tout=""
  For TL_i=1 To Text.GetLength(Tin)
    tchar=text.GetSubText(Tin,TL_i,1)
    tindx=text.GetIndexOf(t2,tchar)
    If tindx>0 Then
      tchar=text.GetSubText(t1,tindx,1)
    EndIf
    Tout=Text.Append(Tout,tchar)
  EndFor
EndSub


Sub Text_Upper
  'Make Tin string uppercase
  'Input Tin (string)
  'Output Tout (string)
  Tout=""
  For TL_i=1 To Text.GetLength(Tin)
    tchar=text.GetSubText(Tin,TL_i,1)
    tindx=text.GetIndexOf(t1,tchar)
    If tindx>0 Then
      tchar=text.GetSubText(t2,tindx,1)
    EndIf
    Tout=Text.Append(Tout,tchar)
  EndFor
EndSub

Sub CharIndex
  'Given 2 strings and a char, find the corresponding char from location t1 at t2
  'return "" if not found. return char/string otherwise
  'Input Tin1 = in index string
  'Input Tin2 = out index string
  'Input Cin = character / string
  'Output Cout = character/string
  tindx=text.GetIndexOf(Tin1,Cin)
  If (tindx=0) Then
    Cout=""
  Else
    Cout=text.GetSubText(Tin2,tindx,text.GetLength(Cin))
  EndIf
EndSub

Sub MakeAlpha
  'Given a string, pick out all alphabet. Store in UPPERCASE
  'Input Tin = string (text)
  'Output Tout = string (alphabets)
  Tout=""
  For MA_i = 1 To Text.GetLength(Tin)
    tchar=text.ConvertToUpperCase(text.GetSubText(Tin,MA_i,1))
    tindx=text.GetIndexOf(t2,tchar)
    If tindx>0 Then
      tindx=text.GetIndexOf(Tout,tchar)
      If tindx=0 Then
        Tout=Text.Append(Tout,tchar)
      EndIf
    EndIf
  EndFor
EndSub


Sub IsPangram
  'Given a string, see if all alphabets is represented
  'Input Tin = string(text)
  'Output Tout = string "TRUE" if yes. "FALSE" if false
  Tin1=text.ConvertToUpperCase(Tin)
  Tout="TRUE"
  For IP_i=1 To Text.GetLength(t2)
    tchar=Text.GetSubText(t2,IP_i,1)
    tindx=text.GetIndexOf(Tin1,tchar)
    If (tindx=0) Then
      Tout="FALSE"
    EndIf
  EndFor
EndSub

Sub CharOut
  'Given 2 strings return string of char found in Tin1, but not in Tin2
  'return string
  'Note: No character upper/lower conversion is done.
  'Input Tin1 = main index string
  'Input Tin2 = sub index string
  'Output Tout = character/string
  Tout=""
  For CO_i=1 To Text.GetLength(Tin1)
    tchar=text.GetSubText(Tin1,CO_i,1)
    tindx=text.GetIndexOf(Tin2,tchar)
    If (tindx=0) Then
      Tout=Text.Append(Tout,tchar)
    EndIf
  EndFor
EndSub

Sub StringOut
  'Given 2 strings return string of char found in Tin1, but not in Tin2
  'return string
  'Note: Convert all char to UPPER
  'Note: Calls CharOut(), MakeAlpha()
  'Input Tin1 = main index string
  'Input Tin2 = sub index string
  'Output Tout = character/string
 
  Tin1=text.ConvertToUpperCase(Tin1)
  Tin2=text.ConvertToUpperCase(Tin2)
  CharOut()
  Tin=Tout
  MakeAlpha()
EndSub

Small Basic Noise Checker

'Noise Checker - wxv722-6
'Uses Dictionary.GetDefinition(word) - Need internet access
'Harry Hardjono
'July 2012 - adjective and adverb marker. Good for filtering nasty posts. :)
' just change color red and yellow to black.
'Updated with dict.txt
'
Str="abcdefghijklmnopqrstuvwxyz'ABCDEFGHIJKLMNOPQRSTUVWXYZ"
ReadDictFile()
inputtext=""
DataFile=""

While (inputtext<>" ")
TextWindow.WriteLine("  ")
TextWindow.WriteLine("Enter file name: ")
FileDir=text.Append(Program.Directory,"\")
WT="1=black;2=white;"
WriteText()
DataFile=File.ReadContents(text.Append(FileDir,Textwindow.read()))
inputtext=text.Append(DataFile," ")
counteradv=0
counteradj=0
counterunk=0
counterwrd=0
For i=1 To Text.GetLength(inputtext)
  If (Text.GetIndexOf(Str,Text.GetSubText(inputtext,i,1))=0) Then    'Not word
    If (Word<>"") Then
      GetDictWord()
      If (DictWord="") Then
WT="1=white;2=black;"
WriteText()
      Else
        fword=DictWord
        adjloc=text.GetIndexOf(fword,"adjective")
        advloc=text.GetIndexOf(fword,"adverb")
        unkloc=text.GetIndexOf(fword,"unknown")
        rploc=text.GetIndexOf(fword,")")
        If (adjloc0) then  'adjective
WT="1=red;2=black;"
WriteText()
counteradj=counteradj+1
      ElseIf (advloc0) then  'adverb
WT="1=yellow;2=black;"
WriteText()
counteradv=counteradv+1
      ElseIf (unkloc0) then  'unknown
WT="1=white;2=black;"
WriteText()
counterunk=counterunk+1
        Else
WT="1=black;2=white;"
WriteText()
counterwrd=counterwrd+1
        EndIf
      EndIf
      Word=""
    EndIf
    TextWindow.Write(Text.GetSubText(inputtext,i,1))
  Else 'Word
    Word=Text.Append(Word,Text.GetSubText(inputtext,i,1))
  EndIf
endfor

ShowNoiseRatio()
EndWhile

WriteDictFile()

'===============================
'Program ends here
'===============================

Sub  ShowNoiseRatio

NR=Math.Round(1000*(counteradj+counteradv)/counterwrd)/10
NRT="Noise Level Interpretation"
If (NR<5) then
  NRT="Text is very clean."
ElseIf (NR<10) then
  NRT="Text is relatively clean"
ElseIf (NR<15) then
  NRT="Can use less noise."
ElseIf (NR<18) then
  NRT="Somewhat noisy."
ElseIf (NR<20) then
  NRT="Noisy. Very Noisy."
ElseIf (NR<23) then
  NRT="You're being annoying on purpose, aren't you?"
ElseIf (NR<28) then
  NRT="Are you kidding me? I have to wash my eyeballs after this!"
ElseIf (NR<32) then
  NRT="Is there a World War out there? Gettouttahere!"
ElseIf (NR<50) then
  NRT="This is so bad, I will not dignify it with a response!"
else
NRT="This high level of noise is impossible! Impossible!"
endif

TextWindow.WriteLine("")
TextWindow.Write("Noise ratio is ")
TextWindow.WriteLine(NR)
TextWindow.WriteLine(NRT)

endsub


  Sub WriteText
        TextWindow.BackgroundColor=WT[1]
      TextWindow.ForegroundColor=WT[2]
      TextWindow.Write(Word)
      TextWindow.BackgroundColor="black"
      TextWindow.ForegroundColor="white"
  EndSub
   
Sub GetDictWord
      If (HashWord[Word]="") Then
        tword=Dictionary.GetDefinition(Word)
        If (tword="") then
          tword="Unknown. (unknown) "
        EndIf
        tline=Text.GetSubText(tword,1,1+Text.GetIndexOf(tword,")"))
        HashWord[Word]=tline
      EndIf
      DictWord=HashWord[Word]
      'TextWindow.WriteLine(DictWord)
  EndSub
 
  Sub WriteDictFile
    FileDir=text.Append(Program.Directory,"\dict.txt")
    File.WriteContents(FileDir,HashWord)
  EndSub
 
  Sub ReadDictFile
    FileDir=text.Append(Program.Directory,"\dict.txt")
    HashWord=File.ReadContents(FileDir)
EndSub  
   

Small Basic Spell Checker - 25 lines challenge

'Spell checker example - wxv722-2
'Uses Dictionary.GetDefinition(word) - Need internet access
'Harry Hardjono
'June 2012 - 25 line small basic challenge version
'
Str="abcdefghijklmnopqrstuvwxyz'ABCDEFGHIJKLMNOPQRSTUVWXYZ"
While (inputtext<>" ")
TextWindow.WriteLine("  ")
TextWindow.WriteLine("Enter your sentence: ")
inputtext=text.Append(TextWindow.Read()," ")
For i=1 To Text.GetLength(inputtext)
  If (Text.GetIndexOf(Str,Text.GetSubText(inputtext,i,1))=0) Then    'Not word
    If (Word<>"") Then
      If (Dictionary.GetDefinition(Word)="") Then  
      TextWindow.BackgroundColor="white"
      TextWindow.ForegroundColor="black"
      TextWindow.Write(Word)
      TextWindow.BackgroundColor="black"
      TextWindow.ForegroundColor="white"
      Else
      TextWindow.Write(Word)
      EndIf
      Word=""
    EndIf
    TextWindow.Write(Text.GetSubText(inputtext,i,1))
  Else 'Word
    Word=Text.Append(Word,Text.GetSubText(inputtext,i,1))
  EndIf
endfor
EndWhile

Small Basic Cube Root

'Cuberoot challenge - MLQ436-0
'Harry Hardjono
'June 2012
'Just a 10 minute quickie

Loop:
TextWindow.Write("Enter a number (1-1000): ")
N=TextWindow.ReadNumber()

If N=0 Then
  Program.End()
EndIf

D=1000 'Delta. Decreasing range in calcloop.
S=1 'Starting number. To be modified in calcloop.
E=0.00000000001 ' Epsilon. Desired accuracy.

calcloop:
While (D>E)
  C=(S+D)*(S+D)*(S+D)
  If C<=N Then
    S=S+D
  Else 'Not comfortable skipping else when D isn't a power of two.
    D=D/2
  EndIf
EndWhile

TextWindow.Write("Cube root is: ")
TextWindow.WriteLine(S)
TextWindow.WriteLine(" ")
Goto Loop

Small Basic Spell Checker

'Spell checker example - wxv722-1
'Uses Dictionary.GetDefinition(word) - Need internet access
'Harry Hardjono
'June 2012
'
Init:
Str="abcdefghijklmnopqrstuvwxyz'ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Word=""


Loop:
TextWindow.BackgroundColor="black"
TextWindow.ForegroundColor="white"
TextWindow.WriteLine("  ")
TextWindow.WriteLine("Enter your sentence: ")
inputtext=text.Append(TextWindow.Read()," ") 'bug fix. ^_^;

If (inputtext=" ") Then
  Goto End
EndIf


For i=1 To Text.GetLength(inputtext)
  curchar=Text.GetSubText(inputtext,i,1)
  If (Text.GetIndexOf(Str,curchar)=0) Then
    'Not word
    If (Word<>"") Then
      WordDef=Dictionary.GetDefinition(Word)
      If (WordDef="") Then
      TextWindow.BackgroundColor="white"
      TextWindow.ForegroundColor="black"
      TextWindow.Write(Word)
      TextWindow.BackgroundColor="black"
      TextWindow.ForegroundColor="white"
      Else
      TextWindow.Write(Word)
      EndIf
      Word=""
    EndIf
    TextWindow.Write(curchar)
  Else 'Word
    Word=Text.Append(Word,curchar)
  EndIf
endfor

Goto Loop

End:
Program.End()

Poker Hand Probabilities using nCr

'Poker probabilities - ZFS003-0
'Harry Hardjono
'May 2012
'
' Verified: Royal Flush, Flush
'I wonder why the probabilities don't match?
'
'
'All cards possibilities
S=52*51*50*49*48
TextWindow.WriteLine("All Card Possibilities: "+S)


'Royal Flush
P=20*4*3*2*1
TextWindow.WriteLine("Royal Flush:     1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Straight Flush
P=32*4*3*2*1
TextWindow.WriteLine("Straight Flush:  1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Four of a Kind
P=52*3*2*1*48
TextWindow.WriteLine("Four of a Kind:  1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Full House
P=52*3*2*48*3
TextWindow.WriteLine("Full House:      1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Flush
P=52*12*11*10*9
TextWindow.WriteLine("Flush:           1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Straight
P=52*16*12*8*4
TextWindow.WriteLine("Straight:        1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Three of a Kind
P=52*3*2*48*44
TextWindow.WriteLine("Three of a Kind: 1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Two Pair
P=52*3*48*3*44
TextWindow.WriteLine("Two Pair:        1 in "+Math.Round(S/P)+"       "+(P*100/S))


'One Pair
P=52*3*48*44*42
TextWindow.WriteLine("One Pair:        1 in "+Math.Round(S/P)+"       "+(P*100/S))


'High Card
P=52*48*44*42*38
TextWindow.WriteLine("High Card:       1 in "+Math.Round(S/P)+"       "+(P*100/S))


TextWindow.WriteLine(" ")
TextWindow.WriteLine("These combinations are verified on Wiki")


'Combination
N=52
R=5
nCr()
S=C
TextWindow.WriteLine("Combination:  "+C+"       ")


'Royal Flush
N=4
R=1
nCr()
TextWindow.WriteLine("Royal Flush:     1 in "+Math.Round(S/C)+"       "+(C*100/S))


'Straight Flush
ArrN="1=10;2=4;3=4;"
ArrR="1=1;2=1;3=1;"
MultinCr()
P=(ArrC[1]*ArrC[2])-ArrC[3]
TextWindow.WriteLine("Straight Flush:  1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Four of a Kind
ArrN="1=13;2=12;3=4;"
ArrR="1=1;2=1;3=1;"
MultinCr()
P=(ArrC[1]*ArrC[2]*ArrC[3])
TextWindow.WriteLine("Four of a Kind:  1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Full House
ArrN="1=13;2=4;3=12;4=4;"
ArrR="1=1;2=3;3=1;4=2;"
MultinCr()
P=(ArrC[1]*ArrC[2]*ArrC[3]*ArrC[4])
TextWindow.WriteLine("Full House:      1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Flush
ArrN="1=13;2=4;3=10;4=4;"
ArrR="1=5;2=1;3=1;4=1;"
MultinCr()
P=(ArrC[1]*ArrC[2])-(ArrC[3]*ArrC[4])
TextWindow.WriteLine("Flush:           1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Straight
ArrN="1=10;2=4;3=10;4=4;"
ArrR="1=1;2=1;3=1;4=1;"
MultinCr()
P=(ArrC[1]*ArrC[2]*ArrC[2]*ArrC[2]*ArrC[2]*ArrC[2])-(ArrC[3]*ArrC[4])
TextWindow.WriteLine("Straight:        1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Three of a Kind
ArrN="1=13;2=4;3=12;4=4;"
ArrR="1=1;2=3;3=2;4=1;"
MultinCr()
P=(ArrC[1]*ArrC[2]*ArrC[3]*ArrC[4]*ArrC[4])
TextWindow.WriteLine("Three of a Kind: 1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Two Pair
ArrN="1=13;2=4;3=11;4=4;"
ArrR="1=2;2=2;3=1;4=1;"
MultinCr()
P=(ArrC[1]*ArrC[2]*ArrC[2]*ArrC[3]*ArrC[4])
TextWindow.WriteLine("Two Pair:        1 in "+Math.Round(S/P)+"       "+(P*100/S))


'One Pair
ArrN="1=13;2=4;3=12;4=4;"
ArrR="1=1;2=2;3=3;4=1;"
MultinCr()
P=(ArrC[1]*ArrC[2]*ArrC[3]*ArrC[4]*ArrC[4]*ArrC[4])
TextWindow.WriteLine("One Pair:        1 in "+Math.Round(S/P)+"       "+(P*100/S))


'High Card
ArrN="1=13;2=10;3=4;4=4;"
ArrR="1=5;2=1;3=1;4=1;"
MultinCr()
P=(ArrC[1]-ArrC[2])*(ArrC[3]*ArrC[3]*ArrC[3]*ArrC[3]*ArrC[3]-ArrC[4])
TextWindow.WriteLine("High Card:       1 in "+Math.Round(S/P)+"       "+(P*100/S))








Sub MultinCr
  For m=1 To Array.GetItemCount(ArrN)
    N=ArrN[m]
    R=ArrR[m]
    nCr()
    ArrC[m]=C
    EndFor
endsub
  


'nCr = (n!)/(r!*(n-r)!)
Sub nCr
  'N (input)
  'R (input)
  C=1 '(output)
  For i=Math.Max(R,(N-R))+1 To N
    C=C*i
  EndFor
  For i=1 To Math.Min(R,(N-R))
    C=C/i
  EndFor
EndSub


  
TextWindow.WriteLine(" ")
TextWindow.WriteLine("These combinations are verified on Wiki")


'Combination
N=52
R=5
nCr2()
S=C
TextWindow.WriteLine("Combination:  "+C+"       ")


'Royal Flush
N=4
R=1
nCr2()
TextWindow.WriteLine("Royal Flush:     1 in "+Math.Round(S/C)+"       "+(C*100/S))


'Straight Flush
ArrN="1=10;2=4;3=4;"
ArrR="1=1;2=1;3=1;"
MultinCr2()
P=(ArrC[1]*ArrC[2])-ArrC[3]
TextWindow.WriteLine("Straight Flush:  1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Four of a Kind
ArrN="1=13;2=12;3=4;"
ArrR="1=1;2=1;3=1;"
MultinCr2()
P=(ArrC[1]*ArrC[2]*ArrC[3])
TextWindow.WriteLine("Four of a Kind:  1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Full House
ArrN="1=13;2=4;3=12;4=4;"
ArrR="1=1;2=3;3=1;4=2;"
MultinCr2()
P=(ArrC[1]*ArrC[2]*ArrC[3]*ArrC[4])
TextWindow.WriteLine("Full House:      1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Flush
ArrN="1=13;2=4;3=10;4=4;"
ArrR="1=5;2=1;3=1;4=1;"
MultinCr2()
P=(ArrC[1]*ArrC[2])-(ArrC[3]*ArrC[4])
TextWindow.WriteLine("Flush:           1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Straight
ArrN="1=10;2=4;3=10;4=4;"
ArrR="1=1;2=1;3=1;4=1;"
MultinCr2()
P=(ArrC[1]*ArrC[2]*ArrC[2]*ArrC[2]*ArrC[2]*ArrC[2])-(ArrC[3]*ArrC[4])
TextWindow.WriteLine("Straight:        1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Three of a Kind
ArrN="1=13;2=4;3=12;4=4;"
ArrR="1=1;2=3;3=2;4=1;"
MultinCr2()
P=(ArrC[1]*ArrC[2]*ArrC[3]*ArrC[4]*ArrC[4])
TextWindow.WriteLine("Three of a Kind: 1 in "+Math.Round(S/P)+"       "+(P*100/S))


'Two Pair
ArrN="1=13;2=4;3=11;4=4;"
ArrR="1=2;2=2;3=1;4=1;"
MultinCr2()
P=(ArrC[1]*ArrC[2]*ArrC[2]*ArrC[3]*ArrC[4])
TextWindow.WriteLine("Two Pair:        1 in "+Math.Round(S/P)+"       "+(P*100/S))


'One Pair
ArrN="1=13;2=4;3=12;4=4;"
ArrR="1=1;2=2;3=3;4=1;"
MultinCr2()
P=(ArrC[1]*ArrC[2]*ArrC[3]*ArrC[4]*ArrC[4]*ArrC[4])
TextWindow.WriteLine("One Pair:        1 in "+Math.Round(S/P)+"       "+(P*100/S))


'High Card
ArrN="1=13;2=10;3=4;4=4;"
ArrR="1=5;2=1;3=1;4=1;"
MultinCr2()
P=(ArrC[1]-ArrC[2])*(ArrC[3]*ArrC[3]*ArrC[3]*ArrC[3]*ArrC[3]-ArrC[4])
TextWindow.WriteLine("High Card:       1 in "+Math.Round(S/P)+"       "+(P*100/S))








Sub MultinCr2
  For m=1 To Array.GetItemCount(ArrN)
    N=ArrN[m]
    R=ArrR[m]
    nCr2()
    ArrC[m]=C
    EndFor
endsub
  


'nCr = (n!)/(r!*(n-r)!)
Sub nCr2
  'N (input)
  'R (input)
  C=N '(output)
  For i=2 To Math.Min(R,(N-R))
    C=C*(N-(i-1))/i
  EndFor
EndSub

Small Basic Fortune Teller

This is an example of accessing arrays. I suppose a better way to do this is to read a file into said array. You don't really need to answer the question since the program doesn't do anything with it.


'Clairvoyant - PZH705
'Fortune telling in Small Basic
'Example tutorial in how to access arrays.
'There are different ways to access arrays depending upon the codes.
'You can put this in one line if you're willing to string the text together
'and do proper calculation.
'
Init:
A[1]="It is certain"
A[2]="Yes - definitely"
A[3]="Most likely"
A[4]="Outlook good"
A[5]="Yes"
A[6]="Reply hazy"
A[7]="My reply is no"
A[8]="Outlook not so good"
A[9]="Very doubtful"
A_length=Array.GetItemCount(A)
NL=Text.GetCharacter(13)+Text.GetCharacter(10) 'newline


Loop:
TextWindow.Write(("What is your Yes/No Question? "+ NL))
TextWindow.Read()
TextWindow.WriteLine((A[Math.GetRandomNumber(A_length)]+NL+NL))
Goto Loop

Small Basic Prime Number

' Harry Hardjono
'May 2012
' Done in less than 30 minutes. :)


Init:
TextWindow.WriteLine("How many Prime numbers (1-1000)? ")
N=TextWindow.ReadNumber()
If N<1 Or N>1000 Then
  TextWindow.WriteLine("That's All Folks!")
  TextWindow.Pause()
  Program.End()
EndIf


Prime="1=2;"
Num=Prime[Array.GetItemCount(Prime)]


MainLoop:
Num=Num+1
  
  Flag=1
  For i=1 To Array.GetItemCount(Prime)
    If (Math.Remainder(Num,Prime[i])=0) Then
      'Not Prime
      Flag=0
      i=Array.GetItemCount(Prime)
    EndIf
  EndFor
  If Flag=1 Then
    Prime[Array.GetItemCount(Prime)+1]=Num
    TextWindow.Write(Array.GetItemCount(Prime))
    TextWindow.WriteLine("   "+Num)
    if Array.GetItemCount(Prime)>=N Then
      Goto Ender
    EndIf
  EndIf
  Goto MainLoop
  


Ender:
'TextWindow.Write("Press any key to continue...")
TextWindow.WriteLine("---")
TextWindow.Pause()
Goto Init

Small Basic Converter Code

One of April challenges is writing a converter, the kind that converts meter to yard. A lot of people are doing it the hard coding way. I am way to busy to do that. So, I decided to spend one hour on it, and no more! The result is here. Not perfect, but close enough.

There are several design issues:

1. The display for various conversion and the result is rolled into one.

2. You only select the original data, all the possible conversions is done automatically.

3. Range is limited to valid input

4. The data is provided via text. You can modify the text to suit.

5. More importantly, the text also include range of numbers, which the program uses for conversion. The ratio for conversion is calculated automatically. This includes negative numbers, or shifting numbers (i.e. 1-5 into 3-7)

6. I use a hidden Main scale to facilitate ease of conversion.

7. Pay attention to Field[] entries! They defined the data field locations!

These design decisions helped me contained the implementation of this program into one hour.

I did encounter one bug. When copying Choice Loop into NumLoop, I forgot to change the Goto statement, so it went back to Choice Loop. Easily fixed.

Turns out, the algorithm for conversion is robust enough to handle out of range condition, so that I don't have to restrict its input. I could have avoided that bug after all.

It also means, that I don't have to show the range of numbers. It means I can just display the descriptions, and the converted numbers. It would make a cleaner presentation.

'Small Basic Converter - ZLW480

'By Harry Hardjono

'April 2012

'

Init:

MainMin=0

MainNum=0

MainMax=9999999

Field[1]=1 'N

Field[2]=3 'Description

Field[3]=14 'From

Field[4]=18 'Min

Field[5]=28 'To

Field[6]=30 'Max

Field[7]=40 ':

'Data[0]="N DescriptionFrom To :"

Data[1]="1 USD From 0 To 100000 : "

Data[2]="2 GBP From 0 To 158308 : "

Data[3]="3 CAD From 0 To 99962 : "

Data[4]="4 EUR From 0 To 130240 : "

Data[5]="5 AUD From 0 To 103447 : "

TextWindow.WriteLine("Small Basic Converter")

MainLoop:

For i=1 To Array.GetItemCount(Data)

TextWindow.Write(Text.GetSubText(Data[i],1,Text.GetLength(Data[i])))

mx1=MainMin

mx2=MainNum

mx3=MainMax

my1=Text.GetSubText(Data[i],Field[4],Field[5]-Field[4])

my3=Text.GetSubText(Data[i],Field[6],Field[7]-Field[6])

map()

TextWindow.WriteLine(my2)

EndFor

TextWindow.WriteLine(" ")

ChoiceLoop:

TextWindow.Write(("Which data(1-"+Array.GetItemCount(Data))+")?")

Choice=TextWindow.ReadNumber()

If (Choice<1 or Choice>Array.GetItemCount(Data)) then

TextWindow.WriteLine("Out of Range!")

Goto ChoiceLoop

endif

NumLoop:

TextWindow.WriteLine(Text.GetSubText(Data[Choice],Field[4],Field[5]-Field[4])+" to "+Text.GetSubText(Data[Choice],Field[6],Field[7]-Field[6]))

TextWindow.Write("Enter the amount: ")

Num=TextWindow.ReadNumber()

' If (NumText.GetSubText(Data[Choice],Field[6],Field[7]-Field[6])) then

' TextWindow.WriteLine("Out of Range!")

' Goto NumLoop

'endif

mx1=Text.GetSubText(Data[Choice],Field[4],Field[5]-Field[4])

mx2=Num

mx3=Text.GetSubText(Data[Choice],Field[6],Field[7]-Field[6])

my1=MainMin

my3=MainMax

map()

MainNum=my2

Goto MainLoop

Sub map 'map function

'x1-x2-x3 y1-y2-y3

my2=((my3-my1)*(mx2-mx1)/(mx3-mx1))+my1

EndSub

Small Basic Morse Code

I got bored one day, and hey, remember that Rock/Paper/Scissors game? That was quick. So I was hunting for a quick coding project, quicker than my usual one hour session. The Morse code is it. It took about 10 minutes, including typing all those entries. Of course, the original design was phonetic alphabet project, but I decided that typing Morse code entries would be faster than typing phonetic alphabet entries.

BTW, you don't have to limit yourself. You can do your own project like this, and substitute Klingon alphabet, for example. Do you know that Small Basic uses Unicode? Try looping some big numbers through Text.GetCharacter and you'll get the idea.

Of course, as luck would have it, I still have some time, so I improved it with tones. I think there is something wrong here because the sound is so soft! Oh, well.

'Extending the code, as well as decoding is left as an exercise for the reader!

Morse="a=+-;b=-+++;c=-+-+;d=-++;e=+;f=++-+;g=--+;h=++++;i=++;j=+---;k=-+-;l=+-++;m=--;n=-+;o=---;p=+--+;q=--+-;r=+-+;s=+++;t=-;u=++-;v=+++-;w=+--;x=-++-;y=-+--;z=--++;"

Loop:

TextWindow.Write("Enter Text:")

t=TextWindow.Read()

For i=1 To Text.GetLength(t)

TextWindow.Write((Morse[Text.ConvertToLowerCase(Text.GetSubText(t,i,1))])+" ")

EndFor

TextWindow.WriteLine(" ")

Goto Loop

'Extending the code, as well as decoding is left as an exercise for the reader!

Morse="a=+-;b=-+++;c=-+-+;d=-++;e=+;f=++-+;g=--+;h=++++;i=++;j=+---;k=-+-;l=+-++;m=--;n=-+;o=---;p=+--+;q=--+-;r=+-+;s=+++;t=-;u=++-;v=+++-;w=+--;x=-++-;y=-+--;z=--++;"

TextWindow.WriteLine("Morse Code Encoder by Harry Hardjono")

Loop:

TextWindow.Write(Text.GetCharacter(13)+Text.GetCharacter(10)+"Enter Text:")

t=TextWindow.Read()

For i=1 To Text.GetLength(t)

MC=Text.Append(MC,(Morse[Text.ConvertToLowerCase(Text.GetSubText(t,i,1))]+" ")) 'Comment this out for no sound

TextWindow.Write((Morse[Text.ConvertToLowerCase(Text.GetSubText(t,i,1))])+" ")

EndFor

PlayMorse() 'Comment this out for no sound

Goto Loop

Sub PlayMorse

TT="+=C12;-=C4; =P4;"

For j=1 To Text.GetLength(MC)

MT=Text.Append(MT,TT[Text.GetSubText(MC,j,1)])

EndFor

Sound.PlayMusic(MT)

MC=""

MT=""

EndSub

Small Basic Rock Paper Scissors Code

Just a little quickie, this time. I was looking at the Rock, Paper, Scissors that others have written, and Jason boiled it down to 2 lines. Which I think isn't strictly true. I'd have call it one line. Here is another one-liner. This one works by first splitting the input into 3, and splitting it again. Basically, a simpler way to handle multi-dimensional strings. I also added a touch of detail in that you actually type R/P/S as entry. I could have added the code to convert the input into uppercase, but it's long enough as it is.

I do not do tutorials, at least at this time, but I left out all the original code as comments so hopefully, you can learn from it.

'Rock Paper Scissor

' by Harry Hardjono

'April 2012 - GTJ601

'

'This is an implementation of Rock-Paper-Scissors

'Rock beat Scisscors

'Scisscors beat Paper

'Paper beat Rock

'

'The input requires capital letter, and is one of these:

'(R)ock, (P)aper,(S)cissors

'The program will randomly choose one of them

'and display the result.

'

'The output is encoded because I'm too lazy to type them out.

'">R" means "You choose Rock."

'">P" means "You choose Paper."

'">S" means "You choose Scissors."

'"vR" means "Computer chooses Rock."

'"vP" means "Computer chooses Paper."

'"vS" means "Computer chooses Scissors."

'"=W" means "You win!"

'"=L" means "Computer wins!"

'"=D" means "It's a draw!"

'So, ">RvS=W" is interpreted as:

'"You choose Rock. Computer chooses Scissors. You win!"

'

'The following is the original source code before

'I collapse them into one line.

'

'Loop:

'T1=">RvR=D>RvP=L>RvS=W>PvR=W>PvP=D>PvS=L>SvR=L>SvP=W>SvS=D"

'P1=(Text.GetIndexOf("RPS",TextWindow.Read())-1)

'T2=Text.GetSubText(T1,1+(P1*18),18)

'P2=(Math.GetRandomNumber(3)-1)

'T3=(Text.GetSubText(T2,1+(P2*6),6))

'TextWindow.WriteLine(T3)

'Goto Loop

Loop:

TextWindow.WriteLine((Text.GetSubText(Text.GetSubText(">RvR=D>RvP=L>RvS=W>PvR=W>PvP=D>PvS=L>SvR=L>SvP=W>SvS=D",1+((Text.GetIndexOf("RPS",TextWindow.Read())-1)*18),18),1+((Math.GetRandomNumber(3)-1)*6),6)))

Goto Loop

Small Basic Analog Clock

I wrote a Small Basic Analog Clock. Since I really want to have background pictures, I use Shapes. The rotation is a mess. Lots of trial and error. I also put in time offset, although you have to muddle with the source code to do it. Maybe an update will allow you to do it without modifying the source code. The sample picture has random picture from Flickr. I do wish I know who took it, so it can be properly credited.

'Analog Clock - MHR140

'A Shape example

'by Harry Hardjono

' April 2012

'

'Init

GraphicsWindow.Width=400

GraphicsWindow.Height=400

GraphicsWindow.Show()

GraphicsWindow.Clear()

screen_x=GraphicsWindow.Width

screen_y=GraphicsWindow.Height

'Commented out because it hangs on my SilverLight

'BPic=Flickr.GetRandomPicture("clock")

'BImg=ImageList.LoadImage(BPic)

'BGP=Shapes.AddImage(BImg)

For i=1 to 12

Digits[i]=Shapes.AddRectangle(10,40)

mx1=1

mx2=i

mx3=12

my1=30

my3=360

map()

DAngle=my2

Dx=(screen_x/2)+150*Math.Sin(Math.GetRadians(DAngle))

Dy=(screen_y/2)-150*Math.Cos(Math.GetRadians(DAngle))

Shapes.Rotate(Digits[i],DAngle)

Shapes.Move(Digits[i],Dx,Dy)

Program.Delay(100)

endfor

GraphicsWindow.BrushColor="White"

Hand[1]=Shapes.AddRectangle(20,90) 'Hour hand

Hand[2]=Shapes.AddRectangle(12,150) 'Minute hand

Hand[3]=Shapes.AddRectangle(2,180) 'Second hand

GraphicsWindow.FontSize=15

GraphicsWindow.BrushColor="Black"

TT=Shapes.AddText(Clock.Time)

Shapes.Move(TT,150,5)

OffsetHour=0

OffsetMin=0

OffsetSec=0

Loop:

OnTick()

Program.Delay(1000)

Goto Loop

Sub OnTick

Shapes.SetText(TT,Clock.Time)

THour=Clock.Hour

mx1=0

mx2=Math.Remainder(THour+OffsetHour,12)

mx3=12

my1=0

my3=360

map()

DAngle=my2

Dx=((screen_x/2)+10)+40*Math.Sin(Math.GetRadians(DAngle))

Dy=((screen_y/2)-22.5)-40*Math.Cos(Math.GetRadians(DAngle))

Shapes.Rotate(Hand[1],DAngle)

Shapes.Move(Hand[1],Dx-15,Dy)

TMin=Clock.Minute

mx1=0

mx2=Math.Remainder(TMin+OffsetMin,60)

mx3=60

my1=0

my3=360

map()

DAngle=my2

Dx=((screen_x/2)+6)+60*Math.Sin(Math.GetRadians(DAngle))

Dy=((screen_y/2)-75)-60*Math.Cos(Math.GetRadians(DAngle))

Shapes.Rotate(Hand[2],DAngle)

Shapes.Move(Hand[2],Dx-8,Dy+20)

TSec=Clock.Second

mx1=0

mx2=Math.Remainder(TSec+OffsetSec,60)

mx3=60

my1=0

my3=360

map()

DAngle=my2

Dx=((screen_x/2)+1)+70*Math.Sin(Math.GetRadians(DAngle))

Dy=((screen_y/2)-90)-70*Math.Cos(Math.GetRadians(DAngle))

Shapes.Rotate(Hand[3],DAngle)

Shapes.Move(Hand[3],Dx+3,Dy+20)

Endsub

Sub map 'map function

'x1-x2-x3 y1-y2-y3

my2=((my3-my1)*(mx2-mx1)/(mx3-mx1))+my1

EndSub