--------------------------------------
REM.. COMPRES
REM.. BY C J Waldock
REM.. (C) The Micro User
REM.. Compresses segment commands
REM..  and strips out REMS.
REM.. Put segment program in TEXT.
REM.. Save result on ANOTHER disc
REM..  in $ directory.

REM.. set constant carriage return
 R$=chr$13

REM.. TEXT may be changed to SEGMENT
 select text
 cursor down 4

cls
vdu10,10,10
print"     Working . . . please wait"

REM.. strip REMs
repeat
 find "REM##"
 cursor at 0
 fkey 3
 find R$
 cursor right
 fkey 3
 fkey 7
until EOT

REM.. Now convert common commands
REM.. to their minimum form

A$="repeat"
B$="r."
procCHANGE

A$="dothis"
B$="d."
procCHANGE

A$="times "
B$="t."
procCHANGE

A$="endproc"
B$="e."
procCHANGE

A$="cursor "
B$="c."
procCHANGE

A$="delete "
B$="de."
procCHANGE

A$="at "
B$="a."
procCHANGE

A$="left "
B$="l."
procCHANGE

A$="left"
B$="l."
procCHANGE

A$="right "
B$="r."
procCHANGE

A$="right"
B$="r."
procCHANGE

A$="up "
B$="u."
procCHANGE

A$="up"
B$="u."
procCHANGE

A$="down "
B$="d."
procCHANGE

A$="down"
B$="d."
procCHANGE

A$="select "
B$="s."
procCHANGE

A$="text"
B$="te."
procCHANGE

A$="delete "
B$="de."
procCHANGE

A$="if "
B$="i."
procCHANGE

A$="then "
B$="t."
procCHANGE

A$=" t."
B$="t."
procCHANGE

A$="display"
B$="di."
procCHANGE

A$="goto "
B$="g."
procCHANGE

A$="print "
B$="p."
procCHANGE

A$="print"
B$="p."
procCHANGE

A$="fkey "
B$="fk."
procCHANGE

A$="chr$ "
B$="c."
procCHANGE

A$="chr$"
B$="c."
procCHANGE

A$="vdu "
B$="v."
procCHANGE

A$="until "
B$="u."
procCHANGE

A$="false"
B$="fa."
procCHANGE

A$="find "
B$="f."
procCHANGE

A$="type "
B$="ty."
procCHANGE

A$="top"
B$="t."
procCHANGE

A$="bottom"
B$="b."
procCHANGE

A$="replace "
B$="repl."
procCHANGE

A$="segment "
B$="s."
procCHANGE

REM.. remove double line spacing
cursor top
repeat
 replace R$+R$,R$
until EOT

print
print"Any COMMAND words found in "
print"QUOTES will also be compressed."
print"You need to go through and expand these"
print"(if any), by hand."
print
print"Save working files on another disc"
print
print"- save in $.(default) directory."
print
print"Press any key to continue"
G%=get
display
END

.CHANGE
 cursor top
 repeat
 replace A$,B$
 until EOT
endproc
---------------------------------------
REM: INTEGRI by C J Waldock
REM  (c) MICRO USER 1990
REM: checks database file for integrity
REM: stops with beep if first character
REM: of a record is not ">"

select text
cursor top
cursor down 4
repeat
  S$=gct$
  cursor left
  if S$<>">" then goto END
  cursor down 9
until false

.END
vdu 7
display
end
---------------------------------------
REM "D.REGISTR"
REM BY C J Waldock
REM (C) The Micro User
REM Prints attendance register

REM NEC P2200 printer

REM send line feeds to printer
 oscli"FX6"

REM set MARGINS on printer LM5,RM96
 vdu2,1,27,1,108,1,5,1,27,1,81,1,96,3

REM set 84/360 LINE PITCH
 vdu2,1,28,1,51,1,84,3

REM set 12 CPI UNDERLINED
 vdu2,1,27,1,33,1,129,3

REM:C%:max lines THEN line cntr
 C%=0
REM L%:margin width
 L%=6
REM M%:max name length
 M%=0
REM N%:max char names THEN No.of cols
 N%=0
