DECLARE SUB PlayToon (x!)
DECLARE FUNCTION AgeGroupConv$ (a$)
DECLARE SUB BatchPrint ()
DECLARE SUB Finish ()
DECLARE SUB InitialSetup ()
DECLARE SUB Title ()
DECLARE SUB EnterData ()
DECLARE SUB PrintCard (eventcode$, agegroup$, eventname$, numevents!, scoreevents!, measure$, group$)
DECLARE SUB op (a$)
DECLARE FUNCTION Field$ (value$, wid!)
DECLARE SUB centre (y!, a$)

COMMON SHARED mdate$, tname$, opc, toppage, relayscore
opc = 0
toppage = 1
CONST ten$ = "³          "
CONST tline$ = "ÅÄÄÄÄÄÄÄÄÄÄ"
CONST thirty$ = "³                              "
CONST uline$ = "³"

mdate$ = ""
tname$ = "Team"

SCREEN 12
' Code, Age Group, Event, Number of Competitors, Measure of Score, 1=Normal 2=Relay, Team Generic Name
' e.g. PrintCard "FHJ1", "First Year Girls", "Long Distance High Jump", 5, 1, "Distance", "House"
InitialSetup
DO
        EnterData
LOOP

FUNCTION AgeGroupConv$ (a$)
b$ = a$
IF a$ = "u13" THEN b$ = "Under 13"
IF a$ = "u14" THEN b$ = "Under 14"
IF a$ = "u15" THEN b$ = "Under 15"
IF a$ = "u17" THEN b$ = "Under 17"
IF a$ = "o17" THEN b$ = "Over 17"
IF a$ = "1g" THEN b$ = "1st Girls"
IF a$ = "1b" THEN b$ = "1st Boys"
IF a$ = "2g" THEN b$ = "2nd Girls"
IF a$ = "2b" THEN b$ = "2nd Boys"
IF a$ = "4g" THEN b$ = "4th & 5th Girls"
IF a$ = "4b" THEN b$ = "4th & 5th Boys"
IF a$ = "6g" THEN b$ = "6th Form Girls"
IF a$ = "6b" THEN b$ = "6th Form Boys"
AgeGroupConv$ = b$
END FUNCTION

SUB BatchPrint
RANDOMIZE TIMER
SCREEN 0
COLOR 28, 0: CLS
PLAY "c18e18g18>c18<"
PRINT "Tada! Automatic card-printing clever mode."
COLOR 15, 0
LINE INPUT "Batch file name>", batchname$
'batchname$ = "c:\athletic\cards\experi.prg"

' defaults
relayscore = 2
numcomps = 6
tname$ = "School"
mdate$ = ""

PRINT "Parsing file: "; batchname$

f = FREEFILE
OPEN batchname$ FOR INPUT AS #f
DO
        LINE INPUT #f, com$
        IF INSTR(com$, " ") = 0 THEN com$ = "; blank"
        PRINT "Parsing: "; com$
        firstword$ = LEFT$(com$, INSTR(com$, " ") - 1)
        secondword$ = RIGHT$(com$, LEN(com$) - (LEN(firstword$) + 1))
        SELECT CASE firstword$
                CASE ";"
                        ' comment, don't do anything
                CASE "eventdate"
                        mdate$ = secondword$
                CASE "relayscore"
                        relayscore = VAL(secondword$)
                CASE "message"
                        PlayToon INT(RND(1) * 5) + 1
                        COLOR 27, 0: PRINT "MESSAGE!"
                        COLOR 15, 0
                        PRINT secondword$
                        PRINT
                        LINE INPUT "---return---", ret$
                CASE "teamname"
                        tname$ = secondword$
                CASE "agegroup"
                        agegr$ = AgeGroupConv(secondword$)
                CASE "numcomps"
                        numcomps = VAL(secondword$)
                CASE "card"
                        ecode$ = UCASE$(LEFT$(secondword$, INSTR(secondword$, " ")))
                        ename$ = RIGHT$(secondword$, LEN(secondword$) - LEN(ecode$))
                        score = 1
                        IF INSTR(ename$, "Relay") > 0 THEN score = relayscore
                        emeasure$ = "Time"
                        IF LEFT$(ecode$, 1) = "F" THEN emeasure$ = "Distance"
                        IF INSTR(ename$, "High") > 0 THEN emeasure$ = "Height"
                        PrintCard ecode$, agegr$, ename$, numcomps, score, emeasure$, tname$
                        IF toppage = 1 THEN
                                PLAY "c18g18"
                                PRINT " "
                                PRINT "End of page."
                                PRINT
                                LINE INPUT "---return---", dum$
                        END IF
                CASE ELSE
                        PLAY "<<<<<c3>>>>>"
                        PRINT "Error in file!"
        END SELECT
