A direct access database system

[sarossell]

Ah, of course, mea culpa. It was such a natural fit, I gazed right past it. Sorry. Datamine; informative, clever..and apparently, for my thick skull, subtly appropriate.

[Henko]

Thanks, Henko. I will take a look at the new code tonight. I am booked for Christmas shopping at IKEA this afternoon.

Some quick responses. I agree that it is best if you handle the low-level functions. I changed the data statements to put the surname first, and then made field 0 the key, since it was now the surname. Those changes corrected the labeling. Perhaps you have already done this correction some other way.

Regarding more or fewer fields. This one is a bit tougher. If there are only a small number of fields contained in the database, I don't think it would be good esthetically to have a bunch of blank slots on screen. Also some slots, such as those containing notes, will need to be quite a bit larger, or at least taller, such as the image window. Whether all of the tools need to be on screen for manipulating the layout is a good question. There could be pop-up menu that allows for setting the field layout and linking them to data. The other alternative would be some statements near the front of the code that could be changed to allow for more or fewer on-screen fields. If this program is to have maximum flexibility in being able to maintain multiple databases, then there will need to be a data header added to each database that describes its layout - how many fields, where positioned, what data links to them, etc. but I see that as an evolution that will take some time to reach

Re Next and Previous. These buttons make sense if the records can be called up alphabetically by surname, which your sorted list does well too. A possible combination could be that Next and Previous buttons step through the names in the list sequentially by alphabet, and the pop-up list gives random access to any name without needing to type it into the search field.

The Load button I envisioned to load distinctly different databases. I didn't include a save button since saves are performed continuously. But there may need to be at least a Confirm button for layout changes.

Regarding a name for the program, I did pick a name that I thought might work well, and I used it in the screen shots I posted last night. I like something short with a bit of flair, which ideally includes a pun or dual meaning. Naming it after one or both of us as the main collaborators doesn't appeal to me as much

A good suggestion there: i will assign slotnumber 1 to store the fieldheaders in one string, making a DB file more "selfcontaining". The string will be defined and written in the db_create() function, together with the other meta-data. It will be read and decomposed in the db() function. Thereafter the headers will be available to the user as db.header$(i) with i from 0 through db.N_fields-1.
The hashing algorithm shall be modified to exclude slot 1.

Please no names of us in the program name. Hashing was not invented here. Datamine or datavault or the like is ok for me. I don't care.

You mentioned large fields like notes. I think they should have a different approach than ordinary record fields, as the method is based on fixed sized slots. If a note of 2K must be possible ,all slots must at least have that size plus the rest of the records. The same goes for pictures. Maybe one or more fields must be references to filenames. Such fields must then be recognizable as textfiles or picturefiles (or music files for that matter ). Think about it.

A layout change in an exixting DB requires a dedicated conversion program. Not too difficult, but dedicated.

I will add a check on the length of new records in the add_record() function to ensure that the length fits in the slot size.

[Henko]

