'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, sg_build
vari dg_changes, dg_bookcurrent
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
vari sg_foundnum1, sg_foundnum2, sg_foundnum3, sg_foundnum4, sg_foundnum5
vari sg_foundstr1, sg_foundstr2, sg_foundstr3, sg_foundstr4, 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_lineshold
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_linesbad, dg_linesbad, sg_surnames, sg_key, dg_key
'xyzmath
vari dg_xvalue, dg_yvalue, dg_zvalue, sg_xyzmath
'xyzmath for total and bank for money
'call the sub_main subroutine to start the program
sub_main
endp
subr sub_main
'updated 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
d_loop = 1
dwhi d_loop = 1
sub_initialize
$out s_aster
sg_build = "Program: fixran.tea, build=744, 2010/02/04"
$out sg_build
$out "Copyright (c) 1998-2010 by D La Pierre Ballard"
$out "Download this program from www.teapro.com"
$out "This program was begun on 10-JAN-1998"
$out "It was written by D La Pierre Ballard"
$out "Written in the Teapro programming language which"
$out "uses the OpenTea technology to be simple and solid"
$out "Teapro was invented on 14-DEC-1997"
$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
$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_oledot"
$out "6. sub_file_hash"
$out "96. sub_xyz_math"
$out "97. sub_teaquad_prime_duo_speed_test"
$out "98. sub_speed98_test"
$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_oledot
dift d_pick = 6: sub_file_hash
dift d_pick = 96
sg_pass1 = "x=x"
sub_xyz_math
endi
dift d_pick = 97: sub_teaquad_prime_duo_speed_test
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
$len d_any, sg_cmdline
dift d_any > 1
$cut s_any, sg_cmdline, 1, 4
$clo s_any, s_any
$ift s_any <> "redo"
'append a tab character sg_cmdline is tab delimited
dch$ s_any, 9, 1
sg_cmdredo = sg_cmdline + s_any + sg_cmdredo
else
sub_redo_commands
endi
endi
'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_lineshold
$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
'oledot
$ift sg_cmd0 = "oledot": sub_file_oledot
'hunt one string, not case sensitive
$ift sg_cmd0 = "one"
dg_pass4 = 1
dg_pass0 = 2
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 2009/11/07
'2009/02/16, 2006/07/14, 2005/08/12, 2005/08/07, 2004/12/30
'get the paramters from the command in sg_cmdline
'string parameters are found by the commands
'put them in dg_cmd1, dg_cmd2, dg_cmd3
vari s_any, d_any, s_dot, d_dot
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
dg_quiet = 2
'we can have either " or # at 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
$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 strings into s_str1 etc
s_commline = sg_cmdline
d_count = 0
d_loop = 1
dwhi d_loop = 1
'we can have either " or # at a string delimiter
$lok d_beg, s_commline, 1, s_quote
dift d_beg > 0
d_end = d_beg + 1
$lok d_end, s_commline, d_end, s_quote
dift d_end > 0
d_long = d_end - d_beg
$cut s_dot, s_commline, d_beg, d_long
'replace the string parameter with nothing
dinc d_long
$del s_commline, d_beg, d_long
'put the string parameter in sg_cmd1 etc
dinc d_count
dift d_count = 1: $cut sg_cmd1, s_dot, 2, 99
dift d_count = 2: $cut sg_cmd2, s_dot, 2, 99
dift d_count = 3: $cut sg_cmd3, s_dot, 2, 99
dift d_count = 4: $cut sg_cmd4, s_dot, 2, 99
else
dinc d_loop
endi
else
dinc d_loop
endi
endw
'separate the command from the 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, 99
'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
$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
$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
$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
$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
$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
'initialize command parameters
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
'so that you can have a K=1000 inside a number 200k
$ift s_byte = "K"
$del s_line, d_byte, 1
$ins s_line, d_byte, "000"
$len d_long, s_line
$cut s_byte, s_line, d_byte, 1
endi
'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 "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 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"string1","string2","string3",500 find strings beginning at 500#
$out "f,600 find previous string starting at 600, see ONE"
$out #h"string1","string2","string3",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 "oledot to oledot 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, punctuation, 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 345,789 to thin out lines range 345/789"
$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 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
$trb sg_nothing, " "
'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
sg_find1 = sg_nothing
sg_find2 = sg_nothing
sg_find3 = sg_nothing
sg_deletedlines = sg_nothing
sg_lineshold = 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_linesbad = 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 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
'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
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_lineshold
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 2001/01/10
'add some records starting at dg_pass1 or dg_add
vari d_loop, d_add
d_add = dg_pass1
dift d_add = 0: d_add = dg_add
dg_add = d_add
d_loop = 1
dwhi d_loop = 1
'dg_add is where it will add
sub_add2
d_loop = dg_pass1
endw
ends sub_add1
subr sub_add2
'updated 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
vari d_hold, d_long, s_blanks
vari s_inputrecord, s_record, d_byte, s_byte
'is dg_add beyond the end of the file
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
'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_record, 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 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
$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
dift dg_nowline <> d_record: dg_ampline = dg_nowline
dg_nowline = d_record
dg_modify = d_record
'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
dift d_record > d_end: dinc d_loop
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 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
vari d_good, d_loop, d_lines, d_process
vari d_begin, d_end, 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
'find is case sensitive hunt is not
d_yesfind = dg_pass0
'if one find string then begin in 2 else if 2 then 3
d_begin = dg_pass2
dift d_begin = 0: d_begin = dg_pass3
'do we want to find just one d_justone=1
d_justone = dg_pass4
s_findstr1 = sg_pass1
s_findstr2 = sg_pass2
s_findstr3 = sg_pass3
d_process = 1
dift dg_debug = 1
s_any = "1=" + s_findstr1 + ", 2=" + s_findstr2
$app s_any, ", 3=" + s_findstr3
$app s_any, ", d_begin=" + d_begin
$out s_any
$inp s_any, "return or *"
$ift s_any = "*": dinc d_process
endi
d_count = 0
dift d_process = 1
'test to see if valid s_findstr1
$lok d_dot, sg_cmdline, 1, #"#
dift d_dot = 0: $lok d_dot, sg_cmdline, 1, "#"
dift d_dot > 0
'we should have a s_findstr1
$len d_any, s_findstr1
dift d_any = 0
$out "bad findstr"
dinc d_process
endi
endi
endi
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_begin = 0: d_begin = dg_findbegin
dg_findbegin = d_begin
$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
$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 "begin=" + d_begin
d_end = d_begin
d_recct = 0
d_record = d_begin
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_end = 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
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
s_any = "found=" + d_count + ", begin=" + d_begin
$app s_any, ", end=" + d_end
$out s_any
endi
ends sub_find_hunt
subr sub_find_fast
'updated 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
$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 record number."
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_linesbad
s_findstr = "bad lines"
endi
dift d_which = 6: s_findstr = sg_linesbad
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_redo_commands
'updated 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, d_long
vari d_which
'sg_cmdredo is tab=char 9 delimited
'we have redo in sg_cmdline do we have a number
$cut s_any, sg_cmdline, 5, 20
d_which = 0
$isd d_any, s_any
dift d_any = 1: $tod d_which, s_any
d_lines = 0
d_dot = 1
dch$ s_tab, 9, 1
d_loop = 1
dwhi d_loop = 1
'get command d_dot
$par s_command, sg_cmdredo, s_tab, d_dot
$trb s_command, s_command
$len d_long, s_command
dift d_long = 0
'beyond end drop out
dinc d_loop
else
dift d_which = 0
'just show redo commands
dinc d_lines
dift d_lines > dg_maxlines
d_lines = 1
$inp s_dot, "more commands, * to end"
$tlo s_any, s_dot
$len d_any, s_any
dift d_any > 0
$ift s_any = "*"
dinc d_loop
else
sg_cmdline = s_dot
endi
endi
endi
'show redo command
dift d_loop = 1: $out d_dot + ". " + s_command
else
dift d_dot = d_which
'found wanted command
sg_cmdline = s_command
dinc d_loop
endi
endi
endi
dinc d_dot
endw
ends sub_redo_commands
subr sub_change
'updated 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_begin, d_end, 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_dot = sg_cmdline
$lok d_dot, s_dot, 1, s_quote
dift d_dot = 0: dinc d_process
dift d_process = 1
'get the location of the change from string
dinc d_dot
$cut s_dot, s_dot, d_dot, 200
$lok d_dot, s_dot, 1, s_quote
ddec d_dot
dift d_dot = 0: dinc d_process
endi
dift d_process = 1
'get change from string
$cut s_change1, s_dot, 1, d_dot
d_dot = d_dot + 2
$cut s_dot, s_dot, d_dot, 200
$lok d_dot, s_dot, 1, s_quote
dift d_dot = 0: dinc d_process
endi
dift d_process = 1
dinc d_dot
$cut s_dot, s_dot, d_dot, 200
$lok d_dot, s_dot, 1, s_quote
dift d_dot = 0: dinc d_process
endi
dift d_process = 1
'get the second change string
ddec d_dot
$cut s_change2, s_dot, 1, d_dot
'do we have a beginning and ending record number
'c"the","THE",500,600
d_begin = 1
d_end = 99999 * 10
d_dot = d_dot + 3
$cut s_dot, s_dot, d_dot, 200
$trb s_dot, s_dot
$lok d_dot, s_dot, 1, ","
dift d_dot = 0: $lok d_dot, s_dot, 1, "/"
dift d_dot > 0
ddec d_dot
$cut s_any, s_dot, 1, d_dot
$isd d_any, s_any
dift d_any = 1: $tod d_begin, s_any
d_dot = d_dot + 2
$cut s_any, s_dot, d_dot, 999
$isd d_any, s_any
dift d_any = 1: $tod d_end, s_any
else
$isd d_any, s_dot
dift d_any = 1: $tod d_begin, s_dot
endi
dift d_begin > d_end: dinc d_process
'the first string cannot be blanks only
$isc d_any, s_change1, " "
dift d_any = 1
$inp s_any, "first string is blank, return"
$ift s_any = "*": dinc d_process
endi
endi
dift d_process = 1
'character 34 in s_quote is "
$out "change1='" + s_change1 + "'"
$out "change2='" + s_change2 + "'"
$len d_len1, s_change1
$len d_len2, s_change2
'read through the file with the record number in d_record
d_record = d_begin
d_count = 0
d_loop = 1
endi
'd_mode = 1 means ask
'd_mode = 2 means automatic
s_listrange = d_begin + "/" + d_end
s_findnum = sg_nothing
d_yatbyte = 1
d_mode = 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_end: 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 "count of replacements=" + 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 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
vari d_torecord, s_torecord
vari d_count, d_push, s_delrecord
vari d_firstgood, d_lastgood
d_beg = dg_pass1
d_end = dg_pass2
d_process = 1
dift d_beg < 6: d_beg = 6
dift d_beg >= d_end: dinc d_process
dift d_process = 1
'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
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
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"
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 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
'the default wraplong is 67
dg_wraplong = 67
dift d_wraplong >= 50
dift d_wraplong <= 70: dg_wraplong = d_wraplong
endi
d_wraplong = dg_wraplong
else
d_wraplong = 66
dift dg_wraplong < 50: d_wraplong = 61
dift dg_wraplong = 50: d_wraplong = 55
dift dg_wraplong = 55: d_wraplong = 58
dift dg_wraplong = 58: d_wraplong = 61
dift dg_wraplong = 61: d_wraplong = 64
dift dg_wraplong = 64: d_wraplong = 67
dift dg_wraplong = 67: d_wraplong = 70
dift dg_wraplong >= 70: d_wraplong = 50
dg_wraplong = d_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
'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 = 54
'right now d_wraplong=54 is not needed
d_wraplong = 58
dg_wraplong = 58
endi
dift d_wraplong = 54
'wrap a chess game score
'find " 99. "
$bak d_byte, s_hold, 63, "."
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 > 54
'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 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, s_beg
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_bank
vari d_recomonth, d_totmonth, s_totmonth
vari d_total, s_total
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_total = 0
d_balance = 0
d_bank = 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_bank = d_bank + d_delta
dinc d_showrecord
endi
'total and get s_total
d_total = d_total + d_delta
d_any = d_total / 100
dto$ s_total, d_any, 10, 2
$trb s_total, s_total
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_total / 100
d_dot = d_bank / 100
dto$ s_any, d_any, 10, 2
dto$ s_dot, d_dot, 10, 2
$out "total=" + s_any + ", bank=" + s_dot
sub_more
dift dg_more <> 1: dinc d_loop
d_linect = 1
endi
endi
dinc d_record
endw
dift d_process = 1
d_total = d_total / 100
d_bank = d_bank / 100
d_totmonth = d_totmonth / 100
dto$ s_any, d_total, 10, 2
dto$ s_dot, d_bank, 10, 2
dto$ s_beg, d_totmonth, 10, 2
s_any = "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_oledot
'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
'oledot
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_oledot
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 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 + " " + 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 2007/03/26, 2007/03/25, 2006/07/13, 2005/01/16, 2004/10/21
'indent a Teapro program
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
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_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 lines beginning with <
$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 lines to shift
dinc d_count
$cut s_command, s_line, 1, 4
$cup s_command, s_command
d_delta = 0
$ift s_command = "SUBR"
d_spaces = 0
d_delta = d_shift
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_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 = "ENDS"
d_spaces = 0
d_show = 1
endi
endi
dift d_good = 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 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
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 ], do DATESTRING$"
$ift s_any = "1": d_nobegbracket = 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
$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
'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_linesbad = 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_linesbad = 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_linesbad = 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_linesbad and sg_all
sg_linesbad = 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_linesbad 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_linesbad 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 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
$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
$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
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
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_linesbad = sg_linesbad + 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_linesbad = sg_linesbad + 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 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 qtp20.com'"
$out "11=for link 'return to alisabassano.com'"
$out "12=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 = "email03.jpg"
dg_bookdomain = 9
endi
$ift s_pick = "10"
s_homeurl = "qtp20.com"
s_email = "email02.jpg"
dg_bookdomain = 10
endi
$ift s_pick = "11"
s_homeurl = "alisabassano.com"
dg_bookdomain = 11
endi
$ift s_pick = "12"
s_homeurl = sg_nothing
dg_bookdomain = 12
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 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
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_any = sg_filecode + ".toe"
flen d_long, s_any
dift d_long > 0
$out "file exists=" + s_any + " length=" + d_long
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 19:17
']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 19:17
']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 19:17
']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 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
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_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
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
$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 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 = 18
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 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_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 = 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 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
$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_lineshold = sg_lineshold + d_line + ","
dinc d_process
endi
d_which = 1
d_loop = d_process
dwhi d_loop = 1
$par s_dot, sg_lineshold, ",", 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 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, s_out, d_tap
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
vari d_begteaquadpart, d_begteaquadmult
vari d_prevrecord, s_prevshow, s_log
vari d_prevteaquadmult, d_prevteaquadpart
vari d_process, d_testeach, d_endteaquadyes, d_nostop
vari d_endteaquadpart, d_endteaquadmult, d_endteaquadct
vari d_teaquadpart, d_teaquadmult, d_teaquadone
vari s_teaquadrecord, d_diff, d_refnum, d_ctnum
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
$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
s_number = "9,000,000,000,000,001"
$inp s_any, "enter begin number, default=" + s_number
$ift s_any = "*": dinc d_process
$trb s_any, s_any
$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
d_nostop = 2
$inp s_any, "1=nostop"
$ift s_any = "*": dinc d_process
$ift s_any = "1": d_nostop = 1
endi
dift d_process = 1
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"
$ift s_any = "*": dinc d_process
d_testeach = 1
$ift s_any = "1": dinc d_testeach
endi
dift d_process = 1
d_endteaquadyes = 0
d_endteaquadpart = 0
d_endteaquadmult = d_begteaquadmult + 1
dift d_testeach = 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
dpow d_teaquadone, 10, 15
dpow d_2mindiff, 10, 20
dpow d_3mindiff, 10, 20
dpow d_4mindiff, 10, 20
d_ctnum = 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
$cut s_record, s_record, 1, 70
'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="
dift d_tap = 0
dinc d_good
d_ctnum = 0
endi
endi
dift d_good = 1
'we have a record s_record with 5TP39=
'first validate count numbers on left
'] 000:5TP39=
dinc d_ctnum
$lok d_any, s_record, 1, ":"
d_any = d_any - 3
d_dot = 1
dift d_any >= 2
$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
dift d_any <> d_ctnum: dinc d_dot
endi
else
dinc d_dot
endi
else
dinc d_dot
endi
dift d_dot <> 1
$out d_record + " " + s_record
$inp s_any, "bad left count=" + d_ctnum
$ift s_any = "*"
dinc d_good
dinc d_loop
endi
endi
endi
dift d_good = 1
'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
'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
'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_any = d_qtppart01 - d_qtppart02
dift d_any < 0: d_any = d_any + d_teaquadone
dift d_any > d_2maxdiff
d_2maxdiff = d_any
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
endi
endi
endi
endi
dift d_good = 1
'2min
dift d_qtppart02 > 0
d_any = d_qtppart01 - d_qtppart02
dift d_any < 0: d_any = d_any + d_teaquadone
dift d_any < d_2mindiff
d_2mindiff = d_any
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
endi
endi
endi
dift d_good = 1
'3min
dift d_qtppart03 > 0
d_any = d_qtppart01 - d_qtppart03
dift d_any < 0: d_any = d_any + d_teaquadone
dift d_any < d_3mindiff
d_3mindiff = d_any
s_3minrec1 = s_qtprec01
s_3minrec2 = s_qtprec02
s_3minrec3 = s_qtprec03
$out s_dashes
$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_any = d_qtppart01 - d_qtppart04
dift d_any < 0: d_any = d_any + d_teaquadone
dift d_any < d_4mindiff
d_4mindiff = d_any
s_4minrec1 = s_qtprec01
s_4minrec2 = s_qtprec02
s_4minrec3 = s_qtprec03
s_4minrec4 = s_qtprec04
$out s_dashes
$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
'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
$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
$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
$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_testeach <> 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
$inp s_any, "less than"
$ift s_any = "*": dinc d_loop
endi
dift d_teaquadpart = d_prevteaquadpart
$inp s_any, "equal to"
$ift s_any = "*": dinc d_loop
endi
endi
'd_teaquadmult can never decline
dift d_teaquadmult < d_prevteaquadmult
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_prevrecord = d_record
s_prevprimeline = s_teaquadrecord
'are we upto d_begteaquadpart,d_begteaquadmult
dift d_teaquadmult < d_begteaquadmult
dinc d_good
else
dift d_teaquadmult >= d_begteaquadmult
dift d_teaquadpart < d_begteaquadpart
dinc d_good
endi
endi
endi
endi
dift d_good = 1
'do we not want to test each
dift d_testeach <> 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
dg_pass1 = d_teaquadpart
dg_pass2 = d_teaquadmult
sub_teaquad_5tp39_test
d_good = dg_pass1
dsec d_time2
dift d_good <> 1
$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
s_out = "qtpct=" + d_qtpcount + ", last=" + s_rawnumber
$out s_out
$out s_dashes
sub_path_prog_memory
$inp s_any, "return"
ends sub_teaquad_5tp39_from_file
subr sub_teaquad_5tp39_test
'updated 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
'11,13,17,19,29,31,41,43,47,49
d_teaquadpart = dg_pass1
d_teaquadmult = dg_pass2
dfak d_good, d_teaquadpart, d_teaquadmult
d_any = d_teaquadpart + 2
dift d_good = 1: dfak d_good, d_any, d_teaquadmult
d_any = d_teaquadpart + 6
dift d_good = 1: dfak d_good, d_any, d_teaquadmult
d_any = d_teaquadpart + 8
dift d_good = 1: dfak d_good, d_any, d_teaquadmult
d_any = d_teaquadpart + 18
dift d_good = 1: dfak d_good, d_any, d_teaquadmult
d_any = d_teaquadpart + 20
dift d_good = 1: dfak d_good, d_any, d_teaquadmult
d_any = d_teaquadpart + 30
dift d_good = 1: dfak d_good, d_any, d_teaquadmult
d_any = d_teaquadpart + 32
dift d_good = 1: dfak d_good, d_any, d_teaquadmult
d_any = d_teaquadpart + 36
dift d_good = 1: dfak d_good, d_any, d_teaquadmult
d_any = d_teaquadpart + 38
dift d_good = 1: dfak 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 2007/10/07, 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
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
dwhi d_process = 1
'x is in dg_xvalue, y is in dg_yvalue, z in dg_zvalue
'remove commas and blanks
$swp s_line, ",", sg_nothing
$swp s_line, " ", sg_nothing
'semi-colon 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
$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
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 = "/"
d_answer = d_answer / d_number
endi
$ift s_operator = "\"
d_answer = d_answer \ d_number
endi
$ift s_operator = "^"
dpow 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 = ":"
dfac d_answer, d_answer
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
$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
'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
$out s_dashes
'semi-colon 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 = "S"
'list from sg_xyzmath semi-colon 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 2007/12/17, 2007/12/01, 2007/11/12
'2006/09/25, 2006/09/04, 2006/08/29, 2006/04/23, 2005/10/08
vari s_out, s_path, d_memory, s_memory
vari s_date, s_version, d_lines, s_lines
$sys s_version, 3
$out s_version
$out sg_build
$sys s_path, 1
$out "Path: " + s_path
$dat s_date
$cut s_date, s_date, 1, 20
dsys d_memory, 1
ded$ s_memory, d_memory, 0, 0
dsys d_lines, 2
ded$ s_lines, d_lines, 0, 0
s_out = "memory=" + s_memory + ", lines=" + s_lines
$app s_out, ", date=" + s_date
$out s_out
ends sub_path_prog_memory
subr sub_teaquad_prime_duo_speed_test
'updated 2009/05/07
'test qtp20 for speed test
vari d_any, s_any, d_dot, s_dot, s_out
vari d_sec1, d_sec2, d_sec3
vari s_number, d_factor
vari d_teaquadpart, d_teaquadmult
s_number = "10,100,000,026,832,025,221"
$out "testing=" + s_number
sg_pass1 = s_number
sub_teaquad_from_string
d_teaquadpart = dg_pass1
d_teaquadmult = dg_pass2
dsec d_sec1
dduo d_factor, d_teaquadpart, d_teaquadmult
dsec d_sec2
$out s_number
d_sec3 = d_sec2 - d_sec1
d_any = d_sec3 * 5
s_out = "factor=" + d_factor + " secs=" + d_sec3
$app s_out, " 5x=" + d_any
$out s_out
$inp s_any, "return"
ends sub_teaquad_prime_duo_speed_test
subr sub_speedquick
'updated 2010/02/04
'2009/11/10, 2009/11/08, 2009/10/19, 2009/10/18, 2008/02/23
vari d_any, s_dot, d_dot, d_time
'ten million loop
d_dot = 10 ^ 7
dsec d_time
d_any = 0
dwhi d_any < d_dot
dinc d_any
endw
dsec d_any
d_dot = d_any - d_time
dift d_dot <= 0: d_dot = 1
d_any = 37 / d_dot / 10
sg_pass1 = "10^7 time= " + d_dot + " mflops/thread= " + d_any
ends sub_speedquick
subr sub_speed98_test
'updated 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, s_out
vari d_time, d_max, d_count, d_index
vari s_dashes, d_tseconds
vari d_teaquadpart, d_teaquadmult
$sys s_any, 2
$out s_any
$ch$ s_dashes, "-", 70
$out s_dashes
sub_path_prog_memory
d_tseconds = 0
d_max = 10000 * 5000
'load array
d_index = 1
dwhi d_index <= 8000
dtoi d_index, d_index
dinc d_index
endw
'dwhi dinc loop
$out s_dashes
d_count = 0
dsec d_time
dwhi d_count < d_max
dinc d_count
endw
dsec d_any
d_time = d_any - d_time
d_tseconds = d_tseconds + d_time
$out "seconds=" + d_time + " dwhi dinc loop"
'dwhi +1 loop
$out s_dashes
d_count = 0
dsec d_time
dwhi d_count < d_max
d_count = d_count + 1
endw
dsec d_any
d_time = d_any - d_time
d_tseconds = d_tseconds + d_time
$out "seconds=" + d_time + " dwhi +1 loop"
'gtag dinc loop
$out s_dashes
d_count = 0
dsec d_time
gtag tag_gtagdinc
dinc d_count
dift d_count < d_max: goto tag_gtagdinc
dsec d_any
d_time = d_any - d_time
d_tseconds = d_tseconds + d_time
$out "seconds=" + d_time + " gtag dinc dift loop"
'gtag +1 dift loop
$out s_dashes
d_count = 0
dsec d_time
gtag tag_gtagplusone
d_count = d_count + 1
dift d_count < d_max: goto tag_gtagplusone
dsec d_any
d_time = d_any - d_time
d_tseconds = d_tseconds + d_time
$out "seconds=" + d_time + " gtag +1 dift loop"
'dwhi dift gtag loop
$out s_dashes
d_count = 0
dsec d_time
dwhi 1 = 1
dinc d_count
dift d_count >= d_max: goto tag_dwhigtag
endw
gtag tag_dwhigtag
dsec d_any
d_time = d_any - d_time
d_tseconds = d_tseconds + d_time
$out "seconds=" + d_time + " dwhi dift gtag"
'gtag dift gtag loop
$out s_dashes
d_count = 0
dsec d_time
gtag tag_gtaggtag1
dinc d_count
dift d_count >= d_max: goto tag_gtaggtag2
goto tag_gtaggtag1
gtag tag_gtaggtag2
dsec d_any
d_time = d_any - d_time
d_tseconds = d_tseconds + d_time
$out "seconds=" + d_time + " gtag dift gtag loop"
'gtag dift itod
$out s_dashes
dsec d_time
d_count = 0
d_index = 1
gtag tag_diftitod
itod d_any, d_index
dinc d_index
dift d_index > 8000: d_index = 1
dinc d_count
dift d_count <= d_max: goto tag_diftitod
dsec d_any
d_time = d_any - d_time
d_tseconds = d_tseconds + d_time
$out "seconds=" + d_time + " gtag dift itod"
$out s_dashes
ded$ s_any, d_max, 0, 0
$out "loops=" + s_any
$out "total seconds=" + d_tseconds
$out s_dashes
$inp s_any, "done"
ends sub_speed98_test
subr sub_speed_test
'updated 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_time, d_max, d_count, d_index
vari s_dashes, d_tseconds
vari d_teaquadpart, d_teaquadmult
$sys s_any, 2
$out s_any
$ch$ s_dashes, "-", 70
$out s_dashes
sub_path_prog_memory
d_tseconds = 0
d_max = 10 ^ 6 * 100
'dwhi dinc loop
$out s_dashes
d_count = 0
dsec d_time
dwhi d_count < d_max
dinc d_count
endw
dsec d_any
d_time = d_any - d_time
d_tseconds = d_tseconds + d_time
ded$ s_any, d_max, 0, 0
$out s_any + " loop, seconds=" + d_time
$out s_dashes
sub_path_prog_memory
$out s_dashes
$inp s_any, "done"
ends sub_speed_test