One of the coldest starts to winter in years. 
I'm curious too. It is a "team" development now, but quite different from the IT projects i used to do as a free-lance projectleadersarossell wrote:This is all starting to look really amazing. I'm excited to see where it all leads. So much has already been accomplished. Imagine the possibilities.
Code: Select all
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$)
db(f$) ' open database f$
edit_rec("Brady")
' disp_rec()
' del_rec("Carter")
add_rec("Flintstone", "Fred Flintstone delivery 42 4400")
key_list()
page "keys" show
rec_window(400,50,240,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 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
tx$="window for viewing and editing records"
field "temp" text tx$ at 10,140 size ww-20,60 ML RO
page name$ hide
page name$ frame xs,ys,ww,hh
end def
def db(fn$) ' open database f$ (read meta data in slot 0)
'y'
n_fields=5 ' # of fields in record
''
dim f_name$(n_fields) ' test DB has staff records with 5 fields
file fn$ setpos 0
file fn$ readline db_name$,size$,prim$,free$
S_size=size$ ! N_prim=prim$ ! S_free=free$
empty_slot$="" ! for i=1 to S_size ! empty_slot$ &= " " ! next i
restore to fields
'y'
for i=0 to n_fields-1 ! read f_name$(i) ! next i
fields:
data "Name","Surname","Dept. ","Age ","Salary "
''
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.f_name$(i) & " - " & field$(i) ! next i
until forever
end def
def init_db(f$)
'y'
create_db(f$,"Test_database",50,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
{db_util}
' def create_db(fn$,db_name$,S_size,N_rec)
' 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 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$)
Code: Select all
' Create a direct access database with fixed length slots
' fn$ - filename on "disc"
' db_name$ - database name for readability
' S_size - slotsize for key + record + link fields
' N_rec - estimated max. # of records
'
def create_db(fn$,db_name$,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)
'
' init the slots in the primary area
for i=1 to N_rec
file fn$ setpos S_size*i
file fn$ writeline "","","0"
next i
db(fn$)
end def
def add_rec(key$,rec$)
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 1+adr%db.N_prim
end def
def key_list()
f$=db.fn$ ! slot=db.S_size ! nkeys=-1
file f$ setpos 999999 ! nslot=floor(file_pos(f$)/slot)
dim keys$(nslot)
for i=1 to nslot
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 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$)
