A number of functions are added in this last version. The data file can be fully maintained and viewed, some statistical info can be calculted and displyed, and the content of the whisky file can be printed, either on-line to a printer, or off-line on the screen, via a printfile.
For convenience and to be sure that all code is the recent version, i will put everything in this post.
As you will see, there is a short main program with the print function, all other coding is included using three include code files
- "whisky_functions", which contains all ("application programmers") functions
- "dictionary", which contains the dictionary ("file management") functions
- "printing" , which contains the ("low level") print functions
With the additions of "packages" like "dictionary" (or "datamine" by rBytes), "printing" and "emails", it is quite possible to build serious applications of various kind. For instance an application can be imagined for clubs, registering the members with their relevant club data, support club activities, manage the contribution billing, using the email facility, generate dunning emails for due collectable contributions, etc. Reports may be generated, the printfile of which consists of one single string, wich also may be distributed via email to selected members.
Just thinking....
First, what the output on screen looks like:
The main program with the "top level" print function:
Code: Select all
' Whisky management app (version april 30,2019)
'
url$="XXX.XXX.X.X" ' current local IP adress for printing
'
init_prog()
do slowdown
lnr=list_selected("whisky")
if lnr>0 then
key$=table$.keys$(lnr) ! display(key$)
list "whisky" select -1
end if
if bp("add") then add_brand()
if bp("edit") then replace_brand(key$)
if bp("del") then delete_brand(key$)
if bp("sort") then reorganize_array()
if bp("save") then save_array(f$)
if bp("stat") then statistics()
if bp("print")then whisky_report()
until bp("quit")
if array_changed then save_array(f$)
end
def init_prog()
option base 1
graphics ! graphics clear .8,.8,.8 ! draw color 0,0,0
table$("init","","whisky")
whisky_window("whisky","Whisky",190,20,400,500,.5,.7,.7)
set buttons custom ! set buttons font size 20
set buttons font name "Georgia-Bold" ! fill color .5,.7,.7
button "add" text "Add" at 620,50 size 120,40
button "edit" text "Replace" at 620,120 size 120,40
button "del" text "Delete" at 620,190 size 120,40
button "sort" text "Reorg" at 620,280 size 120,40
button "save" text "Save" at 620,350 size 120,40
button "stat" text "Statistics" at 20,550 size 150,40
button "print" text "Print report" at 190,550 size 150,40
button "quit" text "Quit" at 620,480 size 120,40
.array_changed=0 ! reorganize_array()
end def
def whisky_report()
dim col_head$(3),lin$(100)
rname$="Whisky collection" ' title of the report
restore to columns
for i=1 to 1 ! read col_head$(i) ! next i ' column headings
columns:
data " Code Description Age % Casks # € "
n=0
for i=1 to .Ntab
if table$.keys$(i)="" then continue
n+=1 ! l$=ft$(8,table$.keys$(i))
split table$.contents$(i) to rec$,nrec with "|"
l$ &= ft$(27,rec$(1)) & ft$(5,rec$(2)) & ft$(6,rec$(3))
l$ &= ft$(20,rec$(4)) & ft$(6,rec$(5)) & ft$(5,rec$(6))
lin$(n)=l$
next i
iprt(rname$,col_head$,58,70)
for i=1 to n ! prt(lin$(i)) ! next i
f$="prt_output" ! if file_exists(f$) then file f$ delete
file f$ print """";
file f$ print prt.t$ ' to screen via file
file f$ print """"
eprt(prt.t$) ' to printer
end def
{whisky_functions}
{dictionary}
{printing}
def db ! debug pause ! end def
def bp(a$) = button_pressed(a$)
def lines(n) ! for i=1 to n ! print ! next i ! end def
And using a very simple snippet of code to put the printfile on screen:
Code: Select all
' print a printfile on screen
'
set output font size 16
file "prt_output" input t$
print t$
end
Code: Select all
def display(key$)
field "whisky_key" text key$
cont$=table$("get",key$,"")
split cont$ to rec$,nrec with "|"
field "whisky_name" text rec$(1)
field "whisky_yrs" text rec$(2)
field "whisky_alco" text rec$(3)
field "whisky_quant" text rec$(5)
field "whisky_price" text rec$(6)
split rec$(4) to cas$,nrec with ","
for i=1 to 3 ! field "whisky_cask"&i text "" ! next i
for i=1 to nrec ! field "whisky_cask"&i text cas$(i) ! next i
end def
def add_brand()
key$=field_text$("whisky_key") ! if key$="" then return
content$ = window_content$()
table$("add",key$,content$) ! .array_changed=1
end def
def replace_brand(key$)
key$=field_text$("whisky_key") ! if key$="" then return
content$ = window_content$()
table$("replace",key$,content$) ! .array_changed=1
end def
def delete_brand(key$)
key$=field_text$("whisky_key") ! if key$="" then return
table$("del",key$,"")
end def
def whisky_window(name$,title$,xs,ys,ww,hh,R,G,B)
' **** stuff for all input forms ***
fill color R,G,B ! set buttons custom
button name$&"win" text "" at xs,ys size ww,hh
x1=xs+10 ! x2=xs+130 ! set buttons default
button name$&"title" text title$ at xs+1,ys+1 size ww-2,30
' *** application specific fields ***
n$=" Key : "
field name$ & "key" text n$ at x1,ys+40 size 150,30 RO
field name$ & "_key" text "" at x2,ys+40 size 100,30
field_refine(name$,"key") ! ys+=90
n$=" Full name : "
field name$ & "name" text n$ at x1,ys size 150,30 RO
field name$ & "_name" text "" at x2,ys size 250,30
field_refine(name$,"name") ! ys+=50
n$=" Years of riping : "
field name$ & "yrs" text n$ at x1,ys size 150,30 RO
field name$ & "_yrs" text "" at x2,ys size 100,30
field_refine(name$,"yrs") ! ys+=50
n$=" Strenght % : "
field name$ & "alco" text n$ at x1,ys size 150,30 RO
field name$ & "_alco" text "" at x2,ys size 100,30
field_refine(name$,"alco") ! ys+=50
n$=" Cask1 : "
field name$ & "cask1" text n$ at x1,ys size 150,30 RO
field name$ & "_cask1" text "" at x2,ys size 250,30
field_refine(name$,"cask1") ! ys+=50
n$=" Cask2 : "
field name$ & "cask2" text n$ at x1,ys size 150,30 RO
field name$ & "_cask2" text "" at x2,ys size 250,30
field_refine(name$,"cask2") ! ys+=50
n$=" Cask3 : "
field name$ & "cask3" text n$ at x1,ys size 150,30 RO
field name$ & "_cask3" text "" at x2,ys size 250,30
field_refine(name$,"cask3") ! ys+=50
n$=" # Bottles : "
field name$ & "quant" text n$ at x1,ys size 150,30 RO
field name$ & "_quant" text "" at x2,ys size 100,30
field_refine(name$,"quant") ! ys+=50
n$=" Price/bottle : "
field name$ & "price" text n$ at x1,ys size 150,30 RO
field name$ & "_price" text "" at x2,ys size 100,30
field_refine(name$,"price")
end def
def field_refine(a$,b$)
f$=a$&b$ ! field f$ font size 20 ! field f$ font color 1,1,0
field f$ back color .5,.7,.7 ! field f$ back alpha .2
field f$ font name "Baskerville-Italic"
f$=a$&"_"&b$ ! field f$ font size 20 ! field f$ font color 0,0,0
field f$ back color 1,1,1 ! field f$ back alpha 1
field f$ font name "Baskerville-Bold"
end def
def window_content$()
content$ = field_text$("whisky_name")
content$ &= "|" & field_text$("whisky_yrs")
content$ &= "|" & field_text$("whisky_alco")
content$ &= "|" & field_text$("whisky_cask1")
cask$=field_text$("whisky_cask2")
if cask$<>"" then content$ &= "," & cask$
cask$=field_text$("whisky_cask3")
if cask$<>"" then content$ &= "," & cask$
content$ &= "|" & field_text$("whisky_quant")
content$ &= "|" & field_text$("whisky_price")
return content$
end def
def reorganize_array()
n=0
dim key$(.Ntab),cont$(.Ntab)
for i=1 to .Ntab
k$=table$.keys$(i) ! if k$="" then continue
n+=1 ! key$(n)=k$ ! cont$(n)=table$.contents$(i)
next i
dim list$(n)
for i=1 to .Ntab
if i<=n then
list$(i)=key$(i)
table$.keys$(i)=key$(i) ! table$.contents$(i)=cont$(i)
else ! table$.keys$(i)=""
end if
next i
sort list$ as index
for i=1 to n ! key$(i)=table$.keys$(index(i)) ! next i
for i=1 to n ! table$.keys$(i)=key$(i) ! list$(i)=key$(i) ! next i
for i=1 to n ! cont$(i)=table$.contents$(index(i)) ! next i
for i=1 to n ! table$.contents$(i)=cont$(i) ! next i
for i=1 to n ! if table$.keys$(i)<>"" then break ! next i
c_list("whisky","Key's",list$,n,20,20,150,500)
end def
' id$ = object name
' cont$ = array met elementen
' size = aantal elementen in de list
'
def c_list(id$,title$,cont$(),size,xt,yt,ww,hh)
fill color .5,.7,.7 ! set buttons custom
button name$&"win" text "" at xt,yt size ww,hh
x1=xs+10 ! x2=xs+160 ! set buttons default
button name$&"title" text title$ at xt+1,yt+1 size ww-2,30
list id$ text cont$ at xt+8,yt+37 size ww-16,hh-45
end def
def statistics()
nbo=0 ! nb=0 ! nlit=0 ! nalco=0 ! nyrs=0 ! ndol=0 ! n=0
for i=1 to .Ntab
if table$.keys$(i)="" then continue
split table$.contents$(i) to rec$,nrec with "|"
n+=1 ! Q=val(rec$(5)) ! bs=floor(Q)
bo=int(Q-bs+.49) ! nb+=bs+bo ! nbo+=bo
lit=0.7*Q ! nlit+=lit ! nyrs+=lit*val(rec$(2))
nalco+=lit*val(rec$(3)) ! ndol+=Q*val(rec$(6))
next i
draw font size 28 ! draw text "Statistics" at 100,620
draw text "~~~~~~~~~~" at 100,635 ! draw font size 20
t$=n&" brands of whisky in collection" ! draw text t$ at 20,660
t$=nb&" bottles in total, from which "&nbo&" are open"
draw text t$ at 20,690
t$=nb&" bottles containing "&int(nlit)&" litres of whisky,"
draw text t$ at 20,720
t$="with an average age of "&int(nyrs/nlit)&" years,"
draw text t$ at 55,740
t$="and a average strength of "&int(nalco/nlit)&"% of alcohol."
draw text t$ at 55,760
t$="The value is €"&int(ndol)&", or €"&int(.7*ndol/nlit)&" per (full) bottle"
draw text t$ at 20,790
cpd=ndol/nlit*.03 ! cpd=int(100*cpd)/100
t$="If we take a dram as 3 cc of whisky, then one dram costs €"&cpd
draw text t$ at 20,820
end def
The "dictionary" code file:
Code: Select all
' pseudo associative array for sB (version april 21, 2019)
'
def table$(opcode$,key$,content$)
if opcode$="init" then
.f$=content$
if file_exists(.f$) then ! load_array(.f$) ! return "" ! end if
N=64 ! .Ntab=N ! dim keys$(N),contents$(N) ! return ""
end if
if opcode$="add" then
for i=1 to N
if keys$(i)=key$ then return "key exists"
next i
adr=find("")
if adr=0 then ! adr=N+1 ! N=expand() ! end if
keys$(adr)=key$ ! contents$(adr)=content$ ! return ""
end if
if opcode$="get" then
adr=find(key$) ! if adr=0 then return "not found"
return contents$(adr)
end if
if opcode$="replace" then
adr=find(key$) ! if adr=0 then return "not found"
contents$(adr)=content$ ! return ""
end if
if opcode$="del" then
adr=find(key$) ! if adr=0 then return "not found"
keys$(adr)="" ! return ""
end if
if opcode$="count" then
num=0
for i=1 to N ! if keys$(i)<>"" then num+=1 ! next i
return num
end if
if opcode$="save" then ! save_array(.f$) ! return "" ! end if
return "unknown opcode"
end def
def load_array(f$)
file f$ input .Ntab ! table$.N=.Ntab
dim table$.keys$(.Ntab),table$.contents$(.Ntab)
for i=1 to .Ntab
file f$ input table$.keys$(i),table$.contents$(i)
next i
end def
def save_array(f$)
if f$="" then return "nothing saved"
if file_exists(f$) then file f$ delete
file f$ print .Ntab
for i=1 to .Ntab
if table$.keys$(i)="" then ! file f$ print """""",""""""
else ! file f$ print table$.keys$(i),table$.contents$(i)
end if
next i
.array_changed=0
end def
def expand()
n=int(1.5*.Ntab)
dim a$(n),b$(n)
for i=1 to .Ntab
a$(i)=table$.keys$(i) ! b$(i)=table$.contents$(i)
next i
dim table$.keys$(n),table$.contents$(n)
for i=1 to .Ntab
table$.keys$(i)=a$(i) ! table$.contents$(i)=b$(i)
next i
.Ntab=n ! return n
end def
def find(k$)
for i=1 to .Ntab ! if table$.keys$(i)=k$ then break ! next i
if i<=.Ntab then return i else return 0
end def
Code: Select all
' initialisation for printing a report
' rname$ = report title, is printed on each page
' col_head$() = 0, 1 or 2 strings with colomn headers
' lpp = # of lines per page
' cpl = # of characters per line
'
def iprt(rname$,col_head$(),lpp,cpl)
ob=option_base() ! option base 1
set output font size int(1250/cpl)
' make report header
prt.rn$=date_time$() ! ld=len(prt.rn$) ! av=cpl-ld-8
lr=len(rname$)
if lr>av-4 then ! rname$=left$(rname$,av-4)! lr=av-4 ! end if
sp=(av-lr)/2
prt.rn$&=ft$(sp+lr,rname$)&ft$(sp+5,"page ")
' make columns headers
prt.header$=""
h1$=col_head$(2-ob) ! lh1=len(h1$)
h2$=col_head$(3-ob) ! lh2=len(h2$)
if lh1 then prt.header$ &= h1$ & lf$()
if lh2 then prt.header$ &= h2$ & lf$()
' underline the column headers
sp$="" ! ns=min(lh1,lh2)
for i=1 to ns
if asc(mid$(h1$,i,1))+asc(mid$(h2$,i,1))>64 then sp$&="~" else sp$&=" "
next i
if lh1>ns then
for i=ns+1 to lh1
if mid$(h1$,i,1)>" " then sp$&="~" else sp$&=" "
next i
end if
if lh2>ns then
for i=ns+1 to lh2
if mid$(h2$,i,1)>" " then sp$&="~" else sp$&=" "
next i
end if
prt.header$ &= sp$
' initialize some more values for the prt() function
prt.hfix=3+sgn(lh1)+sgn(lh2)
prt.lc=lpp+1 ! prt.lmax=lpp ! prt.page=0 ! prt.t$=""
option base ob
end def
def prt(a$)
if lc>=lmax then
page+=1 ! if page>9 then p$=page else p$="0"&page
lc=hfix
t$ &= rn$ & p$ & lf$ & lf$ & header$ & lf$
end if
lc+=1 ! t$ &= a$ & lf$
end def
def eprt(t$)
dim h$(3)
h$(1) = "content-type:text/html"
h$(2) = "content-length:"&len(t$)
HTTP .url$ HEADER h$ POST t$ ' IP adress of PC
end def
def date_time$()
dim m$(13)
restore to months
for i=1 to 12 ! read m$(i) ! next i
months:
data "january","february","march","april","may","june","july"
data "augustus","september","october","november","december"
y=current_year() ! mo=current_month() ! d=current_date()
h=current_hour() ! mi=current_minute()
if mi>9 then min$=mi else min$="0"&mi
dt$=m$(mo)&" "&d&","&y&" "&h&"."&min$&"h"
return dt$
end def
' print formatting of numbers
' n is total fieldwith, -n puts %-sign at end of number
' field starts and ends with one space
' number is right justified if smaller than fieldwith
' number is truncated if larger than fieldwidth
'
def fn$(n,x)
sp$=" "
if n<0 then p=1 else p=0 ! n=abs(n)
v$=x ! lv=len(v$) ! dp=n-lv-p-2
if dp<0 then v$=left$(v$,lv+dp)
ret$=" " ! if dp>0 then ret$&=left$(sp$,dp)
ret$&=v$ ! if p=1 then ret$&="%" ! ret$&=" "
return ret$
end def
' print formatting of texts
def ft$(n,v$)
sp$=" "
lv=len(v$) ! dp=n-lv-2
if dp<0 then v$=left$(v$,lv+dp)
ret$=" " ! if dp>0 then ret$&=left$(sp$,dp)
ret$&=v$&" "
return ret$
end def
def lf$ = chr$(13)&chr$(10)