A direct access database system

[sarossell]

Sorry to see things play out this way. On the one hand, surely it's a good thing to have more than one person excited about developing an idea, but I can see how forks in development can get confusing. If you have any ideas on how to make things work more smoothly next time, please let us know. Perhaps not using something like Github for source control was a mistake(?)

[Henko]

@rbytes: i had enough time to mark my last modifications. They are in yellow. I look strongly forward to the end product!

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","4 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

' open database f$ (read meta data in slots 0 and 1


def user_edit$(rec$)
' this user function is called by edit_rec(key$)
'
' 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 piece of resistance:

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
'y'
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)
'y'
   ' write field info in slot 1
file fn$ setpos S_size
file fn$ writeline key$,header$
''
   ' init the slots in the primary area
'y'
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$
'y'
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

'y'
' 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$)
'y'
split rec$ to a$,na with " "
key$=""
for i=0 to db.N_keys-1
  key$&=" "&A$(val(db.key_index$(i)))
  next i
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
'y'
return 2+adr%(db.N_prim-1)
''
end def

def key_list()
f$=db.fn$ ! slot=db.S_size ! nkeys=-1
'y'
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
'y'
' 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$)

@ Sarussell:
It took me 2 years to decide to use dropbox after a couple of failures. I know the name "Github" and it's purpose, but i'll leave it there. Call me lazy

[rbytes]

I'm happy with how things have worked out. It has been a challenge to restrict myself to the interface, and I'm sure that it has been similarly difficult for you to code only for the engine. But keep in mind that it took me until today to post my code. Until then, even though you had some idea of the direction I was going, you had to create your own program to view the output of your engine. Maybe I should have posted my code sooner, even though it was in a rougher state.

When I look at what we've accomplished in just a few days, I am very proud of the collaboration. We should let our respective ambassadors know about this success.

I will definitely study the improvements you made in your last post and incorporate them.

I would like to see us continue development, so please let me know what I can do to make the environment more acceptable to you. Please specify what rules you would like us to adopt.

Ideas for future:

I am thinking about your comment that we may need more screen area for fields. For now, the navigation tools are always visible. But it would be easy to toggle them on and off with a button, allowing use of the right side of the screen for fields.

Another limitation is the space taken up by the keyboard. I would like to put all the fields on a page, with a button in the top half of the screen that would move the page up and down half the screen height. Why? Because on an iPad or iPhone you can't type into a field located in the lower half of the screen. This change would allow a user to type into a field anywhere on the screen.

For now, Datamine is strictly a one-database interface. Would it be more useful if it could generate multiple databases, or should that be a separate dbcreate program? Would a setup file be helpful that defines field positions and sizes?

For now, we define five fields. What if a user sees the need for an additional field, or wants to remove one that is no longer required. I could separate the control panel with buttons to control record add, edit delete and others to control field add, edit, delete if you would generate the functions for the latter.

Last thought for now. You mention a manual. Would you like to work on that? Do you want me to?

Anyway, no matter how we proceed from here, I enjoy working with you, and am always impressed by your computing skills.

I am attaching the image that is used for the interface background. You may notice that it is slightly blurred compared to the first screen shots I posted. It now recedes into the background a little more and lets text stand out better.

[rbytes]

Thanks sarossell, for the Github suggestion. I used it for a time when I was developing with Pythonista.

But I think a simpler solution might just be to rotate code postings. By that I mean that each time one of the collaborators posts their code, they wait for comments and suggestions from the other(s), and for a posting of code by the other(s) that incorporates their code changes. This would to help to clarify the next phase for each participant. Not that they can't experiment with new ideas while waiting for a response, but by waiting until their "turn" to implement them, they ensure that project moves forward in a uniform way.

[sarossell]

Well, I've said it before; I am no programmer. If your suggestion of taking turns makes sense to all involved, then by all means. My initial programming challenge was for an icon creation program. That quickly morphed into a database. I'm fine with that. Sometimes you just have to get the water moving so it can decide where it wants to go. I would just love to see a sticky post in the future for a fully functional database application and library of generic database management commands for smart BASIC for future programmers to take advantage of.

[Henko]

Yes, this is typically a single database app. The next step would be a relational database system, wich is also based on direct access files (more than one) and a number of index files with keys serving as the access method instead of hashing (in fact the ISAM, indexed sequential organization). That method is also suited for SQL techniques. But it is a lot of work.

If we work again on a project, we should work with time-slots, which should not be problematic due to the time difference of about 7 or 8 hours (western canada).

[sarossell]

Awesome! Sounds like we got that worked out easily enough.

Now, just to toss a rock in the stew, how might db_util be expanded to allow for variable length fields? Or am I trying to dry my hair with a light saber?

[rbytes]

Jjhjj

[sarossell]

Un..be..liev..able. I am learning and programming as well as I can but I take a bit of initiative to encourage the design of something that doesn't exist and I get accused of taking advantage, or worse yet, credit?! Do you have any idea how incredibly petty you sound? I didn't take credit for ANYTHING. I originally mentioned how I might write a database using arrays and Henko stepped up with all of this detail. Great! Good on ya! You two got all hot and bothered and started banging out code and I apparently had the AUDACITY to encourage you both. Excuse the hell out of me! Then he bails because of your rampant code shifting LIKE YOU OWN THE DAMN THING and now you come at me and accuse me of being some kind of code-stealing hack. You know what? Grow the hell up! YOU'RE THE PROBLEM. What are you, fourteen? I've been nothing but respectful and encouraging while I try to catch up on lost time with BASIC and try to enjoy a little social interaction with people around the world, but so far, with the exception of Mr. K, all I've run into is a bunch of whining primadonnas. You don't get to be an ass just because you're on the other side of a keyboard, comfortable in your home. I can't believe that even here I have to deal with a cowardly, immature, troll. Your comments and accusations were WAY out of line. And frankly, I agree with Henko for stepping off. YOU basically took over HIS code. Now do yourself a favor and shut the hell up. Anything else you might say, short of a heartfelt apology to me and the rest of the forum, would just be childish.

[rbytes]

Hhkjh