REM O%:lines per page - MAX 40
 O%=30
REM P%:length of name to print
 P%=0
REM Q%:number of pages
 Q%=0
REM S%:number of spaces after name
 S%=0
REM T% page ctr
 T%=0
REM D% spaces before line number
 D%=0

procWORKING
procCOUNT
procNEWPAGE

.CYCLE
 REM incr line ctr
  C%=C%+1
 procPAD
 procPR
 cursor down
  if C%modO%=0 then procNEWPAGE
  if C%=Z% then goto END
goto CYCLE

.PAD
 REM find D% - characters in number 'C'
  D%=Lenstr$C%
 REM D$=spaces to right-justify No.
  D$=""
   if D%=2 then D$=" "
   if D%=1 then D$="  "
endproc

.NEWPAGE
  cls
  vdu10,10,10
  print "PAPER READY - Y/N?"
  print
  print "A negative response ends program" 
   Z$=gck$
    if Z$="y" then Z$="Y"
    if Z$<>"Y"then goto END
REM: increment page counter T%
 T%=T%+1
 vdu2
  print "     CLUB REGISTER - page "+str$T%+"/"+str$Q%
  print
  print
  print
  print
 vdu3
endproc

.PR
 REM find next record
  find">"
 REM get name
  cursor down 2
  G$=glt$
  P$=glt$+" "+G$
 REM start printing line
  vdu2
   REM right justified line No.+ name
   print D$+str$C%+"  "+P$;
   procSPACES
   procCOLS
   REM 'print'gives CR to complete line
    print
 REM turn off printer
  vdu3
endproc

.SPACES
 REM (M%=maximum name length)
 P%=lenP$
 S%=1+M%-P%
  if S%=0 then endproc
 REM print S% spaces after name
  dothis
   print " ";
  times S%
endproc

.COLS
REM print 3-char. columns after name
 print "|";
 dothis
  print"  |";
 times N%
endproc

.WORKING
 cls
 vdu10,10,10
 print "     WORKING . . . please wait"
endproc

.COUNT
REM find max name length M%
REM find number of names C%
 select text
 cursor top
 find ">"
 cursor down 2
 dothis
  REM: increment page count
   C%=C%+1
  REM:N%=surname + forename length
   N%=lenglt$+lenglt$
   REM:M% is longest name length
    if N%>M% then M%=N%
  cursor down 7
 until EOT
  REM convert N% to cols (L% = margin)
  REM allows 3 chars per register column 
   N%=(80-L%-M%)/3
  REM Find Q%:number of pages 
  REM O% = lines per page
   Q%=(C%+O%-1)/O%
  REM Z%=max lines
   Z%=C%
  REM clear line ctr: C%
   C%=0
  cursor top
endproc

.END
display
---------------------------------------
REM.. D.ROUTINE
REM.. BY C J Waldock
REM.. (C) The Micro User
REM.. see procHELP for information

REM.. Set constant R$,carriage return
 R$=chr$ 13
REM.. Set constant N$,newline
 N$=R$+chr$ 10
REM.. Q$=prompt for input
 Q$=" ==> "
REM.. message M$
 M$=N$+"To continue PRESS ANY KEY"+Q$

REM.. see endmarkers complete
 procZZZ

REM.. get left margin to print a record
 procLM

select text
 if EOT then procHOM
 if SOT then cursor down 4
procLOC

 REM.. M1 starts main loop
.M1
  cursor at 0
  display 
 REM.. get option from keyboard
  A%=get
 REM.. change UPPERCASE to LOWERCASE
  if A%>64 and A%<91 then A%=A%+32
REM.. Rather than actual values like REM..  108 ASC"l" may be inserted
 if A%=108 then goto LN
 if A%=110 then goto NX
 if A%=98 then goto BK
 if A%=112 then goto PR
 if A%=115 then goto SCH
 if A%=114 then goto REP
 if A%=102 then goto FIN
 if A%=116 then procLOC 
 if A%=117 then goto UP
 if A%=100 then goto DEL
 if A%=99 then goto COP
 if A%=97 then goto ADD
 if A%=105 then goto INS
 if A%=101 then goto END
 if A%=104 then goto HELP
