Showing posts with label Basic. Show all posts
Showing posts with label Basic. Show all posts
Monday, August 27, 2012
Petit Computer Journal #4
Petit Computer Journal #4
Knowing that computer is composed of numbers makes it easy to understand. That does not make it easy to do, you see, just to understand. The point is: The computer does what you tell it to do, not what you think you tell the computer to do. Faulty language implementation is an exception to that rule, and even then, you need to figure out a way around the problem.
Computer programming can be fun, but it can be very frustrating, indeed. The question is, what will you do to make computer programming fun? If the answer is to make games, then you're probably off to the wrong start. If the answer is to make games that people want to play, then you're probably off to the right start.
You see, computer programming is all about problem solving. What problem are you trying to solve? Without a clear goal, you probably will just do things randomly. Maybe you discover something, or maybe not. With a clear goal, however, you can work on the steps to achieving that goal. Then, when you finally solve that problem and arrive at your goal, your satisfaction level is quite high. That, my friend, is the fun of computer programming.
It's like winning a game, solving a puzzle, guessing a riddle. Before you did it, you don't know. After you did it, you know. That's fun.
Speaking of goals, you are still a beginner, so let's keep things simple for now. Let's start by figuring out how to tell a computer to do something simple.
Inkey$, input, linput
Let's get the keyboard input out of the way real quick. What is the difference between INKEY$, INPUT, AND LINPUT? Write a small program to check it out!
'Keyboard input source code example
@MAINLOOP
VSYNC 1: A$=INKEY$
IF A$!="" THEN B$=A$
LOCATE 0,0:?"A$=";A$;" "
LOCATE 0,2:?"B$=";B$;" "
GOTO @MAINLOOP
There are 3 things you have to see here:
VSYNC 1: This synchronized the system 1/60 second. Try it with different values and see what happens!
A$=INKEY$: This gets the keyboard value and assign it to A$
IF A$!="" THEN B$=A$: Since the value disappear at the next iteration, and we want to keep the old value, we assign the value of A$ to B$, but only if there is something to copy.
And that's it! If you are writing a computer game that cannot wait for user input, then INKEY$ is the way to go. I understand that it isn't the easiest to use, but it's there if you want it.
What's the difference between INPUT AND LINPUT? Try them out and see!
@MAINLOOP
VSYNC 1: INPUT "X,Y",X,Y
?"X=";X:?"Y=";Y
?:?:'DOUBLE BLANK LINES
VSYNC 1: LINPUT "DATA:";A$
?"A$=";A$
WAIT 300
GOTO @MAINLOOP
INPUT takes several inputs and assign them to different variables. This is very useful for inputting numeric values. Just type them out and separate them with comma. LINPUT takes in a string, commas included. Just one string.
Can you take string and numbers using INPUT? Try it and see!
@MAINLOOP
VSYNC 1: INPUT "X$,Y",X$,Y '<==change here
?"X=";X$:?"Y=";Y '<==Change here
?:?:'DOUBLE BLANK LINES
VSYNC 1: LINPUT "DATA:";A$
?"A$=";A$
WAIT 300
GOTO @MAINLOOP
Yes, you can! If the program doesn't understand your input, it will ask you to re-enter the data "?Redo from start". In which case, you re-enter the data, hopefully without mistake this time!
Touch Screen TCHX,TCHY,TCHST,TCHTIME PNLTYPE
Buttons and keyboard are nice, but we have something there that is just begging to be used: Touchscreen! I know I'm bucking the convention here, since most people are satisfied writing their beginner's program using INPUT or BUTTON(), but I really want to use the touch screen. Fortunately, it's as easy to use as INKEY$.
It's just some variables, and you even use it like you do INKEY$. The difference is that there is more than one, and you use numeric variables. Let's do it. It is helpful if we disable the on-screen keyboard. We do it via PNLTYPE command. Simply set it to "OFF".
'Touchscreen input source code example
PNLTYPE "OFF"
CLS
@MAINLOOP
VSYNC 1
X=TCHX:Y=TCHY:S=TCHST:T=TCHTIME
LOCATE 0,0:?"X=";X;" "
LOCATE 0,2:?"Y=";Y;" "
LOCATE 0,4:?"S=";S;" "
LOCATE 0,6:?"T=";T;" "
GOTO @MAINLOOP
Hit the Select button to stop the program. Yup. Just like INKEY$. The difference is, X and Y values are not reset to zero when the stylus is off the screen even though the status (TCHST) and timer (TCHTIME) are reset.
Math - Arithmetic
Alright, I need you to confess: Who among you have not yet finished 1st Grade? You know, the school grade right after Kindergarten? Whaat? You don't know Arithmetic? Oh, dear. This is bad. I think maybe you need to learn how before we can continue.
Haha, joking aside, you do need to know Arithmetic. Some Trigonometry, too. How about Algebra? Yes, you do need to know how to manipulate variables. Fortunately, if you know Show-and-Tell, you may be alright. Here's a little something that's useful to know: Mapping function.
map() is something that is built-in in Processing computer programming language. It's a good programming language. Check out www.processing.org for details.
In the meantime, let's implement it in BASIC. The idea is, if you have a number that is between two numbers, given another two numbers, what will be the number that has the same ratio as the first? In mathematical format, assuming X is the first number, and Y is the second, we have
X1-X2-X3 X2 is between X1 & X3
Y1-Y2-Y3 Y2 is between Y1 & Y3
Since the ratio is the same, we have
(X2-X1)/(X3-X1)=(Y2-Y1)/(Y3-Y1)
Solve for Y2:
(Y2-Y1)/(Y3-Y1)=(X2-X1)/(X3-X1)
(Y2-Y1)=((X2-X1)/(X3-X1))*/(Y3-Y1)
Y2=(((X2-X1)/(X3-X1))*/(Y3-Y1))+Y1
And that's all there is to it! Work it out on paper if you're having trouble. I find it helpful to draw triangles to visualize the problem.
A Math Explorer sample program
We want to feature a lot of math here, so we're going to just do it all in one program. The program will features different modes, and take inputs from touch screen, normalized to 0-5 for both X and Y. Furthermore, if the stylus is on top-left corner, we'll change the mode.
0: Simple Arithmetic
1: Math functions
2: Logical Math
3: Exponent
Here goes:
Part 1: Touch screen input. No problem there. Just copy it from the sample program above.
'Math Explorer
PNLTYPE "OFF"
CLS
@MAINLOOP
VSYNC 1
X=TCHX:Y=TCHY:S=TCHST:T=TCHTIME
Part 2: Display X,Y, Mode, and Cycle Mode. If you remember our COUNTER program example? Yup, just like that!
IF (X<32 AND Y<24 AND T==1) THEN MODE=MODE+1
MODE=MODE%4:'MODE=0-3
LOCATE 0,0
?"X=";X;" Y=";Y;" MODE=";MODE
Part 3: Normalize X and Y. We already have the mathematical formula for this. Just implement that using GOSUB.
X1=0:X2=X:X3=255:Y1=0:Y3=5:GOSUB @MAP:XP=Y2:'CALCULATES XP=Y2
X1=0:X2=Y:X3=191:Y1=0:Y3=5:GOSUB @MAP:YP=Y2:'CALCULATES YP=Y2
?"XP=";XP;" YP=";YP;" "
GOTO @MAINLOOP
@MAP
Y2=(((X2-X1)/(X3-X1))*(Y3-Y1))+Y1
RETURN
And that's the beginning. We'll continue with Part 4 next, but first, run this program and see that we have normalized XP and YP, and that the MODE cycles 0-3 satisfactorily.
Change the program slightly to this before continuing. Yes, I expect you to be able to read! I know it's hard in the beginning, but please persevere.
'Math Explorer
PNLTYPE "OFF"
CLS
@MAINLOOP
VSYNC 1:IF MODE!=2 THEN CLS
X=TCHX:Y=TCHY:S=TCHST:T=TCHTIME
IF (X<32 AND Y<24 AND T==1) THEN MODE=MODE+1
MODE=MODE%4:'MODE=0-3
LOCATE 0,0
?"X=";X;" Y=";Y;" MODE=";MODE;" "
X1=0:X2=X:X3=255:Y1=0:Y3=5:GOSUB @MAP:XP=Y2:'CALCULATES XP=Y2
X1=0:X2=Y:X3=191:Y1=0:Y3=5:GOSUB @MAP:YP=Y2:'CALCULATES YP=Y2
?"XP=";XP;" YP=";YP;" "
GOTO @MAINLOOP
@MAP
Y2=(((X2-X1)/(X3-X1))*(Y3-Y1))+Y1
RETURN
And that's the program. Now, here is some snippets of code. I trust that you know where to put this.
?:?
ON MODE GOTO @ARIT, @FUNC,@LOGI, @EXPO
GOTO @MAINLOOP:'INVALID CHOICE
@ARIT
?"X+Y=";(X+Y)
?"X-Y=";(X-Y)
?"X*Y=";(X*Y)
IF Y!=0 THEN ?"X/Y=";(X/Y)
IF Y!=0 THEN ?"X%Y=";(X%Y)
IF YP!=0 THEN ?"X%YP=";(X%YP)
GOTO @ENDLOOP
@FUNC
?"FLOOR(XP)=";FLOOR(XP)
?"RND(X)=";RND(X)
?"RND(XP)+20=";RND(XP)+20
?"ABS(X-128)=";ABS(X-128)
?"SGN(X-128)=";SGN(X-128)
?"SWAP ":SWAP XP,YP
?"XP=";XP;" YP=";YP
IF S==1 THEN WAIT 30
GOTO @ENDLOOP
@LOGI
LOCATE 0,4
?"X= ";:V=X:GOSUB @BIN
?"Y= ";:V=Y:GOSUB @BIN
?"AND ";:V=(X AND Y):GOSUB @BIN
?"OR ";:V=(X OR Y):GOSUB @BIN
?"XOR ";:V=(X XOR Y):GOSUB @BIN
?
?"X= ";:V=X:GOSUB @BIN
?"NOT ";:v=NOT(X):GOSUB @BIN
?"! ";:v=!X:GOSUB @BIN
GOTO @ENDLOOP
@EXPO
?"SQR(X)=";SQR(X)
?"EXP(XP)=";EXP(XP)
IF X!=0 THEN ?"LOG(X)=";LOG(X)
?"POW(2,XP)=";POW(2,XP)
?"POW(3,XP)=";POW(3,XP)
@ENDLOOP
GOTO @MAINLOOP
'SPLIT THIS TO THE END
@BIN
FOR I=0 TO 7
P=POW(2,I)
IF (P AND V) THEN ?"1"; ELSE ?"0";
NEXT
RETURN
One more round of Math and we'll be done! It's all about Trigonometry. We'll save it for later until after we learn Graphics!
Tuesday, August 14, 2012
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
Tuesday, August 7, 2012
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
'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
Tuesday, July 31, 2012
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
Tuesday, July 10, 2012
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 (adjloc
WT="1=red;2=black;"
WriteText()
counteradj=counteradj+1
ElseIf (advloc
WT="1=yellow;2=black;"
WriteText()
counteradv=counteradv+1
ElseIf (unkloc
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
Tuesday, June 26, 2012
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
Tuesday, June 19, 2012
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
Tuesday, June 12, 2012
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()
Tuesday, June 5, 2012
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
Tuesday, May 29, 2012
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
'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
Labels:
accessing,
array,
Basic,
clairvoyant,
fortune,
magic 8 ball,
Small,
teller,
telling
Tuesday, May 22, 2012
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
Tuesday, May 15, 2012
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
Subscribe to:
Posts (Atom)