iConvert 4 Beta

Post Reply
User avatar
rbytes
Posts: 1798
Joined: Sun May 31, 2015 12:11 am
My devices: iPhone X
iPad 4
Dell Inspiron laptop
CHUWI Plus 10 convertible Windows/Android tablet
Location: Calgary, Canada
Flag: Canada
Contact:

iConvert 4 Beta

Post by rbytes » Sat Nov 10, 2018 9:32 pm

Ton, I hoped that you would have received my private message by now, but it seems you didn't get a notification email from the Forum. The message included the code of the integrated version of iConvert and Update Currencies that I have been using.
I will just post here.

4 Beta has been tested and tweaked for both iPhone and iPad. It uses the code from Update Currencies 2.2. The only changes I made were to harmonize it with iConvert in functionality and look. To do this, I stayed in GRAPHICS mode throughout the update, and created two fields to show progress or error messages, rather than print them in TEXT mode. Field "info" shows the messages, and field "infob" appears behind it filled with black, to create the black border. All of the code related to Update Currencies is located within Functions and Subroutines, starts with a label named Update: and is highlighted in yellow (except for a few lines in the middle of it that were already highlighted in green).

During integration I changed the format of Datestring to YYMMDDHHMM, so I could test that updates were actually rewriting currencies.data. Change it back if you wish.

I saw today that you posted an alternate version of Update Currencies designed to be embedded in iConvert. That would mean rewriting a lot of code, since I already have V2.2 embedded. If you have made any changes to that version, perhaps you could also make them in iConvert 4 Beta.

Please give everything a test run. If it meets your approval, we can remove the Beta label and make it version 4. If not, please correct any issues you find and/or let me know what I should change. One thing I haven't tested 4 Beta for is a correct "exit on error" response if any problems occur during currency conversion. As an example, my server lost its internet connection the other day, which caused unexpected behavior of the update. It might be advisable to create an error trap that posts an error message and returns to the main loop if the currency website doesn't respond to a PING.

I notice that when I press the Update button when view=1, I don't get the prompt that shows the date of the last update and asks the user to Continue Y/N? The code exists, but for some reason it is not executed. As a check, I ran iConvert 3.6 and called for an update. Update Currencies 2.2.sb also skipped that query. So it must be something in the Update Currencies logic, which I will leave for you to examine. If you want me to add a switch in Settings that will activate that query, I will do that.

I am also including here the two GIF animations that are needed for the program.
iconvert3.GIF
iconvert3.GIF (222.71 KiB) Viewed 52 times
loader.GIF
loader.GIF (75.22 KiB) Viewed 52 times

Code: Select all

