1. Budget Builder
- Posted by Senator Oct 01, 2020
- 1667 views
Forked from Re: Novice Level Project - simple, fun and useful
For better or worse I have decided to post the code for my little budget program. Note from the link above that there are significant bugs. I hope that by posting the code I/we can fix those bugs in short order.
There are seven files: register.ex, register.e, db_tools.e, reg_graphics.e, get_datetime.e, xbackup.e, and register.prj. Plus the database file, check_register.edb.
I will probably have to make a series of post. So, I'll post the smallest file here: register.prj is a file used by xbackup for "batch" file backup operations - it consists of a simple listing of files in the directory which you want to back up, either automatically, or from a selected menu option.
file name: register.prj
register.ex register.e db_tools.e reg_graphics.e get_datetime.e xbackup.e register.prj check_register.edb
2. Re: Budget Builder
- Posted by Senator Oct 01, 2020
- 1683 views
-- xbackup.e -- Kenneth Rhodes -- backup current file, current directory, or a list of files saved to a text file -- with the file extension "prj" -"wee.prj", for example. Creates directory -- "Archive" in current directory. All files in current directory will be copied -- to a subdirectory named with a timestamp, "dt". -- All files listed in a text file with the extension "prj" -- will be copied to a subdirectory labeled "filename.prj" -- in a subdirectory labeled with a timestamp, "dt". -- backupfiles("backup.e") "backup.e" copied to /home/kenneth/wee/Archive/backup.e/dt -- backupfiles() current directory files placed in /home/kenneth/wee/Archive/dt -- backupfiles("wee.prj") "wee.prj" files > /home/kenneth/wee/Archive/wee.prj/dt include std/filesys.e include std/sequence.e include std/text.e include std/error.e include std/console.e include std/sort.e include std/io.e enum PATH, FILES object TMP = {{},{}}, files={} sequence today, dt global object BACKUPDIR, sourceDir="", brd={--"brd" stands for backup, replace, delete. 0, -- integer flag for operation sucess or failure: 0 = failure, 1 = sucess "", "" -- place holders for sequences msg and backup directory } function load_directory_files(sequence path) -- load files from directory, path, into sequence files -- returns a sequence of file names with an absolute path object file = "" TMP[PATH] = path & SLASH TMP[FILES] = dir(path) if not atom(TMP[FILES])then if length(TMP[FILES]) >=3 then for x = 3 to length(TMP[FILES]) do if not equal(TMP[FILES][x][D_ATTRIBUTES], "d") then file = TMP[PATH] & TMP[FILES][x][D_NAME] files = append(files,canonical_path(file)) end if end for end if end if return sort(files) end function global function backupfiles(sequence file_or_list = "") sequence msg ="", MS= "\n\tThe original source code file: \"%s\","\n\thas been archived in:\n\"%s\"\n\n" integer BCF = 0 -- switch: 1 = Backup Current FILE if equal(file_or_list, "") then--backup all the files in the current directory files=load_directory_files(sourceDir) BACKUPDIR=sourceDir &SLASH &"Archive" elsif equal("prj", fileext(file_or_list)) then -- backup("myprog.prj") --backup files listed in files with "prj" file extension BACKUPDIR=dirname(file_or_list) & SLASH & "Archive" sourceDir=dirname(file_or_list) BACKUPDIR=BACKUPDIR & SLASH & filebase(file_or_list) &"."& fileext(file_or_list) files=read_lines(file_or_list) else --Backup the current file BACKUPDIR=dirname(file_or_list)& SLASH & "Archive" BACKUPDIR=BACKUPDIR&SLASH&filebase(file_or_list)&"."&fileext(file_or_list) BCF=1 files=file_or_list end if if not atom(files) then if file_exists(BACKUPDIR) or create_directory(BACKUPDIR) then end if today=date() dt=sprintf("%04d:",today[1]+1900) & -- year sprintf("%02d:",today[2]) & -- month sprintf("%02d:",today[3])& -- day sprintf("%02d:",today[4])& -- hour sprintf("%02d",today[5]) -- minute BACKUPDIR=BACKUPDIR &SLASH& dt if file_exists(BACKUPDIR) or create_directory(BACKUPDIR) then if BCF then --Backup Current File:backupfiles("wee.exw") if copy_file(file_or_list,BACKUPDIR,1) then msg &= sprintf(MS,{file_or_list,BACKUPDIR}) brd={1,msg,BACKUPDIR} end if else-- backup all files in the current directory: backupfiles(), -- or backup files listed in "*.prj file:backupfiles("wee.prj") for x=1 to length(files) do printf(1,"%s\n",{files[x]}) if not absolute_path(sprintf("%s",{files[x]})) then if copy_file( sourceDir&SLASH& files[x],BACKUPDIR,1) then msg &= sprintf(MS,{files[x],BACKUPDIR}) brd={1,msg,BACKUPDIR} end if else -- files[x], is an absolute path if copy_file(sprintf("%s",{files[x]}),BACKUPDIR,1) then msg &= sprintf(MS,{files[x],BACKUPDIR}) brd={1,msg,BACKUPDIR} end if end if end for end if else msg &=sprintf("\nBackup operation failed! Failed to create %s\n"{BACKUPDIR}) brd={0,msg,BACKUPDIR} end if else msg &= "\nBackup operation failed!\n" brd={0, msg, BACKUPDIR} end if return brd end function
Regards, Ken
3. Re: Budget Builder
- Posted by Senator Oct 01, 2020
- 1679 views
-- -- get_datetime.e v3 -- Kenneth Rhodes -- include std/console.e include std/datetime.e -- -- ymd(Y) returns current year -- ymd(M) returns current month -- ymd(D) returns current day -- enum Y,M,D function ymd(integer ymd) sequence tmp = now() if ymd<Y or ymd>D then return 0 end if return tmp[ymd] end function -- overides std/datetime.e new() function -- defaults to current year,month, day: -- {Y,M,D,0,0,0} instead of {0,0,0,0,0,0} -- as defined in std/datetime.e function new(integer year=ymd(Y), integer month=ymd(M), integer day=ymd(D), integer hour=0, integer minute=0, atom second=0) return {year,month,day,hour,minute,second} end function constant MENU = { -- accessor "\t\t Enter Year: #: ", --1 YEAR "\t\t Enter Month: #: ", --2 MONTH "\t\t Enter Day: #: ", --3 DAY "\t\t Enter Hour: #: ", --4 HOUR "\t\t Enter Minute: #: ", --5 MINUTE "\t\t Enter Seconds: #: " --6 SECOND } public constant USE_MENU = 1, NO_MENU = 0 public function get_datetime(integer Max_Accessor=SECOND,integer menu=NO_MENU,sequence yr={}) sequence r -- range for prompt_number datetime dtnow = now(), -- {Y,M,D,H,M,S} dt = new() -- {Y,M,D,0,0,0} if not(menu) then -- auto entry datetime data returned from now() function if Max_Accessor=SECOND then dt=now() -- {Y,M,D,H,M,S} elsif Max_Accessor=HOUR then dt[HOUR]=dtnow[HOUR] -- {Y,M,D,H,0,0} elsif Max_Accessor=MINUTE then dt[HOUR]=dtnow[HOUR] dt[MINUTE]=dtnow[MINUTE]-- {Y,M,D,H,M,0} end if return dt elsif USE_MENU then -- enter datetime data: y/m/d/hr using MENU for i = 1 to Max_Accessor do switch i do case YEAR then r = yr case MONTH then r = {1,12} case DAY then r = {1,31} case HOUR then r = {0,23} case MINUTE then r = {0,59} case SECOND then r = {0,60} case else return 0 end switch dt[i] = prompt_number(MENU[i],r) -- overwrites default dt values end for end if return dt end function constant DT_MENU = sprintf("%s", { """ Set Date/Time 0 = Auto entry of current date/time data from system 1 = Manual Entry of date/time data #: """ }) include std/types.e -- choose auto or manual entry of datetime data from menu public function dt_menu(integer MAX_ACCESSOR=SECOND) datetime dt integer m = prompt_number(DT_MENU,{NO_MENU, USE_MENU}) if m then dt=get_datetime(MAX_ACCESSOR, USE_MENU) else dt=get_datetime(MAX_ACCESSOR, NO_MENU) end if return dt end function
Regards, Ken
4. Re: Budget Builder
- Posted by Senator Oct 01, 2020
- 1663 views
-- -- reg_graphics.e ---- Kenneth Rhodes -- public include std/graphics.e ------------------------------------------------------------ -- background foreground hilite menu public constant BGC = WHITE, FGC = BLUE, HLC = YELLOW, MC = BROWN public color foreground public color background public procedure set_background_color(color c) -- use set_background_color(color c) -- instead of bk_color(x) bk_color(c) background = c end procedure public procedure set_text_color(color c ) --use set_text_color instead of text_color(x) --foreground will always be available --for highlight(), or any other purpose text_color(c) foreground = c end procedure public procedure set_foreground_color(color c) set_text_color(c) end procedure public function hilite(sequence text, color hicolor = RED, integer new_line = 0) -- default no new line sequence rc text_color(hicolor) display("[]",{text},new_line) set_foreground_color(foreground) rc=get_position() return {rc[1], rc[2]} end function
Regards, Ken
5. Re: Budget Builder file: dbtools.e edit 1
- Posted by Senator Oct 01, 2020
- 1657 views
- Last edited Oct 06, 2020
Edit 1 note: Moved routines init_db() and quit() to file: register.ex
-- -- db_tools.e edit 1 -- include std/text.e include std/eds.e include std/io.e include std/datetime.e include std/filesys.e public include std/graphics.e public include reg_graphics.e public include formtext.e public sequence tables, current_table integer table_size public constant DB = "check_register.edb" -- tables public constant REGISTER = "register", REG = REGISTER, BUDGET = "budget", CASH = "CASH", RESERVE = "RESERVE" public procedure list_tables() -- list tables, highlights current table sequence text = "\n\n\t\tDatabase Table List" update_tables() set_foreground_color(FGC) display(text) for i = 1 to length(tables) do text = text:format("\n\t\t[]: []",{i,tables[i]}) if equal(tables[i],current_table) then hilite(text, HLC,0) else display(text,{},0) end if end for any_key("\n\n\tPress Any Key to Continue...") end procedure public procedure update_tables() tables = db_table_list() current_table = db_current_table() table_size = db_table_size() end procedure -- public procedure quit() db_close() abort(0) end procedure public procedure select_table() integer t, x, ct -- ct = create table sequence text, initial_table = db_current_table() list_tables() ct = length(tables)+1 x = length(tables)*-1 text=text:format( "\n\n\t\t\tSelect table Enter table # " & "\n\t\t\tEnter 0 to continue with current table" & "\n\t\t\tEnter -# of table to delete the table" & "\n\t\t\tEnter [] to create a new table: ",ct) t = prompt_number(text,{x,ct}) if t>0 then if t = ct then -- create new table text = prompt_string("\n\t\t\tEnter name of new table: ") text = upper(text) if db_create_table(text) != DB_OK then any_key("\n\t\t\tERROR! Failed to create new table...") end if else -- select table if db_select_table(tables[t]) != DB_OK then display("\n\t\t\tERROR! Could not select: ",0) hilite(sprintf("%s",{tables[t]})) end if end if elsif t = 0 then -- do nothing continue with current table else -- t < 0 -- delete table t*=-1 -- convert x to positive table # text=text:format("\n\n\t\t\tDelete table []? yes = 1, no = 0: ", {tables[t]}) x = prompt_number(text,{0,1}) if x then db_delete_table(tables[t]) db_select_table(initial_table) end if end if update_tables() end procedure public procedure DbDump() file_number FN datetime dt = now() sequence dtstr, dump_file, db = db_current() db= filebase(db) dtstr = text:format("[]:[]:[]:[]:[]-",{dt[YEAR],dt[MONTH],dt[DAY],dt[HOUR],dt[MINUTE]}) dump_file = dtstr & db & "-Db-Dump.txt" FN = open(dump_file,"w") db_dump(FN) close(FN) system("less " & dump_file) end procedure public procedure rename_table() integer t sequence tmenu, new_table_name, text list_tables() tmenu=text:format( "\n\n\t\t\tSelect table to rename" & "\n\t\t\tEnter 0 to abort #: " ) t = prompt_number(tmenu,{0,length(tables)}) if t then -- rename table text = text:format("\n\n\t\t\t\Enter new name for table: [] : ", {tables[t]}) new_table_name = prompt_string(text) new_table_name = upper(new_table_name) db_rename_table(tables[t],new_table_name) update_tables() list_tables() end if end procedure -- end dbtools.e
Regards, Ken
6. Re: Budget Builder
- Posted by Senator Oct 01, 2020
- 1662 views
-- -- formtext.e -- Mike Nelson -- -- text formatting for DOS/Linux include std/graphics.e public constant ALIGN_LEFT=1 public constant ALIGN_CENTER=2 public constant ALIGN_RIGHT=3 public integer screenLines, screenColumns, leftMargin, rightMargin, tabSize, textAlignment public procedure init_text_formatter() -- initializes screen parameters -- call after changing video modes sequence vidconf=video_config() screenLines = vidconf[VC_LINES] screenColumns=vidconf[VC_COLUMNS] leftMargin=1 rightMargin=screenColumns tabSize=4 textAlignment=ALIGN_LEFT end procedure init_text_formatter() -- first initialization is automatic -- public function set_margins(integer left,integer right) -- Sets margins, returns 1 or 0 on invalid margin(s). -- left=0 or right=0 leaves that margin unchanged -- a negative value for right indicates moving left if left<0 then return 0 end if if right<0 then right=screenColumns+right end if if right>screenColumns then return 0 end if if left>right then return 0 end if if left>0 then leftMargin=left end if if right>0 then rightMargin=right end if return 1 end function public function set_tabsize(integer size) -- sets tabsize, returns 1 or 0 on invalid size. if size<0 then return 0 end if if size>rightMargin-leftMargin+1 then return 0 end if tabSize=size return 1 end function -- public function get_tabsize() return tabSize end function -- public function set_alignment(integer align) -- ALIGN_LEFT, ALLIGN_CENTER, ALLIGN_RIGHT -- sets alignment, returns 1. -- Returns 0 on invalid alignment if find(align, {1,2,3}) then textAlignment=align return 1 else return 0 end if end function -- public function get_alignment() return textAlignment end function -- function ltrim(sequence text) for i=1 to length(text) do if text[i]!=' ' then return text[i..length(text)] end if end for return "" end function function rtrim(sequence text) for i=length(text) to 1 by -1 do if text[i]!=' ' then return text[1..i] end if end for return "" end function -- procedure print_aligned(sequence text,integer width) sequence lspace,rspace integer spaces spaces=width-length(text) if textAlignment=ALIGN_LEFT then lspace="" rspace=repeat(' ',spaces) elsif textAlignment=ALIGN_CENTER then lspace=repeat(' ',floor(spaces/2)) rspace=repeat(' ',floor((spaces+1)/2)) else lspace=repeat(' ',spaces) rspace="" end if puts(1,lspace&text&rspace) end procedure -- public procedure print_formatted(sequence text) --Prints formatted text to screen starting at current postion, --using the curent margin and alignment settings. --Output is word-wrapped if possible, hyphenated if not. --Tabs are expanded to the number of spaces given --by the current tabsize setting. --Whitespace is trimmed only at word wraps and hyphenations. --Assumes text is a valid string. integer width,offset,index sequence pos --,printText while 1 do index=find('\t',text) if index=0 then exit end if text=text[1..index-1]&repeat(' ',tabSize)&text[index+1..length(text)] end while width=rightMargin-leftMargin+1 pos=get_position() offset=0 if pos[2]>rightMargin then puts(1,"\n") pos=get_position() end if if pos[2]<leftMargin then position(pos[1],leftMargin) elsif pos[2]>leftMargin then offset=pos[2]-leftMargin end if index=find('\n',text) if index=0 then index=length(text)+1 end if if index<=width-offset+1 then print_aligned(text[1..index-1],width-offset) if index<=length(text) then print_formatted(text[index+1..length(text)]) end if return end if for i=width-offset+1 to 1 by -1 do if text[i]=' ' then print_aligned(rtrim(text[1..i-1]),width) print_formatted(ltrim(text[i+1..length(text)])) return end if end for print_aligned(text[1..width-offset-1]&'-',width-offset) if length(text)>=width-offset then print_formatted(ltrim(text[width-offset..length(text)])) end if end procedure
Regards, Ken
8. Re: Budget Builder file: register.e part 1, edit 1
- Posted by Senator Oct 05, 2020
- 1596 views
- Last edited Oct 06, 2020
-- -- register.e part 1, edit 1 -- include std/console.e include std/datetime.e include std/filesys.e include std/io.e include std/text.e include std/eds.e include std/get.e include std/convert.e include std/utils.e include std/io.e include std/filesys.e include std/math.e --------------------- include xbackup.e include formtext.e include db_tools.e global sequence pos global integer line public integer autolog = 0 public integer rec_col, key_col, budget_note_col, note_col, full_note_col, amt_col,bal_col, bal_amt_col, bal_bal_col, table_size public procedure reset_columns() rec_col=1 key_col=7 full_note_col=30 budget_note_col=11 note_col=13 amt_col=50 bal_col=67 bal_amt_col=40 bal_bal_col=57 end procedure public function is_error(integer rec_num) if rec_num = 0 then any_key("\n\tERROR! aborting transaction... ") return 1 else return 0 end if end function global function bankers_rounding(atom pence, integer precision=1) integer pennies, -- (or nearest 100, etc, but never nearest < 1 ) s = sign(pence), whole pence = abs(pence)/precision whole = floor(pence) atom fract = pence-whole if fract=0.5 then pennies = whole+and_bits(whole,1) else pennies = floor(0.5+pence) end if pennies *= s*precision return pennies end function public procedure truncate_note(object note, integer truncate_at) if atom(note) then note = to_string(note) display("ERROR! note is []",note,0) end if if length(note)>=truncate_at then note = note[1..truncate_at] display("[]",{note},0) hilite("~",HLC,0) else display("[]",{note},0) end if end procedure public procedure toggle_tables() current_table = db_current_table() if equal(current_table,REGISTER) then db_select_table(BUDGET) else db_select_table(REGISTER) end if update_tables() end procedure public enum D,H,M,S public function set_budget_key() integer DD, last_day, rec -- D=1,H=2,M=3,S=4, sequence text, key, -- {DD,HH,MM,SS} dt = now() last_day = days_in_month(dt) text="\n\tEnter day of budget transaction: " DD = prompt_number(text, {0,last_day}) if DD = 0 then DD = last_day end if dt[DAY]=DD key = dt[DAY..$] -- {D,H,1,1} rec = db_find_key(key) -- if rec with key already exists -- within database subtract 1 second from -- key and try again if rec then loop do dt = datetime:subtract(dt,1,SECONDS) key = dt[DAY..$] rec = db_find_key(key) until rec < 0 end loop end if return key end function public function balance(integer rec) sequence data atom bal = 0 for i = 1 to rec do data = db_record_data(i) bal += data[$] end for return bal end function -- end register.e part 1, edit 1
Regards, Ken
9. Re: Budget Builder file: register.e part 2, edit 1
- Posted by Senator Oct 05, 2020
- 1592 views
- Last edited Oct 06, 2020
-- register.e part 2, edit 1 public procedure display_full_note(integer rec=0, integer truncate = 1) integer HLITE, line atom val, bal object data, key, pos sequence display_key, note, display_amt, display_bal init_text_formatter() reset_columns() set_foreground_color(FGC) if rec=0 then rec=prompt_number("\n\nEnter number of record to display #: ",{1,db_table_size()}) truncate = 0 else truncate = 1 end if key = db_record_key(rec) data = db_record_data(rec) note = data[1] val = data[2]/100 bal = balance(rec)/100 if val <0 then val = -val HLITE = RED else HLITE = FGC end if display_amt = text:format("$ [:8,,.2]",val) display_bal = text:format("$ [:8,,.2]",bal) puts(1, "\n\n") pos = get_position() line = pos[1] position(line,pos[2]) -- display rec/key if equal(current_table, BUDGET) then -- BUDGET position(line,1) display("[]",rec,0) -- rec = #### display_key = text:format("[]-[]-[]",{key[1],key[2],key[3]}) position(line,key_col) hilite(display_key,HLC,0) else -- REGISTER/CASH position(line,1) display("[]",rec,0) -- display rec # display_key = text:format("[]-[]",{key[2],key[3]}) position(line,key_col) hilite(display_key,HLC,0) end if -- display note position(line, note_col) if truncate then truncate_note(note, 35) else position(line+1, note_col) set_margins(note_col, amt_col-2) print_formatted(note) end if -- display transaction amt position(line,amt_col) hilite(display_amt,HLITE,0) -- display balance position(line, bal_col) display(display_bal,{},0) init_text_formatter() set_foreground_color(FGC) end procedure procedure display_total(atom total) sequence amt_text, fms = "total $ [:8,,.2]" puts(1,"\n\n") pos = get_position() position(pos[1],amt_col-6) if total < 0 then amt_text = text:format(fms, -total) hilite(amt_text, RED) else amt_text = text:format(fms, total) display(amt_text) end if end procedure public function select_year() integer a, z, year object key sequence range_text key = db_record_key(1) a = key[YEAR] key = db_record_key(db_table_size()) z = key[YEAR] if a=z then year = a -- only 1 year in table else range_text=text:format("Enter year [] <> [] #: ",{a,z}) year = prompt_number(range_text,{a,z}) end if return year end function public function select_month() integer a,z, month object key sequence range_text key = db_record_key(1) a = key[MONTH] key = db_record_key(db_table_size()) z = key[MONTH] range_text=text:format("Enter month # between [] and [] #: ",{a,z}) month = prompt_number(range_text,{a,z}) return month end function -- end register.e part 2, edit 1
Regards, Ken
10. Re: Budget Builder file: register.e part 3, edit 1
- Posted by Senator Oct 05, 2020
- 1591 views
- Last edited Oct 06, 2020
-- register.e part 3, edit 1 public constant SELECT=13 -- flag to select search_year and/or search_month public procedure search(integer search_year = 0, integer search_month = 0) integer caption_flag = 1, cash_flag = 1, start = 1, cont = 1 sequence caption, table_text, search object note, key = 0, data = {} atom amt = 0, subtotal = 0, reg search = upper(prompt_string("\n\tEnter search keyword: ")) caption = text:format("<keyword: []>",{search}) if search_year = SELECT then search_year = select_year() end if if search_year then caption &= text:format(" Year: []", search_year) end if if search_month = SELECT then search_month = select_month() end if if search_month then caption &= text:format(" Month: []", search_month) else caption &= text:format(" YEAR To DATE") end if db_select_table(REGISTER) while cont do if find(current_table, {REGISTER, CASH}) then table_text = text:format("*****[]*****",{db_current_table()}) else return end if for rec = start to db_table_size() do key = db_record_key(rec) data = db_record_data(rec) note = upper(data[1]) amt = data[2]/100 if match("AUTOLOG",note) then continue end if if match(search, note) then -- display keyword and initial table caption once if caption_flag then center_display(caption, rightMargin) draw_line() center_display(table_text,rightMargin+5) if equal(db_current_table(),CASH) then cash_flag = 0 end if caption_flag = 0 end if -- display new table caption once if cont = 2 then if cash_flag then center_display(table_text,rightMargin+5) end if cash_flag = 0 end if if search_year and search_month then -- update subtotal for search month if key[MONTH] = search_month then subtotal += amt display_full_note(rec, 1) -- 0 = do not truncate end if else -- update subtotal for all years/months subtotal += amt display_full_note(rec, 1) -- 1 = truncate end if end if end for -- display subtotal for current table if subtotal then display_total(subtotal) puts(1,"\n") draw_line() end if -- after display of search subtotal for registry table -- assign subtotal to reg variable and reset subtotal = 0 if cont = 1 then reg = subtotal subtotal = 0 end if -- after display of search subtotal for cash table -- display total of search for both tables if cont = 2 then if subtotal then display_total(reg+subtotal) end if end if cont += 1 if cont = 2 then db_select_table(CASH) else db_select_table(REGISTER) cont = 0 end if end while -- return to register db_select_table(REGISTER) any_key("\n\nPress Any Key to continue...") list() end procedure procedure draw_line(integer dash = 1) sequence FILL if dash then set_foreground_color(HLC) FILL = "-" else set_foreground_color(FGC) FILL = " " end if for i = 1 to rightMargin-5 do puts(1,FILL) end for set_foreground_color(FGC) end procedure function get_highlight_record_number(datetime dt = now()) integer rec_num-- returns rec # rec_num = db_find_key(dt) if rec_num > 0 then return rec_num elsif rec_num < 0 then return -rec_num-2 else return 0 end if end function -- end register.e part 3, edit 1
11. Re: Budget Builder file: register.e part 4, edit 1
- Posted by Senator Oct 05, 2020
- 1583 views
- Last edited Oct 06, 2020
-- register.e part 4, edit 1 public procedure display_header() sequence hpos integer col, hline init_text_formatter() clear_screen() set_foreground_color(HLC) center_display(current_table,rightMargin-10) set_foreground_color(FGC) puts(1, "\n") col = note_col if equal(current_table, BUDGET) then col = budget_note_col key_col -= 1 else col = note_col end if hpos=get_position() hline = hpos[1] position(hline,1) hilite("#",HLC,0) position(hline,key_col) hilite("Day",HLC,0) position(hline,col) hilite("Transaction", HLC,0) position(hline,amt_col) hilite("Amount", HLC,0) position(hline, bal_col) hilite("Balance",HLC,1) draw_line() puts(1,"\n") end procedure public constant ALL=13 public procedure list(integer only_year = 0, integer only_month = 0, integer start = 1, integer stop = db_table_size()) object key reset_columns() init_text_formatter() update_tables() if only_year = 13 then only_year = select_year() end if if only_month = 13 then only_month = select_month() end if display_header() pos = get_position() -- line = pos[1] for rec = start to stop do key = db_record_key(rec) if only_year and only_month then if equal(key[MONTH],only_month) then display_full_note(rec) end if else display_full_note(rec) end if end for puts(1,"\n\n") set_foreground_color(FGC) end procedure global object brd, sourceDir, BACKUPDIR include xbackup.e public procedure backup_prj_files() sequence file_name = "/home/ken/euprogs/bank_book/register.prj" sourceDir = dirname(file_name) brd = backupfiles(file_name) display(brd[2]) end procedure public function autolog_budget(sequence TARGET_TABLE = REGISTER) sequence key, data datetime dt = datetime:now() backup_prj_files() if db_select_table(BUDGET) != DB_OK then display("\n\t\t\tCould not select: ",0) hilite(sprintf("\n\t\t\t%s",{BUDGET})) else current_table = db_current_table() if equal(current_table, BUDGET) then for rec = 1 to db_table_size() do key = db_record_key(rec) -- budget data = db_record_data(rec) -- budget if db_select_table(TARGET_TABLE) != DB_OK then display("\n\t\t\tCould not select: ",0) hilite(sprintf("\n\t\t\t%s",{TARGET_TABLE})) any_key("\n") else -- table = TARGET_TABLE if key[1] > days_in_month(dt) then -- edit 9/1/2020 key[1] = days_in_month(dt) end if dt[DAY] = key[1] dt[HOUR] = 4 -- 4 a.m. dt[MINUTE] = 1 dt = add(dt, rec, MINUTES) if db_insert(dt,data) != DB_OK then display("\n\t\tCould not insert Autolog Budget data into ",0) hilite(sprintf("\n\t\t\t%s",{TARGET_TABLE})) any_key(" ") return 0 else -- switch to BUDGET table to select next autolog entry db_select_table(BUDGET) end if end if end for end if end if db_select_table(TARGET_TABLE) return 1 end function -- end register.e part 4, edit 1
12. Re: Budget Builder file register.e part 5, edit 1
- Posted by Senator Oct 05, 2020
- 1576 views
- Last edited Oct 06, 2020
-- register.e part 5, edit 1 public constant AUTOLOG_DAT = "AUTOLOG.DAT" public procedure check_AUTOLOG_DAT() integer FILE, val if file_exists(AUTOLOG_DAT) then puts(1, "\n\tAUTOLOG.DAT file located...\n") FILE = open(AUTOLOG_DAT,"rb") if FILE = -1 then any_key("\n\t...Error opening AUTOLOG.DAT!\n\tPress any key...") else val = get_integer16(FILE) printf(1, "\ntAUTOLOG.DAT = %d", val) any_key("\n\n") end if end if end procedure -- automatically log transactions to table: register public procedure check_autolog_flag() datetime dtnow = now() integer LAST_MONTH, THIS_MONTH = dtnow[2], autolog = 0, FILE -- if db_compress() != DB_OK then -- any_key("\n\tDB compress failed!\n") -- end if if file_exists("AUTOLOG.DAT") then FILE = open("AUTOLOG.DAT", "ub") if FILE = -1 then any_key("\n\taborting autolog...Error opening AUTOLOG.DAT!\n\tPress any key...") return end if LAST_MONTH = get_integer16(FILE) if LAST_MONTH != THIS_MONTH then -- autolog budget data autolog = prompt_number("\n\tAuto-Log Budget data? Enter 0 = no, 1 = yes : ",{0,1}) if autolog then if autolog_budget() then put_integer16(FILE,THIS_MONTH) any_key("\n\tAutolog complete, AUTOLOG.DAT file updated\n\tPress any key to continue...") end if end if end if else -- FILE AUTOLOG.DAT does not exist -- create initial "AUTOLOG.DAT" file: FILE = open("AUTOLOG.DAT", "wb") if autolog_budget() then put_integer16(FILE,THIS_MONTH) -- update AUTOLOG.DAT end if end if close(FILE) end procedure public procedure select_cash_table() if db_select_table(CASH) != DB_OK then display("\n\t\t\tCould not select: ",0) hilite(sprintf("\n\t\t\t%s",{CASH})) end if update_tables() end procedure -- end register.e part 5, edit 1 -- end register.e
Regards, Ken
13. Re: Budget Builder file: register.e part 6 deleted
- Posted by Senator Oct 05, 2020
- 1583 views
- Last edited Oct 06, 2020
register.e part 6 deleted in edit 1
14. Re: Budget Builder - file: register.ex part 1 - edit 1
- Posted by Senator Oct 05, 2020
- 1575 views
- Last edited Oct 06, 2020
-- register.ex -- part 1, edit 1 include std/eds.e include std/console.e include std/io.e include std/text.e include std/datetime.e include std/types.e include std/filesys.e include std/math.e include std/utils.e include std/error.e include get_datetime.e include reg_graphics.e include formtext.e include register.e include db_tools.e -- with type_check with warning warning_file("warning.log") procedure init_db() -- initialize Db if db_open(DB, DB_LOCK_NO) != DB_OK then if db_create(DB, DB_LOCK_NO) != DB_OK then display("Couldn't create database: []",{DB}) any_key("") end if if db_create_table(REGISTER) != DB_OK then display("Could not create table: []", {REGISTER}) any_key("") end if if db_create_table(CASH) != DB_OK then display("Could not create table: []", {CASH}) any_key("") end if if db_create_table(BUDGET) != DB_OK then display("Could not create table: []", {BUDGET}) any_key("") end if if db_create_table(RESERVE) != DB_OK then display("Could not create table: []", {RESERVE}) any_key("") end if end if if db_select_table(REGISTER) != DB_OK then display("\tCould not Select table: []", {REGISTER},1) end if end procedure init_db() function select_record()-- select record from current db table sequence prompt = "\n\t\tEnter # of record to edit, Enter 0 to abort: " integer rn -- rec # list() puts(1,"\n") rn=prompt_number(prompt, {0,db_table_size()}) if rn then return rn else return 0 -- rn = 0, abort procedure end if end function function remove_word(sequence note, sequence word) integer start = match(word,note), stop = start+length(word) return remove(note,start,stop) end function function replace_word(sequence note, sequence word, sequence new_word) integer start = match(word,note), stop = start+length(word) if stop != length(note) then new_word&=" " end if return replace(note,new_word,start,stop) end function function edit_note(object note)-- edit transaction note sequence word="", new_word="" integer x x=prompt_number("\n\t1. Append Keyword to transaction note"& "\n\t2. Replace Keyword in transaction note"& "\n\t3. Remove Keyword in transaction note"& "\n\t4. Replace entire transaction note\n\t: ",{0,4}) if x = 1 then new_word = prompt_string("\n\n\tAppend this Keyword to transaction note: ") new_word = " "&new_word note = splice(note,new_word,length(note)+1) elsif x = 2 then word = prompt_string("\n\tReplace this Keyword: ") new_word = prompt_string("\n\tWith this Keyword: ") note = replace_word(note,word,new_word) elsif x = 3 then word = prompt_string("\n\tRemove this word: ") note = remove_word(note, word) else note = prompt_string("\n\t\tEnter new transaction note\n\t: ") end if return note end function constant DEBIT=2, TA = {"Deposit", "Debit"}, -- transaction type FIELDS = {"DATE: ", "Transaction Note: ", " $"} -- amount -- always enter without +- sign public function debit_or_deposit() -- select transaction type: integer t set_foreground_color(FGC) puts(1, "\n\n\t\tTransaction Type\n\n") for i = 1 to 2 do display("\t#[]. [] -- enter positive amount without sign",{i, TA[i]}) end for t = prompt_number("\t#: ", {1,2}) if t = DEBIT then t = -1 end if set_foreground_color(FGC) return t end function -- end register.ex part 1, edit 1
15. Re: Budget Builder - file: register.ex part 2, edit 1
- Posted by Senator Oct 05, 2020
- 1574 views
- Last edited Oct 06, 2020
-------------- register.ex part 2, edit 1 procedure add_record() -- add a new record to the current table object key, data, note integer rec, t -- t = transaction type debit/deposit atom amt, bal sequence prompt current_table = db_current_table() if equal(current_table, BUDGET) then -- table: BUDGET key = set_budget_key() -- obtain key - enter day of month for rec = db_find_key(key) -- BUDGET deposit/debit transaction else -- table: REGISTER/CASH key = dt_menu(SECOND) --,USE_MENU)-- enter full datetime value rec = db_find_key(key) if is_error(rec) then return end if -- if rec > 0, then key already exists within database -- add 30 seconds to key and try again if rec then loop do key=datetime:add(key,30,SECONDS) rec = db_find_key(key) until rec < 0 end loop end if end if t = debit_or_deposit() if t = 0 then return end if -- convert rec to a positive value in order to calculate -- current balance before insertion of next record bal=balance(-rec-1) data = {} for i = 2 to 3 do -- FIELDS[1] = key prompt = "\t" & FIELDS[i] if i = 2 then -- FIELDS[2] = Transaction Note: note = prompt_string(prompt) data = append(data, note) else -- FIELDS[3] = "$" if t = -1 then set_foreground_color(RED) else set_foreground_color(FGC) end if amt = prompt_number(prompt,{}) amt *= 100 -- convert to integer for storage amt *= t bal += amt data = append(data, amt) end if end for if db_insert(key, data) != DB_OK then any_key("\n\tinsert failed!\n") return end if list() end procedure procedure delete_record() integer rec list() rec = prompt_number("\n\n\tEnter # of db record to delete: ",{1,db_table_size()}) puts(1,"\n\n") display_full_note(rec) set_foreground_color(RED) puts(SCREEN, "\n\n\tDelete? (y/n) ") if find('n', gets(0)) then set_foreground_color(FGC) else db_delete_record(rec) set_foreground_color(FGC) end if end procedure procedure list_month(integer prior = 0)-- list current month, or prior=1 for previous month datetime dt if find(db_current_table(), {REGISTER,CASH}) then dt = now() list(dt[YEAR],dt[MONTH]-prior) end if end procedure constant MENU = sprintf("%s", { """ 1 add record 8 edit record data 2 delete record 9 DbDump 3 list all 10 list tables 4 display full note 11 rename table 5 toggle tables 12 select table 6 select cash table 13 backup 7 autolog budget 14 search all 17 list all 15 select search month 18 select list month 16 search current month 19 list current month 0 quit 20 list prior month 21 compress database 22 check autolog.dat #: """ })
16. Re: Budget Builder - file: register.ex part 3, edit 1
- Posted by Senator Oct 05, 2020
- 1594 views
- Last edited Oct 06, 2020
---------------- register.ex part 3, edit 1 procedure quit() db_close() abort(0) end procedure constant PRIOR=1, CURRENT=0 procedure main() sequence text integer s datetime dt = now() set_background_color(BGC) list() while 1 do -- if equal(current_table, REGISTER) then check_autolog_flag() end if set_foreground_color(MC) -- MC = Menu Color text = text:format("[]",{db_current_table()}) puts(1,"\n\n\t\t\t\tBudget Builder: ") hilite(text,YELLOW,1) puts(1,"\n\t\t\t\t") dt = now() set_foreground_color(BLUE) text = datetime:format(dt, "%A, %B %d '%y %l:%M%P") display(text,{},0) --hilite("*",YELLOW,0) -- display menu puts(1,"\n\n") set_foreground_color(MC) s = prompt_number(MENU,{0,22}) switch s do case 0 then quit() case 1 then add_record() case 2 then delete_record() case 3 then list() -- list all case 4 then display_full_note() any_key("\n") case 5 then toggle_tables() case 6 then select_cash_table() case 7 then autolog_budget() case 8 then edit_record_data() case 9 then DbDump() case 10 then list_tables() case 11 then rename_table() case 12 then select_table() case 13 then backup_prj_files() case 14 then search() -- search all-- 13 = select switch case 15 then search(13,13) -- select search YEAR/MONTH case 16 then dt=now() -- search current search(dt[YEAR],dt[MONTH]) -- YEAR/MONTH case 17 then list() case 18 then list(13,13) -- select YEAR/MONTH to list case 19 then list_month(CURRENT) -- list current YEAR/MONTH case 20 then list_month(PRIOR) -- list current year/PRIOR MONTH case 21 then db_compress() case 22 then check_AUTOLOG_DAT() case else any_key("\n\tThat key does nothing - Press Any Key to continue...") end switch end while end procedure main() -- end register.ex part 3, edit 1 -- end register.ex
17. Re: Budget Builder
- Posted by irv Oct 05, 2020
- 1558 views
Thanks - I can see it took some work to break that up into post-able size. Now to try it...
Where is center_display declared?
18. Re: Budget Builder
- Posted by Senator Oct 05, 2020
- 1568 views
Thanks - I can see it took some work to break that up into post-able size. Now to try it...
Where is center_display declared?
OOPS... sorry about that. I think I intended to add it to top of register.e since std/text.e and std/console.e were already included. Then forgot to do it...
-- -- center_display.e -- include std/text.e include std/console.e public procedure center_display(sequence text, integer rm) display("[c:" & sprint(rm) & "]",{text}) end procedure -- test: --center_display("This Text Is Centered",60) --display("[c:60]",{"this text is centered"})
Regards, Ken
EDIT: the public procedure center display has now been added to to the top of register.e part 1.
19. Re: Budget Builder
- Posted by irv Oct 06, 2020
- 1526 views
When I start register.ex, and enter 10 to list tables:
#: 10 Database Table List 1: register 2: CASH 3: budget 4: RESERVE Budget Buddy:
OK. Then I enter 10 to list tables:
#: 10 Database Table List Budget Buddy:
Where did the tables go? It's difficult to do any testing until the database handling is stable, so that's the first thing to fix.
20. Re: Budget Builder
- Posted by Senator Oct 06, 2020
- 1505 views
Where did the tables go? It's difficult to do any testing until the database handling is stable, so that's the first thing to fix.
It appears that when I started breaking up my original files into segments that I could post I somehow manage to muck up a lot. To my horror I discovered problems similar to what you have described. The database initialization and handling was not a problem.
For some reason I decided to move init_db() to the top of register.ex and call init_db() immediately after declaration. That seems to have solved that problem.
Also, I have abandoned the show() routine in register.e and expanded the routine display_full_note() to take its place.
The Following files in this thread have been edited/update:
register.ex parts 1-3
db_tools.e
register.e parts 1-5 (there is no longer a part 6)
There has been corruption of the *.edb file.
The problem seems to have been in the routine show(). Now execution of the program produces no warning.log or debug.log.
Note that when you have no data in a table running list() will only display a Header label.
The menu labels should be more descriptive: add - means add a record to the current table list all - means list all the records in the current table.
I hope this works now... If not maybe I can post/email a copy to interested parties.
Regards, Ken
21. Re: Budget Builder
- Posted by irv Oct 07, 2020
- 1494 views
Whew! Approx. 1175 lines of code.
As an experiment, I am going to try to implement that with a GUI interface, which would make it a bit easier to use, but also, I suspect, requiring fewer lines of code.
We'll see.
It's something to do while staying home.
22. Re: Budget Builder
- Posted by Senator Oct 07, 2020
- 1496 views
Whew! Approx. 1175 lines of code.
As an experiment, I am going to try to implement that with a GUI interface, which would make it a bit easier to use, but also, I suspect, requiring fewer lines of code.
We'll see.
It's something to do while staying home.
I was hoping that you would do exactly that!
Something very strange is going on with the console code. I'll explain in my next post.
Regards, Ken
23. Re: Budget Builder - Euphoria display bug?
- Posted by Senator Oct 07, 2020
- 1491 views
-- register.e part 2, edit 2 public procedure display_full_note(integer rec=0, integer truncate = 1) integer HLITE, line atom val, bal object data, key, pos sequence display_key, note, display_amt, display_bal init_text_formatter() reset_columns() set_foreground_color(FGC) if rec=0 then rec=prompt_number("\n\nEnter number of record to display #: ",{1,db_table_size()}) truncate = 0 else truncate = 1 end if key = db_record_key(rec) data = db_record_data(rec) note = data[1] val = data[2] bal = balance(rec) if val <0 then val = -val HLITE = RED else HLITE = FGC end if display_amt = text:format("$ [:8,,.2]",val) display_bal = text:format("$ [:8,,.2]",bal) puts(1, "\n") --<-------this produces serious unacceptable display errors, produces debug.log puts(1, "\n\n") --<-------this significant display errors. Does not produce a debug.log pos = get_position() line = pos[1] -- display record position(line,1) printf(1,"%d", rec) -- display("[]",rec,0) -- works same as printf -- display key position(line,key_col) if truncate = 0 then display_key = text:format("[]-[]-[]-[]:[]:[]",{key[YEAR],key[MONTH],key[DAY],key[HOUR],key[SECOND]}) elsif equal(current_table, RESERVE) then display_key = text:format("[]-[]-[]",{key[YEAR],key[MONTH]}) elsif equal(current_table, BUDGET) then display_key = text:format("[]-[]",{key[1]}) -- DAY-HOUR in budget key else -- REGISTER/CASH display_key = text:format("[]-[]",{key[MONTH],key[DAY]}) end if hilite(display_key,HLC,0) -- display note position(line, note_col) if truncate then truncate_note(note, 35) else position(line+1, note_col) set_margins(note_col, amt_col-2) print_formatted(note) end if -- display transaction amt position(line,amt_col) hilite(display_amt,HLITE,0) -- display balance position(line, bal_col) display(display_bal,{},0) init_text_formatter() set_foreground_color(FGC) end procedure
Using "\n" display through 20 OK. Records 25-93 are not displayed at all. No problem with *.edb is fine. debug.log file
# Day Transaction Amount Balance ----------------------------------------------------------------------------------- 1 7-3 Deposit SSA $ 1,505.00 $ 5,306.03 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 20 7-21 AMAZON household Veken Bidet & toil~ $ 45.83 $ 2,882.72 94 10-31 autolog SC Balance Requirement Feel~ $ 5.00 $ 3,211.7Using "\n\n" Displays initial 9 records with an extra "\n. Balance of records displayed as expected-
- .edb OK No debug log.
# Day Transaction Amount Balance ----------------------------------------------------------------------------------- 1 7-1 balance $ 3,801.03 $ 3,801.03 2 7-3 Deposit SSA $ 1,505.00 $ 5,306.03 --------------------------------------------------------------------------------- 91 10-28 autolog Tabatha Kitchens household $ 250.00 $ 2,366.73 92 10-28 autolog FOOD groceries $ 500.00 $ 1,866.73
Any insight into this problem would be appreciated.
Regards,Ken
24. Re: Budget Builder - Euphoria display bug?
- Posted by irv Oct 08, 2020
- 1483 views
I've got the interface working fine, in less than 500 lines. Still to do is math to maintain balances. Roughly 8 hours of work thus far.
https://drive.google.com/file/d/1_MHzG13wIoSkI2jAY0NloUC7hgr8EXxy/view?usp=sharing
25. Re: Budget Builder - Euphoria display bug?
- Posted by Senator Oct 08, 2020
- 1479 views
I've got the interface working fine, in less than 500 lines. Still to do is math to maintain balances. Roughly 8 hours of work thus far.
https://drive.google.com/file/d/1_MHzG13wIoSkI2jAY0NloUC7hgr8EXxy/view?usp=sharing
WOW! That looks really nice.
Calculating the balance shouldn't be hard, at least not if you calculate it on the fly for every display. You must be working on some interesting alternative method... less brute force, eh?
public function balance(integer rec) sequence data atom bal = 0 for i = 1 to rec do data = db_record_data(i) bal += data[$]-- data[$] is the + or - transaction amt end for return bal end function atom bal = balance(rec) -- or integer, if your storing as integers
Regards, Ken
26. Re: Budget Builder - Euphoria display bug?
- Posted by irv Oct 11, 2020
- 1406 views
I don't find anywhere in your code where you set up an eds fatal error handler. Did I just miss that? It can be helpful to prevent doing things which can corrupt the database:
-------------------------------------- global procedure ShowError(object msg) -------------------------------------- display("******************************************") display(db_get_errors()) display("******************************************") end procedure db_fatal_id = routine_id("ShowError") -- init on startup
Example of msg:
****************************************** { { 903, "no table selected", "db_table_size", {""} } } ****************************************** EDS Error Code 903: no table selected, from db_table_sizeObviously, you should examine the error message and decide whether it is safe to continue, or should crash the program before something worse happens - like going into a continuous loop until you run out of memory.
27. Re: Budget Builder - Euphoria display bug?
- Posted by Senator Oct 13, 2020
- 1397 views
I don't find anywhere in your code where you set up an eds fatal error handler. Did I just miss that? It can be helpful to prevent doing things which can corrupt the database memory.
Thanks for the Show_Error(object msg) routine. No *.edb errors are reported. It appears all my problems are display related. Took a few days off.. Now I have the the list() routines (and more) working as expected, but somehow managed to gum up my search() functions.
I'll soldier on... I hope to wind this project up tomorrow.
Regards, Ken