LOOP UNTIL EOF(f)
CLOSE f
PRINT
PRINT
BEEP
PRINT "Batch file successfully parsed."
END SUB

SUB centre (y, a$)
LOCATE y, 40 - LEN(a$) / 2: PRINT a$;
END SUB

SUB EnterData
Title
'
LOCATE 9, 10: PRINT "             Enter 'x' to exit the program."
LOCATE 10, 10: LINE INPUT "Event Code > ", ecode$
ecode$ = UCASE$(ecode$)
IF ecode$ = "X" THEN Finish
IF ecode$ = "B" THEN BatchPrint
LOCATE 12, 10: LINE INPUT "Event Name > ", ename$
'
measure$ = "Distance"
IF LEFT$(ecode$, 1) = "T" THEN measure$ = "Time"
IF INSTR(UCASE$(ename$), "HIGH") > 0 THEN measure$ = "Height"
centre 20, "Measure = " + measure$ + "."
'
IF INSTR(UCASE$(ename$), "RELAY") > 0 THEN
        a$ = "Relay Event Detected, Score Set To Relay"
        score = relayscore
ELSE
        a$ = "Normal Event, Score Normal"
        score = 1
END IF
centre 13, a$
'
LOCATE 14, 10: PRINT "u13=Under 13  u14=Under 14  u17=Under 17  o17=Over 17"
LOCATE 15, 10: PRINT "1g=1st Girls 1b=1st Boys etc."
agegr$ = ""
LOCATE 16, 10: LINE INPUT "Age Group > ", agegr$
agegr$ = AgeGroupConv$(agegr$)
'
num$ = ""
LOCATE 18, 10: LINE INPUT "Number Of Competitors [6] > ", num$
IF num$ <> "" THEN num = VAL(num$) ELSE num = 6
'
centre 23, "Printing..."
PrintCard ecode$, agegr$, ename$, num, score, measure$, tname$
END SUB

FUNCTION Field$ (value$, wid)
Field$ = value$ + STRING$(wid - LEN(value$), " ")
END FUNCTION

SUB Finish
SCREEN 0
CLS
PRINT "Thank you for using The Card Printer."
SYSTEM
END SUB

SUB InitialSetup
Title
'
LOCATE 13, 10: PRINT "                    [enter 'batch' for batch mode]"
LOCATE 14, 10: PRINT "                    e.g. House, Team, School"
LOCATE 15, 10: LINE INPUT "Generic team name > ", tname$
IF tname$ = "batch" OR tname$ = "b" THEN BatchPrint: END
LOCATE 20, 10: LINE INPUT "Event Date > ", mdate$
LOCATE 22, 10: INPUT "Relay Score (1 or 2) > ", relayscore
END SUB

SUB OldBatchPrint
Title
PRINT "Batch mode activated..."
LINE INPUT "Batch: ", b$
OPEN "c:\athletic\sptsdays\senior96\" + b$ + ".prg" FOR INPUT AS #1
DO
        LINE INPUT #1, dum$