/*
iConvert 4 Beta
by rbytes and Dutchman, October 2018
Converts measurements in many categories.
A collaborative international project.

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

'r'  conversion constants  
KwhPerYear=1000/(365.25*24)
MJperYear=1E6/(365.25*24*60*60)
''
' 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 update
  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://kibernetik.pro/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 "viewstate" DELETE
  FILE "viewstate" 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'
Update:

' Update Currencies by Dutchman, October 2018

'==== Presets ====
GRAPHICS CLEAR .9,1,1
SET BROWSERS SCALED
PAGE "update" SET
PAGE "update" SHOW
PAGE "" HIDE
V$="anim"

If view then
  a$="Follow the prompts at screen top"
ELSE
  a$="  Updating currency data ..."
ENDIF
IF rw<1 THEN lshift=12 ELSE lshift=0

B$="loader.GIF"
IF FILE_EXISTS(B$) THEN
  SPRITE V$ LOAD B$
  SPRITE V$ AT sw/2.8-lshift*4,sh/3 scale 1*rw
  SPRITE V$ SHOW
  SPRITE V$ DELAY .05
  SPRITE V$ PLAY
ENDIF


' field to create black background behind FIELD "info"

FIELD "infob" TEXT "" AT sw/2-180*rw-3,sw/6-2 SIZE 350*rw+6,43*rw+3 ML RO
FIELD "infob" BACK COLOR 0,0,0


' information field

FIELD "info" TEXT a$ AT sw/2-180*rw,sw/6 SIZE 350*rw,40*rw ML RO
FIELD "info" FONT SIZE 20*rw
PAUSE 2
Test=0  ' don't ask
'
'==== Constants ======
Source$="https://www.x-rates.com/table/?from=USD&amount=1"
Count=100 ' max number of currencies
Top=(sh/30)*(1/rw) ' top space
Top$="In" ' Field for input
WebPage$="currencies.html" ' undated webpage filename

'==== Output variables
DIM Data$(count,2) ' array for extracted data
DataFile$="currencies.data" ' file with DATA-lines
'
'==== Main ====
Msg$="" ' message on exit
'
'--- Select and store source
GOSUB StoreSource
'
'---- Extract data from HTML-text
IF view THEN
  FIELD "infob" TEXT ""
  FIELD "info" TEXT " Extracting first table ..."
  FIELD "infob" SHOW
  FIELD "info" SHOW
  PAUSE 2
  FIELD "infob" HIDE
  FIELD "info" HIDE
ENDIF
ExtractData: ' from file
GOSUB ReadTableBody ' store HTML-table in 'Body$'
Msg$=""
CALL Extract(p1,p2, Body$)
IF Msg$<>"" THEN GOSUB Finish
'
'--- Sort and write to data-file
CALL SortAndStore(DataFile$,Data$,Extract.count)
GOSUB FINISH
IF view THEN
  FIELD "info" DELETE
  FIELD "infob" DELETE
ENDIF

' SHOW interface of main page

PAGE "update" HIDE
PAGE "" SET
PAGE "" SHOW
GRAPHICS CLEAR .9,1,1

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
RETURN

'========== Subroutines and Functions For Update Currencies ===========
Finish:
BROWSER "a" DELETE
IF view THEN
  FIELD "info" TEXT Msg$
  FIELD "infob" SHOW
  FIELD "info" SHOW
  PAUSE 2
ENDIF
FIELD top$ DELETE
RETURN
'
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 "currencies="&items&" ' items in Currencies"
FILE File$ PRINT "CurrDate$="""&.DataDate$&""" ' 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
File File$ SETPOS 0
.Msg$="Data written to """&File$&""""
END DEF
'
DEF Extract(first,last,a$)
'g'/* single item in HTML-text to parse:
<tr>
<td>Argentine Peso</td>
<td class='rtRates'><a href='… url …/?from=USD&amp;to=ARS'>36.446414</a></td>
<td class='rtRates'><a href='… url …/?from=ARS&amp;to=USD'>0.027438</a></td> 
</tr>*/
'y'
count=0
'--- Store HTML table-rows
p1=INSTR(a$,"<tr",first)
WHILE p1>0 AND count<.count
 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>=.count THEN
  FIELD "infob" TEXT ""
  FIELD "info" TEXT " Data-array is too small. Increase constant 'count'"
  FIELD "infob" SHOW
  FIELD "info" SHOW
  PAUSE 2
  FIELD "infob" HIDE
  FIELD "info" HIDE
  RETURN
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
END DEF
'
ReadTableBody:
'--- Extract date from filename
year$=CURRENT_YEAR()
year$=RIGHT$(year$,2)
hour$=CURRENT_HOUR()
if val(hour$)<10 then hour$="0"&hour$
min$=CURRENT_MINUTE()
if val(min$)<10 then min$="0"&min$
DataDate$=year$&RIGHT$(TRIM$(web$),4)&hour$&min$     ' YYMMDDHHMM
'--- Find second table
IF view THEN
  FIELD "infob" TEXT ""
  FIELD "info" TEXT " Extracting second table ..."
  FIELD "infob" SHOW
  FIELD "info" SHOW
  PAUSE 2
  FIELD "infob" HIDE
  FIELD "info" HIDE
