'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.
'In today's world, we 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_ampersandline, 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
'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
'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 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
sub_initialize
$ch$ s_aster, "*", 76
d_loop = 1
dwhi d_loop = 1
sub_initialize
$out s_aster
sg_build = "Program: fixran.tea, build=683 2008/11/28"
$out sg_build
$out "Copyright (c) 1998-2008 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
s_any = "In today's world, we need computer software "
$app s_any, "that actually works."
$out s_any
$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
$out s_aster
$out "1. process a fixran file"
$out "2. build a new empty fixran file"
$out "4. sub_file_delete"
$out "5. sub_file_oldtoe"
$out "6. sub_file_hash"
$out "96. sub_xyz_math"
$out "97. sub_teaquad_prime_speed_test"
$out "98. sub_speed98_test"
$out "99. sub_speed_test " + dg_pass1
$out "* = end"
$inp s_pick, "pick a number" + " x=" + dg_xvalue
$isd d_any, s_pick
d_pick = 0
dift d_any = 1: $tod d_pick, s_pick
dift d_pick = 1: sub_process_file
dift d_pick = 2
sub_get_filenames
dift dg_pass1 = 1: sub_file_new
endi
dift d_pick = 4: sub_file_delete
dift d_pick = 5: sub_file_oldtoe
dift d_pick = 6: sub_file_hash
dift d_pick = 96
sg_pass1 = "x=x"
sub_xyz_math
endi
dift d_pick = 97: sub_teaquad_prime_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 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
$app sg_cmdredo, sg_cmdline + s_any
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 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_ampersandline
$ift sg_cmd0 = "@": $out "@=" + dg_nowline
$ift sg_cmd0 = "^": $out "^=" + dg_list1
'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 = 4: sub_wrap
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_quick_find
endi
'fast hunt
$ift sg_cmd0 = "hunt"
dg_pass1 = 1
sub_quick_find
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
'money totalling and mode
$ift sg_cmd0 = "money": sub_money
'note
$ift sg_cmd0 = "note": sub_note
'next chapter to dg_echapter
$ift s_4longcmd = "next": sub_next_back_chapter
'oldtoe
$ift sg_cmd0 = "oldtoe": sub_file_oldtoe
'hunt one string, not case sensitive
$ift sg_cmd0 = "one"
dg_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 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_ampersandline
$lok d_dot, s_parameters, 1, "&"
dwhi d_dot > 0
s_any = dg_ampersandline
$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 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
'if dg_cmd1 > 0 and sg_cmd0 = "V" then set dg_ampersandline
dift dg_cmd1 > 0
$ift sg_cmd0 = "V": dg_ampersandline = dg_cmd1
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 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 "+ 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 "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 "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 "nexte set e chapter next one chapter"
$out "nextr set r chapter next one chapter"
$out "nextt set t chapter next one chapter"
$out "note to see and add to the note"
$out "oldtoe to oldtoe a file"
$out #one"XX",458 works just like hunt but only finds one#
$out "past show options for showing past finds"
$out "past 3 to show third find past"
$out #pattern "pattern","pattern in chars"#
$out "patterns: escapes, space, 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_ampersandline = 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_ampersandline
dg_pass1 = dg_ampersandline
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 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
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 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_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 5 here
'we do not want to push dg_add here
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_record, sg_pass1
'do a right trim to see if we have just blanks
$trr s_record, s_record
'we have a record to add
$ift s_record <> "//"
$ift s_record = ")": s_record = "]"
'prep the record
$ch$ s_blanks, " ", 80
$app s_record, s_blanks
'if ) and second byte not blank make ]
$cut s_any, s_record, 1, 1
$ift s_any = ")"
$cut s_any, s_record, 2, 1
$ift s_any <> " ": $rep s_record, 1, "]"
endi
'do we have a dash record
$cut s_any, s_record, 1, 2
$ift s_any = "]-"
$ch$ s_any, "-", 69
s_record = "]" + s_any + s_blanks
endi
'do we have an asterisk record
$cut s_any, s_record, 1, 2
$ift s_any = "]*"
$ch$ s_any, "*", 69
s_record = "]" + s_any + s_blanks
endi
$cut s_record, s_record, 1, 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
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 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
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 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
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 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
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 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
dift d_record > 99999
'if record number is big put token in 7
s_out = s_dot + " " + s_goodrecord
dift d_record = dg_ampersandline: $rep s_out, 7, "&"
dift d_record = dg_nowline: $rep s_out, 7, "@"
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"
$out s_out
else
'if record number is not big put token in 1
s_out = s_dot + " " + s_goodrecord
dift d_record = dg_ampersandline: $rep s_out, 1, "&"
dift d_record = dg_nowline: $rep s_out, 1, "@"
dift d_record = dg_list1: $rep s_out, 1, "^"
dift d_record = dg_wrapline: $rep s_out, 1, "w"
dift d_record = dg_echapter: $rep s_out, 1, "e"
dift d_record = dg_rchapter: $rep s_out, 1, "r"
dift d_record = dg_tchapter: $rep s_out, 1, "t"
dift d_record = dg_view1s: $rep s_out, 1, "s"
dift d_record = dg_view1v: $rep s_out, 1, "v"
dift d_record = dg_view1x: $rep s_out, 1, "x"
dift d_record = dg_view1z: $rep s_out, 1, "z"
$out s_out
endi
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 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
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
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: dg_nowline = d_record
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_quick_find
'updated 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
'save the lines number
dto$ s_any, d_record, 6, 0
$app s_findnum, s_any + ","
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
dift dg_quiet = 1: dinc d_good
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_quick_find
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 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 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 = 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 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 % 100
dift d_any = 0: $sho "pattern=" + d_record
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
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 "found=" + d_findct
sg_pass1 = s_findnum
dg_pass1 = 1
dg_pass2 = 0
sub_string_lines_show
endi
ends sub_pattern_look
subr sub_redo_commands
'updated 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_any, "more commands, * to end"
$ift s_any = "*": dinc d_loop
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 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
dinc d_process
$out "first string is blank"
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 + ","
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 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
d_record = dg_pass1
dift d_record < 1: d_record = dg_chaplinetoshow
'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
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
dinc d_lines
dift d_lines > dg_maxlines
d_lines = 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
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 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
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_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
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 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