Support Forum / Форум поддержки

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

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

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)

Code: Select all

' Whiskey Management (version april 26,2019)
' by Henko
' a couple of added features by rbytes, May 2019:
'   Prev (previous) button and Next button can step through the entries
'   The first entry loads on launch
'   Tap the image to enlarge it to full screen, tap it again to shrink it

url$="XXX.XXX.X.X"    ' current local IP adress for printing
'
OPTION SPRITE POS CENTRAL
SET TOOLBAR OFF
init_prog()
lnr=1
sel=lnr
gosub nav
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()
  if bp("del")  then delete_brand(key$)
  if bp("sort") then reorganize_array()
  if bp("prev") then gosub goprev
  if bp("next") then gosub gonext
  if bp("save") then save_array(f$)
  if bp("stat") then statistics()
  if bp("print")then whisky_report()
  if bp("bag")  then ! v=0.3-v ! music .bag$ volume v ! end if
  get touch 0 as tx,ty
  if lg=1 then
    if SPRITE_HIT ("large", tx,ty) then
      SPRITE "large" DELETE
      page "" set
      page "" show
      page "large" hide
      lg=0
      display(key$)
    endif
  else
  if tx>570 and ty>570 then
    page "large" set
    page "large" show
    page "" hide
    graphics clear .8,.8,.8
    SPRITE "large" load display.im$
    SPRITE "large" at sw/2,sh/2 scale .6
    SPRITE "large" show
    lg=1
  endif
  endif
  until bp("quit")
if array_changed then save_array(f$)
end

nav:
  key$=table$.keys$(lnr) ! display(key$)
return

goprev:
  if sel>1 then
    sel-=1
    lnr=sel
    gosub nav
  endif
return

gonext:
  if sel<c_list.size-1 then
    sel+=1
    lnr=sel
    gosub nav
  endif
return

def init_prog()
option base 1
get screen size .sw,.sh
graphics ! graphics clear .8,.8,.8 ! draw color 0,0,0
table$("init","","whisky_data")
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,20 size 120,40
button "edit" text "Replace" at 620,85 size 120,40
button "del" text "Delete" at 620,150 size 120,40
button "sort" text "Reorg" at 620,215 size 120,40
button "save" text "Save" at 620,280 size 120,40
button "prev" text "Prev" at 620,345 size 120,40
button "next" text "Next" at 620,410 size 120,40
button "quit" text "Quit" at 620,475 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 "bag" text "Bagpipe on/off" at 360,550 size 180,40
button "quit" text "Quit" at 620,480 size 120,40
.array_changed=0 ! reorganize_array()
music .bag$ load "balladofglencoe.mp3" ! .v=.3
music .bag$ loop ! music .bag$ volume .v
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