ENDIF
FILE Web$ SETPOS 0
Msg$="Second marker """&"tbody"&""" not found."
FOR i=1 TO 2
  DO
    FILE Web$ READLINE Line$
    IF Line$<>"" THEN p1=INSTR(Line$,"<tbody",1)
  UNTIL p1>0 OR FILE_END(Web$)
  IF FILE_END(web$) THEN GOSUB Finish ' Msg$ is preset
NEXT i
IF p1<1  THEN GOSUB Finish ' Msg$ is preset
'--- Read table-body
Body$=Line$
DO
  FILE web$ READLINE Line$
  Body$&=Line$
  p2=INSTR(Body$,"/tbody",1)
UNTIL FILE_END(web$) OR p2>0
Msg$&=" (no end-marker)"
IF p2<1 THEN GOSUB Finish ' Msg$ is preset
RETURN

StoreSource:
IF view then shift=0 else shift=sh  ' move browser off screen if view=0
BROWSER "a" AT 0,top-shift SIZE sw,sh-top
BROWSER "a" HIDE
Update=1
web$=LatestFile$(webpage$)
IF web$<>"" THEN
  IF Test THEN RETURN
  debug pause
  prompt$ ="Latest date: "
  prompt$&= LatestFile$.date$
  prompt$&=". Download new? (Y/N)"
  IF view=1 THEN
    DO 
      Answer$=TRIM$(LOWSTR$(Input$(0,0,sw,top,top$, prompt$)))
    UNTIL Answer$="y" OR Answer$="n"
  ELSE
    Answer$="y"
  ENDIF
  
  FIELD top$ DELETE
  IF Answer$="n" OR Test THEN
    Update=0
    FIELD "infob" TEXT ""
    Field "info" TEXT " Reading data ..."
    PAUSE 2
    BROWSER "a" SHOW
    BROWSER "a" TEXT PageContent$(web$)
  ELSE
    Update=1
 ENDIF
ENDIF

'----  Update webdata
IF Update THEN
  web$=webpage$&" "&ISO_date$
IF view THEN
  FIELD "infob" TEXT ""
  FIELD "info" TEXT " Loading webpage ..."
  FIELD "infob" SHOW
  FIELD "info" SHOW
  PAUSE 2
endif
  BROWSER "a" SHOW
  BROWSER "a" URL Source$
  if view then FIELD "info" TEXT " Webpage loaded ..."
ENDIF

Inspect:
  '---- Continue or stop
IF view THEN
  DO
    prompt$= "Continue? (Y/N)"
    Answer$=TRIM$(LOWSTR$(Input$(0,0,sw,top,top$, prompt$)))
  UNTIL Answer$="y" OR Answer$="n"
ELSE
  Answer$="y"
ENDIF

IF Answer$="n" THEN GOSUB Finish
FIELD top$ DELETE
'---- download binary contents
IF view THEN
  
  FIELD "infob" TEXT ""
  FIELD "info" TEXT " Scanning webpage ..."
  FIELD "infob" SHOW
  FIELD "info" SHOW
  PAUSE 2
  FIELD "infob" HIDE
  FIELD "info" HIDE
ENDIF

IF Update THEN
  HTTP Source$ GETDIM Bin
  FILE Web$ WRITEDIM Bin
ENDIF
RETURN

DEF LatestFile$(undated$) ' find latest datafile
File$=""
DIR "." LIST FILES A$,n
FOR i=1 TO n
  IF INSTR(a$(i),undated$,1)>0 THEN File$=a$(i)
NEXT i
Date$=RIGHT$(File$,8)
RETURN File$
END DEF

DEF ISO_Date$
Date$=STR$(CURRENT_YEAR()*10000+100*CURRENT_MONTH()+CURRENT_DATE(),"########")
ISO_Date$=Date$
END DEF ' ISO_Date$
'
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
'
DEF Input$(x,y,w,h,Field$,Prompt$)
' Inline input by Dutchman
GOSUB Init 'local subroutine
DO
 IF FIELD_CURSOR_POS(Field$)<prompt THEN FIELD Field$ TEXT Prompt$
 SLOWDOWN
UNTIL FIELD_CHANGED(Field$)
Txt$=FIELD_TEXT$(Field$)
T$=RIGHT$(Txt$,LEN(Txt$)-prompt)
RETURN T$

Init: ' local subroutine
FIELD Field$ AT x,y SIZE w,h
FIELD Field$ BACK COLOR 0,0,1
FIELD Field$ FONT NAME "Menlo"
FIELD Field$ FONT COLOR 1,1,0
FIELD Field$ FONT SIZE h-6
FIELD Field$ SELECT
prompt=LEN(Prompt$)
RETURN ' from subroutine
END DEF
'
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, KwhPerYear,MJperYear,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

The screen shots below are both from iPad. The second shot simulates an iPhone display on an iPad.
Attachments
7E88364C-EAAC-48A9-B321-22AE4A4AD57A.png
7E88364C-EAAC-48A9-B321-22AE4A4AD57A.png (263.79 KiB) Viewed 51 times
95E7A89B-7FC0-4D62-A657-09D452CBC81B.png
95E7A89B-7FC0-4D62-A657-09D452CBC81B.png (124.5 KiB) Viewed 51 times
####### Living the colorful life #######

Post Reply