goto M1

.ZZZ
 REM.. First wipe out text at end
  select text
  cursor top
  find ">END"
  fkey 3
  cursor bottom
  fkey 3
  fkey 7
 REM.. then insert end markers required
 REM.. and lines to make .LOC work
 REM.. when at ">END"
  type">END"+R$+R$
  type "zzz"
  dothis
   type R$
  times 7
endproc

.LN
 cursor down
 cursor at 0
goto M1

.UP
 cursor at 0
 cursor up
goto M1

.LOC
 REM.. find start of next record
  cursor right
  find ">"
 REM..cursor to start of current record
  cursor up 9
endproc

.INS
  REM.. get new line of text
   cls
   v.10,10,10 
   print "Type replacement for line ";     print "- ""Q"" to abort"
   print N$+Q$;
   G$=glk$
  REM.. allow abort
   if G$="Q" or G$="q"then goto M1
  REM.. wipe out old line
   cursor at 0
   fkey 3
   cursor at 39
   fkey 3
   fkey 7
  REM.. insert new line
   type G$
   cursor right
goto M1

 REM.. jump to next record
.NX
 if SOT then cursor down 4
 if EOT=0 then cursor down 9
goto M1

 REM.. jump back a record
.BK
 cursor up 9
 if SOT then cursor down 4
goto M1

 REM.. cursor to first record
.HOM
 select text
 cursor top  
 cursor at 0
 cursor down 4
endproc

.HELP
 cls
 vdu 10
p."       MOVING through DATA"
p."       -------------------"
p."Press""L"" to move down a LINE"
p."Press""T"" to go to TOP of record"
p."Press""U"" to go UP a line"
p."Press""N"" to move to NEXT record"
p."Press""B"" to move BACK"
p."Press""S"" to SEARCH for word(s)"
p."Press""R"" to REPEAT search"
p."Press""F"" to FIND PLACE for new record"
p."       PRINTING A RECORD"
p."       -----------------"
p."Press""P"" to PRINT a name and address"
p."       MANIPULATING DATA"
p."       -----------------"
p."Press""C"" to COPY record"
p."Press""D"" to DELETE record"
p."Press""A"" to ADD record"
p."Press""I"" to INSERT line change"
p."       LEAVING ROUTINE"
p."       ---------------"
p."Press""E"" TO END operation"
 print M$
 G%=get
goto M1

 REM.. finds place for new record
.FIN
 cls
 vdu 10,10,10
 print "Enter SURNAME to insert"
 pr. "(Only initial letter as Capital)"
 print Q$;
 S$=glk$
 REM.. the "seek" process
  procHOM 
  cursor down 2
  repeat  
    if S$<=glt$ then goto F1
   cursor down 8
  until false 
 .F1
  cursor up 3
 REM.. set X%, flag to be used by .ADD
  X%=1
goto M1

 REM.. copy a record
.COP
 procLOC
 REM.. mark record to copy
  fkey 3
  cursor down 9
  cursor at 0
  fkey 3
 REM.. now use fkey to copy marked text
  fkey 9
  delete markers
  cursor at 0
goto M1

 REM.. search for text string S$
.SCH
 procHOM
 cls
 vdu 10,10,10
 print "ENTER character(s) to find"
 print "(CARE with capitals)"
 print
 print Q$;
 S$=glk$
 find S$
  if EOT then goto NOTFD
goto M1 

 REM.. repeat a search for text
.REP
 cursor down 9
 find S$
  if EOT then goto NOTFD
goto M1

 REM: advise when search reaches EOT
.NOTFD
 cls
 vdu 10,10,10,7
 pr. "I couldn't find the text sought"
 print M$
 G%=get
 procHOM
goto M1

 REM.. print individual record
.PR
 procLOC
 cursor down 3
 REM.. printer on
  vdu 2
   print L$+glt$+" ";
   cursor up 2
   print glt$
   cursor down
   dothis
    G$=glt$
     if G$<>"" then print L$+G$
   times 3
   print
   print
  REM.. printer off
  vdu 3
  cursor down 2
goto M1

 REM: create left margin string: L$