Mofifications done.
The db() (open database) is now also recordlayout independent and has been moved to the include file.
Preparations have been made in the create() and db() functions to define the composition of the keys from the record contents. For instance, "2 0 1" means that the record key must consist of fields 2, 0, and 1 from the record. In the actual testDB, that would be simply "1", the key being the surname, field 1. Using this method (not yet fully implemented) would imply that adding a new record does no longer require the key as input. The function itself will generate it.
(It's time to start making a little user manual).

Code: Select all

' version 13-12-2016
'
graphics ! graphics clear .8,.8,.8
fill color .8,.8,.8 ! draw color 0,0,0
first_time=1
f$="testdb"
if first_time then init_db(f$) else db(f$)
edit_rec("Brady")
' disp_rec()
' del_rec("Carter")
add_rec("Flintstone", "Fred Flintstone delivery 42 4400") 
key_list()
page "keys" show
rec_window(340,50,300,400,.8,.8,.8,1)
page "dbrec" show
do ! slowdown
  if bp("keys_close") then page "keys" hide
  if bp("dbrec_close") then page "dbrec" hide 
until forever
end

def init_db(f$)
'y'
  h$="Name Surname Department Age Salary"
  create_db(f$,"Test_database","1",h$,60,10)
  restore to staff
  for i=0 to 8
    read rec$
    split rec$ to field$,n with " "  ' to extract the key
    key$=field$(1)
    add_rec(key$,rec$)
    next i
staff:
  data "John Friedman    sales      32  4500  "
  data " Betty Longa     ledger     28  3700"
  data " Ann Strady    sales      43  5300  "
  data "John-John Brady  production 25  3250  "
  data "   Lydia Carter  sales      36  3300 "
  data "  Peter Pan    R&D    48   4100"
  data " Reginald Nobody  production  23 3100  "
  data " Mary Poppins  sales  29  3650 "
  data " Elly Sunshine   production  32 3560 "
''
end def

def rec_window(xs,ys,ww,hh,R,G,B,alpha)
name$="dbrec"
page name$ set 
page name$ frame xs,ys,0,0
page name$ color R,G,B,alpha
button name$&"_close" title "❎" at ww-30,5 size 22,22
set buttons custom ! draw color 0,0,0
button name$&"bottom" title "" at -6,hh-3 size ww+12,3
button name$&"left" title "" at 0,-6 size 3,hh+12
button name$&"right" title "" at ww-3,-6 size 3,hh+12
button name$&"upper1" title "" at -6,0 size ww+12,3
button name$&"upper2" title "" at -6,30 size ww+12,3
d_blue() ! f_grey()
button "d_title" title "add / edit records" at(ww-190)/2,3 size 200,27
tx$="Window for viewing and editing records. Who is doing this piece of art? Can use the combined prompt+input field idea by Ton the Dutchman and some nice coloring."
field "temp" text tx$ at 10,140 size ww-20,180 ML RO
field "temp" back color .8,.8,.8
page name$ hide
page name$ frame xs,ys,ww,hh
end def

def user_edit$(rec$)
' this user function is called by edit_rec(key$)
'y'
' user code to modify the contents of rec$
''
return rec$
end def

def disp_rec(key$)    ' temporary function for test purpose
dim field$(db.N_fields)
do
  input "Surname? ": key$
  if key$="stop" or key$="Stop" or key$="" then break
  record$=get_record$(key$)
  if record$="not found" then
    print ! print record$ ! continue
    end if
  split record$ to field$,n with " "
  print
  for i=0 to n-1 ! print db.header$(i) & " - " & field$(i) ! next i
  until forever
end def

{db_util}
' def create_db(fn$,db_name$,S_size,N_rec)
' def db(fn$)
' def add_rec(key$,rec$)
' def edit_rec(key$)
' def del_rec(key$)
' def get_record$(key$)
' def get_adr(key$)
' def hash(tt$)
' def key_list()
' def nslots()
' def get_1st_free()
' def put_1st_free(adr)
' def db_dump()
' def list_window(name$,titel$,cont$(),size,xs,ys,ww,hh,R,G,B,alpha)
' def pos(adr)
' def f_grey()
' def f_yellow()
' def d_black()
' def d_blue()
' def bp(a$)

And the include file.

Code: Select all

' Create a direct access database with fixed length slots
' fn$      - filename on "disc"
' db_name$ - database name for readability
' key$     - future use (composition of the key)
' header$  - fieldnames in one string, separated by spaces
' S_size   - slotsize for key + record + link fields
' N_rec    - estimated max. # of records

' version 13-12-2016
'
' create_db(f$,"Test_database","1",h$,50,10)
def create_db(fn$,db_name$,key$,header$,S_size,N_rec)
N_prim=N_rec          ' # of slots in primary area
S_free=N_rec+1        ' initial first free slot
'
dim slot(S_size)
if file_exists(fn$) then file fn$ delete
'
   ' create space for the database
for i=0 to N_prim ! file fn$ writedim slot ! next i
'
   ' write slot number 0 with meta data
file fn$ setpos 0
file fn$ writeline db_name$,str$(S_size),str$(N_prim),str$(S_free)
'
   ' write field info in slot 1
file fn$ setpos S_size
file fn$ writeline key$,header$
'
   ' init the slots in the primary area
for i=2 to N_rec
  file fn$ setpos S_size*i
  file fn$ writeline "","","0"
  next i
db(fn$)
end def

' open database fn$
'
def db(fn$)
file fn$ setpos 0 ! file fn$ readline db_name$,size$,prim$,free$
S_size=size$ ! N_prim=prim$ ! S_free=free$
pos(1) ! file fn$ readline k$,h$
empty_slot$="" ! for i=1 to S_size ! empty_slot$ &= " " ! next i
split h$ to header$,N_fields with " "
split k$ to key_index$,N_keys with " "
end def

' add record to database
' returns slotnumber if succesfully added
' returns -1 if key is already in use
' returns -2 if key+record+link is too long
'
def add_rec(key$,rec$)
ls=len(key$)+len(rec$)+len(db.free$)
if ls>db.S_size then return -2  ' length larger than slotsize
adr=get_adr(key$)
if adr>0 then return -1    ' record with same key already present
if adr<0 then              ' free slot in primary area
  adr=-adr
  pos(adr)  ! file db.fn$ writeline key$,rec$,"0"
  return adr
  end if
new=hash(key$)
pos(new)    ! file db.fn$ readline aux$,trec$,link$
rec_to=get_1st_free()
pos(rec_to) ! file db.fn$ writeline db.empty_slot$
pos(rec_to) ! file db.fn$ writeline key$,rec$,link$
pos(new)    ! file db.fn$ writeline aux$,trec$,str$(rec_to)
put_1st_free(rec_to+1)
end def

def edit_rec(key$)
adr=get_adr(key$)
if adr>0 then
  pos(adr) ! file db.fn$ readline key$,rec$,link$
  rec$=user_edit$(rec$)   ' user function to edit fields in rec$
  pos(adr) ! file db.fn$ writeline key$,rec$,link$
  end if
end def

def del_rec(key$)
prd_adr=hash(key$)
pos(prd_adr) ! file db.fn$ readline prd_key$,prd_rec$,prd_link$
if prd_key$=key$ then
  suc_adr=val(prd_link$)
  if suc_adr=0 then
    pos(prd_adr) ! file db.fn$ writeline "","","0"
    return 0
    end if
  pos(suc_adr) ! file db.fn$ readline suc_key$,suc_rec$,suc_link$
  pos(prd_adr) ! file db.fn$ writeline suc_key$,suc_rec$,suc_link$
  pos(suc_adr) ! file db.fn$ writeline "","","0"
  return 1
  end if
do
  suc_adr=val(prd_link$)
  pos(suc_adr) ! file db.fn$ readline suc_key$,suc_rec$,suc_link$
  if suc_key$=key$ then
    prd_link$=suc_link$
    pos(prd_adr) ! file db.fn$ writeline prd_key$,prd_rec$,prd_link$
    pos(suc_adr) ! file db.fn$ writeline "","","0"
    return 1
    end if
  prd_adr=suc_adr
  pos(prd_adr) ! file db.fn$ readline prd_key$,prd_rec$,prd_link$
  until suc_link$="0"
return 0
end def

' retrieve record with key <key$> from the DB
' returns <not found> if not found
'
def get_record$(key$)
slot=get_adr(key$)
if slot>0 then 
  pos(slot) ! file db.fn$ readline t$,rec$,t$
  return rec$
  else
  return "not found"
  end if
end def

' find adress of record with given key
' key$ - the key on which to search
' function returns one of 3 values:
' adr > 0 : record found in slot <adr>    (update or delete record)
' adr = 0 : no record found with that key  (error key or add new record)
' adr < 0 : not found, but slot <abs(adr)> is free (add new record)
'
def get_adr(key$)
adr=hash(key$)
while adr>0
  pos(adr) ! file db.fn$ readline aux$,rec$,link$
  if aux$=key$ then return adr
  if aux$="" then return -adr
  adr=val(link$)
  end while
return 0
end def

' transform key tt$ into a DB adress (slotnumber)
'
def hash(tt$)
nt=len(tt$) ! adr=1
for i=0 to nt-1 ! adr+=asc(mid$(tt$,i,1))-32 ! adr*=7 ! next i
return 2+adr%(db.N_prim-1)
end def

def key_list()
f$=db.fn$ ! slot=db.S_size ! nkeys=-1
N_slot=nslots()
dim keys$(N_slot)
for i=2 to N_slot
pos(i) ! file f$ readline key$,t$,t$
if key$<>"" then ! nkeys+=1 ! keys$(nkeys)=key$ ! end if
next i
list_window("keys","Record keys",keys$,nkeys,50,50,180,500,.8,.8,.8,1)
end def

' returns the actual number of slots in the DB (inclusive overflow)
'
def nslots()
file db.fn$ setpos 999999
return floor(file_pos(db.fn$)/db.S_size)
end def

' returns the adress of the first free slot
'
def get_1st_free()
pos(0) ! file db.fn$ readline t$,t$,t$,t$
return val(t$)
end def

' edits the adress of the first free slot
'
def put_1st_free(adr)
pos(0) ! file db.fn$ readline  t1$,t2$,t3$,t4$
pos(0) ! file db.fn$ writeline t1$,t2$,t3$,str$(adr)
return
end def

def db_dump()
print
f$=db.fn$ ! slot=db.S_size
file f$ setpos 999999 ! nslot=floor(file_pos(f$)/slot)
for i=1 to nslot
pos(i) ! file f$ readline key$,rec$,link$
if key$<>"" then print i;"  ";key$;"  ";rec$;"  ";link$
next i
end def

def list_window(name$,titel$,cont$(),size,xs,ys,ww,hh,R,G,B,alpha)
dim temp$(size+1)
for i=0 to size ! temp$(i)=cont$(i) ! next i
sort temp$
page name$ set 
page name$ frame xs,ys,0,0
page name$ color R,G,B,alpha
set buttons custom ! d_black() ! f_grey()
button name$&"_close" title "❎" at ww-30,5 size 22,22
button name$&"bottom" title "" at -6,hh-3 size ww+12,3
button name$&"left" title "" at 0,-6 size 3,hh+12
button name$&"right" title "" at ww-3,-6 size 3,hh+12
button name$&"upper1" title "" at -6,0 size ww+12,3
button name$&"upper2" title "" at -6,30 size ww+12,3
button name$&"title" title titel$ at 20,3 size ww-60,27
set lists custom
list name$ text temp$ at 2,32 size ww-4,hh-34
page name$ hide
page name$ frame xs,ys,ww,hh
end def

def pos(adr)
file db.fn$ setpos adr*db.S_size
end def

def f_grey() ! fill color .8,.8,.8 ! end def
def f_yellow() ! fill color 1,1,.7 ! end def
def d_black() ! draw color 0,0,0 ! end def
def d_blue() ! draw color 0,0,1 ! end def
def bp(a$) = button_pressed(a$)

[rbytes]

Dgh

[sarossell]

Exciting to see this coming about. I had to comment out the background jpg load since I don't have the image of course, but very cool.

[sarossell]

Exciting to see this coming about. I had to comment out the background jpg load since I don't have the image of course, but very cool.

[Henko]

Ahh, this is definitly not going to work. This afternoon i completed the the flexible key mechanism, and we are left with two versions of the program now.
I will post my last version and indicate where i made modifications in yellow. You can then implement the key mechanism in your version and go on with it. The backbone is then completed, and most of the work remaining is the user interface. You're better in that than me. I refert to the wave&sound project (operator is still waiting.. ), but if you encounter any problem, i'll try to be of assistence.

I will post the stuff tomorrow, because marking what i have modified takes some time and it is my bridge evening

[sarossell]

I am very grateful for all of your hard work. Just a few short days ago smart BASIC didn't have a working database solution. Thank you so much for such a vital contribution. I've learned quite a bit from your work.

[Henko]

Here's an example where the combination Salary + Surname is chosen as key (in that order).
Just by providing an addition parameter "4 1" to the db_create() function.

IMG_1322.PNG (366.98 KiB) Viewed 5885 times

[Henko]

I am very grateful for all of your hard work. Just a few short days ago smart BASIC didn't have a working database solution. Thank you so much for such a vital contribution. I've learned quite a bit from your work.

It has been fun. Next time when we do some project together, better rules must be agreed upon. And i'm not leaving the forum