LOOP UNTIL dum$ = "#data"
DO
        INPUT #1, ecode$, agegr$, ename$, num, score, measure$, tname$
        PRINT "Printing " + ecode$ + "... " + ename$
        PrintCard ecode$, agegr$, ename$, num, score, measure$, tname$
        LINE INPUT "Hit return...", dum$
LOOP UNTIL EOF(1)
CLOSE 1
END SUB

SUB op (a$)
PRINT a$;
LPRINT a$;
'IF INSTR(a$, CHR$(13)) > 0 THEN opc = opc + 1
END SUB

SUB PlayToon (x)
SELECT CASE x
        CASE 1
                PLAY "c18e18g18c18e18g18c18e18g18c18e18g18>c6<<c18c18c18c6"
        CASE 2
                PLAY "o4g14g14g14<e14>g14<d14>g14<c14>g14<<b14>>g14<c14>g14<d14>g14<e14>"
        CASE 3
                PLAY "c2g2f12e12d12>c2<"
        CASE 4
                PLAY "o4<a2b2>c12d12c2<e2>"
        CASE 5
                PLAY "<g8a8b8>c8d8p8<g8a8b8>c8d8c8p5<<c4>>"
END SELECT
END SUB

SUB PrintCard (eventcode$, agegroup$, eventname$, numevents, scoreevents, measure$, group$)
'Title
PRINT "Printing " + eventname$ + "..."
IF toppage = 0 THEN op CHR$(13)
op Field$("EVENT: " + eventname$, 60) + Field$("  CODE: " + eventcode$, 18) + CHR$(13)
op CHR$(13)
agetmp$ = "AGE GROUP: " + agegroup$
IF agegroup$ = "" THEN agetmp$ = ""
op Field$(agetmp$, 35) + Field$("  MEETING DATE: " + mdate$, 30) + CHR$(13)
op CHR$(13)
op "É" + STRING$(74, "Í") + "»" + CHR$(13)
op "º" + Field$(" Place", 10) + uline$ + Field$(" Name", 30) + uline$ + Field$(" " + group$, 10) + uline$ + Field$(" " + measure$, 10) + uline$ + Field$(" Points", 10) + "º" + CHR$(13)
div$ = "º" + STRING$(10, "Ä") + "Å" + STRING$(30, "Ä") + tline$ + tline$ + tline$ + "º" + CHR$(13)
op div$
FOR k = 1 TO numevents
        IF k = 1 THEN
                s = (numevents - k) + 2
        ELSE
                s = (numevents - k) + 1
        END IF
        s = s * scoreevents
        op "º" + Field$(STR$(k), 10)
        op thirty$ + ten$ + ten$ + uline$ + Field$(STR$(s), 10) + "º" + CHR$(13)
        op "º" + STRING$(10, " ") + thirty$ + ten$ + ten$ + ten$ + "º" + CHR$(13)
        IF k < numevents THEN op div$
NEXT k
op "È" + STRING$(74, "Í") + "¼" + CHR$(13)
IF numevents < 6 THEN
        FOR k = 1 TO 6 - numevents
                op CHR$(13)
                op CHR$(13)
                op CHR$(13)
        NEXT k
END IF
op CHR$(13)
op STRING$(50, " ") + "Staff Initials: _________" + CHR$(13)
op CHR$(13)
op "ÍÍ> PLEASE SEND THIS FORM TO THE SCORER'S TABLE DIRECTLY AFTER COMPLETION <ÍÍ"
op CHR$(13)
IF toppage = 1 THEN op CHR$(13)
toppage = 1 - toppage
PRINT "top:"; toppage
END SUB

SUB Title
COLOR 15: VIEW PRINT
CLS
'
centre 1, "        ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ        "
centre 2, "ÍÍÍ" + CHR$(16) + "    The Card Printer    " + CHR$(17) + "ÍÍÍ"
centre 3, "        ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ        "
centre 4, "For the Sevenoaks School PE Department"
centre 5, "v1.04 (c)1995 Adam Sampson and Marryat Stevens"
centre 6, STRING$(78, "Í")
'
VIEW PRINT 7 TO 30
END SUB