.LM
 L$=""
 cls
 vdu 10,10,10 
 print "Enter LEFT MARGIN width"
 print "Press E and SHIFT-f9 to reset"
 print
 print Q$;
 O$=glk$
  if VALO$=0 then endproc
 dothis
  L$=L$+" "
 times valO$
 REM.. enable carriage retns on printer
  oscli"FX6"
endproc

 REM.. prompts for and accepts data
 REM.. for each record field (line)
.ADD
 cls
 print N$+N$+"Code(s)"+Q$;
  A$=">"+glk$+R$
 print N$+"Date of Birth"
 pr. "(If a JUNIOR use form YR.MO.DA)"
 print "(If an ADULT enter 99)"
 print Q$;
  B$=glk$+R$
 print N$+"Surname"+Q$;
 REM.. flag X% uses surname from .FIN
  if X%=1 then C$=S$+R$
  if X%=1 then print C$
  if X%=0 then C$=glk$+R$
 print N$+"Title and forename"+Q$;
  D$=glk$+R$
 print N$+"Address Line 1"+Q$;
  E$=glk$+R$
 print N$+"Address Line 2"+Q$;
  G$=glk$+R$
 print N$+"TOWN"+Q$;
  H$=glk$+R$
 print N$+"Phone, Notes"+Q$;
  J$=glk$+R$
 procLOC
 type A$+B$+C$+D$+E$+G$+H$+J$+R$
 REM.. cancel flag X%
  X%=0
goto M1

.DEL
 cls
 vdu 10,10,10,7
 print "DELETES RECORD - ARE YOU SURE";
 print " Y/N?"
 print
 print Q$;
 Z$=gck$
  if Z$="y" then Z$="Y"
  if Z$<>"Y" then goto M1
 procLOC
 REM.. first mark entire record
  cursor up
  fkey 3
  cursor down 9
  fkey 3
 REM.. fkey deletes marked text
  fkey 7
  cursor down
goto M1

.END 
 vdu 7
 display
---------------------------------------
REM.. D.SELLIST  
REM.. BY C J Waldock
REM.. (C) The Micro User
REM.. Selectively lists
REM..  fields from records
REM..  of a file placed in TEXT.

 procINIT

.correct
 procCHOOSE
 procCHECK
  if X$<>"Y" then goto correct

repeat
 procSELECT
until false


.INIT
 REM.. ensure records present
  select text
   if SOT AND EOT then procEMPTY
 REM.. see if file to be saved first
  cls
  vdu10,10,10,7
  pr. "RECORDS in text will be DELETED"
  print "   as the program works"
  pr. "Do you want to save them first";
  print ": Y/N? ";
  Y$=gck$
   if Y$="y"then Y$="Y"
  print Y$
   if Y$="Y" then goto ABORT
 REM.. set constants, carriage return
  R$=chr$13
 REM..   and comma+space
  K$=", "
 REM.. reset number of optional lines
  L%=0
 REM.. wipe segment 1
  select segment 1
  delete text
 REM.. return to text
  select text
  cursor top
  cursor down 4
endproc

.EMPTY
 cls
 vdu10,10,10,7
 print "     There is no data in TEXT"
 print
 print "    for the program to work on"
 print
 print "    press key to RETURN to Text"
 G%=get
 di.
end

.ABORT
 select text
 vdu10,10,10,7
 p."press key then save data in text"
 G%=get
 display
END

 REM.. user selects fields to be listed
.CHOOSE
 REM.. reset flags F%
  F%=0
 REM.. I% will set flags
  I%=1
 REM.. get print instructions
  cls
  vdu10,10,10
  print "Print Codeline - Y/N? ";
  procSETFLAG
  print "Print Date of birth - Y/N? ";
  procSETFLAG
  print "Print Address Line 1 - Y/N? ";
  procSETFLAG
  print "Print Address Line 2 - Y/N? ";
  procSETFLAG
  print "Print Town? - Y/N? ";
  procSETFLAG
  print "Print Phone number - Y/N? ";
  procSETFLAG
endproc

