! RFO Power Shell v1.0
! by [Antonis]
! April.10.2012
dim line$[5],os[5],sns[15],gp[10],tx[13],cr[10]
dim si[10],bh[8],sd[22],intr[9],bmp[6],drawbmp[6]
dim titl$[6],icon$[6],command[6],pth$[6]
! Returns the time in seconds resolved to the hour
! If run on the cusp of the hour, will produce bad data
fn.def xtime()
time Y$, M$, D$, H$, M$, S$
fn.rtn val(H$) * 3600 + val(M$)*60 + val(S$)
fn.end
gr.open 255,0,45,0
gr.color 255,255,255,255,0
gr.orientation 1
pause 1000
gr.screen w,h
sx=w/800
sy=h/1232
gr.scale sx,sy
gr.text.size 30
gr.color 255,0,0,255,1
err$="bitmap loading"
gr.bitmap.load bptr1,"bar.png" % android bar
gr.bitmap.draw bar,bptr1, -2,1080
gr.bitmap.load bptr2,"menu.png" % device utils, games, rfo-basic,
gr.bitmap.load bptr4,"submenu.png" % record calls,sysinfo,contacts, sd
gr.bitmap.load bptr5,"gsubmenu.png" % craps, scissors
gr.bitmap.load bptr7,"program.png"
gr.bitmap.load bptr8,"button.png"
gr.bitmap.load bptr9,"rec.png"
gr.bitmap.load bptr10,"rps.png"
gr.bitmap.load bptr11,"arrowr.png"
gr.bitmap.load bptr12,"welcome.png"
gr.bitmap.draw welcome,bptr12,25,870
! load ini file
err$="rfo ini file"
text.open r,filn,"rfo_ini.txt"
text.readln filn,line$ % 1st line not important
for i=1 to 6
text.readln filn,line$ % 1st line not important
text.readln filn,line$ % title
a=Is_In("=",line$)
titl$[i]=mid$(line$,a+2,len(line$)-a-2)
text.readln filn,line$ % icon name+path!
a=Is_In("=",line$)
icon$[i]=mid$(line$,a+2,len(line$)-a-2)
text.readln filn,line$ % command type
a=Is_In("=",line$)
a$=mid$(line$,a+2,len(line$)-a-2)
if a$="Internet" then command[i]=1 else command[i]=2
text.readln filn,line$ % command type
a=Is_In("=",line$)
pth$[i]=mid$(line$,a+2,len(line$)-a-2)
next i
text.close filn
! first load bitmap icons
err$="icon loading"
for i=1 to 6
gr.bitmap.load bmp[i],icon$[i]
next i
! Draw bitmaps
gr.text.align 2
for i=1 to 3
gr.bitmap.draw newbmp,bmp[i],70+(i-1)*250,80
gr.text.draw tex,70+(i-1)*250+80,80+160+30-5, titl$[i]
next i
for i=4 to 6
gr.bitmap.draw newbmp,bmp[i],70+(i-4)*250,280
gr.text.draw tex,70+(i-4)*250+80,280+160+30-5, titl$[i]
next i
gr.text.align 1
TIME Year$, Month$, Day$, Hour$, Minute$, Second$
gr.text.draw taim, 680,1140,Hour$+":"+Minute$
gr.text.draw deit, 630,1180,Month$+"/"+Day$+"/"+Year$
gr.text.draw mylogo,200,1220,"Power Shell, v1.0 by [Antonis]"
gr.render
menuon=0
submenuon=0
submenuon2=0
submenuon3=0
progmenu=0
g=clock()
firsttime=1 % menu "util, games, basic"
firstsub=1 % submenu "record calls,sysinfo,contacts, sd"
firstsub2=1 % submenu2 "craps, scissors"
firstsub3=1 % submenu3 "basic hints"
firstprog=1 % general program
ftouched=0
firstbutton=0 % button bitmap
firstrec=0 % record bitmap
firstgames=0 %
firstarrow=1
do % loop
! wait for android press
do
flag=0
flags=0
pause 20
gr.touch touched,x,y
gosub mytime
until touched
do
gr.touch touched,x,y
ftouched=1
until !touched
gosub mytime
if ftouched>0 % something pressed
gr.hide welcome
! if icon selected, execute command
! icon 1
if x>70*sx & x<230*sx & y>80*sy & y<240*sy then
if command[1]=1 then browse pth$[1]
if command[1]=2 then
ff$=pth$[1]
gosub runprg
endif
endif
! icon 2
if x>320*sx & x<480*sx & y>80*sy & y<240*sy then
if command[2]=1 then browse pth$[2]
if command[2]=2 then
ff$=pth$[2]
gosub runprg
endif
endif
! icon 3
if x>570*sx & x<730*sx & y>80*sy & y<240*sy then
if command[3]=1 then browse pth$[3]
if command[3]=2 then
ff$=pth$[3]
gosub runprg
endif
endif
! icon 4
if x>70*sx & x<230*sx & y>280*sy & y<440*sy then
if command[4]=1 then browse pth$[4]
if command[4]=2 then
ff$=pth$[4]
gosub runprg
endif
endif
! icon 5
if x>320*sx & x<480*sx & y>280*sy & y<440*sy then
if command[5]=1 then browse pth$[5]
if command[5]=2 then
ff$=pth$[5]
gosub runprg
endif
endif
! icon 6
if x>570*sx & x<730*sx & y>280*sy & y<440*sy then
if command[6]=1 then browse pth$[6]
if command[6]=2 then
ff$=pth$[6]
gosub runprg
endif
endif
! if android touched, show menu "util, games, basic" if not visible
if x<150*sx & y>1080*sy & menuon=0 then
menuon=1
if firsttime=1 then
gr.bitmap.draw menu,bptr2, 0,780
gr.render
firsttime=0
else
gr.show menu
gr.render
endif
flag=1
endif
! if android touched, hide menu "util, games, basic" if visible
if x<150*sx & y>1080*sy & menuon=1 & flag=0 then
menuon=0
gr.hide menu
gr.hide arrow
if submenuon=1 then
gr.hide submenu
submenuon=0
endif
if submenuon2=1 then
gr.hide submenu2
submenuon2=0
endif
if submenuon3=1 then
gr.hide submenu3
submenuon3=0
endif
if progmenu=1 then
gr.hide prog
progmenu=0
endif
gr.render
endif
! show submenu = record,sysinfo,agenda,sdcard
if x<300*sx & y<=1080*sy & y>980*sy & menuon=1 then % & submenuon=0
gr.hide submenu2
gr.hide submenu3
gr.hide arrow
if firstsub=1 then
gr.bitmap.draw submenu,bptr4, 305,680
gr.render
firstsub=0
else
gr.show submenu
gr.render
endif
submenuon=1
if firstarrow=1 then
gr.bitmap.draw arrow,bptr11, 255,980
gr.render
firstarrow=0
else
gr.show arrow
gr.modify arrow,"x",255
gr.modify arrow,"y",980
gr.render
endif
endif
! show submenu2 = craps, scissors
if x<300*sx & y>880*sy & y<=980*sy & menuon=1 then % & submenuon2=0
gr.hide submenu
gr.hide submenu3
if firstsub2=1 then
gr.bitmap.draw submenu2,bptr5, 305,780
gr.render
firstsub2=0
else
gr.show submenu2
gr.render
endif
submenuon2=1
if firstarrow=1 then
gr.bitmap.draw arrow,bptr11,255,890
gr.render
firstarrow=0
else
gr.show arrow
gr.modify arrow,"x",255
gr.modify arrow,"y",890
gr.render
endif
submenuon2=1
endif
! game craps
if x>305*sx & x<605*sx & y>780*sy & y<=880*sy & menuon=1 & submenuon2=1 then
gr.hide menu
gr.hide submenu
gr.hide submenu2
gr.hide submenu3
gr.hide arrow
if firstprog=1 then
gr.bitmap.draw prog,bptr7, 50,50
gr.render
firstprog=0
else
gr.show prog
gr.render
endif
progmenu=1
gosub mytime
menuon=0
submenuon=0
submenuon3=0
gosub mytime
gosub crapsgame
gosub mytime
submenuon2=0
endif
! game scissors
if x>305*sx & x<605*sx & y>880*sy & y<=980*sy & menuon=1 & submenuon2=1 then
gr.hide menu
gr.hide submenu
gr.hide submenu2
gr.hide submenu3
gr.hide arrow
if firstprog=1 then
gr.bitmap.draw prog,bptr7, 50,50
gr.render
firstprog=0
else
gr.show prog
gr.render
endif
progmenu=1
gosub mytime
menuon=0
submenuon=0
submenuon3=0
gosub mytime
gosub scissorsgame
gosub mytime
submenuon2=0
endif
! basic hints
if x<300*sx & y>=780*sy & y<880*sy & menuon=1 & submenuon3=0 then
gr.hide menu
gr.hide submenu
gr.hide submenu2
gr.hide arrow
if firstprog=1 then
gr.bitmap.draw prog,bptr7, 50,50
gr.render
firstprog=0
else
gr.show prog
gr.render
endif
submenuon3=1
gosub mytime
gosub basichints
menuon=0
submenuon=0
submenuon2=0
submenuon3=0
progmenu=0
gosub mytime
endif
! sdcard analyzer
if x>305*sx & x<605*sx & y>=680*sy & y<790*sy & menuon=1 & submenuon=1 then
gr.hide menu
gr.hide submenu
gr.hide submenu2
gr.hide submenu3
gr.hide arrow
if firstprog=1 then
gr.bitmap.draw prog,bptr7, 50,50
gr.render
firstprog=0
else
gr.show prog
gr.render
endif
progmenu=1
gosub mytime
menuon=0
submenuon=0
submenuon2=0
gosub sdanalyzer
submenuon3=0
endif
! system tests
if x>305*sx & x<605*sx & y>=790*sy & y<890*sy & menuon=1 & submenuon=1 then
gr.hide menu
gr.hide submenu
gr.hide submenu2
gr.hide submenu3
gr.hide arrow
if firstprog=1 then
gr.bitmap.draw prog,bptr7, 50,50
gr.render
firstprog=0
else
gr.show prog
gr.render
endif
progmenu=1
gosub mytime
menuon=0
submenuon=0
submenuon2=0
gosub systests
submenuon3=0
endif
! submenu sysinfo
if x>305*sx & x<605*sx & y>=890*sy & y<970*sy & menuon=1 & submenuon=1 then
gr.hide menu
gr.hide submenu
gr.hide submenu2
gr.hide submenu3
gr.hide arrow
if firstprog=1 then
gr.bitmap.draw prog,bptr7, 50,50
gr.render
firstprog=0
else
gr.show prog
gr.render
endif
progmenu=1
gosub mytime
menuon=0
submenuon=0
submenuon2=0
gosub sysinfo
submenuon3=0
endif
! submenu record calls
if x>305*sx & x<605*sx & y>=970*sy & y<1080*sy & menuon=1 & submenuon=1 then
gr.hide menu
gr.hide submenu
gr.hide submenu2
gr.hide submenu3
gr.hide arrow
if firstprog=1 then
gr.bitmap.draw prog,bptr7, 50,50
gr.render
firstprog=0
else
gr.show prog
gr.render
endif
progmenu=1
gosub mytime
menuon=0
submenuon=0
submenuon2=0
gosub recordcalls
submenuon3=0
endif
endif
until 0
! ******* subroutines *******
! sd card analyzer
sdanalyzer:
err$="sd card access"
gr.color 255,255,55,0,1
gr.text.size 50
gr.text.bold 1
gr.text.draw title8,130,105,"SD CARD ANALYZER"
gr.text.size 30
gr.bitmap.draw nxtpage1,bptr8, 150,750
gr.text.draw sd1, 200,795," START"
gr.bitmap.draw xbutton1,bptr8, 450,750
gr.text.draw sd2, 500,795,"EXIT PROG"
gr.text.size 30
gr.text.draw sd[3],100,180,"Press Start when ready: "
gr.render
fshowed=0
reanalyze:
do
gr.touch touched,x,y
gosub mytime
until touched & ((x>150*sx & x<400*sx & y>750*sy & y<820*sy) | (x>450*sx & x<700*sx & y>750*sy & y<820*sy))
if x>150*sx & x<400*sx & y>750*sy & y<820*sy & fshowed=0 then
! start pressed
popup " Please wait..",0,0,0
gosub fileanalyzer
fshowed=1
gr.hide sd1
gr.text.draw sd1, 195,795,"SHOW FILES"
GR.render
gosub mytime
x=-1
y=-1
endif
if x>150*sx & x<400*sx & y>750*sy & y<820*sy & fshowed=1 then
! show files pressed
gr.hide sd1
! gr.hide sd2
gr.modify sd2,"text"," GO BACK"
gr.hide nxtpage1
! gr.hide xbutton1
gosub fileanalyzer
fshowed=0
gosub mytime
endif
if x>450*sx & x<700*sx & y>750*sy & y<820*sy then
! exit pressed
for i=1 to 20
gr.hide sd[i]
next i
gr.hide sd1
gr.hide sd2
gr.hide nxtpage1
gr.hide xbutton1
gr.hide prog
gr.hide title8
gr.render
gosub mytime
return
endif
goto reanalyze
return
fileanalyzer:
path$="../../"
array.delete list$[]
Stack.create S, stk
file.dir path$, list$[]
Array.reverse list$[]
Array.length l, list$[]
for i=1 to 20
gr.hide sd[i]
next i
j=0
flag=1
for i=1 to l
nn= Is_In("(d)",list$[i])
if nn>0 then
ndirs=ndirs+1
s$=path$+replace$(list$[i],"(d)","/")
stack.push stk,s$
endif
next i
ndirs=0
nfiles=0
bytes=0
n=0
j=0
do
stack.isempty stk,n
if n<>1 then
if fshowed=1 then
j=j+1
k=mod(j,20)+1
if k=1 then
gr.render
popup "touch screen to continue..",0,0,0
do
gr.touch touched,x,y
gosub mytime
until touched
if x>450*sx & x<700*sx & y>750*sy & y<820*sy then d_u.break
endif
gr.text.size 30
gr.hide sd[k]
gr.text.draw sd[k],100,150+k*30,"-------------------------------------------"
endif
Stack.pop stk, s$
ndirs=ndirs+1
if fshowed=1 then
s2$= replace$(s$,"../../","")
j=j+1
k=mod(j,20)+1
if k=1 then
gr.render
popup "touch screen to continue..",0,0,0
do
gr.touch touched,x,y
gosub mytime
until touched
if x>450*sx & x<700*sx & y>750*sy & y<820*sy then d_u.break
endif
gr.text.size 30
gr.hide sd[k]
gr.text.draw sd[k],100,150+k*30,left$(s2$,40)
endif
path$=s$
array.delete list$[]
file.dir s$, list$[]
Array.length l, list$[]
for i=1 to l
nn=Is_In("(d)",list$[i])
if nn>0 then
s$=path$+replace$(list$[i],"(d)","/")
stack.push stk,s$
endif
w$=path$+list$[i]
if nn=0 & list$[i]<>"" & list$[i]<>" " then
File.Size sn, Path$+list$[i]
bytes=bytes+sn
if fshowed=1 then
s3$=list$[i]+" "+str$(sn)+" bytes"
s3$=replace$(s3$,".0","")
j=j+1
k=mod(j,20)+1
if k=1 then
gr.render
popup "touch screen to continue..",0,0,0
do
gr.touch touched,x,y
gosub mytime
until touched
if x>450*sx & x<700*sx & y>750*sy & y<820*sy then d_u.break
endif
gr.text.size 25
gr.hide sd[k]
gr.text.draw sd[k],100,150+k*30,s3$
endif
nfiles=nfiles+1
endif
next i
endif
until n=1
popup "finished listing",0,0,0
x=-1
y=-1
gr.modify sd2,"text","EXIT PROG"
gr.render
if fshowed=0 then
gr.text.draw sd[4],100,240,"Dirs total= "+replace$(str$(ndirs),".0","")
gr.text.draw sd[5],100,270,"Files total= "+replace$(str$(nfiles),".0","")
gr.text.draw sd[6],100,300,"kb used= "+replace$(str$(round(bytes/1024)),".0","")
gr.text.draw sd[7],100,330,"(Mb= "+str$(round(100*bytes/(1024*1024))/100)+")"
gr.text.draw sd[9],100,360,"(Gb= "+str$(round(1000*bytes/(1024*1024*1024))/1000)+")"
gr.render
endif
stack.clear stk
if fshowed=1 then
for i=1 to 20
gr.hide sd[i]
next i
gr.show sd1
gr.show sd2
gr.show nxtpage1
gr.show xbutton1
gr.text.draw sd[3],100,180,"Press Start when ready: "
gr.modify sd1,"text"," START"
gr.render
x=-1
y=-1
endif
return
! basic hints
basichints:
gr.color 255,255,55,0,1
gr.text.size 50
gr.text.bold 1
gr.text.draw title7,150,105,"RFO BASIC! HINTS"
gr.text.size 30
gr.bitmap.draw nxtpage,bptr8, 150,750
gr.text.draw bh[1], 200,795,"Next Page"
gr.bitmap.draw xbutton,bptr8, 450,750
gr.text.draw bh[2], 500,795,"EXIT PROG"
popup "Please wait...",0,0,0
gr.text.size 30
gr.render
gosub mytime
err$="internet, in Basic Hints"
GrabURL s$,"http://laughton.com/basic/versions/index.html"
gosub mytime
array.delete vtext$[]
Split vtext$[], s$, chr$(10)
array.length l, vtext$[]
s$=mid$(vtext$[15],16,6)
! for i=1 to l
! print vtext$[i]
! next i
gr.text.draw bh[3],100,180,"Latest Rfo! Basic Version: "+s$
gr.render
GrabURL ss$,"http://laughton.com/basic/versions/"+s$+"/index.html"
gosub mytime
array.delete itext$[]
Split itext$[], ss$, chr$(10)
array.length ll, itext$[]
ss$=mid$(itext$[15],50,10)
gr.text.draw bh[4],100,240,"Release Date: >"+ss$+"<"
GrabURL ss$,"http://rfobasic.freeforums.org/"
! users, registered, newest member
gr.text.size 25
a1=Is_In("users online ::", ss$)
if a1=0 then a1= Is_In("user online ::", ss$)
a2=Is_In("(based on users active",ss$)
s$=mid$(ss$,a1,a2-a1)
s$=replace$(s$,"","")
gr.text.draw bh[5],100,300,s$
a1=Is_In("Total posts " , ss$)
a2=Is_In(" | Total topics" , ss$)
a3=Is_In(" | Total members", ss$)
s1$=mid$(ss$,a1+19,a2-a1-18)
s2$=mid$(ss$,a2+32,a3-a2-31)
gr.text.draw bh[6],100,360,"Total posts: "+s1$+" -"+" Total topics: "+s2$
a1=Is_In("Our newest member" , ss$)+109
a2=Is_In("" , ss$)
s$=mid$(ss$,a1,a2-a1)
gr.text.draw bh[7],100,420,"Our newest member: "+s$
a1=Is_In("Total members" , ss$)
a2=Is_In("| Our newest member" , ss$)
s$=mid$(ss$,a1,a2-a1)
s$=replace$(s$,"","")
s$=replace$(s$,"","")
gr.text.draw bh[8],100,480,s$
gr.text.size 30
gr.render
gosub mytime
do
gr.touch touched,x,y
gosub mytime
until touched & ((x>150*sx & x<400*sx & y>750*sy & y<820*sy) | (x>450*sx & x<700*sx & y>750*sy & y<820*sy))
if x>450*sx & x<700*sx & y>750*sy & y<820*sy then
for i=1 to 8
gr.hide bh[i]
next i
gr.hide nxtpage
gr.hide xbutton
gr.hide prog
gr.hide title7
gr.render
endif
! next button=ftp dir
if x>150*sx & x<400*sx & y>750*sy & y<820*sy then
popup "Please wait..",0,0,0
for i=1 to 8
if i<>2 then gr.hide bh[i]
next i
gr.text.draw bh[3], 100,150, "RFO BASIC! FTP DIRECTORY LISTING"
gr.hide nxtpage
gr.color 255,0,0,255,1
err$="ftp, in Basic Hints"
ftp.open "ftp.laughton.com", 21, "basic", "basic"
ftp.dir file_list
ftp.close
gosub mytime
list.size file_list,size
undim ftplst[]
dim ftplst[size]
j=0
flag=1
for i = 1 to size
j=j+1
list.get file_list,i,name$
! print name$
a=is_in("(d)",name$)
if a>0 then
b$=" "+replace$(name$,"(d)","")
else
b$=name$
endif
if i>20 & flag=1 then
gr.hide bh[3]
gr.hide bh[4]
flag=0
endif
for n=1 to 50 % x20 names in ftp dir
if i=n*20 then
popup "touch screen to continue..",0,0,0
do
gr.touch touched,x,y
gosub mytime
until touched
if x>450*sx & x<700*sx & y>750*sy & y<820*sy then goto quitlisting
endif
next n
gosub mytime
if i>=20 then
j=mod(i,20)+1
gr.hide ftplst[j]
endif
gosub mytime
gr.text.draw ftplst[j], 100, 150+j*30,b$
gr.render
next i
for i=j to 20
gr.hide ftplst[i]
next i
gr.render
gosub mytime
! exit button
do
gr.touch touched,x,y
gosub mytime
until touched &(x>450*sx & x<700*sx & y>750*sy & y<820*sy)
quitlisting:
for i=1 to j
gr.hide ftplst[i]
next i
gr.hide xbutton
gr.hide title7
gr.hide prog
gr.hide bh[2]
gr.hide bh[3]
gr.render
return
endif
return % basic hints
! ****scissors game***
scissorsgame:
scorehuman=0
scoreandroid=0
gr.color 255,255,55,0,1
gr.text.size 50
gr.text.bold 1
gr.text.draw title6,130,105,"ROCK, PAPER, SCISSORS"
gr.text.size 30
gr.text.draw si[1],100,180,"To Play : Tap an icon"
gr.text.draw si[2],100,210,"To Quit: Press Exit"
gr.text.draw si[3],100,240,"Rock defeats scissors, Paper defeats rock"
gr.text.draw si[4],100,270,"Scissors defeats paper."
gr.bitmap.draw rps,bptr10, 150,450
gr.bitmap.draw extscissors,bptr8, 150,750
gr.text.draw si[5], 200,795,"EXIT PROG"
gr.text.draw si[6], 200,350,"HUMAN: 0"
gr.text.draw si[7], 200,400,"ANDROID: 0"
gr.text.draw si[8], 200,700,"Android choosed:"
gr.render
retouch1:
do
gr.touch touched,x,y
gosub mytime
until touched & ((x>150*sx & x<450*sx & y>450*sy & y<550*sy) | (x>150*sx & x<400*sx & y>750*sy & y<820*sy))
! exit button
if x>150*sx & x<400*sx & y>750*sy & y<820*sy then
for i=1 to 8
gr.hide si[i]
next i
gr.hide extscissors
gr.hide rps
gr.hide title6
gr.hide prog
gr.render
return
endif
! bitmap button, human
if x>150*sx & x<450*sx & y>450*sy & y<550*sy) then
if x>150*sx & x<250*sx then human=1
if x>250*sx & x<350*sx then human=2
if x>350*sx & x<450*sx then human=3
endif
pause 1000
gosub mytime
android=CEIL(rnd(t)*3))
if android=1 then
droidchoosed$="Rock"
elseif android=2 then
droidchoosed$="Paper"
else
droidchoosed$="Scissors"
endif
gr.modify si[8],"text","Android choosed:"+droidchoosed$
popup "Your turn",-100,-40,0
tone 800,300
if human=1 & android=3 | human=2 & android=1 | human=3 & android=2 then scorehuman=scorehuman+1
if human=1 & android=2 | human=2 & android=3 | human=3 & android=1 then scoreandroid=scoreandroid+1
f1$ = replace$(STR$(scorehuman), ".0", "")
f2$ = replace$(STR$(scoreandroid), ".0", "")
gr.modify si[6],"text","HUMAN: "+f1$
gr.modify si[7],"text","ANDROID: "+f2$
gr.render
goto retouch1
return
! ****craps game***
crapsgame:
sum1=0
sum2=0
scorehuman=0
scoreandroid=0
gr.color 255,255,55,0,1
gr.text.size 50
gr.text.bold 1
gr.text.draw title5,200,105,"SIMPLIFIED CRAPS"
gr.text.size 30
gr.text.draw cr[1],100,180,"To Play hit: Roll Dices"
gr.text.draw cr[2],100,210,"To Quit: Press Exit"
gr.text.draw cr[3],100,240,"If sum is 2, 3, 4, 10, 11 or 12, you win"
gr.text.draw cr[4],100,270,"If sum is 5, 6, 7, 8 or 9, you lose"
gr.bitmap.draw rolldice,bptr8, 150,650
gr.color 255,255,55,0,0
gr.set.stroke 4
gr.rect rct1,165,550,225,620
gr.rect rct2,265,550,325,620
gr.set.stroke 0
! GR.text.DRAW obj2, 280, 600,
gr.color 255,255,55,0,1
gr.text.draw cr[5], 200,695,"ROLL DICES"
gr.bitmap.draw crapbutton,bptr8, 150,750
gr.text.draw cr[6], 200,795,"EXIT PROG"
gr.text.draw cr[7], 200,350,"HUMAN: 0"
gr.text.draw cr[8], 200,400,"ANDROID: 0"
gr.text.draw turn,150,500, "Android's turn..."
gr.hide turn
gr.render
gr.text.size 50
reroll:
do
gr.touch touched,x,y
gosub mytime
until touched % x>150*sx & x<400*sx & y>750*sy & y<820*sy
if x>150*sx & x<400*sx & y>650*sy & y<720*sy then
! human plays
gr.color 255,0,0,255,1
gosub rolldice
sum1=dice1+dice2
if sum1=2 | sum1=3 | sum1=4 | sum1=10 | sum1=11 | sum1=12 then
! player wins
scorehuman=scorehuman+1
gosub showscore
else
! player loses
scoreandroid=scoreandroid+1
gosub showscore
endif
pause 1500
! android plays
gr.color 255,255,0,0,1
gr.show turn
gosub rolldice
gr.hide turn
sum2=dice1+dice2
if sum2=2 | sum2=3 | sum2=4 | sum2=10 | sum2=11 | sum2=12 then
! android wins
scoreandroid=scoreandroid+1
gosub showscore
else
! android loses
scorehuman=scorehuman+1
gosub showscore
endif
pause 500
endif
if x>150*sx & x<400*sx & y>750*sy & y<820*sy then
for i=1 to 8
gr.hide cr[i]
next i
gr.hide obj1
gr.hide obj2
gr.hide obj3
gr.hide obj4
gr.hide rct1
gr.hide rct2
gr.hide rolldice
gr.hide crapbutton
gr.hide title5
gr.hide prog
gr.render
return
endif
goto reroll
showscore:
dd1$ = replace$(STR$(scorehuman), ".0", "")
dd2$ = replace$(STR$(scoreandroid), ".0", "")
gr.modify cr[7],"text","HUMAN: "+dd1$
gr.modify cr[8],"text","ANDROID: "+dd2$
gr.render
return
rolldice:
dice1=CEIL(rnd(t)*6))
dice2=CEIL(rnd(y)*6))
FOR i = 1 TO 10
GR.HIDE obj1
GR.HIDE obj2
GR.HIDE obj3
GR.HIDE obj4
fakedice1=CEIL(rnd(z)*6))
fakedice2=CEIL(rnd(x)*6))
f1$ = replace$(STR$(fakedice1), ".0", "")
f2$ = replace$(STR$(fakedice2), ".0", "")
GR.color 255, 0, 0, 255, 1
GR.text.DRAW obj1, 180, 600, f1$
GR.text.DRAW obj2, 280, 600, f2$
GR.RENDER
TONE 800,200
PAUSE 100
GR.HIDE obj1
GR.HIDE obj2
NEXT i
d1$ = replace$(STR$(dice1), ".0", "")
d2$ = replace$(STR$(dice2), ".0", "")
GR.color 255, 255, 0, 0, 1
GR.HIDE obj3
GR.HIDE obj4
GR.text.DRAW obj3, 180, 600, d1$
GR.text.DRAW obj4, 280, 600, d2$
GR.RENDER
diceok=1
PAUSE 600
RETURN
! RECORD CALLS SUBROUTINE
recordcalls:
err$="record calls"
gosub mytime
gr.color 255,255,55,0,1
gr.text.size 50
gr.text.bold 1
gr.text.draw title3,140,105,"RECORD CALLS UTILITY"
gr.render
gr.text.size 30
gr.text.draw tx[1],70,180,"There are different types of recording:"
gr.text.draw tx[2],70,210,"type #0 for microphone input,#1 for Voip calls,"
gr.text.draw tx[3],70,240,"2,3,4 (may fail) for different types of recording."
gr.text.draw tx[4],70,270,"Turning the speaker on during record, is better."
gr.text.draw tx[5],70,300,"To stop recording, press button or exit program"
if firsbutton=0 then
gr.bitmap.draw butt1,bptr8, 150,350
gr.text.draw tx[6], 180,395,"Enable type #0"
gr.bitmap.draw butt2,bptr8, 150,450
gr.text.draw tx[7], 180,495,"Enable type #1"
gr.bitmap.draw butt3,bptr8, 150,550
gr.text.draw tx[8], 180,595,"Enable type #2"
gr.bitmap.draw butt4,bptr8, 150,650
gr.text.draw tx[9], 180,695,"Enable type #3"
gr.bitmap.draw butt5,bptr8, 150,750
gr.text.draw tx[10], 180,795,"Enable type #4"
gr.bitmap.draw butt6,bptr8, 450,650
gr.text.draw tx[13], 505,695,"EXIT PROG"
gr.bitmap.draw butt7,bptr8, 450,750
gr.text.draw tx[11], 515,795,"Disable rec."
gr.text.size 50
gr.text.draw tx[12], 480,800,"X"
gr.text.size 30
gr.render
firstbutton=1
else
gr.show butt1
gr.show butt2
gr.show butt3
gr.show butt4
gr.show butt5
gr.show butt6
gr.show butt7
for i=1 to 13
gr.show tx[i]
next i
endif
gr.render
retry:
do
gr.touch touched,x,y
gosub mytime
until touched
! button is 70x250
if x>150*sx & x<400*sx & y>350*sy & y<420*sy then
! type 0 command
if firstrec=0 then
gr.bitmap.draw rec,bptr9, 580,1105
gr.render
firstrec=1
else
gr.show rec
gr.render
endif
audio.record.start "call_"+ Month$+Day$+Hour$+Minute$+Second$+".3gp",0
endif
if x>150*sx & x<400*sx & y>450*sy & y<520*sy then
! type 1 command
if firstrec=0 then
gr.bitmap.draw rec,bptr9, 580,1105
gr.render
firstrec=1
else
gr.show rec
gr.render
endif
audio.record.start "call_"+ Month$+Day$+Hour$+Minute$+Second$+".3gp",1
endif
if x>150*sx & x<400*sx & y>550*sy & y<620*sy then
! type 2 command
if firstrec=0 then
gr.bitmap.draw rec,bptr9, 580,1105
gr.render
firstrec=1
else
gr.show rec
gr.render
endif
audio.record.start "call_"+ Month$+Day$+Hour$+Minute$+Second$+".3gp",2
endif
if x>150*sx & x<400*sx & y>650*sy & y<720*sy then
! type 3 command
if firstrec=0 then
gr.bitmap.draw rec,bptr9, 580,1105
gr.render
firstrec=1
else
gr.show rec
gr.render
endif
audio.record.start "call_"+ Month$+Day$+Hour$+Minute$+Second$+".3gp",3
endif
if x>150*sx & x<400*sx & y>750*sy & y<820*sy then
! type 4 command
if firstrec=0 then
gr.bitmap.draw rec,bptr9, 580,1105
gr.render
firstrec=1
else
gr.show rec
gr.render
endif
audio.record.start "call_"+ Month$+Day$+Hour$+Minute$+Second$+".3gp",4
endif
if x>450*sx & x<700*sx & y>750*sy & y<820*sy then
! stop command
audio.record.stop
gr.hide rec
gr.render
endif
if x>450*sx & x<700*sx & y>650*sy & y<720*sy then
! exit routine
gr.hide title3
gr.hide butt1
gr.hide butt2
gr.hide butt3
gr.hide butt4
gr.hide butt5
gr.hide butt6
gr.hide butt7
for i=1 to 13
gr.hide tx[i]
next i
gr.hide prog
goto extreccalls
end if
gosub mytime
goto retry
extreccalls:
gr.render
return
sysinfo:
! DEVICE INFO SUBROUTINE
gr.color 255,255,55,0,1
gr.text.size 50
gr.text.bold 1
gr.text.draw title,200,105,"DEVICE INFO"
gr.render
gr.text.size 30
! first type and os
err$="device"
device d$
a$=""
j=0
for i=1 to len(d$)
b$=mid$(d$,i,1)
a$=a$+b$
if b$=chr$(10) then
c=i
j=j+1
line$[j]=a$
a$=""
gr.text.draw os[j],100,120+30*j,line$[j]
endif
next i
gr.text.draw os[5],100,270,right$(d$,len(d$)-c)
! lan & wan ip
err$="socket-internet"
socket.myip lanip$
err$="internet connection"
graburl wanip$, "http://whatismyip.net/"
where1=is_in("color=\"#FF0000\">",wanip$)+24
where2=is_in("",wanip$)
wanip$=mid$(wanip$,where1,where2-where1)
gr.text.draw lip,100,300,"Lan IP: "+lanip$
gr.text.draw wip,100,330,"WAN IP: "+wanip$
! Path to root
err$="path to root"
file.root fr$
gr.text.draw fr,100,360,"Path to root: "+fr$
gosub mytime
! screen resolution
gr.text.draw scr,100,390,"Resolution: "+str$(w)+"x"+str$(h)
gr.render
! sensors
err$="sensors"
array.delete list$[]
sensors.list list$[]
array.length size, list$[]
for i=1 to size
gr.text.draw sns[i],100,450+i*30,"Sensor: "+list$[i]
next i
gr.render
gosub mytime
gr.text.draw cgm1,100,780," GPS info following.."
gr.bitmap.draw baton1, bptr8,100,780
gr.bitmap.draw baton2, bptr8,350,780
gr.text.draw cgm2,150,830,"[GO ON] [EXIT]"
gr.color 255,255,0,0,0
gr.render
do
gr.touch touched,x,y
gosub mytime
until touched & x>100*sx & x<500*sx & y>780*sy & y<850*sy
! next page or exit
gr.hide program
gr.hide title
for i=1 to 5
gr.hide os[i]
next i
gr.hide lip
gr.hide wip
gr.hide fr
gr.hide scr
gr.hide cgm1
gr.hide cgm2
gr.hide rc1
gr.hide rc2
for i=1 to size
gr.hide sns[i]
next i
gr.hide cmr1
gr.hide cmr2
gosub mytime
if x>350*sx then
! exit sysinfo
gr.hide baton1
gr.hide baton2
gr.hide prog
progmenu=0
gr.render
return
endif
! next p
gr.hide baton1
gr.color 255,255,0,0,1
gr.text.size 50
gr.text.draw title2,330,105,"GPS info"
gr.text.size 30
gr.text.draw extt,430,830,"[EXIT]"
gr.render
! gps
err$="GPS"
gosub mytime
gps.open
gps.provider pr$
gr.text.draw gp[1], 100, 230, "GPS Provider: "+pr$
gps.accuracy acc
gr.text.draw gp[2], 100, 260, "GPS Accuracy: "+str$(acc)
gps.altitude al
gr.text.draw gp[3], 100, 290, "Altitude: "+str$(al)
gps.bearing be
gr.text.draw gp[4], 100, 320, "Bearing: "+str$(be)
gps.longitude lo
gr.text.draw gp[5], 100, 350, "Longitude: "+str$(lo)
gps.speed sp
gr.text.draw gp[6], 100, 380, "Speed: "+str$(sp)
gps.time tm
gr.text.draw gp[7], 100, 410, "Time: "+str$(tm)
gps.close
gosub mytime
gr.render
! wait to close
do
gr.touch touched,x,y
gosub mytime
until touched & x>350*sx & x<600*sx & y>780*sy & y<860*sy
gr.hide title2
gr.hide ext
gr.hide extt
for i=1 to 7
gr.hide gp[i]
next i
gr.hide prog
gr.hide baton2
progmenu=0
gr.render
return % sysinfo
systests:
! SYSTEM TESTS
gr.color 255,255,55,0,1
gr.text.size 50
gr.text.bold 1
gr.text.draw title,200,105,"SYSTEM TESTS"
gr.text.size 30
gr.bitmap.draw baton2, bptr8,350,780
gr.text.draw extt,430,830,"[EXIT]"
gr.render
! multitouch
err$="multitouch"
gr.rect r1,100,280,150,330
gr.rect r2,300,280,350,330
gr.text.size 30
gr.text.draw mtc, 100,230,"First touch left rectangle, then right one"
gr.render
x=clock()
do
gr.bounded.touch touched1, 100*sx, 280*sy, 150*sx, 330*sy
gr.bounded.touch2 touched2, 300*sx, 280*sy, 350*sx, 330*sy
gosub mytime
until (touched1 & touched2) | (clock()-x>10000)
gr.hide r1
gr.hide r2
if touched1 & touched2 then
gr.text.draw mt1,100,230, "Multitouch Test: Succeeded"
else
gr.text.draw mt2,100,230, "Multitouch Test: Failed!"
endif
gr.hide r1
gr.hide r2
gr.hide mtc
gr.render
! vibration
err$="vibration"
dash = 500
gap = 200 % Length of Gap Between dots/dashes
undim vib[]
array.load vib[], 0,dash,gap,dash
vibrate vib[], -1
gosub mytime
gr.text.draw vb,100,290,"Vibration: Sent to device"
! speak
err$="speech data"
tts.init
tts.speak "this is a speech synthesis test"
gosub mytime
gr.text.draw spk,100,350,"Speech synthesis: Message sent"
gr.render
! speed test
gosub mytime
gr.color 255,0,55,255,1
gosub speedtest
gr.color 255,255,55,0,1
! record 3 secs
gosub mytime
err$="audio record"
audio.stop
pause 1000
x=clock()
audio.record.start "basic_audio_test.3GP"
gr.text.draw bt1,100,650,"Audio record started!"
gr.render
do
gosub mytime
until clock()-x>=5000
audio.record.stop
gr.text.draw bt2,100,680,"Audio record ended!"
gr.text.draw bt3,100,710,"Check 'basic_audio_test.3GP'"
gr.render
! wait to close
do
gr.touch touched,x,y
gosub mytime
until touched & x>350*sx & x<600*sx & y>780*sy & y<850*sy
gr.hide title
gr.hide extt
gr.hide mt1
gr.hide mt2
gr.hide vb
gr.hide cal0
gr.hide cal1
gr.hide prn1
gr.hide prn2
gr.hide prn3
gr.hide prn4
gr.hide prn5
gr.hide baton2
gr.hide bt1
gr.hide bt2
gr.hide bt3
gr.hide spk
gr.hide prog
progmenu=0
gr.render
return % system tests
! ******** updates time *******
mytime:
if clock()-g>=20000 then
g=clock()
TIME Year$, Month$, Day$, Hour$, Minute$, Second$
gr.modify taim, "text",Hour$+":"+Minute$
gr.render
endif
return
! chooses a program to run
runprg:
if firstprog=1 then
gr.bitmap.draw prog,bptr7, 50,50
gr.render
firstprog=0
else
gr.show prog
gr.render
endif
if ff$="crapsgame" then gosub crapsgame
if ff$="scissorsgame" then gosub scissorsgame
if ff$="basichints" then gosub basichints
if ff$="sysinfo" then gosub sysinfo
if ff$="systests" then gosub systests
if ff$="recordcalls" then gosub recordcalls
if ff$="sdanalyzer" then gosub sdanalyzer
return
! f22 benchmarking example proram
speedtest:
err$=" BENCHMARK"
Rem
Rem Document: Whets.bas
Rem File Group: Classic Benchmarks
Rem Creation Date: 9 December 1996
Rem Revision Date:
Rem
Rem Title: Whetstone Benchmark for QBasic
Rem Keywords: WHETSTONE BENCHMARK PERFORMANCE MIPS
Rem MWIPS MFLOPS
Rem
Rem Abstract: QBasic version of Whetstone one of the
Rem Classic Numeric Benchmarks with example
Rem results for PCs.
Rem
Rem Contributor: Roy Longbottom 101323.2241@compuserve.com
Rem or Roy_Longbottom@compuserve.com
Rem
Rem*************************************************************
Rem QBasic Whetstone benchmark Single Precision
Rem
Rem Original concept Brian Wichmann NPL 1960Rems
Rem Original author Harold Curnow CCTA 1972
Rem Self timing versions Roy Longbottom CCTA 1978/87
Rem Optimisation control Bangor University 1987
Rem PC versions Roy Longbottom 1996
Rem
Rem***********************************************************
Rem
Rem This version is a greatly simplified version of the full
Rem Whetstone benchmark. The results of this benchmark are
Rem only relative to the results of other devices running
Rem this program.
Rem
Rem***********************************************************
undim ex[]
undim results[]
undim ztime[]
undim headings[]
undim ops[]
undim flops[]
DIM ex[4]
DIM results[8]
DIM ztime[8]
DIM heading$[8]
DIM ops[8]
DIM flops[8]
icount = 10
calibrate = 0
ixtra = 1
ix100 = 1
Rem Passes to average
Passes = 10
gr.text.draw cal0,100,560," " % calib 0
gr.text.draw cal1,100,590," " % calib 1
gr.text.draw prn5,100,470," " % calib 1
gr.text.draw prn1,100,410,"Whetstone Benchmark modified for BASIC!"
gr.text.draw prn2,100,440,"Performing "+str$(Passes)+" Passes"
gr.render
mTimeUsed = 0
Check = 0
For Pass = 1 to Passes
GOSUB Whetstones
Next Pass
gr.text.draw prn3,100,500,">> TOTAL TIME: "+str$(mTimeUsed)+" secs <<"
gr.text.draw prn4,100,530,">> AVERAGE PASS TIME: "+str$(mTimeUsed / Passes)+" secs <<"
IF Check = 0 THEN
popup "Calculation Error Detected",0,0,4
Else
popup "Calculations Correct",0,0,0
Endif
return
Whetstones:
Rem INITIALISE CONSTANTS
t = 0.49999975
t0 = t
t1 = 0.50000025
t2 = 2
n1 = 12 * ix100
n2 = 14 * ix100
n3 = 345 * ix100
n4 = 210 * ix100
n5 = 32 * ix100
n6 = 899 * ix100
n7 = 616 * ix100
n8 = 93 * ix100
n1mult = 10
gr.modify prn5,"text","Pass: "+str$(Pass)+" of "+str$(Passes)
gr.render
Rem MODULE 1 - ARRAY ELEMENTS
let stime = xTime()
let ex[1] = 1
let ex[2] = -1
let ex[3] = -1
let ex[4] = -1
FOR ix = 1 TO ixtra
FOR i = 1 TO n1 * n1mult
let ex[1] = (ex[1] + ex[2] + ex[3] - ex[4]) * t
let ex[2] = (ex[1] + ex[2] - ex[3]+ ex[3]) * t
let ex[3] = (ex[1] - ex[2] + ex[3] + ex[4]) * t
let ex[4]= (-ex[1] + ex[2] + ex[3] + ex[4]) * t
NEXT i
let t = 1.0 - t
NEXT ix
let t = t0
let checsum = ex[4]
let rtime = (xTime() - stime)
smflops = n1 * 16
title$ = "N1 floating point"
atype = 1
section = 1
Rem N1 * 16 floating point calculations
GOSUB Pout
Rem MODULE 2 - ARRAY AS PARAMETER
stime = xTime()
FOR ix = 1 TO ixtra
FOR i = 1 TO n2
GOSUB PA
NEXT i
let t = 1.0 -t
NEXT ix
let t = t0
let checsum = ex[4]
let rtime = xTime() - stime
smflops = n2 * 96
title$ = "N2 floating point"
atype = 1
section = 2
Rem N2 * 96 floating point calculations
GOSUB Pout
Rem MODULE 3 - CONDITIONAL JUMPS
let stime = xTime()
let j = 1
FOR ix = 1 TO ixtra
FOR i = 1 TO n3
IF j <> 1 THEN
j = 3
ELSE
j = 2
Endif
IF j <= 2 THEN
j = 1
ELSE
j = 0
Endif
IF j >= 1 THEN
j = 0
ELSE
j = 1
Endif
NEXT i
NEXT ix
let checsum = j
let rtime = xTime() - stime
smflops = n3 * 3
title$ = "N3 if then else"
atype = 2
section = 3
Rem N3 * 3 IF THEN ELSE
GOSUB Pout
Rem MODULE 4 - INTEGER ARITHMETIC
let stime = xTime()
let j = 1
let k = 2
let l = 3
FOR ix = 1 TO ixtra
FOR i = 1 TO n4
let j = j * (k - j) * (l - k)
let k = l * k - (l - j) * k
let l = (l - k) * (k + j)
let ex[l - 1] = j + k + l
let ex[k - 1] = j * k * l
NEXT i
NEXT ix
let checsum = ex[2] + ex[1]
let rtime = xTime() - stime
smflops = n4 * 15
title$ = "N4 fixed point"
atype = 2
section = 4
Rem N4 * 15 fixed point operations
GOSUB Pout
Rem MODULE 5 - TRIG. FUNCTIONS
let stime = xTime()
let X = 0.5
let Y = 0.5
FOR ix = 1 TO ixtra
FOR i = 1 TO n5
let X = t * ATAN(t2 * SIN(X) * COS(X) / (COS(X + Y) + COS(X - Y) - 1))
let Y = t * ATAN(t2 * SIN(Y) * COS(Y) / (COS(X + Y) + COS(X - Y) - 1))
NEXT i
let t = 1.0 - t
NEXT ix
let t = t0
let checsum = Y
let rtime = xTime() - stime
smflops = n5 * 26
title$ = "N5 sin,cos etc."
atype = 2
section = 5
Rem N5 * 26 function calls and floating point operations
GOSUB Pout
Rem MODULE 6 - PROCEDURE CALLS
let stime = xTime()
let X = 1
let Y = 1
let Z = 1
FOR ix = 1 TO ixtra
FOR i = 1 TO n6
GOSUB P3
NEXT i
NEXT ix
let checsum = Z
let rtime = xTime() - stime
let smflops = n6 * 6
title$ = "N6 floating point"
atype = 1
section = 6
Rem N6 * 6 floating point operations
GOSUB Pout
Rem MODULE 7 - ARRAY REFERENCES
let stime = xTime()
let j = 1
let k = 2
let l = 3
let ex[1] = 1
let ex[2] = 2
let ex[3] = 3
FOR ix = 1 TO ixtra
FOR i = 1 TO n7
GOSUB PO
NEXT i
NEXT ix
let checsum = ex[3]
let rtime = xTime() - stime
smflops = n7 * 3
title$ = "N7 assigns"
atype = 2
section = 7
Rem N7 * 3 assignments
GOSUB Pout
Rem MODULE 8 - STANDARD FUNCTIONS
let stime = xTime()
let X = 0.75
FOR ix = 1 TO ixtra
FOR i = 1 TO n8
let X = SQR(LOG(X) / t1)
NEXT i
NEXT ix
let checsum = X
let rtime = xTime() - stime
smflops = n8 * 4
title$ = "N8 exp,sqrt etc."
atype = 2
section = 8
Rem N8 * 4 function calls and floating point operations
GOSUB Pout
RETURN
Rem END OF MAIN ROUTINE
PA:
Rem PROCEDURE PA
j = 0
DO
let ex[1] = (ex[1] + ex[2] + ex[3] - ex[4]) * t
let ex[2] = (ex[1] + ex[2] - ex[3]+ ex[3]) * t
let ex[3] = (ex[1] - ex[2] + ex[3] + ex[4]) * t
let ex[4]= (-ex[1] + ex[2] + ex[3] + ex[4]) * t/2
let j = j + 1
until j = 6
RETURN
PO:
Rem PROCEDURE P0
let ex[j] = ex[k]
let ex[k] = ex[l]
let ex[l] = ex[j]
RETURN
P3:
Rem PROCEDURE P3
let X = Y
let Y = Z
let X = t * (X + Y)
let Y = t1 * (X + Y)
let Z = (X + Y) / t2
RETURN
Pout:
Check = Check + checsum
ztime[section] = rtime
heading$[section] = title$
mTimeUsed = mTimeUsed + rtime
IF calibrate = 1 THEN
gr.modify cal1,"text","#"
gr.render
Endif
IF calibrate = 0 THEN
gr.modify cal0,"text", heading$[section]+ " "+ str$(ztime[section])+ " sec"
gr.render
Endif
RETURN
! ----------------------------------------------------
OnError:
gr.cls
gr.color 255,255,255,255,1
gr.text.draw tex, 10,100," Unexpected error"
gr.text.draw tex, 10,200," Error type: "+err$
gr.text.draw tex, 10,300," Quitting..."
gr.render
pause 7000
end