• The update functions are integrated together on a red background, separated by white lines
• The introduction of the "Update" function reduces the number of global variables and simplifies integration with iConvert.
• Preparation of the update (on yellow background) requires now only the set up of
- Browser if view is active, to display the web-contents
- Interface-field
This field is at the top of the display in the testprogram and gives messages about progress and errors.
Progress-messages are on blue background, whereas interactivity requests and error-messages are on red background.
• I have disabled (as comment) the code that removes html-files. The last html-file can now be used as backup and for testing. Older files could be deleted.
• A date-time stamp for the data-file has been prepared but commented because the Date-time string according to ISO 8601 becomes too long e.g. "20181112T13:21" for display in the items-list.
• A PING-command to test the website has not been used, because it returned always zero.
Code: Select all
/*
iConvert 4 Alpha
by rbytes and Dutchman, October 2018
Converts measurements in many categories.
A collaborative international project.
V4 Alpha
- Integrated with UpdateCurrencies.functions
See https://nitisara.ru/forum/viewtopic.php?f=20&t=2272
- Subroutine renamed to UpdateData
• Prepares Interactivity field and browser
• Calls Startfunction "Update(view,iField)"
- Page change removed. Convert screen stays.
V4 Beta
- The project continues as a single integrated program.
- The Update Currencies program code is now in a subroutine labelled Update:
It and all of the subroutines and functions it calls are highlighted in yellow.
V3.6b
- now has a Settings button (gear symbol), left of the other buttons. This opens a
popup Settings window with a switch to set the view for Update Currencies V2.1
when the switch is off, the currency exchange file is updated without
interactivity.
when the switch is on, the file is updated interactively with the user.
- file "viewstate1" stores the view setting.
V3.5b self
- Update Currencies code now embedded as a subroutine
- Fuel Economy category added by rbytes, November 2018
V3.4b
- Modified for my personal use
V3.4
- Acceleration category added by rbytes
- Update button added to launch "Update currencies.sb"
for updating currency exchange rates
V3.3
- Flow Rate category added by rbytes
V3.2
- Angle category added by rbytes
- Energy transition category added by Dutchman
- Error trap added for Currency
V3.1
- Temperature category added by Dutchman
V3
- Currency category added by Dutchman
DATA generated with "Update currencies.sb"
V2
- animation added to title
(plays only once, at launch)
- measures added in most categories
- scientific notation is now used for
results larger than 100,000,000 or
smaller than .00000001
V1.1
- added Horsepower (Metric) to
Power category
- eliminated >>> button;
calculation is now automatic
when list selections or
input values are changed.
- code efficiency improved
*/
OPTION BASE 1
SET ORIENTATION LANDSCAPE
SET BUTTONS CUSTOM
SET TOOLBAR OFF
laun$=LAUNCHER$()
GET SCREEN SIZE sw,sh
' set to 1 to test iPhone layout on iPad
iostest=0
IF iostest THEN
sw=568
sh=320
ENDIF
rw=sw/1024!rh=sh/740
'b'========= Constants ===================
'' *** Note - IP address may change if router is rebooted ***
' run ipconfig on your PC to find its IP address.
URL$="192.170.61.43" ' example of IP address
DIM h$(2)
' each line of a file sent to a PC print server must end with these characters:
cr$=CHR$(13) ' carriage return character
lf$=CHR$(10) ' line feed character
' interface object names
x$="guide"
y$="guide2"
n$="title"
o$="category"
p$="from"
q$="to"
pi$="from_in"
qi$="to_in"
qi2$="cover"
lf$=CHR$(10)
q$=CHR$(34)
cat=1 ' default category (angle)
invalue=1
upshift=7
' correction for iPad display only
IF rw=1 then shift=10
' correction for non-iPad display only
IF rw<1 THEN shift2=75 ELSE shift2=-6
fm$="##,###,###,###,###,###,###.#######" ' formats the result with commas
fm2$="####################.#######" ' formats the result without commas
' number of measures in each category
cats=17
DIM cat$(cats)
accel=7
angle=9
area=9
cook=9
dat=8
energ=12
EnergyTrans=28
flow=17
leng=13
prefix=21
pow=14
press=13
spd=11
Tscales=8 ! Tscale$="Temperature"
timing=10
vol=12
wgt=10
'g'
' User choice of interface when updating currency exchange rates:
' Silent: view=0
' Interactive: view=1
IF file_exists("viewstate1") then
FILE "viewstate1" READLINE view$
view$=LEFT$(view$,1)
view=VAL(view$)
ELSE
view=0
view$=STR$(view)
END IF
FILE "viewstate1" DELETE
FILE "viewstate1" WRITELINE view$&"calling"
''
'b'============ Initialisation============
''
GRAPHICS
GRAPHICS CLEAR .9,1,1
' animate title if gif animation file exists
PAGE "title" FRAME 0,0,sw,80
PAGE "title" SET
PAGE "title" SHOW
A$="iconvert3.GIF"
IF FILE_EXISTS(A$) THEN
SPRITE N$ LOAD A$
SPRITE N$ AT sw/3-shift2,sh/60+3*shift scale 1*rh
SPRITE N$ SHOW
ELSE
DRAW IMAGE "iconvert.PNG" AT sw/2.8,sh/20 SCALE .8*rw
ENDIF
PAGE "" SET
' read categories
RESTORE TO Categories
GOSUB money
FOR t=1 TO cats
READ cat$(t)
NEXT t
RESTORE TO acceleration ' default category
items=accel
DIM measure$(items)
GOSUB setcategory
' create three lists
SET LISTS FONT SIZE 18*rw
LIST o$ TEXT cat$ AT sw*.1,260*rh SIZE 240*rw,310*rh
LIST o$ SELECT cat
LIST p$ TEXT measure$ AT sw*.385,260*rh SIZE 240*rw,310*rh
LIST p$ SELECT 1
LIST q$ TEXT measure$ AT sw*.672,260*rh SIZE 240*rw,310*rh
LIST q$ SELECT 1
' create fields and buttons
SET BUTTONS FONT SIZE 20*rw
DRAW COLOR 0,0,0
guide$="Pick from each list"&lf$&"Enter quantity here"
FILL COLOR 0,0,0
FILL CIRCLE sw*.39,168*rh SIZE 3*rw
FILL COLOR 1,1,1
FIELD x$ TEXT guide$ AT sw*.1,132*rh-upshift SIZE 250,60 RO ML
FIELD x$ FONT SIZE 18*rw
FIELD x$ BACK ALPHA 0
guide2$="All lists can be scrolled"
DRAW LINE sw*.26,168*rh TO sw*.392,168*rh
DRAW LINE sw*.096,618*rh TO sw*.38,618*rh
DRAW LINE sw*.63,618*rh TO sw*.91,618*rh
FIELD y$ TEXT guide2$ AT sw*.41,600*rh-upshift*.8 SIZE 250,60 RO ML
FIELD y$ FONT SIZE 18*rw
FIELD y$ BACK ALPHA 0
FIELD o$ TEXT "CATEGORY" AT sw*.115,210*rh SIZE 130,30 RO
FIELD o$ FONT SIZE 20*rw
FIELD o$ BACK ALPHA 0
FIELD p$ TEXT "FROM" AT sw*.405,210*rh SIZE 100,30 RO
FIELD p$ FONT SIZE 20*rw
FIELD p$ BACK ALPHA 0
FIELD q$ TEXT "TO" AT sw*.69,210*rh SIZE 70,30 RO
FIELD q$ FONT SIZE 20*rw
FIELD q$ BACK ALPHA 0
FILL ALPHA 0
SET BUTTONS FONT SIZE 24*rw
BUTTON "settings" TEXT CHR$(9881) AT 90*rw,648*rh SIZE 50*rw,50*rh
SET BUTTONS FONT SIZE 20*rw
BUTTON "update" TEXT "UPDATE" AT 190*rw,650*rh SIZE 100*rw,50*rh
BUTTON "copy" TEXT "COPY" AT 330*rw,650*rh SIZE 100*rw,50*rh
BUTTON "print" TEXT "PRINT" AT 470*rw,650*rh SIZE 100*rw,50*rh
BUTTON "save" TEXT "SAVE" AT 610*rw,650*rh SIZE 100*rw,50*rh
BUTTON "stop" TEXT "STOP" AT 750*rw,650*rh SIZE 100*rw,50*rh
FILL ALPHA 1
FIELD pi$ TEXT "1" AT sw*.400,150*rh SIZE 200*rw,30*rh
FIELD pi$ FONT SIZE 18*rw
FIELD qi$ TEXT "1" AT sw*.640,145*rh SIZE 280*rw,40*rh
FIELD qi$ FONT SIZE 22*rw
FIELD qi2$ TEXT "" AT sw*.640,145*rh SIZE 280*rw,40*rh RO
FIELD qi2$ BACK ALPHA 0
if rw<1 then vshift=2
FILL COLOR .6,.8,.8
FILL RECT sw*.395,145*rh TO sw*.6,185*rh-vshift
FILL COLOR .8,.8,.8
FILL RECT sw*.635,140*rh TO sw*.92,190*rh-vshift
DRAW RECT sw*.1-1,258*rh TO sw*.1+240*rw+1,258*rh+312*rh
DRAW RECT sw*.386-2,258*rh TO sw*.386+240*rw,258*rh+312*rh
DRAW RECT sw*.673-2,258*rh TO sw*.673+240*rw,258*rh+312*rh
timer=time () ' set timer to stop title anim after one cycle
'b'========== main program loop ===================
''
DO
' play once, then stop animation
IF time()-timer>1 AND time()-timer <2 and not noplay THEN
IF FILE_EXISTS(A$) THEN SPRITE N$ PLAY
noplay=1
ENDIF
IF time()-timer>6 AND time()-timer <7 THEN
IF FILE_EXISTS(A$) THEN SPRITE N$ STOP
ENDIF
' check which category is selected
type=LIST_SELECTED(o$)
' choose and prepare a new category if necessary
IF type<>cat THEN
oldcat=cat
cat=type
changed=1
ON cat GOTO 5,10,15,20,25,30,40,45,50,55,60,70,80,90,95,100,110,120
5 RESTORE TO acceleration
items=accel
GOTO skip
10 RESTORE TO angle
items=angle
GOTO skip
15 RESTORE TO area
items=area
GOTO skip
20 RESTORE TO cooking
items=cook
GOTO skip
25 'RESTORE TO currencies
if curr=0 then
list o$ select oldcat
type=oldcat
gosub message
goto skip2
else
items=curr
endif
GOTO skip
30 RESTORE TO data
items=dat
GOTO skip
40 RESTORE TO energy
items=energ
GOTO skip
45 RESTORE TO EnergyTransition
items=EnergyTrans
GOTO skip
50 RESTORE TO FlowRate
items=flow
GOTO skip
55 RESTORE TO length
items=leng
GOTO skip
60 RESTORE TO prefixes
items=prefix
GOTO skip
70 RESTORE TO power
items=pow
GOTO skip
80 RESTORE TO pressure
items=press
GOTO skip
90 RESTORE TO speed
items=SPD
GOTO skip
95 RESTORE TO Temperatures
items=Tscales
GOTO Skip
100 RESTORE TO timing
items=timing
GOTO skip
110 RESTORE TO volume
items=vol
GOTO skip
120 RESTORE TO weight
items=wgt
GOTO skip
skip:
if cat=5 then
GOSUB currcalc
else
GOSUB setcategory
endif
LIST p$ TEXT measure$
LIST p$ SELECT 1
LIST q$ TEXT measure$
LIST q$ SELECT 1
FIELD pi$ TEXT "1"
skip2:
ENDIF
IF LIST_SELECTED(p$)<>selp or LIST_SELECTED(q$)<>selq then changed=1
' calculate the conversion
if VAL(FIELD_TEXT$(pi$))<>invalue or changed then
invalue=VAL(FIELD_TEXT$(pi$))
selp=LIST_SELECTED(p$)
selq=LIST_SELECTED(q$)
GOSUB Convert ' calculate OutValue
if outvalue<100000000 and outvalue>.000000001 then
out$=STR$(outvalue,fm$)
out2$=STR$(outvalue,fm2$)
format(out$)!out$=format.form$
format(out2$)!out2$=format.form$
else
out$=STR$(outvalue)
endif
fsize=22*rw
FIELD qi$ FONT SIZE fsize
FIELD qi$ TEXT out$
FIELD qi2$ TEXT ""
ENDIF
IF bp("settings") THEN
showswitch=1
gosub settings
ENDIF
IF bp("update") THEN
/*
DIR "" LIST FILES FILES$,n2
FOR t=1 to n2
temp=INSTR(FILES$(t),"currencies.html")
IF temp<>-1 THEN FILE FILES$(t) DELETE
NEXT t
*/
/*Test mode is changed to View mode. If View is non-zero then program is interactive. Default: 'View = 0'
• If "currencies.data" is not present, then 'View' becomes inactive if "currencies.html <date>" is present. The program will then extract data from that html-file and generate "currencies.data". This is the test mode for data extraction.
• If both files, "currencies.data" and "currencies.html <date>", are not present then 'View' becomes active and the conversion-program identified by 'Convert$' will be started after finishing.
So the program "iConvert" can refresh the "Currencies" category as follows:
• Be sure that the constant "Convert$" in "Update currencies" (on red background) has the correct name of "iConvert"
• Delete the files "currencies.data" and "currencies.html <date>"
• Run "Update currencies". That will generate "currencies.data" and return to "iConvert"
*/
gosub updatedata
gosub money
restore to categories
FOR t=1 TO cats
READ cat$(t)
NEXT t
LIST o$ TEXT cat$
LIST p$ TEXT measure$
LIST q$ TEXT measure$
ENDIF
' copy the conversion info to clipboard
IF bp("copy") THEN
GOSUB compile
IF cp=0 THEN!CLIPBOARD CLEAR!cp=1!ENDIF
CLIPBOARD WRITE convert$
BEEP
ENDIF
' print the conversion info
IF bp("print") THEN
GOSUB compile
h$(1) = "content-type:text/html" ' make header info
h$(2) = "content-length:" & LEN(convert$)
' print convert$ using Henko print technique
HTTP URL$ HEADER H$ POST convert$ ' send doc to the print server
BEEP
ENDIF
' save the conversion info to a file
IF bp("save") THEN
GOSUB compile
fname$="converted.txt"
IF FILE_EXISTS(fname$) THEN FILE fname$ DELETE
FILE fname$ WRITELINE convert$
BEEP
ENDIF
' end the program
IF bp("stop") THEN
view$=STR$(view)
FILE "viewstate1" DELETE
FILE "viewstate1" WRITELINE view$&"idle"
IF laun$="desktop" THEN
IF FILE_EXISTS("/launch") THEN
RUN "/-Launch.sb"
ELSE
EXIT
ENDIF
ENDIF
END
ENDIF
SLOWDOWN
UNTIL 0
END
'g'========== Subroutines and Functions =============
Convert:
'--- Convert via formula
' temperature
IF Cat$(cat)=Tscale$ THEN
Outvalue=FromCelsius(Celsius(Invalue,measureval(selp)),measureval(selq))
RETURN
ENDIF
'--- Convert via ratio
outvalue=invalue*1/(measureval(selq)/measureval(selp))
RETURN
' temperature conversion
DEF FromCelsius(Value,UnitPointer)
'Converts Value on 'Unit'-scale to Celsius-scale
' to newvalue in scale of Unitpointer
ON UnitPointer GOTO 1,2,3,4,5,6,7,8
1 RETURN Value 'Celsius
2 RETURN Value+273.15 'Kelvin
3 RETURN Value*9/5+32 'Fahrenheit
4 RETURN (Value+273.15)*9/5 'Rankine
5 RETURN (100-Value)*3/2 'Delisle
6 RETURN Value*33/100 'Newton
7 RETURN Value*4/5 'Réamur
8 RETURN Value*21/40+7.5 'Rømer
END DEF
'
DEF Celsius(Value,UnitPointer)
'Converts Value in 'Unit' to new value in Celsius
ON UnitPointer GOTO 1,2,3,4,5,6,7,8
1 RETURN Value 'Celsius
2 RETURN Value-273.15 'Kelvin
3 RETURN (Value-32)*5/9 'Fahrenheit
4 RETURN (Value-491.67)*5/9 'Rankine
5 RETURN 100-Value*2/3 'Delisle
6 RETURN Value*100/33 'Newton
7 RETURN Value*5/4 'Réamur
8 RETURN (Value-7.5)*40/21 'Rømer
END DEF
' read the data for a category
setcategory:
DIM measure$(items)
FOR t=1 TO items
READ measure$(t)
NEXT t
DIM measureval(items)
FOR t=1 TO items
READ measureval(t)
NEXT t
RETURN
currcalc:
DIM measure$(items)
FOR t=1 TO items
measure$(t)=mname$(t)
NEXT t
DIM measureval(items)
FOR t=1 TO items
measureval(t)=val(mvalue$(t))
NEXT t
RETURN
' prepare a string showing the conversion, for copying or saving to a file
compile:
selp=LIST_SELECTED(p$)
selq=LIST_SELECTED(q$)
temp1$=measure$(selp)
temp2$=measure$(selq)
' if a value is 1 or a fraction, change the name from plural to singular
convin=val(FIELD_TEXT$(p$))
temp1len=LEN(temp1$)
IF convin=<1 AND RIGHT$(temp1$,1)="s" THEN temp1$=LEFT$(temp1$,temp1len-1)
IF VAL(out2$)=<1 AND RIGHT$(temp2$,1)="s" THEN temp2$=LEFT$(temp2$,LEN(temp2$)-1)
convert$&=FIELD_TEXT$(pi$)&" "&temp1$&" = "&FIELD_TEXT$(qi$)&" "&temp2$
convert$&=cr$&lf$&FIELD_TEXT$(pi$)&" "&temp1$&" = "&out2$&" "&temp2$&cr$&lf$&cr$&lf$
RETURN
' settings window
settings:
a$=lf$&"When updating currency data, choose if you want interactive mode. When the switch is off, the currency exchange file is updated without interactivity. When the switch is on, the file is updated interactively with the user."
pw("notice","Settings",a$,sw/2-200*rw,sh/4,400*rw,400*rw,1,1,1,1)
goto message
' notice if user has not downloaded and run Update Currencies.sb
notice:
a$="To use this category, please download the file Update Currencies 2.1.sb from the Forum at this link:"&lf$&lf$&"https://nitisara.ru/forum/viewtopic.php?f=20&t=2280"&lf$&lf$&"Then run it. The next time you run iConvert, the Currency category will be functional."
pw("notice","Notice!",a$,sw/2-200*rw,sh/4,400*rw,400*rw,1,1,1,1)
message:
wait: SLOWDOWN
IF SWITCH_CHANGED("inter") THEN
.view=SWITCH_STATE("inter")
view$=STR$(.view)
FILE "viewstate1" DELETE
FILE "viewstate1" WRITELINE view$&"calling"
ENDIF
IF BUTTON_PRESSED("close") THEN
PAGE pw.NAME$ HIDE ! PAGE "" SET ! PAGE "" SHOW
FILL COLOR .6,.8,.8
FILL RECT sw*.395,145*rh TO sw*.6,185*rh-vshift
FILL COLOR .8,.8,.8
FILL RECT sw*.635,140*rh TO sw*.92,190*rh-vshift
DRAW COLOR 0,0,0
DRAW RECT sw*.1-1,258*rh TO sw*.1+240*rw+1,258*rh+312*rh
DRAW RECT sw*.386-2,258*rh TO sw*.386+240*rw,258*rh+312*rh
DRAW RECT sw*.673-2,258*rh TO sw*.673+240*rw,258*rh+312*rh
DRAW LINE sw*.26,168*rh TO sw*.392,168*rh
DRAW LINE sw*.096,618*rh TO sw*.38,618*rh
DRAW LINE sw*.63,618*rh TO sw*.91,618*rh
FILL COLOR 0,0,0
FILL CIRCLE sw*.39,168*rh SIZE 3*rw
FILL COLOR .8,.8,.8
ELSE
GOTO wait
ENDIF
RETURN
' import currencies.data if exists
money:
fname$="currencies.data"
q$=chr$(34)
mark=1
if file_exists(fname$) then
void=0
file fname$ setpos 0
for t=1 to 5
FILE fname$ READLINE hold$(t)
next t
' read curr value
temp$=hold$(1)
fnd=INSTR(temp$,"=",mark)
IF fnd<>-1 THEN
stpt=INSTR(temp$,"=",fnd) ' start of condition string
enpt=INSTR(temp$,"'",fnd) ' end of condition string
curr$=MID$(temp$,stpt+1,enpt-stpt-2)
curr=VAL(curr$)
ENDIF
' read CurrDate$
temp$=hold$(2)
fnd=INSTR(temp$,"=",mark)
IF fnd<>-1 THEN
stpt=INSTR(temp$,"=",fnd) ' start of condition string
enpt=INSTR(temp$,"'",fnd) ' end of condition string
CurrDate$=MID$(temp$,stpt+2,enpt-stpt-4)
ENDIF
' read measures array
temp$=hold$(4)
temp$=MID$(temp$,5,1000)
SPLIT temp$ TO mname$,tot WITH ","
for t=1 to curr
temp$=mname$(t)
' trim quotation marks
temp$=right$(temp$,len(temp$)-2)
mname$(t)=temp$
temp2$=left$(mname$(t),len(temp$)-1)
mname$(t)=temp2$
next t
' read measures values
temp$=hold$(5)
temp$=MID$(temp$,5,1000)
SPLIT temp$ TO mvalue$,tot WITH ","
ELSE
void=1
ENDIF
return
'y'
UpdateData:
' Update Currencies by Dutchman, October 2018
'==== Presets ====
IF NOT viewpreset THEN
'--- presets
Top=MAX(17,MIN(sw,sh)/32) ' top space
YesNoPos=sw/2 ' x-position of buttons
TopFont=0.7*top 'fontsize
'--- Prepare browser
SET BROWSERS SCALED
BROWSER "a" AT 0,top SIZE sw,sh-top
BROWSER "a" HIDE
'--- make buttons
SET BUTTONS FONT SIZE topfont
SET BUTTONS FONT NAME "Menlo"
DRAW COLOR 1,1,0
FILL COLOR 1,0,0
BUTTON "yes" TEXT "Yes" AT YesNoPos,0 SIZE 3*top,top
BUTTON "yes" HIDE
BUTTON "no" TEXT "No" AT YesNoPos+3*top,0 SIZE 3*top,top
BUTTON "no" HIDE
'--- Make Messagefield
Top$="In" ' Field for input
FIELD Top$ AT 0,0 SIZE sw/2,top
FIELD Top$ FONT NAME "Menlo"
FIELD Top$ FONT SIZE topfont
FIELD Top$ FONT COLOR 1,1,0
FIELD Top$ BACK COLOR 0,0,1
FIELD Top$ HIDE
'--- don't recall
viewpreset=1
ENDIF
'
'==== Main Update Routine ====
IF Update(View,Top$) THEN
FIELD Top$ BACK COLOR 0,0,1
Field Top$ TEXT "Data written to """&Update.DataFile$&"""."
ELSE
FIELD Top$ BACK COLOR 1,0,0
Field Top$ TEXT Update.Msg$
ENDIF
PAUSE 1
FIELD Top$ BACK COLOR 0,0,1
FIELD Top$ HIDE
BROWSER "a" HIDE
RETURN
'
'========== Update Currencies Subroutines and Functions ===========
'r'
DEF Update(view,iField$)
'--- constants
Source$="https://www.x-rates.com/table/?from=USD&amount=1"
MaxCount=100 ' max number of currencies
WebPage$="currencies.html" ' undated webpage filename
'--- Output variables
DIM Data$(maxcount,2) ' array for extracted data
DataFile$="currencies.data" ' file with DATA-lines
'--- messagebar
IF view THEN
FIELD iField$ SHOW
FIELD iField$ BACK COLOR 0,0,1
ENDIF
'--- Select and store source
IF view THEN web$=LatestFile$(webpage$)
IF web$="" THEN web$=WebPage$
web$=MakeCurrencyHTML$(Source$,Web$,view,iField$,"a")
IF web$="" THEN
Msg$="Cancelled."
RETURN 0
ENDIF
'---- Extract data from HTML-file
IF ExtractHtml(web$,Data$,iField$)=0 THEN
Msg$=ExtractHtml.Msg$
RETURN 0
ENDIF
'--- Sort and write to data-file
CALL SortAndStore(DataFile$,Data$,ExtractHtml.count)
RETURN 1
END DEF
''
'r'
DEF SortAndStore(File$,Data$(,),items)
Quicksort$(Data$,Extract.count,2,1)
IF FILE_EXISTS(File$) THEN FILE File$ DELETE
items+=1 'add 1 to include reference value US-dollar
FILE File$ PRINT "Curr="&items&" ' items in Currencies"
DateTime$= ExtractHtml.DataDate$
'DateTime$&="T"&RIGHT$("0"&CURRENT_HOUR(),2)&":" ' add hour
'DateTime$&=RIGHT$("0"&CURRENT_MINUTE(),2) ' add minutes
FILE File$ PRINT "CurrDate$="""&DateTime$&""" ' download date"
FILE File$ PRINT "Currencies:"
File File$ PRINT "DATA """&"US dollar"&"""";
FOR i=1 TO items-1
File File$ PRINT ", """&Data$(i,1)&"""";
NEXT i
File File$ PRINT
File File$ PRINT "DATA 1";
FOR i=1 TO items-1
File File$ PRINT ", "&Data$(i,2);
NEXT i
END DEF
''
'r'
DEF ExtractHtml(HtmlFile$,Data$(,),iField$)
/* single item in HTML-text to parse:
<tr>
<td>Argentine Peso</td>
<td class='rtRates'><a href='… url …/?from=USD&to=ARS'>36.446414</a></td>
<td class='rtRates'><a href='… url …/?from=ARS&to=USD'>0.027438</a></td>
</tr>
*/
count=0
'--- Read body into a$
GOSUB ReadTableBody ' local subroutine
IF Msg$<>"" THEN RETURN 0
'--- Store HTML table-rows
p1=INSTR(a$,"<tr",1)
WHILE p1>0 AND count<update.maxcount
p2=INSTR(a$,"/tr>",p1)
first=p2
IF first>0 THEN
count+=1
Data$(count,1)=SUBSTR$(a$,p1,p2)
ENDIF
p1=INSTR(a$,"<tr",first)
END WHILE
'--- Check table-size
IF count>=update.maxcount THEN
Msg$="Data-array is too small. Increase constant 'count'."
RETURN 0
ENDIF
'--- extract valuta and value
FOR i=1 TO count
p1=INSTR(Data$(i,1),"<td>",1)+4
p2=INSTR(Data$(i,1),"<",p1)-1
Valuta$=SUBSTR$(Data$(i,1),p1,p2)
p1=INSTR(Data$(i,1),"to=USD'>",p2)+8
p2=INSTR(Data$(i,1),"</a",p1)-1
Value$= SUBSTR$(Data$(i,1),p1,p2)
Data$(i,1)=Valuta$ ! Data$(i,2)=Value$
NEXT i
RETURN 1 ' all OK
ReadTableBody: ' ------------ local subroutine
'--- Extract date from filename
DataDate$=RIGHT$(TRIM$(HtmlFile$),8)
'--- Find second table
FIELD iField$ SHOW
FIELD iField$ BACK COLOR 0,0,1
Field iField$ TEXT "Extracting second table."
FILE HtmlFile$ SETPOS 0
Msg$="Second marker """&"tbody"&""" not found."
FOR i=1 TO 2
DO
FILE HtmlFile$ READLINE Line$
IF Line$<>"" THEN p1=INSTR(Line$,"<tbody",1)
UNTIL p1>0 OR FILE_END(HtmlFile$)
IF FILE_END(HtmlFile$) THEN RETURN 'Msg$ is set
NEXT i
IF p1<1 THEN RETURN' Msg$ is preset
'--- Read table-body
a$=Line$
DO
FILE HtmlFile$ READLINE Line$
a$&=Line$
p2=INSTR(a$,"/tbody",1)
UNTIL FILE_END(HtmlFile$) OR p2>0
Msg$&=" (no end-marker)"
IF p2<1 THEN RETURN ' Msg$ is preset
Msg$=""
RETURN ' from local sub
END DEF
''
'r'
DEF MakeCurrencyHTML$(Url$,HtmlFile$,iview,iField$,Browser$)
'HtmlFile$ contains name of existing file or undated name
'returns filename if HtmlFile$ is updated
'If 'htm-file$' was not existing then name is extended with date
IF FILE_EXISTS(HtmlFile$) AND iView THEN
prompt$ ="Latest date: "
prompt$&= RIGHT$(HtmlFile$,8)
prompt$&=". Download new?"
Answer$=Input$(iField$, prompt$)
FIELD iField$ BACK COLOR 0,0,1
IF Answer$="n" THEN
NewData=0
FIELD iField$ BACK COLOR 0,0,1
Field iField$ TEXT "Reading data"
BROWSER Browser$ SHOW
BROWSER Browser$ TEXT PageContent$(HtmlFile$)
ELSE ! NewData =1
ENDIF
ELSE ! NewData =1
ENDIF
'---- Update webdata
IF NewData THEN
SPLITE HtmlFile$ TO a$,n with " "
HtmlFile$=a$(1)&" "&ISO_Date$
FIELD iField$ BACK COLOR 0,0,1
Field iField$ TEXT "Collecting data"
IF iView THEN
BROWSER Browser$ URL Url$
BROWSER Browser$ SHOW
ENDIF
ENDIF
Inspect:
'---- Continue or return
IF NOT iView THEN Download
prompt$= "Continue?"
Answer$=Input$(iField$, prompt$)
FIELD iField$ BACK COLOR 0,0,1
BROWSER Browser$ HIDE
IF Answer$="n" THEN RETURN ""
DownLoad:
FIELD iField$ BACK COLOR 0,0,1
'---- download binary contents
FIELD iField$ BACK COLOR 0,0,1
Field iField$ TEXT "Loading webpage"
IF NewData THEN
HTTP Url$ GETDIM Bin
FILE HtmlFile$ WRITEDIM Bin
ENDIF
RETURN HtmlFile$
END DEF
'r'
DEF LatestFile$(undated$) ' find latest datafile
File$=""
DIR "." LIST FILES A$,n
FOR i=1 TO n
IF INSTR(a$(i),undated$,1)=1 THEN File$=a$(i)
NEXT i
Date$=RIGHT$(File$,8)
RETURN File$
END DEF
''
'r'
DEF ISO_Date$
Date$=STR$(CURRENT_YEAR()*10000+100*CURRENT_MONTH()+CURRENT_DATE(),"########")
ISO_Date$=Date$
END DEF ' ISO_Date$
''
'r'
DEF PageContent$(file$) ' read html-content
FILE file$ SETPOS 0
content$=""
WHILE NOT FILE_END(file$)
FILE file$ READLINE line$
content$&=Line$
END WHILE
RETURN content$
END DEF
''
'r'
DEF Input$(Field$,Prompt$)
' Input from buttons
FIELD Field$ BACK COLOR 1,0,0
FIELD Field$ SHOW
FIELD Field$ TEXT Prompt$
BUTTON "yes" SHOW
BUTTON "no" SHOW
T$=""
DO
IF bp("yes") THEN T$="y"
IF bp("no") THEN T$="n"
SLOWDOWN
UNTIL T$<>""
BUTTON "yes" HIDE
BUTTON "no" HIDE
RETURN T$
END DEF
''
'r'
DEF Quicksort$(Array$(,),MaxRow,Rowsize,SortColumn)' for STRINGS
' by Dutchman
' Non-recursive version of the QuickSort algorithm
' This sortfunction operates on a 2-dimensional string-array
' Number of rows is <MaxRow> and number of columns is <RowSize>
' The variable <SortColumn> determines which column is sorted
ShowMaxStack=0 ' will display stack-usage if set to 1
MaxStackPtr=0
DIM SwapRow$(RowSize), Stack1$(30), Stack2$(30)
StackPtr=0 ! HeadPtr=1 ! TailPtr=MaxRow
Qlabel2:
IF HeadPtr>TailPtr THEN
GOTO Qlabel4
ELSE
Pivot$= CAPSTR$(Array$((HeadPtr+TailPtr)/2,SortColumn))
qa=HeadPtr ! qb=TailPtr
Qlabel1:
IF CAPSTR$(Array$(qa,SortColumn))<Pivot$ THEN ' while2
qa=qa+1
GOTO Qlabel1
END IF '1
Qlabel3:
IF CAPSTR$(Array$(qb, SortColumn))>Pivot$ THEN
qb=qb-1
GOTO Qlabel3
END IF '2
IF qa<qb THEN
' swap rows
FOR qi=1 TO RowSize
SwapRow$(qi)=Array$(qa,qi)'save row qa
Array$(qa,qi)=Array$(qb,qi)'store row qb content in row qa
Array$(qb,qi)=SwapRow$(qi)'restore content of row qa to row qb
NEXT qi
qa=qa+1
qb=qb-1
GOTO Qlabel1
END IF '3
IF qa=qb THEN
qq = qb - 1
qr = qa + 1
ELSE
qq = qb
qr = qa
END IF '4
StackPtr = StackPtr + 1
IF MaxStackPtr<StackPtr THEN
MaxStackPtr=StackPtr
END IF '5
qp=HeadPtr
qs=TailPtr
IF (qq-qp)<(qs-qr) THEN
Stack1$(StackPtr)=qr
Stack2$(StackPtr)=qs
HeadPtr=qp
TailPtr=qq
ELSE
Stack1$(StackPtr) = qp
Stack2$(StackPtr) = qq
HeadPtr = qr
TailPtr = qs
END IF '6
GOTO Qlabel2
END IF '7
Qlabel4:
IF StackPtr > 0 THEN
HeadPtr = Stack1$(StackPtr)
TailPtr = Stack2$(StackPtr)
StackPtr = StackPtr - 1
GOTO Qlabel2
END IF '8
IF ShowMaxStack THEN
PRINT "Maximum stacksize=";MaxStackPtr
END IF '9
END DEF ' QuickSort$
' end of Update Currencies code
'g'
' shortcut for button press
DEF bp(a$) = BUTTON_PRESSED(a$)
' remove scientific notation before displaying result
DEF format(form$)
WHILE LEFT$(form$,1)=" " OR LEFT$(form$,1)=","
form$=RIGHT$(form$,LEN(form$)-1)
' trim leading spaces and separators
ENDWHILE
IF INSTR (form$, ".") THEN ' if form$ has a decimal point
IF NOT numpad.curr THEN
' trim trailing zeros
WHILE RIGHT$(form$,1)="0"
form$=LEFT$(form$,LEN(form$)-1)
ENDWHILE
IF RIGHT$(form$,1)="." THEN
form$=LEFT$(form$,LEN(form$)-1)
ENDIF
ENDIF
ENDIF
END DEF
DEF pw(NAME$,title$,a$,xs,ys,ww,hh,R,G,B,ALPHA)
GRAPHICS CLEAR .9,1,1
PAGE NAME$ SET
PAGE NAME$ SHOW
PAGE NAME$ FRAME xs,ys,ww,hh
PAGE NAME$ COLOR R,G,B,ALPHA
PAGE "" HIDE
FIELD NAME$ TEXT a$ at 20*.rw,50*.rh size 360*.rw,360*.rh ML RO
FIELD NAME$ FONT SIZE 18*.rw
IF .rw<1 THEN lshift=12 ELSE lshift=0
IF title$="Settings" THEN
if .rw<1 THEN
FIELD "labels" TEXT "OFF ON" at 108*.rw,307*.rh RO
ELSE
FIELD "labels" TEXT "OFF ON" at 130*.rw,307*.rh RO
ENDIF
FIELD "labels" FONT SIZE 18*.rw
SWITCH "inter" STATE .view AT 177*.rw-lshift,310*.rh
ENDIF
FILL ALPHA 0
BUTTON "close" title "❎" AT ww-30,5 SIZE 24,24
FILL ALPHA 1
BUTTON "bottom" title "" AT -6,hh-3 SIZE ww+12,3
BUTTON "left" title "" AT 0,-6 SIZE 3,hh+12*.rh
BUTTON "right" title "" AT ww-3,-6 SIZE 3,hh+12*.rh
BUTTON "upper1" title "" AT -6,0 SIZE ww+12,3
BUTTON "upper2" title "" AT -6,30 SIZE ww+12,3
BUTTON "title" title title$ AT ww/2-50*.rw,3+lshift/2 SIZE 100*.rw,28*.rw
'
' other UI objects
'
'
END DEF
''
/*
Conversion Data
The technique I use to calculate conversions is to choose a reference measure in the middle of the range and set its value to 1. All other measures are then assigned numbers representing the ratio of their value to the reference measure's value.
*/
Categories:
DATA "Acceleration", "Angle", "Area", "Cooking", "Currency "&CurrDate$ ,"Data", "Energy", "Energy Transition", "Flow Rate", "Length", "Prefixes", "Power", "Pressure", "Speed"
DATA Tscale$, "Time", "Volume", "Weight"
Acceleration:
DATA "Centimeters Per Sec²", "Inches per Second²", "Feet per Second²", "Meters Per Second²", "Galileos", "Leos", "Gravity"
DATA .01, 0.0254, 0.304800000001219,1,.01,10,9.80664999978774
Angle:
DATA "Degrees", "Radians", "Gradians", "Minutes", "Seconds", "Circles", "Quadrants", "Points", "Mils"
DATA 1, 57.2957795128962, .9, .0166666666666667, .000277777777777778, 360, 90, 11.25, .05625
Area:
DATA "Acres", "Square Kilometers", "Hectares", "Square Meters", "Square Centimeters", "Square Miles", "Square Yards", "Square Feet", "Square Inches"
DATA 4046.85642, 1000000, 10000, 1, .0001, 2589988.110266, .8361273, .0929030, .000645159722
Cooking:
DATA "Centiliters", "Cups (CD)", "Fluid Ounces (CD)", "Liters", "Milliliters", "Pints (CD)", "Quarts (CD)", "Tablespoons", "Teaspoons"
DATA .35195,8,1,35.195079,.035195,20,40,.520421,.1734737
Data:
DATA "Bits", "Bytes", "Words", "Kilobytes", "Megabytes", "Gigabytes", "Terabytes", "Petabytes"
DATA .000125, .001, .008, 1, 1000, 1000000, 1000000000, 1000000000000
Energy:
DATA "BTU", "Calories", "Cubic Mile of Oil", "Foot Pounds", "Horsepower Per Hr", "Joules", "KiloJoules", "KiloCalories", "Kilowatt Hours", "Kilotons", "MegaJoules", "Therms (US)"
DATA 251.99576, 1, 38334721315564331336, .32404825, 641615.559278, .23900573, 239.00573, 1000, 860420.6501033, 999999974320, 239005.7299999, 25210420.65043
EnergyTransition:
DATA "Watt", "Kilowatt", "Kwh/y", "Kg/y Coal", "Kg/y Brown coal", "Kg/y Peat dry", "Kg/y Wood", "Kg/y Fat", "Kg Battery Li-Po, Li-Hv", "m² Solar panel", "Liter/y petrol", "Liter/y diesel oil", "Liter/y heating oil", "Liter/y Hydrogen 700bar", "Liter/y Alcohol", "Liter/y LNG", "Liter/y LPG", "Liter/day heating oil", "Liter/day LNG", "Liter/day LPG", "m³/y natural gas", "m³/y natural gas NL", "m³/y Hydrogen", "m³/day natural gas", "m³/day natural gas NL", "m³/day Hydrogen", "m³/day water to ice", "g/y Thorium"
DATA 1, 1000, 0.114077, 0.7465713, 0.4753213, 0.4753213, 0.4753213, 1.1724592, 0.0570386, 31.6564, 1.0837326, 1.2231602, 1.1819657, 0.2905798, 0.7415013, 0.7034755, 0.8143839, 431.713, 256.944, 297.454, 1.234251, 1.0583821, 0.5357, 450.81, 386.574, 195.664, 3865.74, 2516.6679
FlowRate:
DATA "Cubic Meters per Sec", "Cubic Meters per Min", "Cubic Meters per Hour", "Liters per Second", "Liters per Minute", "Liters per Hour", "Cubic Feet per Sec", "Cubic Feet per Minute", "Cubic Feet per Hour", "Gallons (US) per Sec", "Gallons (US) per Min", "Gallons (US) per Hour", "Gallons (US) per Day", "Gallons (UK) per Sec", "Gallons (UK) per Min", "Gallons (UK) per Hour", "Gallons (UK) per Day"
DATA 951019.38852, 15850.323142, 264.172052366667, 951.01938852, 15.850323142, 0.264172052366667, 26929.870147125, 448.83116911875, 7.48051948531251, 3600, 60, 1, .0416666666675429, 4323.41973193896, 72.0569955323167, 1.20094992556893, .0500395802310909
Length:
DATA "Ångströms","Centimeters", "Fathoms", "Feet", "Furlongs (US)", "Inches", "Kilometers", "Meters","Mils", "Miles", "Millimeters", "Nanometers", "Yards"
DATA .00000001, 1, 182.88, 30.48, 20116.8, 2.54, 100000, 100, .00254, 160934.39999, .1, .0000001, 91.44
Power:
DATA "Watts","Kilowatts", "Megawatts", "Gigawatts", "Terawatts", "KWh/year", "MegaJoule/year (MJ/y)","Horsepower (IT)", "Horsepower (Metric)", "Moosepower", "Calories per Hour", "BTU per Hour", "Foot Pounds per Hr", "Tons Refrigeration"
DATA 1,1000, 1E6, 1E9, 1E12, 1000/(365.25*24), 1E6/(365.25*24*60*60),745.69987, 756.042476, 2438.4385749, 0.0011629, 2930710000, 3766160000, 3516.8
Prefixes:
DATA "yotta", "zetta", "exa", "peta", "tera", "giga", "mega", "kilo", "hecto", "deca", "none", "deci", "centi", "milli", "micro", "nano", "pico", "femto", "atto", "zepto", "yocto"
DATA 1000000000000000000000000, 1000000000000000000000, 1000000000000000000, 1000000000000000, 1000000000000, 1000000000, 1000000, 1000, 100, 10, 1, .1, .01, .001, .000001, .000000001, .000000000001, .000000000000001, .000000000000000001, .000000000000000000001, .000000000000000000000001
Pressure:
DATA "Bars", "Millibars", "Pascals", "HectoPascals", "KiloPascals", "MegaPascals", "Atmospheres", "Pounds per Sq. Foot", "Pounds per Sq. Inch", "Inches of Water", "Inches of Mercury", "Centimeters of Water", "Centimeters of Mercury"
DATA 1000, 1, .01, 1, 10, 10000, 1013.250099, .47880258, 68.947572, 2.490889, 33.864, .98066496, 13.332283459
Speed:
DATA "Feet per Second", "Feet per Minute", "Furlongs per Fortnight", "Inches per Second", "Kilometers per Hour", "Kilometers per Sec.", "Knots", "Miles per Hour", "Miles per Second", "Speed of Light", "Speed of Sound"
DATA 1.09728, .018288, .000598715, .09144, 1, 3600, 1.8519999, 1.609349, 5793.638399, 1079252848.794, 1225.0439999
Temperatures:
DATA "Celsius [°C]", "Delisle [°D]", "Fahrenheit [°F]", "Kelvin [K]", "Newton [°N]", "Rankine [°Ra]", "Réamur [°Re]", "Rømer [°Rø]"
DATA 1,5,3,2,6,4,7,8 ' unit-pointers
Timing:
DATA "Milliseconds", "Seconds", "Minutes", "Hours", "Days", "Weeks", "Fortnights", "Months", "Years", "Leap Years"
DATA .00001666666, .01666666, 1, 60, 1440, 10080, 20160, 43800, 525600, 527040
Volume:
DATA "Cubic Centimeters", "Cubic Feet", "Cubic Inches", "Cubic Yards", "Cups (CD)", "Fluid Ounces (CD)", "Gallons (CD)", "Gallons (US)", "Liters", "Milliliters", "Pints (CD)", "Quarts (CD)"
DATA 1,28316.84659,16.3871,764554,284.130625,28.4131,4546.08999,3785.411784,1000,1,568.26125,1136.5225
Weight:
DATA "Grams", "Kilograms", "Ounces", "Ounces (troy)", "Pounds", "Grains", "Tonnes (metric)", "Tons (US short)", "Long Tons (UK)", "Stones"
DATA .0022046226, 2.2046226, .0625, .0685714, 1, 10, 2204.62262184, 2000, 2240, 14
' this routine is used when adding a new category, until its data is entered.
TBA:
DATA "To Be Added","","","","","","","","",""
DATA 1,1,1,1,1,1,1,1,1,1