.SETFLAG
 REM.. get Y/N response
  X$=gck$
  if X$="y" then X$="Y"
  print X$
  print
 REM.. set flag for record line (field)
  if X$="Y" then F%=F% OR I%
 REM.. add to number of optional lines
  if X$="Y" then L%=L%+1
 REM.. I% is 1, 2, 4, 8, 16, 32 in turn
  I%=I%*2
endproc

.CHECK
 print
 print"Are the above choices ";
 print"correct - Y/N? ";
 X$=gck$
 if X$="y" then X$="Y"
 print X$
endproc

 REM.. proc selects fields as chosen
 REM.. and adds to list in segment 1
.SELECT
  select text
 REM.. Reset print string P$ which is
 REM..  to be built up 
 REM..  from fields to be listed.
  P$=""
 REM.. Reset counter of fields
 REM..  added to P$.
  M%=0
 REM.. set opening marker for delete
  fkey 3
 REM.. read first four lines (fields)
  A$=glt$
   if A$=">END" then goto END
  B$=GLT$
   if B$="99" then B$="Adult"
  C$=glt$
  D$=glt$

 REM.. start print string P$ with name
  P$=P$+D$+" "+C$+K$

 REM.. fields must be passed to
 REM.. BUILDSTRING as E$

 REM.. code field
  E$=A$
  if (F% AND 1)=1 then procBUILDSTRING

REM.. read next four fields in turn
REM.. and add to P$ if flag set

 REM.. date_of_birth field
 REM.. can be moved to precede name.
  E$=B$
  if (F% AND 2)=2 then procBUILDSTRING

 REM.. address line 1
  E$=glt$
  if (F% AND 4)=4 then procBUILDSTRING

 REM.. address line 2
  E$=glt$
  if (F% AND 8)=8 then procBUILDSTRING

 REM.. town
  E$=glt$
  if (F% AND 16)=16 then procBUILDSTRING
 REM.. phone number
  E$=glt$
  if (F% AND 32)=32 then procBUILDSTRING
 REM.. complete P$ with carriage return
  P$=P$+R$

 REM.. step over last line of record
  cursor down

 REM.. Set closing marker
  fkey 3
 REM..   and delete record just read.
  fkey 7

 REM.. add P$ to segment 1
  select segment 1
  type P$
  display
endproc

.BUILDSTRING
  P$=P$+E$
  REM.. increment counter, fields added
   M%=M%+1
  REM.. if less than limit add K$
   if M%<L% and E$<>"" then P$=P$+K$
endproc

.END
 select text
 delete text
 select segment 1
 vdu7
 display
END
---------------------------------------
REM.. D.STATS
REM.. BY C J Waldock
REM.. (C) The Micro User
REM.. analyzes adults and juniors
REM.. analyzes paid and unpaid

REM A%=all members
 A%=0
REM B%=adults paid
 B%=0
REM C%=adults unpaid
 C%=0
REM D%=juniors paid
 D%=0
REM E%=juniors unpaid
 E%=0

cls
vdu10,10,10
print"     WORKING . . . please wait"

select text
cursor top
repeat
 find ">"
 cursor right
 REM.. get code character
 REM.. for paid (*) or unpaid(/)
  C$=gct$
 REM.. go to start of next line
  G$=glt$
 REM.. get year value (birthdate)
  T%=VALglt$
 REM.. add to appropriate count
   if C$<>"E" then A%=A%+1
   if T%=99 and C$="*"then B%=B%+1
   if T%=99 and C$="/" then C%=C%+1 
   if T%<>99 and C$="*"then D%=D%+1
   if T%<>99 and C$="/" then E%=E%+1 
until EOT

cls
vdu10,10,10
print "    ADULTS paid:   ";
G$=str$B%
procRJ
print "    JUNIORS paid:  ";
G$=str$D%
procRJ
print "    ADULTS unpaid: ";
G$=str$C%
procRJ
print "    JUNIORS unpaid:";
G$=str$E%
procRJ
print"    All members:   ";
G$=str$A%
procRJ
print
print"Press any key to continue"
G$=gck$
di.
end

.RJ
 REM.. right-justifies string G$
 G%=5-lenG$
 dothis
  print" ";
 timesG%
 printG$
endproc
---------------------------------------