'Program fixran.tea written in the Teapro programming language 'using the OpenTea technology 'The program fixran.tea may be used for free by anyone, 'but there is no warranty of any kind whatsoever on fixran.tea. 'People need computer software that actually works. 'global variables follow vari sg_fileran, sg_fileexp, sg_filecode, sg_filetxt vari sg_interpreter, sg_path, sg_build, sg_memory, sg_lines vari sg_loadprog, dg_changes, dg_bookcurrent, sg_dashline vari dg_booklinetoshow, dg_chaplinetoshow vari dg_debug, dg_outputindex vari dg_shownline, dg_nowline vari dg_ampline, dg_quiet vari dg_more, sg_more, dg_all vari dg_maxlines, dg_linescount, sg_nothing vari dg_backline, dg_paneline 'variables for sub_interpreter vari sg_cmdline, sg_cmd0, sg_cmdredo vari dg_cmd1, dg_cmd2, dg_cmd3, dg_cmd4 vari sg_cmd1, sg_cmd2, sg_cmd3, sg_cmd4 'variables for passing information to and fro vari dg_pass0, dg_pass1, dg_pass2, dg_pass3, dg_pass4, dg_pass5 vari sg_pass0, sg_pass1, sg_pass2, sg_pass3, sg_pass4, sg_pass5 vari sg_pass6 'variables to hold system info vari dg_add, dg_modify, sg_note vari dg_view1s, dg_view2s, dg_view1v, dg_view2v vari dg_view1x, dg_view2x, dg_view1z, dg_view2z vari dg_wrapline, dg_wraplong vari dg_paragraph1, dg_paragraph2, dg_paragraph3 vari sg_find1, sg_find2, sg_find3, dg_findbegin, dg_findend vari sg_foundnum1, sg_foundnum2, sg_foundnum3, sg_foundnum4, vari sg_foundnum5 vari sg_foundstr1, sg_foundstr2, sg_foundstr3, sg_foundstr4, vari sg_foundstr5 vari dg_kopy1, dg_kopy2, dg_kopy3 vari dg_list1, dg_list2 vari dg_shochap, dg_echapter, dg_rchapter, dg_tchapter vari dg_topchap, sg_1lineshold vari dg_delete1, dg_delete2, sg_deletedlines vari dg_jumpline, dg_jumptop, dg_mode, dg_jumpmode 'variables for creating the book file vari dg_bookpagenum, dg_bookpageline, dg_booklinesper vari sg_bookinfo, sg_booknames, sg_booksort, sg_bookchapter vari dg_bookrecord, dg_ynbookpaging, sg_filebook vari dg_bookchartot, dg_bookcharhash vari dg_bookleftmargin, dg_bookdomain 'variable file byte position for outputting a text file 'using sub_text_file_out vari dg_textbyte 'special purpose variables vari sg_all, sg_1linesbad, dg_linesbad, sg_surnames, sg_key, dg_key 'xyzmath vari dg_xvalue, dg_yvalue, dg_zvalue, sg_xyzmath vari dg_uvalue, dg_vvalue, dg_wvalue 'xyzmath for total and bank for money 'call the sub_main subroutine to start the program sub_main endp subr sub_main 'updated 2011/09/26, 2010/06/20, 2010/06/05 '2010/05/10, 2010/05/01, 2010/04/14, 2009/05/07, 2008/02/25 '2008/02/01, 2007/11/12, 2007/09/10, 2007/07/17, 2007/02/19 '2006/09/18, 2006/08/29, 2006/08/26, 2006/08/20, 2006/08/09 '2006/08/08, 2006/03/16, 2006/01/29, 2005/10/07, 2005/06/11 '2005/04/19, 2005/04/13, 2005/04/09, 2005/04/07, 2004/10/13 vari s_any, d_any, s_dot, d_dot vari s_pick, d_pick, s_out, s_date, d_time vari d_loop, d_sec, s_aster, s_speedquick sub_initialize $ch$ s_aster, "*", 76 $sys sg_interpreter, 3 $trb sg_interpreter, sg_interpreter $sys sg_path, 1 $trb sg_path, sg_path d_loop = 1 dwhi d_loop = 1 sub_initialize $out s_aster sg_build = "fixran.tea build=797 2012/02/03" dsys d_any, 3 $app sg_build, " " + d_any $out sg_build $out "fixran.tea copyright (c) 1998-2012 by D La Pierre Ballard" $out "download this program from www.teapro.com" $out "this program was begun on 10-JAN-1998" $out "written in the teapro programming language" $out "copyright (c) 1997-2011 by D La Pierre Ballard" $out "teapro was invented on 14-DEC-1997" $out "teapro uses the opentea technology to be simple and solid" $out "this program may be used for free by anyone," $out "but it is totally without any warranty" $out s_aster $out "People need computer software that actually works." $dat s_date dsec d_sec $out "Current date=" + s_date + ", seconds=" + d_sec sub_floating_point_test $out s_aster sub_path_prog_memory sub_speedquick s_speedquick = sg_pass1 dsys d_any, 1 ded$ sg_memory, d_any, 0, 0 dsys d_any, 2 ded$ sg_lines, d_any, 0, 0 $out s_aster $out "1. process a fixran file" $out "2. build a new empty fixran file" $out "4. sub_file_delete" $out "5. sub_file_oldtoe" $out "6. sub_file_hash " + sg_path + " " + sg_lines $out "96. sub_xyz_math " + sg_interpreter + " " + sg_memory $out "98. sub_speed98_test " + sg_build + " " + sg_loadprog $out "99. sub_speed_test " + s_speedquick $out "* = end" $inp s_pick, "pick a number" + " x=" + dg_xvalue $isd d_any, s_pick d_pick = 0 dift d_any = 1: $tod d_pick, s_pick dift d_pick = 1: sub_process_file dift d_pick = 2 sub_get_filenames dift dg_pass1 = 1: sub_file_new endi dift d_pick = 4: sub_file_delete dift d_pick = 5: sub_file_oldtoe dift d_pick = 6: sub_file_hash dift d_pick = 96 sg_pass1 = "x=x" sub_xyz_math endi dift d_pick = 98: sub_speed98_test dift d_pick = 99: sub_speed_test $ift s_pick = "*": dinc d_loop $ift s_pick = "?": sub_help $ift s_pick = "i": sub_info $ift s_pick = "key": sub_key sg_pass1 = s_pick sub_xyz_math s_pick = sg_pass1 endw ends sub_main subr sub_process_file 'updated 2009/09/15, 2006/10/22, 2006/06/04, 2006/03/25, 2004/04/13 'process a fixran file vari s_any, d_any, s_dot, d_dot, s_out vari d_loop, d_seconds1, d_seconds2, d_long, d_good vari d_needimport, s_seconds, d_notexist 'get the file code and the filenames, d_good means good name sub_get_filenames d_good = dg_pass1 d_needimport = dg_pass2 d_notexist = dg_pass3 dift d_notexist = 1: dinc d_good dift d_good = 1 dift d_needimport = 1 'do we want to import s_out = "1=import " + sg_fileexp + " into " + sg_fileran $inp s_out, s_out $ift s_out = "*": dinc d_good $ift s_out = "1": sub_fixran_import $ift s_out <> "1": dinc d_good endi endi d_loop = d_good dwhi d_loop = 1 'the processing loop 'command line prompt dto$ s_seconds, d_seconds2, 0, 2 s_out = "*=end, ?=help, l=" + dg_list1 + "/" + dg_list2 $app s_out, ", lines=" + dg_maxlines $app s_out, ", sec=" + s_seconds + ", chg=" + dg_changes $app s_out, ", " + sg_filecode 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog dift dg_mode = 2: $app s_out, ", $" dift dg_mode = 3: $app s_out, ", RPG" dift dg_mode = 4: $app s_out, ", chef" dift dg_mode = 5: $app s_out, ", prog" $app s_out, ", x=" + dg_xvalue 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog 'for fun, if the command line is too long shorten it $len d_long, s_out dwhi d_long > 76 $bak d_dot, s_out, d_long, " " dift d_dot > 0 $del s_out, d_dot, 1 $len d_long, s_out else d_long = 0 endi endw dg_all = 2 $len d_long, sg_more dift d_long = 0 'output the command line prompt and get the command $inp sg_cmdline, s_out else 'we had a command line from sub_more sg_cmdline = sg_more sg_more = sg_nothing endi $trb sg_cmdline, sg_cmdline 'save in sg_cmdredo if length>1 and not redo sub_command_redo 'get seconds to start dsec d_seconds1 sg_pass1 = sg_cmdline sub_xyz_math sg_cmdline = sg_pass1 'get paramters of the command into dg_cmd1 and dg_pass1 etc sub_parameters 'command interpreter sub_interpreter d_loop = dg_pass1 'get time to end dsec d_seconds2 d_seconds2 = d_seconds2 - d_seconds1 d_seconds2 = d_seconds2 * 100 \ 1 / 100 endw ends sub_process_file subr sub_interpreter 'updated 2009/11/07, 2009/04/01, 2008/11/05, 2008/02/17, 2008/01/21 '2007/08/30, 2007/08/01, 2007/05/27, 2007/03/14, 2006/10/22 '2006/09/16, 2006/06/17, 2006/05/04, 2005/11/16, 2005/10/02 '2005/08/16, 2005/05/19, 2005/04/13, 2005/02/10, 2004/12/30 'command interpreter, the command is in sg_cmd0 vari s_beg, s_any, d_any, s_dot, d_dot vari d_hold, s_4longcmd 'make the command into lower case $clo sg_cmd0, sg_cmd0 'get the 4 long command $cut s_4longcmd, sg_cmd0, 1, 4 'help $ift sg_cmd0 = "?": sub_help 'ampersand or atcharacter $ift sg_cmd0 = "&": $out "&=" + dg_ampline $ift sg_cmd0 = "@": $out "@=" + dg_nowline $ift sg_cmd0 = "^": $out "^=" + dg_list1 $ift sg_cmd0 = "!": $out "!=" + dg_tchapter 'add $ift sg_cmd0 = "a": sub_add1 'show back lines $ift sg_cmd0 = "b": sub_back 'change string $ift sg_cmd0 = "c": sub_change 'delete $ift sg_cmd0 = "d": sub_delete 'show chapter e $ift sg_cmd0 = "e": sub_sho_chap1 'find a string $ift sg_cmd0 = "f" dg_pass0 = 1 sub_find_hunt endi 'hunt a string, not case sensitive $ift sg_cmd0 = "h" dg_pass0 = 2 sub_find_hunt endi 'show information about the program $ift sg_cmd0 = "i": sub_info 'jump on another few lines $ift sg_cmd0 = "j": sub_jump 'kopy lines to another place $ift sg_cmd0 = "k": sub_kopy 'list lines quiet will list deleted too $ift sg_cmd0 = "l": sub_list 'modify $ift sg_cmd0 = "m": sub_modify1 'n 'other beginning paragraph, toggle line beginning $ift sg_cmd0 = "o": sub_paragraph_lines 'paragraph $ift sg_cmd0 = "p" dg_pass2 = 2 sub_paragraph_begin endi 'show before and after $ift sg_cmd0 = "q": sub_show_now_before_after 'show chapter r $ift sg_cmd0 = "r": sub_sho_chap1 'show chapter s $ift sg_cmd0 = "s": sub_view 'show top chapter t and set b=bottom $ift sg_cmd0 = "t": sub_sho_chap1 'add update line or update line there $ift sg_cmd0 = "u": sub_updated_line 'view some records dg_view1v, dg_view2v $ift sg_cmd0 = "v": sub_view 'wrap words $ift sg_cmd0 = "w" 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog dift dg_mode = 1: sub_wrap dift dg_mode = 2: $out "no wrap in money mode" dift dg_mode = 3: $out "no wrap in RPG mode" dift dg_mode = 4: sub_wrap dift dg_mode = 5: $out "no wrap in prog mode" endi 'view some records dg_view1x $ift sg_cmd0 = "x": sub_view $ift sg_cmd0 = "y" sg_pass1 = sg_foundnum1 sub_string_lines_show endi 'view some records dg_view1z, dg_view2z $ift sg_cmd0 = "z": sub_view 'back one chapter to dg_echapter $ift s_4longcmd = "back": sub_next_back_chapter 'look at books $ift sg_cmd0 = "book": sub_show_books $ift sg_cmd0 = "bulk": sub_show_books 'set b to be at bottom of chapter $ift sg_cmd0 = "bott": sub_bottom 'change lines to certain case $ift sg_cmd0 = "case": sub_case_lines 'show chapters $ift sg_cmd0 = "chap": sub_show_chapters 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog $ift sg_cmd0 = "chef": dg_mode = 4 'clear screen $ift sg_cmd0 = "cls": sub_cls 'code or encode $ift sg_cmd0 = "code" dg_pass0 = 1 sub_code_lines endi 'change columns $ift sg_cmd0 = "columns": sub_columns_change 'put commas in numbers $ift sg_cmd0 = "commas": sub_put_commas_in_numbers 'count everything $ift sg_cmd0 = "count": sub_count_everything 'dash $ift sg_cmd0 = "dash" dg_pass2 = 1 sub_paragraph_begin endi 'toggle debug $ift sg_cmd0 = "debug" d_any = dg_debug dg_debug = 1 dift d_any = 1: dinc dg_debug $out "debug=" + dg_debug endi 'file output of lines $ift sg_cmd0 = "file": sub_lines_to_file 'fast find $ift sg_cmd0 = "find" dg_pass1 = 2 sub_find_fast endi 'fast hunt $ift sg_cmd0 = "hunt" dg_pass1 = 1 sub_find_fast endi 'hush $ift sg_cmd0 = "hush": sub_hush 'last show $ift sg_cmd0 = "last": sub_last_show 'left justify lines $ift sg_cmd0 = "left": sub_left_justify 'keep .RAN file to .EXP file, record by record $ift sg_cmd0 = "keep" dg_pass1 = 1 sub_fixran_export endi 'keep .RAN file to .EXP file, 50 records at a time $ift sg_cmd0 = "keepfifty" dg_pass1 = 3 sub_fixran_export endi 'lines hold in sg_1lineshold $ift sg_cmd0 = "lineshold": sub_lineshold 'bring up menu $ift sg_cmd0 = "menu": sub_menu 'menuprimes $ift sg_cmd0 = "menuprimes": sub_menu_primes 'menuprog $ift sg_cmd0 = "menuprog": sub_menu_prog 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog $ift sg_cmd0 = "mode" $out "mode: 1=normal 2=money 3=RPG 4=chef 5=prog" dift dg_pass1 > 0 dift dg_pass1 < 6: dg_mode = dg_pass1 endi $out "dg_mode=" + dg_mode endi 'money totalling and mode $ift sg_cmd0 = "money": sub_money 'note $ift sg_cmd0 = "note": sub_note 'next chapter to dg_echapter $ift s_4longcmd = "next": sub_next_back_chapter 'oldtoe $ift sg_cmd0 = "oldtoe": sub_file_oldtoe 'hunt one string, not case sensitive $ift sg_cmd0 = "one" dg_pass0 = 3 sub_find_hunt endi 'show a past find $ift sg_cmd0 = "past": sub_past_find 'look for a pattern in lines $ift sg_cmd0 = "pattern": sub_pattern_look 'push $ift sg_cmd0 = "push": sub_push 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog $ift sg_cmd0 = "rpg": dg_mode = 3 'renumber a column over lines $ift sg_cmd0 = "renum": sub_renumber_column 'save .RAN file to .EXP file, by whole file $ift sg_cmd0 = "save" dg_pass1 = 2 sub_fixran_export endi 'seek to find chapters with a certain string $ift sg_cmd0 = "seek": sub_seek 'sortlines $ift sg_cmd0 = "sortlines": sub_sort_lines 'show the speed of the computer $ift sg_cmd0 = "speed": sub_speed_test 'show the system memory $ift sg_cmd0 = "system" dsys d_any, 1 ded$ s_any, d_any, 0, 0 $out "string memory=" + s_any endi 'set number of lines to tall $ift sg_cmd0 = "tall" dift dg_pass1 > 2: dg_maxlines = dg_pass1 endi 'thinout a range of lines $ift sg_cmd0 = "thin": sub_thinout 'show the time line $ift sg_cmd0 = "time" $dat s_any $out s_any endi 'todo $ift sg_cmd0 = "todo" dg_pass2 = 4 sub_paragraph_begin endi 'total up a column of numbers $ift sg_cmd0 = "total": sub_total_column 'top to show current chap or subr $ift sg_cmd0 = "top" dg_pass2 = 1 sub_top endi $ift sg_cmd0 = "toprpg" dg_pass2 = 2 sub_top endi 'undelete $ift sg_cmd0 = "undelete": sub_undelete 'go into sub_xyz_math $ift sg_cmd0 = "xyz": sub_xyz_math $ift sg_cmd0 = sg_nothing 'jump on down some more dift dg_jumpmode = 1: sub_jump 'show some more of a chapter dift dg_jumpmode = 5: sub_sho_chap2 endi 'end of program dg_pass1 = 1 $ift sg_cmd0 = "*" $ift sg_cmdline <> "**" dift dg_changes > 0 dg_pass1 = 2 sub_fixran_export endi endi 'return a value to end dg_pass1 = 2 endi ends sub_interpreter subr sub_parameters 'updated 2010/09/24, 2010/09/23, 2009/11/07 '2009/02/16, 2006/07/14, 2005/08/12, 2005/08/07, 2004/12/30 'put string parameters in sg_cmd1,sg_cmd2,sg_cmd3,sg_cmd4 'put numeric parameters in dg_cmd1,dg_cmd2,dg_cmd3,dg_cmd4 vari s_any, d_any, s_dot, d_dot, s_out vari d_loop, s_byte, d_byte, d_long, d_good vari s_parameters, s_commline, s_line, s_quote vari s_str1, s_str2, s_str3, s_str4 vari d_beg, d_end, d_count 'initialize command parameters sg_cmd0 = sg_nothing sg_cmd1 = sg_nothing sg_cmd2 = sg_nothing sg_cmd3 = sg_nothing sg_cmd4 = sg_nothing 'we can have either " or # as a string delimiter $trb sg_cmdline, sg_cmdline s_quote = #"# $lok d_any, sg_cmdline, 1, "#" dift d_any > 0: s_quote = "#" $lok d_dot, sg_cmdline, 1, #"# dift d_dot > 0: s_quote = #"# d_good = d_any * d_dot dift d_good > 0 dift d_any < d_dot s_quote = "#" else s_quote = #"# endi endi 'does the line end in Q for quiet mode dg_quiet=1 dg_quiet = 2 $len d_long, sg_cmdline dift d_long > 1 $cup s_any, sg_cmdline $off s_any, s_any, 1 $ift s_any = "Q" 'set dg_quiet=1 and remove Q on right end dg_quiet = 1 ddec d_long $cut sg_cmdline, sg_cmdline, 1, d_long endi endi 'the command line is in sg_cmdline 'get the string parameters into s_str1 etc s_commline = sg_cmdline + " " d_count = 0 d_loop = 1 dwhi d_loop = 1 's_quote can be either " or # as a string delimiter $lok d_beg, s_commline, 1, s_quote dift d_beg > 0 'now find the end of this string d_end = d_beg + 1 $lok d_end, s_commline, d_end, s_quote dift d_end > 0 'length from s_quote to string end d_long = d_end - d_beg 's_dot has first quote in it $cut s_dot, s_commline, d_beg, d_long 'replace the string parameter and separator 'following it with nothing d_long = d_long + 2 $del s_commline, d_beg, d_long 'put the string parameter in sg_cmd1 etc 'and get rid of first quote dinc d_count dift d_count = 1: $cut sg_cmd1, s_dot, 2, 999 dift d_count = 2: $cut sg_cmd2, s_dot, 2, 999 dift d_count = 3: $cut sg_cmd3, s_dot, 2, 999 dift d_count = 4: $cut sg_cmd4, s_dot, 2, 999 else dinc d_loop endi else dinc d_loop endi endw 'the string parameters have been removed from s_commline 'separate the command from the remaining numeric parameters 'the parameters begin with a non-alpha byte at > 1 'sg_cmdline was trimmed just after it was entered dch$ s_any, 32, 10 $cup s_commline, s_commline $app s_commline, s_any d_byte = 2 d_loop = 1 dwhi d_loop = 1 $cut s_byte, s_commline, d_byte, 1 'the parameters begin with a non-alpha byte $isp d_any, s_byte, "A" dift d_any <> 1 'get just the parameters $cut s_parameters, s_commline, d_byte, 999 'get just the command d_any = d_byte - 1 $cut sg_cmd0, s_commline, 1, d_any dinc d_loop endi dinc d_byte endw 'if a command was entered then turn off continue 'set dg_jumpmode = 0 $trb s_parameters, s_parameters $trb sg_cmd0, sg_cmd0 $len d_long, sg_cmd0 'if there is a command then end jump mode dift d_long > 0: dg_jumpmode = 0 'replace @ with dg_nowline in remaining numeric parameters $lok d_dot, s_parameters, 1, "@" dwhi d_dot > 0 s_any = dg_nowline $del s_parameters, d_dot, 1 $ins s_parameters, d_dot, s_any $lok d_dot, s_parameters, 1, "@" endw 'replace & with dg_ampline in remaining numeric parameters $lok d_dot, s_parameters, 1, "&" dwhi d_dot > 0 s_any = dg_ampline $del s_parameters, d_dot, 1 $ins s_parameters, d_dot, s_any $lok d_dot, s_parameters, 1, "&" endw 'replace ^ with dg_list1 in remaining numeric parameters $lok d_dot, s_parameters, 1, "^" dwhi d_dot > 0 s_any = dg_list1 $del s_parameters, d_dot, 1 $ins s_parameters, d_dot, s_any $lok d_dot, s_parameters, 1, "^" endw 'replace ! with dg_tchapter in remaining numeric parameters $lok d_dot, s_parameters, 1, "!" dwhi d_dot > 0 s_any = dg_tchapter $del s_parameters, d_dot, 1 $ins s_parameters, d_dot, s_any $lok d_dot, s_parameters, 1, "^" endw 'replace a + sign with 999999 in remaining numeric parameters $lok d_dot, s_parameters, 1, "+" dwhi d_dot > 0 d_any = 1000 * 1000 - 1 s_any = d_any $del s_parameters, d_dot, 1 $ins s_parameters, d_dot, s_any $lok d_dot, s_parameters, 1, "+" endw 'replace a K with 000 in remaining numeric parameters $lok d_dot, s_parameters, 1, "K" dwhi d_dot > 0 s_any = "000" $del s_parameters, d_dot, 1 $ins s_parameters, d_dot, s_any $lok d_dot, s_parameters, 1, "K" endw 'initialize command parameters 'dg_cmd0 is set in sub_interpreter dg_cmd1 = 0 dg_cmd2 = 0 dg_cmd3 = 0 dg_cmd4 = 0 'do we have a possible numeric parameter $cup s_line, s_parameters $len d_long, s_line dift d_long > 0 'get the numeric parameters from s_line d_count = 1 d_byte = 1 dwhi d_byte <= d_long 'get the byte $cut s_byte, s_line, d_byte, 1 'is it a number $ist d_any, s_byte, "9" dift d_any = 1 'change index to the number $tod d_any, s_byte 'build whichever parameter we are on dift d_count = 1: dg_cmd1 = dg_cmd1 * 10 + d_any dift d_count = 2: dg_cmd2 = dg_cmd2 * 10 + d_any dift d_count = 3: dg_cmd3 = dg_cmd3 * 10 + d_any dift d_count = 4: dg_cmd4 = dg_cmd4 * 10 + d_any else dinc d_count endi dinc d_byte endw endi dift dg_debug = 1 $out sg_dashline $out "sub_parameters debug output" $out "command line=" + sg_cmdline $out "command=" + sg_cmd0 $out dg_cmd1 + " " + dg_cmd2 + " " + dg_cmd3 + " " + dg_cmd4 $out sg_cmd1 + "," + sg_cmd2 + "," + sg_cmd3 + "," + sg_cmd4 endi 'set the to variables, we do not change 'the cm variables elsewhere dg_pass1 = dg_cmd1 dg_pass2 = dg_cmd2 dg_pass3 = dg_cmd3 dg_pass4 = dg_cmd4 sg_pass1 = sg_cmd1 sg_pass2 = sg_cmd2 sg_pass3 = sg_cmd3 sg_pass4 = sg_cmd4 ends sub_parameters subr sub_more 'updated 2006/06/04, 2004/01/03 'return 1 in dg_more if more is wanted and return sg_more vari d_any, s_any, s_out dift dg_all <> 1 s_out = "return for more, l=" $app s_out, dg_list1 + "/" + dg_list2 $app s_out, ", x=" + dg_xvalue $app s_out, ", all=all" $inp sg_more, s_out sg_pass1 = sg_more sub_xyz_math sg_more = sg_pass1 dg_more = 2 $trb sg_more, sg_more $len d_any, sg_more dift d_any = 0: dg_more = 1 $cup s_any, sg_more $ift s_any = "ALL" dg_all = 1 dg_more = 1 sg_more = sg_nothing endi endi ends sub_more subr sub_help 'updated 2012/02/03, 2009/11/07, 2009/11/01, 2009/09/04, 2009/04/01 '2008/11/06, 2008/11/05, 2008/05/23, 2008/02/17, 2008/02/11 '2008/01/22, 2007/08/30, 2007/08/26, 2007/08/02, 2007/08/01 '2007/06/12, 2007/05/27, 2007/03/14, 2007/02/05, 2006/09/18 '2006/08/08, 2006/08/02, 2006/07/14, 2006/06/17, 2006/05/31 '2006/05/09, 2006/03/15, 2005/11/16, 2005/10/02, 2005/08/14 '2005/08/10, 2005/05/22, 2005/04/05, 2005/02/10, 2004/12/30 'show help information vari s_more, s_any, s_returnformore s_returnformore = "return for more" $out "// end add_mode" $out "* end with exporting if changes have been made" $out "** end without exporting" $out "x=456-37*1.6 find 456*37-1.6 left to right" $out "? means to show this help" $out "@ show line number of last used" $out "& show line number of last v" $out "^ show line number of list" $out "! show line number of tchapter" $out "+ line 8888888" $out "200k=200000 a k inside a number becomes 000" $inp s_any, s_returnformore $out "command & means whichever command with last v entered line" $out "command @ means whichever command with now line" $out "command ^ means whichever command with list1 line" $out "command ! means whichever command with tchapter line" $out "a37 add line 37 or 38 if 37 exists" $out "b345 show back lines from 345" $out #c"string1","string2",456 change string1 to string2 beg at 456# $out #c"str1","str2",456,500 change over range# $out " the strings must be in double quotes" $out "d45/48 to delete lines 45 through 48" $out "d to delete one line more if last was delete" $out "e83 to show the chapter containing line 83" $inp s_any, s_returnformore $out #f"string",500 to find string beginning at line 500# $out "f#string# to find string" $out #f"str1","str2","str3",500 find strings beginning at 500# $out "f,600 find previous string starting at 600, see ONE" $out #h"str1","str2","str3",500 to find strings beg at 500, no case# $out "i show information about the program" $out "j456 show lines and jump down to another show" $out "k26/50,75 kopy lines 26/50 to line 75" $out "k26,,75 kopy line 26 to line 75" $out "l56/70 list lines 56 to 70" $out "l56,70 q list lines 56 to 70 and show deleted records" $inp s_any, s_returnformore $out "m456 to modify line 456, see below for how" $out "o591 other, toggle beginning of line 591" $out "p591 to put ] line before 591" $out "...q ending a command means quiet mode" $out "q403 to show lines before and after 403" $out "r83 to show the chapter containing line 83" $out "s873,24 means view lines at 873 and at 24" $out "t83 to show the chapter containing line 83 and set b=bottom" $out "u45 add or update chapter update line" $out "v873,24 means view lines at 873 and at 24" $out "w732 wrap the paragraph beginning at 732" $out "w732,70,1 wrap at 732 for length 70 no 5 indentation" $out "x873,24 means view lines at 873 and at 24" $out "y show results of f, h, find or hunt, use past" $out "y345,3 show 3 lines of find results at record 345" $out "z873,24 view lines at 873 and 24" $inp s_any, s_returnformore $out "multi byte commands" $out "backe set e chapter back one chapter" $out "backr set r chapter back one chapter" $out "backt set t chapter back one chapter" $out "book show books in file" $out "book 4567 show books starting at line 4567" $out "book 4567 q show books with hash starting at 4567" $out "bulk 4567 show books,bulks starting at 4567" $out "case 45,70 change 45/70 to upper or lower case" $out "chap 345 show chapters in book at 345" $out "chap 345,10 show chapters and ten lines" $out "dash 570 insert above dash line at 570" $out "debug toggle debug" $out "cls clear screen" $inp s_any, s_returnformore $out "code 34,56 encode lines 34 to 56, beginning with ']E '" $out "code 34,56 decode lines 34 to 56" $out "columns 346,500 change columns over a range" $out "commas 405,622 put commas in numbers over range" $out "count 876/900 count lines and words in range 876/900" $out "file 345,360 line range 345/360 to file" $out #find"string" to fast find string# $out #hunt"string" to fast hunt string, case independent# $out "keep save .RAN file to .EXP file, record by record" $out "keepfifty .RAN file to .EXP file, 50 records at a time" $out "last 10 show last 10 records" $out "left 520,535 left justify line range 520/535" $out "lineshold 457 add line 457 to lineshold" $out "lineshold show lines in lineshold" $out "menu show the menu of choices" $out "menuprog programming menu" $out "money 926 money totalling and mode at 926" $inp s_any, s_returnformore $out "mode 1 set mode to 1=normal" $out "nexte set e chapter next one chapter" $out "nextr set r chapter next one chapter" $out "nextt set t chapter next one chapter" $out "note to see and add to the note" $out "oldtoe to oldtoe a file" $out #one"XX",458 works just like hunt but only finds one# $out "past show options for showing past finds" $out "past 3 to show third find past" $out #pattern "pattern","pattern in chars"# $out "patterns: escapes, space, punc, numbers, upper, lower, >126" $inp s_any, s_returnformore $out "push 589,4 to push line 589 down 4 lines" $out "redo to show last few commands" $out "redo 5 to redo command 5 shown by just redo" $out "renum 580, 872 to renumber of column over a range" $out "rpg to change to rpg mode" $out "save save .RAN file to .EXP file, whole file method" $out "seek 451 to find chapters having a string beg=451" $out "sortlines 59,90 sort lines" $out "system to show total string memory" $out "tall 35 to set the screen lines to 35" $out "thin to thin out lines over file" $out "time show the time line" $out "todo 245 put ] ToDo: line above 245" $out "top 545 find memo,chap,book put in e to show" $out "toprpg 545 find above subr or tag put in e to show" $out "total 570,580 to total a column in range 570/580" $out "undelete 81/96 undelete range 81/96 of lines" $out "xyz to show x, y and z edited" $inp s_any, s_returnformore $out "Help for Modify Mode" $out "m5328 enter modify mode for line 5328" $out "^ replace character above with blank" $out "^^^^ replace characters above with blanks" $out "|hello insert 'hello' at character above the |" $out "~ delete character above" $out "~~~~~ delete five characters above" $out "hello replace characters above with 'hello'" $out #"~" put in a tilde# $inp s_any, s_returnformore $out "Line beginning characters" $out ") begins a family formatted line" $out "] and a blank begins an absolute formatted line" $out "Genealogical keywords for persons" $out "Spouse:" $out "Paramour:" $out "Father:" $out "Mother:" $out "Grandfather:" $out "Grandmother:" $out "GGrandfather:" $out "GGrandmother:" $out "GGGrandfather:" $out "GGGrandmother:" $out "GGGGrandfather:" $out "GGGGrandmother:" $out "Brother:" $out "Sister:" $out "Uncle:" $out "Aunt:" $out "Bondsman:" $out "Witness:" $out "Minister:" $out "Child:" $out "Who:" $inp s_any, s_returnformore $out "Genealogical keywords for events" $out "Married:" $out "Born:" $out "Died:" $out "Will:" $out "Buried:" $out "Estate:" $out "Probate:" $out "Divorced:" $out "Baptized:" $out "Christened:" $out "See the chart for his family." $out "See the chart for her family." $out "Genealogical codes for military service" $out "F&I means the French and Indian War, 1755-1763" $out "REV means the American Revolution, 1776-1784" $out "W12 means the War of 1812, 1812-1815" $out "MEX means the Mexican War, 1844" $out "CSA means Confederate service, Civil War 1861-1865" $out "USA means Union service, Civil War 1861-1865" $out "WW1 means World War I, 1914-1918" $out "WW2 means World War II, 1941-1945" ends sub_help subr sub_initialize 'updated 2010/09/24, 2010/09/23, 2007/08/30, 2007/02/19, 2006/06/04 '2006/05/04, 2006/02/19, 2005/09/02, 2005/02/09, 2004/09/19 'initialize variables dift dg_maxlines = 0 'first time through only $trb sg_nothing, " " $ch$ sg_dashline, "-", 70 'for sub_xyz_math dg_xvalue = 0 dg_yvalue = 0 dg_zvalue = 0 sg_xyzmath = sg_nothing dg_maxlines = 19 endi dg_debug = 2 dg_quiet = 2 dg_bookcurrent = 1 dg_booklinetoshow = 1 dg_chaplinetoshow = 1 dg_nowline = 1 dg_ampline = 1 dg_linescount = 0 dg_add = 1 dg_modify = 1 dg_list1 = 1 dg_list2 = 1 sg_cmdredo = sg_nothing dg_outputindex = 1500 dg_echapter = 1 dg_rchapter = 1 dg_tchapter = 1 dg_view1s = 1 dg_view2s = 1 dg_view1v = 1 dg_view2v = 1 dg_view1z = 1 dg_view2z = 1 dg_view1x = 1 dg_view2x = 1 dg_findbegin = 1 dg_findend = 10 ^ 7 sg_find1 = sg_nothing sg_find2 = sg_nothing sg_find3 = sg_nothing sg_deletedlines = sg_nothing sg_1lineshold = sg_nothing sg_foundnum1 = sg_nothing sg_foundnum2 = sg_nothing sg_foundnum3 = sg_nothing sg_foundnum4 = sg_nothing sg_foundnum5 = sg_nothing sg_foundstr1 = sg_nothing sg_foundstr2 = sg_nothing sg_foundstr3 = sg_nothing sg_foundstr4 = sg_nothing sg_foundstr5 = sg_nothing sg_1linesbad = sg_nothing dg_linesbad = 0 dg_changes = 0 dg_wrapline = 0 dg_wraplong = 0 dg_kopy1 = 0 dg_kopy2 = 0 dg_kopy3 = 0 dg_shochap = 0 dg_jumpline = 0 dg_jumptop = 0 dg_paneline = 0 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog dg_mode = 1 dg_jumpmode = 0 sg_more = sg_nothing sg_surnames = sg_nothing sg_bookinfo = sg_nothing sg_booknames = sg_nothing sg_booksort = sg_nothing sg_bookchapter = sg_nothing ends sub_initialize subr sub_info 'updated 2010/09/23 '2010/06/05, 2007/02/06, 2006/05/04, 2005/02/09, 2004/06/27 'show information about the program vari d_any, s_any, d_dot, s_dot vari d_good, d_long d_good = 1 dift d_good = 1 $out sg_interpreter + " " + sg_path dsys d_any, 2 ded$ s_any, d_any, 0, 0 $out sg_build + " " + sg_loadprog + " " + s_any sub_path_prog_memory sub_speedquick $out sg_pass1 sub_more d_good = dg_more endi dift d_good = 1 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog $out "mode=" + dg_mode + ",1=normal,2=money,3=RPG,4=chef" flen d_long, sg_fileran d_long = d_long / 72 $out "the fixran code=" + sg_filecode $out "the fixran file=" + sg_fileran + ", records=" + d_long $out "the export file=" + sg_fileexp $out "the text file=" + sg_filetxt $out "the book file=" + sg_filebook sub_more d_good = dg_more endi dift d_good = 1 $out "changes=" + dg_changes $out "now line=" + dg_nowline dg_pass1 = dg_nowline sub_record_show $out "ampersand line=" + dg_ampline dg_pass1 = dg_ampline sub_record_show $out "add=" + dg_add dg_pass1 = dg_add sub_record_show $out "modify=" + dg_modify dg_pass1 = dg_modify sub_record_show $out "book=" + dg_bookcurrent dg_pass1 = dg_bookcurrent sub_record_show sub_more d_good = dg_more endi dift d_good = 1 $out "show chapter e=" + dg_echapter dg_pass1 = dg_echapter sub_record_show $out "show chapter r=" + dg_rchapter dg_pass1 = dg_rchapter sub_record_show $out "show chapter t=" + dg_tchapter dg_pass1 = dg_tchapter sub_record_show sub_more d_good = dg_more endi dift d_good = 1 'show last few deleted lines $out "deleted lines follow" $len d_long, sg_deletedlines d_dot = 1 dwhi d_dot <= d_long $cut s_dot, sg_deletedlines, d_dot, 80 $out s_dot d_dot = d_dot + 80 endw $out "last delete=" + dg_delete1 + "/" + dg_delete2 sub_more d_good = dg_more endi dift d_good = 1 $out "view s=" + dg_view1s + "/" + dg_view2s dg_pass1 = dg_view1s sub_record_show dg_pass1 = dg_view2s sub_record_show $out "view v=" + dg_view1v + "/" + dg_view2v dg_pass1 = dg_view1v sub_record_show dg_pass1 = dg_view2v sub_record_show $out "view x=" + dg_view1x + "/" + dg_view2x dg_pass1 = dg_view1x sub_record_show dg_pass1 = dg_view2x sub_record_show $out "view z=" + dg_view1z + "/" + dg_view2z dg_pass1 = dg_view1z sub_record_show dg_pass1 = dg_view2z sub_record_show $out "key=" + dg_key sub_more d_good = dg_more endi dift d_good = 1 $out "list=" + dg_list1 + "/" + dg_list2 dg_pass1 = dg_list1 sub_record_show dg_pass1 = dg_list2 sub_record_show $out "wrap=" + dg_wrapline + ", wraplong=" + dg_wraplong dg_pass1 = dg_wrapline sub_record_show $out "find begin=" + dg_findbegin $out "find end=" + dg_findend s_any = "find string = '" + sg_find1 + "' and string '" $app s_any, sg_find2 + "' and string '" $app s_any, sg_find3 + "'" $out s_any $out "kopy=" + dg_kopy1 + "/" + dg_kopy2 + "/" + dg_kopy3 dg_pass1 = dg_kopy1 sub_record_show dg_pass1 = dg_kopy2 sub_record_show dg_pass1 = dg_kopy3 sub_record_show sub_more d_good = dg_more endi dift d_good = 1 $out "jump=" + dg_jumptop dg_pass1 = dg_jumptop sub_record_show $out "lineshold=" + sg_1lineshold endi ends sub_info subr sub_cls 'updated 2007/10/10, 2005/06/16, 2005/02/10 vari d_any, s_any, d_dot, s_dot d_dot = 0 dwhi d_dot < 1000 $ch$ s_any, " ", 80 dran d_any d_any = d_any * 22 + 1 $rep s_any, d_any, "Teapro" dran d_any d_any = d_any * 22 + 27 $rep s_any, d_any, "Teapro" dran d_any d_any = d_any * 22 + 53 $rep s_any, d_any, "Teapro" $out s_any dinc d_dot endw ends sub_cls subr sub_note 'updated 2005/02/10 'keep note in sg_note vari d_any, s_any, d_dot, s_dot vari d_loop, s_line $trb sg_note, sg_note $len d_any, sg_note d_loop = 2 dift d_any > 0 d_loop = 1 s_line = sg_note endi dwhi d_loop = 1 $trb s_line, s_line $len d_any, s_line dift d_any < 71 $out s_line s_line = sg_nothing dinc d_loop else $bak d_dot, s_line, 71, " " dift d_dot = 0: d_dot = 71 d_any = d_dot - 1 $cut s_any, s_line, 1, d_any $out s_any $cut s_line, s_line, d_dot, 9999 endi endw $len d_any, sg_note dift d_any > 700: $cut sg_note, sg_note, 1, 700 $inp s_any, "type in additional note if wanted" $trb s_any, s_any $len d_any, s_any dift d_any > 0: $app sg_note, " " + s_any ends sub_note subr sub_list 'updated 2008/02/17, 2006/10/12, 2004/12/22 'list lines dg_pass1 to dg_pass2, save in dg_list1, dg_list2 'if dg_quiet=1 show deleted records also vari d_any, s_any, d_dot, s_dot vari d_loop, d_good, d_lines, d_beg, d_end, d_first vari d_record, s_record, d_byte, s_byte, d_long, d_count vari d_deletedrecord d_beg = dg_pass1 d_end = dg_pass2 dift d_beg > 0 dg_list1 = d_beg dg_list2 = d_end endi dift d_end > 0: dg_list2 = d_end dift dg_list2 < dg_list1: dg_list2 = dg_list1 'if dg_quiet=1 then show deleted records too d_record = dg_list1 d_count = 0 d_first = 0 d_lines = 0 d_loop = 1 dwhi d_loop = 1 d_good = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 d_deletedrecord = 2 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W" dinc d_good d_deletedrecord = 1 dift dg_quiet = 1: d_good = 1 endi endi dift d_good = 1 $cut s_record, s_record, 1, 70 dift d_first = 0: d_first = d_record dinc d_lines dift d_lines >= dg_maxlines d_lines = 1 sub_more dift dg_more <> 1 dinc d_good dinc d_loop endi endi endi dift d_good = 1 dift dg_quiet = 1 'if dg_quiet=1 show deleted records too $cut s_record, s_record, 1, 70 dto$ s_dot, d_record, 6, 0 s_any = " " dift d_deletedrecord = 1: s_any = "-" $out s_dot + s_any + s_record else 'show records dg_pass1 = d_record sub_record_show endi dinc d_count endi dinc d_record dift d_record > dg_list2: dinc d_loop endw $out "listed=" + d_count ends sub_list subr sub_case_lines 'updated 2005/11/16 vari d_any, s_any, d_dot, s_dot vari d_loop, d_good, s_line, d_lower, d_beg, d_end vari d_record, s_record, d_byte, s_byte, d_long d_beg = dg_pass1 d_end = dg_pass2 d_lower = 1 $inp s_any, "1=lower case, 2=upper" $ift s_any <> "1": dinc d_lower dift d_end = 0: d_end = d_beg d_record = d_beg d_loop = 1 dwhi d_loop = 1 d_good = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_line, s_record, 1, 70 $cup s_line, s_line dift d_lower = 1: $clo s_line, s_line $rep s_record, 1, s_line fwri d_any, sg_fileran, d_byte, s_line dbad d_any = 0 dinc dg_changes dg_pass1 = d_record sub_record_show endi dinc d_record dift d_record > d_end: dinc d_loop endw ends sub_case_lines subr sub_modify1 'updated 2009/02/16, 2004/10/21 'modify record dg_pass1 vari d_any, s_any, d_dot, s_dot vari s_blanks, s_char10 vari s_nums, d_chan, s_line, d_good, d_loop, s_modline vari d_record, s_record, d_byte, s_byte, d_long, s_quote d_record = dg_pass1 dch$ s_blanks, 32, 1 dch$ s_char10, 10, 1 'modify the next line if d_record = 0 dift d_record = 0 d_record = dg_modify d_loop = 1 dwhi d_loop = 1 dinc d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long = 72 $cut s_byte, s_record, 71, 1 $ift s_byte = "W": dinc d_loop else dinc d_loop endi endw endi 'dg_modify is the modify record number dift d_record = 0: d_record = dg_modify dift d_record > 0: dg_modify = d_record 'read in the record into s_record d_good = 1 d_byte = dg_modify - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72: dinc d_good dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 'build up numbered line s_nums = "1234567890" $app s_nums, s_nums+ s_nums+ s_nums+ s_nums+ s_nums+ s_nums 'put a " into s_quote dch$ s_quote, 34, 1 d_chan = 0 d_loop = 1 dwhi d_loop = 1 'prep the rec to modify dch$ s_blanks, 32, 80 $app s_record, s_blanks $cut s_record, s_record, 1, 70 s_any = "Modify record=" + dg_modify $app s_any, ", use #x# to put in x or use #128#" $out s_any 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog dift dg_mode = 2 $out "$10 puts 10 for October under M to reconcile" endi 'output modify prompts based on dg_mode sub_lines_add_modify $out sg_pass1 $inp s_modline, s_record 'do a right trim $trr s_modline, s_modline $len d_long, s_modline dift d_long > 70 $cut s_modline, s_modline, 1, 70 d_long = 70 endi dift d_long = 0: dinc d_loop dift d_loop = 1 'send s_record to be modified by s_modline sg_pass1 = s_record sg_pass2 = s_modline sub_modify2 'the return values s_record = sg_pass1 dift dg_pass1 > 0: dinc d_chan endi endw 'were changes made, then write back to the file dift d_chan > 0 'prep the record dch$ s_blanks, 32, 80 $app s_record, s_blanks $cut s_record, s_record, 1, 70 $app s_record, "W" + s_char10 'dg_modify has the modify record number d_byte = dg_modify - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 dift dg_nowline <> dg_modify: dg_ampline = dg_nowline dg_nowline = dg_modify dinc dg_changes endi endi ends sub_modify1 subr sub_modify2 'updated 2002/09/17 'modify sg_pass1 from sg_pass2 'and return number of changes in dg_pass1 vari d_any, s_any, d_dot, s_dot vari d_chan, s_modline, d_good vari s_record, d_record, d_byte, s_byte, d_long s_record = sg_pass1 s_modline = sg_pass2 d_chan = 0 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog 'if in money mode a $10 puts a 10 under M in 49 to reconcile dift dg_mode = 2 'in money mode $10 puts a 10 for October in place in 49 'money record format '1/1 $ record ID '3/6 check number '8/15 date '17/56 description '58/59 reconciliation month '61/70 delta d_good = 1 'we must have a $ in 1 $cut s_any, s_modline, 1, 1 $ift s_any <> "$": dinc d_good 'we cannot have a blank in 2 $cut s_any, s_modline, 2, 1 $ift s_any = " ": dinc d_good dift d_good = 1 $cut s_any, s_modline, 2, 80 $trr s_any, s_any $isd d_any, s_any dift d_any <> 1: dinc d_good endi dift d_good = 1 $tod d_any, s_any dift d_any < 1: dinc d_good dift d_any > 12: dinc d_good endi dift d_good = 1 $app s_any, " " $cut s_any, s_any, 1, 2 $rep s_record, 58, s_any dinc d_chan s_modline = " " endi endi 'special characters are ^,~ and | we can put in if #^# 'with no other modification $trb s_any, s_modline $len d_any, s_any dift d_any = 3 d_good = 1 $cut s_byte, s_any, 1, 1 $ift s_byte <> "#": dinc d_good $cut s_byte, s_any, 3, 1 $ift s_byte <> "#": dinc d_good dift d_good = 1 'get the special character into s_any $cut s_any, s_any, 2, 1 $lok d_any, s_modline, 1, s_any dift d_any > 0 $rep s_record, d_any, s_any s_modline = " " dinc d_chan endi endi endi 'special characters by number ie. #128# 'with no other modification $trb s_dot, s_modline $len d_any, s_dot dift d_any = 5 d_good = 1 $cut s_byte, s_dot, 1, 1 $ift s_byte <> "#": dinc d_good $cut s_byte, s_dot, 5, 1 $ift s_byte <> "#": dinc d_good dift d_good = 1 'is it a number $cut s_byte, s_dot, 2, 3 $isd d_any, s_byte dift d_any <> 1: dinc d_good endi dift d_good = 1 $tod d_dot, s_byte dift d_dot < 0: dinc d_good dift d_dot > 255: dinc d_good endi dift d_good = 1 'get the special character into s_dot dch$ s_dot, d_dot, 1 'where does it go $trr s_any, s_modline $len d_dot, s_any d_dot = d_dot - 4 $rep s_record, d_dot, s_dot s_modline = " " dinc d_chan endi endi 'delete characters in s_record by ~ in s_modline $len d_long, s_modline d_byte = 1 dwhi d_byte <= d_long $cut s_byte, s_modline, d_byte, 1 $ift s_byte = "~" 'delete byte d_byte from s_record and from s_modline $del s_record, d_byte, 1 $del s_modline, d_byte, 1 'decrease the length by one ddec d_long dinc d_chan else dinc d_byte endi endw 'insert characters $trr s_modline, s_modline $lok d_dot, s_modline, 1, "|" dift d_dot > 0 'get the insert string and insert d_any = d_dot + 1 $cut s_any, s_modline, d_any, 80 'replace carets in s_any with blanks $lok d_any, s_any, 1, "^" dwhi d_any > 0 $rep s_any, d_any, " " $lok d_any, s_any, 1, "^" endw $ins s_record, d_dot, s_any dinc d_chan else 'get replace string $trb s_any, s_modline $len d_any, s_any dift d_any > 0 'where does s_any begin in s_modline $lok d_dot, s_modline, 1, s_any 'replace carets in s_any with blanks $lok d_any, s_any, 1, "^" dwhi d_any > 0 $rep s_any, d_any, " " $lok d_any, s_any, 1, "^" endw 'replace $rep s_record, d_dot, s_any dinc d_chan endi endi $cut s_dot, s_record, 1, 2 $ift s_dot = "]-" $ch$ s_any, "-", 68 s_record = s_dot + s_any endi 'send a value to dg_pass1 = d_chan sg_pass1 = s_record ends sub_modify2 subr sub_add1 'updated 2011/05/04, 2001/01/10 'add some records starting at dg_pass1 or dg_add vari d_loop, d_add, d_onetime d_add = dg_pass1 dift d_add = 0: d_add = dg_add dg_add = d_add d_onetime = 1 d_loop = 1 dwhi d_loop = 1 'dg_add is where it will add dg_pass1 = d_onetime sub_add2 d_loop = dg_pass1 dinc d_onetime endw ends sub_add1 subr sub_add2 'updated 2011/12/10 '2011/05/04, 2009/01/18, 2006/12/28, 2006/05/09, 2004/10/21 'add a record at dg_add or one below it vari d_any, s_any, d_dot, s_dot, s_tap, d_tap vari d_hold, d_long, s_blanks, d_onetime vari s_inputrecord, s_record, d_byte, s_byte 'we want to list prev rec only onetime d_onetime = dg_pass1 'is dg_add beyond the end of the file 'then make dg_add at the last record flen d_any, sg_fileran d_any = d_any \ 72 + 1 dift dg_add > d_any: dg_add = d_any 'if dg_add is a good record add one to it d_byte = dg_add - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long = 72 $cut s_byte, s_record, 71, 1 $ift s_byte = "W": dinc dg_add 'do we need to do a push d_byte = dg_add - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long = 72 $cut s_byte, s_record, 71, 1 $ift s_byte = "W" 'for simplicity lets do a push of 10 here 'hold dg_add here so it will not be pushed d_hold = dg_add dg_pass1 = dg_add dg_pass2 = 10 sub_push dg_add = d_hold endi endi endi dift d_onetime = 1 'show last good record before dg_add dg_pass1 = dg_add dg_pass2 = 1 sub_show_lines_before endi 'prompts for add_mode $out "add record=" + dg_add + " use // to end" 'output add/modify prompts based on dg_mode sub_lines_add_modify $inp s_inputrecord, sg_pass1 'do a right trim to see if we have just blanks $trr s_inputrecord, s_inputrecord 'we have a record or two to add $ift s_inputrecord <> "//" $ift s_inputrecord = ")": s_inputrecord = "]" 'prep the record $ch$ s_blanks, " ", 80 $app s_inputrecord, s_blanks 'if ) and second byte not blank make ] $cut s_any, s_inputrecord, 1, 1 $ift s_any = ")" $cut s_any, s_inputrecord, 2, 1 $ift s_any <> " ": $rep s_inputrecord, 1, "]" endi 'do we have a dash record $cut s_any, s_inputrecord, 1, 2 $ift s_any = "]-" $ch$ s_any, "-", 69 s_inputrecord = "]" + s_any + s_blanks endi 'do we have an asterisk record $cut s_any, s_inputrecord, 1, 2 $ift s_any = "]*" $ch$ s_any, "*", 69 s_inputrecord = "]" + s_any + s_blanks endi 'get first 70 $cut s_record, s_inputrecord, 1, 70 'get rest if any at most two allowed $cut s_inputrecord, s_inputrecord, 71, 70 'arrange the record sg_pass1 = s_record sub_arrange_record s_record = sg_pass1 'do we have a money record 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog dift dg_mode = 2 sg_pass1 = s_record sub_arrange_money s_record = sg_pass1 endi $cut s_record, s_record, 1, 70 dch$ s_any, 10, 1 $app s_record, "W" + s_any 'write the record d_byte = dg_add - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 $trb s_record, s_inputrecord $len d_long, s_record dift d_long > 0 'we have a trailing record to add 'we do nothing fancy to a trailing record $app s_record, s_blanks $cut s_record, s_record, 1, 70 dch$ s_any, 10, 1 $app s_record, "W" + s_any dinc dg_add 'for simplicity lets do a push of 5 here 'hold dg_add here so it will not be pushed d_hold = dg_add dg_pass1 = dg_add dg_pass2 = 5 sub_push dg_add = d_hold 'write the record d_byte = dg_add - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 dinc dg_changes endi dift dg_nowline <> dg_add: dg_ampline = dg_nowline dg_nowline = dg_add dg_modify = dg_add - 1 dinc dg_changes dg_pass1 = 1 else 'no record was entered dg_pass1 = 0 endi ends sub_add2 subr sub_arrange_record 'updated 2007/06/12, 2002/03/18 'arrange a fixran record in sg_pass1 vari d_any, s_any, d_dot, s_dot vari s_record, s_line, d_good, d_long, d_underline, d_space, d_loop vari s_name, s_other, s_descent, s_war, s_sex, s_dates vari d_name, d_other, d_descent, d_war, s_dquote, d_count s_record = sg_pass1 '34 is " dch$ s_dquote, 34, 1 d_good = 1 s_line = s_record $trr s_line, s_line $len d_any, s_line dift d_any < 8: dinc d_good dift d_good = 1 $cut s_any, s_record, 1, 1 $ift s_any <> ")": dinc d_good 'family lines except ]C begin with ) $cut s_any, s_record, 1, 2 $ift s_any = "]C": d_good = 1 endi dift d_good = 1 s_line = s_record 'do the items that begin in 11 $lok d_dot, s_line, 1, "Married: " dift d_dot = 0: $lok d_dot, s_line, 1, "Born: " dift d_dot = 0: $lok d_dot, s_line, 1, "Died: " dift d_dot = 0: $lok d_dot, s_line, 1, "Will: " dift d_dot = 0: $lok d_dot, s_line, 1, "Buried: " dift d_dot = 0: $lok d_dot, s_line, 1, "Estate: " dift d_dot = 0: $lok d_dot, s_line, 1, "Probate: " dift d_dot = 0: $lok d_dot, s_line, 1, "Divorced: " dift d_dot = 0: $lok d_dot, s_line, 1, "Baptized: " dift d_dot = 0: $lok d_dot, s_line, 1, "Christened: " dift d_dot = 0: $lok d_dot, s_line, 1, "See the chart for " dift d_dot = 0: $lok d_dot, s_line, 1, "Father: " dift d_dot = 0: $lok d_dot, s_line, 1, "Mother: " dift d_dot = 0: $lok d_dot, s_line, 1, "GGGGrandfather: " dift d_dot = 0: $lok d_dot, s_line, 1, "GGGGrandmother: " dift d_dot = 0: $lok d_dot, s_line, 1, "GGGrandfather: " dift d_dot = 0: $lok d_dot, s_line, 1, "GGGrandmother: " dift d_dot = 0: $lok d_dot, s_line, 1, "GGrandfather: " dift d_dot = 0: $lok d_dot, s_line, 1, "GGrandmother: " dift d_dot = 0: $lok d_dot, s_line, 1, "Grandfather: " dift d_dot = 0: $lok d_dot, s_line, 1, "Grandmother: " dift d_dot = 0: $lok d_dot, s_line, 1, "Brother: " dift d_dot = 0: $lok d_dot, s_line, 1, "Sister: " dift d_dot = 0: $lok d_dot, s_line, 1, "Uncle: " dift d_dot = 0: $lok d_dot, s_line, 1, "Aunt: " dift d_dot = 0: $lok d_dot, s_line, 1, "Bondsman: " dift d_dot = 0: $lok d_dot, s_line, 1, "Witness: " dift d_dot = 0: $lok d_dot, s_line, 1, "Minister: " 'Who: and Child: now begin in 3 as does Spouse: 'dift d_dot = 0: $lok d_dot, s_line, 1, "Child: " 'dift d_dot = 0: $lok d_dot, s_line, 1, "Who: " dift d_dot > 0 'we have a ) line that should start in 11 $cut s_line, s_line, d_dot, 80 $ch$ s_any, " ", 9 s_line = ")" + s_any + s_line $trr s_line, s_line $len d_long, s_line dift d_long > 70 'if too long try taking out unneeded blanks d_loop = 1 dwhi d_loop = 1 $lok d_any, s_line, 11, " " dift d_any > 0 $del s_line, d_any, 1 $len d_any, s_line dift d_any <= 70: dinc d_loop else dinc d_loop endi endw endi 'if not too long make new record $len d_long, s_line dift d_long > 70: dinc d_good else 'here we have a ) line that should start in 3 $cut s_any, s_line, 2, 1 $ift s_any = " " d_count = 0 d_loop = 1 dwhi d_loop = 1 $cut s_any, s_line, 3, 1 $ift s_any = " " $del s_line, 3, 1 dinc d_count dift d_count > 70: dinc d_loop else dinc d_loop endi endw endi endi endi dift d_good = 1 'make the line 70 long $ch$ s_any, " ", 80 $app s_line, s_any $cut s_line, s_line, 1, 70 s_record = s_line 'do we have a name line $lok d_underline, s_line, 1, "_" dift d_underline = 0 dinc d_good else d_any = d_underline + 3 $cut s_any, s_line, d_any, 1 $ift s_any = "@": dinc d_good endi dift d_good <> 1 'do we have a "]CHAP" with \gen005 $cut s_any, s_line, 1, 5 $ift s_any = "]CHAP" $lok d_dot, s_line, 1, "\gen0" dift d_dot > 0 $cut s_dot, s_line, d_dot, 7 $rep s_line, d_dot, " " $cut s_any, s_line, 52, 7 $ift s_any = " " $rep s_line, 52, s_dot else $rep s_line, d_dot, s_dot endi s_record = s_line endi endi endi endi dift d_good = 1 'get the six parts of a name record 's_name, s_other, s_descent, s_war, s_sex, s_dates '5 6 7 '89012345678901234567890 '\ABC CSA M.1840-1870 'get the name with the Jr if any on it $lok d_dot, s_line, d_underline, " " ddec d_dot $cut s_name, s_line, 1, d_dot dinc d_dot $cut s_line, s_line, d_dot, 100 'get the sex and dates $len d_long, s_line $bak d_any, s_line, d_long, "M." $bak d_dot, s_line, d_long, "F." dift d_any > d_dot: d_dot = d_any dift d_dot = 0: dinc d_good endi dift d_good = 1 $cut s_sex, s_line, d_dot, 2 d_any = d_dot + 2 $cut s_dates, s_line, d_any, 100 ddec d_dot $cut s_line, s_line, 1, d_dot 'find the s_war s_war = sg_nothing $lok d_any, s_line, 1, "REV" dift d_any = 0: $lok d_any, s_line, 1, "F&I" dift d_any = 0: $lok d_any, s_line, 1, "W12" dift d_any = 0: $lok d_any, s_line, 1, "MEX" dift d_any = 0: $lok d_any, s_line, 1, "CSA" dift d_any = 0: $lok d_any, s_line, 1, "USA" dift d_any = 0: $lok d_any, s_line, 1, "CUB" dift d_any = 0: $lok d_any, s_line, 1, "WW1" dift d_any = 0: $lok d_any, s_line, 1, "WW2" dift d_any > 0 $cut s_war, s_line, d_any, 3 $rep s_line, d_any, " " endi 'find the descent tag and the other '89012345678901234567890 '\ABCDEFGHIJ F.1910-1996 $trb s_line, s_line $lok d_dot, s_line, 1, "\" dift d_dot > 0 $cut s_descent, s_line, d_dot, 100 ddec d_dot $cut s_other, s_line, 1, d_dot else s_descent = sg_nothing s_other = s_line endi 'we now have s_name, s_other, s_descent, s_sex and s_dates endi dift d_good = 1 '89012345678901234567890 '\ABCDEFGHIJ F.1910-1996 'prep s_dates $trb s_dates, s_dates $len d_long, s_dates dift d_long < 2: s_dates = " - " dift d_long = 4: $app s_dates, "- " dift d_long = 5 $cut s_any, s_dates, 1, 1 $ift s_any = "-" s_dates = " " + s_dates else $cut s_any, s_dates, 5, 1 $ift s_any = "-" $app s_dates, " " else dinc d_good endi endi endi endi dift d_good = 1 'prep parts and their lengths $trb s_name, s_name $trb s_other, s_other $trb s_descent, s_descent $trb s_war, s_war $len d_name, s_name $len d_other, s_other $len d_descent, s_descent $len d_war, s_war 'if left of s_other is not capital letter add left space dift d_other > 0 $cut s_any, s_other, 1, 1 $ift s_any < "A": s_other = " " + s_other $ift s_any > "Z": s_other = " " + s_other $len d_other, s_other endi '89012345678901234567890 '\ABCDEF CSA F.1910-1996 old 'CSA \ABCDEF F.1910-1996 new 'put them together to test length s_line = s_sex + s_dates dift d_descent > 0: s_line = s_descent + " " + s_line dift d_war > 0: s_line = s_war + " " + s_line dift d_other > 0: $app s_name, " " + s_other s_any = s_name + " " + s_line $len d_long, s_any dift d_long > 70: dinc d_good endi dift d_good = 1 ddec d_long d_long = 70 - d_long dch$ s_any, 32, d_long s_record = s_name + s_any + s_line endi sg_pass1 = s_record ends sub_arrange_record subr sub_arrange_money 'updated 2006/05/27, 2005/11/05, 2002/07/24 'arrange a fixran money record in sg_pass1 vari d_any, s_any, d_dot, s_dot, d_yes vari s_record, s_line, d_good, d_long, d_byte vari s_checknum, s_date, s_description vari s_recomonth, s_money, d_money s_record = sg_pass1 'do we have a money record d_good = 1 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog dift dg_mode <> 2: dinc d_good $cut s_any, s_record, 1, 2 $ift s_any <> "$ ": dinc d_good dift d_good = 1 s_checknum = sg_nothing s_date = sg_nothing s_description = sg_nothing s_money = sg_nothing 'get rid of the '$ ' $cut s_line, s_record, 2, 80 $trb s_line, s_line $lok d_byte, s_line, 1, " " $cut s_checknum, s_line, 1, d_byte $cut s_line, s_line, d_byte, 80 $trb s_checknum, s_checknum $trb s_line, s_line 'is s_checknum a check number or the date $isd d_any, s_checknum dift d_any = 1 'we have a check number get the date $lok d_byte, s_line, 1, " " $cut s_date, s_line, 1, d_byte $cut s_line, s_line, d_byte, 80 $trb s_date, s_date $trb s_line, s_line else 'there is no check number s_date = s_checknum s_checknum = sg_nothing endi 'we have the check number and the date 'get the money $len d_long, s_line $bak d_byte, s_line, d_long, " " $cut s_money, s_line, d_byte, 80 $trb s_money, s_money $cut s_line, s_line, 1, d_byte $trb s_line, s_line 'format s_money $isd d_any, s_money dift d_any = 1 $tod d_money, s_money dto$ s_money, d_money, 10, 2 endi 'get the recon month = s_recomonth $len d_long, s_line $bak d_byte, s_line, d_long, " " $cut s_recomonth, s_line, d_byte, 80 $trb s_recomonth, s_recomonth 'is this a recon month or not d_yes = 1 $len d_any, s_recomonth dift d_any > 2: dinc d_yes dift d_any < 1: dinc d_yes $ist d_any, s_recomonth, "9" dift d_any = 1 $tod d_dot, s_recomonth dift d_dot < 1: dinc d_yes dift d_dot > 12: dinc d_yes '99 means other bank transaction dift d_dot = 99: d_yes = 1 else dinc d_yes endi dift d_yes = 1 'we have a recon month in s_recomonth s_recomonth = "0" + s_recomonth $off s_recomonth, s_recomonth, 2 $cut s_description, s_line, 1, d_byte else 'we do not have a recon month s_recomonth = " " s_description = s_line endi $trb s_description, s_description 'we have a money record '1/1 $ record ID '3/6 check number = s_checknum '8/15 date = s_date '17/56 description = s_description '58/59 reconciliation month = s_recomonth '61/70 delta amount = s_money 'make sure none are too long $cut s_checknum, s_checknum, 1, 4 $cut s_date, s_date, 1, 8 $cut s_description, s_description, 1, 40 $cut s_recomonth, s_recomonth, 1, 2 $cut s_money, s_money, 1, 10 'we have the fields so build the record $ch$ s_record, " ", 70 $rep s_record, 1, "$" $rep s_record, 3, s_checknum $rep s_record, 8, s_date $rep s_record, 17, s_description $rep s_record, 58, s_recomonth $rep s_record, 61, s_money endi sg_pass1 = s_record ends sub_arrange_money subr sub_lines_add_modify 'updated 2006/05/18, 2001/01/09 'output add or modify by mode vari d_any, s_any, d_dot, s_dot 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog 'if in money mode dift dg_mode = 2 dch$ s_any, 32, 70 $rep s_any, 1, "$ Chk# Date Description" $rep s_any, 58, "M" $rep s_any, 61, "Delta" $out s_any endi 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog 'if in RPG mode dift dg_mode = 3 s_any = "RPG CSR 99 TERM1 COMM TERM2" $app s_any, " RESULT 82H999798" $out s_any endi 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef dift dg_mode = 4 dch$ s_any, 32, 70 $rep s_any, 1, "] Quantity" $rep s_any, 14, "Measurement" $rep s_any, 29, "Preparation" $rep s_any, 51, "Ingredient" $out s_any endi 'build up numbered line s_any = "1234567890" $app s_any, s_any + s_any + s_any + s_any + s_any + s_any sg_pass1 = s_any ends sub_lines_add_modify subr sub_delete 'updated 2010/07/03, 2009/02/16, 2008/10/03, 2006/10/14 '2006/10/02, 2006/08/09, 2005/09/02, 2005/04/11, 2003/06/14 'delete lines dg_pass1 through dg_pass2 vari d_any, s_any, d_dot, s_dot vari d_beg, d_end, d_loop, d_good, d_count, d_total vari d_record, s_record, d_byte, s_byte, d_long vari d_process, d_toshow, d_show, d_action d_beg = dg_pass1 d_end = dg_pass2 d_process = 1 dift d_process = 1 dift d_beg = 0: d_end = 0 dift d_end = 0: d_end = d_beg dift d_beg = 0 dift dg_delete2 = 0: dinc d_process endi endi dift d_process = 1 dift d_beg = 0 'if zero start where we left off and delete one 'find next undeleted record from previous delete dg_pass1 = dg_delete2 sub_next_undeleted_record d_beg = dg_pass1 d_end = d_beg endi 'only one needed if only d_beg dift d_end = 0: d_end = d_beg 'validate dift d_beg > d_end: dinc d_process dift d_beg < 1: dinc d_process endi 'how many lines is this put in d_total d_toshow = dg_maxlines - 5 d_total = 0 d_record = d_beg d_loop = d_process dwhi d_loop = 1 d_action = 0 d_good = 1 d_show = 2 'calc bytes and read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'if we read a record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 'is it a good record $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 dinc d_total dift d_total < d_toshow d_show = 1 else d_any = d_record % 100 dift d_any = 0: $sho "delete prep=" + d_record endi $cut s_any, s_record, 1, 1 $ift s_any = "]" 'show lines like ]A where A=anything $cut s_any, s_record, 2, 1 $ift s_any <> " ": d_show = 1 endi endi dift d_show = 1 dg_pass1 = d_record sub_record_show endi dinc d_record dift d_record > d_end: dinc d_loop endw dift d_total = 0: dinc d_process dift d_total > 5 d_loop = 1 dwhi d_loop = 1 s_any = "1=delete lines " + d_beg + "/" + d_end $app s_any, ", total=" + d_total $app s_any, " lines, 2=do not delete" $inp s_any, s_any $ift s_any = "1": dinc d_loop $ift s_any = "2" dinc d_loop dinc d_process endi endw endi dift d_process = 1 dg_delete1 = d_beg dg_delete2 = d_end endi 'd_total is how many lines to delete 'd_count is how many deleted d_count = 0 d_record = d_beg d_loop = d_process dwhi d_loop = 1 d_good = 1 'calc bytes and read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'if we read a record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 'tell d_any = d_record % 100 dift d_any = 0: $sho d_record 'is it a good record $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 'if good record beyond delete range then end dift d_record > d_end dinc d_good dinc d_loop dg_ampline = dg_nowline dg_nowline = d_record dg_modify = d_record endi endi dift d_good = 1 $cut s_dot, s_record, 1, 1 $ift s_dot = "]" $cut s_any, s_record, 2, 1 $ift s_any = " ": s_dot = " " $ift s_any = "-": s_dot = " " endi $ift s_dot = "]" d_any = d_total - d_count $out "lines left to delete=" + d_any dg_pass1 = d_record sub_record_show $inp s_any, "return to continue else *" $ift s_any = "*" dinc d_good dinc d_loop endi endi endi dift d_good = 1 'delete $rep s_record, 71, "d" fwri d_any, sg_fileran, d_byte, s_record dift d_any = 0: $out "not deleted=" + d_record dinc dg_changes dinc d_count 'save in sg_deletedlines $off sg_deletedlines, sg_deletedlines, 900 $cut s_dot, s_record, 1, 70 $ch$ s_any, " ", 80 s_dot = d_record + " " + s_dot + s_any $cut s_dot, s_dot, 1, 80 $app sg_deletedlines, s_dot endi dinc d_record endw dift d_process = 1 $out "deleted=" + d_beg + "/" + d_end + ", count=" + d_count else $out "no records deleted" endi ends sub_delete subr sub_undelete 'updated 2009/02/16, 2008/02/01, 2003/06/14 'undelete line range dg_pass1/dg_pass2 vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_byte, s_byte, d_long, d_nostop vari d_beg, d_end, s_zzzz, s_char10, d_good, d_loop d_beg = dg_pass1 d_end = dg_pass2 'make a string of z repeated 70 times $ch$ s_zzzz, "z", 70 dch$ s_char10, 10, 1 dift d_end = 0: d_end = d_beg d_record = d_beg d_nostop = 2 d_loop = 1 dift d_beg > d_end: dinc d_loop dift d_beg < 1: dinc d_loop dwhi d_loop = 1 'calc bytes and read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'if we read a record d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 'if the record is deleted undelete it $cut s_byte, s_record, 71, 1 $ift s_byte = "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 $ift s_record = s_zzzz: dinc d_good endi dift d_good = 1 $out d_record + " " + s_record dift d_nostop <> 1 s_any = "enter to undelete, n=no, *=stop, all=all, " $app s_any, "to go=" + d_record + "/" + d_end $inp s_any, s_any $cup s_any, s_any $ift s_any = "*" dinc d_good dinc d_loop endi $ift s_any = "N": dinc d_good $ift s_any = "ALL": d_nostop = 1 endi endi dift d_good = 1 'write back to file s_record = s_record + "W" + s_char10 fwri d_any, sg_fileran, d_byte, s_record dift d_any = 0: $out "not undeleted=" + d_record 'show undeleted record dg_pass1 = d_record sub_record_show dift dg_nowline <> d_record: dg_ampline = dg_nowline dg_nowline = d_record dg_modify = d_record - 1 dinc dg_changes endi dinc d_record dift d_record > d_end: dinc d_loop endw $out "undeleted=" + d_beg + "/" + d_end ends sub_undelete subr sub_next_undeleted_record 'updated 2002/02/11 'find the first good record from dg_pass1 vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_byte, s_byte, d_long vari d_loop, d_findrecord, s_findrecord, d_good 'find next undeleted record d_record = dg_pass1 d_findrecord = 0 s_findrecord = sg_nothing d_loop = 1 dwhi d_loop = 1 d_good = 1 'calc bytes and read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'if we read a record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 'is it a good record $cut s_byte, s_record, 71, 1 $ift s_byte = "W" dinc d_loop d_findrecord = d_record $cut s_findrecord, s_record, 1, 70 endi endi dinc d_record endw dg_pass1 = d_findrecord sg_pass1 = s_findrecord ends sub_next_undeleted_record subr sub_count_everything 'updated 2007/09/29, 2004/12/22 'count items in chapter vari d_any, s_any, d_dot, s_dot vari d_loop, d_count, d_good, s_out vari d_charnum, d_prevnum, d_wordpos vari d_wordcount, d_lines, d_dashes, d_chars, d_wordvalue vari d_record, s_record, d_byte, s_byte, d_long, d_end d_record = dg_pass1 d_end = dg_pass2 d_wordvalue = 0 d_dashes = 0 d_wordcount = 0 d_lines = 0 d_count = 0 d_loop = 1 dwhi d_loop = 1 d_any = d_record % 1000 dift d_any = 0: $sho "chapter count=" + d_record 'calc bytes and read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 $len d_long, s_record 'if we read a record dift d_long <> 72 $out "end of file" dinc d_good dinc d_loop endi dift d_good = 1 'is the record good $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 1, 2 $ift s_any = "]-" dinc d_dashes dinc d_lines dinc d_good endi endi dift d_good = 1 'we want to count this record dinc d_lines d_prevnum = 0 d_wordpos = 0 d_dot = 1 dwhi d_dot <= 70 'count word beginnings $cut s_dot, s_record, d_dot, 1 $chd d_charnum, s_dot dift d_charnum <= 32: d_charnum = 0 dift d_charnum > 126: d_charnum = 0 d_chars = d_chars + d_charnum dift d_prevnum = 0 dift d_charnum > 0 dinc d_wordcount d_wordpos = 0 endi endi dinc d_wordpos d_wordvalue = d_charnum * d_wordpos + d_wordvalue d_prevnum = d_charnum dinc d_dot endw endi dinc d_record dift d_record > d_end: dinc d_loop endw s_out = "lines=" + d_lines + ", words=" + d_wordcount $app s_out, ", dashes=" + d_dashes ded$ s_any, d_chars, 0, 0 $app s_out, ", chars=" + s_any ded$ s_any, d_wordvalue, 0, 0 $app s_out, ", wordvalue=" + s_any $out s_out ends sub_count_everything subr sub_jump 'updated 2008/03/25, 2006/09/16, 2003/09/03 'jump on a few more lines vari d_any, s_any, d_dot, s_dot, s_out vari d_loop, d_count, d_good, d_firstline vari d_record, s_record, d_byte, s_byte, d_long d_record = dg_pass1 'do we come from j $ift sg_cmd0 = "j" dift d_record = 0: d_record = dg_jumptop else dift dg_paneline > 0: d_record = dg_paneline endi dift d_record < 1: d_record = 1 dg_jumptop = d_record dg_jumpline = d_record d_firstline = 0 dg_paneline = 0 dg_jumpmode = 1 d_count = 0 d_loop = 1 dwhi d_loop = 1 d_good = 1 'calc bytes and read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'if we read a record dift d_long <> 72 $out "end of file" dinc d_good dinc d_loop endi dift d_good = 1 'is the record good $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 dift d_firstline = 0: d_firstline = d_record dift d_record > d_firstline 'keep track of the latest panebreak in dg_paneline $cut s_any, s_record, 1, 2 $ift s_any = "]-": dg_paneline = d_record $trr s_any, s_record $ift s_any = "]": dg_paneline = d_record + 1 endi 'show the record dg_pass1 = d_record sub_record_show dg_jumpline = d_record dinc d_count dift d_count >= dg_maxlines: dinc d_loop endi dinc d_record endw dift dg_paneline = 0: dg_paneline = dg_jumpline + 1 ends sub_jump subr sub_back 'updated 2006/10/12, 2004/07/23 'show dg_maxlines back from dg_backline vari d_any, s_any, d_dot, s_dot vari d_loop, d_count, d_total, d_hold, d_good vari d_record, s_record, d_byte, s_byte, d_long d_record = dg_pass1 dift d_record = 0: d_record = dg_backline dg_backline = d_record d_count = 0 d_hold = 0 d_loop = 1 dwhi d_loop = 1 'read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'is the record a good one d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 d_hold = d_record dinc d_count dift d_count >= dg_maxlines: dinc d_loop endi ddec d_record dift d_record < 1: dinc d_loop endw 'set dg_pass1 and dg_pass2 dg_pass1 = d_hold dg_pass2 = d_count sub_show_lines_after ends sub_back subr sub_view 'updated 2007/08/02, 2007/08/01, 2007/05/27, 2007/02/01 '2007/01/31, 2005/06/08, 2005/02/09, 2005/02/07, 2004/02/09 'view some lines beginning in dg_pass1 'or two sets in dg_pass1 and dg_pass2 'with lines to show in dg_pass3 vari d_any, s_any, d_dot, s_dot vari d_vue1, d_vue2, d_lines, d_maxlines d_vue1 = dg_pass1 d_vue2 = dg_pass2 $ift sg_cmd0 = "s" dift d_vue1 > 0 dg_view1s = d_vue1 dg_view2s = d_vue2 else dift d_vue2 > 0: dg_view2s = d_vue2 endi d_vue1 = dg_view1s d_vue2 = dg_view2s endi $ift sg_cmd0 = "v" dift d_vue1 > 0 dg_view1v = d_vue1 dg_view2v = d_vue2 else dift d_vue2 > 0: dg_view2v = d_vue2 endi d_vue1 = dg_view1v d_vue2 = dg_view2v endi $ift sg_cmd0 = "x" dift d_vue1 > 0 dg_view1x = d_vue1 dg_view2x = d_vue2 'wrap and view x are the same dg_wrapline = dg_view1x else dift d_vue2 > 0: dg_view2x = d_vue2 endi d_vue1 = dg_view1x d_vue2 = dg_view2x endi $ift sg_cmd0 = "z" dift d_vue1 > 0 dg_view1z = d_vue1 dg_view2z = d_vue2 else dift d_vue2 > 0: dg_view2z = d_vue2 endi d_vue1 = dg_view1z d_vue2 = dg_view2z endi dift d_vue1 = 0: d_vue1 = d_vue2 dift d_vue1 = d_vue2: d_vue2 = 0 dift d_vue1 < 1: d_vue1 = 1 dift d_vue2 = 0 dg_pass1 = d_vue1 dg_pass2 = dg_maxlines sub_show_lines_after else 'top lines dg_pass1 = d_vue1 dg_pass2 = dg_maxlines \ 2 sub_show_lines_after $ch$ s_any, "*", 76 $out s_any 'bottom lines d_dot = dg_maxlines + 1 % 2 dg_pass1 = d_vue2 dg_pass2 = dg_maxlines \ 2 - d_dot sub_show_lines_after endi ends sub_view subr sub_show_now_before_after 'updated 2009/02/16, 2006/10/12, 2001/04/13 'q command show lines before and lines after vari s_any, d_now1, d_lines d_now1 = dg_nowline dift dg_pass1 > 0: d_now1 = dg_pass1 dift dg_nowline <> d_now1: dg_ampline = dg_nowline dg_nowline = d_now1 d_lines = dg_maxlines dg_pass1 = d_now1 dg_pass2 = d_lines sub_show_before_after ends sub_show_now_before_after subr sub_show_before_after 'updated 2007/07/19, 2002/02/16 'show lines before and lines after vari d_any, s_any, d_dot, s_dot vari s_record, d_record, d_howmany, d_mod 'dg_pass1 is the line, dg_pass2 is how many d_record = dg_pass1 d_howmany = dg_pass2 d_mod = d_howmany % 2 'show lines before dg_pass1 = d_record - 1 dg_pass2 = d_howmany \ 2 + d_mod + 1 sub_show_lines_before 'show the line dg_pass1 = d_record sub_record_show 'show lines after dg_pass1 = d_record + 1 dg_pass2 = d_howmany \ 2 - 1 sub_show_lines_after ends sub_show_before_after subr sub_show_lines_before 'updated 2001/01/11 'list lines before line dg_pass1, dg_pass2 many lines vari d_loop, d_count, d_total, d_hold, d_good vari d_record, s_record, d_byte, s_byte, d_long d_record = dg_pass1 d_total = dg_pass2 d_count = 0 d_hold = 0 d_loop = 1 dwhi d_loop = 1 'read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'is the record a good one d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 d_hold = d_record dinc d_count dift d_count >= d_total: dinc d_loop endi ddec d_record dift d_record < 1: dinc d_loop endw 'set dg_pass1 and dg_pass2 dg_pass1 = d_hold dg_pass2 = d_count sub_show_lines_after ends sub_show_lines_before subr sub_show_lines_after 'updated 2008/03/25, 2006/09/16, 2005/05/22, 2004/04/12 'list beginning with line dg_pass1, list dg_pass2 many lines vari d_any, s_any, d_dot, s_dot, s_tap vari d_good, d_loop, d_count, d_total, d_firstline vari d_record, s_record, d_byte, s_byte, d_long d_record = dg_pass1 d_total = dg_pass2 'set counter to zero d_count = 0 d_firstline = 0 dg_paneline = 0 d_loop = 1 dwhi d_loop = 1 'calc bytes and read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record d_good = 1 'did we read in a full record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 'show only good records $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 'get just the first 70 bytes $cut s_record, s_record, 1, 70 'show the record dg_pass1 = d_record sub_record_show 'set jumpline to this last listed record dg_jumpline = d_record dift d_firstline = 0: d_firstline = d_record dift d_record > d_firstline 'get the paneline $cut s_any, s_record, 1, 2 $ift s_any = "]-": dg_paneline = d_record $trr s_any, s_record $ift s_any = "]": dg_paneline = d_record + 1 endi 'increment line counter dinc d_count dift d_count >= d_total: dinc d_loop endi 'increment the record number dinc d_record endw dift dg_paneline = 0: dg_paneline = dg_jumpline 'set dg_jumpmode = 1 dg_jumpmode = 1 'send dg_pass1 and dg_pass2 back dg_pass1 = d_record dg_pass2 = d_count ends sub_show_lines_after subr sub_record_show 'updated 2009/11/07, 2009/11/06 '2009/08/25, 2009/02/16, 2006/10/06, 2006/10/04, 2006/03/15 '2005/10/03, 2005/10/02, 2005/08/21, 2005/08/20, 2004/03/04 'just show the record dg_pass1 if it is good vari s_any, d_any, s_dot, d_dot, s_out vari d_record, s_record, s_goodrecord, d_good d_record = dg_pass1 s_goodrecord = sg_nothing d_good = 1 d_dot = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_dot, 72 $len d_any, s_record dift d_any <> 72: dinc d_good dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 dg_shownline = d_record $cut s_goodrecord, s_record, 1, 70 dto$ s_dot, d_record, 6, 0 'if record number is big put token in 7 s_out = s_dot + " " + " " + s_goodrecord dift d_record = dg_list1: $rep s_out, 7, "^" dift d_record = dg_wrapline: $rep s_out, 7, "w" dift d_record = dg_echapter: $rep s_out, 7, "e" dift d_record = dg_rchapter: $rep s_out, 7, "r" dift d_record = dg_tchapter: $rep s_out, 7, "t" dift d_record = dg_view1s: $rep s_out, 7, "s" dift d_record = dg_view1v: $rep s_out, 7, "v" dift d_record = dg_view1x: $rep s_out, 7, "x" dift d_record = dg_view1z: $rep s_out, 7, "z" dift d_record = dg_ampline: $rep s_out, 7, "&" dift d_record = dg_nowline: $rep s_out, 7, "@" dift d_record = dg_tchapter: $rep s_out, 7, "!" $out s_out endi sg_pass1 = s_goodrecord dg_pass1 = d_good ends sub_record_show subr sub_record_read 'updated 2004/09/22 'read record dg_pass1 into sg_pass1 if good dg_pass1=1 vari s_any, d_any, s_dot, d_dot vari d_record, s_record, s_goodrecord, d_result d_record = dg_pass1 s_goodrecord = sg_nothing d_result = 3 d_dot = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_dot, 72 $len d_any, s_record dift d_any = 72 d_result = 2 $cut s_any, s_record, 71, 1 $ift s_any = "W" d_result = 1 $cut s_goodrecord, s_record, 1, 70 endi endi 'd_result: 1=good record, 2=not good, 3=no record sg_pass1 = s_goodrecord dg_pass1 = d_result ends sub_record_read subr sub_sho_chap1 'updated 2008/01/21, 2005/02/13, 2004/09/20 'show lines in a chapter vari d_any, s_any, d_dot, s_dot vari d_loop, d_good, d_showlines, d_chaprec, d_hold vari d_record, s_record, d_byte, s_byte, d_long d_record = dg_pass1 $ift sg_cmd0 = "e" dift d_record > 0: dg_echapter = d_record d_record = dg_echapter endi $ift sg_cmd0 = "r" dift d_record > 0: dg_rchapter = d_record d_record = dg_rchapter endi $ift sg_cmd0 = "t" d_hold = dg_tchapter dift d_record > 0: dg_tchapter = d_record d_record = dg_tchapter endi dift d_record < 1: d_record = 1 'find chapter start by reading backwards dg_jumpmode = 5 d_showlines = 1 d_chaprec = d_record d_loop = 1 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog 'in RPG or prog mode use entered value dift dg_mode = 3: dinc d_loop dift dg_mode = 5: dinc d_loop dwhi d_loop = 1 'read records backwards to find a chap d_good = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 $out "beyond file" dinc d_loop dinc d_good dinc d_showlines dg_jumpmode = 0 d_chaprec = 1 endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 'look for ]B = book/bulk or ]M = memo or ]C = chapter $cut s_any, s_record, 1, 1 $ift s_any = "]" $cut s_any, s_record, 1, 2 s_dot = "]B,]C,]M" $lok d_any, s_dot, 1, s_any dift d_any > 0 dinc d_loop d_chaprec = d_record endi endi endi ddec d_record dift d_record < 1 dinc d_loop d_chaprec = 1 endi endw dg_paneline = 0 $ift sg_cmd0 = "t" dift d_hold <> d_chaprec 'if t then put bottom line number in dg_backline dg_pass1 = d_chaprec sub_bottom endi endi 'show dg_maxlines lines dift d_showlines = 1 dg_topchap = d_chaprec dg_shochap = d_chaprec sub_sho_chap2 endi ends sub_sho_chap1 subr sub_sho_chap2 'updated 2008/03/25, 2006/09/16, 2005/05/22, 2004/04/12 'show the chapter lines some more if dg_shochap is greater than 1 vari d_any, s_any, d_dot, s_dot vari d_loop, d_lines, d_count, s_num1 vari d_shownline, d_firstline, d_yespreviousblank vari d_record, s_record, d_byte, s_byte, d_long, d_good 'if full screen we do not want to show all dg_maxlines d_count = 0 d_shownline = 1 d_record = dg_shochap dift dg_paneline > 0: d_record = dg_paneline dg_paneline = 0 d_firstline = 0 d_yespreviousblank = 50 d_loop = 1 dwhi d_loop = 1 d_good = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 dinc d_loop dinc d_good dg_shochap = 0 dg_jumpmode = 0 endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 'show the record dg_pass1 = d_record sub_record_show d_shownline = d_record 'do we need to stop dinc d_count d_any = 0 $cut s_any, s_record, 1, 2 $ift s_any = "]B": d_any = 1 $ift s_any = "]C": d_any = 1 $ift s_any = "]M": d_any = 1 dift d_any = 1 'we have hit a chapter line dift d_record <> dg_topchap dinc d_loop dinc d_good dg_shochap = 0 dg_jumpmode = 0 endi endi dift d_firstline = 0: d_firstline = d_record dift d_record > d_firstline 'get the paneline $cut s_any, s_record, 1, 2 $ift s_any = "]-": dg_paneline = d_record $trr s_any, s_record $ift s_any = "]": dg_paneline = d_record + 1 endi endi dift d_good = 1 dift d_count >= dg_maxlines dinc d_loop 'to start a line or two back next return hit dg_shochap = d_record + 1 endi endi dinc d_record endw dift dg_paneline = 0: dg_paneline = d_shownline ends sub_sho_chap2 subr sub_next_back_chapter 'updated 2008/01/21, 2005/04/27, 2004/11/07 'show next or back one chapter from dg_echapter etc vari d_any, s_any, d_dot, s_dot vari d_good, d_loop, d_lines, d_process vari d_begin, d_findchapter vari d_record, s_record, d_count, d_next, s_letter 'commands are: next,back,nexte,backe,nextr,backr etc d_next = 1 $cut s_any, sg_cmd0, 1, 4 $ift s_any = "back": d_next = -1 d_any = 2 s_any = sg_cmd0 + " " $cut s_letter, s_any, 5, 1 $ift s_letter = "e": d_any = 1 $ift s_letter = "r": d_any = 1 $ift s_letter = "t": d_any = 1 dift d_any <> 1: s_letter = "e" $ift s_letter = "e": d_record = dg_echapter $ift s_letter = "r": d_record = dg_rchapter $ift s_letter = "t": d_record = dg_tchapter d_findchapter = 1 d_count = 0 d_loop = 1 dwhi d_loop = 1 d_good = 1 d_any = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_any, 72 $len d_any, s_record dift d_any <> 72 dinc d_loop dinc d_good endi dift d_good = 1 'count even deleted records dinc d_count $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 d_any = 2 $cut s_any, s_record, 1, 2 $ift s_any = "]B": d_any = 1 $ift s_any = "]C": d_any = 1 $ift s_any = "]M": d_any = 1 dift d_any = 1 'we have a chapter or book line dift d_count > 1 d_findchapter = d_record dinc d_loop endi endi endi 'd_next can be 1 or -1 d_record = d_record + d_next endw sg_cmd0 = s_letter $ift s_letter = "e": dg_pass1 = d_findchapter $ift s_letter = "r": dg_pass1 = d_findchapter $ift s_letter = "t": dg_pass1 = d_findchapter sub_sho_chap1 ends sub_next_back_chapter subr sub_top 'updated 2006/03/15, 2004/08/08 'show top of chapter or subroutine vari d_any, s_any, d_dot, s_dot vari d_good, d_loop, d_count, d_which vari d_record, s_record 'd_which=1 for command "top" 'd_which=2 for command "toprpg" d_which = dg_pass2 d_record = dg_pass1 dift d_record = 0 dift dg_nowline > 1: d_record = dg_nowline endi dift d_record = 0 dift dg_shownline > 1: d_record = dg_shownline endi d_count = 0 d_loop = 1 dwhi d_loop = 1 d_good = 1 d_any = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_any, 72 $len d_any, s_record dift d_any <> 72 dinc d_loop dinc d_good endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 dinc d_count dift d_which = 1 'not rpg d_any = 2 $cut s_any, s_record, 1, 2 $ift s_any = "]B": d_any = 1 $ift s_any = "]C": d_any = 1 $ift s_any = "]M": d_any = 1 dift d_any = 1 'we have a chapter or book line or memo line dift d_count > 1 dg_echapter = d_record dinc d_loop endi endi endi dift d_which = 2 'rpg d_any = 2 $cut s_any, s_record, 28, 5 $ift s_any = "BEGSR": d_any = 1 $ift s_any = "TAG ": d_any = 1 $cut s_any, s_record, 6, 1 $ift s_any = "I": d_any = 1 $ift s_any = "F": d_any = 1 dift d_any = 1 'we have a subr or tag line dift d_count > 1 dg_echapter = d_record dinc d_loop endi endi endi endi ddec d_record endw sg_cmd0 = "e" dg_pass1 = dg_echapter sub_sho_chap1 ends sub_top subr sub_bottom 'updated 2008/01/21, 2007/08/30, 2006/12/04, 2006/03/15, 2004/08/08 'put bottom line in dg_backline and do sub_back vari d_any, s_any, d_dot, s_dot vari d_good, d_loop, d_record, s_record, d_count d_record = dg_pass1 dift d_record = 0 dift dg_nowline > 1: d_record = dg_nowline endi dift d_record = 0 dift dg_shownline > 1: d_record = dg_shownline endi d_count = 0 d_loop = 1 dwhi d_loop = 1 d_good = 1 d_any = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_any, 72 $len d_any, s_record dift d_any <> 72 dinc d_loop dinc d_good endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 dinc d_count dg_backline = d_record d_any = 2 $cut s_any, s_record, 1, 2 $ift s_any = "]B": d_any = 1 $ift s_any = "]C": d_any = 1 $ift s_any = "]M": d_any = 1 dift d_any = 1 dift d_count > 1: dinc d_loop endi endi dinc d_record endw $ift sg_cmd0 = "b" dg_pass1 = 0 sub_back endi ends sub_bottom subr sub_find_hunt 'updated 2011/11/05, 2010/09/24, 2010/09/23 '2009/08/25, 2008/02/11, 2007/09/29, 2006/05/04 '2006/05/03, 2006/03/04, 2006/02/18, 2006/01/26, 2005/10/04 '2005/10/02, 2005/08/20, 2005/08/17, 2005/08/16, 2005/08/15 '2005/08/14, 2005/08/11, 2005/06/01, 2005/02/13, 2004/07/17 'find or hunt strings sg_find1,sg_find2,sg_find3 vari d_any, s_any, d_dot, s_dot, s_out vari d_good, d_loop, d_lines, d_process vari d_begline, d_endline, d_lastline, d_justone, s_line vari d_record, s_record, d_byte, s_byte, d_long, d_yesfind vari s_findstr1, s_findstr2, s_findstr3, d_findstr2, d_findstr3 vari s_10blanks, s_quote, d_count, s_findnum, d_recct 'd_yesfind=1 for find, d_yesfind=2 for hunt, d_yesfind=3 for one 'find is case sensitive hunt is not d_yesfind = dg_pass0 'do we want to find just one d_justone=1 dift d_yesfind > 2: d_justone = 1 'if one find string then begin in 2 else if 2 then 3 d_begline = dg_pass1 d_endline = dg_pass2 s_findstr1 = sg_pass1 s_findstr2 = sg_pass2 s_findstr3 = sg_pass3 d_process = 1 dift dg_debug = 1 $out sg_dashline $out "sub_find_hunt debug input" $out s_findstr1 + " " + s_findstr2 + " " + s_findstr3 $out d_yesfind + " " + d_begline + " " + d_endline $inp s_out, "return or *" $ift s_out = "*": dinc d_process endi d_count = 0 dift d_process = 1 $len d_any, s_findstr1 dift d_any = 0 s_findstr1 = sg_find1 s_findstr2 = sg_find2 s_findstr3 = sg_find3 endi dift d_begline = 0: d_begline = dg_findbegin dg_findbegin = d_begline dift d_endline = 0: d_endline = dg_findend dg_findend = d_endline $len d_any, s_findstr1 dift d_any = 0 $out "no findstr" dinc d_process endi endi dift d_process = 1 sg_find1 = s_findstr1 sg_find2 = s_findstr2 sg_find3 = s_findstr3 dch$ s_10blanks, 32, 10 dift d_yesfind = 2 'd_yesfind=2 means hunt which is case independent $cup s_findstr1, sg_find1 $cup s_findstr2, sg_find2 $cup s_findstr3, sg_find3 endi 'show dg_maxlines finds on the screen s_findnum = sg_nothing $len d_any, s_findstr2 d_findstr2 = 2 dift d_any > 0: d_findstr2 = 1 $len d_any, s_findstr3 d_findstr3 = 2 dift d_any > 0: d_findstr3 = 1 s_quote = #"# endi $out "beg=" + d_begline + " end=" + d_endline d_lastline = d_begline d_recct = 0 d_record = d_begline d_loop = 2 dift d_process = 1: d_loop = 1 dwhi d_loop = 1 d_any = d_record % 10000 dift d_any = 0: $sho "rec=" + d_record + " ct=" + d_count d_good = 1 'calculate the bytes and read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'if d_long is not 72 then we have hit the end of the file dift d_long <> 72 dinc d_good dinc d_loop endi 'do we have a 'W' in 71 dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 'stop at next book if dg_bookcurrent is not 1 dift dg_bookcurrent > 1 dift d_record > dg_bookcurrent $cut s_any, s_record, 1, 6 $ift s_any = "]BOOK:" dinc d_good dinc d_loop endi endi endi d_lastline = d_record endi dift d_good = 1 'get just the 70 bytes of the record $cut s_record, s_record, 1, 70 $app s_record, s_10blanks 'case sensitive or not dift d_yesfind = 1 s_line = s_record else $cup s_line, s_record endi 'do we have s_findstr1 $lok d_dot, s_line, 1, s_findstr1 dift d_dot > 0 'do we have d_findstr2 if wanted dift d_findstr2 = 1 $lok d_dot, s_line, 1, s_findstr2 endi dift d_dot > 0 'do we have d_findstr3 if wanted dift d_findstr3= 1 $lok d_dot, s_line, 1, s_findstr3 endi endi endi dift d_dot = 0: dinc d_good endi dift d_good = 1 'we found s_findstr1 and maybe s_findstr2 dinc d_count dinc d_lines dift dg_quiet = 1: d_lines = 0 dift d_lines >= dg_maxlines d_lines = 1 sub_more dift dg_more <> 1 dinc d_good dinc d_loop endi endi endi dift d_good = 1 dift d_justone = 1 dift dg_nowline <> d_record: dg_ampline = dg_nowline dg_nowline = d_record else dift d_count = 1 'token for dg_ampline is an ampersand dg_ampline = dg_nowline dg_nowline = d_record endi endi dift dg_quiet <> 1 dg_pass1 = d_record sub_record_show endi dift d_justone = 1 'we have found one and are done dinc d_loop dinc d_process endi 'save the line number dto$ s_any, d_record, 6, 0 $app s_findnum, s_any + "," endi dinc d_record dift d_record > d_endline: dinc d_loop endw dift d_process = 1 sg_pass1 = s_findstr1 dift d_findstr2 = 1 $app sg_pass1, " and " + s_findstr2 dift d_findstr3 = 1 $app sg_pass1, " and " + s_findstr3 endi endi sg_pass2 = s_findnum sub_find_push dg_xvalue = d_count s_any = "found=" + d_count + ", begin=" + d_begline $app s_any, ", end=" + d_lastline $out s_any endi ends sub_find_hunt subr sub_find_fast 'updated 2011/11/05, 2009/08/25 '2009/01/11, 2006/11/15, 2005/08/20, 2005/08/16, 2004/06/24 'find in string of whole file vari d_any, s_any, d_dot, s_dot vari s_wholefile, s_findstr, d_count, s_findnum vari d_record, s_record, d_byte, d_hunt vari d_loop, d_good, d_long, d_lines 'with hunt case does not matter d_hunt = dg_pass1 s_findstr = sg_pass1 d_good = 1 $len d_long, s_findstr dift d_long = 0 s_findstr = sg_find1 $len d_long, s_findstr endi dift d_long < 1 dinc d_good $out "no string to find" endi dift d_good = 1 sg_find1 = s_findstr $out "finding='" + s_findstr + "'" s_findnum = sg_nothing finp s_wholefile, sg_fileran '$bes s_wholefile, s_wholefile dift d_hunt = 1 $cup s_wholefile, s_wholefile $cup s_findstr, s_findstr endi endi d_count = 0 d_lines = 0 d_byte = 1 d_loop = d_good dwhi d_loop = 1 'look through the whole file d_good = 1 $lok d_byte, s_wholefile, d_byte, s_findstr dift d_byte = 0 dinc d_loop dinc d_good endi dift d_good = 1 'we found one at d_byte d_record = d_byte \ 72 + 1 'find position of W d_dot = d_record - 1 * 72 + 71 'prepare to look at next record d_byte = d_dot + 1 $cut s_any, s_wholefile, d_dot, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 'we have found one save the line number dto$ s_any, d_record, 6, 0 $app s_findnum, s_any + "," dinc d_count dift d_count = 1 dg_ampline = dg_nowline dg_nowline = d_record endi dinc d_lines dift dg_quiet = 1: d_lines = 0 dift d_lines > dg_maxlines d_lines = 1 sub_more dift dg_more <> 1 dinc d_good dinc d_loop endi endi dift dg_quiet = 1 $sho d_record dinc d_good endi dift d_good = 1 dg_pass1 = d_record sub_record_show endi endi endw dg_xvalue = d_count $out "count found=" + d_count sg_pass1 = s_findstr sg_pass2 = s_findnum sub_find_push ends sub_find_fast subr sub_seek 'updated 2008/11/06, 2008/10/28 '2007/10/09, 2007/10/08, 2006/04/22, 2006/04/19, 2002/01/27 'hunt string and show chapters vari d_any, s_any, d_dot, s_dot vari d_good, d_loop, d_lines, d_process vari d_record, s_record, d_byte, s_byte, d_long vari s_seekstr1, s_seekstr2, d_seektwo vari s_hold, d_chapter, s_findnum d_process = 1 dift d_process = 1 $out "Enter what you want to seek without quotes around it" $out "Seek will seek what you enter in the whole file" $inp s_seekstr1, "Seek is not case dependent" $ift s_seekstr1 = "*": dinc d_process endi dift d_process = 1 $out "Enter s second string without quotes around it" $out "or hit return" $inp s_seekstr2, "Seek is not case dependent." $ift s_seekstr2 = "*": dinc d_process endi dift d_process = 1 $trb s_seekstr1, s_seekstr1 s_hold = s_seekstr1 $cup s_seekstr1, s_seekstr1 $len d_long, s_seekstr1 dift d_long = 0: dinc d_process $trb s_seekstr2, s_seekstr2 $cup s_seekstr2, s_seekstr2 $len d_long, s_seekstr2 d_seektwo = 1 dift d_long = 0: dinc d_seektwo endi dift d_process = 1 'show dg_maxlines finds on the screen s_findnum = sg_nothing d_lines = 2 d_record = 1 dift dg_pass1 > 0: d_record = dg_pass1 endi d_loop = d_process dwhi d_loop = 1 d_any = d_record % 1000 dift d_any = 0: $sho s_hold + ", seek=" + d_record d_good = 1 'calculate the bytes and read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'if d_long is less than 72 then end of the file dift d_long <> 72 dinc d_good dinc d_loop endi 'do we have a 'W' in 71 dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 'save the chapter record number $cut s_any, s_record, 1, 2 $ift s_any = "]C": d_chapter = d_record $ift s_any = "]B": d_chapter = d_record 'if no chapter has been found then no dift d_chapter = 0: dinc d_good endi dift d_good = 1 'get just the 70 bytes of the record $cut s_record, s_record, 1, 70 'upper case $cup s_record, s_record 'do we have the string we are looking for $lok d_dot, s_record, 1, s_seekstr1 dift d_dot > 0 dift d_seektwo = 1 $lok d_dot, s_record, 1, s_seekstr2 endi endi 'if found then show the chapter dift d_dot > 0 dift dg_quiet <> 1 'show the chapter line and the found line dg_pass1 = d_chapter sub_record_show dg_pass1 = d_record sub_record_show d_lines = d_lines + 2 endi 'save the lines number dto$ s_any, d_chapter, 6, 0 $app s_findnum, s_any + "," 'zero chapter since we have shown it d_chapter = 0 endi endi dift d_lines >= dg_maxlines d_lines = 2 sub_more d_loop = dg_more endi dinc d_record endw dift d_process = 1 sg_pass1 = s_seekstr1 sg_pass2 = s_findnum sub_find_push $out "Put in a y to show the chapters again." $out "To show a chapter put in a e followed by the rec num" endi ends sub_seek subr sub_hush 'updated 2006/02/08, 2006/01/18, 2005/12/29 vari d_any, s_any, d_dot, s_dot vari d_good, d_loop, d_lines, s_line1, s_line2, s_hush vari d_record, s_record, d_byte, s_byte, d_long d_good = 1 $inp s_hush, "Enter hush string" $tup s_hush, s_hush $len d_long, s_hush dift d_long = 0: dinc d_good d_record = 1 d_loop = d_good dwhi d_loop = 1 d_any = d_record % 1000 dift d_any = 0: $sho d_record d_good = 1 'calculate the bytes and read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 1, 3 $ift s_any <> "]E ": dinc d_good endi dift d_good = 1 'get just the 67 bytes of the record $cut s_line1, s_record, 4, 67 $cod s_line1, s_line1 'trim upper case $tup s_line2, s_line1 'do we have the string we are looking for $lok d_dot, s_line2, 1, s_hush 'if found then show the chapter dift d_dot > 0 dift dg_quiet = 1: $out s_line1 dg_pass1 = d_record sub_record_show endi endi dinc d_record endw $inp s_any, "done" ends sub_hush subr sub_past_find 'updated 2009/11/01, 2005/08/31, 2005/02/10, 2004/04/02 'show by number a past find vari d_which, d_yestofile, d_process vari s_findstr, s_findnum, d_count, d_long 'which set of find lines d_which = dg_pass1 % 1000 'process for the set of find lines d_process = dg_pass1 \ 1000 dift d_which = 1 s_findnum = sg_foundnum1 s_findstr = sg_foundstr1 endi dift d_which = 2 s_findnum = sg_foundnum2 s_findstr = sg_foundstr2 endi dift d_which = 3 s_findnum = sg_foundnum3 s_findstr = sg_foundstr3 endi dift d_which = 4 s_findnum = sg_foundnum4 s_findstr = sg_foundstr4 endi dift d_which = 5 s_findnum = sg_foundnum5 s_findstr = sg_foundstr5 endi dift d_which = 6 s_findnum = sg_1linesbad s_findstr = "bad lines" endi dift d_which = 6: s_findstr = sg_1linesbad dift d_which = 0 $out "find='" + sg_find1 + "'" $out "1. " + sg_foundstr1 $out "2. " + sg_foundstr2 $out "3. " + sg_foundstr3 $out "4. " + sg_foundstr4 $out "5. " + sg_foundstr5 $out "6. bad lines" $out "do: past 1002 to show 2" $out "do: past 2002 to send 2 to a file" $out "do: past 5002 to alter set 2 one at a time" $out "do: past 9002 to delete set 2 one at a time" endi dift d_process = 1 dg_pass1 = 1 dg_pass2 = 0 sg_pass1 = s_findnum sub_string_lines_show endi dift d_process = 2 sg_pass1 = s_findnum sub_string_lines_to_file endi dift d_process = 5 sg_pass1 = s_findnum sub_string_lines_alter endi dift d_process = 9 sg_pass1 = s_findnum sub_string_lines_delete endi ends sub_past_find subr sub_find_push 'updated 2004/04/02 'put find down to new sg_foundnum1 vari s_findstr, s_findnum, d_count s_findstr = sg_pass1 s_findnum = sg_pass2 $len d_count, s_findnum d_count = d_count \ 7 s_findstr = #"# + s_findstr + #"# + ", count=" + d_count sg_foundstr5 = sg_foundstr4 sg_foundstr4 = sg_foundstr3 sg_foundstr3 = sg_foundstr2 sg_foundstr2 = sg_foundstr1 sg_foundstr1 = s_findstr sg_foundnum5 = sg_foundnum4 sg_foundnum4 = sg_foundnum3 sg_foundnum3 = sg_foundnum2 sg_foundnum2 = sg_foundnum1 sg_foundnum1 = s_findnum ends sub_find_push subr sub_pattern_look 'updated 2009/11/01, 2002/11/18 'look for a string pattern in the lines vari d_any, s_any, d_dot, s_dot, s_out vari d_record, s_record, d_loop, d_good vari s_pattern, d_long, d_byte, s_byte, d_yes vari d_end, d_process vari s_findnum, s_findstr, d_findct s_pattern = sg_pass1 s_findstr = s_pattern s_findnum = sg_nothing d_findct = 0 $len d_long, s_pattern d_end = 70 - d_long + 1 d_record = 1 d_process = 1 dift d_long = 0: dinc d_process d_loop = d_process dwhi d_loop = 1 d_any = d_record % 1000 dift d_any = 0 $sho "pattern=" + d_record + " " + d_findct endi d_good = 1 'calculate the bytes and read the record d_dot = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_dot, 72 $len d_any, s_record dift d_any <> 72 dinc d_good dinc d_loop endi dift d_good = 1 'do we have a 'W' in 71 $cut s_dot, s_record, 71, 1 $ift s_dot <> "W": dinc d_good endi dift d_good = 1 d_byte = 1 d_yes = 1 dwhi d_yes = 1 $cut s_any, s_record, d_byte, d_long $isp d_any, s_any, s_pattern dift d_any = 1 'we have one in this record dinc d_yes 'save the line number dto$ s_any, d_record, 6, 0 $app s_findnum, s_any + "," dinc d_findct dift dg_quiet <> 1 dg_pass1 = d_record sub_record_show endi endi dinc d_byte dift d_byte > d_end: dinc d_yes endw endi dinc d_record endw dift d_process = 1 sg_pass1 = s_findstr sg_pass2 = s_findnum sub_find_push $out "use y or past to see" $out "found=" + d_findct + " pattern=" + s_pattern endi ends sub_pattern_look subr sub_command_redo 'updated 2011/03/14, 2010/06/11, 2009/09/12, 2007/01/25, 2003/01/22 'redo and show past commands vari d_any, s_any, d_dot, s_dot vari s_tab, d_loop, s_command, d_lines, s_input vari d_number, d_good, d_action 'sg_cmdredo is tab=char 9 delimited 'do we have redo in sg_cmdline or redo + number 'three cases 'd_action=1 is no redo 'd_action=2 is redo no number after 'd_action=3 is redo with number after $trb sg_cmdline, sg_cmdline 'put a tab character in s_tab dch$ s_tab, 9, 1 d_action = 0 d_good = 1 $trb sg_cmdline, sg_cmdline $len d_any, sg_cmdline dift d_any = 0: dinc d_good dift d_good = 1 'not a redo $cut s_any, sg_cmdline, 1, 4 $cup s_any, s_any $ift s_any <> "REDO" 'we do not have redo so save on front of sg_cmdredo sg_cmdredo = sg_cmdline + s_tab + sg_cmdredo dinc d_good 'd_action=1 is no redo d_action = 1 endi endi dift d_good = 1 'we have a redo so do we have a number $cut s_any, sg_cmdline, 5, 20 $trb s_any, s_any $isd d_any, s_any dift d_any <> 1 'd_action=2 is redo no number d_action = 2 else 'd_action=3 is redo with a number $tod d_number, s_any d_action = 3 endi endi d_loop = 2 dift d_action = 2 'd_action=2 is redo no number d_lines = 0 d_dot = 1 d_loop = 1 endi dwhi d_loop = 1 'show list of past commands 'get command d_dot $par s_command, sg_cmdredo, s_tab, d_dot $trb s_command, s_command $len d_any, s_command dift d_any = 0 'beyond end drop out sg_cmdline = sg_nothing dinc d_loop d_action = 0 d_lines = 999 else 'just show redo commands $out d_dot + ". " + s_command endi dinc d_lines dift d_lines >= dg_maxlines d_lines = 1 $inp s_input, "more, number, redo 5, * to end" $tup s_any, s_input $len d_any, s_any dift d_any > 0 dinc d_loop $ift s_any = "*" sg_cmdline = sg_nothing else $isd d_any, s_any dift d_any = 1 sg_cmdline = "redo" + s_any else $trb sg_cmdline, s_input endi d_action = 3 endi endi endi dinc d_dot endw 'do we have redo + number dift d_action = 3 'we have to have redo $cut s_any, sg_cmdline, 1, 4 $cup s_any, s_any $ift s_any <> "REDO": d_action = 0 endi dift d_action = 3 'we have redo in sg_cmdline 'do we have a number $cut s_any, sg_cmdline, 5, 40 $trb s_any, s_any $isd d_any, s_any dift d_any <> 1: d_action = 0 dift d_any = 1: $tod d_number, s_any endi dift d_action = 3 'get command corresponding to d_number $par s_command, sg_cmdredo, s_tab, d_number $trb s_command, s_command sg_cmdline = s_command endi ends sub_command_redo subr sub_change 'updated 2010/10/24, 2009/09/07, 2009/02/16, 2008/10/02, 2007/09/29 '2007/04/04, 2007/03/10, 2007/02/05, 2004/11/07 'change string sg_pass1 to sg_pass2 in a book one at a time vari d_any, s_any, d_dot, s_dot vari d_process, s_quote, s_char10, s_blanks, s_listrange vari d_good, d_loop, d_count, d_mode, s_findnum, d_quiet vari d_begline, d_endline, d_ynextrec, d_yatbyte, d_prevrecord vari d_record, s_record, d_byte, s_byte, d_long, s_oldrecord vari s_change1, s_change2, d_len1, d_len2, d_update vari d_stopatbooks 'c"the","THE",500,650 'change "the" to "THE" beginning at record 500 to 650 d_process = 1 d_stopatbooks = 1 'char 34 is " dch$ s_quote, 34, 1 dch$ s_char10, 10, 1 dch$ s_blanks, 32, 70 'get the change strings s_change1 = sg_pass1 s_change2 = sg_pass2 d_begline = dg_pass1 d_endline = dg_pass2 $len d_len1, s_change1 $len d_len2, s_change2 dift d_process = 1 'validate s_change1 dift d_len1 = 0 dinc d_process $out "no change from" endi dift d_begline = 0: d_begline = 1 dift d_endline = 0: d_endline = 10 ^ 7 dift d_begline > d_endline: dinc d_process endi dift d_process = 1 'character 34 in s_quote is " $out "change1='" + s_change1 + "'" $out "change2='" + s_change2 + "'" $out "beg=" + d_begline + ", end=" + d_endline 'read through the file with the record number in d_record d_record = d_begline d_count = 0 d_loop = 1 endi 'd_mode = 1 means ask 'd_mode = 2 means automatic d_mode = 1 s_listrange = d_begline + "/" + d_endline s_findnum = sg_nothing d_yatbyte = 1 d_quiet = 2 d_loop = 2 dift d_process = 1: d_loop = 1 dwhi d_loop = 1 d_any = d_record % 1000 dift d_any = 0: $sho "change=" + d_record dift d_record <> d_prevrecord: d_yatbyte = 1 d_prevrecord = d_record d_good = 1 d_ynextrec = 1 'calculate the bytes and read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 'if d_long <> 72 then we have hit the end of the file dinc d_good dinc d_loop endi dift d_good = 1 'do we have a 'W' in 71 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 'show books d_any = 2 dift d_stopatbooks = 1 $cut s_any, s_record, 1, 5 $ift s_any = "]BOOK": d_any = 1 $ift s_any = "]STOP": d_any = 1 endi dift d_any = 1 dg_pass1 = d_record sub_record_show $inp s_any, "enter 'nostop' to not stop at books" $tup s_any, s_any $ift s_any = "NOSTOP": dinc d_stopatbooks $ift s_any = "*" dinc d_good dinc d_loop endi endi endi dift d_good = 1 'get just the 70 bytes of the record $cut s_record, s_record, 1, 70 s_oldrecord = s_record 'add end blanks $app s_record, s_blanks 'do we have the string we are looking for $lok d_yatbyte, s_record, d_yatbyte, s_change1 dift d_yatbyte = 0 'no find d_ynextrec = 1 d_yatbyte = 1 else 'delete the old string $del s_record, d_yatbyte, d_len1 'insert the new string $ins s_record, d_yatbyte, s_change2 'is there any thing but blanks in the too long d_update = 2 $cut s_any, s_record, 71, 200 $trb s_any, s_any $len d_any, s_any dift d_any = 0 'it is ok to put the new record back in d_update = 1 $cut s_record, s_record, 1, 70 else dift d_mode = 1 dto$ s_any, d_record, 6, 0 $out s_any + " " + s_oldrecord $out s_any + " " + s_record $inp s_any, "cannot change, too long, * to end" $ift s_any = "*": dinc d_loop endi endi dift d_update = 1 'show the old and the new and ask dift d_quiet <> 1 $out " " dto$ s_any, d_record, 6, 0 $out s_any + " " + s_oldrecord $out s_any + " " + s_record else d_any = d_record % 100 dift d_any = 0: $sho d_record endi dift d_mode = 1 'd_mode=1 means to ask s_any = "n=do not change,all=change all," $app s_any, "allq=all quiet," $app s_any, "*=end," + s_listrange $inp s_any, s_any $cup s_any, s_any $ift s_any = "*" dinc d_update dinc d_loop endi $ift s_any = "ALL": d_mode = 2 $ift s_any = "ALLQ" d_mode = 2 d_quiet = 1 endi $ift s_any = "N": dinc d_update endi endi 'do we have another in this record dift d_update = 1: $len d_any, s_change2 dift d_update <> 1: $len d_any, s_change1 d_yatbyte = d_yatbyte + d_any $lok d_yatbyte, s_record, d_yatbyte, s_change1 dift d_yatbyte > 0 'not next record dinc d_ynextrec else d_ynextrec = 1 d_yatbyte = 1 endi dift d_update = 1 'update the record s_any = s_record + "W" + s_char10 d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_any dift d_any = 0: $out "not changed" + d_record dto$ s_any, d_record, 6, 0 $app s_findnum, s_any + "," dift dg_nowline <> d_record dg_ampline = dg_nowline endi dg_nowline = d_record dinc d_count dinc dg_changes endi endi endi dift d_ynextrec = 1: dinc d_record dift d_record > d_endline: dinc d_loop endw dift d_count > 0 sg_pass1 = s_change2 sg_pass2 = s_findnum sub_find_push endi dift d_process = 1: $out "changes=" + d_count ends sub_change subr sub_show_chapters 'updated 2010/01/23, 2009/09/04 '2009/02/04, 2008/11/02, 2008/07/28, 2008/07/25, 2008/04/25 '2008/02/13, 2007/09/28, 2007/09/23, 2007/02/10, 2006/05/28 '2006/05/04, 2006/02/09, 2005/12/11, 2005/12/10, 2004/10/21 'show chapters in a book vari d_any, s_any, d_dot, s_dot vari s_beg, d_good, d_lines, d_booklines, d_firstchapfound vari d_loop, d_chapnum, s_putline, d_yesrenumber vari d_record, s_record, d_byte, d_long, d_count vari d_beyondend, d_lastline, d_showline, d_more vari d_numtoshow d_record = dg_pass1 dift d_record < 1: d_record = dg_chaplinetoshow d_numtoshow = dg_pass2 dift d_numtoshow > dg_maxlines: d_numtoshow = dg_maxlines dift d_numtoshow < 1: d_numtoshow = 1 'initialize for chapter numbering and whether to renumber d_firstchapfound = 0 d_yesrenumber = 2 d_booklines = -1 d_lastline = 0 d_beyondend = 3 d_chapnum = 0 d_count = 0 'do we have a book record d_good = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72: dinc d_good dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 ']BOOK:,]BULK: $cut s_any, s_record, 1, 2 $ift s_any = "]B" dg_bookcurrent = d_record dg_findbegin = d_record dg_chaplinetoshow = d_record d_firstchapfound = d_record d_yesrenumber = 1 d_booklines = 0 endi ']CHAP $cut s_any, s_record, 1, 5 $lok d_any, "]CHAP,]CHAR,]MEMO", 1, s_any dift d_any > 0 dg_bookcurrent = d_record dg_findbegin = d_record dg_chaplinetoshow = d_record d_firstchapfound = d_record d_yesrenumber = 2 d_booklines = -1 endi endi 'dg_bookcurrent has the book beginning line number 'dg_chaplinetoshow has the first chapter to begin showing 'we have to keep track of the book beginning for find 'dg_bookcurrent can only be set by dg_pass1 'if we do not have a book show only books d_lines = 0 d_loop = 1 dwhi d_loop = 1 'tell d_any = d_record % 1000 dift d_any = 0: $sho "chapters=" + d_record 'read a record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 d_showline = 2 $len d_long, s_record dift d_long <> 72 dinc d_loop dinc d_good endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 'do we have lines beyond ]R LAST but not ]Z $cut s_beg, s_record, 1, 2 $ift s_beg <> "]Z" dift d_beyondend = 2: d_beyondend = 1 endi $ift s_beg = "]R LAST" dift d_beyondend = 3: d_beyondend = 2 endi endi dift d_good = 1 dift dg_mode = 3 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog $cut s_any, s_record, 5, 2 $ift s_any = ".C": d_showline = 1 $ift s_any = ".O": d_showline = 1 endi endi dift d_good = 1 $cut s_any, s_record, 1, 1 $ift s_any <> "]": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 2, 1 $ift s_any = "-": dinc d_good endi dift d_good = 1 d_lastline = d_record 'record 2 should be a ]DATE dift d_record = 2 $cut s_any, s_record, 1, 8 $ift s_any <> "]R DATE:" $out "record 2 not date record" dinc d_lines endi endi 'always show ]SECT records $cut s_beg, s_record, 1, 5 $ift s_beg = "]SECT": d_showline = 1 'always show ]MEMO records $cut s_beg, s_record, 1, 5 $ift s_beg = "]MEMO": d_showline = 1 'always show ]STOP records $cut s_beg, s_record, 1, 5 $ift s_beg = "]STOP": d_showline = 1 'always show ]R records also $cut s_beg, s_record, 1, 2 $ift s_beg = "]R": d_showline = 1 $cut s_beg, s_record, 1, 6 $ift s_beg = "]BOOK:" 'always show a book line d_showline = 1 'stop at second book line 'count booklines dinc d_booklines 'stop if several lines have been shown dift d_count > 5: dinc d_loop d_chapnum = 0 endi 'we are only interested in chapters/charts below $cut s_beg, s_record, 1, 2 $ift s_beg <> "]C": dinc d_good endi dift d_good = 1 'show chapters d_showline = 1 dift d_yesrenumber <> 1: dinc d_good dift d_firstchapfound = 0 d_firstchapfound = d_record endi endi dift d_good = 1 'do not renumber chapters if no ]BOOK dift d_booklines <> 1: dinc d_good endi dift d_good = 1 'do we need to renumber the chapter '1234567890123 ']CHART 123: ']CHAP: 123: $cut s_any, s_record, 8, 3 $ist d_any, s_any, "9" dift d_any <> 1: dinc d_good $cut s_any, s_record, 11, 2 $ift s_any <> ": ": dinc d_good $cut s_any, s_record, 7, 1 $ift s_any <> " ": dinc d_good endi dift d_good = 1 'renumber the chapter if needed dinc d_chapnum $cut s_any, s_record, 8, 3 $tod d_any, s_any dift d_any <> d_chapnum 'renumber the chapter s_any = "000" + d_chapnum $off s_any, s_any, 3 $rep s_record, 8, s_any fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 endi endi dift d_showline = 1 'more d_lines = d_lines + d_numtoshow dift d_lines > dg_maxlines d_lines = d_numtoshow sub_more d_more = dg_more dift d_more <> 1: dinc d_loop d_showline = d_more d_lastline = 0 endi endi dift d_showline = 1 dg_pass1 = d_record dg_pass2 = d_numtoshow sub_show_lines_after dift d_numtoshow > 1 $ch$ s_any, "-", 70 $out s_any dinc d_lines endi dinc d_count d_lastline = 0 endi dinc d_record endw 'show the last dift d_lastline > 0 dg_pass1 = d_lastline sub_record_show endi dg_chaplinetoshow = d_firstchapfound dift d_beyondend = 1: $out "lines beyond ]R LAST" ends sub_show_chapters subr sub_show_books 'updated 2009/11/06, 2009/02/27, 2009/01/02, 2008/11/28 '2008/08/31, 2008/04/17, 2008/02/13, 2007/08/01, 2007/03/01 '2006/08/09, 2006/06/06, 2006/06/05, 2006/06/04, 2006/05/04 '2006/05/03, 2005/10/06, 2005/09/02, 2005/08/14, 2004/10/21 'get bulks, books or chapters in a book vari d_any, s_any, d_dot, s_dot, s_out vari s_beg, d_good, d_linect, d_process, s_plus vari d_loop, d_chapnum, s_putline, d_begin, d_bulk vari d_record, s_record, d_byte, d_long, s_program vari s_line, d_yhash, s_hash, s_bookline, d_blines vari d_hash0, d_hash1, d_hash2, d_hash3, d_hash4 vari d_hash5, d_hash6, d_hash7, d_hash8, d_hash9 vari d_beyondend, d_lastline, d_showline, d_more d_bulk = 2 $ift sg_cmd0 = "bulk": d_bulk = 1 d_begin = dg_pass1 dift d_begin = 0: d_begin = dg_booklinetoshow dg_booklinetoshow = d_begin dg_findbegin = d_begin d_process = 1 d_yhash = dg_quiet 'initialize for chapter numbering and whether to renumber s_plus = " " s_hash = sg_nothing s_bookline = sg_nothing d_lastline = 0 d_beyondend = 3 d_chapnum = 0 d_linect = 0 d_record = d_begin d_loop = d_process dwhi d_loop = 1 'tell d_any = d_record % 1000 dift d_any = 0: $sho "books=" + d_record 'read a record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 d_showline = 2 $len d_long, s_record dift d_long <> 72 dinc d_loop dinc d_good endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 'skip over ]Z lines $cut s_beg, s_record, 1, 2 $ift s_beg = "]Z": dinc d_good 'stop at ]BULK: lines $cut s_beg, s_record, 1, 6 $ift s_beg = "]BULK:" dg_pass1 = d_record sub_record_show dift d_bulk <> 1 $inp s_any, "return" $trb s_any, s_any $len d_any, s_any $ift d_any > 0 dinc d_good dinc d_loop endi else dinc d_good endi endi dift d_bulk = 1: dinc d_good endi dift d_good = 1 'do we have lines beyond ]R LAST dift d_beyondend = 2: d_beyondend = 1 $cut s_beg, s_record, 1, 7 $ift s_beg = "]R LAST" dift d_beyondend = 3: d_beyondend = 2 endi dift d_yhash = 1 'hash the books to compare them $cut s_line, s_record, 1, 70 $cut s_any, s_line, 1, 2 $ift s_any = "]B" $hsh d_hash0, s_hash s_hash = sg_nothing d_any = 10 ^ 9 * 2 d_hash1 = d_hash0 \ d_any s_dot = " " dift d_hash1 = d_hash9: s_dot = "*" dift d_hash1 = d_hash8: s_dot = "*" dift d_hash1 = d_hash7: s_dot = "*" dift d_hash1 = d_hash6: s_dot = "*" dift d_hash1 = d_hash5: s_dot = "*" dift d_hash1 = d_hash4: s_dot = "*" dift d_hash1 = d_hash3: s_dot = "*" dift d_hash1 = d_hash2: s_dot = "*" d_hash9 = d_hash8 d_hash8 = d_hash7 d_hash7 = d_hash6 d_hash6 = d_hash5 d_hash5 = d_hash4 d_hash4 = d_hash3 d_hash3 = d_hash2 d_hash2 = d_hash1 ded$ s_hash, d_hash0, 20, 0 ded$ s_any, d_blines, 7, 0 s_out = s_any + s_hash + s_dot + s_plus $app s_out, " " + s_bookline dift d_blines > 0: $out s_out dto$ s_any, d_record, 7, 0 s_bookline = s_any + " " + s_line 'get the RPG program name for the next line ']BOOK: SRETREG s_plus = " " $cut s_program, s_record, 8, 8 $trb s_program, s_program $off s_any, s_program, 1 $ist d_any, s_any, "9" dift d_any = 1 $off s_any, s_program, 2 $ist d_any, s_any, "9" dift d_any <> 1: s_plus = "+" endi dinc d_good d_blines = 0 dinc d_linect dift d_linect >= dg_maxlines d_linect = 1 sub_more dift dg_more <> 1: dinc d_loop endi else dinc d_blines $trb s_any, s_line $app s_hash, s_any dinc d_good endi endi $cut s_any, s_record, 1, 1 $ift s_any <> "]": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 2, 1 $ift s_any = "-": dinc d_good endi dift d_good = 1 d_lastline = d_record 'record 2 should be a ]DATE dift d_record = 2 $cut s_any, s_record, 1, 8 $ift s_any <> "]R DATE:" $out "record 2 not date record" dinc d_linect endi endi 'do we have a ]r record $cut s_beg, s_record, 1, 2 $ift s_beg = "]r" dg_pass1 = d_record sub_record_show endi 'always show ]R records also $cut s_beg, s_record, 1, 2 $ift s_beg = "]R": d_showline = 1 $ift s_beg = "]B" 'always show a bulk or book line d_showline = 1 d_chapnum = 0 endi 'we are only interested in chapters/charts below $cut s_beg, s_record, 1, 2 $ift s_beg <> "]C": dinc d_good endi dift d_good = 1 'do we need to renumber the chapter '1234567890123 ']CHART 123: ']CHAP: 123: $cut s_any, s_record, 8, 3 $isd d_any, s_any dift d_any <> 1: dinc d_good $cut s_any, s_record, 11, 2 $ift s_any <> ": ": dinc d_good $cut s_any, s_record, 7, 1 $ift s_any <> " ": dinc d_good endi dift d_good = 1 'renumber the chapter if needed dinc d_chapnum $cut s_any, s_record, 8, 3 $tod d_any, s_any dift d_any <> d_chapnum 'renumber the chapter s_any = "000" + d_chapnum $off s_any, s_any, 3 $rep s_record, 8, s_any fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 endi endi dift d_showline = 1 'more dift dg_quiet = 1: d_linect = 0 dinc d_linect dift d_linect >= dg_maxlines d_linect = 1 sub_more d_more = dg_more dift d_more <> 1: dinc d_loop d_showline = d_more d_lastline = 0 endi endi dift d_showline = 1 dg_pass1 = d_record sub_record_show d_lastline = 0 endi dinc d_record endw 'show the last dift d_lastline > 0 dg_pass1 = d_lastline sub_record_show endi dift d_beyondend = 1: $out "lines beyond ]R LAST" ends sub_show_books subr sub_kopy 'updated 2009/02/16, 2007/01/15, 2006/10/17, 2002/06/13 'kopy lines dg_pass1/dg_pass2 to another dg_pass3 vari d_any, s_any, d_dot, s_dot vari d_good, d_loop, d_hold, d_torecord, d_count vari d_record, s_record, d_byte, s_byte, d_long vari d_process, d_lastrecord vari d_toplace1, d_toplace2 dg_kopy1 = dg_pass1 dg_kopy2 = dg_pass2 dg_kopy3 = dg_pass3 dift dg_kopy2 = 0: dg_kopy2 = dg_kopy1 'validate d_process = 1 dift dg_kopy1 < 1: dinc d_process dift dg_kopy2 < 1: dinc d_process dift dg_kopy3 < 1: dinc d_process dift dg_kopy1 > dg_kopy2: dinc d_process dift dg_kopy3 > dg_kopy1 dift dg_kopy3 <= dg_kopy2: dinc d_process endi dift d_process <> 1: $out "no kopy" dift d_process = 1 'how many lines do we want to kopy d_count = 0 d_record = dg_kopy1 d_lastrecord = dg_kopy1 d_loop = 1 dwhi d_loop = 1 d_good = 1 d_any = d_record % 100 dift d_any = 0 $sho "kopy prep=" + d_record endi 'read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 dinc d_loop dinc d_good endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte = "W" dinc d_count d_lastrecord = d_record endi endi dinc d_record dift d_record > dg_kopy2: dinc d_loop endw dg_kopy2 = d_lastrecord endi dift d_process = 1 'is dg_kopy3 beyond the length of the file flen d_dot, sg_fileran d_dot = d_dot \ 72 + 1 dift dg_kopy3 > d_dot: dg_kopy3 = d_dot 'hold where we are pushing to since we do not want 'push to change it d_hold = dg_kopy3 'push to make sure we have room to kopy to d_any = dg_kopy3 % 100 dift d_any = 0 $sho "pushing=" + dg_kopy3 + ", for=" + d_count endi dg_pass1 = dg_kopy3 dg_pass2 = d_count + 1 sub_push dg_kopy3 = d_hold d_toplace1 = 0 d_toplace2 = 0 d_count = 0 d_record = dg_kopy1 d_torecord = dg_kopy3 d_loop = 1 dwhi d_loop = 1 'read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'if good write into new location dift d_long = 72 $cut s_byte, s_record, 71, 1 $ift s_byte = "W" d_any = d_record % 100 dift d_any = 0 $sho "kopying=" + d_record + ", to=" + d_torecord endi dg_modify = d_torecord - 1 dift dg_nowline <> d_torecord: dg_ampline = dg_nowline dg_nowline = d_torecord d_byte = d_torecord - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dift d_any = 0: $out "not kopied=" + d_record dinc d_torecord dift d_toplace1 = 0: d_toplace1 = d_torecord d_toplace2 = d_torecord dinc d_count dinc dg_changes endi endi dinc d_record dift d_record > dg_kopy2: dinc d_loop endw dift d_count = 0: dinc d_good endi s_any = "kopied " + dg_kopy1 + "/" + dg_kopy2 $app s_any, " count=" + d_count + " to=" $app s_any, d_toplace1 + "/" + d_toplace2 dift d_process = 1: $out s_any ends sub_kopy subr sub_thinout 'updated 2012/02/03, 2012/02/01, 2002/06/13 'make a deleted line between each line over range vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_byte, d_good, d_loop vari d_long, d_yes vari d_beg, d_end, d_process, d_show vari d_torecord, s_torecord vari d_count, d_push, s_delrecord vari d_firstgood, d_lastgood d_process = 1 d_beg = 10 d_end = 10 ^ 7 d_show = 2 $inp s_any, "1=show lines" $ift s_any = "1": d_show = 1 dift d_process = 1 'count how many good lines d_beg to d_end d_firstgood = 0 d_lastgood = 0 d_count = 0 d_record = d_beg d_loop = 1 dwhi d_loop = 1 d_any = d_record % 100 dift d_any = 0: $sho "thinout=" + d_record d_good = 1 'calculate the bytes and read in the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any = "W" dinc d_count dift d_firstgood = 0: d_firstgood = d_record d_lastgood = d_record endi endi dinc d_record dift d_record > d_end: dinc d_loop endw d_end = d_lastgood 'how much do we need to push d_any = d_lastgood - d_firstgood + 1 d_push = d_count * 2 - d_any dift d_push < 1: dinc d_process endi dift d_process = 1 d_any = d_lastgood + 1 $out "push record=" + d_any + ", count=" + d_push dg_pass1 = d_lastgood + 1 dg_pass2 = d_push + 5 sub_push 'find d_torecord the last deleted record after d_lastgood d_record = d_lastgood + 1 d_torecord = 0 d_loop = 1 dwhi d_loop = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any = "W" dinc d_loop else d_torecord = d_record endi endi dinc d_record endw 'build a deleted record $ch$ s_delrecord, "z", 71 dch$ s_any, 10, 1 $app s_delrecord, s_any 'move the records down starting at the bottom d_record = d_lastgood d_loop = 1 dwhi d_loop = 1 d_good = 1 'tell d_any = d_record % 100 dift d_any = 0: $sho "thin=" + d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good dift d_good = 1 'the d_torecord must be a deleted record d_yes = 1 d_byte = d_torecord - 1 * 72 + 1 frea s_torecord, sg_fileran, d_byte, 72 $len d_long, s_torecord dift d_long <> 72: dinc d_yes dift d_yes = 1 $cut s_any, s_torecord, 71, 1 $ift s_any = "W": dinc d_yes endi dift d_yes <> 1 $inp s_any, "bad thin at record=" + d_torecord dinc d_good dinc d_loop endi endi dift d_good = 1 'put the old record in d_torecord d_byte = d_torecord - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dift d_any = 0: $out "not thinned=" + d_record 'show the new record dg_pass1 = d_torecord dift d_show = 1: sub_record_show 'delete the old record just put back in d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_delrecord dift d_any = 0: $out "not thinned=" + d_record 'adjust line numbers in global variables dg_pass1 = d_record dg_pass2 = d_torecord sub_push_numbers ddec d_torecord dift d_torecord <= d_record: dinc d_good endi dift d_good = 1 'the new d_torecord must be a deleted record d_yes = 1 d_byte = d_torecord - 1 * 72 + 1 frea s_torecord, sg_fileran, d_byte, 72 $len d_long, s_torecord dift d_long <> 72: dinc d_yes dift d_yes = 1 $cut s_any, s_torecord, 71, 1 $ift s_any = "W": dinc d_yes endi dift d_yes <> 1 $inp s_any, "bad thin at record=" + d_torecord dinc d_good dinc d_loop endi ddec d_torecord endi ddec d_record dift d_record < d_firstgood: dinc d_loop endw endi $out "thinned count=" + d_count ends sub_thinout subr sub_push 'updated 2006/12/28, 2005/11/26, 2004/10/21 'push down line number dg_pass1 for dg_pass2 lines vari s_blanks, s_char10, s_71z vari d_push, d_many, d_torecord, d_count, d_any vari d_record, s_record, d_byte, s_byte d_push = dg_pass1 d_many = dg_pass2 dch$ s_blanks, 32, 1 dch$ s_char10, 10, 1 'd_push must be at least one dift d_push < 1: d_push = 1 'd_many must be at least one dift d_many < 1: d_many = 1 'how far down must we go to find d_many deleted lines d_torecord = d_push d_count = 0 d_record = d_push dwhi d_count < d_many 'calculate the bytes and read in the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_any, s_record 'test to see if we read in a record dift d_any < 72 'since there is not a record then write one! '71 z's and a line feed = 10 $ch$ s_71z, "z", 71 s_record = s_71z + s_char10 d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 endi 'do we have a good record or not $cut s_byte, s_record, 71, 1 $ift s_byte <> "W" 'save the record number of the deleted record d_torecord = d_record 'increment the count of deleted records dinc d_count else d_any = d_record % 100 dift d_any = 0 $sho "push=" + d_record endi endi dinc d_record endw 'starting with d_torecord read upward and move 'all good lines compacted down to d_torecord 'd_torecord is the last deleted record before d_record d_record = d_torecord - 1 dwhi d_record >= d_push 'change system line numbers to new numbers dg_pass1 = d_record dg_pass2 = d_torecord sub_push_numbers 'read in d_record and if good put into d_torecord d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 'do we have a good record $cut s_byte, s_record, 71, 1 $ift s_byte = "W" d_any = d_record % 100 dift d_any = 0 $sho "push from=" + d_record + ", to=" + d_torecord endi 'put the good record in d_torecord d_byte = d_torecord - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 'put a deleted record in d_record 'since it has been moved down $ch$ s_71z, "z", 71 s_record = s_71z + s_char10 d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 'move up to the next deleted record ddec d_torecord endi ddec d_record endw ends sub_push subr sub_push_numbers 'updated 2006/05/04, 2006/02/09, 2004/08/18 'fix system record numbers 'shift various system line numbers from dg_pass1 to dg_pass2 dift dg_add = dg_pass1: dg_add = dg_pass2 dift dg_modify = dg_pass1: dg_modify = dg_pass2 dift dg_view1s = dg_pass1: dg_view1s = dg_pass2 dift dg_view2s = dg_pass1: dg_view2s = dg_pass2 dift dg_view1v = dg_pass1: dg_view1v = dg_pass2 dift dg_view2v = dg_pass1: dg_view2v = dg_pass2 dift dg_view1z = dg_pass1: dg_view1z = dg_pass2 dift dg_view2z = dg_pass1: dg_view2z = dg_pass2 dift dg_wrapline = dg_pass1: dg_wrapline = dg_pass2 dift dg_kopy1 = dg_pass1: dg_kopy1 = dg_pass2 dift dg_kopy2 = dg_pass1: dg_kopy2 = dg_pass2 dift dg_kopy3 = dg_pass1: dg_kopy3 = dg_pass2 dift dg_list1 = dg_pass1: dg_list1 = dg_pass2 dift dg_list2 = dg_pass1: dg_list2 = dg_pass2 dift dg_echapter = dg_pass1: dg_echapter = dg_pass2 dift dg_rchapter = dg_pass1: dg_rchapter = dg_pass2 dift dg_tchapter = dg_pass1: dg_tchapter = dg_pass2 dift dg_bookcurrent = dg_pass1: dg_bookcurrent = dg_pass2 dift dg_findbegin = dg_pass1: dg_findbegin = dg_pass2 dift dg_chaplinetoshow = dg_pass1: dg_chaplinetoshow = dg_pass2 dift dg_paragraph1 = dg_pass1: dg_paragraph1 = dg_pass2 dift dg_paragraph2 = dg_pass1: dg_paragraph2 = dg_pass2 dift dg_ampline = dg_pass1: dg_ampline = dg_pass2 dift dg_nowline = dg_pass1: dg_nowline = dg_pass2 dift dg_backline = dg_pass1: dg_backline = dg_pass2 ends sub_push_numbers subr sub_wrap 'updated 2010/08/19, 2009/01/04, 2008/11/28 '2008/10/28, 2008/03/30, 2008/02/18, 2006/10/06, 2005/11/08 '2005/09/11, 2005/04/30, 2005/04/14, 2005/04/05, 2004/10/21 'wrap the words in the paragraph vari d_any, s_any, d_dot, s_dot, d_tap, s_tap vari d_index, d_beg, s_beg, s_char10, d_wraplong vari d_loop, d_lastrecord, d_spot, d_good, s_line vari d_everyct, d_ctgoodlines, d_count, d_musthave vari s_hold, s_quote, d_totlong, d_process vari d_record, s_record, d_byte, s_byte, d_long vari d_wordcount1, d_wordcount2, d_wrappedok 'dg_wrapline is the beginning line 'dg_wraplong tells the wraplong 'd_paragraph = 1 begins the paragraph in 1 not 5 d_record = dg_pass1 d_wraplong = dg_pass2 d_process = 1 d_wrappedok = 1 'do we have a new line to begin wrapping at dift d_record > 0 dg_wrapline = d_record 'make view x same as wrap dg_view1x = dg_wrapline dg_view2x = 0 endi 'the default wraplong is 67 d_dot = 0 dift dg_wraplong < 50: d_dot = 67 dift dg_wraplong = 50: d_dot = 55 dift dg_wraplong = 55: d_dot = 58 dift dg_wraplong = 58: d_dot = 61 dift dg_wraplong = 61: d_dot = 64 dift dg_wraplong = 64: d_dot = 67 dift dg_wraplong = 67: d_dot = 70 dift dg_wraplong >= 70: d_dot = 50 dift d_dot = 0: d_dot = 67 dg_wraplong = d_dot dift d_wraplong > 12 dift d_wraplong > 70: d_wraplong = 70 dg_wraplong = d_wraplong else d_wraplong = dg_wraplong endi dch$ s_char10, 10, 1 'the previous line must be a ], ), " " line d_musthave = 1 d_record = dg_wrapline - 1 d_loop = d_process dwhi d_loop = 1 'read backwards to find the previous record d_good = 1 'read record d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'good record or not dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 'we do have a good record $cut s_any, s_record, 1, 1 $ift s_any = ")": dinc d_musthave $ift s_any = "]": dinc d_musthave $ift s_any = " ": dinc d_musthave dinc d_loop endi ddec d_record dift d_record < 1: dinc d_loop endw 'find the last line and load lines into s_hold s_hold = sg_nothing d_record = dg_wrapline d_lastrecord = dg_wrapline d_everyct = 0 d_ctgoodlines = 0 d_loop = 1 dift d_musthave = 1 $out "not paragraph beginning" dinc d_wrappedok dinc d_process endi d_loop = d_process dwhi d_loop = 1 'string all lines together in s_hold d_good = 1 'read record d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 'count the records with d_everyct dinc d_everyct 'save last record d_lastrecord = d_record $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 'end record or not 'good record count dinc d_ctgoodlines 'a "$ " marks an end record if in money mode 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog dift dg_mode = 2 $cut s_beg, s_record, 1, 2 $ift s_beg = "$ " dinc d_good dinc d_loop ddec d_everyct ddec d_ctgoodlines ddec d_lastrecord endi endi 'a ],)," " marks an end record $cut s_beg, s_record, 1, 1 $ift s_beg = ")": s_beg = "]" $ift s_beg = " ": s_beg = "]" $ift s_beg = "]" dinc d_good dinc d_loop ddec d_everyct ddec d_ctgoodlines ddec d_lastrecord endi endi dift d_good = 1 'cut, right trim and add the line to our hold string $cut s_line, s_record, 1, 70 'shrink to take out not needed spaces sg_pass1 = s_line sub_shrink s_line = sg_pass1 'add to hold $app s_hold, " " + s_line endi dinc d_record endw dift d_process = 1 'all of the lines are in s_hold $len d_totlong, s_hold 'do a beginning word count dg_pass1 = dg_wrapline dg_pass2 = d_lastrecord sub_range_word_count d_wordcount1 = dg_pass1 d_good = 1 'do we have at least one line and not more than 200 dift d_ctgoodlines < 1: d_good = 2 dift d_ctgoodlines > 200: d_good = 2 endi dift d_process <> 1 $out "too many/few" dinc d_wrappedok endi 'we need the string array so use 1 to 200 'blank the string array arrb 'break up the string in s_hold and store in the array d_ctgoodlines = 0 d_index = 1 d_loop = d_process dwhi d_loop = 1 d_good = 1 'get the length of s_hold to know what to do $len d_long, s_hold dift d_long <= d_wraplong $toi d_index, s_hold s_hold = sg_nothing 'count the lines with d_ctgoodlines dinc d_ctgoodlines dinc d_loop dinc d_good endi dift d_good = 1 dift d_wraplong = 50 'break into sentences 'find the first occurrence of .!?:;, 'less than 70 $bak d_byte, s_hold, 70, " " dift d_byte = 0: d_byte = 70 $cut s_beg, s_hold, 1, d_byte $len d_long, s_beg d_byte = 0 d_tap = 3 dwhi d_tap <= d_long 'find d_byte = first occurrence of .!?:;, $cut s_tap, s_beg, d_tap, 1 s_any = ".!?:;," $lok d_any, s_any, 1, s_tap dift d_any > 0 d_byte = d_tap d_tap = 99 else dinc d_tap endi endw 'if not found then find last space dift d_byte = 0 $bak d_byte, s_beg, 70, " " dift d_byte = 0: d_byte = 70 endi 'wrap at first space beyond d_byte $lok d_byte, s_beg, d_byte, " " dift d_byte = 0: d_byte = 70 endi dift d_wraplong < 50 'wrap a chess game score 'find " 99." $bak d_byte, s_hold, d_wraplong, "." dift d_byte > 5 ddec d_byte $bak d_byte, s_hold, d_byte, " " else d_byte = 0 endi dift d_byte = 0: $bak d_byte, s_hold, 70, " " dift d_byte = 0: d_byte = 70 endi dift d_wraplong > 50 'find the first blank going left from d_wraplong d_beg = d_wraplong + 1 $bak d_byte, s_hold, d_beg, " " dift d_byte < 5: d_byte = 71 endi 'save the part to the left of d_byte 'and cut it from s_hold $cut s_beg, s_hold, 1, d_byte $toi d_index, s_beg 'count them with d_ctgoodlines dinc d_ctgoodlines 'get s_hold without the part we just took off $cut s_beg, s_hold, d_byte, 1 $ift s_beg = " ": dinc d_byte $cut s_hold, s_hold, d_byte, 99999 endi dinc d_index endw dift d_process = 1 'the new lines d_ctgoodlines must be <= d_everyct dift d_ctgoodlines > d_everyct $out "not enough lines" dinc d_process dinc d_wrappedok 'push to make some room dg_pass1 = d_lastrecord + 1 dg_pass2 = d_ctgoodlines - d_everyct + 3 sub_push dg_wraplong = 70 endi endi 'write the lines to the file d_record = dg_wrapline d_index = 1 d_count = 0 d_loop = d_process dwhi d_loop = 1 'do we have more wrapped lines to write dinc d_count dift d_count <= d_ctgoodlines 'prep the wrapped line ito$ s_line, d_index 'remove extraneous spaces sg_pass1 = s_line sub_shrink s_line = sg_pass1 dch$ s_any, 32, 70 $app s_line, s_any $cut s_line, s_line, 1, 70 $app s_line, "W" + s_char10 else 'prep a deleted line dch$ s_any, 32, 70 s_line = s_any + "d" + s_char10 endi 'write the record d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_line dbad d_any = 0 'increment and test for done dinc d_index dinc d_record dift d_record > d_lastrecord: dinc d_loop endw dift d_process = 1 dift dg_quiet <> 1 'show the records dg_pass1 = dg_wrapline dg_pass2 = d_ctgoodlines sub_show_lines_after endi dinc dg_changes dg_pass1 = dg_wrapline dg_pass2 = d_lastrecord sub_range_word_count d_wordcount2 = dg_pass1 s_any = "wrapped=" + dg_wrapline + ", length=" + d_wraplong $app s_any, ", beg words=" + d_wordcount1 $app s_any, ", end words=" + d_wordcount2 $app s_any, ", tot long=" + d_totlong $out s_any endi dg_pass1 = d_wrappedok ends sub_wrap subr sub_range_wrap 'updated 2002/07/11 'wrap paragraphs over a range of lines dg_list1/dg_list2 vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_byte, d_count, d_notcount vari d_long, d_loop, d_good, d_wraplength vari d_begwords, d_endwords, s_beg, s_previous $inp s_any, "enter wrap length, 45 to 70" d_wraplength = 64 $isd d_any, s_any dift d_any = 1: $tod d_wraplength, s_any d_good = 1 dift dg_list1 = 0: dinc d_good dift dg_list2 = 0: dinc d_good dift dg_list2 < dg_list1: dinc d_good dift d_wraplength < 45: dinc d_good dift d_wraplength > 70: dinc d_good dift d_good = 1 dg_pass1 = dg_list1 dg_pass2 = dg_list2 sub_range_word_count d_begwords = dg_pass1 endi d_notcount = 0 d_count = 0 d_record = dg_list1 d_loop = d_good dwhi d_loop = 1 'read record d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'good record or not dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 $cut s_beg, s_record, 1, 1 $ift s_beg = ")": s_beg = "]" dinc d_good $ift s_beg = " ": d_good = 1 $ift s_previous = "]" $ift s_beg <> "]": d_good = 1 endi s_previous = s_beg endi dift d_good = 1 dinc d_count dg_pass1 = d_record dg_pass2 = d_wraplength dg_pass3 = 5 sub_wrap dift dg_pass1 <> 1: dinc d_notcount endi d_good = 1 dinc d_record dift d_record > dg_list2 : dinc d_loop endw dift d_good = 1 dg_pass1 = dg_list1 dg_pass2 = dg_list2 sub_range_word_count d_endwords = dg_pass1 endi s_any = "wrapped=" + d_count + ", not=" + d_notcount $app s_any, ", beg words=" + d_begwords $app s_any, ", end words=" + d_endwords $out s_any ends sub_range_wrap subr sub_shrink 'updated 2001/08/02 'have no more than one space between non-spaces vari d_any, s_any, d_dot, s_dot vari s_two, d_byte, s_line, d_long s_line = sg_pass1 $bes s_line, s_line $trb s_line, s_line $len d_long, s_line d_byte = 1 dwhi d_byte <= d_long $cut s_two, s_line, d_byte, 2 $ift s_two = " " $del s_line, d_byte, 1 $len d_long, s_line else dinc d_byte endi endw sg_pass1 = s_line ends sub_shrink subr sub_range_word_count 'updated 2001/11/11 'count words over a range vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_byte, d_long, d_loop, d_good vari d_begrecord, d_endrecord, d_count, d_blank d_begrecord = dg_pass1 d_endrecord = dg_pass2 d_record = d_begrecord d_count = 0 d_loop = 1 dwhi d_loop = 1 d_any = d_record % 100 dift d_any = 0: $sho "word count=" + d_record d_good = 1 'read record d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'good record or not dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 d_blank = 1 d_dot = 1 dwhi d_dot <= 70 $cut s_dot, s_record, d_dot, 1 $ift s_dot = " " d_blank = 1 else dift d_blank = 1: dinc d_count dinc d_blank endi dinc d_dot endw endi dinc d_record dift d_record > d_endrecord: dinc d_loop endw dg_pass1 = d_count ends sub_range_word_count subr sub_money 'updated 2011/06/29, 2006/06/25 '2006/05/27, 2005/11/05, 2005/06/11, 2005/04/24, 2004/10/21 'total up money lines in a book 'money lines begin with '$ ' in format by sub_arrange_money vari d_any, s_any, d_dot, s_dot, d_tap, s_tap, s_beg, s_out vari d_record, s_record, d_byte, s_byte, s_hold vari d_long, d_loop, d_process, d_good, d_update vari d_delta, s_delta, d_balance, s_balance, d_banktotal vari d_recomonth, d_totmonth, s_totmonth vari d_ourtotal, s_ourtotal, d_sincebaltotal vari d_showrecord, d_linect d_record = dg_pass1 dift d_record = 0: d_record = dg_bookcurrent dift d_record = 0: d_record = dg_echapter dg_echapter = d_record 'do we have a book d_process = 1 dg_pass1 = d_record sub_record_show s_record = sg_pass1 $cut s_any, s_record, 1, 6 $ift s_any <> "]BOOK:" dinc d_process $out "not book" else dg_bookcurrent = d_record dg_findbegin = d_record dinc d_record endi 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog dg_mode = 2 d_linect = 0 d_delta = 0 d_ourtotal = 0 d_banktotal = 0 d_sincebaltotal = 0 d_balance = 0 d_totmonth = 0 d_recomonth = 0 d_loop = d_process dwhi d_loop = 1 d_good = 1 d_update = 2 'read record d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record 'good record or not dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 d_any = 2 $cut s_beg, s_record, 1, 2 $ift s_beg = "]B": d_any = 1 $ift s_beg = "]C": d_any = 1 $ift s_beg = "]M": d_any = 1 dift d_any = 1 dinc d_good dinc d_loop endi $ift s_beg <> "$ ": dinc d_good $ift s_beg = "]D" d_any = d_totmonth / 100 dto$ s_totmonth, d_any, 10, 2 $cut s_any, s_record, 1, 70 $out d_record + " " + s_any $out "tot at month=" + s_totmonth endi endi dift d_good = 1 'trans code of 99 means other bank transaction $cut s_any, s_record, 58, 2 $ift s_any = "99": dinc d_good endi dift d_good = 1 'make sure format is correct $cut s_hold, s_record, 1, 70 sg_pass1 = s_hold sub_arrange_money $ift sg_pass1 <> s_hold $rep s_record, 1, sg_pass1 d_update = 1 dinc dg_changes endi 'money record format done by sub_arrange_money '1/1 $ record ID '3/6 check number '8/15 date '17/56 description '58/59 reconciliation month '61/70 delta amount $cut s_any, s_record, 58, 2 d_recomonth = 0 $isd d_any, s_any dift d_any = 1: $tod d_recomonth, s_any 'get d_delta in cents $cut s_delta, s_record, 61, 10 $trb s_delta, s_delta d_delta = 0 $isd d_any, s_delta dift d_any = 1: $tod d_delta, s_delta d_delta = d_delta * 100 \ 1 d_showrecord = 1 dift d_recomonth > 0 d_banktotal = d_banktotal + d_delta dinc d_showrecord endi 'total and get s_ourtotal d_ourtotal = d_ourtotal + d_delta d_any = d_ourtotal / 100 dto$ s_ourtotal, d_any, 10, 2 $trb s_ourtotal, s_ourtotal 'total d_sincebaltotal d_sincebaltotal = d_sincebaltotal + d_delta d_totmonth = d_totmonth + d_delta dift d_update = 1 'we need to update the record fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 dinc dg_changes endi dift d_showrecord = 1 dinc d_linect dift d_linect > 10 sub_more dift dg_more <> 1: dinc d_loop d_linect = 1 endi 'show the record dg_pass1 = d_record sub_record_show endi $cut s_any, s_record, 17, 8 $ift s_any = "Balanced" 'show the record dg_pass1 = d_record sub_record_show d_any = d_ourtotal / 100 d_dot = d_banktotal / 100 d_tap = d_sincebaltotal / 100 dto$ s_any, d_any, 1, 2 dto$ s_dot, d_dot, 1, 2 dto$ s_tap, d_tap, 1, 2 s_out = "at bal: total=" + s_any $app s_out, ", bank total=" + s_dot $app s_out, ", since prevbal=" + s_tap $out s_out sub_more dift dg_more <> 1: dinc d_loop d_linect = 1 d_sincebaltotal = 0 endi endi dinc d_record endw dift d_process = 1 d_ourtotal = d_ourtotal / 100 d_banktotal = d_banktotal / 100 d_totmonth = d_totmonth / 100 dto$ s_any, d_ourtotal, 1, 2 dto$ s_dot, d_banktotal, 1, 2 dto$ s_beg, d_totmonth, 1, 2 s_any = "end: total=" + s_any + ", bank=" + s_dot $app s_any, ", totmonth=" + s_beg $out s_any endi ends sub_money subr sub_code_lines 'updated 2009/02/16 '2006/09/18, 2006/06/21, 2006/06/20, 2006/06/18, 2006/06/17 '2006/06/16, 2006/03/16, 2005/12/29, 2005/04/09, 2004/10/21 vari d_any, s_any, d_dot, s_dot vari d_process, d_good, d_beg, d_end vari d_char, s_toe, d_inout, s_ending, s_blanks vari d_onlyshow, s_line, d_lines, d_loop, d_count vari d_record, s_record, d_byte, s_byte, d_long d_beg = dg_pass1 d_end = dg_pass2 dift d_end = 0: d_end = d_beg dift d_beg = 0: d_beg = dg_list1 dift d_end = 0: d_end = dg_list2 $ch$ s_blanks, " ", 70 s_ending = ".,;" d_inout = 0 d_process = 1 dift d_process = 1 dift d_beg < 1: dinc d_process dift d_end = 0: d_end = d_beg dift d_end < d_beg: dinc d_process endi dift d_process = 1 d_onlyshow = 3 $inp s_any, "1=just look, 2=change record" $ift s_any = "*": dinc d_process $ift s_any = "1": d_onlyshow = 1 $ift s_any = "2": d_onlyshow = 2 endi d_count = 0 d_lines = 1 d_record = d_beg d_loop = d_process dwhi d_loop = 1 d_any = d_record % 1000 dift d_any = 0: $sho "code=" + d_record d_good = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 1, 3 $ift s_any <> "]E ": dinc d_good endi dift d_good = 1 'we have an ]E record dinc d_count $cut s_line, s_record, 4, 67 $cod s_line, s_line $rep s_record, 4, s_line $cut s_line, s_record, 1, 70 endi dift d_good = 1 dift dg_nowline <> d_record: dg_ampline = dg_nowline dg_nowline = d_record dift d_onlyshow = 1 dinc d_lines dto$ s_any, d_record, 6, 0 $out s_any + " " + s_line else 'write the record back d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 dinc dg_changes endi endi dift d_onlyshow = 1 'do we need a sub_more dift d_lines >= dg_maxlines d_lines = 1 sub_more d_loop = dg_more endi endi dinc d_record dift d_record > d_end: dinc d_loop endw dift d_process = 1 dift d_onlyshow = 1 $out "shown=" + d_count else $out "changed=" + d_count endi dift d_count = 0: $out "lines must begin with ]E" else $out "error" endi ends sub_code_lines subr sub_file_oldtoe 'updated 2009/05/20 '2008/10/22, 2007/09/17, 2007/02/14, 2007/02/06, 2006/09/11 '2006/08/26, 2006/08/09, 2006/04/08, 2006/03/17, 2006/03/16 'oldtoe vari d_any, s_any, d_dot, s_dot, s_out vari d_long, d_loop, d_byte, s_line1, s_line2, d_seconds vari s_char, d_char, s_file1, s_file2, d_process vari s_key, d_which d_process = 1 dift d_process = 1 $tlo s_file1, sg_fileexp $inp s_any, "enter input file name, default=" + s_file1 $tlo s_any, s_any $ift s_any = "*": dinc d_process $len d_any, s_any dift d_any > 1: s_file1 = s_any endi dift d_process = 1 'switch to the other probable extension $lok d_any, s_file1, 1, "." dift d_any > 1 $cut s_file2, s_file1, 1, d_any $cut s_any, s_file1, d_any, 99999 $ift s_any = ".toe" $app s_file2, "exp" else $app s_file2, "toe" endi else s_file2 = s_file1 + ".toe" endi $inp s_any, "enter output file name, default=" + s_file2 $tlo s_any, s_any $ift s_any = "*": dinc d_process $len d_any, s_any dift d_any > 1: s_file2 = s_any endi dift d_process = 1 $len d_any, sg_key dift d_any > 0 s_key = sg_key else $inp s_key, "enter a word" $ift s_key = "*": dinc d_process sub_cls endi endi dift d_process = 1 flen d_any, s_file2 dift d_any >= 0 ded$ s_dot, d_any, 0, 0 $out "file=" + s_file2 + ", length=" + s_dot $inp s_any, "1=purge file=" + s_file2 $ift s_any = "*": dinc d_process $ift s_any <> "1": dinc d_process endi endi dift d_process = 1 d_which = 1 $inp s_any, "1=into, 2=out of" $ift s_any = "*": dinc d_process $ift s_any = "2": d_which = 2 endi dift d_process = 1 dsec d_seconds finp s_line1, s_file1 $len d_long, s_line1 fdel d_any, s_file2 $toe s_line2, s_line1, s_key, d_which fout d_any, s_file2, s_line2 dbad d_any = 0 dsec d_any d_seconds = d_any - d_seconds ded$ s_dot, d_long, 0, 0 $inp s_any, "done, length=" + s_dot + ", sec=" + d_seconds endi ends sub_file_oldtoe subr sub_key 'updated 2007/02/06 vari d_any, s_any, d_dot, s_dot, s_out $inp sg_key, "enter" $cup sg_key, sg_key $hsh dg_key, sg_key sub_cls ends sub_key subr sub_file_hash 'updated 2006/06/02, 2006/05/31 'hash vari d_any, s_any, d_dot, s_dot, s_out vari d_long, s_long, d_hash, s_hash, d_seconds vari s_line, s_file, d_process d_process = 1 dift d_process = 1 $inp s_file, "enter input file name" $ift s_file = "*": dinc d_process endi dift d_process = 1 dsec d_seconds finp s_line, s_file $len d_long, s_line ded$ s_long, d_long, 0, 0 $hsh d_hash, s_line ded$ s_hash, d_hash, 0, 0 dsec d_any d_seconds = d_any - d_seconds s_dot = "done, hash=" + s_hash $app s_dot, ", length=" + s_long $app s_dot, ", sec=" + d_seconds $inp s_any, s_dot endi ends sub_file_hash subr sub_updated_line 'updated 2005/03/14, 2005/03/02, 2005/03/01, 2004/10/21 'add updated line ]Updated or update ]Updated 2002/05/27 vari d_any, s_any, d_dot, s_dot, s_out vari d_record, s_record, d_byte, s_newrecord vari d_findrecord, s_findrecord, s_end vari s_newdate, d_loop, d_good, d_process d_record = dg_pass1 dift d_record = 0: d_record = dg_nowline d_process = 1 dift d_record < 5: dinc d_process 'build up the new record ']Updated 2002/05/27 '12345678901234567890123456789012345 '27-MAY-2002 10:55:01 20020527105501 $dat s_newdate $cut s_newdate, s_newdate, 22, 8 $ins s_newdate, 7, "/" $ins s_newdate, 5, "/" s_newrecord = "]Updated " + s_newdate $ch$ s_any, " ", 80 $app s_newrecord, s_any $cut s_newrecord, s_newrecord, 1, 70 dch$ s_any, 10, 1 $app s_newrecord, "W" + s_any 'find the previous chap or book d_findrecord = 2 d_loop = 1 dwhi d_loop = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 $len d_any, s_record dift d_any <> 72: dinc d_good dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 d_findrecord = d_record s_findrecord = s_record $cut s_any, s_record, 1, 1 $ift s_any = "]" $cut s_any, s_record, 2, 1 s_dot = "BCMR" $lok d_any, s_dot, 1, s_any dift d_any > 0: dinc d_loop endi endi ddec d_record dift d_record < 1: dinc d_loop endw dift d_findrecord < 3: dinc d_process dift d_process = 1 dg_pass1 = d_findrecord sub_record_show endi 'find the next record after the d_findrecord d_record = d_findrecord + 1 d_findrecord = 2 d_loop = d_process dwhi d_loop = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 $len d_any, s_record dift d_any <> 72: dinc d_good dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 d_findrecord = d_record s_findrecord = s_record dinc d_loop endi dinc d_record endw 'do we have a ]U record d_record = d_findrecord $cut s_any, s_findrecord, 1, 2 $ift s_any = "]U" 'we have in s_findrecord a ]U record '1234567890123456789 ']Updated 2002/05/27 'do we have the same date as s_newdate $cut s_any, s_findrecord, 10, 10 $ift s_any <> s_newdate $cut s_end, s_findrecord, 71, 2 s_any = s_newdate + ", " $ins s_findrecord, 10, s_any $cut s_findrecord, s_findrecord, 1, 70 $bak d_any, s_findrecord, 70, " " $cut s_findrecord, s_findrecord, 1, d_any $ch$ s_any, " ", 80 $app s_findrecord, s_any $cut s_findrecord, s_findrecord, 1, 70 s_newrecord = s_findrecord + s_end else s_newrecord = s_findrecord endi else 'we did not have a ]U record dg_pass1 = d_record dg_pass2 = 1 dift d_process = 1: sub_push endi dift d_process = 1 d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_newrecord dbad d_any = 0 dg_pass1 = d_record sub_record_show dinc dg_changes endi ends sub_updated_line subr sub_paragraph_begin 'updated 2009/06/19, 2009/02/16, 2008/11/24, 2008/11/12 '2008/11/07, 2008/11/05, 2007/01/15, 2006/10/15, 2004/10/21 'begin a new paragraph by inserting a ] or ]- line 'if rpg dg_mode=3 put C* line 'if dg_pass2 = 4 then "todo" then a ToDo: line vari d_any, s_any, d_dot, s_dot vari s_record, d_record, d_byte, d_good, d_dash, s_char10 d_record = dg_pass1 d_dash = dg_pass2 d_good = 1 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog dift dg_mode = 3: d_dash = 3 flen d_any, sg_fileran d_any = d_any / 72 dift d_record > d_any: dinc d_good dift d_record < 3: dinc d_good dift d_good = 1 dg_pass1 = d_record dg_pass2 = 1 sub_push d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_any, s_record dift d_any <> 72: dinc d_good endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any = "W": dinc d_good endi dift d_good = 1 $ch$ s_record, " ", 69 dift d_dash = 1: $ch$ s_record, "-", 69 dch$ s_char10, 10, 1 s_record = "]" + s_record + "W" + s_char10 dift d_dash = 3 'if RPG dg_mode = 3 $ch$ s_record, " ", 70 $rep s_record, 6, "C*" $app s_record, "W" + s_char10 endi dift d_dash = 4 'ToDo: line $ch$ s_record, " ", 70 $rep s_record, 1, "] ToDo: 0000/00/00, Done:" $rep s_record, 37, "," $rep s_record, 39, "#" $rep s_record, 40, "0" $dat s_dot '1234567890123456789012345678901234567890 '22-MAR-2002 21:28:16 20020322212816 '] ToDo: 0000/00/00, Done: 0000/00/00, #0 $cut s_any, s_dot, 22, 4 $rep s_record, 9, s_any $cut s_any, s_dot, 26, 2 $rep s_record, 14, s_any $cut s_any, s_dot, 28, 2 $rep s_record, 17, s_any $app s_record, "W" + s_char10 endi fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 dg_pass1 = d_record sub_record_show dinc d_record dg_pass1 = d_record sub_record_show dift dg_nowline <> d_record: dg_ampline = dg_nowline dg_nowline = d_record dinc dg_changes else $out "not done" endi ends sub_paragraph_begin subr sub_paragraph_lines 'updated 2009/01/04, 2006/09/19, 2006/06/18, 2004/10/21 'toggle paragraph lines vari d_any, s_any, d_dot, s_dot vari d_update, d_good, d_loop vari s_record, d_record, d_byte, s_line, s_number, d_long vari d_beg, d_end, d_mode, d_continue, s_beg d_beg = dg_pass1 d_end = dg_pass2 d_mode = dg_pass3 dift d_beg = 0 d_beg = dg_paragraph1 d_end = dg_paragraph2 else d_mode = 1 endi dift d_mode = 0: d_mode = dg_paragraph3 dift d_end = 0: d_end = d_beg d_good = 1 dift d_beg > d_end: dinc d_good dift d_good = 1 dinc d_mode dift d_mode > 5: d_mode = 2 dift d_mode < 2: d_mode = 2 dg_paragraph1 = d_beg dg_paragraph2 = d_end dg_paragraph3 = d_mode endi d_continue = 2 d_record = d_beg d_loop = d_good dwhi d_loop = 1 'read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 d_any = 2 $cut s_beg, s_record, 1, 2 $ift s_beg = "]B": d_any = 1 $ift s_beg = "]C": d_any = 1 $ift s_beg = "]M": d_any = 1 dift d_any = 1 dg_pass1 = d_record sub_record_show dift d_continue <> 1 $out "doing o " + d_beg + "," + d_end d_continue = 3 $inp s_any, "1=no stop, 2=stop at ]C, 3=end now" $ift s_any = "1": d_continue = 1 $ift s_any = "2": d_continue = 2 dift d_continue = 3 dinc d_good dinc d_loop endi endi endi endi dift d_good = 1 $cut s_line, s_record, 1, 70 $cut s_beg, s_line, 1, 1 'remove a > as in a e-mail reply $ift s_beg = ">": $cut s_line, s_line, 2, 9999 'if a line is only a ] then do not change $ift s_beg = "]" $trb s_any, s_line $len d_any, s_any dift d_any = 1: dinc d_good 'if byte 2 is not blank, E, N do not change $cut s_any, s_line, 2, 1 $ift s_any = "E": s_any = " " $ift s_any = "N": s_any = " " $ift s_any <> " ": dinc d_good endi 'if a dash line then do not change $cut s_beg, s_line, 1, 2 $ift s_beg = "]*": dinc d_good $ift s_beg = "]-": dinc d_good endi dift d_good = 1 d_dot = 0 $cut s_beg, s_line, 1, 2 $ift s_beg = "] ": d_dot = 3 $cut s_beg, s_line, 1, 3 $ift s_beg = "]E ": d_dot = 4 $ift s_beg = "]N ": d_dot = 4 dift d_dot > 0: $cut s_line, s_line, d_dot, 99 'put new beginnings on depending on d_mode 'begin line with "] " line dift d_mode = 2: s_line = "] " + s_line 'begin line with "]E " line dift d_mode = 3: s_line = "]E " + s_line 'begin line with "]N " line dift d_mode = 4: s_line = "]N " + s_line 'd_mode = 5 begin line in byte 1 so do nothing endi d_update = 2 dift d_good = 1 $trr s_any, s_line $len d_any, s_any dift d_any <= 70 d_update = 1 else dinc d_update $out "too long=" + d_record endi endi dift d_update = 1 $ch$ s_any, " ", 80 $app s_line, s_any $cut s_line, s_line, 1, 70 d_byte = d_record - 1 * 72 + 1 dch$ s_any, 10, 1 s_record = s_line + "W" + s_any fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 dinc dg_changes dift dg_quiet <> 1 dg_pass1 = d_record sub_record_show endi endi dinc d_record dift d_record > d_end: dinc d_loop endw ends sub_paragraph_lines subr sub_left_justify 'updated 2004/10/21 'left justify lines vari d_any, s_any, d_dot, s_dot vari d_update, d_good, d_loop, s_line vari s_record, d_record, d_byte, s_number, d_long vari d_beg, d_end, d_mode, d_continue, s_beg d_beg = dg_pass1 d_end = dg_pass2 dift d_end = 0: d_end = d_beg d_good = 1 dift d_beg > d_end: dinc d_good d_continue = 2 d_record = d_beg d_loop = d_good dwhi d_loop = 1 'read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 'have we hit a new book or new chapter or new memo d_any = 2 $cut s_beg, s_record, 1, 2 $ift s_beg = "]B": d_any = 1 $ift s_beg = "]C": d_any = 1 $ift s_beg = "]M": d_any = 1 dift d_any = 1 dg_pass1 = d_record sub_record_show dift d_continue <> 1 $out "doing left " + d_beg + "," + d_end d_continue = 3 $inp s_any, "1=no stop, 2=stop at ]C, 3=end now" $ift s_any = "1": d_continue = 1 $ift s_any = "2": d_continue = 2 dift d_continue = 3 dinc d_good dinc d_loop endi endi endi endi dift d_good = 1 $cut s_beg, s_record, 1, 1 $ift s_beg <> " ": dinc d_good endi dift d_good = 1 'left justify the line $cut s_line, s_record, 1, 70 $trl s_line, s_line $ch$ s_any, " ", 80 $app s_line, s_any $cut s_line, s_line, 1, 70 d_byte = d_record - 1 * 72 + 1 'put a line feed char in s_any dch$ s_any, 10, 1 s_record = s_line + "W" + s_any fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 dinc dg_changes dg_pass1 = d_record sub_record_show endi dinc d_record dift d_record > d_end: dinc d_loop endw ends sub_left_justify subr sub_menu_prog 'updated 2008/09/14, 2008/04/02 '2008/03/11, 2008/02/09, 2007/03/25, 2007/01/15, 2007/01/01 '2006/09/01, 2006/05/10, 2006/03/26, 2006/03/12, 2005/10/11 '2005/10/08, 2005/07/27, 2005/02/07, 2005/01/18, 2004/12/31 vari d_any, s_out, s_pick, d_pick 'dg_mode=3 means RPG mode 'dg_mode=5 means program mode dift dg_mode <> 3: dg_mode = 5 d_any = dg_list1 * dg_list2 dift d_any = 1 dg_list1 = 1 dg_list2 = 1000 * 1000 - 1 endi s_out = "list=" + dg_list1 + "/" + dg_list2 $out s_out $out "11. sub_prog_teapro_indent" $out "12. sub_prog_c_indent" $out "21. read through RPG programs for various types, info" $out "22. read through RPG programs for month chg listing" $out "23. validate format of note file" $out "31. make RPG program file from this fixran file" $out "41. find obsolete or certain syntax in RPG programs" $out "51. sub_wrpg_wstr_append_progs_or_streams" $out "61. sub_rpg_compare_2_programs" $out "62. fixprog to put tokens in " + s_out $out "71. sub_rpg_program_fix_to_new_dates" $inp s_pick, "choose" d_pick = 0 $isd d_any, s_pick dift d_any = 1: $tod d_pick, s_pick dift d_pick = 11: sub_prog_teapro_indent dift d_pick = 12: sub_prog_c_indent dift d_pick = 21: sub_rpg_prog_types dift d_pick = 22: sub_rpg_prog_change_list dift d_pick = 23: sub_rpg_prog_validate_notes dift d_pick = 31: sub_make_progfile dift d_pick = 41: sub_rpg_obsolete_or_certain_syntax dift d_pick = 51: sub_wrpg_wstr_append_progs_or_streams dift d_pick = 61: sub_rpg_compare_2_programs dift d_pick = 62: sub_rpg_put_in_tokens dift d_pick = 71: sub_rpg_program_fix_to_new_dates sub_path_prog_memory ends sub_menu_prog subr sub_rpg_put_in_tokens 'updated 2008/08/03, 2007/01/14, 2005/10/12, 2005/10/11 'put tokens in RPG programs dg_list1/dg_list2 vari d_any, s_any, d_dot, s_dot, s_out vari d_record, s_record, d_byte, d_update, d_long vari d_loop, d_good, d_inarrays, d_action, d_count vari s_5byte, s_6byte, s_7byte, s_70byte d_inarrays = 2 d_record = dg_list1 d_loop = 1 dwhi d_loop = 1 'read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_action = 0 d_update = 2 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 'have we hit a new book to begin a new program $cut s_any, s_record, 1, 6 $ift s_any = "]BOOK:" dinc d_inarrays $cut s_any, s_record, 1, 70 $out d_record + " " + s_any endi 'have we hit an asterisk in 1 to begin arrays $cut s_any, s_record, 1, 1 $ift s_any = "*": d_inarrays = 1 dift d_inarrays = 1: dinc d_good endi dift d_good = 1 $cut s_5byte, s_record, 5, 1 $cut s_6byte, s_record, 6, 1 $cut s_7byte, s_record, 7, 1 $cut s_70byte, s_record, 70, 1 endi dift d_good = 1 'what kind of line do we have $ift s_6byte = "H": d_action = 1 $ift s_6byte = "F": d_action = 2 $ift s_6byte = "E": d_action = 3 $ift s_6byte = "I": d_action = 4 $ift s_6byte = "C" $ift s_7byte = " " 'C line d_action = 5 else 'CSR line d_action = 6 endi endi $ift s_6byte = "O": d_action = 7 'do we have a comment line $ift s_7byte = "*": d_action = 9 endi 'tens 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ' .FTERMIN ID F 80 $STDIN ' .FTERMOUT O F 80 $STDLST ' .E ZZ 1 80 1 2 ' .IFILEINP AA ' .I 10 20 VARIAB ' .CSR 01 02 03FACTOR1 COMMDFACTOR2 RESULT 92H919293 ' .OFILENAMEE 12 01 02 03OLINE ' .O E 01 02 03VARIABJB 132 "HEADING LINE " dift d_action = 1 'H line $ift s_5byte = " " $rep s_record, 5, "." d_update = 1 endi endi dift d_action = 2 'F line $ift s_5byte = " " $ift s_7byte <> " " $rep s_record, 5, "." d_update = 1 endi endi endi dift d_action = 3 'E line $ift s_5byte = " " $rep s_record, 5, "." d_update = 1 endi endi dift d_action = 4 'I line $ift s_5byte = " " $ift s_7byte <> " " $rep s_record, 5, "." d_update = 1 endi endi endi dift d_action = 5 'C line 'result indicators $cut s_any, s_record, 54, 6 $swp s_any, " ", sg_nothing $trb s_any, s_any $ist d_any, s_any, "9" dift d_any = 1 $rep s_record, 60, "." d_update = 1 endi 'TAG line $ift s_5byte = " " $cut s_any, s_record, 28, 5 $ift s_any = "TAG " $rep s_record, 5, "." d_update = 1 endi endi $cut s_any, s_record, 70, 1 $ift s_any = "." $rep s_record, 70, " " d_update = 1 endi endi dift d_action = 6 'CSR line 'result indicators $cut s_any, s_record, 54, 6 $swp s_any, " ", sg_nothing $trb s_any, s_any $ist d_any, s_any, "9" dift d_any = 1 $rep s_record, 60, "." d_update = 1 endi 'BEGSR line $ift s_5byte = " " $cut s_any, s_record, 28, 5 $ift s_any = "BEGSR" $rep s_record, 5, "." d_update = 1 endi endi $cut s_any, s_record, 70, 1 $ift s_any = "." $rep s_record, 70, " " d_update = 1 endi endi dift d_action = 7 'O line $ift s_5byte = " " $ift s_7byte <> " " $rep s_record, 5, "." d_update = 1 endi endi endi dift d_action = 9 'comment line $cut s_any, s_record, 5, 3 $ift s_any = ".I*" $rep s_record, 5, " " d_update = 1 endi endi dift d_update = 1 'update the record d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any <> 72 dinc dg_changes dinc d_count dg_pass1 = d_record sub_record_show endi dinc d_record dift d_record > dg_list2: dinc d_loop endw $inp s_any, "done count=" + d_count ends sub_rpg_put_in_tokens subr sub_rpg_compare_2_programs 'updated 2008/04/24, 2008/04/02, 2005/02/07 vari d_any, s_any, d_dot, s_dot, s_out vari d_record1, d_record2, s_record1, s_record2 vari d_loop, d_process, d_good vari d_begin1, d_begin2, s_dashes $ch$ s_dashes, "-", 70 d_process = 1 dift d_process = 1 $inp s_any, "first record of first RPG program" $ift s_any = "*": dinc d_process $isd d_any, s_any d_record1 = 0 dift d_any = 1: $tod d_record1, s_any endi dift d_process = 1 $inp s_any, "first record of second RPG program" $ift s_any = "*": dinc d_process $isd d_any, s_any d_record2 = 0 dift d_any = 1: $tod d_record2, s_any endi 'cannot begin a zero d_any = d_record1 * d_record2 dift d_any = 0: dinc d_process d_begin1 = d_record1 d_begin2 = d_record2 d_loop = d_process dwhi d_loop = 1 d_good = 1 dg_pass1 = d_record1 sub_next_undeleted_record d_record1 = dg_pass1 s_record1 = sg_pass1 dg_pass1 = d_record2 sub_next_undeleted_record d_record2 = dg_pass1 s_record2 = sg_pass1 $trb s_record1, s_record1 $trb s_record2, s_record2 $ift s_record1 = s_record2 $out d_record1 + " " + s_record1 else $out s_dashes $out d_record1 + " " + s_record1 $out s_dashes $out d_record2 + " " + s_record2 $out s_dashes s_any = "1=advance1, 2=advance2, return=both" $app s_any, ", beg1=" + d_begin1 + ", beg2=" + d_begin2 $inp s_any, s_any $ift s_any = "*": dinc d_loop $ift s_any = "1" ddec d_record2 endi $ift s_any = "2" ddec d_record1 endi endi dinc d_record1 dinc d_record2 endw ends sub_rpg_compare_2_programs subr sub_wrpg_wstr_append_progs_or_streams 'updated 2008/09/24, 2008/09/20, 2007/01/04, 2007/01/01 '2006/12/31, 2006/08/07, 2006/05/24, 2006/05/09, 2006/02/06 '2005/01/31, 2005/01/29, 2005/01/20, 2005/01/19, 2005/01/18 'append an RPG program file of variable length records vari d_any, s_any, d_dot, s_dot, s_out vari s_char10, d_time1, s_seconds, d_bookbreaks vari d_loop, d_good, d_process, d_fixranrecord, s_record vari s_rpgfilename, d_rpgrecord, d_rpgfilebyte vari s_progname, d_addbookrecord, s_prevrecord d_process = 1 dift d_process = 1 s_any = "enter the name of the file to append" s_rpgfilename = "WRPGZ.TXT" $app s_any, ", default=" + s_rpgfilename $inp s_any, s_any $ift s_any = "*": dinc d_process $len d_any, s_any dift d_any > 0: s_rpgfilename = s_any endi dift d_process = 1 'does the file exist flen d_any, s_rpgfilename dift d_any < 0 $out "The file does not exist=" + s_rpgfilename dinc d_process endi endi dift d_process = 1 d_bookbreaks = 2 $inp s_any, "1 = include bookbreaks" $ift s_any = "*": dinc d_process $ift s_any = "1": d_bookbreaks = 1 endi 'get next record number for the .RAN file = sg_fileran flen d_any, sg_fileran d_fixranrecord = d_any \ 72 + 1 dch$ s_char10, 10, 1 dsec d_time1 d_rpgrecord = 0 d_rpgfilebyte = 1 d_loop = d_process dwhi d_loop = 1 d_good = 1 'sip in a record fsip s_record, s_rpgfilename, d_rpgfilebyte dift d_rpgfilebyte = 0 dinc d_loop dinc d_good endi dift d_good = 1 dinc d_rpgrecord d_addbookrecord = 2 'do we have a needed H* sprogname $cut s_any, s_record, 6, 4 $ift s_any = "H* S" 'only if previous record not "rpgall" $cut s_any, s_prevrecord, 1, 6 $ift s_any <> "rpgall" $cut s_progname, s_record, 9, 99 $lok d_any, s_progname, 1, " " dift d_any > 0 $cut s_progname, s_progname, 1, d_any endi d_addbookrecord = 1 endi endi s_prevrecord = s_record 'do we have a "rpgall program=" record $trl s_dot, s_record $cut s_any, s_dot, 1, 15 $ift s_any = "rpgall program=" 'make up a ]BOOK record if needed 'get the program name $cut s_progname, s_dot, 16, 9999 $trb s_progname, s_progname $lok d_any, s_progname, 1, "." dift d_any > 0 ddec d_any $cut s_progname, s_progname, 1, d_any endi d_addbookrecord = 1 endi 'tens 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ' .I* INPUT ENDS DATE= TUE, AUG 19, 2008, 8:35 AM ' .I* INPUT ENDS TUE, AUG 19, 2008, 8:35 AM ' .I* INPUT ENDS DATE= 2008/08/19, 8:35 AM ']BOOK: SACTADDR DEC 11, 2007, 4:23 PM ']BOOK: SACTADDR 2007/12/11, 4:23 PM dift d_addbookrecord = 1 'get the date out of the "C* CALCS" d_dot = d_rpgfilebyte dwhi d_dot > 0 'sip the record into s_dot fsip s_dot, s_rpgfilename, d_dot $cut s_any, s_dot, 6, 1 $ift s_any = "O": d_dot = 0 dift d_dot > 0 $cut s_any, s_dot, 6, 8 $ift s_any = "C* CALCS" 'C* CALCS BEGIN $cut s_dot, s_dot, 20, 99 $trb s_dot, s_dot 'remove "DATE=" $cut s_any, s_dot, 1, 5 $ift s_any = "DATE=" $cut s_dot, s_dot, 6, 99 $trb s_dot, s_dot endi 'remove day of week if needed $cut s_any, s_dot, 1, 1 $ist d_any, s_any, "9" dift d_any <> 1 $cut s_dot, s_dot, 6, 99 endi $ch$ s_any, " ", 20 $app s_progname, s_any $cut s_progname, s_progname, 1, 10 $app s_progname, s_dot d_dot = 0 endi endi endw endi dift d_addbookrecord = 1 'make up a ]BOOK record if needed dift d_bookbreaks = 1 s_dot = "]BOOK: " + s_progname else s_dot = "] " + s_progname $lok d_any, s_record, 1, "program=" dift d_any > 0 $rep s_record, d_any, "stream =" endi endi $ch$ s_any, " ", 70 $app s_dot, s_any $cut s_dot, s_dot, 1, 70 $app s_dot, "W" + s_char10 'write the book record to the file d_any = d_fixranrecord - 1 * 72 + 1 fwri d_any, sg_fileran, d_any, s_dot dift d_any = 0 $out "cannot append" $out s_dot endi dg_pass1 = d_fixranrecord sub_record_show dinc d_fixranrecord endi 'make sure s_record is 70 long $ch$ s_any, " ", 70 $app s_record, s_any $cut s_record, s_record, 1, 70 'append W and char10 $app s_record, "W" + s_char10 'write the record to the file d_any = d_fixranrecord - 1 * 72 + 1 fwri d_any, sg_fileran, d_any, s_record dift d_any = 0 $out "cannot append" $out s_record endi dinc d_fixranrecord dinc dg_changes 'do we need a deleted record d_any = d_rpgrecord % 20 dift d_any = 0 'tell d_any = d_rpgrecord % 1000 dift d_any = 0 $sho "lines append=" + d_rpgrecord endi $ch$ s_record, "z", 71 $app s_record, s_char10 d_any = d_fixranrecord - 1 * 72 + 1 fwri d_any, sg_fileran, d_any, s_record dbad d_any = 0 dinc d_fixranrecord endi endi endw dift d_process = 1 dsec d_any d_time1 = d_any - d_time1 dto$ s_seconds, d_time1, 0, 3 s_out = "records appended=" + d_rpgrecord $app s_out, ", seconds=" + s_seconds $inp s_any, s_out endi ends sub_wrpg_wstr_append_progs_or_streams subr sub_rpg_obsolete_or_certain_syntax 'updated 2007/01/01, 2006/05/11, 2006/05/10, 2006/03/16, 2006/03/14 '2005/01/31, 2005/01/28, 2005/01/25, 2005/01/23, 2005/01/08 vari d_any, s_any, d_dot, s_dot, s_out, d_action vari s_line, d_good, d_loop, d_count, s_count, d_pick vari d_record, s_record, s_progline, s_prevprogline vari d_byte, s_byte, d_long, d_process vari s_progname, s_fileout, s_oldprog vari s_command, s_okcommands, s_field, d_error vari s_mathcommands $out "1=find programs with COR or CAN lines" $out "2=find programs with input primary" $out "3=find programs with tables" $out "4=find programs with obsolete variables" $out "5=find bad rpg commands in clines" $out "6=find clines,olines with leading zeros" $out "7=find MOVE,MOVEL with numeric literals" $out "8=find olines with obsolete editing" $out "9=find ilines,clines with obsolete indicators" $out "10=find elines with numeric arrays" $out "11=find packed ilines,elines,olines" $out "12=find ksam files without NOLOCK" $inp s_any, "pick a number" $isd d_any, s_any d_pick = 0 dift d_any = 1: $tod d_pick, s_any s_fileout = "rpg00" + d_pick + ".txt" fdel d_any, s_fileout $out "creating file=" + s_fileout 'tens 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ' .FTERMIN ID F 80 $STDIN ' .FTERMOUT O F 80 $STDLST ' .E ZZ 1 80 1P2 ' .IFILEINP AA ' .I P 10 20 VARIAB ' .CSR 01 02 03FACTOR1 COMMDFACTOR2 RESULT 92H919293 ' .OFILENAMEE 12 01 02 03OLINE ' .O E 01 02 03VARIABJB 132P"HEADING LINE " 'P=packed s_okcommands = "ADD ,BITOF,BITON,COMP ,DIV ,FNDJW," $app s_okcommands, "LOKUP,MOVE ,MOVEA,MOVEL,MULT ,MVR ," $app s_okcommands, "PUTJW,SETOF,SETON,SORTA,SQRT ,SUB ," $app s_okcommands, "TESTN,TIME ,TIME2,XFOOT,Z-ADD,Z-SUB," $app s_okcommands, "TAG ,GOTO ,EXSR ,BEGSR,ENDSR,READ ," $app s_okcommands, "READP,CHAIN,LOCK ,UNLCK,SETLL,EXCPT," s_mathcommands = "ADD ,SUB ,MULT ,DIV ,MVR ," d_count = 0 d_record = 1 d_loop = 1 dwhi d_loop = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_action = 0 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 1, 5 $ift s_any = "]STOP" dinc d_good dinc d_loop endi endi dift d_good = 1 'we have a program line d_action = d_pick 'get the line s_prevprogline = s_progline $cut s_progline, s_record, 1, 70 'do we have a program name s_progname $cut s_any, s_progline, 1, 6 $ift s_any = "]BOOK:" 'show the record $sho d_record + " " + s_progline $cut s_any, s_progline, 7, 99999 $trb s_progname, s_any $ch$ s_any, " ", 20 $app s_progname, s_any $cut s_progname, s_progname, 1, 12 endi endi dift d_action = 1 'do we have CAN or COR d_dot = 2 $cut s_dot, s_progline, 6, 3 $ift s_dot = "COR": d_dot = 1 $ift s_dot = "CAN": d_dot = 1 $ift s_progname = s_oldprog: dinc d_dot $cut s_any, s_progline, 10, 2 $ist d_any, s_any, "9" dift d_any <> 1: dinc d_dot dift d_dot = 1 dinc d_count dto$ s_count, d_count, 6, 0 $app s_count, ". " s_oldprog = s_progname s_out = s_count + s_progname + s_progline fapp d_any, s_fileout, s_out dbad d_any = 0 endi endi dift d_action = 2 'input primary d_dot = 0 $cut s_dot, s_progline, 6, 1 $ift s_dot = "F": dinc d_dot $cut s_dot, s_progline, 15, 2 $ift s_dot = "IP": dinc d_dot dift d_dot = 2 dinc d_count dto$ s_count, d_count, 6, 0 $app s_count, ". " s_out = s_count + s_progname + s_progline fapp d_any, s_fileout, s_out dbad d_any = 0 endi endi dift d_action = 3 'table in program d_dot = 0 $cut s_dot, s_progline, 6, 1 $ift s_dot = "E": dinc d_dot $cut s_dot, s_progline, 27, 3 $ift s_dot = "TAB": dinc d_dot $cut s_dot, s_progline, 46, 3 $ift s_dot = "TAB": dinc d_dot dift d_dot = 3 dinc d_count dto$ s_count, d_count, 6, 0 $app s_count, ". " s_out = s_count + s_progname + s_progline fapp d_any, s_fileout, s_out dbad d_any = 0 endi endi dift d_action = 4 'find lines with obsolete variable names d_dot = 2 $cut s_any, s_progline, 6, 2 $ift s_any = "C ": d_dot = 1 $ift s_any = "CS": d_dot = 1 dift d_dot = 1 s_dot = sg_nothing $cut s_any, s_progline, 18, 10 $cut s_byte, s_any, 1, 1 $ift s_byte <> #"#: $app s_dot, s_any $cut s_any, s_progline, 33, 10 $cut s_byte, s_any, 1, 1 $ift s_byte <> #"#: $app s_dot, s_any $cut s_any, s_progline, 43, 6 $cut s_byte, s_any, 1, 1 $ift s_byte <> #"#: $app s_dot, s_any $lok d_any, s_dot, 1, "@" dift d_any = 0: $lok d_any, s_dot, 1, "#" dift d_any = 0: $lok d_any, s_dot, 1, "$" d_dot = 2 dift d_any <> 0: d_dot = 1 dift d_dot = 1 dinc d_count dto$ s_count, d_count, 6, 0 $app s_count, ". " s_out = s_count + s_progname + s_progline fapp d_any, s_fileout, s_out dbad d_any = 0 endi endi endi dift d_action = 5 'bad rpg commands in clines d_dot = 2 $cut s_any, s_progline, 6, 3 $ift s_any = "C ": d_dot = 1 $ift s_any = "CSR": d_dot = 1 dift d_dot = 1 $cut s_command, s_progline, 28, 5 $lok d_any, s_okcommands, 1, s_command $isc d_dot, s_command, " " dift d_dot = 1: dinc d_any dift d_any = 0 dinc d_count dto$ s_count, d_count, 6, 0 $app s_count, ". " s_out = s_count + s_progname + s_progline fapp d_any, s_fileout, s_out dbad d_any = 0 endi endi endi dift d_pick = 6 'clines,olines with leading zeros on numbers d_error = 0 $cut s_dot, s_progline, 6, 3 d_dot = 2 $ift s_dot = "C ": d_dot = 1 $ift s_dot = "CSR": d_dot = 1 dift d_dot = 1 'cline $cut s_field, s_progline, 18, 10 sg_pass1 = s_field sub_rpg_validate_field dift dg_pass1 > 0: d_error = 1 $cut s_field, s_progline, 33, 10 sg_pass1 = s_field sub_rpg_validate_field dift dg_pass1 > 0: d_error = 1 $cut s_field, s_progline, 43, 6 sg_pass1 = s_field sub_rpg_validate_field dift dg_pass1 > 0: d_error = 1 endi $cut s_dot, s_progline, 6, 3 $ift s_dot = "O " 'oline $cut s_field, s_progline, 32, 6 sg_pass1 = s_field sub_rpg_validate_field dift dg_pass1 > 0: d_error = 1 endi dift d_error > 0 dinc d_count dto$ s_count, d_count, 6, 0 $app s_count, ". " s_out = s_count + s_progname + s_progline fapp d_any, s_fileout, s_out dbad d_any = 0 endi endi dift d_pick = 7 'MOVE,MOVEL with numeric d_error = 0 $cut s_dot, s_progline, 6, 3 d_dot = 2 $ift s_dot = "C ": d_dot = 1 $ift s_dot = "CSR": d_dot = 1 dift d_dot = 1 'cline 'cline with MOVE,MOVEL of literal number d_any = 2 $cut s_any, s_progline, 28, 5 $ift s_any = "MOVE ": d_any = 1 $ift s_any = "MOVEL": d_any = 1 dift d_any = 1 $cut s_any, s_progline, 33, 1 s_dot = "0123456789+-" $lok d_any, s_dot, 1, s_any dift d_any > 0: d_error = 1 endi endi dift d_error > 0 dinc d_count dto$ s_count, d_count, 6, 0 $app s_count, ". " s_out = s_count + s_progname + s_progline fapp d_any, s_fileout, s_out dbad d_any = 0 endi endi dift d_pick = 8 'obsolete editing in olines and PAGE d_error = 0 $cut s_dot, s_progline, 6, 3 $ift s_dot = "O " 'oline $cut s_any, s_progline, 15, 1 $ift s_any <> " ": dinc d_error $cut s_any, s_progline, 32, 1 $ift s_any <> " " 'we have a variable "$" editing is ok $cut s_any, s_progline, 45, 3 $ift s_any <> #"$"# $ift s_any <> " ": dinc d_error endi endi $cut s_any, s_progline, 32, 6 $ift s_any = "PAGE ": dinc d_error endi dift d_error > 0 dinc d_count dto$ s_count, d_count, 6, 0 $app s_count, ". " s_out = s_count + s_progname + s_progline fapp d_any, s_fileout, s_out dbad d_any = 0 endi endi dift d_pick = 9 'ilines,clines with obsolete indicators d_error = 0 $cut s_dot, s_progline, 6, 2 $ift s_dot = "I " $cut s_any, s_progline, 59, 12 $ch$ s_dot, " ", 12 $ift s_any <> s_dot: dinc d_error endi 'do we have a cline d_dot = 0 $cut s_dot, s_progline, 6, 3 $ift s_dot = "C ": d_dot = 1 $ift s_dot = "CSR": d_dot = 1 'do we have a math command $cut s_dot, s_progline, 28, 5 $lok d_any, s_mathcommands, 1, s_dot dift d_any > 0: dinc d_dot dift d_dot = 2 $cut s_any, s_progline, 54, 6 $ch$ s_dot, " ", 6 $ift s_any <> s_dot: dinc d_error endi dift d_error > 0 dinc d_count dto$ s_count, d_count, 6, 0 $app s_count, ". " s_out = s_count + s_progname + s_progline fapp d_any, s_fileout, s_out dbad d_any = 0 endi endi 'tens 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ' .E NZ 1 80 15 2 dift d_pick = 10 'find numeric arrays in elines d_error = 0 $cut s_dot, s_progline, 6, 2 $ift s_dot = "E " $cut s_any, s_progline, 44, 1 $isd d_any, s_any dift d_any = 1: dinc d_error endi dift d_error > 0 dinc d_count dto$ s_count, d_count, 6, 0 $app s_count, ". " s_out = s_count + s_progname + s_progline fapp d_any, s_fileout, s_out dbad d_any = 0 endi endi dift d_pick = 11 'find packed elines,ilines,olines d_error = 0 $cut s_dot, s_progline, 6, 2 $ift s_dot = "E " $cut s_any, s_progline, 43, 1 $ift s_any = "P": dinc d_error endi $ift s_dot = "I " $cut s_any, s_progline, 43, 1 $ift s_any = "P": dinc d_error endi $ift s_dot = "O " $cut s_any, s_progline, 44, 1 $ift s_any = "P": dinc d_error endi dift d_error > 0 dinc d_count dto$ s_count, d_count, 6, 0 $app s_count, ". " s_out = s_count + s_progname + s_progline fapp d_any, s_fileout, s_out dbad d_any = 0 endi endi dift d_action = 12 'do we have FK in 6/7 for ksam in previous $cut s_any, s_prevprogline, 6, 2 $ift s_any = "FK" $cut s_any, s_progline, 53, 7 $ift s_any <> "KNOLOCK" dinc d_count s_out = d_count + "." + d_record $app s_out, " " + s_progname $app s_out, s_prevprogline fapp d_any, s_fileout, s_out dbad d_any = 0 s_out = d_count + "." + d_record $app s_out, " " + s_progname $app s_out, s_progline fapp d_any, s_fileout, s_out dbad d_any = 0 endi endi endi dinc d_record endw 'tens 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ' .FTERMIN ID F 80 $STDIN ' .FTERMOUT O F 80 $STDLST ' .E ZZ 1 80 1P2 ' .IFILEINP AA ' .I P 10 20 VARIAB ' .CSR 01 02 03FACTOR1 COMMDFACTOR2 RESULT 92H919293 ' .OFILENAMEE 12 01 02 03OLINE ' .O E 01 02 03VARIABJB 132P"HEADING LINE " '123456789012345678901234567890123456789012345678901234567890 'P=packed $inp s_any, "done, count=" + d_count ends sub_rpg_obsolete_or_certain_syntax subr sub_rpg_validate_field 'updated 2004/12/31 vari d_any, s_any, d_dot, s_dot vari s_field, s_part1, s_part2, d_error s_field = sg_pass1 $trb s_field, s_field d_error = 0 'blank fields beginning with " $cut s_any, s_field, 1, 1 $ift s_any = #"#: s_field = sg_nothing 'do we have a comma $lok d_dot, s_field, 1, "," dift d_dot > 0 d_any = d_dot - 1 $cut s_part1, s_field, 1, d_any dinc d_dot $cut s_part2, s_field, d_dot, 99 else s_part1 = s_field s_part2 = sg_nothing endi 'on s_part1 is there + or - $cut s_any, s_part1, 1, 1 $ift s_any = "+": $cut s_part1, s_part1, 2, 99 $ift s_any = "-": $cut s_part1, s_part1, 2, 99 'do we have a leading zero on either $len d_any, s_part1 dift d_any > 1 $cut s_any, s_part1, 1, 1 $ift s_any = "0": d_error = 1 endi $len d_any, s_part2 dift d_any > 1 $cut s_any, s_part2, 1, 1 $ift s_any = "0": d_error = 1 endi dg_pass1 = d_error ends sub_rpg_validate_field subr sub_rpg_prog_validate_notes 'updated 2009/06/19, 2008/03/11 vari d_any, s_any, d_dot, s_dot, s_out vari s_line, d_good, d_loop, d_count, d_error vari d_record, s_record, d_byte, s_byte, d_long vari d_todo, d_done, d_num0, d_previsdash d_record = 1 d_loop = 1 dwhi d_loop = 1 d_any = d_record % 1000 dift d_any = 0: $sho d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_error = 2 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good $cut s_record, s_record, 1, 70 endi dift d_good = 1 '12345678901234567890123456789012345678901 '] ToDo: 0000/00/00, Done: 0000/00/00, #0 $lok d_todo, s_record, 1, "ToDo:" $lok d_done, s_record, 1, "Done:" $lok d_num0, s_record, 1, "#0" d_any = 2 dift d_todo > 0: d_any = 1 dift d_done > 0: d_any = 1 dift d_num0 > 0: d_any = 1 dift d_any = 1 dift d_todo <> 3: d_error = 1 dift d_done <> 21: d_error = 1 'we do not have to have #0 dift d_num0 = 0: d_num0 = 39 dift d_num0 <> 39: d_error = 1 dift d_previsdash <> 1: d_error = 1 endi d_previsdash = 2 $cut s_any, s_record, 1, 2 $ift s_any = "]-": d_previsdash = 1 endi dift d_error = 1: $out d_record + " " + s_record dinc d_record endw ends sub_rpg_prog_validate_notes subr sub_rpg_prog_change_list 'updated 2011/09/26, 2009/08/23 '2009/08/21, 2009/06/19, 2009/05/21, 2009/05/20, 2009/02/03 '2008/10/10, 2008/10/08, 2008/10/07, 2008/10/04, 2008/10/02 '2008/10/01, 2008/09/21, 2008/06/23, 2008/04/17, 2008/03/25 '2008/03/24, 2008/03/10, 2008/03/07, 2008/03/03, 2008/02/26 '2008/02/20, 2008/02/13, 2008/02/12, 2008/02/11, 2008/02/09 vari d_any, s_any, d_dot, s_dot, d_tap, s_tap, d_out, s_out vari s_line, d_good, d_loop, d_count, d_beg, d_end vari s_chprogram, s_chlf, d_time, s_dashes vari d_record, s_record, d_byte, s_byte, d_long, d_process vari s_nameline, s_olddate, s_csvline vari s_chprogfilename, s_chnotefilename, s_csvfilename vari d_month, d_year, d_chcnt, d_chprogshowall vari s_begyearmonth, s_endyearmonth d_process = 1 dift d_process = 1 s_out = "enter begin year and month wanted ie. 2008/09" $inp s_begyearmonth, s_out $ift s_begyearmonth = "*": dinc d_process endi dift d_process = 1 s_out = "enter end year and month wanted ie. 2008/09" $inp s_endyearmonth, s_out $ift s_endyearmonth = "*": dinc d_process endi dift d_process = 1 s_chnotefilename = "okladata.exp" $out "note file name=" + s_chnotefilename $inp s_any, "enter other note file name" $ift s_any = "*": dinc d_process $trb s_any, s_any $len d_any, s_any dift d_any > 0: s_chnotefilename = s_any endi dift d_process = 1 d_chprogshowall = 2 $inp s_any, "1=show all" $ift s_any = "*": dinc d_process $ift s_any = "1": d_chprogshowall = 1 endi dift d_process = 1 'use sg_pass5 below to hold data of s_chprogfilename 'use sg_pass6 below to hold data of s_chnotefilename 'prepare to get text from sg_fileran s_chprogfilename = sg_fileran finp sg_pass5, s_chprogfilename finp sg_pass6, s_chnotefilename 'clean up sg_pass5 = data of s_chprogfilename 'eliminate zzzz deletes dch$ s_chlf, 10, 1 $ch$ s_dot, "z", 71 $app s_dot, s_chlf $len d_long, sg_pass5 dsec d_time $swp sg_pass5, s_dot, sg_nothing dsec d_any endi dift d_process = 1 d_time = d_any - d_time $len d_dot, sg_pass5 $out "length1=" + d_long + " and " + d_dot + " sec=" + d_time 'eliminate deleted records $len d_long, sg_pass5 dsec d_time endi 'eliminate deleted records from sg_pass5 s_dot = "d" + s_chlf d_any = 0 d_out = 0 s_tap = " " d_loop = d_process dwhi d_loop = 1 dinc d_loop $lok d_dot, sg_pass5, 1, s_dot dift d_dot > 0 d_loop = 1 dinc d_out d_beg = d_dot - 70 'are the adjacent deleted records d_any = 1 dwhi d_any = 1 d_end = d_dot + 1 d_dot = d_dot + 72 $cut s_any, sg_pass5, d_dot, 2 $ift s_any <> s_dot: dinc d_any endw 'we have d_beg and d_end d_long = d_end - d_beg + 1 'd_out is count of beginning records 'd_dot is begin record 'd_tap is record count to delete 's_tap is the first 40 of the first record d_dot = d_beg \ 72 + 1 d_tap = d_long \ 72 $cut s_tap, sg_pass5, d_beg, 40 $out d_out + " " + d_dot + " " + d_tap + " " + s_tap $del sg_pass5, d_beg, d_long endi endw dift d_process = 1 dsec d_any d_time = d_any - d_time $len d_dot, sg_pass5 $out "length2=" + d_long + " and " + d_dot + " sec=" + d_time 'find the beginning of okladata.exp $lok d_dot, sg_pass6, 1, "]BULK: OKLADATA" d_any = 10 ^ 9 $cut sg_pass6, sg_pass6, d_dot, d_any $out sg_pass6 'we can now call sub_rpg_prog_change_note for a program 'to get the last note on it 'program change list file rpg0708c.csv, rpg0708.txt $cut s_any, sg_fileran, 1, 7 s_csvfilename = s_any + "c.csv" s_chprogfilename = s_any + "c.txt" fdel d_any, s_chprogfilename fdel d_any, s_csvfilename 'tens 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ' .I* INPUT ENDS DATE= TUE, AUG 19, 2008, 8:35 AM ' .I* INPUT ENDS TUE, AUG 19, 2008, 8:35 AM ' .I* INPUT ENDS DATE= 2008/08/19, 8:35 AM ']BOOK: SACTADDR DEC 11, 2007, 4:23 PM ']BOOK: SACTADDR 2007/12/11, 4:23 PM '] ToDo: 2008/09/25, Done: 2008/09/27, #0105 '123456789012345678901234567890123456789012345678901234567890 s_out = "beg yr/mo=" + s_begyearmonth $app s_out, " end yr/mo=" + s_endyearmonth $app s_out, " file=" + s_chprogfilename $out s_out $dat s_dot $cut s_dot, s_dot, 22, 8 s_out = "Programs Changed " + s_begyearmonth $app s_out, " thru " + s_endyearmonth $app s_out, " now=" + s_dot fapp d_any, s_chprogfilename, s_out dbad d_any = 0 endi d_record = 1 d_loop = d_process dwhi d_loop = 1 d_any = d_record % 1000 dift d_any = 0: $sho d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 'make file change list to s_chprogfilename $cut s_any, s_record, 1, 8 $ift s_any <> "]BOOK: S": dinc d_good endi '123456789012345678901234567890123456789012345678901234567890 ']BOOK: SACTADDR 2007/12/11, 4:23 PM dift d_good = 1 $sho s_record 'skip if the program ends with a single number $cut s_dot, s_record, 8, 9 $trb s_dot, s_dot $off s_any, s_dot, 1 $ist d_dot, s_any, "9" dift d_dot = 1 'if it ends with 2 or more numbers do not skip $off s_any, s_dot, 2 $ist d_any, s_any, "9" dift d_any = 1: dinc d_dot endi dift d_dot = 1 dinc d_good $cut s_dot, s_record, 8, 30 $out "version program=" + s_dot endi endi dift d_good = 1 'do we have the right year and month $cut s_any, s_record, 18, 7 $ift s_any < s_begyearmonth: dinc d_good $ift s_any > s_endyearmonth: dinc d_good endi dift d_good = 1 'we have right month and year $cut s_nameline, s_record, 8, 99 'put comma after prog name $lok d_any, s_nameline, 1, " " $ins s_nameline, d_any, "," 'prep for file s_csvfilename s_csvline = s_nameline 'prepare to call sub_rpg_prog_change_note 'put programname in sg_pass1 to get any note 'from okladata.exp in sg_pass6 $cut sg_pass1, s_record, 8, 10 'send name of output change listing sg_pass2 = s_chprogfilename 'send name of csv file and line sg_pass3 = s_csvfilename sg_pass4 = s_csvline 'd_chprogshowall = 1 to show all dg_pass1 = d_chprogshowall 'dg_pass2 = 2 means no output test only dg_pass2 = 2 sub_rpg_prog_change_note 'end of call to sub_rpg_prog_change_note dift dg_pass2 <> 1: dinc d_good endi dift d_good = 1 dinc d_chcnt $cut s_nameline, s_record, 8, 99 'put comma after prog name $lok d_any, s_nameline, 1, " " $ins s_nameline, d_any, "," 'prep for file s_csvfilename s_csvline = s_nameline fapp d_any, s_chprogfilename, s_dashes dbad d_any = 0 dto$ s_any, d_chcnt, 3, 0 s_dot = s_any + ". " + s_nameline fapp d_any, s_chprogfilename, s_dot dbad d_any = 0 fapp d_any, s_chprogfilename, " " dbad d_any = 0 'prepare to call sub_rpg_prog_change_note 'put programname in sg_pass1 to get any note 'from okladata.exp in sg_pass6 $cut sg_pass1, s_record, 8, 10 'send name of output change listing sg_pass2 = s_chprogfilename 'send name of csv file and line sg_pass3 = s_csvfilename sg_pass4 = s_csvline 'd_chprogshowall = 1 to show all dg_pass1 = d_chprogshowall 'dg_pass2 = 1 means do the output dg_pass2 = 1 sub_rpg_prog_change_note endi dinc d_record endw dift d_process = 1 'last line with program information $dat s_dot $cut s_dot, s_dot, 1, 20 s_dot = sg_build + " " + sg_loadprog + " " + s_dot fapp d_any, s_chprogfilename, s_dot dbad d_any = 0 endi ends sub_rpg_prog_change_list subr sub_rpg_prog_change_note 'updated 2009/08/24, 2009/08/23, 2009/08/21, 2009/06/19, 2009/05/21 '2009/02/03, 2008/10/02, 2008/10/01, 2008/04/18, 2008/04/17 '2008/03/26, 2008/03/25, 2008/03/10, 2008/03/07, 2008/02/26 '2008/02/20, 2008/02/14, 2008/02/13, 2008/02/12, 2008/02/11 vari d_any, s_any, d_dot, s_dot, s_out, s_dashes vari s_chprogram, s_note, d_beg, d_long, d_chprogshowall vari s_line, s_chnotedata, s_chlf, s_dateline vari d_byte, d_found, d_loop1, d_loop2, d_good, d_yesoutput vari s_csvline, s_csvfilename, s_chprogfilename 'd_chprogshowall = 1 to show all d_chprogshowall = dg_pass1 'd_yesoutput = 1 means do output d_yesoutput = dg_pass2 'trying to find program name in sg_pass1 $tup s_chprogram, sg_pass1 'change output file in sg_pass2 s_chprogfilename = sg_pass2 'get s_csvfilename and s_csvline s_csvfilename = sg_pass3 s_csvline = sg_pass4 $trb s_csvline, s_csvline $dot d_any, s_csvline, ",", 2 $rep s_csvline, d_any, " " $app s_csvline, "," 'all note data in sg_pass6 s_chnotedata = sg_pass6 dch$ s_chlf, 10, 1 $ch$ s_dashes, "-", 60 d_found = 2 d_byte = 0 d_loop1 = 1 dwhi d_loop1 = 1 'reject if no Done: date d_good = 1 dinc d_byte $lok d_byte, s_chnotedata, d_byte, s_chprogram dift d_byte = 0 dinc d_loop1 dinc d_good endi dift d_good = 1 '12345678901234567890123456789012345678901 'ToDo: 2008/03/11, Done: 2008/03/11, #0123 $bak d_beg, s_chnotedata, d_byte, "ToDo:" dift d_beg = 0: dinc d_good endi dift d_good = 1 $cut s_dateline, s_chnotedata, d_beg, 41 $cut s_any, s_dateline, 19, 5 $ift s_any <> "Done:": dinc d_good endi dift d_good = 1 $cut s_any, s_dateline, 25, 4 $ist d_good, s_any, "9" 'do not need a date after Done: d_good = 1 endi dift d_good = 1 dift d_chprogshowall <> 1 $cut s_any, s_dateline, 38, 4 $len d_any, s_any dift d_any <> 4: dinc d_good $ist d_any, s_any, "9" dift d_any <> 1: dinc d_good dift d_good <> 1 dift d_yesoutput = 1 $out s_chprogram + " " + s_dateline endi endi endi endi dift d_good = 1 d_found = 1 'find the end of the note $lok d_any, s_chnotedata, d_beg, "]-" 'max length d_long = d_any - d_beg dift d_long > 5000: d_long = 5000 $cut s_note, s_chnotedata, d_beg, d_long 'break the note into lines d_loop2 = 1 dwhi d_loop2 = 1 s_line = s_note $lok d_dot, s_note, 1, s_chlf dift d_dot > 0 d_any = d_dot - 1 $cut s_line, s_note, 1, d_any d_any = d_dot + 1 $cut s_note, s_note, d_any, 99999 else dinc d_loop2 endi 'replace "]-" line with dashes $cut s_any, s_line, 1, 2 $ift s_any = "]-" s_line = s_dashes else 'build up s_csvline $trb s_dot, s_line $cut s_any, s_dot, 1, 4 $ift s_any = "Per " 'we have a Per line $lok d_dot, s_dot, 1, "," dift d_dot = 0: $lok d_dot, s_dot, 6, " " $swp s_dot, ",", " " $rep s_dot, d_dot, "," else 'not a Per line $swp s_dot, ",", " " endi '12345678901234567890123456789012345678901 'ToDo: 2008/03/25, Done: 2008/03/25, #0037 $cut s_any, s_dot, 1, 5 $ift s_any = "ToDo:" $ch$ s_any, " ", 20 $app s_dot, s_any $cut s_dot, s_dot, 1, 50 'replace : with , $rep s_dot, 5, "," $rep s_dot, 17, "," $rep s_dot, 23, "," $rep s_dot, 35, "," $trr s_dot, s_dot $app s_dot, "," endi $app s_csvline, s_dot + " " endi dift d_yesoutput = 1 fapp d_any, s_chprogfilename, s_line dbad d_any = 0 endi endw endi dift d_found = 1: dinc d_loop1 endw dift d_found <> 1 dg_pass2 = 2 dift d_chprogshowall = 1 dift d_yesoutput = 1 s_line = "no find=" + s_chprogram $out s_line fapp d_any, s_chprogfilename, s_line dbad d_any = 0 fapp d_any, s_csvfilename, s_line dbad d_any = 0 endi endi else dg_pass2 = 1 'output s_csvline to file s_csvfilename dift d_yesoutput = 1 fapp d_any, s_csvfilename, s_csvline dbad d_any = 0 endi endi ends sub_rpg_prog_change_note subr sub_rpg_prog_types 'updated 2009/02/03, 2008/03/14, 2008/02/09, 2008/02/08, 2007/08/01 '2007/04/02, 2007/03/25, 2007/02/14, 2007/02/02, 2006/05/24 '2006/05/04, 2006/05/03, 2006/04/02, 2006/03/30, 2006/03/27 '2006/03/26, 2006/03/25, 2006/03/24, 2006/03/23, 2004/03/10 'looking for cycle,ksam,screen,simple,etc in RPG programs 'looking in H and F records vari d_any, s_any, d_dot, s_dot, s_out vari s_line, d_good, d_loop, d_count vari s_oldrecord, s_newrecord vari d_record, s_record, d_byte, s_byte, d_long, d_process vari s_olddate vari d_inudcs, s_udcs, d_isudc vari s_description, s_rpgcommands, s_intrinsic vari s_progname, d_cttotal, d_ctcalclines, s_tofile, d_action vari d_iscycle, d_isksam, d_isscreen, d_issimple, d_isupdate vari d_ischain, d_isintrinsic vari d_ctcycle, d_ctksam, d_ctscreen, d_ctsimple, d_ctupdate vari d_ctchain, d_ctudc, d_ctintrinsic, d_ctbegsr d_process = 1 'rpg0708.ran to rpg0708.csv $cut s_tofile, sg_fileran, 1, 7 $app s_tofile, ".csv" flen d_any, s_tofile dift d_any >= 0 $inp s_any, "1=purge file " + s_tofile $ift s_any = "*": dinc d_process $ift s_any = "1": fdel d_any, s_tofile endi dift d_process = 1 s_out = "program,cycle,update,chain,ksam,screen,simple," $app s_out, "udc,intrinsic,date,clines,description," $dat s_any $cut s_any, s_any, 1, 11 $app s_out, s_any + "," fapp d_any, s_tofile, s_out dbad d_any = 0 endi 'get udc/streams lines into s_udcs d_inudcs = 2 s_udcs = sg_nothing d_record = 1 d_loop = d_process dwhi d_loop = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_action = 0 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop d_action = 12 endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 $cut s_any, s_record, 1, 4 $ift s_any = "]BOO": $sho d_record + " " + s_record $ift s_any = "****": $sho d_record + " " + s_record $cut s_any, s_record, 1, 6 $ift s_any = "]BULK:" $cup s_dot, s_record $lok d_dot, s_dot, 1, "UDC" dift d_dot = 0: $lok d_dot, s_dot, 1, "STREAMS" dift d_dot > 0: d_inudcs = 1 $lok d_dot, s_dot, 1, "FORMATS" dift d_dot > 0: d_inudcs = 2 endi d_good = d_inudcs endi dift d_good = 1 'append to s_udcs $trb s_record, s_record $app s_udcs, s_record endi dinc d_record endw $len d_any, s_udcs dift d_any = 0 $inp s_any, "no ]BULK: with udcs and streams" $ift s_any = "*": dinc d_process endi s_rpgcommands = "ADD ,SUB ,MULT ,DIV ,MVR ,MOVE ," $app s_rpgcommands, "MOVEL,MOVEA,GOTO ,TAG ,BEGSR," $app s_rpgcommands, "ENDSR,EXCPT,COMP ,SETON,SETOF," $app s_rpgcommands, "EXSR ,Z-ADD,Z-SUB,TIME ,TIME2," $app s_rpgcommands, "LOKUP,READ ,CHAIN,LOCK ,UNLCK," $app s_rpgcommands, "FNDJW,PUTJW,BITON,BITOF,TESTN," $app s_rpgcommands, "XFOOT,SETLL,SORTA,READP," s_olddate = "19960101" s_progname = sg_nothing d_count = 0 d_record = 1 d_loop = d_process dwhi d_loop = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_action = 0 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop d_action = 12 endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_any, s_newrecord, 1, 5 $ift s_any = "]STOP" dinc d_good dinc d_loop d_action = 12 endi endi dift d_good = 1 'save to the old record s_oldrecord = s_newrecord 'get the line $cut s_newrecord, s_record, 1, 70 'get the latest date if DATE= 2008/12/03 in 28 $cut s_any, s_record, 28, 5 $ift s_any = "DATE=" $cut s_any, s_record, 34, 10 $ift s_any > s_olddate: s_olddate = s_any endi $cut s_any, s_newrecord, 1, 6 $ift s_any = "]BOOK:" 'skip if first letter in byte 8 or after not S '1234567890 ']BOOK: SX $cut s_any, s_newrecord, 8, 20 $tup s_any, s_any $cut s_any, s_any, 1, 1 'd_action=11 means ]BOOK record with file name in it $ift s_any = "S": d_action = 11 endi $cut s_any, s_newrecord, 6, 4 $ift s_any = "H* S" $cut s_description, s_newrecord, 9, 99 $tup s_description, s_description $swp s_description, ",", " " endi 'do we have an F-record $cut s_any, s_newrecord, 6, 1 $ift s_any = "F" $cut s_any, s_newrecord, 7, 1 'd_action=21 means F-record that is not a comment $ift s_any <> "*": d_action = 21 endi 'do we have a C-record $cut s_any, s_newrecord, 6, 1 $ift s_any = "C" d_dot = 2 $cut s_any, s_newrecord, 7, 1 $ift s_any = " ": d_dot = 1 $ift s_any = "S": d_dot = 1 $ift s_any = "L": d_dot = 1 dift d_dot = 1 'we have a C-record that is a calc dinc d_ctcalclines 'count the BEGSRs $cut s_any, s_newrecord, 28, 5 $ift s_dot = "BEGSR": dinc d_ctbegsr 'do we have a RPG command s_dot = s_any + "," $lok d_dot, s_rpgcommands, 1, s_dot $trb s_dot, s_any $len d_any, s_dot dift d_any = 0: dinc d_dot $ift s_any = "IPARM": dinc d_dot dift d_dot = 0 'we have an intrinsic s_intrinsic = s_any d_isintrinsic = 1 endi endi endi endi dift d_action = 11 'we have an ]BOOK: with an S in columns 7/24 's_progname has the previous program name in it 'do we have a previous program $len d_any, s_progname 'we have a previous program dift d_any > 0: d_action = 12 'we do not have a previous program dift d_any = 0: d_action = 15 endi dift d_action = 12 'output previous program info 'we are at begin new prog ie. ]BOOK: or at ]STOP 's_progname has the program name in it 'if s_olddate is all 9s make sg_nothing $isc d_any, s_olddate, "0" dift d_any = 1: s_olddate = "0" s_out = s_progname + "," dift d_iscycle = 1: $app s_out, "cycle" $app s_out, "," dift d_isupdate = 1: $app s_out, "update" $app s_out, "," dift d_ischain = 1: $app s_out, "chain" $app s_out, "," dift d_isksam = 1: $app s_out, "ksam" $app s_out, "," dift d_isscreen = 1: $app s_out, "screen" $app s_out, "," dift d_issimple = 1: $app s_out, "simple" $app s_out, "," dift d_isudc = 1: $app s_out, "udc" $app s_out, "," $app s_out, s_intrinsic $app s_out, "," $app s_out, s_olddate $app s_out, "," $app s_out, d_ctcalclines $app s_out, "," $app s_out, s_description $app s_out, "," fapp d_any, s_tofile, s_out dbad d_any = 0 d_ctcycle = d_ctcycle + d_iscycle d_ctupdate = d_ctupdate + d_isupdate d_ctchain = d_ctchain + d_ischain d_ctksam = d_ctksam + d_isksam d_ctscreen = d_ctscreen + d_isscreen d_ctsimple = d_ctsimple + d_issimple d_ctudc = d_ctudc + d_isudc d_ctintrinsic = d_ctintrinsic + d_isintrinsic dinc d_cttotal d_ctcalclines = 0 d_iscycle = 0 d_isksam = 0 d_isscreen = 0 d_issimple = 0 d_isupdate = 0 d_ischain = 0 d_isudc = 0 d_isintrinsic = 0 s_intrinsic = sg_nothing s_olddate = "1996/01/01" s_description = sg_nothing 'get the program name from the current ]BOOK: record d_action = 15 endi dift d_action = 15 'get the program name from the current ]BOOK: record $cut s_progname, s_newrecord, 8, 8 $tup s_progname, s_progname $sho d_record + " " + s_progname 'is this prog in s_udcs $cut s_any, s_progname, 2, 20 s_any = "O" + s_any $lok d_any, s_udcs, 1, s_any dift d_any > 0: d_isudc = 1 endi 'tens 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ' .FTERMIN ID F 80 $STDIN ' .FTERMOUT O F 80 $STDLST dift d_action = 21 'we have an F in column 6 with no * in 7 $cut s_any, s_newrecord, 15, 2 $ift s_any = "IP": d_iscycle = 1 $ift s_any = "UP" d_iscycle = 1 d_isupdate = 1 endi $ift s_any = "IC": d_ischain = 1 $ift s_any = "UD": d_isupdate = 1 $cut s_any, s_newrecord, 7, 1 $ift s_any = "K": d_isksam = 1 $cut s_any, s_newrecord, 40, 7 $ift s_any = "WORKSTN": d_isscreen = 1 d_any = d_iscycle + d_ischain + d_isscreen dift d_any = 0: d_issimple = 1 endi dinc d_record endw 'output of final totals s_out = "ctcycle=" + d_ctcycle fapp d_any, s_tofile, s_out s_out = "ctupdate=" + d_ctupdate fapp d_any, s_tofile, s_out s_out = "ctchain=" + d_ctchain fapp d_any, s_tofile, s_out s_out = "ctksam=" + d_ctksam fapp d_any, s_tofile, s_out s_out = "ctscreen=" + d_ctscreen fapp d_any, s_tofile, s_out s_out = "ctsimple=" + d_ctsimple fapp d_any, s_tofile, s_out s_out = "ctudc=" + d_ctudc fapp d_any, s_tofile, s_out s_out = "ctintrinsic=" + d_ctintrinsic fapp d_any, s_tofile, s_out s_out = "cttotal=" + d_cttotal fapp d_any, s_tofile, s_out s_out = "ctbegsr=" + d_ctbegsr fapp d_any, s_tofile, s_out $inp s_any, "done, see file=" + s_tofile ends sub_rpg_prog_types subr sub_rpg_program_fix_to_new_dates 'updated 2008/09/15, 2008/09/14 vari d_any, s_any, d_dot, s_dot vari d_process, d_update, d_true, s_date vari s_line, d_good, d_loop, d_count, d_linect vari d_record, s_record, d_byte, s_byte, d_long 'tens 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ' .I* INPUT ENDS DATE= TUE, AUG 19, 2008, 8:35 AM ' .I* INPUT ENDS TUE, AUG 19, 2008, 8:35 AM ' .I* INPUT ENDS DATE= 2008/08/19, 8:35 AM ']BOOK: SACTADDR DEC 11, 2007, 4:23 PM ']BOOK: SACTADDR 2007/12/11, 4:23 PM d_linect = 0 d_process = 1 d_count = 0 d_record = 1 d_loop = d_process dwhi d_loop = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_update = 2 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 d_any = d_record % 1000 dift d_any = 0: $sho "record=" + d_record $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 'tens 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ']BOOK: SACTADDR DEC 11, 2007, 4:23 PM $cut s_any, s_record, 1, 8 $ift s_any = "]BOOK: S" $cut s_date, s_record, 18, 22 sg_pass1 = s_date sub_rpg_old_date_to_new_date s_date = sg_pass1 d_true = dg_pass1 dift d_true = 1 $cut s_line, s_record, 1, 17 $app s_line, s_date d_update = 1 dinc d_good endi endi $cut s_any, s_record, 7, 1 $ift s_any <> "*": dinc d_good endi dift d_good = 1 'tens 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ' .I* INPUT ENDS DATE= TUE, AUG 19, 2008, 8:35 AM $cut s_any, s_record, 28, 5 $ift s_any = "DATE=" $cut s_date, s_record, 39, 22 sg_pass1 = s_date sub_rpg_old_date_to_new_date s_date = sg_pass1 d_true = dg_pass1 dift d_true = 1 $cut s_line, s_record, 1, 33 $app s_line, s_date d_update = 1 dinc d_good endi endi endi dift d_good = 1 'tens 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ' .I* INPUT ENDS TUE, AUG 19, 2008, 8:35 AM $cut s_date, s_record, 33, 22 sg_pass1 = s_date sub_rpg_old_date_to_new_date s_date = sg_pass1 d_true = dg_pass1 dift d_true = 1 $cut s_line, s_record, 1, 27 $app s_line, "DATE= " + s_date d_update = 1 dinc d_good endi endi 'tens 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ' .I* INPUT ENDS DATE= TUE, AUG 19, 2008, 8:35 AM ' .I* INPUT ENDS TUE, AUG 19, 2008, 8:35 AM ' .I* INPUT ENDS DATE= 2008/08/19, 8:35 AM ']BOOK: SACTADDR DEC 11, 2007, 4:23 PM ']BOOK: SACTADDR 2007/12/11, 4:23 PM dift d_update = 1 $out s_record $out s_line $ch$ s_any, " ", 80 $app s_line, s_any $cut s_line, s_line, 1, 70 $app s_line, "W" dch$ s_any, 10, 1 $app s_line, s_any d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_line dbad d_any = 0 dinc d_count dinc dg_changes dinc d_linect dift d_linect > 50 d_linect = 0 $inp s_any, "more, all=all" $tup s_any, s_any $ift s_any = "*": dinc d_loop $ift s_any = "ALL": d_linect = 10 ^ 10 * -1 endi endi dinc d_record endw $inp s_any, "done, count=" + d_count ends sub_rpg_program_fix_to_new_dates subr sub_rpg_old_date_to_new_date 'update 2008/09/15, 2008/09/14 vari d_any, s_any, d_dot, s_dot vari s_date, d_true, s_12mo vari s_month, s_day, s_year, s_time '1234567890123456789012 'AUG 19, 2008, 8:35 AM '2008/08/19, 8:35 AM s_date = sg_pass1 d_true = 2 s_12mo = "JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC," $tup s_date, s_date $ch$ s_any, " ", 30 $app s_date, s_any $cut s_month, s_date, 1, 3 $cut s_day, s_date, 5, 2 $cut s_year, s_date, 9, 4 $cut s_time, s_date, 13, 10 $lok d_dot, s_12mo, 1, s_month dift d_dot > 0 'get month number into s_month d_any = d_dot - 1 \ 4 + 1 s_month = "0" + d_any $off s_month, s_month, 2 $trb s_day, s_day s_day = "0" + s_day $off s_day, s_day, 2 s_any = s_day + s_year $ist d_any, s_any, "9" dift d_any = 1 d_true = 1 s_date = s_year + "/" + s_month + "/" $app s_date, s_day + s_time endi endi sg_pass1 = s_date dg_pass1 = d_true ends sub_rpg_old_date_to_new_date subr sub_prog_teapro_indent 'updated 2012/01/02 '2007/03/26, 2007/03/25, 2006/07/13, 2005/01/16, 2004/10/21 'indent a Teapro program with spaces not tabs vari d_any, s_any, d_dot, s_dot vari d_beg, d_end, s_command vari d_process, d_shift, d_update, d_show, d_yesindent vari d_delta, d_spaces, s_spaces, d_inquote, s_quote vari s_line, d_good, d_loop, s_oldrecord, d_count vari d_record, s_record, d_byte, s_byte, d_long d_beg = dg_list1 d_end = dg_list2 d_process = 1 dift d_beg > d_end: dinc d_process dift d_process = 1 d_shift = 4 $inp s_any, "enter shift amount, default=4" $ift s_any = "*": dinc d_process $isd d_any, s_any dift d_any = 1: $tod d_shift, s_any endi d_count = 0 d_spaces = 0 d_record = d_beg d_loop = d_process dwhi d_loop = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_yesindent = 2 d_show = 2 d_update = 2 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 d_any = d_record % 1000 dift d_any = 0: $sho "record=" + d_record $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 'get the line $cut s_record, s_record, 1, 70 $bes s_record, s_record s_oldrecord = s_record 'do nothing to comment lines beginning in 1 $cut s_byte, s_record, 1, 1 $ift s_byte = "'": dinc d_good endi dift d_good = 1 $trb s_line, s_record 'replace empty line beginning with ] $cut s_byte, s_line, 1, 1 $ift s_byte = "]" $len d_long, s_line dift d_long = 1 s_line = " " d_update = 1 dinc d_good endi endi endi dift d_good = 1 'count number of lines to shift dinc d_count $cut s_command, s_line, 1, 4 $cup s_command, s_command d_delta = 0 d_yesindent = 1 $ift s_command = "SUBR" d_spaces = 0 d_delta = d_shift dinc d_yesindent d_show = 1 endi s_dot = "DIFT.$IFT" $lok d_dot, s_dot, 1, s_command dift d_dot > 0 $lok d_dot, s_line, 1, ":" dift d_dot = 0 d_update = 1 d_delta = d_shift d_show = 1 else 'is the colon in quotes or not d_inquote = 2 s_quote = "#" d_delta = d_shift d_show = 1 $len d_long, s_line d_byte = 1 dwhi d_byte <= d_long 'do we have a quote $cut s_byte, s_line, d_byte, 1 d_dot = 2 $ift s_byte = #"#: d_dot = 1 $ift s_byte = "#": d_dot = 1 dift d_dot = 1 dift d_inquote = 1 $ift s_byte = s_quote dinc d_inquote endi else d_inquote = 1 s_quote = s_byte endi endi $ift s_byte = ":" dift d_inquote <> 1 d_delta = 0 dinc d_show endi endi dinc d_byte endw endi endi $ift s_command = "ELSE" d_spaces = d_spaces - d_shift d_delta = d_shift d_show = 1 endi $ift s_command = "DWHI" d_delta = d_shift d_show = 1 endi $ift s_command = "$WHI" d_delta = d_shift d_show = 1 endi s_dot = "ENDI.ENDW" $lok d_dot, s_dot, 1, s_command dift d_dot > 0 d_spaces = d_spaces - d_shift d_show = 1 endi $ift s_command = "VARI" d_update = 1 dinc d_yesindent d_show = 1 endi $ift s_command = "GTAG" d_update = 1 dinc d_yesindent d_show = 1 endi $ift s_command = "ENDS" d_update = 1 d_spaces = 0 dinc d_yesindent d_show = 1 endi endi dift d_yesindent = 1 'do the indentation spaces $ch$ s_spaces, " ", d_spaces s_line = s_spaces + s_line d_spaces = d_spaces + d_delta d_update = 1 endi dift d_update = 1 'if too long do not indent at all $len d_long, s_line dift d_long > 70 $trl s_line, s_line $len d_long, s_line dift d_long > 70: dinc d_update endi endi dift d_update = 1 'make update record 70 long $ch$ s_any, " ", 99 $app s_line, s_any $cut s_line, s_line, 1, 70 $ift s_line = s_oldrecord: dinc d_update endi dift d_update = 1 'update the record 'put on a "W" and a LF dch$ s_any, 10, 1 $app s_line, "W" + s_any d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_line dbad d_any = 0 dinc dg_changes endi dift d_show = 1 dg_pass1 = d_record sub_record_show endi dinc d_record dift d_record > d_end: dinc d_loop endw $out "done, count=" + d_count ends sub_prog_teapro_indent subr sub_prog_c_indent 'updated 2005/02/08, 2005/01/30, 2004/10/21 'indent lines of C program beginning with ] vari d_any, s_any, d_dot, s_dot vari d_update, d_good, d_loop, s_line vari s_record, d_record, d_byte, d_long, s_oldrecord vari d_beg, d_end, d_spaces, d_delta, s_beg d_beg = dg_list1 d_end = dg_list2 dift d_end = 0: d_end = d_beg d_good = 1 dift d_beg > d_end: dinc d_good d_spaces = 0 d_record = d_beg d_loop = d_good dwhi d_loop = 1 'read the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 s_oldrecord = s_record $cut s_beg, s_record, 1, 2 $ift s_beg <> "] ": dinc d_good endi dift d_good = 1 'eliminate beginning ] $cut s_line, s_record, 3, 68 $trb s_line, s_line 'skip if blank line $len d_long, s_line dift d_long = 0: dinc d_good endi dift d_good = 1 'do we have a beginning } $cut s_any, s_line, 1, 1 $ift s_any = "}" d_spaces = d_spaces - 4 dift d_spaces < 0: d_spaces = 0 endi 'do we have an ending { d_delta = 0 $off s_any, s_line, 1 $ift s_any = "{" d_delta = 4 endi 'put on indenting spaces $ch$ s_any, " ", d_spaces s_line = s_any + s_line 'add delta d_spaces = d_spaces + d_delta 'put on trailing spaces $ch$ s_any, " ", 80 $app s_line, s_any 'skip if not blank past 68 $cut s_any, s_line, 69, 99999 $isc d_any, s_any, " " dift d_any <> 1: dinc d_good endi dift d_good = 1 $cut s_line, s_line, 1, 68 s_line = "]" + " " + s_line 'is there a change $ift s_line = s_oldrecord: dinc d_good endi dift d_good = 1 'put a line feed char in s_any dch$ s_any, 10, 1 s_record = s_line + "W" + s_any d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 dinc dg_changes dift dg_quiet <> 1 dg_pass1 = d_record sub_record_show endi endi dinc d_record dift d_record > d_end: dinc d_loop endw ends sub_prog_c_indent subr sub_make_progfile 'updated 2006/05/24, 2006/01/30, 2004/11/02 'output program containing line to a file vari d_any, s_any, d_dot, s_dot, s_out vari d_good, d_process, d_line, d_count vari d_record, s_record, d_byte, s_byte, d_long vari s_fileout, d_loop, d_beg, d_end d_line = 0 $inp s_any, "enter any line number in the RPG program" $isd d_any, s_any dift d_any = 1: $tod d_line, s_any d_process = 1 dift d_line = 0: dinc d_process d_count = 0 dift d_process = 1 $inp s_fileout, "enter file name to output to" $ift s_fileout = "*": dinc d_process endi dift d_process = 1 flen d_any, s_fileout dift d_any >= 0 $inp s_any, "1 = purge existing file" $ift s_any = "1" fdel d_any, s_fileout else dinc d_process endi endi endi dift d_process = 1 'get beginning line d_beg = d_line d_loop = 1 d_record = d_line dwhi d_loop = 1 'read a record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 1, 2 $ift s_any = "]U": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 1, 1 $ift s_any = "]" dg_pass1 = d_record sub_record_show dinc d_good dinc d_loop else d_beg = d_record endi endi ddec d_record endw endi dift d_process = 1 'output down to a ] d_end = d_beg d_loop = 1 d_record = d_beg dwhi d_loop = 1 'tell d_any = d_record % 100 dift d_any = 0: $sho "to file=" + d_record 'read a record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 1, 1 $ift s_any = "]" dinc d_good dinc d_loop endi endi dift d_good = 1 $cut s_record, s_record, 1, 70 'make 80 long $ch$ s_any, " ", 10 $app s_record, s_any fapp d_any, s_fileout, s_record dbad d_any = 0 d_end = d_record dinc d_count endi dinc d_record endw s_out = "file made, records=" + d_count $app s_out, ", range=" + d_beg + "/" + d_end $out s_out endi dift d_process <> 1: $out "file not made" ends sub_make_progfile subr sub_lines_to_file 'updated 2012/01/06, 2006/10/06, 2006/05/24 '2005/10/02, 2005/09/05, 2005/06/09, 2005/05/26, 2004/07/13 'output to a file a range of records vari d_any, s_any, d_dot, s_dot, s_out vari d_good, d_process, d_beg, d_end vari s_char10, s_char13 vari d_filebyte, d_usefwri, d_dodatestring vari d_nobegbracket, d_nounderlinetags, d_count vari d_record, s_record, d_byte, s_byte, d_long vari s_fileout, s_recout, d_loop, d_setrecordlength d_beg = dg_pass1 d_end = dg_pass2 dift d_end = 0: d_end = d_beg dch$ s_char13, 13, 1 dch$ s_char10, 10, 1 d_count = 0 d_process = 1 d_filebyte = 1 d_usefwri = 2 dift d_process = 1 $inp s_fileout, "enter file name to output to" $ift s_fileout = "*": dinc d_process endi dift d_process = 1 flen d_any, s_fileout dift d_any >= 0 $inp s_any, "1=purge existing file" $ift s_any = "1" fdel d_any, s_fileout else dinc d_process endi endi endi dift d_process = 1 'prepare to output to a text file d_nobegbracket = 2 $inp s_any, "1=no beginning ]" $ift s_any = "1": d_nobegbracket = 1 $ift s_any = "*": dinc d_process endi dift d_process = 1 'prepare to output to a text file d_dodatestring = 2 $inp s_any, "1=do DATESTRING$" $ift s_any = "1": d_dodatestring = 1 $ift s_any = "*": dinc d_process endi dift d_process = 1 d_nounderlinetags = 2 $inp s_any, "1=no underline tags" $ift s_any = "1": d_nounderlinetags = 1 $ift s_any = "*": dinc d_process endi dift d_process = 1 d_setrecordlength = 0 $inp s_any, "enter set record length > 70 if wanted" $isd d_any, s_any dift d_any = 1: $tod d_setrecordlength, s_any dift d_setrecordlength <= 70: d_setrecordlength = 0 $ift s_any = "*": dinc d_process endi dift d_process = 1 dift d_setrecordlength > 0: d_usefwri = 1 d_loop = 1 d_record = d_beg dwhi d_loop = 1 'tell d_any = d_record % 100 dift d_any = 0: $sho "to file=" + d_record 'read a record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_recout, s_record, 1, 70 dift d_nobegbracket = 1 'replace beginning ] or ) $cut s_any, s_recout, 1, 2 $cut s_any, s_recout, 1, 1 $ift s_any = ")": s_any = "]" $ift s_any = "]" $cut s_any, s_recout, 2, 1 $ift s_any = " " $cut s_recout, s_recout, 3, 100 else 'byte 2 is not blank $cut s_any, s_recout, 3, 1 $ift s_any = " " '2 not blank 3 is blank $cut s_recout, s_recout, 4, 100 else '2 and 3 not blank $cut s_recout, s_recout, 2, 100 endi endi endi endi dift d_dodatestring = 1 'replace DATESTRING$ $lok d_dot, s_recout, 1, "DATESTRING$" dift d_dot > 0 '12345678901234567890123456789012345 '27-MAY-2002 10:55:01 20020527105501 $dat s_any $cut s_dot, s_any, 1, 11 $rep s_recout, d_dot, s_dot endi endi dift d_nounderlinetags = 1 'take out underlinetags 4 long d_dot = 5 dwhi d_dot > 1 $lok d_dot, s_recout, 1, "_" dift d_dot > 0 'underline tags are 4 long $del s_recout, d_dot, 4 endi endw endi $trr s_recout, s_recout dift d_setrecordlength > 70 'make all records same = d_setrecordlength $ch$ s_any, " ", d_setrecordlength $app s_recout, s_any $cut s_recout, s_recout, 1, d_setrecordlength endi dift d_usefwri = 1 $app s_recout, s_char13 $app s_recout, s_char10 fwri d_any, s_fileout, d_filebyte, s_recout dift d_any = 0 $out s_recout s_out = "above record not added to file=" $app s_out, s_fileout $app s_out, ", * to end" $inp s_any, s_out $ift s_any = "*": dinc d_loop endi $len d_any, s_recout d_filebyte = d_filebyte + d_any else fapp d_any, s_fileout, s_recout dift d_any = 0 $out s_recout s_out = "above record not added to file=" $app s_out, s_fileout $app s_out, ", * to end" $inp s_any, s_out $ift s_any = "*": dinc d_loop endi endi dinc d_count endi dinc d_record dift d_record > d_end: dinc d_loop endw $out "done " + d_beg + "/" + d_end endi dift d_process = 1: $out "file made, records=" + d_count dift d_process <> 1: $out "file not made" ends sub_lines_to_file subr sub_menu 'updated 2007/06/27, 2005/10/08, 2003/09/01 'menu commands vari d_any, s_any, d_pick, s_out dg_linescount = 0 s_out = dg_list1 + "/" + dg_list2 $out "1. sub_file_just_look" $out "2. get counts for records " + s_out $out "3. append a file" $out "5. book to file of records " + s_out $out "6. wrap paragraphs of records " + s_out $out "7. delete extra ] lines " + s_out $out "8. insert ] lines after sentences " + s_out $out "9. insert ] line before string " + s_out $out "10. Show possible paragraph beginnings " + s_out $out "20. list lines longer than 64 bytes " + s_out $out "21. find 'a1' letters and numbers " + s_out $out "31. find Teapro lines over 70 long" $out "99. menu1" sub_path_prog_memory $inp s_any, "pick a number" $isd d_any, s_any dift d_any = 1: $tod d_pick, s_any dift d_pick = 1: sub_file_just_look dift d_pick = 2: sub_counts dift d_pick = 3: sub_file_append dift d_pick = 5: sub_book_write dift d_pick = 6: sub_range_wrap dift d_pick = 7: sub_no_extra_bracket_lines dift d_pick = 8: sub_bracket_after_sentence dift d_pick = 9: sub_brackets_before_string dift d_pick = 10: sub_possible_paragraph dift d_pick = 20: sub_longer_than_64 dift d_pick = 21: sub_letters_and_numbers dift d_pick = 31: sub_teapro_long dift d_pick = 99: sub_menu1 ends sub_menu subr sub_menu1 'updated 2008/03/05, 2005/09/13, 2002/10/06 'menu commands vari s_any, d_any, d_pick, s_out dg_linescount = 0 s_out = dg_list1 + "/" + dg_list2 $out "11. find ]updated dates info" $out "21. make list from book of surnames and show" $out "22. 8 letter words" $out "31. validate names, descent tags, sex and dates in book" $out "32. validate charts in book" $out "41. validate individual records in file" $out "42. fix formatted records in file" $out "61. find characters not 32/126 in " + s_out $out "62. show character set" $out "71. sub_fixran_old_dates_to_new_dates" $out "81. replace string in file" $inp s_any, "pick a number" $isd d_any, s_any dift d_any = 1: $tod d_pick, s_any dift d_pick = 11: sub_updated_dates_info dift d_pick = 21: sub_surnames0 dift d_pick = 22: sub_8letter_words dift d_pick = 31: sub_validate_names dift d_pick = 32: sub_validate_charts dift d_pick = 41: sub_validate_records dift d_pick = 42: sub_fix_formatted_records dift d_pick = 61: sub_find_escapes dift d_pick = 62: sub_char_set dift d_pick = 71: sub_fixran_old_dates_to_new_dates dift d_pick = 81: sub_replace_strings_in_file ends sub_menu1 subr sub_fixran_old_dates_to_new_dates 'updated 2008/03/05 'change old dates to new in line range vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_filebyte, s_line, d_end vari d_byte, s_byte, d_long, d_update, s_months, d_justlook vari d_loop, d_good, d_process, d_count, s_date1, s_date2 d_record = dg_list1 d_end = dg_list2 s_months = "JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC" d_process = 1 d_justlook = 2 $inp s_any, "1=just look" $ift s_any = "*": dinc d_process $ift s_any = "1": d_justlook = 1 d_count = 0 d_loop = d_process dwhi d_loop = 1 d_filebyte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_filebyte, 72 $len d_long, s_record d_update = 2 d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good $cut s_record, s_record, 1, 70 $cut s_any, s_record, 1, 2 $ift s_any = "]-": dinc d_good d_byte = 1 endi dwhi d_good = 1 $lok d_byte, s_record, d_byte, "-" dift d_byte = 0 dinc d_good else dinc d_byte $cut s_any, s_record, d_byte, 3 $lok d_any, s_months, 1, s_any dift d_any > 0 '12345678901 '05-MAR-2008 d_dot = d_byte - 3 $cut s_date1, s_record, d_dot, 11 sg_pass1 = s_date1 sub_dmy11_date_to_new_date s_date2 = sg_pass1 $len d_any, s_date2 dift d_any = 10 'we have a replacement date $del s_record, d_dot, 11 $ins s_record, d_dot, s_date2 d_update = 1 dinc d_count s_any = d_record + " old=" + s_date1 $app s_any, " new=" + s_date2 dift d_justlook = 1 dinc d_update $app s_any, " justlooking" endi $out s_any endi endi endi endw dift d_update = 1 $ch$ s_any, " ", 70 $app s_record, s_any $cut s_record, s_record, 1, 70 d_filebyte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_filebyte, s_record dbad d_any = 0 dinc dg_changes endi dinc d_record dift d_record > d_end: dinc d_loop endw $inp s_any, "count=" + d_count ends sub_fixran_old_dates_to_new_dates subr sub_updated_dates_info 'updated 2005/09/17, 2005/09/13 vari d_any, s_any, d_dot, s_dot vari s_filename, s_filedata, d_byte, d_line vari d_loop, d_good, d_count, s_dates d_count = 0 s_dates = sg_nothing $inp s_filename, "enter filename" finp s_filedata, s_filename $len d_any, s_filedata $out "file length=" + d_any d_byte = 1 d_loop = 1 dwhi d_loop = 1 d_good = 1 $lok d_byte, s_filedata, d_byte, "]Updated " dift d_byte = 0 dinc d_good dinc d_loop endi dift d_good = 1 dinc d_count '0123456789012345678 ']Updated 2005/09/13 d_byte = d_byte + 9 $cut s_any, s_filedata, d_byte, 10 $app s_dates, s_any + "," endi endw 'sort the string by 11 long $sor s_dates, s_dates, 11 $out "count=" + d_count 'show the sorted dates d_line = 1 d_byte = 1 d_dot = 1 d_loop = 1 dwhi d_loop = 1 $cut s_any, s_dates, d_byte, 10 $out d_dot + ". " + s_any dinc d_line dift d_line >= dg_maxlines d_line = 0 $inp s_any, "more, * to end" $ift s_any = "*": dinc d_loop endi d_byte = d_byte + 11 dinc d_dot dift d_dot > d_count: dinc d_loop endw $inp s_any, "done" ends sub_updated_dates_info subr sub_teapro_long 'updated 2003/09/01 vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_filebyte vari s_beg, s_byte, d_long vari d_loop, d_good, d_process, d_count d_count = 0 d_record = 1 d_loop = 1 dwhi d_loop = 1 d_filebyte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_filebyte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 $cut s_beg, s_record, 1, 4 $isc d_any, s_beg, " " dift d_any = 1: dinc d_good $ift s_beg = "subr": dinc d_good $ift s_beg = "ends": dinc d_good $cut s_beg, s_record, 1, 1 $ift s_beg = "]": dinc d_good $ift s_beg = "'": dinc d_good endi dift d_good = 1 'show the record dg_pass1 = d_record sub_record_show endi dinc d_record endw ends sub_teapro_long subr sub_replace_strings_in_file 'updated 2004/10/21 vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_filebyte, d_byte, s_byte, d_long vari d_loop, d_good, d_process, d_count vari s_string1, s_string2, d_length1, d_length2 'find string s_string1 = "Teapro programming language" $len d_length1, s_string1 'replace the find string with this string s_string2 = "Teapro programming language" $len d_length2, s_string2 d_count = 0 d_record = 1 d_loop = 1 dwhi d_loop = 1 d_filebyte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_filebyte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 $lok d_dot, s_record, 1, s_string1 dift d_dot = 0: dinc d_good endi dift d_good = 1 'show the record dg_pass1 = d_record sub_record_show $del s_record, d_dot, d_length1 $ins s_record, d_dot, s_string2 $trr s_record, s_record $len d_long, s_record dift d_long > 70 $out "record above too long" dinc d_good endi endi dift d_good = 1 dch$ s_any, 32, 70 $app s_record, s_any $cut s_record, s_record, 1, 70 dch$ s_any, 10, 1 $app s_record, "W" + s_any fwri d_any, sg_fileran, d_filebyte, s_record dbad d_any = 0 dinc d_count dinc dg_changes endi endw $inp s_any, "records changed=" + d_count ends sub_replace_strings_in_file subr sub_char_set 'updated 2002/09/17 'show char set vari d_any, s_any, d_dot, s_dot, s_out vari d_char, s_char s_out = sg_nothing d_char = 32 dwhi d_char <= 255 dch$ s_char, d_char, 1 $app s_out, d_char + "=" + s_char + " " $len d_any, s_out dift d_any > 70 $out s_out s_out = sg_nothing endi dinc d_char endw $out s_out ends sub_char_set subr sub_find_escapes 'updated 2002/09/22 vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_filebyte, d_byte, s_byte, d_long vari d_loop, d_good, d_char d_record = dg_list1 d_loop = 1 dwhi d_loop = 1 d_filebyte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_filebyte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 d_byte = 1 dwhi d_byte <= 70 $cut s_byte, s_record, d_byte, 1 $chd d_char, s_byte d_dot = 2 dift d_char > 126: d_dot = 1 dift d_char < 32: d_dot = 1 dift d_dot = 1 s_any = "1234567890" s_dot = s_any + s_any + s_any $app s_dot, s_dot + s_any $out s_dot $out s_record s_dot = "record=" + d_record + ", byte=" + d_byte $app s_dot, ", char=" + d_char $app s_dot, ", * to end" $inp s_any, s_dot $ift s_any = "*": dinc d_loop endi dinc d_byte endw endi dinc d_record dift d_record > dg_list2: dinc d_loop endw ends sub_find_escapes subr sub_letters_and_numbers 'updated 2002/02/24 vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_filebyte, s_byte, d_long vari d_loop, d_good, s_line, d_count, d_youbet vari d_prev, d_now, s_findnum, d_product vari s_letters, s_numerals s_any = "abcdefghijklmnopqrstuvwxyz" $cup s_letters, s_any $app s_letters, s_any s_numerals = "0123456789" s_findnum = sg_nothing d_count = 0 d_record = dg_list1 d_loop = 1 dwhi d_loop = 1 d_any = d_record % 100 dift d_any = 0: $sho "letter number=" + d_record d_good = 1 d_filebyte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_filebyte, 72 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 d_youbet = 2 d_now = 5 d_dot = 1 dwhi d_dot <= 70 d_prev = d_now d_now = 5 'what is the now byte $cut s_dot, s_record, d_dot, 1 $lok d_any, s_letters, 1, s_dot dift d_any > 0 '1 means letter and 2 means numeral d_now = 1 else $lok d_any, s_numerals, 1, s_dot dift d_any > 0: d_now = 2 endi 'do we have a combination d_product = d_prev + d_now dift d_product = 3 d_any = d_dot - 1 $cut s_any, s_record, d_any, 3 $ift s_any = "1st": dinc d_product $ift s_any = "2nd": dinc d_product $ift s_any = "3rd": dinc d_product endi dift d_product = 3 $cut s_any, s_record, d_dot, 2 $ift s_any = "th": dinc d_product endi dift d_product = 3 d_youbet = 1 d_dot = 100 endi dinc d_dot endw dift d_youbet = 1 'this record has one dinc d_count dto$ s_any, d_record, 6, 0 $app s_findnum, s_any + "," dg_pass1 = d_record sub_record_show endi endi dinc d_record dift d_record > dg_list2: dinc d_loop endw dift d_count > 0 sg_pass1 = "letternumber" sg_pass2 = s_findnum sub_find_push endi $out "letternumber count=" + d_count ends sub_letters_and_numbers subr sub_possible_paragraph 'updated 2002/03/09 'find possible paragraph lines vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_filebyte, s_byte, d_long vari d_loop, d_good, s_line, d_count, d_maybe vari s_prevrecord, s_nowrecord, d_prevlong, d_nowlong vari d_length, s_findnum vari s_lowercase, s_endings s_lowercase = "abcdefghijklmnopqrstuvwxyz" s_endings = ".!?:" dch$ s_any, 34, 1 $app s_endings, s_any s_findnum = sg_nothing d_record = dg_list1 d_count = 0 d_loop = 1 dwhi d_loop = 1 d_any = d_record % 1000 dift d_any = 0: $sho "possible=" + d_record d_good = 1 d_filebyte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_filebyte, 72 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_nowrecord, s_record, 1, 70 d_maybe = 1 $cut s_any, s_prevrecord, 1, 1 $ift s_any = "]": dinc d_maybe $cut s_any, s_nowrecord, 1, 1 $ift s_any = "]": dinc d_maybe $trb s_nowrecord, s_nowrecord $len d_nowlong, s_nowrecord $len d_prevlong, s_prevrecord d_dot = 0 'previous is shorter d_any = d_nowlong - d_prevlong dift d_any > 10: d_dot = 1 'previous ends a sentence or statement $cut s_any, s_prevrecord, d_prevlong, 1 $lok d_any, s_endings, 1, s_any dift d_any > 0: d_dot = 1 dift d_dot <> 1: dinc d_maybe dift d_maybe = 1 'do we have a beginning paragraph line $cut s_any, s_nowrecord, 1, 1 $lok d_dot, s_lowercase, 1, s_any dift d_dot = 0 dinc d_count dto$ s_any, d_record, 6, 0 $app s_findnum, s_any + "," dg_pass1 = d_record sub_record_show endi endi s_prevrecord = s_nowrecord endi dinc d_record dift d_record > dg_list2: dinc d_loop endw dift d_count > 0 sg_pass1 = "paragraph?" sg_pass2 = s_findnum sub_find_push endi $out "possible paragraphs=" + d_count ends sub_possible_paragraph subr sub_brackets_before_string 'updated 2004/10/21 'put a ] line before each line beginning with a string vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_filebyte, s_byte, d_long vari d_loop, d_good, s_line, d_count, d_process vari s_bracketrecord, d_bracketrecord, d_bracketlast vari s_string, d_length, s_findnum d_process = 1 $inp s_string, "enter the string in quotes" dch$ s_dot, 34, 1 $par s_string, s_string, s_dot, 2 $out "string=" + s_dot + s_string + s_dot $len d_length, s_string dift d_length = 0: dinc d_process dift d_process = 1 'build a bracket record $ch$ s_bracketrecord, " ", 69 dch$ s_any, 10, 1 s_bracketrecord = "]" + s_bracketrecord + "W" + s_any endi s_findnum = sg_nothing d_bracketrecord = 2 d_bracketlast = 2 d_record = dg_list1 d_count = 0 d_loop = d_process dwhi d_loop = 1 d_any = d_record % 1000 dift d_any = 0: $sho "bracket=" + d_record d_good = 1 d_filebyte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_filebyte, 72 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 d_bracketlast = d_bracketrecord dinc d_bracketrecord $cut s_line, s_record, 1, 70 $cut s_any, s_line, 1, d_length $ift s_any <> s_string: dinc d_good $trr s_line, s_line $ift s_line = "]" d_bracketrecord = 1 dinc d_good endi endi dift d_good = 1 dift d_bracketlast = 1: dinc d_good endi dift d_good = 1 dg_pass1 = d_record sub_record_show d_any = d_record + 1 dto$ s_any, d_any, 6, 0 $app s_findnum, s_any + "," 'push to make room dg_pass1 = d_record dg_pass2 = 1 sub_push d_filebyte = d_record - 1 * 72 + 1 frea s_any, sg_fileran, d_filebyte, 72 $cut s_any, s_any, 71, 1 $ift s_any <> "W" fwri d_any, sg_fileran, d_filebyte, s_bracketrecord dbad d_any = 0 d_bracketrecord = 1 dinc d_count dinc dg_changes else $out "bad push1" endi endi dinc d_record dift d_record > dg_list2: dinc d_loop endw dift d_count > 0 sg_pass1 = s_string sg_pass2 = s_findnum sub_find_push endi $out "] lines added=" + d_count ends sub_brackets_before_string subr sub_bracket_after_sentence 'updated 2004/10/21 'put a ] line after a sentence ending vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_filebyte, s_byte, d_long vari d_loop, d_good, s_line, d_count vari s_bracketrecord, s_nextrecord, d_nextrecord 'build a bracket record $ch$ s_bracketrecord, " ", 69 dch$ s_any, 10, 1 s_bracketrecord = "]" + s_bracketrecord + "W" + s_any d_record = dg_list1 d_count = 0 d_loop = 1 dwhi d_loop = 1 d_good = 1 d_filebyte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_filebyte, 72 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_line, s_record, 1, 70 $trb s_line, s_line $len d_dot, s_line $cut s_dot, s_line, d_dot, 1 $ift s_dot = "'": ddec d_dot $chd d_any, s_dot '34 is the double quote dift d_any = 34: ddec d_dot $cut s_dot, s_line, d_dot, 1 'sentences can end with .!? s_any = ".!?" $lok d_any, s_any, 1, s_dot dift d_any = 0: dinc d_good endi dift d_good = 1 dg_pass1 = d_record + 1 sub_next_undeleted_record d_nextrecord = dg_pass1 s_nextrecord = sg_pass1 dift d_nextrecord = 0: dinc d_good endi dift d_good = 1 $trb s_nextrecord, s_nextrecord 'in case the next sentence begins with a ' or " d_dot = 1 $cut s_dot, s_nextrecord, d_dot, 1 $ift s_dot = "'": d_dot = 2 $chd d_any, s_dot dift d_any = 34: d_dot = 2 $cut s_dot, s_nextrecord, d_dot, 1 d_any = 1 $ift s_dot < "A": dinc d_any $ift s_dot > "Z": dinc d_any dift d_any <> 1 $ift s_dot < "0": dinc d_good $ift s_dot > "9": dinc d_good endi endi dift d_good = 1 'push to make room d_nextrecord = d_record + 1 dg_pass1 = d_nextrecord dg_pass2 = 1 sub_push d_filebyte = d_nextrecord - 1 * 72 + 1 frea s_any, sg_fileran, d_filebyte, 72 $cut s_any, s_any, 71, 1 $ift s_any <> "W" fwri d_any, sg_fileran, d_filebyte, s_bracketrecord dbad d_any = 0 $out d_nextrecord dinc d_count dinc dg_changes else $out "bad push1" endi endi dinc d_record dift d_record > dg_list2: dinc d_loop endw $out "] lines added=" + d_count ends sub_bracket_after_sentence subr sub_no_extra_bracket_lines 'updated 2004/10/21 'eliminate duplicate ] lines in dg_list1/dg_list2 vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_byte, s_byte, d_long vari d_loop, d_good, d_previous, d_count, d_deleteall d_deleteall = 2 $inp s_any, "1 = delete all bracket blank lines" $ift s_any = "1": d_deleteall = 1 d_record = dg_list1 d_count = 0 d_previous = 2 d_loop = 1 dwhi d_loop = 1 d_good = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 $trr s_dot, s_record $ift s_dot <> "]" dinc d_good dinc d_previous endi endi dift d_good = 1 dift d_deleteall = 1: d_previous = 1 dift d_previous <> 1: dinc d_good d_previous = 1 endi dift d_good = 1 dg_pass1 = d_record sub_record_show 'delete the record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $rep s_record, 71, "d" fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 dinc dg_changes dinc d_count endi dinc d_record dift d_record > dg_list2: dinc d_loop endw $out "lines deleted=" + d_count ends sub_no_extra_bracket_lines subr sub_longer_than_64 'updated 2002/02/13 'list lines longer than 64 bytes vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_byte, s_byte, d_long vari d_loop, d_good, s_findnum s_findnum = sg_nothing d_record = dg_list1 d_loop = 1 dwhi d_loop = 1 d_good = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 1, 1 $ift s_any = ")": dinc d_good $ift s_any = "]": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 $cut s_dot, s_record, 1, 1 $trr s_record, s_record $len d_long, s_record dift d_long > 64 dto$ s_any, d_record, 6, 0 $app s_findnum, s_any + "," dg_pass1 = d_record sub_record_show endi endi dinc d_record dift d_record > dg_list2: dinc d_loop endw sg_pass1 = "line>64" sg_pass2 = s_findnum sub_find_push ends sub_longer_than_64 subr sub_surnames0 'updated 1998/04/03 'make list of surnames from book and show vari s_choice $inp s_choice, "1 = find surnames, 2 = show surnames" $ift s_choice = "1": sub_surnames1 $ift s_choice = "2": sub_surnames2 ends sub_surnames0 subr sub_surnames1 'updated 2006/06/17, 1998/04/03 'find surnames and put in sg_surnames vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_byte, s_byte, d_long, d_loop, d_good vari s_surname sg_surnames = sg_nothing d_record = dg_bookcurrent d_loop = 1 dwhi d_loop = 1 'tell d_any = d_record % 1000 dift d_any = 0: $sho "find surnames=" + d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 ']BOOK: dift d_record > dg_bookcurrent $cut s_any, s_record, 1, 6 $ift s_any = "]BOOK:": dinc d_loop endi endi dift d_good = 1 ']H is an HTML title record ']N is a silent note record $cut s_any, s_record, 1, 2 $ift s_any = "]H": dinc d_good $ift s_any = "]N": dinc d_good $cut s_any, s_record, 1, 1 $ift s_any <> ")": dinc d_good endi dift d_good = 1 $lok d_dot, s_record, 1, "_" dift d_dot = 0: dinc d_good endi dift d_good = 1 d_any = d_dot + 3 $cut s_any, s_record, d_any, 1 $ift s_any = "@": dinc d_good endi dift d_good = 1 'we have a name record $bak d_any, s_record, d_dot, " " dift d_any = 0: dinc d_good endi dift d_good = 1 dinc d_any d_long = d_dot - d_any $cut s_surname, s_record, d_any, d_long $ch$ s_any, " ", 20 s_surname = "," + s_surname + s_any $cut s_surname, s_surname, 1, 16 $lok d_any, sg_surnames, 1, s_surname dift d_any = 0: sg_surnames = sg_surnames + s_surname endi dinc d_record endw 'sort the string $sor sg_surnames, sg_surnames, 16 $len d_any, sg_surnames $out "length=" + d_any ends sub_surnames1 subr sub_surnames2 'updated 2005/08/06, 2000/12/03 'show surnames in sg_surnames vari d_any, s_any, d_dot, s_dot vari d_loop, d_byte, d_long, s_line, s_surnames, d_linect d_linect = 0 s_surnames = sg_surnames d_loop = 1 dwhi d_loop = 1 $len d_long, s_surnames dift d_long < 70 $out s_surnames dinc d_loop else dinc d_linect dift d_linect >= dg_maxlines sub_more dift dg_more <> 1: dinc d_loop d_linect = 1 endi dift d_loop = 1 $cut s_line, s_surnames, 1, 64 $out s_line $cut s_surnames, s_surnames, 65, 99999 endi endi endw ends sub_surnames2 subr sub_fix_formatted_records 'updated 2006/06/17, 2005/05/01, 2004/10/21 'fix formatted records vari s_any, d_any, s_dot, d_dot vari d_good, d_loop, s_blanks, s_char10 vari d_record, s_record, d_byte, s_byte, d_long vari s_oldrecord, d_update, d_continue vari s_booktitle d_continue = 2 $inp s_any, "1 = do not stop" $ift s_any = "1": d_continue = 1 'initialize dch$ s_blanks, 32, 1 dch$ s_char10, 10, 1 s_booktitle = sg_nothing sg_1linesbad = sg_nothing dg_linesbad = 0 d_record = 1 d_loop = 1 dwhi d_loop = 1 'tell d_any = d_record % 1000 dift d_any = 0: $sho "fix formatted records=" + d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record d_update = 2 d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 ']H is a HTML title record ']N is a silent note record $cut s_any, s_record, 1, 2 $ift s_any = "]H": dinc d_good $ift s_any = "]N": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 s_oldrecord = s_record 'get title from ]BOOK: record $cut s_any, s_record, 1, 6 $ift s_any = "]BOOK:" $cut s_booktitle, s_record, 8, 63 dg_pass1 = d_record sub_record_show endi 'put title in ]STOP record $cut s_any, s_record, 1, 5 $ift s_any = "]STOP" $cut s_any, s_record, 8, 61 $ift s_any <> s_booktitle $rep s_record, 8, s_booktitle d_update = 1 else dg_pass1 = d_record sub_record_show endi endi 'arrange the record sg_pass1 = s_record sub_arrange_record s_any = sg_pass1 $ift s_any <> s_record s_record = s_any d_update = 1 dinc d_good endi endi dift d_good = 1 s_dot = "Their children are as follows." $lok d_dot, s_record, 1, s_dot s_dot = "They had the following children." dift d_dot = 0: $lok d_dot, s_record, 2, s_dot dift d_dot > 0 $ch$ s_any, " ", 80 $app s_dot, s_any $cut s_record, s_dot, 1, 70 d_update = 1 dinc d_good endi endi dift d_good = 1 s_dot = ". You may copy this" $cut s_any, s_record, 52, 19 $ift s_dot = s_any $rep s_record, 52, " for non-commercial use" d_update = 1 dinc d_good endi endi dift d_good = 1 s_dot = "entire booklet if it is for non-commercial use." $cut s_any, s_record, 1, 47 $ift s_dot = s_any $ch$ s_record, " ", 70 $rep s_record, 1, "usage only." d_update = 1 dinc d_good endi endi dift d_good = 1 'show record with @balcro.com $lok d_dot, s_record, 1, "@balcro.com" dift d_dot > 0: $out d_record + " " + s_record endi dift d_update = 1 $ch$ s_any, " ", 80 $app s_record, s_any $cut s_record, s_record, 1, 70 dg_pass1 = d_record sub_bad_add dto$ s_any, d_record, 6, 0 $out s_any + " " + s_oldrecord $out s_any + " " + s_record dift d_continue <> 1 $inp s_any, "n = no change, * to end" $ift s_any = "*" s_any = "n" dinc d_loop endi else s_any = "x" endi $ift s_any <> "n" $app s_record, "W" + s_char10 d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 dinc dg_changes endi endi dinc d_record endw $out "bad=" + dg_linesbad ends sub_fix_formatted_records subr sub_validate_charts 'updated 2006/06/17, 2003/08/25 'validate charts vari s_any, d_any, s_dot, d_dot vari d_good, d_loop vari d_record, s_record, d_byte, s_byte, d_long, s_previousrec vari s_borndt, s_dieddt, d_nameline, d_charttop vari d_inchart, d_husborwife, d_namerecno, s_nameline vari d_panect, d_panepersonct, d_panespousect, d_panepersonrecno vari s_descenttag1, s_descenttag2, s_descenttagx vari d_needfather1, d_needmother1, d_needfather2, d_needmother2 'initialize linesbad sg_1linesbad = sg_nothing dg_linesbad = 0 dg_linescount = 0 'person count d_panepersonrecno = 0 d_panepersonct = 0 d_panespousect = 0 d_husborwife = 2 d_panect = 0 d_inchart = 2 d_needfather1 = 2 d_needmother1 = 2 d_needfather2 = 2 d_needmother2 = 2 'born and died dates s_borndt = sg_nothing s_dieddt = sg_nothing d_nameline = 2 d_namerecno = 1 s_nameline = sg_nothing d_charttop = 2 'person count d_record = dg_bookcurrent d_loop = 1 dwhi d_loop = 1 'tell d_any = d_record % 1000 dift d_any = 0: $sho "validate=" + d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 ']H is a HTML title record ']N is a silent note record $cut s_any, s_record, 1, 2 $ift s_any = "]H": dinc d_good $ift s_any = "]N": dinc d_good endi dift d_good = 1 'stop when we hit the next book dift d_record <> dg_bookcurrent $cut s_any, s_record, 1, 6 $ift s_any = "]BOOK:" dinc d_loop dinc d_good endi endi endi dift d_good = 1 'no lines can begin with a space $cut s_any, s_record, 1, 1 $ift s_any = " " sg_pass1 = "paragraphing" dg_pass1 = d_record sub_bad_read_show d_good = dg_pass1 d_loop = dg_pass1 endi $cut s_record, s_record, 1, 70 endi dift d_good = 1 'only formatted gen records are of interest $cut s_any, s_record, 1, 2 $ift s_any <> "]-" $ift s_any <> "]C" $cut s_byte, s_record, 1, 1 $ift s_byte <> ")": dinc d_good endi endi endi dift d_good = 1 'are we at the start of a chart ']BOOK: ']CHART ']CHAP: dinc d_charttop $cut s_any, s_record, 1, 6 $ift s_any = "]CHART" d_inchart = 1 d_charttop = 1 d_panect = 1 d_panespousect = 0 d_panepersonct = 0 s_descenttag1 = sg_nothing d_needfather1 = 1 d_needmother1 = 1 endi $ift s_any = "]CHAP:": dinc d_inchart $cut s_any, s_record, 1, 6 $ift s_any = "]BOOK:": dinc d_inchart dift d_inchart <> 1: dinc d_good endi dift d_good = 1 'we are in a chart, do we have a dash line $cut s_any, s_record, 1, 2 $ift s_any = ")-": s_any = "]-" $ift s_any = "]-" dift d_panect = 1 dift d_panepersonct > 0 'if no spouse dift d_panespousect = 0 sg_pass1 = "no spouse" dg_pass1 = d_record sub_bad_read_show d_good = dg_pass1 d_loop = dg_pass1 endi endi endi 'we have a dashline dinc d_panect d_panespousect = 0 d_panepersonct = 0 dinc d_good endi endi dift d_good = 1 'we are in a chart 'do we have a name record d_nameline = 1 $lok d_dot, s_record, 1, "_" dift d_dot = 0: dinc d_nameline d_any = d_dot + 3 $cut s_any, s_record, d_any, 1 $ift s_any = "@": dinc d_nameline dift d_nameline = 1 'we have a name record and are in a chart dift d_charttop <> 1: dinc d_panepersonct 'get the floating descent tag if any s_descenttagx = sg_nothing $lok d_any, s_record, 1, "\" dift d_any > 0 $cut s_descenttagx, s_record, d_any, 99 $lok d_any, s_descenttagx, 1, " " dift d_any > 0 $cut s_descenttagx, s_descenttagx, 1, d_any $trb s_descenttagx, s_descenttagx endi endi dift d_charttop = 1: s_descenttag1 = s_descenttagx 'is this the first person in this pane dift d_panepersonct = 1 d_panepersonrecno = d_record s_descenttag2 = s_descenttagx 'do we need to validate descenttag2 $len d_long, s_descenttag1 dift d_long > 0 $cut s_any, s_descenttag2, 1, d_long $ift s_any <> s_descenttag1 sg_pass1 = "descent tag1" dg_pass1 = d_record sub_bad_read_show d_loop = dg_pass1 dinc d_good endi $len d_any, s_descenttag2 dift d_panect > 1: ddec d_any dift d_any <> d_long sg_pass1 = "descent tag2" dg_pass1 = d_record sub_bad_read_show d_loop = dg_pass1 dinc d_good endi endi endi 'if child record validate descent tag if any $cut s_any, s_record, 1, 8 $ift s_any = ") Child:" s_descenttagx = sg_nothing $lok d_any, s_record, 1, "\" dift d_any > 0 $cut s_descenttagx, s_record, d_any, 99 $lok d_any, s_descenttagx, 1, " " d_any = d_any - 2 $cut s_descenttagx, s_descenttagx, 1, d_any endi $ift s_descenttagx <> s_descenttag2 sg_pass1 = "descent tag3" dg_pass1 = d_record sub_bad_read_show d_loop = dg_pass1 dinc d_good endi endi dift d_panepersonct > 1 $cut s_any, s_record, 11, 7 $ift s_any = "Father:" dinc d_needfather1 dinc d_needfather2 endi $ift s_any = "Mother:" dinc d_needmother1 dinc d_needmother2 endi $ift s_any <> "Father:" 'do we still need a father or mother d_any = 2 dift d_needfather1 = 1: d_any = 1 dift d_needmother1 = 1: d_any = 1 dift d_needfather2 = 1: d_any = 1 dift d_needmother2 = 1: d_any = 1 dift d_any = 1 sg_pass1 = "need father or mother" dg_pass1 = d_panepersonrecno sub_bad_read_show d_loop = dg_pass1 d_good = dg_pass1 dinc d_needfather1 dinc d_needmother1 dinc d_needfather2 dinc d_needmother2 endi endi 'we must have a spouse or paramour or else d_any = 1 'Spouse: or Spouse1 or Spouse2 $cut s_any, s_record, 3, 6 $ift s_any = "Spouse" dinc d_any dinc d_panespousect endi $cut s_any, s_record, 3, 8 $ift s_any = "Paramour" dinc d_any dinc d_panespousect endi $cut s_any, s_record, 3, 6 $ift s_any = "Child:": dinc d_any $cut s_any, s_record, 3, 4 $ift s_any = "Who:": dinc d_any dift d_any = 1 'what do we have $lok d_dot, s_record, 1, ":" d_dot = d_dot - 10 $cut s_any, s_record, 11, d_dot $ift s_any = "Father:": dinc d_any $ift s_any = "Mother:": dinc d_any $ift s_any = "Grandfather:": dinc d_any $ift s_any = "Grandmother:": dinc d_any $ift s_any = "GGrandfather:": dinc d_any $ift s_any = "GGrandmother:": dinc d_any $ift s_any = "GGGrandfather:": dinc d_any $ift s_any = "GGGrandmother:": dinc d_any $ift s_any = "GGGGrandfather:": dinc d_any $ift s_any = "GGGGrandmother:": dinc d_any $ift s_any = "Brother:": dinc d_any $ift s_any = "Sister:": dinc d_any $ift s_any = "Witness:": dinc d_any $ift s_any = "Bondsman:": dinc d_any $ift s_any = "Minister:": dinc d_any endi dift d_any = 1 sg_pass1 = "what kind of record" dg_pass1 = d_record sub_bad_read_show d_loop = dg_pass1 d_good = dg_pass1 endi endi dift d_husborwife = 1 $len d_any, s_borndt dift d_any > 0 'save line number so we can show it with b sg_pass1 = "born record" dg_pass1 = d_namerecno sub_bad_read_show d_loop = dg_pass1 d_good = dg_pass1 s_borndt = sg_nothing endi $len d_any, s_dieddt dift d_any > 0 'save line number so we can show it with b sg_pass1 = "died record" dg_pass1 = d_namerecno sub_bad_read_show d_loop = dg_pass1 d_good = dg_pass1 s_dieddt = sg_nothing endi endi 'do we have a husband or wife d_husborwife = 1 dift d_charttop = 1: dinc d_husborwife $cut s_any, s_record, 3, 1 $ift s_any = " ": dinc d_husborwife 'Child: and Who: records are not husband or wife $cut s_any, s_record, 3, 6 $ift s_any = "Child:": dinc d_husborwife $cut s_any, s_record, 3, 4 $ift s_any = "Who:": dinc d_husborwife 'get born date and died date $cut s_borndt, s_record, 62, 4 $trb s_borndt, s_borndt $cut s_dieddt, s_record, 67, 4 $trb s_dieddt, s_dieddt d_namerecno = d_record s_nameline = s_record endi 'we do not have a name record dift d_nameline <> 1 'do we have a born record $cut s_any, s_record, 11, 6 s_dot = "Born: ,Christ,Baptiz" $lok d_any, s_dot, 1, s_any dift d_any > 0 $len d_any, s_borndt dift d_any > 0 $lok d_any, s_record, 17, s_borndt dift d_any > 0: s_borndt = sg_nothing endi endi 'do we have a died record $cut s_any, s_record, 11, 6 s_dot = "Died: ,Estate,Probat,Will: ,Buried" $lok d_any, s_dot, 1, s_any dift d_any > 0 $len d_any, s_dieddt dift d_any > 0 $lok d_any, s_record, 17, s_dieddt dift d_any > 0: s_dieddt = sg_nothing endi endi dift d_panect < 3 'cannot have See the chart for his family 'unless dash line has come first $cut s_any, s_record, 11, 13 $ift s_any = "See the chart" sg_pass1 = "See the chart" dg_pass1 = d_record sub_bad_read_show d_loop = dg_pass1 d_good = dg_pass1 endi endi endi endi 'prep to look at the next record dinc d_record endw $out "bad=" + dg_linesbad ends sub_validate_charts subr sub_validate_records 'updated 2006/06/17, 2003/01/09 'validate individual records vari d_good, d_loop, d_any, s_any vari d_record, s_record, d_byte, s_byte, d_long 'initialize sg_1linesbad = sg_nothing dg_linesbad = 0 d_record = 1 d_loop = 1 dwhi d_loop = 1 'tell d_any = d_record % 1000 dift d_any = 0: $sho "validate=" + d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 ']H is HTML title, ]N is silent note ']E is encrypted with $cod $cut s_any, s_record, 1, 2 $ift s_any = "]H": dinc d_good $ift s_any = "]N": dinc d_good $ift s_any = "]E": dinc d_good $ift s_any = "]-": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 s_any = "not to be sold." $lok d_any, s_record, 1, s_any dift d_any > 0 dinc dg_linesbad dg_pass1 = d_record sub_record_show endi s_any = "booklet" $lok d_any, s_record, 1, s_any dift d_any > 0 dinc dg_linesbad dg_pass1 = d_record sub_record_show endi 'validate nametags in unformatted single lines sg_pass1 = s_record dg_pass1 = d_record sub_validate_nametags 'validate single gen lines $cut s_byte, s_record, 1, 1 $ift s_byte = ")" 'validate formatted single lines sg_pass1 = s_record dg_pass1 = d_record sub_validate_genformatted endi 'validate for block paragraphing $cut s_byte, s_record, 1, 1 $ift s_byte = " " dinc dg_linesbad dg_pass1 = d_record sub_record_show endi endi dinc d_record endw $out "bad=" + dg_linesbad ends sub_validate_records subr sub_validate_genformatted 'updated 2002/03/18 'validate one genformatted line vari d_any, s_any, d_dot, s_dot, s_blanks vari s_record, d_record, d_date1, d_date2, d_okline vari d_namerec, s_num, d_num dg_linescount = 0 s_record = sg_pass1 d_record = dg_pass1 d_okline = 1 d_namerec = 1 dch$ s_blanks, 32, 1 'name records only $lok d_dot, s_record, 1, "_" dift d_dot = 0: dinc d_namerec d_dot = d_dot + 3 $cut s_dot, s_record, d_dot, 1 $ift s_dot = "@": dinc d_namerec dift d_namerec = 1 $lok d_dot, s_record, 1, "Frances " dift d_dot > 0 $cut s_dot, s_record, 60, 1 $ift s_dot <> "F": dinc d_okline endi $lok d_dot, s_record, 1, "Francis " dift d_dot > 0 $cut s_dot, s_record, 60, 1 $ift s_dot <> "M": dinc d_okline endi endi dift d_namerec = 1 'validate the floating descenttag $lok d_dot, s_record, 1, "\" dift d_dot > 0 $lok d_dot, s_record, d_dot, " " dift d_dot <> 59: dinc d_okline endi 'validate sex $cut s_any, s_record, 60, 2 d_dot = 0 $ift s_any = "M.": dinc d_dot $ift s_any = "F.": dinc d_dot dift d_dot <> 1: dinc d_okline 'validate dates $cut s_dot, s_record, 66, 1 $ift s_dot <> "-": dinc d_okline 'birth date $cut s_num, s_record, 62, 4 $ift s_num = " ": s_num = "0" $isd d_any, s_num dift d_any = 1: $tod d_date1, s_num dift d_any <> 1: dinc d_okline 'death date $cut s_num, s_record, 67, 4 $ift s_num = " ": s_num = "9999" $isd d_any, s_num dift d_any = 1: $tod d_date2, s_num dift d_any <> 1: dinc d_okline dift d_okline = 1 dift d_date1 > d_date2: dinc d_okline endi else 'not a namerec s_any = "Their children are as follows." $lok d_any, s_record, 1, s_any dift d_any > 0: dinc d_okline $lok d_any, s_record, 1, "unseen" dift d_any > 0: dinc d_okline endi ') and indented beginning in 11 $cut s_any, s_record, 2, 9 dch$ s_blanks, 32, 9 $ift s_any = s_blanks 'only certain keywords $lok d_any, s_record, 11, " " d_any = d_any - 11 $cut s_any, s_record, 11, d_any d_any = 0 dift d_namerec = 1 $ift s_any = "Father:": dinc d_any $ift s_any = "Mother:": dinc d_any $ift s_any = "Grandfather:": dinc d_any $ift s_any = "Grandmother:": dinc d_any $ift s_any = "GGrandfather:": dinc d_any $ift s_any = "GGrandmother:": dinc d_any $ift s_any = "GGGrandfather:": dinc d_any $ift s_any = "GGGrandmother:": dinc d_any $ift s_any = "GGGGrandfather:": dinc d_any $ift s_any = "GGGGrandmother:": dinc d_any $ift s_any = "Brother:": dinc d_any $ift s_any = "Sister:": dinc d_any $ift s_any = "Witness:": dinc d_any $ift s_any = "Bondsman:": dinc d_any $ift s_any = "Minister:": dinc d_any 'Child: and Who: begin in 3 now '$ift s_any = "Child:": dinc d_any '$ift s_any = "Who:": dinc d_any else $ift s_any = "Born:": dinc d_any $ift s_any = "Died:": dinc d_any $ift s_any = "Married:": dinc d_any $ift s_any = "Buried:": dinc d_any $ift s_any = "Baptized:": dinc d_any $ift s_any = "Christened:": dinc d_any $ift s_any = "Divorced:": dinc d_any $ift s_any = "Will:": dinc d_any $ift s_any = "Probate:": dinc d_any $ift s_any = "Estate:": dinc d_any $ift s_any = "They": dinc d_any $ift s_any = "See": dinc d_any endi 'do we have a blank but formatted line $cut s_any, s_record, 2, 69 dch$ s_blanks, 32, 69 $ift s_any = s_blanks: dinc d_any dift d_any <> 1: dinc d_okline else 'must begin in 3 if not ]C $cut s_any, s_record, 1, 2 s_dot = "]C,]B" $lok d_any, s_dot, 1, s_any dift d_any = 0 $cut s_any, s_record, 3, 1 $ift s_any = " ": dinc d_okline dift d_namerec <> 1: dinc d_okline endi endi 'show line if not good dift d_okline <> 1 sg_pass1 = "bad record" dg_pass1 = d_record sub_bad_read_show endi ends sub_validate_genformatted subr sub_validate_nametags 'updated 2002/12/08 'validate nametags vari s_any, d_any, s_dot, d_dot vari s_record, d_record, s_line, d_byte, s_byte vari d_loop, d_good, s_numbers vari s_alpha, s_chars1, s_chars2, s_chars3 s_record = sg_pass1 d_record = dg_pass1 s_numbers = "0123456789" s_alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 'char 1 of tag _AAa s_chars1 = s_alpha + "?" 'char 2 of tag _AAa $clo s_chars2, s_chars1 s_chars2 = s_alpha + s_chars2 'char 3 of tag _AAa $clo s_chars3, s_alpha $app s_chars3, "@" + s_numbers 'validate name tags d_good = 1 s_line = s_record d_loop = 1 dwhi d_loop = 1 $lok d_byte, s_line, 1, "_" dift d_byte > 0 dinc d_byte $cut s_byte, s_line, d_byte, 1 $lok d_any, s_chars1, 1, s_byte dift d_any = 0: dinc d_good dinc d_byte $cut s_byte, s_line, d_byte, 1 $lok d_any, s_chars2, 1, s_byte dift d_any = 0: dinc d_good dinc d_byte $cut s_byte, s_line, d_byte, 1 $lok d_any, s_chars3, 1, s_byte dift d_any = 0: dinc d_good $cut s_line, s_line, d_byte, 99 else dinc d_loop endi endw dift d_good <> 1 sg_pass1 = "bad record" dg_pass1 = d_record sub_bad_read_show endi ends sub_validate_nametags subr sub_validate_names 'updated 2006/06/17, 2002/04/20 'validate names, descent tags, sex and dates vari s_any, d_any, s_dot, d_dot vari s_data, d_loop, d_good, d_yes, d_stop vari s_name, s_desc, s_military, s_info vari s_pers, s_end, s_beg, d_beg, d_end, d_wholefile vari d_record, s_record, d_byte, s_byte, d_long vari d_process d_stop = 2 d_wholefile = 2 $inp s_any, "1 = whole file, 2 = just book" $ift s_any = "1" d_wholefile = 1 else $inp s_any, "1 = stop at stop" $ift s_any = "1": d_stop = 1 endi 'initialize sg_1linesbad and sg_all sg_1linesbad = sg_nothing dg_linesbad = 0 sg_all = sg_nothing d_record = dg_bookcurrent dift d_wholefile = 1: d_record = 1 d_process = 1 d_loop = 1 dwhi d_loop = 1 'tell d_any = d_record % 1000 dift d_any = 0: $sho "validate=" + d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 ']H is HTML title, ]N is a silent note $cut s_any, s_record, 1, 2 $ift s_any = "]H": dinc d_good $ift s_any = "]N": dinc d_good endi dift d_good = 1 'we may want to stop at a ]STOP record $cut s_any, s_record, 1, 5 $ift s_any = "]STOP" 'show the stop record dg_pass1 = d_record sub_record_show dift d_stop = 1 dinc d_loop dinc d_good endi endi endi dift d_good = 1 dift d_wholefile <> 1 dift d_record <> dg_bookcurrent $cut s_any, s_record, 1, 6 $ift s_any = "]BOOK:" dinc d_loop dinc d_good endi endi endi $cut s_any, s_record, 1, 2 $ift s_any = "]C": $rep s_record, 1, ")" $cut s_byte, s_record, 1, 1 $ift s_byte <> ")": dinc d_good endi dift d_good = 1 $lok d_dot, s_record, 1, "_" dift d_dot > 0 d_end = d_dot + 3 $cut s_end, s_record, d_end, 1 $ift s_end = "@": dinc d_good else dinc d_good endi endi dift d_good = 1 'we have a name line with the name ending on d_end 'get the last name d_beg = d_dot d_yes = 1 dwhi d_yes = 1 ddec d_beg $cut s_byte, s_record, d_beg, 1 $ift s_byte = " ": dinc d_yes dift d_beg < 2 dinc d_yes $out s_record $out " " endi endw dinc d_beg d_long = d_end - d_beg + 1 $cut s_name, s_record, d_beg, d_long 'get the descent tag if any s_desc = sg_nothing $lok d_beg, s_record, 1, "\" dift d_beg > 0 $lok d_end, s_record, d_beg, " " dift d_end > 0 d_long = d_end - d_beg $cut s_desc, s_record, d_beg, d_long endi 'reject generation descent tags $cut s_any, s_desc, 1, 4 $ift s_any = "\gen": s_desc = sg_nothing dift d_wholefile = 1: s_desc = sg_nothing endi 'get the military if any s_military = sg_nothing $lok d_any, s_record, 1, "REV" dift d_any = 0: $lok d_any, s_record, 1, "F&I" dift d_any = 0: $lok d_any, s_record, 1, "W12" dift d_any = 0: $lok d_any, s_record, 1, "MEX" dift d_any = 0: $lok d_any, s_record, 1, "CSA" dift d_any = 0: $lok d_any, s_record, 1, "USA" dift d_any = 0: $lok d_any, s_record, 1, "WW1" dift d_any = 0: $lok d_any, s_record, 1, "WW2" dift d_any = 0: $lok d_any, s_record, 1, "CUB" dift d_any > 0: $cut s_military, s_record, d_any, 3 'get the sex and date info $cut s_info, s_record, 60, 11 'build the person record prec s_pers = s_name + "&" + s_desc + "&" + s_military $app s_pers, "&" + s_info + "&" $len d_long, s_pers 'do we have the name already $lok d_dot, sg_all, 1, s_name dift d_dot > 0 'does the rest of the s_pers match $cut s_any, sg_all, d_dot, d_long $ift s_any <> s_pers 'store the rec number in sg_1linesbad and show sg_pass1 = "have name already" dg_pass1 = d_record sub_bad_read_show d_process = dg_pass1 endi else 'we do not have the name, do we have the s_desc $len d_long, s_desc dift d_long > 0 s_any = "&" + s_desc+ "&" $lok d_dot, sg_all, 1, s_any dift d_dot > 0 'store the rec number in sg_1linesbad and show sg_pass1 = "bad name" dg_pass1 = d_record sub_bad_read_show d_process = dg_pass1 endi endi 'add the new s_pers to the sg_all sg_all = sg_all + s_pers endi endi dinc d_record dift d_process <> 1: dinc d_loop endw 'now validate the names in the unformatted records d_record = dg_bookcurrent d_loop = d_process dwhi d_loop = 1 d_any = d_record % 1000 dift d_any = 0: $sho "names=" + d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 dift d_record <> dg_bookcurrent $cut s_any, s_record, 1, 6 $ift s_any = "]BOOK:" dinc d_loop dinc d_good endi endi $cut s_byte, s_record, 1, 1 $ift s_byte = ")": dinc d_good dift d_stop = 1 $cut s_any, s_record, 1, 5 $ift s_any = ")STOP": s_any = "]STOP" $ift s_any = "]STOP" dinc d_loop dinc d_good endi endi endi dift d_good = 1 d_byte = 1 dwhi d_good = 1 $lok d_dot, s_record, d_byte, "_" dift d_dot > 0 d_byte = d_dot + 1 d_end = d_dot + 3 $cut s_end, s_record, d_end, 1 $ift s_end <> "@" d_beg = d_dot - 1 d_yes = 1 dwhi d_yes = 1 $cut s_beg, s_record, d_beg, 1 $ift s_beg = " ": dinc d_yes dift d_yes = 1: ddec d_beg dift d_beg < 1: dinc d_yes endw dinc d_beg d_long = d_end - d_beg + 1 $cut s_name, s_record, d_beg, d_long $lok d_dot, sg_all, 1, s_name dift d_dot = 0 'store rec number in bad and show sg_pass1 = "have not name" dg_pass1 = d_record sub_bad_read_show d_process = dg_pass1 endi endi else dinc d_good endi endw endi dinc d_record dift d_process <> 1: dinc d_loop endw dift d_process = 1 $len d_long, sg_all $out "data length=" + d_long $out "bad=" + dg_linesbad endi sg_all = sg_nothing ends sub_validate_names subr sub_string_lines_show 'updated 2009/11/06, 2009/06/08 '2009/02/16, 2009/01/21, 2008/05/23, 2007/02/06, 2006/05/15 '2006/06/15, 2006/06/11, 2006/06/10, 2005/08/31, 2004/03/06 'show from line numbers in string in sg_pass1 vari d_any, s_any, d_dot, s_dot, s_out vari d_loop, d_good, s_linenumbers, d_byte, d_linecount vari d_record, d_long, d_beginrecord, d_showcount vari d_showbefore, d_showafter 's_linenumbers has in it csv line numbers 6 long s_linenumbers = sg_pass1 d_beginrecord = dg_pass1 d_showcount = dg_pass2 'd_showcount is the number of lines to show per instance dift d_showcount < 0: d_showcount = 0 d_showbefore = d_showcount \ 2 d_showafter = d_showcount \ 2 d_byte = 1 d_linecount = 2 d_loop = 1 $len d_long, s_linenumbers dift d_long = 0: dinc d_loop dwhi d_loop = 1 'get the record number from s_linenumbers d_good = 1 'format=000002,000045,001003, $cut s_any, s_linenumbers, d_byte, 6 $isd d_any, s_any dift d_any <> 1 $out s_any dinc d_good endi dift d_good = 1 'we do not need to test for numeric here $tod d_record, s_any dift d_linecount >= dg_maxlines d_linecount = 2 sub_more d_loop = dg_more d_good = d_loop endi dift d_record < d_beginrecord: dinc d_good endi dift d_good = 1 dift d_showcount = 0 dg_pass1 = d_record sub_record_show dinc d_linecount endi dift d_showcount = 1 dg_pass1 = d_record sub_record_show dinc d_linecount $ch$ s_any, "*", 76 $out s_any d_linecount = d_linecount + 2 endi dift d_showcount > 1 dift dg_nowline <> d_record: dg_ampline = dg_nowline dg_nowline = d_record 'show lines before dg_pass1 = d_record - 1 dg_pass2 = d_showbefore sub_show_lines_before 'show the line dg_pass1 = d_record sub_record_show 'show lines after dg_pass1 = d_record + 1 dg_pass2 = d_showafter sub_show_lines_after $ch$ s_any, "*", 76 $out s_any d_linecount = d_linecount + d_showcount + 3 endi endi d_byte = d_byte + 7 dift d_byte > d_long: dinc d_loop endw ends sub_string_lines_show subr sub_string_lines_to_file 'updated 2006/05/24, 2005/08/31, 2005/02/10, 2004/03/06 'send lines from numbers in string to file vari d_any, s_any, d_dot, s_dot, s_out vari d_loop, d_good, s_linenumbers, d_byte vari d_record, s_record, s_number, d_yeslineno vari s_filename, d_process d_process = 1 s_linenumbers = sg_pass1 $inp s_filename, "enter name of file" $trb s_filename, s_filename $ift s_filename = "*": dinc d_process $len d_any, s_filename dift d_any = 0: dinc d_process dift d_process = 1 flen d_any, s_filename dift d_any >= 0 'the file already exists $inp s_any, "1=purge old file=" + s_filename $ift s_any = "*": dinc d_process $ift s_any = "1" fdel d_any, s_filename else dinc d_process endi endi endi dift d_process = 1 d_yeslineno = 2 $inp s_any, "1=include line numbers" $ift s_any = "1": d_yeslineno = 1 endi d_byte = 1 d_loop = d_process dwhi d_loop = 1 'get the record number from s_linenumbers d_good = 1 'format=000002,000045,001003, $cut s_number, s_linenumbers, d_byte, 6 $isd d_any, s_number dift d_any <> 1 $out s_number dinc d_good endi dift d_good = 1 'we do not need to test for numeric here $tod d_record, s_number d_dot = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_dot, 72 $len d_any, s_record dift d_any <> 72 dinc d_good dinc d_loop endi endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 $trr s_record, s_record dift d_yeslineno = 1 s_record = d_record + " " + s_record endi fapp d_any, s_filename, s_record dbad d_any = 0 endi d_byte = d_byte + 7 $len d_any, s_linenumbers dift d_byte > d_any: dinc d_loop endw ends sub_string_lines_to_file subr sub_string_lines_delete 'updated 2009/11/01, 2004/10/21 'delete lines from numbers in string to file vari d_any, s_any, d_dot, s_dot, s_out vari d_loop, d_good, s_recnumbers, d_byte vari d_record, s_record, s_number, s_line s_recnumbers = sg_pass1 d_byte = 1 d_loop = 1 dwhi d_loop = 1 'get the record number from s_recnumbers d_good = 1 'format=000002,000045,001003, $cut s_number, s_recnumbers, d_byte, 6 $isd d_any, s_number dift d_any <> 1 $out s_number dinc d_good endi dift d_good = 1 'we do not need to test for numeric here $tod d_record, s_number d_dot = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_dot, 72 $len d_any, s_record dift d_any <> 72 dinc d_good dinc d_loop endi endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 $cut s_line, s_record, 1, 70 $out d_record + " " + s_line s_out = "return to delete, n = no, * = cancel" $inp s_any, s_out $clo s_any, s_any $ift s_any = "*" dinc d_loop dinc d_good endi $ift s_any = "n": dinc d_good endi dift d_good = 1 $rep s_record, 71, "d" d_dot = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_dot, s_record dbad d_any = 0 dinc dg_changes endi d_byte = d_byte + 7 $len d_any, s_recnumbers dift d_byte > d_any: dinc d_loop endw ends sub_string_lines_delete subr sub_string_lines_alter 'updated 2011/03/22, 2009/11/01, 2004/10/21 'alter lines from numbers in string vari d_any, s_any, d_dot, s_dot, s_out, s_input vari d_loop1, d_loop2, d_good, s_recnumbers, d_byte vari d_record, s_record, s_number, s_line, d_long s_recnumbers = sg_pass1 d_byte = 1 d_loop1 = 1 dwhi d_loop1 = 1 'get the record number from s_recnumbers d_good = 1 'format=000002,000045,001003, $cut s_number, s_recnumbers, d_byte, 6 $isd d_any, s_number dift d_any <> 1 $out s_number dinc d_good endi dift d_good = 1 'we do not need to test for numeric here $tod d_record, s_number d_dot = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_dot, 72 $len d_any, s_record dift d_any <> 72 dinc d_good dinc d_loop1 endi endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 'get replacement characters $cut s_line, s_record, 1, 70 $out d_record + " " + s_line $out "* to end, ^ to blank" $out "enter replacement characters in place" $inp s_input, s_line $ift s_input = "*" dinc d_loop1 dinc d_good endi $trb s_any, s_input $len d_any, s_any dift d_any = 0: dinc d_good endi dift d_good = 1 'put replacement characters in record $len d_long, s_input d_dot = 1 d_loop2 = 1 dwhi d_loop2 = 1 $cut s_dot, s_input, d_dot, 1 $ift s_dot <> " " $ift s_dot = "^": s_dot = " " $rep s_record, d_dot, s_dot endi dinc d_dot dift d_dot > d_long: dinc d_loop2 endw $cut s_any, s_record, 1, 70 $out s_any 'update record in file d_dot = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_dot, s_record dbad d_any = 0 dg_pass1 = d_record sub_record_show $ch$ s_any, "-", 70 $out s_any dinc dg_changes endi d_byte = d_byte + 7 $len d_any, s_recnumbers dift d_byte > d_any: dinc d_loop1 endw ends sub_string_lines_alter subr sub_bad_add 'updated 2000/11/29 'add a line to bad vari s_number dinc dg_linesbad dto$ s_number, dg_pass1, 6, 0 'add the number to the end sg_1linesbad = sg_1linesbad + s_number + "," ends sub_bad_add subr sub_bad_read_show 'updated 2002/04/11 'add a line to bad vari d_record, s_record, d_byte, s_byte, s_number vari d_good, s_message, d_more, d_long 'get the record number and message about it d_record = dg_pass1 s_message = sg_pass1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_more = 1 d_good = 1 $len d_long, s_record dift d_long <> 72: dinc d_good dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 'do we need a more dg_linescount = dg_linescount + 3 dift dg_linescount > dg_maxlines dg_linescount = 1 'sub_more put 1 in dg_pass1 for more sub_more d_more = dg_more d_good = d_more endi endi dift d_good = 1 'show the record and message $out s_message dg_pass1 = d_record sub_record_show dinc dg_linesbad dto$ s_number, d_record, 6, 0 sg_1linesbad = sg_1linesbad + s_number + "," endi dg_pass1 = d_more ends sub_bad_read_show subr sub_counts 'updated 2000/11/24 'get file counts for a range vari s_any, d_any, s_dot, d_dot vari d_loop, d_good, d_char, d_seconds1, d_seconds2 vari d_record, s_record, d_byte, s_byte, d_long vari d_tline, d_tdele, d_tchar, d_tbyte vari d_mult1, d_mult2, d_mult3, d_twords vari s_previous, d_unformatted dsec d_seconds1 'initialize total variables d_tline = 0 d_tdele = 0 d_mult1 = 0 d_mult2 = 0 d_mult3 = 0 d_tbyte = 0 d_tchar = 0 d_twords = 0 d_record = dg_list1 d_loop = 1 dwhi d_loop = 1 'tell d_byte = d_record % 1000 dift d_byte = 0: $sho "counts=" + d_record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 $len d_long, s_record dift d_long <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W" dinc d_tdele dinc d_good endi endi dift d_good = 1 $cut s_record, s_record, 1, 70 'show )R records $cut s_any, s_record, 1, 2 $ift s_any = ")R": s_any = "]R" $ift s_any = "]R" dg_pass1 = d_record sub_record_show endi dinc d_tline 'prepare for word count d_unformatted = 1 $cut s_any, s_record, 1, 1 $ift s_any = ")": dinc d_unformatted $ift s_any = "]": dinc d_unformatted s_previous = " " 'totals of char and bytes d_dot = 1 dwhi d_dot <= 70 $cut s_byte, s_record, d_dot, 1 $chd d_char, s_byte dift d_char > 32 dift d_char < 127 d_tchar = d_tchar + d_char dinc d_tbyte endi endi 'total of hash numbers d_mult1 = d_char * d_dot + d_mult1 d_mult2 = 71 - d_dot * d_char + d_mult2 d_mult3 = d_char * d_record + d_mult3 dift d_unformatted = 1 'do word count $ift s_previous = " " $cup s_byte, s_byte $ift s_byte >= "A" $ift s_byte <= "Z": dinc d_twords endi endi s_previous = s_byte endi dinc d_dot endw endi dinc d_record dift d_record > dg_list2: dinc d_loop endw dsec d_seconds2 d_seconds1 = d_seconds2 - d_seconds1 $out "file counts and totals" ded$ s_any, d_tline, 0, 0 $out " total lines=" + s_any ded$ s_any, d_tdele, 0, 0 $out " total deleted lines=" + s_any ded$ s_any, d_tbyte, 0, 0 $out "count of non-blank bytes=" + s_any ded$ s_any, d_tchar, 0, 0 $out "total of non-blank chars=" + s_any ded$ s_any, d_mult1, 0, 0 $out " total1 of char * spot=" + s_any ded$ s_any, d_mult2, 0, 0 $out " total2 of char * spot=" + s_any ded$ s_any, d_mult3, 0, 0 $out " total3 of char * record=" + s_any ded$ s_any, d_twords, 0, 0 $out " total words=" + s_any $out " Seconds=" + d_seconds1 ends sub_counts subr sub_book_html 'updated 2011/06/28, 2010/05/04 '2009/10/04, 2008/12/13, 2008/12/09, 2008/12/08, 2008/03/22 '2008/03/18, 2007/05/18, 2007/01/26, 2007/01/25, 2006/12/30 '2006/10/29, 2006/10/27, 2006/06/17, 2005/12/18, 2005/10/24 '2005/07/30, 2005/05/13, 2005/04/21, 2005/04/20, 2004/11/17 'prepare to output book records in HTML format vari d_any, s_any, d_dot, s_dot, s_pick vari d_loop, d_good, s_line, d_keywords, s_crlf, d_process vari s_title, s_description, s_keywords, d_which vari d_record, s_record, d_byte, d_long, s_previous vari s_dashline, s_date, d_count, s_homeurl, s_email vari s_lbrack, s_rbrack, s_dquote d_process = 1 'make s_crlf dch$ s_any, 13, 1 dch$ s_dot, 10, 1 s_crlf = s_any + s_dot dift d_process = 1 d_keywords = 2 $inp s_pick, "1=put in description and keywords" $ift s_pick = "*": dinc d_process $ift s_pick = "1": d_keywords = 1 endi dift d_process = 1 s_homeurl = " " $out "1=for link 'return to balcro.com'" $out "2=for link 'return to teapro.com'" $out "3=for link 'return to opentea.com'" $out "4=for link 'return to tinytea.com'" $out "5=for link 'return to c90tea.com'" $out "6=for link 'return to teaprime.com'" $out "7=for link 'return to teaquad.com'" $out "8=for link 'return to oklatea.com'" $out "9=for link 'return to okla64.com'" $out "10=for link 'return to alisabassano.com'" $out "11=none" $inp s_pick, "choose" $ift s_pick = "*": dinc d_process endi dift d_process <> 1: s_pick = "Z" dg_bookdomain = 0 s_homeurl = sg_nothing s_email = sg_nothing $ift s_pick = "1" s_homeurl = "balcro.com" s_email = "email01.jpg" dg_bookdomain = 1 endi $ift s_pick = "2" s_homeurl = "teapro.com" s_email = "email02.jpg" dg_bookdomain = 2 endi $ift s_pick = "3" s_homeurl = "opentea.com" s_email = "email02.jpg" dg_bookdomain = 3 endi $ift s_pick = "4" s_homeurl = "tinytea.com" s_email = "email02.jpg" dg_bookdomain = 4 endi $ift s_pick = "5" s_homeurl = "c90tea.com" s_email = "email02.jpg" dg_bookdomain = 5 endi $ift s_pick = "6" s_homeurl = "teaprime.com" s_email = "email03.jpg" dg_bookdomain = 6 endi $ift s_pick = "7" s_homeurl = "teaquad.com" s_email = "email02.jpg" dg_bookdomain = 7 endi $ift s_pick = "8" s_homeurl = "oklatea.com" s_email = "email02.jpg" dg_bookdomain = 8 endi $ift s_pick = "9" s_homeurl = "okla64.com" s_email = "email04.jpg" dg_bookdomain = 9 endi $ift s_pick = "10" s_homeurl = "alisabassano.com" dg_bookdomain = 10 endi $ift s_pick = "11" s_homeurl = sg_nothing dg_bookdomain = 11 endi 'dg_bookdomain=1 is balcro.com 'dg_bookdomain=2 is teapro.com 'dg_bookdomain=3 is opentea.com 'dg_bookdomain=4 is tinytea.com 'dg_bookdomain=5 is c90tea.com 'dg_bookdomain=6 is teaprime.com 'dg_bookdomain=7 is teaquad.com 'dg_bookdomain=8 is oklatea.com 'dg_bookdomain=9 is okla64.com 'dg_bookdomain=10 is alisabassano.com 'get the title, description, and keywords 'we can have three lines beginning with ]H ']H is a HTML title record s_title = sg_nothing s_description = sg_nothing s_keywords = sg_nothing d_which = 0 d_count = 0 d_record = dg_list1 d_loop = d_process dwhi d_loop = 1 'read a record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_loop dinc d_good endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 'stop at ]S,]C,]B,]M if not first record dift d_record > dg_list1 $cut s_any, s_record, 1, 2 $lok d_any, "]B,]C,]M,]S", 1, s_any dift d_any > 0 dinc d_good dinc d_loop endi endi endi dift d_good = 1 dinc d_count 'do we HTML title line with ]H $cut s_any, s_record, 1, 2 $ift s_any = "]H" dinc d_which $cut s_record, s_record, 1, 70 dift d_which = 1: $cut s_title, s_record, 3, 99 dift d_which = 2: $cut s_description, s_record, 3, 99 dift d_which = 3: $cut s_keywords, s_record, 3, 99 endi endi dinc d_record dift d_count > 50: dinc d_loop endw dift d_process = 1 'we always must have at least a title $len d_any, s_title dift d_process <> 1: d_any = 1 dift d_any = 0 s_any = "enter the title to reference the HTML document" $inp s_title, s_any $ift s_title = "*": dinc d_process endi $trb s_title, s_title endi dift d_process <> 1: d_keywords = 2 dift d_keywords = 1 'check to see if we have the description and keywords wanted $len d_any, s_description dift d_any = 0 s_any = "enter the description to reference " $app s_any, "the HTML document" $inp s_description, s_any $ift s_description = "*": dinc d_process endi $trb s_description, s_description $len d_any, s_keywords dift d_process <> 1: d_any = 1 dift d_any = 0 s_any = "enter the keywords to reference the " $app s_any, "HTML document" $inp s_keywords, s_any $ift s_keywords = "*": dinc d_process endi $trb s_keywords, s_keywords $len d_any, s_description dift d_any = 0: s_description = s_title $len d_any, s_keywords dift d_any = 0: s_keywords = s_description $out "the title, description, and keywords are:" $out s_title $out s_description $out s_keywords endi dift d_process = 1 'left and right brackets should not appear in literals here 'or this page may not show correctly on the internet dch$ s_lbrack, 60, 1 dch$ s_rbrack, 62, 1 'char 34 is the double quote " dch$ s_dquote, 34, 1 '12345678901234567890123456789012345 '27-MAY-2002 10:55:01 20020527105501 $dat s_date $cut s_date, s_date, 1, 11 'get the name of the file $tlo sg_filebook, sg_filebook 'delete the old file so we can build it new fdel d_any, sg_filebook 'initial html lines, character 34 is " s_line = s_lbrack + "HTML" + s_rbrack + s_crlf $app s_line, s_lbrack + "HEAD" + s_rbrack + s_crlf 'put in the title $app s_line, s_lbrack + "TITLE" + s_rbrack + s_crlf $app s_line, s_title + s_crlf $app s_line, s_lbrack + "/TITLE" + s_rbrack + s_crlf endi dift d_process <> 1: d_keywords = 2 dift d_keywords = 1 'description and keywords $app s_line, s_lbrack + "META NAME=" + s_dquote $app s_line, "DESCRIPTION" + s_dquote $app s_line, " CONTENT=" + s_dquote + s_description $app s_line, s_dquote + s_rbrack $app s_line, s_crlf $app s_line, s_lbrack + "META NAME=" + s_dquote $app s_line, "KEYWORDS" + s_dquote $app s_line, " CONTENT=" + s_dquote + s_keywords $app s_line, s_dquote + s_rbrack $app s_line, s_crlf $app s_line, s_lbrack + "META NAME=" + s_dquote $app s_line, "GENERATOR" + s_dquote $app s_line, " CONTENT=" + s_dquote $app s_line, "www.teapro.com/fixran.tea" $app s_line, s_dquote + s_rbrack $app s_line, s_crlf endi dift d_process = 1 'beginning of the body $app s_line, s_lbrack + "BODY" + s_rbrack + s_crlf endi 'dg_bookdomain=1 is balcro.com 'dg_bookdomain=2 is teapro.com 'dg_bookdomain=3 is opentea.com 'dg_bookdomain=4 is tinytea.com 'dg_bookdomain=5 is c90tea.com 'dg_bookdomain=6 is teaprime.com 'dg_bookdomain=7 is teaquad.com 'dg_bookdomain=8 is oklatea.com 'dg_bookdomain=9 is okla64.com 'dg_bookdomain=10 is alisabassano.com 'dg_bookdomain=11 is not any $len d_dot, s_homeurl $len d_any, s_email dift d_any = 0: d_dot = 0 dift d_process <> 1: d_dot = 0 dift d_dot > 1 'email $app s_line, s_lbrack + "HR" + s_rbrack + s_crlf $app s_line, s_lbrack + "IMG SRC=" + #"# + "http://www." dift dg_bookdomain = 1 $app s_line, "balcro.com/" + s_email + #"# endi dift dg_bookdomain <> 1 $app s_line, "teapro.com/" + s_email + #"# endi $app s_line, s_rbrack + s_crlf 'Home Page for BalCro $app s_line, s_lbrack + "HR" + s_rbrack + s_crlf $app s_line, s_lbrack + "A HREF=" + s_dquote + "http://www." $app s_line, s_homeurl + s_dquote + s_rbrack + "return to " $app s_line, s_homeurl + s_lbrack +"/A" + s_rbrack + s_crlf endi dift d_process = 1 'put in the pre to make the book a literal page $app s_line, s_lbrack + "PRE" + s_rbrack + s_crlf 'output to a text file dg_bookpageline = 0 sg_pass1 = s_line sub_book_lineout endi dg_pass1 = d_process ends sub_book_html subr sub_book_write 'updated 2008/12/13, 2008/12/12, 2008/12/08, 2007/08/28, 2006/12/30 '2006/06/17, 2005/11/26, 2005/10/08, 2005/04/20, 2004/09/28 'output records listed to a text file to be printed vari d_any, s_any, d_dot, s_dot, s_out vari s_beg, s_blanks, s_lbrack, s_rbrack, s_crlf vari d_loop, d_good, d_more, s_putline vari s_time, s_date, d_seconds1, d_seconds2 vari d_yesbookindex, d_yeschapter, d_yesname vari d_nounderlines, d_yeshtml, d_yesstopatstop vari d_yeschapnewpage, d_nochaphead, d_firstchaprec vari s_record, d_byte, s_byte, d_long vari d_chapterlength, d_count, d_process d_process = 1 dch$ s_blanks, 32, 1 'make s_crlf dch$ s_crlf, 13, 1 dch$ s_any, 10, 1 $app s_crlf, s_any dg_bookchartot = 0 dg_bookcharhash = 0 dg_bookdomain = 1 dift d_process = 1 $out sg_filebook $inp s_any, "enter book output file name" $ift s_any = "*": dinc d_process $tlo s_any, s_any $len d_any, s_any dift d_any > 1: sg_filebook = s_any endi dift d_process = 1 d_yeshtml = 2 $inp s_any, "1=html file, 2=text file" $ift s_any = "*": dinc d_process $ift s_any = "1": d_yeshtml = 1 endi dift d_process = 1 d_yesbookindex = 2 $inp s_any, "1=book index, 2=no index" $ift s_any = "*": dinc d_process $ift s_any = "1": d_yesbookindex = 1 endi dift d_process = 1 $inp s_any, "lines per page ie. default=57" $ift s_any = "*": dinc d_process $isd d_any, s_any dift d_any <> 1: s_any = "57" $tod dg_booklinesper, s_any endi dift d_process = 1 dg_bookleftmargin = 0 $inp s_any, "spaces in left margin" $ift s_any = "*": dinc d_process $isd d_any, s_any dift d_any = 1: $tod dg_bookleftmargin, s_any endi dift d_process = 1 d_yesstopatstop = 2 $inp s_any, "1=stop at a stop line ]STOP, 2=do not stop" $ift s_any = "*": dinc d_process $ift s_any = "1": d_yesstopatstop = 1 endi dift d_process = 1 dg_ynbookpaging = 2 $inp s_any, "1=page numbers" $ift s_any = "*": dinc d_process $ift s_any = "1": dg_ynbookpaging = 1 endi dift d_process = 1 d_nounderlines = 2 $inp s_any, "1=no underlines" $ift s_any = "*": dinc d_process $ift s_any = "1": d_nounderlines = 1 endi d_yeschapnewpage = 2 d_nochaphead = 2 dift d_process <> 1: dinc dg_ynbookpaging dift dg_ynbookpaging = 1 d_yeschapnewpage = 2 $inp s_any, "1=chapters begin on new page" $ift s_any = "*": dinc d_process $ift s_any = "1": d_yeschapnewpage = 1 endi dift d_process <> 1: dinc dg_ynbookpaging dift dg_ynbookpaging = 1 d_nochaphead = 2 $inp s_any, "1=do not show chapter headings" $ift s_any = "*": dinc d_process $ift s_any = "1": d_nochaphead = 1 endi dift d_process <> 1: dinc d_yeshtml dift d_yeshtml = 1 sub_book_html dift dg_pass1 <> 1: dinc d_process else sg_filebook = sg_filecode + ".TXT" 'delete the file so we can build it new fdel d_any, sg_filebook endi dsec d_seconds1 '12345678901234567890123456789012345 '27-MAY-2002 10:55:01 20020527105501 $dat s_date $cut s_time, s_date, 13, 5 $cut s_date, s_date, 1, 11 'initialize the book global variables d_count = 0 sg_bookchapter = sg_nothing sg_booksort = sg_nothing sg_booknames = "#" sg_bookinfo = "#" dg_bookpagenum = 0 dg_bookpageline = 500 d_firstchaprec = 0 dg_bookrecord = dg_list1 d_loop = d_process dwhi d_loop = 1 'tell d_any = dg_bookrecord % 100 dift d_any = 0: $sho "book=" + dg_bookrecord 'read a record d_byte = dg_bookrecord - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record d_good = 1 dift d_long <> 72 dinc d_loop dinc d_good endi dift d_good = 1 $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 'we have a record dinc d_count $cut s_record, s_record, 1, 70 ']H is HTML title, ]N is silent note, ]U is update 'do we have a do not print line $cut s_beg, s_record, 1, 2 $ift s_beg = "]H": dinc d_good $ift s_beg = "]N": dinc d_good $ift s_beg = "]U": dinc d_good 'do we have a stop at line and do we want to stop $cut s_beg, s_record, 1, 5 $ift s_beg = "]STOP" dg_pass1 = dg_bookrecord sub_record_show dinc d_good dift d_yesstopatstop = 1: dinc d_loop endi $ift s_beg = "]BOOK" dg_pass1 = dg_bookrecord sub_record_show dinc d_good endi endi dift d_good = 1 'we have a record to output $trr s_record, s_record 'do we have a chapter line d_yeschapter = 2 $cut s_beg, s_record, 1, 2 $ift s_beg = "]C": d_yeschapter = 1 'do we have a name record d_yesname = 2 $lok d_dot, s_record, 1, "-" dift d_dot > 0 d_dot = d_dot + 3 $cut s_dot, s_record, d_dot, 1 $ift s_dot <> "@": d_yesname = 1 endi 'DATESTRING$ $lok d_dot, s_record, 1, "DATESTRING$" dift d_dot > 0: $rep s_record, d_dot, s_date 'TIME$ $lok d_dot, s_record, 1, "TIME$" dift d_dot > 0: $rep s_record, d_dot, s_time 'if book then build county and name index dift d_yesbookindex = 1 'send the record only if it has something 'for the index $lok d_dot, s_record, 1, "_" dift d_dot > 0 sg_pass1 = s_record sub_book_get_info endi endi 'remove name tags dift d_nounderlines = 1 d_more = 1 dwhi d_more = 1 $lok d_dot, s_record, 1, "_" dift d_dot = 0 dinc d_more else $del s_record, d_dot, 4 endi endw endi 'if book then build chapter index dift d_yesbookindex = 1 'if chapter save for chapter index $cut s_beg, s_record, 1, 2 $ift s_beg = "]C" dch$ s_blanks, 32, 70 s_putline = s_record + s_blanks $cut s_putline, s_putline, 2, 66 dto$ s_any, dg_bookpagenum, 4, 0 $app s_putline, s_any + s_blanks $cut s_putline, s_putline, 1, 70 sg_bookchapter = sg_bookchapter + s_putline endi endi 'chapter heading, lines before and after dift d_yeschapter = 1 dift dg_ynbookpaging = 1 dift d_yeschapnewpage = 1 sub_book_chapter_length d_chapterlength = dg_pass1 dift d_firstchaprec = 0 d_chapterlength = 9999 endi 'how many lines do we have left on this page d_any = dg_booklinesper - dg_bookpageline dift d_any <= d_chapterlength sub_book_force_newpage endi d_firstchaprec = dg_bookrecord endi 'if near the bottom go to the next page d_any = dg_booklinesper - dg_bookpageline dift d_any < 6: sub_book_force_newpage 'output blank line dift dg_bookpageline > 1: sub_book_blank_line 'output line of asterisks dift d_nochaphead <> 1: sub_book_aster_line else sub_book_aster_line endi endi 'remove ) and ]C and ]R and ] $cut s_beg, s_record, 1, 2 $ift s_beg = "]R": $cut s_record, s_record, 3, 100 $ift s_beg = "]-": $ch$ s_record, "-", 70 $ift s_beg = "]B": $cut s_record, s_record, 2, 100 $ift s_beg = "]C": $cut s_record, s_record, 2, 100 $ift s_beg = "]M": $cut s_record, s_record, 2, 100 $ift s_beg = "]S": $cut s_record, s_record, 2, 100 $ift s_beg = "]U": $cut s_record, s_record, 2, 100 $ift s_beg = "]L": $cut s_record, s_record, 4, 100 $ift s_beg = "]E": $cut s_record, s_record, 4, 100 $cut s_beg, s_record, 1, 1 $ift s_beg = ")": $cut s_record, s_record, 3, 100 $ift s_beg = "]": $cut s_record, s_record, 3, 100 'do we need to delete a space for a chap + name d_any = d_yeschapter * d_yesname dift d_any = 1 $lok d_any, s_record, 1, " " dift d_any = 0: $lok d_any, s_record, 1, " " dift d_any > 0: $del s_record, d_any, 1 endi 'do we need to expand CHAP: to CHAPTER: '12345678901 'CHAP: 123: $cut s_beg, s_record, 1, 5 $ift s_beg = "CHAP:" 'do we need to expand to CHAPTER d_dot = 1 'must have chapter number $cut s_any, s_record, 7, 3 $isd d_any, s_any dift d_any <> 1: dinc d_dot 'must have room for 2 more letters $trr s_any, s_record $len d_any, s_any dift d_any >= 68: dinc d_dot dift d_dot = 1 $ins s_record, 5, "TER" $cut s_record, s_record, 1, 70 endi endi 'output s_record to text file dift d_yeschapter <> 1 sg_pass1 = s_record sub_book_line_page else dift d_nochaphead <> 1 sg_pass1 = s_record sub_book_line_page 'is the next line ]Updated dg_pass1 = dg_bookrecord + 1 sub_next_undeleted_record s_dot = sg_pass1 $cut s_beg, s_dot, 1, 2 $ift s_beg = "]U" 'we have ]Updated so output $cut s_dot, s_dot, 2, 99 sg_pass1 = s_dot sub_book_line_page endi sub_book_aster_line endi endi endi dinc dg_bookrecord dift dg_bookrecord > dg_list2: dinc d_loop endw dift d_process <> 1: dinc d_yesbookindex dift d_yesbookindex = 1 'sort the string sg_booksort $len d_any, sg_booksort $out "length of sg_booksort=" + d_any $sor sg_booksort, sg_booksort, 50 'output the county index sub_book_indices_out endi dift d_process = 1 dift dg_bookdomain <> 11 'put on the ending lines $dat s_any $cut s_any, s_any, 1, 20 dift d_yeshtml = 1 sg_pass1 = "End of Webpage, " + s_any else sg_pass1 = "End of Document, " + s_any endi sub_book_lineout sg_pass1 = "Created by program: " $app sg_pass1, "www.teapro.com/fixran.tea" sub_book_lineout endi endi 'if doing HTML then put on the ending dift d_process <> 1: dinc d_yeshtml dift d_yeshtml = 1 'put brackets in fields dch$ s_lbrack, 60, 1 dch$ s_rbrack, 62, 1 'put on the html ending s_out = s_lbrack + "/PRE" + s_rbrack + s_crlf $app s_out, s_lbrack + "/BODY" + s_rbrack + s_crlf $app s_out, s_lbrack + "/HTML" + s_rbrack 'output to a text file sg_pass1 = s_out sub_book_lineout endi dift d_process = 1 $len d_long, sg_booknames $out "length of sg_booknames=" + d_long $len d_long, sg_bookinfo $out "length of sg_bookinfo=" + d_long $len d_long, sg_booksort $out "length of sg_booksort=" + d_long ded$ s_any, dg_bookchartot, 0 ,0 $out "bookchartot=" + s_any ded$ s_any, dg_bookcharhash, 0 ,0 $out "bookcharhash=" + s_any 'seconds dsec d_seconds2 d_seconds2 = d_seconds2 - d_seconds1 $out "seconds=" + d_seconds2 sub_path_prog_memory endi ends sub_book_write subr sub_book_chapter_length 'updated 2002/04/16 'get the chapter length in lines vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_lines, d_loop, d_good vari d_begin d_record = dg_bookrecord d_begin = d_record d_lines = 0 d_loop = 1 dwhi d_loop = 1 d_good = 1 d_dot = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_dot, 72 $len d_any, s_record dift d_any <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 1, 2 $ift s_any = "]C" dift d_record <> d_begin: dinc d_loop else dinc d_lines endi endi dinc d_record endw dg_pass1 = d_lines ends sub_book_chapter_length subr sub_book_lineout 'updated 2008/12/12, 2008/12/08, 2005/11/26, 2004/10/20 'output book line in sg_pass1 to sg_filebook vari d_any, s_any, d_dot, s_dot vari d_long, s_out s_out = sg_pass1 'add to dg_bookchartot and dg_bookcharhash $len d_long, s_out d_dot = 1 dwhi d_dot <= d_long $cut s_dot, s_out, d_dot, 1 $chd d_any, s_dot dg_bookchartot = dg_bookchartot + d_any dg_bookcharhash = d_any * d_dot + dg_bookcharhash dinc d_dot endw dift dg_bookleftmargin > 0 $ch$ s_any, " ", dg_bookleftmargin s_out = s_any + s_out endi 'append the line to the file fapp d_any, sg_filebook, s_out dbad d_any = 0 'dg_bookpageline holds the number of the line just outputted dinc dg_bookpageline ends sub_book_lineout subr sub_book_force_newpage 'updated 2002/04/17 'force a new page vari d_beginpage d_beginpage = dg_bookpagenum sub_book_newpage dwhi d_beginpage = dg_bookpagenum sg_pass1 = " " sub_book_lineout sub_book_newpage endw ends sub_book_force_newpage subr sub_book_newpage 'updated 2002/05/16 'do a new page if dg_bookpageline is greater than dg_booklinesper vari d_any, s_any, d_dot, s_dot vari s_blanks vari s_line, s_num, s_date vari d_record, s_nextline dch$ s_blanks, 32, 1 'do we want a new page if one is needed dift dg_ynbookpaging = 1 'do we have a new page dift dg_bookpageline >= dg_booklinesper 'start counting the lines all over dg_bookpageline = 0 'increment the page number dinc dg_bookpagenum '12345678901234567890123456789012345 '27-MAY-2002 10:55:01 20020527105501 $dat s_date $cut s_date, s_date, 1, 11 dch$ s_blanks, 32, 30 s_line = s_blanks + "Page ." + dg_bookpagenum + "." dch$ s_blanks, 32, 10 $app s_line, s_blanks + s_date 'output to text or book file sg_pass1 = s_line sub_book_lineout endi else 'start counting the lines all over dg_bookpageline = 0 endi ends sub_book_newpage subr sub_book_line_page 'updated 1998/04/03 'output a line with paging if needed, input sg_pass1 vari s_line 'do a new page if needed s_line = sg_pass1 sub_book_newpage 'output the line sg_pass1 = s_line sub_book_lineout ends sub_book_line_page subr sub_book_blank_line 'updated 1998/04/03 'output a blank line with paging if wanted and needed sg_pass1 = " " sub_book_line_page ends sub_book_blank_line subr sub_book_aster_line 'updated 2001/11/01 'output a asterisk line with paging if wanted and needed $ch$ sg_pass1, "*", 70 sub_book_line_page ends sub_book_aster_line subr sub_book_get_info 'updated 2001/04/28 'build index for book, sg_pass1 has the record 'dg_bookpagenum has the page 'names go into sg_booknames and to sg_booksort 'sg_bookinfo will have the info vari d_any, s_any, d_dot, s_dot vari s_blanks vari s_line, s_lnametag, s_fname, s_dtag, s_info, s_page, d_page vari d_loop, d_beg, d_end, s_byte, d_long, d_byte s_line = sg_pass1 + " " dch$ s_blanks, 32, 1 'do we have a formatted line $cut s_any, s_line, 1, 1 $ift s_any = ")" 'we have a formatted line, only one name, but maybe info $lok d_dot, s_line, 1, "_" 'get the name d_end = d_dot + 3 'get the last name with tag $bak d_beg, s_line, d_end, " " $bak d_any, s_line, d_end, "," dift d_any > d_beg: d_beg = d_any d_long = d_end - d_beg dinc d_beg $cut s_lnametag, s_line, d_beg, d_long 'take the hyphen out if any $lok d_any, s_lnametag, 1, "-" dift d_any > 0: $rep s_lnametag, d_any, " " 'put the name and page number into sg_booknames, sg_booksort 'page is in dg_bookpagenum sg_pass1 = s_lnametag sub_book_save_info 'do we have a person and info $cut s_any, s_line, d_end, 1 $ift s_any <> "@" 'do we have s_lnametag already in sg_bookinfo $lok d_byte, sg_bookinfo, 1, s_lnametag dift d_byte = 0 'we do not have s_lname in sg_bookinfo 'get the info which is F.1910-1996 $cut s_info, s_line, 60, 11 'get the floating descent tag if any dch$ s_blanks, 32, 12 s_dtag = s_blanks $lok d_any, s_line, 1, "\" dift d_any > 0 $cut s_dtag, s_line, d_any, 99 $lok d_any, s_dtag, 1, " " ddec d_any $cut s_dtag, s_dtag, 1, d_any $len d_any, s_dtag dift d_any < 12 dch$ s_any, 32, 12 $app s_dtag, s_any $cut s_dtag, s_dtag, 1, 12 endi endi 'get the first part of the name too d_end = d_beg - 2 $bak d_beg, s_line, d_end, ":" dift d_beg = 0: $bak d_beg, s_line, d_end, ")" d_beg = d_beg + 2 d_long = d_end - d_beg + 1 $cut s_fname, s_line, d_beg, d_long 'store whole name in sg_booksort sg_pass1 = s_fname sg_pass2 = s_lnametag sub_book_name_for_sort 'put into sg_bookinfo $app s_info, " " + s_dtag + " " + s_lnametag + ", " $app s_info, s_fname sg_bookinfo = sg_bookinfo + s_info + "#" endi endi else 'we have an unformatted line d_loop = 1 dwhi d_loop = 1 $lok d_dot, s_line, 1, "_" dift d_dot > 1 'find the beginning of the lname $bak d_beg, s_line, d_dot, " " $bak d_any, s_line, d_dot, "," dift d_any > d_beg: d_beg = d_any dinc d_beg d_long = d_dot + 4 - d_beg $cut s_lnametag, s_line, d_beg, d_long 'take the hyphen out if any $lok d_any, s_lnametag, 1, "-" dift d_any > 0: $rep s_lnametag, d_any, " " 'put the name and page number into sg_all 'page is already in dg_bookpagenum sg_pass1 = s_lnametag sub_book_save_info 'delete that name from s_line $del s_line, d_beg, d_long else dinc d_loop endi endw endi ends sub_book_get_info subr sub_book_save_info 'updated 1998/04/03 'the last name with tag is in sg_pass1, page is in dg_bookpagenum 'store in sg_booknames with the page number 'also store in sg_booksort to be sorted vari d_any, s_any, d_dot, s_dot, s_blanks vari s_lnametag, s_page, d_beg, d_end, d_yes s_lnametag = sg_pass1 dch$ s_blanks, 32, 1 'prep the page s_page = "," + dg_bookpagenum 'do we have a last name of sg_pass1 $lok d_beg, sg_booknames, 1, s_lnametag 'we have it dift d_beg > 0 'do we have that page $lok d_dot, sg_booknames, d_beg, s_page $lok d_end, sg_booknames, d_beg, "#" d_yes = 0 dift d_dot > 0 dift d_dot < d_end: d_yes = 1 endi dift d_yes = 0 'put page in $ins sg_booknames, d_end, s_page endi else 'add to sg_booksort, the first 29 will hold the name to sort dch$ s_blanks, 32, 30 s_any = s_blanks + s_lnametag + s_blanks $cut s_any, s_any, 1, 50 sg_booksort = sg_booksort + s_any 'add this last name and page sg_booknames = sg_booknames + s_lnametag + s_page + "#" endi ends sub_book_save_info subr sub_book_name_for_sort 'updated 1998/04/03 'first part of the name is in sg_pass1, store in sg_booksort 'the last name with tag is in sg_pass2 vari d_any, s_any, d_dot, s_dot vari s_fname, s_lnametag, s_sortname s_fname = sg_pass1 s_lnametag = sg_pass2 'is the s_lnametag in sg_booksort $lok d_dot, sg_booksort, 1, s_lnametag dift d_dot > 0 'get the sort name with out the tag $lok d_any, s_lnametag, 1, "_" ddec d_any $cut s_any, s_lnametag, 1, d_any s_sortname = s_any + ", " + s_fname $cut s_sortname, s_sortname, 1, 30 d_dot = d_dot - 30 $rep sg_booksort, d_dot, s_sortname endi ends sub_book_name_for_sort subr sub_book_indices_out 'updated 1998/04/03 'output the county index, the person index and the chapter index 'the sorted ones are each 50 long in sg_booksort 'the names with pages are in sg_booknames 'the info is in sg_bookinfo 'the book line and page are in dg_bookpageline, dg_bookpagenum vari d_any, s_any, d_dot, s_dot, s_blanks vari d_loop1, d_loop2, d_byte, d_sortlen, s_key, d_spot, s_line vari d_beg, d_end, d_long, s_name, s_state, s_pages, s_info vari d_count, d_page, d_numx, d_tell dch$ s_blanks, 32, 1 'do we have counties $lok d_any, sg_booksort, 1, "@" dift d_any > 0 'output the county index $ch$ sg_pass1, "*", 70 sub_book_wrap_out sg_pass1 = "County Index" sub_book_wrap_out $ch$ sg_pass1, "*", 70 sub_book_wrap_out $len d_sortlen, sg_booksort d_tell = 0 d_count = 0 d_byte = 1 d_loop1 = 1 dwhi d_loop1 = 1 dinc d_tell d_any = d_tell % 100 dift d_any = 0: $sho "county index=" + d_tell 'get the whole 50 first $cut s_key, sg_booksort, d_byte, 50 'get the 20 which has the lnametag in it $cut s_key, s_key, 31, 20 $trr s_key, s_key 'do we have a county $lok d_spot, s_key, 1, "@" dift d_spot > 0 dinc d_count 'get the line $lok d_beg, sg_booknames, 1, s_key dift d_beg > 0 $lok d_end, sg_booknames, d_beg, "#" 'we do not want the # d_long = d_end - d_beg $cut s_line, sg_booknames, d_beg, d_long 'get the name, state and pages $lok d_end, s_line, 1, "_" ddec d_end $cut s_name, s_line, 1, d_end dch$ s_blanks, 32, 20 $app s_name, " Co" + s_blanks $cut s_name, s_name, 1, 15 d_end = d_end + 2 $cut s_state, s_line, d_end, 2 d_end = d_end + 4 $cut s_pages, s_line, d_end, 1000 sg_pass1 = s_name + s_state + " " + s_pages dg_pass1 = 21 sub_book_wrap_out endi endi d_byte = d_byte + 50 dift d_byte >= d_sortlen: dinc d_loop1 endw sg_pass1 = "Count of counties=" + d_count dg_pass1 = 1 sub_book_wrap_out endi 'output the person index $ch$ sg_pass1, "*", 70 sub_book_wrap_out sg_pass1 = "Person Index" sub_book_wrap_out $ch$ sg_pass1, "*", 70 sub_book_wrap_out $len d_sortlen, sg_booksort d_tell = 0 d_count = 0 d_byte = 1 d_loop1 = 1 dwhi d_loop1 = 1 dinc d_tell d_any = d_tell % 100 dift d_any = 0: $sho "person index=" + d_tell 'get the whole 50 first $cut s_key, sg_booksort, d_byte, 50 'get the 20 which has the lnametag in it $cut s_key, s_key, 31, 20 $trr s_key, s_key 'do we have a person $lok d_spot, s_key, 1, "@" dift d_spot = 0 dinc d_count 'get the info line $lok d_spot, sg_bookinfo, 1, s_key dift d_spot > 0 'get the beginning and the ending $bak d_beg, sg_bookinfo, d_spot, "#" dinc d_beg $lok d_end, sg_bookinfo, d_beg, "#" d_long = d_end - d_beg 'we do not want the #, take out the code $cut s_info, sg_bookinfo, d_beg, d_long $lok d_beg, s_info, 1, "_" $del s_info, d_beg, 4 'if missing F.1910-1996 put 11 spaces in front $cut s_any, s_info, 1, 11 $ch$ s_dot, " ", 11 $ift s_any = s_dot: s_info = s_dot + s_info else 'output the name with the name tag too s_info = s_key endi 'get the pages $lok d_beg, sg_booknames, 1, s_key dift d_beg > 0 $lok d_end, sg_booknames, d_beg, "#" 'we do not want the # d_long = d_end - d_beg $cut s_line, sg_booknames, d_beg, d_long 'get the pages $lok d_end, s_line, 1, "_" d_end = d_end + 5 $cut s_pages, s_line, d_end, 5000 sg_pass1 = s_info + " " + s_pages dg_pass1 = 35 sub_book_wrap_out endi endi d_byte = d_byte + 50 dift d_byte >= d_sortlen: dinc d_loop1 endw sg_pass1 = "Count of persons=" + d_count dg_pass1 = 1 sub_book_wrap_out 'output the chapter index $out "Chapter Index" $ch$ sg_pass1, "*", 70 sub_book_wrap_out sg_pass1 = "Chapter Index" sub_book_wrap_out $ch$ sg_pass1, "*", 70 sub_book_wrap_out d_count = 0 d_loop1 = 1 dwhi d_loop1 = 1 dinc d_count d_any = d_count % 100 dift d_any = 0: $sho "chapters=" + d_count 'get the record $cut s_info, sg_bookchapter, 1, 70 $cut sg_bookchapter, sg_bookchapter, 71, 99999 sg_pass1 = s_info sub_book_line_page $len d_long, sg_bookchapter dift d_long = 0: dinc d_loop1 endw ends sub_book_indices_out subr sub_book_wrap_out 'updated 2000/11/24 'output to book a line that may wrap, line is in sg_pass1 'dg_pass1 has the starting point of the pages on next lines vari d_loop, s_line, s_out, d_long, d_dot, d_beg, d_wraplong vari s_blanks s_line = sg_pass1 d_beg = dg_pass1 s_blanks = sg_nothing d_wraplong = 70 d_loop = 1 dwhi d_loop = 1 $len d_long, s_line dift d_long > d_wraplong $bak d_dot, s_line, d_wraplong, "," dift d_dot = 0: d_dot = d_wraplong $cut s_out, s_line, 1, d_dot dinc d_dot $cut s_line, s_line, d_dot, 5000 'output a line sg_pass1 = s_blanks + s_out sub_book_line_page 'after first reset d_wraplong d_wraplong = 70 - d_beg $ch$ s_blanks, " ", d_beg else sg_pass1 = s_blanks + s_line sub_book_line_page dinc d_loop endi endw ends sub_book_wrap_out subr sub_text_file_out 'updated 2004/10/21 'output to text file sg_pass1 the record in sg_pass1 'at byte dg_textbyte with CRLF vari d_any, s_any vari s_line, d_long, s_char13, s_char10 s_line = sg_pass2 dch$ s_char13, 13, 1 dch$ s_char10, 10, 1 $trr s_line, s_line $app s_line, s_char13 + s_char10 fwri d_any, sg_pass1, dg_textbyte, s_line dbad d_any = 0 $len d_long, s_line dg_textbyte = dg_textbyte + d_long ends sub_text_file_out subr sub_get_filenames 'updated 2010/04/14, 2009/08/12 '2009/08/11, 2007/02/07, 2005/04/07, 2005/01/20, 2004/06/02 'get and validate the fixran filenames vari s_any, d_any, s_dot, d_dot, s_out vari d_loop, s_aster, d_date1, d_date2, d_long vari s_date1, s_date2, s_chars, d_notexist vari d_byte, s_byte, d_needimport, d_goodname 'initialize the fixran filenames sg_fileran = sg_nothing sg_fileexp = sg_nothing sg_filetxt = sg_nothing sg_filecode = sg_nothing sg_filebook = sg_nothing d_goodname = 2 d_loop = 1 dwhi d_loop = 1 d_goodname = 1 $out "letters, numbers and underlines can be used" s_any = "enter the one to eight byte fixran file code, " $app s_any, "ie. fixstone" $inp sg_filecode, s_any 'trim, uppercase, length $trb sg_filecode, sg_filecode $clo sg_filecode, sg_filecode $len d_long, sg_filecode 'length 1 to 5 dift d_long < 1: dinc d_goodname dift d_long > 8: dinc d_goodname dift d_goodname = 1 'validate for correct characters s_chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_" $clo s_chars, s_chars d_byte = 1 dwhi d_byte <= d_long $cut s_byte, sg_filecode, d_byte, 1 $lok d_dot, s_chars, 1, s_byte dift d_dot = 0: dinc d_goodname dinc d_byte endw endi 'if * then end, d_goodname is already > 1 $ift sg_filecode = "*": dinc d_loop 'if good then done with loop dift d_goodname = 1: dinc d_loop endw 'build filenames d_notexist = 2 d_needimport = 2 dift d_goodname = 1 sg_fileran = sg_filecode + ".ran" sg_fileexp = sg_filecode + ".exp" sg_filetxt = sg_filecode + ".txt" sg_filebook = sg_filecode + ".html" 'dg_mode: 1=normal, 2=money, 3=RPG, 4=chef, 5=prog dg_mode = 1 $ift sg_filecode = "fixmoney": dg_mode = 2 $ift sg_filecode = "fixchef": dg_mode = 4 $ift sg_filecode = "rpgtoc": dg_mode = 5 $ift sg_filecode = "rpgtopl": dg_mode = 5 'fixrpg1,fixrpg9, dg_mode=3 for RPG $cut s_any, sg_filecode, 1, 6 $ift s_any = "fixrpg": dg_mode = 3 'rpg0612,rpg0701, dg_mode=3 for RPG $cut s_any, sg_filecode, 1, 3 $ift s_any = "rpg" $cut s_any, sg_filecode, 4, 4 $isd d_any, s_any dift d_any = 1: dg_mode = 3 endi $ch$ s_aster, "*", 76 $out s_aster 'do we have a .toe file s_dot = sg_filecode + ".toe" flen d_long, s_dot dift d_long > 0 s_out = "file exists=" + s_dot + " length=" + d_long $out s_out endi sg_pass1 = sg_fileran flen d_long, sg_pass1 sub_fixran_get_file_date s_date1 = sg_pass1 d_date1 = dg_pass1 s_any = "the file date for " + sg_fileran + " is " $app s_any, s_date1 + " length=" + d_long $out s_any sg_pass1 = sg_fileexp flen d_long, sg_pass1 sub_fixran_get_file_date s_date2 = sg_pass1 d_date2 = dg_pass1 s_any = "the file date for " + sg_fileexp + " is " $app s_any, s_date2 + " length=" + d_long $out s_any dift d_date1 = 0 dift d_date2 = 0 d_notexist = 1 s_any = "files " + sg_fileran $app s_any, " and " + sg_fileexp $app s_any, " do not exist" $inp s_any, s_any endi endi 'is the .exp file newer dift d_date2 > d_date1 s_any = "the file " + sg_fileexp $app s_any, " is newer than the file " $app s_any, sg_fileran $out s_any d_needimport = 1 sub_more endi $out s_aster endi 'put results of this in dg_pass1 to carry to calling sub 'send a value to dg_pass1 = d_goodname dg_pass2 = d_needimport dg_pass3 = d_notexist ends sub_get_filenames subr sub_file_new 'updated 2005/06/18, 2005/04/06, 2004/10/21 'build a new fixran file vari d_any, s_any, d_dot, s_dot vari s_char10, d_build, d_loop, d_count, d_good vari s_putline, s_dateline, s_nowdate, s_blanks vari d_record, s_record, d_byte, d_long vari s_hold1, s_hold2 dch$ s_char10, 10, 1 'do we have this fixran file, try reading record one s_hold1 = sg_nothing s_hold2 = sg_nothing d_build = 2 d_count = 0 d_record = 1 d_loop = 1 dwhi d_loop = 1 d_good = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_long, s_record dift d_long <> 72 dinc d_loop dinc d_good endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 dinc d_count dift d_count >= 2: dinc d_loop dift d_count = 1: $cut s_hold1, s_record, 1, 70 dift d_count = 2: $cut s_hold2, s_record, 1, 70 endi endw dift d_good = 1 $out "The first two records are as follows:" $out "1 " + s_hold1 $out "2 " + s_hold2 $inp s_any, "1=build new file" d_build = 2 $ift s_any = "1": d_build = 1 else d_build = 1 endi dift d_build = 1 'build a new file fdel d_any, sg_fileran 'put in a record with the name of the file in it '12345678901234567890123456789012345 '27-MAY-2002 10:55:01 20020527105501 $dat s_nowdate '12345678901234 '20020527105501 $cut s_nowdate, s_nowdate, 22, 14 $ins s_nowdate, 13, ":" $ins s_nowdate, 11, ":" $ins s_nowdate, 9, " " $ins s_nowdate, 7, "/" $ins s_nowdate, 5, "/" dch$ s_blanks, 32, 80 s_putline = "]R MADE: " + s_nowdate $app s_putline, " fixran file=" + sg_fileran $app s_putline, s_blanks $cut s_putline, s_putline, 1, 70 $app s_putline, "W" + s_char10 d_record = 1 d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_putline dbad d_any = 0 'put in top date line record s_dateline = "]R DATE: " + s_nowdate $app s_dateline, " fixran file=" + sg_fileran $app s_dateline, s_blanks $cut s_dateline, s_dateline, 1, 70 $app s_dateline, "W" + s_char10 dinc d_record d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_dateline dbad d_any = 0 'put in bottom dateline record dinc d_record d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_dateline dbad d_any = 0 'put in a last line dch$ s_blanks, 32, 80 s_putline = "]R LAST: " + s_nowdate + " fixran file=" $app s_putline, sg_fileran + s_blanks $cut s_putline, s_putline, 1, 70 $app s_putline, "W" + s_char10 dinc d_record d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_putline dbad d_any = 0 $out "file created=" + sg_fileran $inp s_any, "return" endi ends sub_file_new subr sub_fixran_export 'updated 2008/11/05, 2008/11/02, 2008/02/16, 2008/02/13 '2006/05/24, 2006/05/09, 2005/04/30, 2005/04/11, 2005/04/09 '2005/04/07, 2005/04/06, 2005/04/05, 2004/11/05 'export the file to a .EXP file vari d_any, s_any, d_dot, s_dot, s_tap, s_out, d_out vari d_record, s_record, d_byte, s_byte, d_long, d_ctout vari d_good, d_loop, s_exportline, s_beg, d_updtneed vari d_seconds, s_seconds, s_line, d_update vari s_file1, s_file2, s_file3, s_file4 vari d_count, d_last, s_data, d_yesbyrecords vari s_50data, d_50count, d_50mode, s_char10 vari s_nowdate, s_newdate, s_olddate d_updtneed = 1 d_50mode = 1 '$inp s_any, "1 = by 50 else by each" '$ift s_any = "1": d_50mode = 1 'make s_char10 dch$ s_char10, 10, 1 d_yesbyrecords = 1 'do we have a really big file dpow d_any, 10, 6 flen d_long, sg_fileran dift d_long >= d_any d_yesbyrecords = 1 endi 'get the new_date into s_nowdate 20 long space on end '12345678901234567890123456789012345 '27-MAY-2002 10:55:01 20020527105501 $dat s_nowdate '12345678901234567890 '20020527105501 '2002/05/27 10:55:01 = 19 long old_date was 20 $cut s_nowdate, s_nowdate, 22, 14 $ins s_nowdate, 13, ":" $ins s_nowdate, 11, ":" $ins s_nowdate, 9, " " $ins s_nowdate, 7, "/" $ins s_nowdate, 5, "/" $app s_nowdate, " " dift d_yesbyrecords > 0 'export backups file names s_file1 = sg_filecode + ".ex1" s_file2 = sg_filecode + ".ex2" s_file3 = sg_filecode + ".ex3" s_file4 = sg_filecode + ".ex4" $clo sg_fileexp, sg_fileexp fdel d_any, s_file4 fren d_any, s_file4, s_file3 fdel d_any, s_file3 fren d_any, s_file3, s_file2 fdel d_any, s_file2 fren d_any, s_file2, s_file1 fdel d_any, s_file1 fren d_any, s_file1, sg_fileexp s_data = sg_nothing s_50data = sg_nothing d_50count = 0 d_ctout = 0 d_last = 0 d_count = 0 d_record = 1 d_loop = 1 $out "fixran exporting " + sg_fileexp dsec d_seconds else d_loop = 2 endi dwhi d_loop = 1 'tell d_any = d_record % 1000 dift d_any = 0: $sho "fixran export=" + d_record d_good = 1 'read a record d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_any, s_record dift d_any <> 72 'did we read a record dinc d_loop dinc d_good endi dift d_good = 1 'did we read a good record $cut s_byte, s_record, 71, 1 $ift s_byte <> "W": dinc d_good endi dift d_good = 1 d_last = d_record $cut s_beg, s_record, 1, 1 $ift s_beg = ")" $cut s_any, s_record, 2, 1 s_tap = "RCNS-*" $lok d_any, s_tap, 1, s_any dift d_any > 0: $rep s_record, 1, "]" endi '12345678901234567890123456789012345678901234567890 ']R DATE: 06-APR-2005 20:11:14 old_date 20 long ']R DATE: 2005/04/06 20:11:14 new_date 19 long ']Z UPDT: 2005/04/06 20:11 ']Z 2008/11/02 19:17 newer date 16 long 'is this a date record $cut s_any, s_record, 1, 8 $ift s_any = "]R DATE:" 'update the date in 10/29, 20 long $cut s_any, s_record, 12, 1 $ift s_any = "-" 'old style date 20 long $rep s_record, 10, s_nowdate else 'new_date 20 long $rep s_record, 10, s_nowdate endi 'put the updated record back in the file d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 endi '0 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ']Z 2008/11/02 19:17 2008/11/02 19:17 2008/11/02 19:17 2008/11/02 ']R DATE: 06-APR-2005 20:11:14 old_date 20 long ']R DATE: 2005/04/06 20:11:14 new_date 19 long ']Z UPDT: 2005/04/06 20:11:14 ']Z 2008/11/02 19:17 newer date 16 long 'is this a ]Z record $cut s_any, s_record, 1, 2 $ift s_any = "]Z" d_update = 2 $cut s_line, s_record, 1, 70 'change ]Z UPDT: TO ]Z $cut s_any, s_line, 1, 8 $ift s_any = "]Z UPDT:" $cut s_line, s_line, 9, 999 s_line = "]Z" + s_line d_update = 1 endi $trr s_line, s_line $len d_any, s_line dift d_any < 54 $cut s_any, s_nowdate, 1, 16 $app s_line, " " + s_any d_update = 1 dinc d_updtneed endi dift d_update = 1 $ch$ s_any, " ", 80 $app s_line, s_any $cut s_line, s_line, 1, 70 $rep s_record, 1, s_line 'put the updated record back in the file d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 endi endi '0 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ']Z 2008/11/02 19:17 2008/11/02 19:17 2008/11/02 19:17 2008/11/02 ']R DATE: 06-APR-2005 20:11:14 old_date 20 long ']R DATE: 2005/04/06 20:11:14 new_date 19 long ']Z UPDT: 2005/04/06 20:11:14 ']Z 2008/11/02 19:17 newer date 16 long 'is this a made or last record d_any = 2 $cut s_any, s_record, 1, 8 $ift s_any = "]R MADE:": d_any = 1 $ift s_any = "]R LAST:": d_any = 1 dift d_any = 1 'change from 07-APR-2005 to 2005/04/07 'update the date format in 10/29, 20 long $cut s_any, s_record, 12, 1 $ift s_any = "-" 'old_date 11 long to new_date 10 long $cut s_olddate, s_record, 10, 20 $cut sg_pass1, s_olddate, 1, 11 sub_dmy11_date_to_new_date s_dot = sg_pass1 'get the " " + time part of the s_olddate $cut s_any, s_olddate, 12, 99999 $app s_dot, s_any + " " 'blank was put on the end to it make 20 long $rep s_record, 10, s_dot 'put the updated record back in the file d_byte = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 endi endi 'trim the right side and output $cut s_exportline, s_record, 1, 70 $trr s_exportline, s_exportline 'do we have a dashline or an asterisk line $cut s_beg, s_exportline, 1, 2 $ift s_beg = "]-": s_exportline = "]-" $ift s_beg = "]*": s_exportline = "]*" dift d_50mode = 1 'collect 50 records and then export dinc d_ctout dinc d_50count dift d_50count >= 50 $app s_50data, s_exportline fapp d_out, sg_fileexp, s_50data dbad d_out = 0 d_50count = 0 s_50data = sg_nothing else $app s_50data, s_exportline + s_char10 endi else 'write the line to the end of the fixran export file fapp d_out, sg_fileexp, s_exportline dbad d_out = 0 dinc d_ctout endi dinc d_count endi dinc d_record endw dift d_50mode = 1 'output any remaining in s_50data dift d_50count > 0 fapp d_out, sg_fileexp, s_50data dbad d_out = 0 endi endi '0 1 2 3 4 5 6 '123456789012345678901234567890123456789012345678901234567890 ']Z 2008/11/02 19:17 2008/11/02 19:17 2008/11/02 19:17 2008/11/02 ']R DATE: 06-APR-2005 20:11:14 old_date 20 long ']R DATE: 2005/04/06 20:11:14 new_date 19 long ']Z UPDT: 2005/04/06 20:11:14 ']Z 2008/11/02 19:17 newer date 16 long dift d_updtneed = 1 'make a new ]Z record $ch$ s_record, " ", 70 dch$ s_any, 10, 1 $app s_record, "W" + s_any $rep s_record, 1, "]Z" $cut s_any, s_nowdate, 1, 16 $rep s_record, 4, s_any 'add a ]Z record to the fixran file flen d_byte, sg_fileran dinc d_byte fwri d_out, sg_fileran, d_byte, s_record dbad d_out = 0 'add a ]Z record to the export file $cut s_record, s_record, 1, 70 $trb s_record, s_record fapp d_out, sg_fileexp, s_record dbad d_out = 0 endi dsec d_any d_seconds = d_any - d_seconds dift d_yesbyrecords > 0 'so the .ran file will be newer than the .exp file frea s_any, sg_fileran, 1, 70 d_any = 0 dwhi d_any <= 99999 d_any = d_any + 1 s_dot = "wait a few seconds" endw fwri d_any, sg_fileran, 1, s_any dbad d_any = 0 dg_changes = 0 dto$ s_seconds, d_seconds, 0, 3 s_out = "exported records=" + d_count $app s_out, ", last record=" + d_last $app s_out, ", seconds=" + s_seconds $app s_out, ", out=" + d_ctout $out s_out endi ends sub_fixran_export subr sub_fixran_import 'updated 2008/11/02, 2008/09/07, 2008/04/25, 2006/12/26, 2006/12/22 '2006/12/11, 2006/11/13, 2006/11/02, 2006/11/01, 2006/10/30 '2006/10/27, 2006/10/24, 2006/10/21, 2006/10/19, 2006/10/18 '2006/10/17, 2006/10/16, 2006/10/10, 2006/10/02, 2006/09/19 '2006/09/13, 2006/09/03, 2006/06/17, 2006/05/09, 2005/07/09 '2005/04/30, 2005/04/12, 2005/04/11, 2005/04/05, 2004/10/21 'import file sg_fileexp into fixran file sg_fileran vari d_any, s_any, d_dot, s_dot, s_out vari s_char10, s_char13, s_beg, d_count, s_oldemail vari d_loop, d_good, d_process, d_tseconds, s_tseconds vari d_record, s_record, d_inputbyte, d_long vari d_ctlf, d_neededlength vari s_50filedata, s_50data, d_50mode, s_50outdata vari d_50byte, d_50length, d_end, d_seconds, d_50outbyte 'make s_char13 and s_char10 dch$ s_char13, 13, 1 dch$ s_char10, 10, 1 d_process = 1 dift d_process = 1 d_50mode = 0 $out "1=add up string" $out "2=replace in string" $inp s_any, "choose, default is 1 rec at a time" $ift s_any = "*": dinc d_process $ift s_any = "1": d_50mode = 1 $ift s_any = "2": d_50mode = 2 endi dift d_process = 1 dsec d_tseconds 'delete the .ran file fdel d_any, sg_fileran $clo sg_fileran, sg_fileran d_record = 1 d_inputbyte = 1 s_oldemail = "@balcro.com" endi dift d_process = 1 finp s_50filedata, sg_fileexp $len d_50length, s_50filedata $cnt d_ctlf, s_50filedata, s_char10 d_neededlength = 3 / 2 * d_ctlf * 72 \ 1 + 200 s_out = "file=" + sg_fileexp + ", length=" + d_50length $app s_out, ", ctlf=" + d_ctlf $app s_out, ", neededlengths=" + d_neededlength $out s_out d_any = 90000 * 1000 dift d_neededlength > d_any $inp s_any, "Too long to replace in string" $ift s_any = "*": dinc d_process d_50mode = 1 endi endi dift d_process = 1 d_50byte = 1 s_50outdata = sg_nothing d_50outbyte = 1 dift d_50mode = 2: $ch$ s_50outdata, " ", d_neededlength endi d_count = 0 s_record = sg_nothing d_loop = d_process dwhi d_loop = 1 d_good = 1 'get next read byte d_50byte $lok d_end, s_50filedata, d_50byte, s_char10 dift d_end = 0 dinc d_good dinc d_loop else d_long = d_end - d_50byte $cut s_50data, s_50filedata, d_50byte, d_long d_50byte = d_end + 1 endi dift d_good = 1 'we have a record in s_50data length d_long 'find first LF $lok d_dot, s_50data, 1, s_char10 dift d_dot = 0: d_dot = 71 dift d_dot > 71 dift d_dot = 72 'suppose we have crlf $cut s_any, s_50data, 71, 1 d_dot = 71 $ift s_any = s_char13: d_dot = 72 else d_dot = 71 endi endi dift d_dot > d_long: d_dot = d_long + 1 'prepare for the next read d_inputbyte = d_inputbyte + d_dot ddec d_dot $cut s_record, s_50data, 1, d_dot d_dot = d_dot + 2 $cut s_50data, s_50data, d_dot, 99999 'blank any escape characters $bes s_record, s_record 'do we need a ] plus blanks $trr s_any, s_record $ift s_any = ")": s_record = "]" 'do we have a dash line $trr s_any, s_record $ift s_any = ")-": s_any = "]-" $ift s_any = "]-" $ch$ s_any, "-", 69 s_record = "]" + s_any endi 'do we have an asterisk line $trr s_any, s_record $ift s_any = ")*": s_any = "]*" $ift s_any = "]*" $ch$ s_any, "*", 69 s_record = "]" + s_any endi 'do we need to change ]C B to ]BOOK: $cut s_any, s_record, 1, 4 $ift s_any = "]C B" ']C BOOK: $cut s_record, s_record, 9, 99 s_record = "]BOOK:" + s_record endi 'do we need to change ]C C to ]C $cut s_any, s_record, 1, 4 $ift s_any = "]C C" ']CHART $cut s_record, s_record, 4, 99 s_record = "]" + s_record 'do we need to add two spaces $lok d_any, s_record, 1, "_" dift d_any > 0 $lok d_any, s_record, d_any, " " dift d_any > 0: $ins s_record, d_any, " " endi endi 'change ]R UPDT: to ]Z UPDT: $cut s_any, s_record, 1, 8 $ift s_any = "]R UPDT:": $rep s_record, 2, "Z" $cut s_any, s_record, 1, 8 $ift s_any = "]Z UPDT:" $cut s_record, s_record, 9, 999 s_record = "]Z" + s_record endi 'prep the record dch$ s_any, 32, 80 $app s_record, s_any $cut s_record, s_record, 1, 70 ']R is a MADE or DATE or LAST record ']B is a book record ']C is a chapter or book record ']E is an encoded record ']H is a HTML title record ']L is a list record ']M is the beginning of a memo type of chapter ']N is a silent note record ']S is a STOP record ']U is an updated date record ']Z is an end date update record $cut s_beg, s_record, 1, 2 $ift s_beg = ")R": $rep s_record, 1, "]" $ift s_beg = ")B": $rep s_record, 1, "]" $ift s_beg = ")C": $rep s_record, 1, "]" $ift s_beg = ")E": $rep s_record, 1, "]" $ift s_beg = ")H": $rep s_record, 1, "]" $ift s_beg = ")L": $rep s_record, 1, "]" $ift s_beg = ")M": $rep s_record, 1, "]" $ift s_beg = ")N": $rep s_record, 1, "]" $ift s_beg = ")S": $rep s_record, 1, "]" $ift s_beg = ")U": $rep s_record, 1, "]" 'put on "W" in 71 and s_char10 in 72 $app s_record, "W" + s_char10 'does it have s_oldemail in it ie old email $clo s_dot, s_record $lok d_dot, s_dot, 1, s_oldemail dift d_dot > 0: $out d_record + " " + s_record 'tell 101,103,107,109 are all prime d_any = d_record % 1000 dift d_any = 0: $sho "import=" + d_record dift d_50mode = 0 d_dot = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_dot, s_record dbad d_any = 0 endi dift d_50mode = 1 $app s_50outdata, s_record endi dift d_50mode = 2 $rep s_50outdata, d_50outbyte, s_record d_50outbyte = d_50outbyte + 72 endi dinc d_record dinc d_count 'tell 101,103,107,109 are all prime d_any = d_record % 1000 dift d_any = 0: $sho "import=" + d_record 'do we need a deleted record d_any = d_record % 3 dift d_any = 1 $ch$ s_record, "z", 71 $app s_record, s_char10 dift d_50mode = 0 d_dot = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_dot, s_record dbad d_any = 0 endi dift d_50mode = 1 $app s_50outdata, s_record endi dift d_50mode = 2 $rep s_50outdata, d_50outbyte, s_record d_50outbyte = d_50outbyte + 72 endi dinc d_record endi endi endw dift d_process = 1 dift d_50mode = 1 fout d_any, sg_fileran, s_50outdata endi dift d_50mode = 2 $trr s_50outdata, s_50outdata $app s_50outdata, s_char10 fout d_any, sg_fileran, s_50outdata endi dsec d_any d_tseconds = d_any - d_tseconds dto$ s_tseconds, d_tseconds, 0, 3 ddec d_record s_any = sg_fileran + " records=" + d_count $app s_any, ", last record=" + d_record $app s_any, ", seconds=" + s_tseconds $out s_any flen d_any, sg_fileran ded$ s_any, d_any, 0, 0 $out "file length=" + s_any endi ends sub_fixran_import subr sub_fixran_get_file_date 'updated 2005/04/09, 2005/04/08, 2005/04/07 vari d_any, s_any, d_dot, s_dot, s_tap, s_out vari d_loop, d_good, s_recdate, s_filedate, d_date vari s_filename, s_record, d_filebyte, s_time s_filename = sg_pass1 s_filedate = "0000/00/00 00:00:00" s_time = "00:00:00" d_date = 0 d_filebyte = 1 d_loop = 1 dwhi d_loop = 1 d_good = 1 fsip s_record, s_filename, d_filebyte dift d_filebyte = 0 dinc d_loop dinc d_good endi '12345678901234567890123456789 ']R DATE: 2005/04/07 06:24:32 ']R DATE: 07-APR-2005 06:24:32 dift d_good = 1 $cut s_any, s_record, 1, 8 $ift s_any <> "]R DATE:": dinc d_good endi '12345678901234567890 '2005/04/07 06:24:32 new_date '07-APR-2005 06:24:32 old_date dift d_good = 1 'we have a "]R DATE:" line $cut s_recdate, s_record, 10, 20 $trb s_recdate, s_recdate 'do we have a new_date $cut s_any, s_recdate, 5, 1 $ift s_any = "/" $cut s_any, s_recdate, 8, 1 $ift s_any = "/" 'we have new_date and are done s_filedate = s_recdate dinc d_good dinc d_loop endi endi endi dift d_good = 1 'do we have an old_date $cut s_any, s_recdate, 3, 1 $ift s_any <> "-": dinc d_good $cut s_any, s_recdate, 7, 1 $ift s_any <> "-": dinc d_good endi dift d_good = 1 'we have an old_date so change it 'change just the old_date 11 long to new_date,10 $lok d_any, s_recdate, 1, " " $cut s_time, s_recdate, d_any, 99999 $cut s_any, s_recdate, 1, d_any $trb s_time, s_time $trb sg_pass1, s_recdate sub_dmy11_date_to_new_date s_filedate = sg_pass1 + " " + s_time dinc d_loop endi endw '1234567890123456789 '2005/04/07 06:24:31 new_date 'get numeric date s_any = s_filedate d_dot = 1 dwhi d_dot > 0 $lok d_dot, s_any, 1, "/" dift d_dot = 0: $lok d_dot, s_any, 1, ":" dift d_dot = 0: $lok d_dot, s_any, 1, " " dift d_dot > 0: $del s_any, d_dot, 1 endw $tod d_date, s_any dg_pass1 = d_date sg_pass1 = s_filedate ends sub_fixran_get_file_date subr sub_dmy11_date_to_new_date 'updated 2008/09/15, 2008/03/04, 2005/04/09, 2005/04/07 'change 07-APR-2005 to 2005/05/07 'return sg_pass1, dg_pass1=1 if good vari d_any, s_any, d_dot, s_dot, s_tap vari s_old, s_new, d_good vari s_day, s_month, s_year s_old = sg_pass1 d_good = 1 dift d_good = 1 $tup s_old, s_old s_new = s_old 'do we have an old date $cut s_any, s_old, 3, 1 $ift s_any <> "-": dinc d_good endi dift d_good = 1 $cut s_any, s_old, 7, 1 $ift s_any <> "-": dinc d_good endi dift d_good = 1 'get month in numbers s_tap = "JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC" '12345678901 '07-APR-2005 '2005/05/07 'get month number $cut s_month, s_old, 4, 3 $lok d_dot, s_tap, 1, s_month dift d_dot = 0: dinc d_good endi dift d_good = 1 d_any = d_dot - 1 \ 4 + 1 s_month = "0" + d_any $off s_month, s_month, 2 $cut s_day, s_old, 1, 2 $cut s_year, s_old, 8, 4 s_any = s_day + s_year $ist d_any, s_any, "9" dift d_any <> 1: dinc d_good endi dift d_good = 1: s_new = s_year + "/" + s_month + "/" + s_day 'old is 11 long, new is 10 long sg_pass1 = s_new dg_pass1 = d_good ends sub_dmy11_date_to_new_date subr sub_file_append 'updated 2010/05/20, 2007/02/19, 2007/01/14 '2006/05/24, 2006/03/11, 2005/06/03, 2005/04/07, 2004/10/21 'append a file vari d_any, s_any, d_dot, s_dot, s_tap, s_out vari s_beg, d_end, d_yesleft, d_time1, s_char10 vari d_loop1, d_loop2, d_good, d_process, d_big, d_chess vari s_filesip, s_filename, d_filelength, d_filebyte vari d_record, s_record, d_long, d_begrecord, d_count '10-line feed dch$ s_char10, 10, 1 dpow d_big, 10, 7 d_big = d_big * 25 d_chess = 2 d_count = 0 d_process = 1 dift d_process = 1 $inp s_filename, "enter the name of the file to append" $ift s_filename = "*": dinc d_process endi dift d_process = 1 'does the file exist flen d_filelength, s_filename dift d_filelength < 0 $out "The file does not exist=" + s_filename dinc d_process endi endi dift d_process = 1 $inp s_any, "1=show mode" $ift s_any = "*": dinc d_process dg_quiet = 1 $ift s_any = "1": dg_quiet = 2 endi dift d_process = 1 d_yesleft = 2 dift dg_mode <> 3 'dg_mode = 3 means RPG code not left justified $inp s_any, "1=left justify lines, * to end" $ift s_any = "*": dinc d_process $ift s_any = "1": d_yesleft = 1 endi $tup s_any, s_filename $lok d_any, s_any, 2, ".PGN" dift d_any > 0 d_chess = 1 d_yesleft = 1 endi endi dift d_process = 1 'get next record number for the current .RAN file flen d_long, sg_fileran d_record = d_long \ 72 + 1 d_begrecord = d_record 'now start appending s_filesip = sg_nothing d_filebyte = 1 d_loop1 = 1 dwhi d_loop1 = 1 d_good = 1 fsip s_filesip, s_filename, d_filebyte dift d_filebyte = 0 dinc d_loop1 dinc d_good endi dift d_good = 1 'blank escapes in s_filesip $bes s_filesip, s_filesip endi d_loop2 = d_good dwhi d_loop2 = 1 $trr s_filesip, s_filesip dift d_yesleft = 1: $trl s_filesip, s_filesip dift d_chess = 1 $cut s_any, s_filesip, 1, 1 $ift s_any = "[" s_filesip = "]" + " " + s_filesip else $swp s_filesip, ". ", "." endi endi $len d_long, s_filesip dift d_long > 70 $bak d_dot, s_filesip, 71, " " dift d_dot = 0: d_dot = 70 $cut s_record, s_filesip, 1, d_dot dinc d_dot $cut s_filesip, s_filesip, d_dot, 99999 else s_record = s_filesip s_filesip = sg_nothing endi 'if a blank line $trr s_record, s_record dift d_yesleft = 1: $trl s_record, s_record $len d_long, s_record dift d_long = 0: s_record = "]" 'do we have a dash line $trr s_any, s_record $ift s_any = "]-" $ch$ s_any, "-", 64 s_record = "]" + s_any endi 'do we have an asterisk line $trr s_any, s_record $ift s_any = "]*" $ch$ s_any, "*", 64 s_record = "]" + s_any endi 'prep the record dch$ s_any, 32, 80 $app s_record, s_any $cut s_record, s_record, 1, 70 $app s_record, "W" + s_char10 d_any = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_any, s_record dift d_any = 0 $out "cannot append" $out s_record $inp s_any, "return" endi dift dg_quiet <> 1 dg_pass1 = d_record sub_record_show endi dinc d_record dinc d_count dinc dg_changes 'do we need a deleted record d_any = d_record % 8 dift d_any = 0 'tell d_any = d_record % 100 dift d_any = 0: $sho "lines append=" + d_record $ch$ s_record, "z", 71 $app s_record, s_char10 d_any = d_record - 1 * 72 + 1 fwri d_any, sg_fileran, d_any, s_record dbad d_any = 0 dinc d_record endi $len d_any, s_filesip dift d_any = 0: dinc d_loop2 endw endw s_any = "appended=" + d_begrecord + "/" + d_record $app s_any, " count=" + d_count + " from=" + s_filename $out s_any endi ends sub_file_append subr sub_last_show 'updated 2010/06/11, 2007/08/30, 2004/03/12 'show the last good record vari d_byte, d_lines d_lines = dg_pass1 dift d_lines = 0: d_lines = dg_maxlines flen d_byte, sg_fileran dg_pass1 = d_byte \ 72 dg_pass2 = d_lines sub_show_lines_before ends sub_last_show subr sub_sort_lines 'updated 2007/09/12, 2007/08/31, 2006/02/26, 2004/12/21 'sort a range of lines vari d_any, s_any, d_dot, s_dot vari d_record1, s_record1, s_key1, d_loop1, d_byte1, d_good1 vari d_record2, s_record2, s_key2, d_loop2, d_byte2, d_good2 vari d_record3, s_record3, s_key3, d_loop3, d_byte3, d_good3 vari d_begrec, d_endrec, d_begcol, d_length, d_result vari d_total, d_count, d_process, d_linect vari d_seconds1, d_seconds2, d_seconds3 d_begrec = dg_pass1 d_endrec = dg_pass2 d_process = 1 dift d_process = 1 d_begcol = 1 $inp s_any, "enter beginning column" $ift s_any = "*": dinc d_process $isd d_any, s_any dift d_any = 1: $tod d_begcol, s_any endi dift d_process = 1 d_length = 70 $inp s_any, "enter length" $ift s_any = "*": dinc d_process $isd d_any, s_any dift d_any = 1: $tod d_length, s_any dift d_begrec < 1: dinc d_process dift d_endrec < d_begrec: dinc d_process dift d_begcol < 1: dinc d_process dift d_length < 1: dinc d_process d_any = d_begcol + d_length dift d_any > 71: dinc d_process endi dift d_process = 1 'cannot sort ]B,]C,]M,]-,]S d_record1 = d_begrec dwhi d_record1 <= d_endrec dg_pass1 = d_record1 sub_record_read 'dg_pass1: 1=good record, 2=not good, 3=no record d_result = dg_pass1 s_record1 = sg_pass1 dift d_result = 1 $cut s_dot, s_record1, 1, 2 $lok d_dot, "]B,]C,]M,]-,]S,]N", 1, s_dot dift d_dot > 0 s_any = "cannot sort=" + d_record1 $app s_any, " " + s_dot $inp s_any, s_any dinc d_process endi else dift d_result = 3: d_record1 = d_endrec + 1 endi dinc d_record1 endw endi 'now sort d_linect = 1 d_count = 0 d_total = 0 d_record1 = d_begrec d_loop1 = d_process dwhi d_loop1 = 1 d_byte1 = d_record1 - 1 * 72 + 1 frea s_record1, sg_fileran, d_byte1, 72 d_good1 = 1 $len d_any, s_record1 dift d_any <> 72 dinc d_good1 dinc d_loop1 endi dift d_good1 = 1 $cut s_any, s_record1, 71, 1 $ift s_any <> "W": dinc d_good1 endi dift d_good1 = 1 'we have a good record1 'tell dinc d_linect d_any = d_linect % 10 dift d_any = 0 dsec d_seconds2 d_seconds3 = d_seconds2 - d_seconds1 d_seconds1 = d_seconds2 $sho d_record1 + " seconds=" + d_seconds3 endi $cut s_key1, s_record1, d_begcol, d_length 'this is the start for s_key2, d_record2 'make d_record2,s_key2 the minimum d_record2 = d_record1 d_byte2 = d_byte1 s_record2 = s_record1 s_key2 = s_key1 'now see if any s_key3 is less and swap 2 and 3 'now record3 d_record3 = d_record2 + 1 d_loop3 = 1 dwhi d_loop3 = 1 'find the lowest key from d_record2+1 to d_endrec d_byte3 = d_record3 - 1 * 72 + 1 frea s_record3, sg_fileran, d_byte3, 72 $len d_any, s_record3 dift d_any = 72 $cut s_any, s_record3, 71, 1 $ift s_any = "W" 'we have a good record3 $cut s_key3, s_record3, d_begcol, d_length $ift s_key3 < s_key2 'replace s_key2 with s_key3 d_byte2 = d_byte3 d_record2 = d_record3 s_record2 = s_record3 s_key2 = s_key3 endi endi else dinc d_loop3 endi dinc d_record3 dift d_record3 > d_endrec: dinc d_loop3 endw 's_key2 is the minimum do we need to replace s_key1 $ift s_key2 < s_key1 'swap s_record1 and s_record2 fwri d_any, sg_fileran, d_byte1, s_record2 dbad d_any = 0 fwri d_any, sg_fileran, d_byte2, s_record1 dbad d_any = 0 dinc d_count dinc dg_changes endi endi dinc d_record1 dift d_record1 >= d_endrec: dinc d_loop1 endw $out "lines=" + d_linect $out "done, records swapped=" + d_count ends sub_sort_lines subr sub_total_column 'updated 2011/03/13, 2001/09/16 'total up a column of numbers vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_loop, d_good vari d_begrec, d_endrec, d_begcol, d_length vari d_total, d_count, d_process d_begrec = dg_pass1 d_endrec = dg_pass2 d_begcol = 0 $inp s_any, "enter beginning column" $isd d_any, s_any dift d_any = 1: $tod d_begcol, s_any d_length = 0 $inp s_any, "enter number of bytes" $isd d_any, s_any dift d_any = 1: $tod d_length, s_any d_process = 1 dift d_begrec < 1: dinc d_process dift d_endrec < d_begrec: dinc d_process dift d_begcol < 1: dinc d_process dift d_begcol > 70: dinc d_process dift d_length < 1: dinc d_process d_count = 0 d_total = 0 d_record = d_begrec d_loop = d_process dwhi d_loop = 1 d_dot = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_dot, 72 d_good = 1 $len d_any, s_record dift d_any <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 'we have a good record $cut s_record, s_record, 1, 70 $cut s_dot, s_record, d_begcol, d_length $isd d_dot, s_dot dift d_dot = 1 $tod d_any, s_dot d_total = d_total + d_any dinc d_count endi endi dinc d_record dift d_record > d_endrec: dinc d_loop endw dift d_process = 1 d_any = 0 dift d_count > 0: d_any = d_total / d_count s_any = "count=" + d_count + ", total=" + d_total $app s_any, ", average=" + d_any $out s_any endi ends sub_total_column subr sub_renumber_column 'updated 2010/05/19, 2007/09/11, 2007/06/30, 2005/06/09, 2004/10/21 'renumber a column of numbers vari d_any, s_any, d_dot, s_dot vari d_record, s_record, d_byte, d_loop, d_good vari d_begrec, d_endrec, d_begcol, d_length vari d_number, s_number, d_count, d_process d_begrec = dg_pass1 d_endrec = dg_pass2 d_process = 1 dift d_process = 1 d_begcol = 0 $inp s_any, "enter beginning column" $ift s_any = "*": dinc d_process $isd d_any, s_any dift d_any = 1: $tod d_begcol, s_any endi dift d_process = 1 d_length = 0 $inp s_any, "enter number of bytes" $ift s_any = "*": dinc d_process $isd d_any, s_any dift d_any = 1: $tod d_length, s_any endi dift d_process = 1 d_number = -1 $inp s_any, "enter first number" $ift s_any = "*": dinc d_process $isd d_any, s_any dift d_any = 1: $tod d_number, s_any endi dift d_process = 1 dift d_begrec < 1: dinc d_process dift d_endrec < d_begrec: dinc d_process dift d_begcol < 1: dinc d_process dift d_length < 1: dinc d_process dift d_number < 0: dinc d_process endi d_count = 0 d_record = d_begrec d_loop = d_process dwhi d_loop = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 $len d_any, s_record dift d_any <> 72 dinc d_good dinc d_loop endi dift d_good = 1 d_any = d_record % 100 dift d_any = 0: $sho d_record $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 1, 2 $ift s_any = "]N": dinc d_good endi dift d_good = 1 'we have a good record $cut s_record, s_record, 1, 70 $cut s_dot, s_record, d_begcol, d_length $isd d_dot, s_dot dift d_dot <> 1 'not numeric so end dinc d_good dinc d_loop else 'put on leading zeros and make correct length dto$ s_number, d_number, 0, 0 $ch$ s_any, "0", 20 s_number = s_any + s_number $off s_number, s_number, d_length 'put back in record $rep s_record, d_begcol, s_number $cut s_record, s_record, 1, 70 dch$ s_any, 10, 1 $app s_record, "W" + s_any fwri d_any, sg_fileran, d_byte, s_record dbad d_any = 0 dinc d_count dinc dg_changes dinc d_number dift dg_quiet <> 1 dg_pass1 = d_record sub_record_show endi endi endi dinc d_record dift d_record > d_endrec: dinc d_loop endw dg_xvalue = d_count $out "total renumbered=" + d_count ends sub_renumber_column subr sub_columns_change 'updated 2006/06/12, 2004/10/21 'change columns with command columns vari d_any, s_any, d_dot, s_dot vari d_record, s_record, s_newrecord, d_byte vari d_process, d_loop, d_good vari d_begrec, d_endrec, d_begcol, d_numcol, s_tostring vari s_blanks, d_count, s_left, s_right d_begrec = dg_pass1 d_endrec = dg_pass2 d_process = 1 dift d_process = 1 d_begcol = 0 $inp s_any, "enter beginning column" $isd d_any, s_any dift d_any = 1: $tod d_begcol, s_any dift d_any <> 1: dinc d_process endi dift d_process = 1 d_numcol = -1 $inp s_any, "enter number of columns to replace" $isd d_any, s_any dift d_any = 1: $tod d_numcol, s_any dift d_any <> 1: dinc d_process endi dift d_process = 1 $inp s_tostring, "enter change to string in double quotes" $cnt d_any, s_tostring, #"# dift d_any <> 2: dinc d_process $par s_tostring, s_tostring, #"#, 2 endi dift d_process = 1 dift d_begrec < 1: dinc d_process dift d_endrec < d_begrec: dinc d_process dift d_begcol < 1: dinc d_process dift d_begcol > 70: dinc d_process dift d_numcol < 0: dinc d_process d_any = d_begcol + d_numcol - 1 dift d_any > 70: dinc d_process endi dift d_process = 1 s_any = "beg=" + d_begcol + " #col to replace=" + d_numcol $app s_any, " string='" + s_tostring + "'" $inp s_any, "* = end" $ift s_any = "*": dinc d_process else $out "cannot perform" endi dch$ s_blanks, 32, 80 d_count = 0 d_record = d_begrec d_loop = d_process dwhi d_loop = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 $len d_any, s_record dift d_any <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 'we have a good record $cut s_record, s_record, 1, 70 'get the left and right unaffected portions d_any = d_begcol - 1 $cut s_left, s_record, 1, d_any d_any = d_begcol + d_numcol $cut s_right, s_record, d_any, 99999 'assemble s_newrecord s_newrecord = s_left + s_tostring + s_right + s_blanks 'is s_newrecord too long $cut s_any, s_newrecord, 71, 99999 $trb s_any, s_any $len d_any, s_any dift d_any > 0 $out "record=" + d_record + " will be too long" $out s_record $out s_newrecord dinc d_good endi endi dift d_good = 1 'put back in record $cut s_newrecord, s_newrecord, 1, 70 dch$ s_any, 10, 1 $app s_newrecord, "W" + s_any fwri d_any, sg_fileran, d_byte, s_newrecord dbad d_any = 0 dinc d_count dinc dg_changes dg_pass1 = d_record sub_record_show endi dinc d_record dift d_record > d_endrec: dinc d_loop endw $out "total columns changed=" + d_count ends sub_columns_change subr sub_put_commas_in_numbers 'updated 2007/08/26 'put commas in numbers vari d_any, s_any, d_dot, s_dot vari d_record, s_record, s_newrecord, d_byte vari d_process, d_loop, d_good vari d_begrec, d_endrec, d_begcol vari s_line, s_number, s_hold vari s_blanks, d_count d_begrec = dg_pass1 d_endrec = dg_pass2 d_process = 1 dift d_process = 1 d_begcol = 0 $inp s_any, "enter begin column" $isd d_any, s_any dift d_any = 1: $tod d_begcol, s_any dift d_any <> 1: dinc d_process dift d_begcol < 1: dinc d_process dift d_begcol > 65: dinc d_process endi dift d_process = 1 s_any = "lines=" + d_begrec + "/" + d_endrec $app s_any, " beg column=" + d_begcol $out s_any $inp s_any, "* = end" $ift s_any = "*": dinc d_process else $out "cannot perform" endi dch$ s_blanks, 32, 80 d_count = 0 d_record = d_begrec d_loop = d_process dwhi d_loop = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 'tell d_any = d_record % 100 dift d_any = 0: $sho d_record d_good = 1 $len d_any, s_record dift d_any <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 'we have a good record $cut s_record, s_record, 1, 70 $cut s_line, s_record, d_begcol, 80 $trb s_line, s_line $app s_line, " " $lok d_any, s_line, 1, " " $cut s_number, s_line, 1, d_any $cut s_hold, s_line, d_any, 999 $trb s_number, s_number $ist d_any, s_number, "9" d_good = d_any endi dift d_good = 1 's_number is a number sg_pass1 = s_number sub_teaquad_from_string sub_teaquad_to_string s_number = sg_pass1 d_any = d_begcol - 1 $cut s_line, s_record, 1, d_any s_newrecord = s_line + s_number + s_hold + s_blanks $cut s_any, s_newrecord, 71, 999 $isc d_any, s_any, " " dift d_any <> 1 $out "record=" + d_record + " will be too long" $out s_record $out s_newrecord dinc d_good endi endi dift d_good = 1 'put back in record $cut s_newrecord, s_newrecord, 1, 70 dch$ s_any, 10, 1 $app s_newrecord, "W" + s_any fwri d_any, sg_fileran, d_byte, s_newrecord dbad d_any = 0 dinc d_count dinc dg_changes dift dg_quiet <> 1 dg_pass1 = d_record sub_record_show endi endi dinc d_record dift d_record > d_endrec: dinc d_loop endw $out "total numbers changed=" + d_count ends sub_put_commas_in_numbers subr sub_8letter_words 'updated 2006/05/24, 2004/10/20 'get all 8 letter words in a file vari d_any, s_any, d_dot, s_dot vari s_fileout, d_record, s_record vari d_loop, d_good, d_process vari s_word1, s_word2, s_allfile, s_oldwords, s_newwords vari d_long, s_alpha, d_big, d_count, d_filelong vari d_byte, s_byte, d_ctgood, d_8long d_process = 1 dift d_process = 1 d_8long = 8 $inp s_any, "enter length of words to find" $isd d_any, s_any dift d_any = 1: $tod d_8long, s_any $inp s_fileout, "enter output filename" flen d_long, sg_fileran dift d_long < 0: dinc d_process flen d_long, s_fileout dift d_long >= 0 $inp s_any, "1=purge existing output file" $ift s_any = "1" fdel d_any, s_fileout else dinc d_process endi endi endi dift d_process = 1 'get all of the file into s_allfile s_allfile = sg_nothing d_record = 1 d_loop = 1 dwhi d_loop = 1 d_any = d_record % 100 dift d_any = 0: $sho "getting file=" + d_record d_good = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 $len d_any, s_record dift d_any <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 $cut s_record, s_record, 1, 70 $trb s_record, s_record $app s_allfile, s_record + " " endi dinc d_record endw 'make uppercase $cup s_allfile, s_allfile $len d_filelong, s_allfile d_count = 0 dpow d_big, 10, 9 s_alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" s_oldwords = sg_nothing 'now find the 8letter words in s_allfile d_ctgood = 0 d_byte = 1 dwhi d_byte <= d_filelong $cut s_byte, s_allfile, d_byte, 1 $lok d_dot, s_alpha, 1, s_byte dift d_dot > 0 'd_ctgood is the count of good letters dinc d_ctgood else dift d_ctgood = d_8long 'we have a word8 d_dot = d_byte - d_8long $cut s_word1, s_allfile, d_dot, d_8long 'is it a new word $lok d_dot, s_oldwords, 1, s_word1 dift d_dot = 0 dinc d_count d_any = d_byte / d_filelong * 100 dto$ s_any, d_any, 6, 3 s_dot = d_count + ". " + s_word1 + ", percent done=" $app s_dot, s_any $out s_dot $app s_oldwords, s_word1 + "," endi endi 'reset d_ctgood to zero d_ctgood = 0 endi dinc d_byte endw dift d_count > 0 $out "beginning sort" d_any = d_8long + 1 $sor s_newwords, s_oldwords, d_any $out "outputting file" d_count = 0 d_loop = 1 dwhi d_loop = 1 dinc d_count $cut s_word1, s_oldwords, 1, d_8long $cut s_word2, s_newwords, 1, d_8long d_any = d_8long + 2 $cut s_oldwords, s_oldwords, d_any, d_big $cut s_newwords, s_newwords, d_any, d_big dto$ s_dot, d_count, 6, 0 s_any = s_dot + ". " + s_word1 + " " + s_word2 fapp d_any, s_fileout, s_any dbad d_any = 0 $len d_long, s_oldwords dift d_long < d_8long: dinc d_loop endw endi endi dift d_process = 1 $inp s_any, "done" else $out "not done" endi ends sub_8letter_words subr sub_file_delete 'updated 2005/04/13, 2005/01/15, 1998/04/03 'file delete vari s_any, d_any, s_dot, d_dot vari s_file, d_long $ch$ s_any, "*", 76 $out s_any $inp s_file, "enter filename" flen d_long, s_file ded$ s_dot, d_long, 0, 0 s_any = "file=" + s_file + ", length=" + s_dot $out s_any $inp s_any, "1=delete file" 'delete the file $ift s_any = "1" fdel d_any, s_file $inp s_any, "deleted" endi ends sub_file_delete subr sub_lineshold 'updated 2003/07/14 vari d_any, s_any, d_dot, s_dot vari d_line, d_good, d_process, d_which, d_loop d_line = dg_pass1 d_process = 1 dift d_line > 0 sg_1lineshold = sg_1lineshold + d_line + "," dinc d_process endi d_which = 1 d_loop = d_process dwhi d_loop = 1 $par s_dot, sg_1lineshold, ",", d_which $isd d_any, s_dot dift d_any = 1 $tod d_line, s_dot dg_pass1 = d_line sub_record_show dinc d_which else dinc d_loop endi endw ends sub_lineshold subr sub_floating_point_test 'updated 2004/09/25 vari d_any, s_any, d_dot, s_dot, s_out dpow d_any, 10, 15 d_any = d_any / 3 ded$ s_dot, d_any, 0, 0 s_out = "1.0E15/3=" + s_dot s_any = "error: floating point: " $lok d_dot, s_dot, 1, "." dift d_dot > 0 ddec d_dot $cut s_dot, s_dot, d_dot, 3 $ift s_dot = "3.3": s_any = "ok: floating point: " endi $out s_any + s_out ends sub_floating_point_test subr sub_menu_primes 'updated 2010/01/30, 2008/05/12, 2007/04/27, 2006/11/27, 2006/05/19 vari s_pick sub_path_prog_memory $out "1. sub_teaquad_5tp39_from_file" $out "2. sub_teaquad_primes_find" $inp s_pick, "choose" $ift s_pick = "1": sub_teaquad_5tp39_from_file $ift s_pick = "2": sub_teaquad_primes_find ends sub_menu_primes subr sub_teaquad_primes_find 'updated 2007/03/04, 2007/02/24, 2007/01/07, 2007/01/06 '2006/12/11, 2006/12/09, 2006/12/08, 2006/12/07, 2006/12/06 '2006/11/27, 2006/11/25, 2006/11/13, 2006/11/12, 2006/11/11 '2006/10/29, 2006/10/28, 2006/10/27, 2006/10/26, 2006/10/25 'find primes teaquad greater than 1E15 as total of two numbers vari d_any, s_any, d_dot, s_dot, s_out vari s_number, d_teaquadpart, d_teaquadmult, d_count, s_count vari d_process, d_loop, d_show, d_factor, s_factor vari d_seconds, d_previous, d_gap, d_ctmax vari d_teaquadnum, d_maxteaquadpart, d_maxteaquadmult vari d_stopteaquadpart, d_stopteaquadmult vari d_file, s_filename, s_date, d_factfactor 'stop for sure at 1E21 dpow d_maxteaquadpart, 10, 15 $tod d_maxteaquadmult, "999,999" d_teaquadnum = d_maxteaquadpart d_process = 1 dift d_process = 1 d_teaquadpart = 1 d_teaquadmult = 1 $inp s_number, "enter begin number, default=teaquad" $ift s_number = "*": dinc d_process endi dift d_process = 1 $trb s_number, s_number $ift s_number <> sg_nothing sg_pass1 = s_number sub_teaquad_from_string d_teaquadpart = dg_pass1 d_teaquadmult = dg_pass2 endi d_any = d_teaquadpart % 2 dift d_any = 0: dinc d_teaquadpart ded$ s_any, d_teaquadpart, 0, 0 $out "1part=" + s_any $out "1mult=" + d_teaquadmult endi dift d_process = 1 d_show = 2 $inp s_any, "1=show tries" $ift s_any = "*": dinc d_process $ift s_any = "1": d_show = 1 endi dift d_process = 1 d_ctmax = 99999 $inp s_any, "how many to find, default=99999" $ift s_any = "*": dinc d_process $isd d_any, s_any dift d_any = 1: $tod d_ctmax, s_any endi dift d_process = 1 d_file = 2 s_filename = "primes99.txt" $inp s_any, "1=output to file " + s_filename $ift s_any = "*": dinc d_process $ift s_any = "1" d_file = 1 flen d_any, s_filename dift d_any >= 0 $inp s_any, "1=purge old file" $ift s_any = "*": dinc d_process $ift s_any = "1": fdel d_any, s_filename endi endi endi dift d_process = 1 d_stopteaquadpart = d_maxteaquadpart d_stopteaquadmult = d_maxteaquadmult $inp s_any, "enter stop number if wanted" $ift s_any = "*": dinc d_process sg_pass1 = s_any sub_teaquad_from_string d_stopteaquadpart = dg_pass1 d_stopteaquadmult = dg_pass2 s_out = "stop: 1part=" + d_stopteaquadpart $app s_out, ", 1mult=" + d_stopteaquadmult $out s_out endi d_count = 0 d_loop = d_process dwhi d_loop = 1 dsec d_seconds 'use teapro command for fast method dfak d_factor, d_teaquadpart, d_teaquadmult dsec d_any d_seconds = d_any - d_seconds $dat s_date $cut s_date, s_date, 1, 20 'is the factor prime dfac d_factfactor, d_factor 'show number just tested dg_pass1 = d_teaquadpart dg_pass2 = d_teaquadmult sub_teaquad_to_string s_number = sg_pass1 ded$ s_factor, d_factor, 0, 0 'if factor is prime append ":P" dift d_factfactor = 1: $app s_factor, ":P" s_out = s_number + " " + s_date $app s_out, " fact=" + s_factor $app s_out, " sec=" + d_seconds $sho s_out dift d_show = 1 $out s_out dift d_file = 1: fapp d_any, "primes99.txt", s_out endi dift d_factfactor <> 1 $out s_out $inp s_any, "factor not prime" $ift s_any = "*": dinc d_loop endi dift d_factor = 1 'we have a teaquad prime dinc d_count s_count = "0000" + d_count $off s_count, s_count, 4 'find gap to previous prime d_gap = 0 dift d_previous > 0: d_gap = d_teaquadpart - d_previous d_previous = d_teaquadpart dg_pass1 = d_teaquadpart dg_pass2 = d_teaquadmult sub_teaquad_to_string s_number = sg_pass1 s_out = s_count + ".prime=" + s_number $app s_out, " " + s_date $app s_out, " sec=" + d_seconds $app s_out, " gap=" + d_gap $out s_out dift d_file = 1 s_out = "]" + " " + s_count $app s_out, ".prime=" + s_number $app s_out, " " + s_date $app s_out, " gap=" + d_gap fapp d_any, "primes99.txt", s_out dbad d_any = 0 endi endi d_teaquadpart = d_teaquadpart + 2 dift d_teaquadpart > d_teaquadnum dinc d_teaquadmult d_teaquadpart = 1 endi dift d_count >= d_ctmax: dinc d_loop dift d_stopteaquadpart > 0 dift d_teaquadmult >= d_stopteaquadmult dift d_teaquadpart >= d_stopteaquadpart: dinc d_loop endi endi 'cannot go over 1E21 dift d_teaquadmult >= d_maxteaquadmult dift d_teaquadpart >= d_maxteaquadpart: dinc d_loop endi endw $inp s_any, "done" ends sub_teaquad_primes_find subr sub_teaquad_5tp39_from_file 'updated 2012/01/06 '2011/12/31, 2011/12/03, 2011/11/05, 2011/11/04, 2011/09/19 '2011/09/15, 2011/09/07, 2011/09/06, 2010/11/21, 2010/09/13 '2010/07/05, 2010/06/17, 2010/06/14, 2010/05/25, 2010/04/12 '2010/04/03, 2010/02/21, 2010/01/30, 2010/01/29, 2009/11/15 '2009/10/12, 2009/10/11, 2009/10/04, 2009/09/18, 2009/07/12 '2009/04/21, 2009/04/16, 2009/03/28, 2009/02/13, 2009/01/02 '2008/11/18, 2008/11/08, 2008/08/11, 2008/08/24, 2008/07/26 '2008/06/29, 2008/05/12, 2008/05/02, 2008/04/07, 2008/03/28 '2008/03/20, 2008/03/18, 2008/02/27, 2008/02/16, 2008/01/23 '2007/10/01, 2007/09/18, 2007/09/15, 2007/08/30, 2007/08/21 '2007/08/09, 2007/08/08, 2007/06/24, 2007/05/21, 2007/05/18 '2007/04/29, 2007/04/28, 2007/04/27, 2007/04/23, 2007/03/26 '2007/03/10, 2007/03/09, 2007/03/04, 2007/02/28, 2007/02/17 '2007/02/15, 2007/02/09, 2007/01/24, 2007/01/11, 2006/12/28 '2006/11/27, 2006/11/26, 2006/11/14, 2006/11/07, 2006/11/04 '2006/11/02, 2006/10/14, 2006/10/03, 2006/09/29, 2006/09/05 '2006/08/06, 2006/08/01, 2006/07/29, 2006/07/13, 2006/07/07 '2006/07/06, 2006/07/01, 2006/06/26, 2006/06/01, 2006/04/22 '2006/04/03, 2006/02/25, 2006/02/07, 2005/12/08, 2005/11/07 '2005/11/01, 2005/10/22, 2005/10/15, 2005/10/04, 2005/07/16 '2005/06/20, 2005/05/30, 2005/05/27, 2005/05/20, 2005/05/19 vari d_any, s_any, d_dot, s_dot, d_tap, s_out vari d_loop, d_byte, d_record, s_record, d_good vari s_number, d_time1, d_time2, s_dashes vari s_rawnumber, s_nowprimeline, s_prevprimeline vari d_prevcount, d_qtpcount, s_entirefile vari d_chapdonect, s_chapline, d_chapqtptot, d_chapqtpct vari d_primearraytest1, d_primearraytestct vari d_begteaquadpart, d_begteaquadmult vari d_prevrecord, s_prevshow, s_log, s_barenumberfile vari d_prevteaquadmult, d_prevteaquadpart vari d_process, d_testeachexactly, d_endteaquadyes vari d_endteaquadpart, d_endteaquadmult, d_endteaquadct vari d_teaquadpart, d_teaquadmult, d_teaquadone vari s_teaquadrecord, d_qtpdiff, d_refnum vari d_qtppart01, d_qtpmult01, s_qtprec01 vari d_qtppart02, d_qtpmult02, s_qtprec02 vari d_qtppart03, d_qtpmult03, s_qtprec03 vari d_qtppart04, d_qtpmult04, s_qtprec04 vari d_qtppart05, d_qtpmult05, s_qtprec05 vari d_qtppart06, d_qtpmult06, s_qtprec06 'below for 2max vari s_2maxrec1, s_2maxrec2, d_2maxdiff, d_afterskipct 'below for 2min vari s_2minrec1, s_2minrec2, d_2mindiff 'below for 3min vari s_3minrec1, s_3minrec2, s_3minrec3, d_3mindiff 'below for 4min vari s_4minrec1, s_4minrec2, s_4minrec3, s_4minrec4, d_4mindiff 'below for 5min vari s_5minrec1, s_5minrec2, s_5minrec3 vari s_5minrec4, s_5minrec5, d_5mindiff 'below for 6min vari s_6minrec1, s_6minrec2, s_6minrec3, s_6minrec4 vari s_6minrec5, s_6minrec6, d_6mindiff $ch$ s_dashes, "-", 70 '28049 in 1-100E15 '18541 in 100E15 to 200E15 '16558 in 200E15 to 300E15 d_process = 1 dift d_process = 1 d_primearraytest1 = 1 d_primearraytestct = 0 $inp s_any, "1=do not test by 20,000 prime array" $ift s_any = "*": dinc d_process $ift s_any = "1": dinc d_primearraytest1 dift d_primearraytest1 = 1 'load decimal array with primes sub_prepare_primearray endi endi dift d_process = 1 s_number = "1E15" $inp s_any, "enter begin number, default=" + s_number $tup s_any, s_any $ift s_any = "*": dinc d_process $lok d_any, s_any, 1, "E15" dift d_any > 0 ddec d_any dift d_any = 0 s_any = "1" d_any = 1 endi $cut s_any, s_any, 1, d_any $ch$ s_dot, "0", 15 $app s_any, s_dot endi $len d_any, s_any dift d_any = 0: s_any = s_number sg_pass1 = s_any sub_teaquad_from_string d_begteaquadpart = dg_pass1 d_begteaquadmult = dg_pass2 $out "part=" + d_begteaquadpart $out "mult=" + d_begteaquadmult endi dift d_process = 1 $tlo s_barenumberfile, sg_fileran $swp s_barenumberfile, ".ran", ".txt" $swp s_barenumberfile, "qtp", "num" fdel d_any, s_barenumberfile $out s_barenumberfile s_log = "primes.log" $out "if test each make log file=" + s_log flen d_any, s_log dift d_any > 0 $inp s_any, "1=purge old log file" $ift s_any = "*": dinc d_process $ift s_any = "1": fdel d_any, s_log endi $inp s_any, "1=do not test each exactly" $ift s_any = "*": dinc d_process d_testeachexactly = 1 $ift s_any = "1": dinc d_testeachexactly endi dift d_process = 1 d_endteaquadyes = 0 d_endteaquadpart = 0 d_endteaquadmult = d_begteaquadmult + 1 dift d_testeachexactly = 1 dg_pass1 = d_endteaquadpart dg_pass2 = d_endteaquadmult sub_teaquad_to_string s_dot = sg_pass1 $inp s_any, "1=end at " + s_dot $ift s_any = "*": dinc d_process $ift s_any = "1": d_endteaquadyes = 1 endi dift d_endteaquadyes = 1 '9,123,456,789,012,345 dg_pass1 = d_endteaquadpart dg_pass2 = d_endteaquadmult sub_teaquad_to_string $out "end=" + sg_pass1 endi endi finp s_entirefile, sg_fileran dpow d_teaquadone, 10, 15 dpow d_2mindiff, 10, 20 dpow d_3mindiff, 10, 20 dpow d_4mindiff, 10, 20 dpow d_5mindiff, 10, 20 dpow d_6mindiff, 10, 20 d_chapdonect = 0 d_chapqtptot = 0 d_chapqtpct = 0 d_refnum = 0 d_qtpcount = 0 d_record = 1 d_loop = d_process dwhi d_loop = 1 d_byte = d_record - 1 * 72 + 1 frea s_record, sg_fileran, d_byte, 72 d_good = 1 $len d_any, s_record dift d_any <> 72 dinc d_good dinc d_loop endi dift d_good = 1 $cut s_any, s_record, 71, 1 $ift s_any <> "W": dinc d_good endi dift d_good = 1 $cut s_any, s_record, 1, 5 $ift s_any = "]STOP" $out s_dashes $out s_prevshow dg_pass1 = d_record sub_record_show dinc d_good dinc d_loop endi endi dift d_good = 1 'we have a good record of some kind $cut s_record, s_record, 1, 70 'do we have ]CHAP= record $cut s_any, s_record, 1, 6 $ift s_any = "]CHAP=" 'we have a ]CHAP= record 'compare d_chapqtptot and d_chapqtpct 'from the previous chapter dift d_chapqtptot = 0: d_chapqtptot = d_chapqtpct dift d_chapqtptot <> d_chapqtpct dg_nowline = d_record s_out = "bad Ct=" + d_chapqtptot + " <> " $app s_out, d_chapqtpct $out s_out $out s_chapline $out d_record + " " + s_record $inp s_any, "return" $ift s_any = "*" dinc d_good dinc d_loop endi endi d_chapqtpct = 0 d_chapqtptot = 0 s_chapline = d_record + " " + s_record '12345678901234567890 ']CHAP= 5TP39: 10,000E15, n2, Ct=63, end=2009/04/23 'do we have the essential string four times $cut s_any, s_record, 15, 9999 $trb s_any, s_any $cnt d_any, s_entirefile, s_any $lok d_dot, s_record, 1, "end=" dift d_dot = 0: dinc d_any dift d_any <> 4 dg_nowline = d_record $out s_chapline $inp s_any, s_any + " count=" + d_any $ift s_any = "*" dinc d_good dinc d_loop endi endi dift d_dot > 10 'this chapter is done dinc d_chapdonect 'get the chapter qtp total d_chapqtptot $lok d_any, s_record, 1, "Ct=" d_any = d_any + 3 $cut s_dot, s_record, d_any, 9999 $par s_any, s_dot, ",", 1 $isd d_any, s_any dift d_any = 1 $tod d_chapqtptot, s_any else $out "bad Ct=" dg_pass1 = d_record sub_record_show dinc d_good dinc d_loop endi endi endi 'do we have a skip at the end of a chapter $trb s_any, s_record $len d_any, s_any dift d_any <= 1: d_afterskipct = 0 $lok d_tap, s_record, 1, "5TP39=" 'if not a 5TP39= line dift d_tap = 0: dinc d_good endi dift d_good = 1 'we have a number record 'get the num into s_rawnumber,s_number $swp s_record, "=", ":" d_tap = d_tap + 6 $cut s_number, s_record, d_tap, 9999 $trb s_number, s_number $app s_number, " " $lok d_dot, s_number, 1, " " $cut s_number, s_number, 1, d_dot $trb s_number, s_number s_rawnumber = s_number s_teaquadrecord = s_record s_nowprimeline = s_record s_any = s_rawnumber $swp s_any, ",", sg_nothing fapp d_any, s_barenumberfile, s_any 'get the num into d_teaquadpart,d_teaquadmult 'do we have a teaquad sg_pass1 = s_number sub_teaquad_from_string d_teaquadpart = dg_pass1 d_teaquadmult = dg_pass2 endi dift d_good = 1 'have we reached d_begteaquadpart, d_begteaquadmult dift d_teaquadmult < d_begteaquadmult: dinc d_good dift d_teaquadmult = d_begteaquadmult dift d_teaquadpart < d_begteaquadpart: dinc d_good endi endi dift d_good = 1 dift d_primearraytest1 = 1 'test with primes in the prime array $out d_record + " " + s_record dg_pass1 = d_teaquadpart dg_pass2 = d_teaquadmult sub_test_5tp39_with_primearray dift dg_pass1 <> 1 dg_nowline = d_record $out d_record + " " + s_number $inp s_any, "not 5TP39 " + s_record $ift s_any = "*" dinc d_good dinc d_loop endi endi dinc d_primearraytestct dift d_primearraytestct >= 1000 d_primearraytestct = 0 $inp s_any, "y=all, return to test 1000 more" $tlo s_any, s_any $ift s_any = "y" d_primearraytestct = 10 ^ 15 d_primearraytestct = - d_primearraytestct endi $ift s_any = "*" dinc d_good dinc d_loop endi endi endi endi dift d_good = 1 'we have a record s_record with 5TP39= 'first validate count numbers on left '] 000:5TP39= 'validate the d_chapqtpct dinc d_chapqtpct $lok d_any, s_record, 1, ":" d_any = d_any - 3 d_dot = 2 dift d_any > 1 'left count which should = d_chapqtpct $cut s_any, s_record, 3, d_any $isd d_any, s_any dift d_any = 1 $tod d_any, s_any dift d_any > 0 'left count is not zero dift d_any = d_chapqtpct: d_dot = 1 else d_dot = 1 endi endi endi dift d_dot <> 1 'the left count is not = d_chapqtpct dg_nowline = d_record $out d_record + " " + s_record $inp s_any, "bad left count=" + d_chapqtpct $ift s_any = "*" dinc d_good dinc d_loop endi endi endi dift d_good = 1 'count 5TP39 records since skip dinc d_afterskipct 'roll into hold d_qtppart01,d_qtpmult01 etc d_qtppart06 = d_qtppart05 d_qtpmult06 = d_qtpmult05 s_qtprec06 = s_qtprec05 d_qtppart05 = d_qtppart04 d_qtpmult05 = d_qtpmult04 s_qtprec05 = s_qtprec04 d_qtppart04 = d_qtppart03 d_qtpmult04 = d_qtpmult03 s_qtprec04 = s_qtprec03 d_qtppart03 = d_qtppart02 d_qtpmult03 = d_qtpmult02 s_qtprec03 = s_qtprec02 d_qtppart02 = d_qtppart01 d_qtpmult02 = d_qtpmult01 s_qtprec02 = s_qtprec01 d_qtppart01 = d_teaquadpart d_qtpmult01 = d_teaquadmult s_qtprec01 = s_teaquadrecord endi dift d_good = 1 '2max dift d_afterskipct > 1 dift d_qtppart02 > 0 d_qtpdiff = d_qtppart01 - d_qtppart02 d_dot = d_qtpmult01 - d_qtpmult02 d_qtpdiff = d_dot * d_teaquadone + d_qtpdiff dift d_qtpdiff > d_2maxdiff d_2maxdiff = d_qtpdiff s_2maxrec1 = s_qtprec01 s_2maxrec2 = s_qtprec02 $out s_dashes $out s_2maxrec2 $out s_2maxrec1 ded$ s_any, d_2maxdiff, 0, 0 $out "] 2max diff=" + s_any 'fix to not show twice d_qtpdiff = 0 endi 'show 2max if over 100E12 d_dot = 10 ^ 12 * 100 dift d_qtpdiff > d_dot $out s_dashes $out s_qtprec02 $out s_qtprec01 ded$ s_any, d_qtpdiff, 0, 0 $out "] 2max diff=" + s_any endi endi endi endi dift d_good = 1 '2min dift d_qtppart02 > 0 d_qtpdiff = d_qtppart01 - d_qtppart02 d_dot = d_qtpmult01 - d_qtpmult02 d_qtpdiff = d_dot * d_teaquadone + d_qtpdiff dift d_qtpdiff < d_2mindiff d_2mindiff = d_qtpdiff s_2minrec1 = s_qtprec01 s_2minrec2 = s_qtprec02 $out s_dashes $out s_2minrec2 $out s_2minrec1 ded$ s_any, d_2mindiff, 0, 0 $out "] 2min diff=" + s_any 'set big to keep from showing twice d_qtpdiff = d_teaquadone endi 'show 2min if under 5E9 d_dot = 10 ^ 9 * 5 dift d_qtpdiff < d_dot $out s_dashes $out s_qtprec02 $out s_qtprec01 ded$ s_any, d_qtpdiff, 0, 0 $out "] 2min diff=" + s_any endi endi endi dift d_good = 1 '3min dift d_qtppart03 > 0 d_qtpdiff = d_qtppart01 - d_qtppart03 d_dot = d_qtpmult01 - d_qtpmult03 d_qtpdiff = d_dot * d_teaquadone + d_qtpdiff dift d_qtpdiff < d_3mindiff d_3mindiff = d_qtpdiff s_3minrec1 = s_qtprec01 s_3minrec2 = s_qtprec02 s_3minrec3 = s_qtprec03 $out s_dashes $out s_3minrec3 $out s_3minrec2 $out s_3minrec1 ded$ s_any, d_3mindiff, 0, 0 $out "] 3min diff=" + s_any endi endi endi dift d_good = 1 '4min dift d_qtppart04 > 0 d_qtpdiff = d_qtppart01 - d_qtppart04 d_dot = d_qtpmult01 - d_qtpmult04 d_qtpdiff = d_dot * d_teaquadone + d_qtpdiff dift d_qtpdiff < d_4mindiff d_4mindiff = d_qtpdiff s_4minrec1 = s_qtprec01 s_4minrec2 = s_qtprec02 s_4minrec3 = s_qtprec03 s_4minrec4 = s_qtprec04 $out s_dashes $out s_4minrec4 $out s_4minrec3 $out s_4minrec2 $out s_4minrec1 ded$ s_any, d_4mindiff, 0, 0 $out "] 4min diff=" + s_any endi endi endi dift d_good = 1 '5min dift d_qtppart05 > 0 d_qtpdiff = d_qtppart01 - d_qtppart05 d_dot = d_qtpmult01 - d_qtpmult05 d_qtpdiff = d_dot * d_teaquadone + d_qtpdiff dift d_qtpdiff < d_5mindiff d_5mindiff = d_qtpdiff s_5minrec1 = s_qtprec01 s_5minrec2 = s_qtprec02 s_5minrec3 = s_qtprec03 s_5minrec4 = s_qtprec04 s_5minrec5 = s_qtprec05 $out s_dashes $out s_5minrec5 $out s_5minrec4 $out s_5minrec3 $out s_5minrec2 $out s_5minrec1 ded$ s_any, d_5mindiff, 0, 0 $out "] 5min diff=" + s_any endi endi endi dift d_good = 1 '6min dift d_qtppart06 > 0 d_qtpdiff = d_qtppart01 - d_qtppart06 d_dot = d_qtpmult01 - d_qtpmult06 d_qtpdiff = d_dot * d_teaquadone + d_qtpdiff dift d_qtpdiff < d_6mindiff d_6mindiff = d_qtpdiff s_6minrec1 = s_qtprec01 s_6minrec2 = s_qtprec02 s_6minrec3 = s_qtprec03 s_6minrec4 = s_qtprec04 s_6minrec5 = s_qtprec05 s_6minrec6 = s_qtprec06 $out s_dashes $out s_6minrec6 $out s_6minrec5 $out s_6minrec4 $out s_6minrec3 $out s_6minrec2 $out s_6minrec1 ded$ s_any, d_6mindiff, 0, 0 $out "] 6min diff=" + s_any endi endi endi dift d_good = 1 'on 11-AUG-2002 Roger Hargrave pointed out the existence 'of 5TP39s and that P30 % 210 is always 0. '210=2*3*5*7 'He named P30 the Pivcom or pivotal composite. 'He gave them the name 5TP39 on 16-FEB-2003. 'They are now known as Hargrave Primes 'P30 is P11 + 19 d_any = d_teaquadone % 210 * d_teaquadmult d_any = d_any + d_teaquadpart + 19 % 210 dift d_any <> 0 dg_nowline = d_record $out s_number + " Pivcom % 210 = " + d_any $inp s_any, "it should be 0" $ift s_any = "*": dinc d_loop endi endi dift d_good = 1 'Thomas R. Nicely has pointed out that p11 % 2310 is 'either 821 or 1451 for a 5TP39 or QTP is this true 'd_teaquadone % 2310 is 1000 '2310 is 11*210 or 2*3*5*7*11 d_any = d_teaquadone % 2310 * d_teaquadmult d_any = d_any + d_teaquadpart % 2310 dift d_any <> 821 dift d_any <> 1451 dg_nowline = d_record $out d_record + " " + s_record $out s_number + " % 2310 = " + d_any s_any = s_number + " % 2310 is not 821 or 1451" $app s_any, " per Thomas R. Nicely" $inp s_any, s_any $ift s_any = "*" dinc d_loop dinc d_good endi endi endi endi dift d_good = 1 'validate the reference numbers at line end $trb s_dot, s_record $bak d_dot, s_dot, 999, " " $cut s_dot, s_dot, d_dot, 999 $trb s_dot, s_dot $isd d_any, s_dot dift d_any = 1 $len d_any, s_dot dift d_any < 5 $tod d_dot, s_dot dift d_dot = 1 'begin with one d_refnum = d_dot else d_any = d_refnum + 1 dift d_any <> d_dot dg_nowline = d_record $out d_record + " " + s_record $inp s_any, "bad reference number" $ift s_any = "*": dinc d_loop endi d_refnum = d_dot endi endi endi endi dift d_good = 1 'are we testing and at the end of a 100trillion stetch dift d_endteaquadyes = 1 dift d_teaquadmult >= d_endteaquadmult s_any = "end num=" + d_endteaquadmult + " " $app s_any, d_endteaquadpart $out s_any $dat s_dot s_any = "now num=" + d_teaquadmult + " " $app s_any, d_teaquadpart + " " + s_dot $out s_any dinc d_good dinc d_loop $inp s_any, "at end" endi endi endi dift d_good = 1 'counts dinc d_qtpcount 'if not testing show the num with count dift d_testeachexactly <> 1 s_prevshow = "qtpct=" + d_qtpcount $app s_prevshow, ", record=" + d_record $app s_prevshow, ", " + s_number $sho s_prevshow endi 'd_teaquadmult can never decline dift d_teaquadmult = d_prevteaquadmult dift d_teaquadpart <= d_prevteaquadpart s_out = "prev=" + d_prevrecord $app s_out, ". " + s_prevprimeline $out s_out s_out = "curr=" + d_record $app s_out, ". " + s_nowprimeline $out s_out endi dift d_teaquadpart < d_prevteaquadpart dg_nowline = d_record $inp s_any, "less than" $ift s_any = "*": dinc d_loop endi dift d_teaquadpart = d_prevteaquadpart dg_nowline = d_record $inp s_any, "equal to" $ift s_any = "*": dinc d_loop endi endi 'd_teaquadmult can never decline dift d_teaquadmult < d_prevteaquadmult dg_nowline = d_record s_out = "prev=" + d_prevrecord $app s_out, ". " + s_prevprimeline $out s_out s_out = "curr=" + d_record $app s_out, ". " + s_nowprimeline $out s_out $inp s_any, "less than" $ift s_any = "*": dinc d_loop endi d_prevcount = d_qtpcount d_prevteaquadpart = d_teaquadpart d_prevteaquadmult = d_teaquadmult d_prevrecord = d_record s_prevprimeline = s_teaquadrecord endi dift d_good = 1 'do we not want to test each dift d_testeachexactly <> 1: dinc d_good endi dift d_good = 1 'log file primes.log d_any = d_qtpcount % 100 dift d_any = 0 $dat s_any s_out = d_qtpcount + ". " + s_number $app s_out, " " + s_rawnumber fapp d_any, s_log, s_out endi dsec d_time1 sg_pass1 = s_number dg_pass1 = d_teaquadpart dg_pass2 = d_teaquadmult sub_teaquad_5tp39_test d_good = dg_pass1 dsec d_time2 dift d_good <> 1 dg_nowline = d_record $out d_record + " " + s_rawnumber $inp s_any, "not 5TP39, return" $ift s_any = "*": dinc d_loop endi endi dift d_good = 1 dinc d_endteaquadct d_time1 = d_time2 - d_time1 $dat s_any $cut s_any, s_any, 1, 20 s_out = d_endteaquadct + " " + d_record $app s_out, ".5TP39= " + s_rawnumber + " " $app s_out, s_any + " sec=" + d_time1 $out s_out endi dinc d_record endw 'output final max and min finds $out s_dashes $out s_2maxrec2 $out s_2maxrec1 ded$ s_any, d_2maxdiff, 0, 0 $out "] 2max diff=" + s_any $out s_dashes $out s_2minrec2 $out s_2minrec1 ded$ s_any, d_2mindiff, 0, 0 $out "] 2min diff=" + s_any $out s_dashes $out s_3minrec3 $out s_3minrec2 $out s_3minrec1 ded$ s_any, d_3mindiff, 0, 0 $out "] 3min diff=" + s_any $out s_dashes $out s_4minrec4 $out s_4minrec3 $out s_4minrec2 $out s_4minrec1 ded$ s_any, d_4mindiff, 0, 0 $out "] 4min diff=" + s_any $out s_dashes $out s_5minrec5 $out s_5minrec4 $out s_5minrec3 $out s_5minrec2 $out s_5minrec1 ded$ s_any, d_5mindiff, 0, 0 $out "] 5min diff=" + s_any $out s_dashes $out s_6minrec6 $out s_6minrec5 $out s_6minrec4 $out s_6minrec3 $out s_6minrec2 $out s_6minrec1 ded$ s_any, d_6mindiff, 0, 0 $out "] 6min diff=" + s_any dg_xvalue = d_qtpcount $out s_dashes s_out = "qtpct=" + d_qtpcount + ", last=" + s_rawnumber $app s_out, ", chap done=" + d_chapdonect $out s_out $out s_dashes sub_path_prog_memory $inp s_any, "return" ends sub_teaquad_5tp39_from_file subr sub_test_5tp39_with_primearray 'updated 2011/09/19, 2011/09/06, 2010/06/14, 2010/04/12, 2010/04/03 vari d_any, s_any, d_dot, s_dot vari d_index, d_div, d_mod1, d_teaquadone vari d_teaquadmult, d_teaquad49part, d_result d_teaquad49part = dg_pass1 + 38 d_teaquadmult = dg_pass2 d_teaquadone = 10 ^ 15 d_result = 2 d_index = 1 gtag tag_nextprimetest itod d_div, d_index 'd_teaquadone is 10^15 d_mod1=d_teaquadone % d_div * d_teaquadmult + d_teaquad49part % d_div dift d_mod1 < 39 dift d_mod1 < 19 dift d_mod1 < 7 dift d_mod1 = 0: goto tag_primetestend dift d_mod1 = 2: goto tag_primetestend dift d_mod1 = 6: goto tag_primetestend else dift d_mod1 = 8: goto tag_primetestend dift d_mod1 = 18: goto tag_primetestend endi else dift d_mod1 < 32 dift d_mod1 = 20: goto tag_primetestend dift d_mod1 = 30: goto tag_primetestend else dift d_mod1 = 32: goto tag_primetestend dift d_mod1 = 36: goto tag_primetestend dift d_mod1 = 38: goto tag_primetestend endi endi endi dinc d_index dift d_index <= 20000: goto tag_nextprimetest d_result = 1 gtag tag_primetestend dg_pass1 = d_result ends sub_test_5tp39_with_primearray subr sub_prepare_primearray 'updated 2011/09/19, 2011/09/06, 2010/06/14, 2010/04/12, 2010/04/03 vari d_any, s_any, d_dot, s_dot, d_index vari d_qtpmaxindex, d_number, d_maxarrayprime 'zero the 20,000 elements of the decimal array arrz 'put d_qtpmaxindex primes in decimal array d_qtpmaxindex = 20000 d_number = 1 d_index = 1 dwhi d_index <= d_qtpmaxindex dfac d_dot, d_number dift d_dot = 1 dtoi d_index, d_number dinc d_index endi d_number = d_number + 2 endw 'put 2 in index 1 to replace the 1 in it now dtoi 1, 2 itod d_any, 1 itod d_maxarrayprime, d_qtpmaxindex s_any = "array from=" + d_any + " to " + d_maxarrayprime $app s_any, " ct=" + d_qtpmaxindex $out s_any ends sub_prepare_primearray subr sub_teaquad_5tp39_test 'updated 2011/09/07, 2006/11/14, 2006/11/12, 2006/11/02, 2005/03/06 vari d_any, s_any, d_dot, s_dot vari d_teaquadpart, d_teaquadmult, d_good $out "testing: " + sg_pass1 '11,13,17,19,29,31,41,43,47,49 d_teaquadpart = dg_pass1 d_teaquadmult = dg_pass2 dduo d_good, d_teaquadpart, d_teaquadmult d_any = d_teaquadpart + 6 dift d_good = 1: dduo d_good, d_any, d_teaquadmult d_any = d_teaquadpart + 18 dift d_good = 1: dduo d_good, d_any, d_teaquadmult d_any = d_teaquadpart + 30 dift d_good = 1: dduo d_good, d_any, d_teaquadmult d_any = d_teaquadpart + 36 dift d_good = 1: dduo d_good, d_any, d_teaquadmult dg_pass1 = d_good ends sub_teaquad_5tp39_test subr sub_teaquad_to_string 'updated 2007/02/24, 2006/11/25, 2006/11/12, 2006/10/27 'change a teaquad number in d_teaquadpart,d_teaquadmult to a string vari d_any, s_any, d_dot, s_dot vari d_teaquadpart, d_teaquadmult, s_line vari s_beg, d_beg d_teaquadpart = dg_pass1 d_teaquadmult = dg_pass2 '123456789012345678901234567 '123,456,789,012,345,678,901 '123456789012345678901 dto$ s_line, d_teaquadpart, 0, 0 $ch$ s_any, "0", 30 s_line = s_any + s_line $off s_line, s_line, 21 $cut s_beg, s_line, 1, 6 $tod d_beg, s_beg d_beg = d_teaquadmult + d_beg $ch$ s_any, "0", 6 s_beg = s_any + d_beg $off s_beg, s_beg, 6 $rep s_line, 1, s_beg 'put in commas in 21 digit number $ins s_line, 4, "," $ins s_line, 8, "," $ins s_line, 12, "," $ins s_line, 16, "," $ins s_line, 20, "," $ins s_line, 24, "," 'take off leading zeros and commas d_dot = 1 dwhi d_dot = 1 dinc d_dot $cut s_any, s_line, 1, 1 $ift s_any = "0" $cut s_line, s_line, 2, 99 d_dot = 1 endi $ift s_any = "," $cut s_line, s_line, 2, 99 d_dot = 1 endi endw sg_pass1 = s_line ends sub_teaquad_to_string subr sub_teaquad_from_string 'updated 2007/02/24, 2006/11/25, 2006/11/12, 2006/10/28 'teaquad string to d_teaquadpart,d_teaquadmult '1part is the 15 digits on the right,1mult is the left digits vari d_any, s_any, d_dot, s_dot vari d_teaquadpart, d_teaquadmult vari s_line, d_good, d_long, s_beg, d_beg s_line = sg_pass1 d_teaquadpart = 0 d_teaquadmult = 0 '123456789012345678901234567 '123,456,789,012,345,678,901 '123456789012345678901 d_good = 1 dift d_good = 1 'eliminate commas and validate for all numbers $trb s_line, s_line $swp s_line, ",", sg_nothing $ist d_any, s_line, "9" dift d_any <> 1: dinc d_good endi '123456789012345678901234567 '123,456,789,012,345,678,901 '123456789012345678901 dift d_good = 1 'make 21 long $ch$ s_any, "0", 30 s_line = s_any + s_line $off s_line, s_line, 21 $cut s_beg, s_line, 1, 6 $tod d_teaquadmult, s_beg $cut s_any, s_line, 7, 99 $tod d_teaquadpart, s_any endi dg_pass1 = d_teaquadpart dg_pass2 = d_teaquadmult ends sub_teaquad_from_string subr sub_file_just_look 'updated 2007/06/27 vari d_any, s_any, d_dot, s_dot vari d_process, d_good, d_long, d_loop vari s_file, d_byte, s_data, s_record, d_count d_process = 1 dift d_process = 1 $inp s_file, "enter file name" $ift s_file = "*": dinc d_process endi dift d_process = 1 flen d_long, s_file dift d_long < 0 $out "not exist file=" + s_file dinc d_process else $out "file=" + s_file + " length=" + d_long finp s_data, s_file endi endi d_count = 0 d_byte = 1 d_loop = d_process dwhi d_loop = 1 d_good = 1 $cut s_record, s_data, d_byte, 70 dinc d_count dift d_count >= dg_maxlines d_count = 0 $inp s_any, "enter byte number" $ift s_any = "*" dinc d_good dinc d_loop endi $isd d_any, s_any dift d_any = 1: $tod d_byte, s_any endi dift d_good = 1 dto$ s_any, d_byte, 8, 0 $out s_any + " " + s_record d_byte = d_byte + 70 endi endw ends sub_file_just_look subr sub_xyz_math 'updated 2010/02/10 '2010/02/09, 2010/02/06, 2007/09/12, 2007/04/11, 2006/05/04 '2006/04/08, 2005/11/05, 2005/08/20, 2005/06/11, 2004/04/21 'solve a multi number math expression in sg_pass1 'the format is: x=123*567+4.6 etc or y=123*567+4.6 'put answer in dg_xvalue, dg_yvalue, dg_zvalue 'put answer in dg_uvalue, dg_vvalue, dg_wvalue vari d_any, s_any, d_dot, s_dot, s_out, s_lok vari d_good, d_long, d_loop, d_error, s_dashes vari s_line, d_number, s_operator, d_answer, s_xyzvalue vari s_work, d_byte, s_term, d_process, s_command, s_aster s_command = sg_pass1 $tup s_line, s_command $ch$ s_dashes, "-", 70 $ift s_line = "XYZ": s_line = "X=X" 'do we have x=, or y= or z= d_process = 2 $cut s_any, s_line, 1, 2 $ift s_any = "X=": d_process = 1 $ift s_any = "Y=": d_process = 1 $ift s_any = "Z=": d_process = 1 $ift s_any = "U=": d_process = 1 $ift s_any = "V=": d_process = 1 $ift s_any = "W=": d_process = 1 dwhi d_process = 1 'x is in dg_xvalue, y is in dg_yvalue, z in dg_zvalue 'u is in dg_uvalue, v is in dg_vvalue, w in dg_wvalue 'remove commas and blanks and pipes $swp s_line, ",", sg_nothing $swp s_line, " ", sg_nothing $swp s_line, "|", sg_nothing '| pipe delimited into sg_xyzmath 'which holds all xyz commands to show later $app sg_xyzmath, s_line + "|" 'remove the x= or y= at the beginning in s_work $cut s_work, s_line, 3, 100 $cut s_any, s_work, 1, 1 'put on + if needed $ift s_any <> "+" $ift s_any <> "-": s_work = "+" + s_work endi 'semi-colon is the end of line operator $app s_work, ";" $len d_long, s_work d_error = 2 d_byte = 2 d_answer = 0 d_loop = 1 dwhi d_loop = 1 'do we have the next operator in d_byte $cut s_dot, s_work, d_byte, 1 s_lok = "+-*/\%^@;" $lok d_any, s_lok, 1, s_dot dift d_any > 0 'we have the location of the next operator d_long = d_byte - 2 'the current operator is in 1 'get the number or x,y,z $cut s_term, s_work, 2, d_long 'is this string a number $isd d_good, s_term dift d_good = 1 $tod d_number, s_term else 'if X then use the xvalue from previous $ift s_term = "X" d_number = dg_xvalue d_good = 1 endi $ift s_term = "Y" d_number = dg_yvalue d_good = 1 endi $ift s_term = "Z" d_number = dg_zvalue d_good = 1 endi $ift s_term = "U" d_number = dg_uvalue d_good = 1 endi $ift s_term = "V" d_number = dg_vvalue d_good = 1 endi $ift s_term = "W" d_number = dg_wvalue d_good = 1 endi dift d_good <> 1: d_error = 1 endi dift d_good = 1 'get current operator $cut s_operator, s_work, 1, 1 $ift s_operator = "+" d_answer = d_answer + d_number endi $ift s_operator = "-" d_answer = d_answer - d_number endi $ift s_operator = "*" d_answer = d_answer * d_number endi $ift s_operator = "/" dift d_number = 0 $out "zero divide" d_error = 1 else d_answer = d_answer / d_number endi endi $ift s_operator = "\" dift d_number = 0 $out "zero divide" d_error = 1 else d_answer = d_answer \ d_number endi endi $ift s_operator = "^" dpow d_answer, d_answer, d_number endi $ift s_operator = "%" 'mod dift d_number = 0 $out "zero divide" d_error = 1 else d_answer = d_answer % d_number endi endi $ift s_operator = "@" 'round to d_number places d_answer = d_answer @ d_number endi 'put next operator in 1 $cut s_work, s_work, d_byte, 99999 d_byte = 1 endi endi dinc d_byte $len d_long, s_work dift d_byte > d_long: dinc d_loop dift d_error = 1: dinc d_loop 'we end with a semi-colon $cut s_any, s_work, 1, 1 $ift s_any = ";": dinc d_loop endw dift d_error = 1 s_out = "error in expression: " + s_line $inp s_any, s_out s_line = "X=X" else 'put value in x,y,z $cut s_any, s_line, 1, 1 $ift s_any = "X": dg_xvalue = d_answer $ift s_any = "Y": dg_yvalue = d_answer $ift s_any = "Z": dg_zvalue = d_answer $ift s_any = "U": dg_uvalue = d_answer $ift s_any = "V": dg_vvalue = d_answer $ift s_any = "W": dg_wvalue = d_answer 'show values ded$ s_any, dg_xvalue, 0, 0 s_out = "x=" + s_any dift dg_xvalue > 1 d_any = dg_xvalue \ 1 dift dg_xvalue = d_any dfac d_any, dg_xvalue dift d_any = 1: $app s_out, ":P" endi endi ded$ s_any, dg_yvalue, 0, 0 $app s_out, ", y=" + s_any dift dg_yvalue > 1 d_any = dg_yvalue \ 1 dift dg_yvalue = d_any dfac d_any, dg_yvalue dift d_any = 1: $app s_out, ":P" endi endi ded$ s_any, dg_zvalue, 0, 0 $app s_out, ", z=" + s_any dift dg_zvalue > 1 d_any = dg_zvalue \ 1 dift dg_zvalue = d_any dfac d_any, dg_zvalue dift d_any = 1: $app s_out, ":P" endi endi $out s_out ded$ s_any, dg_uvalue, 0, 0 s_out = "u=" + s_any dift dg_uvalue > 1 d_any = dg_uvalue \ 1 dift dg_uvalue = d_any dfac d_any, dg_uvalue dift d_any = 1: $app s_out, ":P" endi endi ded$ s_any, dg_vvalue, 0, 0 $app s_out, ", v=" + s_any dift dg_vvalue > 1 d_any = dg_vvalue \ 1 dift dg_vvalue = d_any dfac d_any, dg_vvalue dift d_any = 1: $app s_out, ":P" endi endi ded$ s_any, dg_wvalue, 0, 0 $app s_out, ", w=" + s_any dift dg_wvalue > 1 d_any = dg_wvalue \ 1 dift dg_wvalue = d_any dfac d_any, dg_wvalue dift d_any = 1: $app s_out, ":P" endi endi $out s_out $out s_dashes 'pipe delimited into sg_xyzmath '$app sg_xyzmath, s_out + "|" $inp s_line, "s=show past xyz commands" $tup s_line, s_line 'do we have x=, or y= d_process = 2 $cut s_any, s_line, 1, 2 $ift s_any = "X=": d_process = 1 $ift s_any = "Y=": d_process = 1 $ift s_any = "Z=": d_process = 1 $ift s_any = "U=": d_process = 1 $ift s_any = "V=": d_process = 1 $ift s_any = "W=": d_process = 1 $ift s_any = "S" 'list from sg_xyzmath | pipe delimited $ch$ s_aster, "*", 60 s_line = "X=X" $out s_aster d_dot = 1 d_loop = 1 dwhi d_loop = 1 $par s_dot, sg_xyzmath, "|", d_dot $trb s_dot, s_dot $ift s_dot = sg_nothing dinc d_loop else $out s_dot dinc d_dot endi endw $out s_aster d_process = 1 endi endi s_command = "none" endw sg_pass1 = s_command ends sub_xyz_math subr sub_path_prog_memory 'updated 2011/09/26, 2010/11/29, 2010/09/21 '2010/05/31, 2010/05/28, 2007/12/22, 2007/12/01, 2007/11/12 '2006/09/25, 2006/09/04, 2006/08/29, 2006/04/23, 2005/10/08 vari s_any, d_any, d_dot, s_dot, s_out, s_dashline, s_date $ch$ s_dashline, "-", 70 $out s_dashline 'path $sys sg_path, 1 $trb sg_path, sg_path 'lines dsys d_any, 2 ded$ sg_lines, d_any, 0, 0 'path and lines $out sg_path + " " + sg_lines 'get teapro interpreter $sys sg_interpreter, 3 $trb sg_interpreter, sg_interpreter 'get load program $sys sg_loadprog, 4 'memory dsys d_any, 1 ded$ sg_memory, d_any, 0, 0 'interpreter and memory $out sg_interpreter + " " + sg_loadprog + " " + sg_memory 'ag_build come from top of this program 'teapro program build and program line count $out sg_build + " " + sg_loadprog $dat s_date $cut s_date, s_date, 1, 20 $out s_date $out s_dashline ends sub_path_prog_memory subr sub_speedquick 'updated 2010/10/14, 2010/09/27 '2010/08/02, 2010/07/08, 2010/04/29, 2010/04/16, 2010/02/04 '2009/11/10, 2009/11/08, 2009/10/19, 2009/10/18, 2008/02/23 vari d_any, s_any, d_dot, s_dot vari d_time, d_total, d_lines 'count of the loop d_total = 10 ^ 6 * 5 dsys d_lines, 2 dsec d_time d_any = 0 gtag tag_speedquick dinc d_any dift d_any < d_total: goto tag_speedquick dsec d_any dsys d_dot, 2 d_time = d_any - d_time dift d_time <= 0: d_time = 1 d_lines = d_dot - d_lines d_any = d_lines / d_time / 1000 / 1000 ded$ s_any, d_any, 2, 3 $dat s_dot $cut s_dot, s_dot, 1, 20 sg_pass1 = "meg_lines/sec= " + s_any + " " + " " + s_dot ends sub_speedquick subr sub_speed98_test 'updated 2011/09/19, 2011/09/12, 2011/09/11 '2011/09/09, 2011/09/08, 2010/09/21, 2010/09/01, 2010/03/07 '2010/03/05, 2009/03/15, 2009/01/25, 2008/02/02, 2008/02/01 '2007/12/09, 2007/12/08, 2007/12/07, 2007/12/01, 2007/11/23 '2007/11/21, 2007/11/20, 2007/11/18, 2007/11/16, 2007/11/12 '2007/11/04, 2007/09/15, 2007/07/11, 2007/04/16, 2007/04/11 '2005/11/30, 2005/11/20, 2005/03/31, 2005/02/26, 2004/12/03 'speed test vari d_any, s_any, d_dot, s_dot, d_tap, s_tap, s_out vari d_time, d_maxcount, s_maxcount, d_count vari d_number, d_index, d_mod1 vari s_dashline, d_tseconds vari d_teaquadpart, d_teaquadmult 'get current subroutine name $sys s_any, 2 $out s_any $ch$ s_dashline, "-", 70 $out s_dashline sub_path_prog_memory d_tseconds = 0 d_maxcount = 10 ^ 8 * 2 ded$ s_maxcount, d_maxcount, 0, 0 s_maxcount = " " + s_maxcount 'load array with 20000 primes 'put 20,000 primes in decimal array dsec d_tap d_number = 1 d_index = 1 dwhi d_index <= 20000 'get the lowest factor dfac d_mod1, d_number dift d_mod1 = 1 'we have a prime dtoi d_index, d_number dinc d_index endi d_number = d_number + 2 endw 'the first prime is 2 dtoi 1, 2 itod d_any, 20000 s_out = "prime array from=2 to=" + d_any $app s_out, " ct=20000" dsec d_any d_tap = d_any - d_tap $out s_out + " sec=" + d_tap d_tseconds = d_tseconds + d_tap 'dwhi dinc loop $out s_dashline d_count = 0 dsec d_time dwhi d_count < d_maxcount dinc d_count endw dsec d_any d_time = d_any - d_time d_tseconds = d_tseconds + d_time $out "1.seconds=" + d_time + " dwhi dinc loop" + s_maxcount 'dwhi ddec loop $out s_dashline d_count = d_maxcount dsec d_time dwhi d_count > 0 ddec d_count endw dsec d_any d_time = d_any - d_time d_tseconds = d_tseconds + d_time $out "2.seconds=" + d_time + " dwhi ddec loop" + s_maxcount 'dwhi +1 loop $out s_dashline d_count = 0 dsec d_time dwhi d_count < d_maxcount d_count = d_count + 1 endw dsec d_any d_time = d_any - d_time d_tseconds = d_tseconds + d_time $out "3.seconds=" + d_time + " dwhi +1 loop" + s_maxcount 'gtag dinc loop $out s_dashline d_count = 0 dsec d_time gtag tag_gtagdinc dinc d_count dift d_count < d_maxcount: goto tag_gtagdinc dsec d_any d_time = d_any - d_time d_tseconds = d_tseconds + d_time $out "4.seconds=" + d_time + " gtag dinc dift loop" + s_maxcount 'dwhi dinc itod $out s_dashline dsec d_time d_dot = 10 ^ 7 * 4 d_count = 0 d_index = 1 dwhi d_count < d_dot itod d_any, d_index dinc d_index dift d_index > 20000: d_index = 1 dinc d_count endw dsec d_any d_time = d_any - d_time d_tseconds = d_tseconds + d_time ded$ s_dot, d_dot, 0, 0 $out "5.seconds=" + d_time + " dwhi dinc itod " + s_dot $out "total=" + d_tseconds 'dduo $out s_dashline '10,999,970,611,232,206,361 d_teaquadmult = 10999 s_dot = "10,999,970,611,232,206,361" $out s_dot $off s_dot, s_dot, 19 $tod d_teaquadpart, s_dot dsec d_time dduo d_any, d_teaquadpart, d_teaquadmult $out "factor=" + d_any dsec d_any d_time = d_any - d_time d_tseconds = d_tseconds + d_time $out "6.seconds=" + d_time + " dduo" $out s_dashline $inp s_any, "tot secs=" + d_tseconds ends sub_speed98_test subr sub_speed_test 'updated 2008/02/02, 2008/01/25, 2007/12/22, 2007/12/14 '2007/12/09, 2007/12/08, 2007/12/07, 2007/12/01, 2007/11/23 '2007/11/21, 2007/11/20, 2007/11/18, 2007/11/16, 2007/11/12 '2007/11/04, 2007/09/15, 2007/07/11, 2007/04/16, 2007/04/11 '2005/11/30, 2005/11/20, 2005/03/31, 2005/02/26, 2004/12/03 'speed test vari d_any, s_any, d_dot, s_dot, s_out vari d_count, d_maxcount, d_index, d_time1, d_time2 vari s_dashline, d_tseconds vari d_teaquadpart, d_teaquadmult 'get current subroutine name $sys s_any, 2 $out s_any $ch$ s_dashline, "-", 70 $out s_dashline sub_path_prog_memory d_tseconds = 0 d_maxcount = 10 ^ 6 * 100 'dwhi dinc loop $out s_dashline d_count = 0 dsec d_time1 dwhi d_count < d_maxcount dinc d_count endw dsec d_any d_time1 = d_any - d_time1 d_tseconds = d_tseconds + d_time1 ded$ s_any, d_maxcount, 0, 0 $out s_any + " dinc loop, seconds=" + d_time1 'dwhi +1 loop $out s_dashline d_count = 0 dsec d_time2 dwhi d_count < d_maxcount d_count = d_count + 1 endw dsec d_any d_time2 = d_any - d_time2 d_tseconds = d_tseconds + d_time2 ded$ s_any, d_maxcount, 0, 0 $out s_any + " +1 loop, seconds=" + d_time2 $out s_dashline $out "total time=" + d_tseconds $out s_dashline sub_path_prog_memory $out s_dashline $inp s_any, "done" ends sub_speed_test