home *** CD-ROM | disk | FTP | other *** search
/ The Glitch Apple Disk Collection / 2014.glitch.apple.collection.zip / indexed / COMPKARA.DSK / P12.bas < prev    next >
BASIC Source File  |  2014-09-09  |  27KB  |  378 lines
  1. 1  REM  (C) 1984 EDWARD BADASOV
  2. 2  REM  COMPETITION KARATE
  3. 5  ONERR  GOTO 19010
  4. 10  GOSUB 23000: GOTO 9200
  5. 2500  IF  RIGHT$(C$,1) = SP$  THEN C$ =  LEFT$(C$, LEN(C$) -1): GOTO 2500
  6. 2501  RETURN 
  7. 3003 C$ = "": GOSUB 3100: PRINT "["CU$;
  8. 3006  IF  PEEK(KP%) <KN%  THEN 3006
  9. 3009  GET A$: IF A$ =  CHR$(13)  THEN  PRINT :CF% = 0: GOSUB 2500: RETURN 
  10. 3010  IF A$ = ES$  THEN RF% = 1:CF% = 0: POP : RETURN 
  11. 3012  IF  LEN(C$) = 1  AND A$ = BS$  THEN  PRINT A$SP$A$A$CU$;
  12. 3014  IF (A$ <SP$  AND A$ < >BS$)  OR (  NOT CF%  AND A$ = ",")  OR ( LEN(C$) <1  AND A$ = SP$)  THEN  PRINT S$;: GOTO 3006
  13. 3015  IF  LEN(C$) <2  AND A$ = BS$  THEN C$ = "": GOTO 3006
  14. 3016  IF A$ < >BS$  AND  LEN(C$) = 15  THEN  PRINT S$;: GOTO 3006
  15. 3018 C$ = C$ +A$
  16. 3021  IF A$ = BS$  THEN  PRINT A$SP$A$A$CU$;:C$ =  LEFT$(C$, LEN(C$) -2): GOTO 3006
  17. 3024  PRINT BS$A$CU$;: GOTO 3006
  18. 3100  POKE KB%,0: POKE 7,3: CALL SD%: RETURN 
  19. 3150  VTAB V% +6: HTAB 5 +20 *H%: PRINT RN$(V% +15 *H%): RETURN 
  20. 3200  VTAB 4: HTAB 1: INVERSE : PRINT PN$: NORMAL : GOSUB 4050: IF RC% = 0  THEN  VTAB 23: HTAB 1: FLASH : PRINT " EMPTY ROSTER ";: GOSUB 3500:RF% = 1: RETURN 
  21. 3205  FOR I = 1 TO 30:RC%(I) = 0: NEXT :RF% = 0: VTAB 23: HTAB 1: CALL  -958: INVERSE : PRINT " [<-]  [->]  [SPACE]  [!]=ALL  [RETURN] ";:H% = 0:V% = 1: GOSUB 3100
  22. 3206  INVERSE : GOSUB 3150:XC% = V% +K5% *H%: POKE KB%,0
  23. 3210  IF  PEEK(KP%) <KN%  THEN 3210
  24. 3215 X% =  PEEK(KP%) -KN%: IF X% = K7%  THEN RF% = 1: NORMAL : RETURN 
  25. 3240  IF X% = K1%  THEN  NORMAL : GOSUB 3150:V% = V% +1: IF V% +K5% *H% >RC%  OR V% >K5%  THEN H% =   NOT H%:V% = 1: IF H%  AND RC% =  <K5%  THEN H% = 0
  26. 3241  IF X% = K8%  THEN  NORMAL : GOSUB 3150:V% = V% -1: IF V% <1  THEN V% = (K5% *H%) +(RC% -K5% *(RC% >K5%)) *(H% = 0):H% =   NOT H%: IF H%  AND RC% < = K5%  THEN H% = 0
  27. 3242  IF X% = K1%  OR X% = K8%  THEN 3206
  28. 3250  IF X% = K2%  THEN RC%(XC%) =   NOT RC%(XC%): IF   NOT RC%(XC%)  THEN  NORMAL 
  29. 3252  IF X% = K2%  THEN  HTAB 2 +20 *H%: VTAB  PEEK(37): PRINT SP$: GOSUB 3100: GOTO 3206
  30. 3255  IF X% = K9%  THEN  GOSUB 3300: GOSUB 3100
  31. 3258  IF X% = K3%  THEN  NORMAL : GOSUB 3150: GOTO 3280
  32. 3260  GOTO 3206
  33. 3280  FOR I = 1 TO RC%: IF RC%(I)  THEN  RETURN 
  34. 3281  NEXT :RF% = 1: RETURN 
  35. 3300 X1% = V% -1: FOR I = XC% TO RC%:RC%(I) =   NOT RC%(I): IF   NOT RC%(I)  THEN  NORMAL 
  36. 3302 X1% = X1% +1: IF X1% >15  THEN X1% = 1
  37. 3305  HTAB 2 +20 *(I >K5%): VTAB X1% +K6%: PRINT SP$: INVERSE : NEXT : RETURN 
  38. 3500  NORMAL : PRINT S$S$CP$(3);: GET A$: POKE KB%,0: RETURN 
  39. 4000  INVERSE :X1$ = " TEAM ROSTER ": GOSUB 15000: NORMAL 
  40. 4005  PRINT SR$;: GOSUB 3003:PN$ = C$: IF PN$ = "C"  THEN  GOSUB 10500: GOTO 4005
  41. 4008  IF PN$ = ""  THEN  RETURN 
  42. 4009  ONERR  GOTO 19000
  43. 4010  GOSUB 25200: VTAB 4: HTAB 1: INVERSE : PRINT PN$: NORMAL :FL% = 0
  44. 4020  GOSUB 4050
  45. 4030  VTAB 23: HTAB 1: CALL  -958: INVERSE : PRINT " [A]DD  [R]EMOVE  [P]RINT   [S]AVE/EXIT";: NORMAL : GOSUB 3100: GET A$
  46. 4032  IF A$ = ES$  AND FL%  THEN  HOME : FLASH : PRINT S$" NOT SAVED ";: NORMAL : PRINT "  [ANY KEY]=CONT  [S]AVE ";: GET Q$: IF Q$ = "S"  THEN A$ = Q$
  47. 4033  IF A$ = ES$  THEN  FOR I = 1 TO 30:RN$(I) = "": NEXT : RETURN 
  48. 4035  IF A$ = "A"  THEN  GOSUB 4100: GOTO 4020
  49. 4036  IF A$ = "R"  THEN  GOSUB 4200: POKE 34,5: GOTO 4020
  50. 4038  IF A$ = "P"  THEN  GOSUB 4300: GOTO 4030
  51. 4039  IF A$ = "S"  THEN  PRINT : GOSUB 25220: FOR I = 1 TO 30:RN$(I) = "": NEXT : RETURN 
  52. 4040  GOTO 4030
  53. 4050  HOME : POKE 34,6: VTAB 7: FOR I = 1 TO 30: HTAB 1 +20 *(I >15): IF I = 16  THEN  VTAB 7
  54. 4051  PRINT BR$ LEFT$(RN$(I),15): NEXT : POKE 34,22
  55. 4052  VTAB 4: HTAB 20: CALL  -868: HTAB 30: PRINT  SPC( RC% <10)RC%SP$"STUDENT";: IF RC% < >1  THEN  PRINT "S"
  56. 4053  RETURN 
  57. 4100  IF RC% > = 30  THEN  RETURN 
  58. 4105  HOME : PRINT SN$;: GOSUB 3003: IF C$ = "C"  THEN : POKE 34,5: GOSUB 10500: GOSUB 4050: GOTO 4105
  59. 4107 RN$(RC% +1) = C$: IF RN$(RC% +1) < >""  THEN RC% = RC% +1:FL% = 1
  60. 4110  RETURN 
  61. 4200  IF RC% = 0  THEN  RETURN 
  62. 4210  HOME : FLASH : VTAB 6: HTAB 16: PRINT " REMOVE ": GOSUB 3205: IF RF%  THEN  RETURN 
  63. 4212  HOME : INVERSE : PRINT CP$(1);: NORMAL : PRINT CP$(0);: GOSUB 3100: GET A$: IF A$ = ES$  THEN  RETURN 
  64. 4215  FOR P = RC% TO 1  STEP  -1: IF RC%(P)  THEN  FOR I = P TO RC% -1:RN$(I) = RN$(I +1): NEXT :RN$(RC%) = "":RC% = RC% -1
  65. 4220  NEXT :FL% = 1: RETURN 
  66. 4300  HOME :VT% = 22: GOSUB 5200: PRINT : IF A$ = ES$  THEN  RETURN 
  67. 4302  HOME : INVERSE : PRINT CP$(1);: NORMAL : PRINT CP$(2);: GOSUB 3100: GET A$: POKE KB%,0: HOME : VTAB 24: POKE 34,23: IF A$ = ES$  THEN  RETURN 
  68. 4305  HOME : PR# 1: PRINT L1$L1$: PRINT L2$: PRINT L1$L1$: PRINT "PLAYER : "PN$;: HTAB 40: PRINT "DATE : "DT$: FOR I = 1 TO 30: PRINT : PRINT I")" TAB( 5)RN$(I): NEXT : PRINT : PRINT : PR# 0: RETURN 
  69. 5000  INVERSE :X1$ = " PRINT STUDENT ": GOSUB 15000: NORMAL :C% = 0:RF% = 0
  70. 5005  GOSUB 9000: IF A$ = "N"  THEN 5030
  71. 5008  IF PN$ = ""  OR A$ = ES$  THEN 5000
  72. 5011  GOSUB 25200:VT% = 11: GOSUB 5200: IF A$ = ES$  THEN 5000
  73. 5012  GOSUB 3200: IF RF%  THEN 5000
  74. 5014  VTAB 23: HTAB 1: CALL  -958: INVERSE : PRINT CP$(1);: NORMAL : PRINT CP$(2);: GOSUB 3100: GET A$: HOME : IF A$ = ES$  THEN 5000
  75. 5020  POKE KB%,0: VTAB 24: POKE 34,23: FOR P = 1 TO RC%: IF RC%(P)  THEN  PRINT :X$ = RN$(P): GOSUB 25010: GOSUB 5100: IF  PEEK(KP%) = K7% +KN%  THEN  PR# 0: RETURN 
  76. 5021  NEXT : GOTO 5000
  77. 5030  PRINT : PRINT SN$;: GOSUB 3003:X$ = C$: IF X$ = ""  THEN 5000
  78. 5031  IF X$ = "C"  THEN  GOSUB 10500: GOTO 5030
  79. 5032  GOSUB 25010: GOSUB 5200: IF A$ = ES$  THEN 5000
  80. 5033  PRINT : PRINT : INVERSE : PRINT CP$(1);: NORMAL : PRINT CP$(2);: GOSUB 3100: GET A$: HOME : IF A$ = ES$  THEN 5000
  81. 5034  HTAB 1: CALL  -958: PRINT : POKE 34,23: VTAB 24: GOSUB 25010: GOSUB 5100: GOTO 5000
  82. 5100  PRINT D$"PR#"; PEEK(799)
  83. 5102 C% = C% +1: PRINT "==== "X$" ===="
  84. 5110  PRINT : PRINT "DATE: "DT$; TAB( 31)US$(US%): PRINT : PRINT "RANK: "RA$(RA%) TAB( 31)"HEIGHT: " INT(HT%/12)"'"HT% - INT(HT%/12) *12 CHR$(34) TAB( 6)"WEIGHT: "WE%: PRINT 
  85. 5115  PRINT AB$(1) TAB( 14)":  "AB%(1) TAB( 31)"INSTRUCTOR  :  "NS$: PRINT AB$(2) TAB( 14)":  "AB%(2) TAB( 31)"EMPHASIS    :   "AB$(IA%(IN%,1))
  86. 5130  PRINT AB$(3) TAB( 14)":  "AB%(3) TAB( 46)SP$AB$(IA%(IN%,2)): PRINT AB$(4) TAB( 14)":  "AB%(4) TAB( 46)SP$AB$(IA%(IN%,3)): PRINT AB$(5) TAB( 14)":  "AB%(5)
  87. 5145  PRINT AB$(6) TAB( 14)":  "AB%(6) TAB( 31)"GRAND CHAMPION : "T1%: PRINT AB$(7) TAB( 14)":  "AB%(7) TAB( 31)"SECOND PLACE   : "T2%
  88. 5155  PRINT AB$(8) TAB( 14)":  "AB%(8) TAB( 31)"SPARRING PTS   : "PNTS%" / " INT(10 *(PNTS%/((LO% +WI%) +(LO% +WI% = 0))))/10: PRINT AB$(9) TAB( 14)":  "AB%(9) TAB( 31)"KNOCKOUTS      : "KO%
  89. 5160  PRINT : PRINT "ABILITY AVG. : "AVG% TAB( 31)"WINS  --  LOSS  --  PCT.": PRINT  TAB( 31)"----      ----      ----": PRINT "PROGRESS PTS : "XPTS% TAB( 31)WI% TAB( 41)LO% TAB( 11);
  90. 5170 :X% = (WI%/((WI% +LO%) +(WI% +LO% = 0))) *1000: IF X% = 1000  THEN  PRINT "1.000": GOTO 5180
  91. 5175  PRINT "."X%
  92. 5180  IF C% = 3  THEN C% = 0: PRINT : PRINT : PRINT : PRINT : PRINT : GOTO 5190
  93. 5185  PRINT : PRINT "--------------------------------------------------------------------------------"
  94. 5190  PRINT D$"PR#0"
  95. 5191  RETURN 
  96. 5200  HTAB 1: VTAB VT% +1: CALL  -958: PRINT "ENTER [DATE] ";: IF DT$ < >""  THEN  PRINT " [RET]="DT$" ";
  97. 5210  PRINT "-> ";:CF% = 1: GOSUB 3003: IF C$ = ""  THEN  RETURN 
  98. 5220 DT$ = C$: RETURN 
  99. 6000  POKE 34,3: HOME : VTAB 5: HTAB 2: INVERSE : PRINT "PROG PTS";: HTAB 13: PRINT "ABIL AVG";: HTAB 25: PRINT "RANK": NORMAL : PRINT L3$
  100. 6010  VTAB 7: FOR I = 1 TO 16: HTAB 5: PRINT PP%(I);: HTAB 16: PRINT AP%(I);: HTAB 25: PRINT RA$(I): NEXT : PRINT L3$;: VTAB 24: HTAB 13: INVERSE : PRINT "STRIKE ANY KEY";: GOSUB 3100: GET A$: NORMAL : RETURN 
  101. 7000  INVERSE :X1$ = " EXPULSION ": GOSUB 15000: NORMAL 
  102. 7001  ONERR  GOTO 19010
  103. 7005  VTAB 8: PRINT "[E]XPEL STUDENT  -OR-  [D]ELETE ROSTER"
  104. 7006  VTAB 10: HTAB 1: CALL  -958: PRINT "SELECT => [E]";: HTAB 12: GOSUB 3100: GET A$: IF A$ = ES$  THEN  RETURN 
  105. 7008  IF A$ = "D"  THEN  PRINT "D": GOTO 7023
  106. 7011  PRINT 
  107. 7014  PRINT : PRINT SN$;: GOSUB 3003:X$ = C$: IF X$ = ""  THEN 7000
  108. 7017  IF X$ = "C"  THEN  GOSUB 10500: GOTO 7014
  109. 7018  FOR I = 1 TO 5: IF X$ = INST$(I)  THEN  FLASH : PRINT : PRINT : PRINT "CAN'T EXPEL AN INSTRUCTOR";: GOSUB 3500: RETURN 
  110. 7019  NEXT 
  111. 7020 X$ = "^" +X$: GOSUB 7100:X$ =  RIGHT$(X$, LEN(X$) -1): GOSUB 7200: RETURN 
  112. 7023  PRINT : PRINT SR$;: GOSUB 3003:X$ = C$: IF X$ = ""  THEN 7000
  113. 7026  IF X$ = "C"  THEN  GOSUB 10500: GOTO 7023
  114. 7082 X$ = X$ +RS$: GOSUB 7100: RETURN 
  115. 7100 AB% = 1: GOSUB 11000: ONERR  GOTO 19010
  116. 7101  PRINT D$"VERIFY"X$",D" PEEK(798)
  117. 7105  POKE 34,5: HOME : PRINT S$;S$;S$: VTAB 10: HTAB 12: FLASH : PRINT " D E L E T I N G ": VTAB 13: HTAB ((40 -( LEN(X$) +1))/2): NORMAL : PRINT "<"X$">"
  118. 7110  VTAB 18: HTAB 11: PRINT "VERIFY WITH [!] => ";: GET A$: PRINT A$: IF A$ < >"!"  THEN  POP : RETURN 
  119. 7120  VTAB 17: CALL  -958
  120. 7121 AB% = 1: GOSUB 11000: ONERR  GOTO 19010
  121. 7122  PRINT D$"UNLOCK"X$",D" PEEK(798)
  122. 7123  PRINT D$"DELETE"X$
  123. 7124  RETURN 
  124. 7200  GOSUB 22500: FOR V = 0 TO 3: FOR I = 1 TO 15: IF X$ = T1$(V,I,1)  THEN  FOR J = I TO 15: FOR Z = 1 TO 9:T1$(V,J,Z) = T1$(V,J +1,Z): NEXT Z,J:WC%(V) = 1:I = 15:V = 3
  125. 7202  NEXT I,V: GOSUB 22700: RETURN 
  126. 8000  INVERSE :X1$ = " REVIEW STUDENT ": GOSUB 15000: NORMAL :C% = 0:RF% = 0
  127. 8005  GOSUB 9000: IF A$ = "N"  THEN 8015
  128. 8006  IF PN$ = ""  OR A$ = ES$  THEN 8000
  129. 8010  GOSUB 25200: GOSUB 3200: IF RF%  THEN 8000
  130. 8011  VTAB 23: HTAB 1: CALL  -958: INVERSE : PRINT CP$(1);: NORMAL : PRINT CP$(0);: GOSUB 3100: GET A$: IF A$ = ES$  THEN 8000
  131. 8012  POKE 34,5: HOME : FOR P = 1 TO RC%: IF RC%(P)  THEN X$ = RN$(P): POKE 34,5: HOME : VTAB 4: HTAB 1: CALL  -868: INVERSE : PRINT X$: NORMAL : HOME : VTAB 7: PRINT : GOSUB 25010: GOSUB 8102
  132. 8013  NEXT : GOTO 8000
  133. 8015  PRINT : PRINT SN$;: GOSUB 3003:X$ = C$: IF X$ = ""  THEN 8000
  134. 8016  IF X$ = "C"  THEN  GOSUB 10500: GOTO 8015
  135. 8017  POKE 34,5: HOME : VTAB 4: HTAB 1: CALL  -868: INVERSE : PRINT X$: NORMAL : VTAB 7: PRINT : GOSUB 25010: GOSUB 8102: GOTO 8000
  136. 8102  HOME : VTAB 4: HTAB 41 - LEN(US$(US%)): PRINT US$(US%);: VTAB 7: HTAB 20: PRINT "HT:" INT(HT%/12)"'"HT% - INT(HT%/12) *12 CHR$(34);: HTAB 29: PRINT "WT:"WE%: PRINT 
  137. 8107 A% = 0: VTAB 7: FOR I = 1 TO 9: PRINT AB$(I);: HTAB 13: PRINT ABIL%(I): NEXT : PRINT : PRINT "ABIL AVG. = "AVG%
  138. 8112  PRINT "PROG PNTS = "XP%: PRINT : PRINT "SPAR PNTS = "PNTS%"/";: IF WI% +LO% = 0  THEN  PRINT 0: GOTO 8120
  139. 8117  PRINT  INT(10 *(PNTS%/(WI% +LO%)))/10
  140. 8120  PRINT "KNOCKOUTS = "KO%: VTAB 9: HTAB 20: PRINT "RANK = "RA$(RA%);: IF RA% <7  THEN  PRINT " BELT"
  141. 8122  VTAB 11: HTAB 20: PRINT NS$: FOR I = 1 TO 3: VTAB 11 +I: HTAB 21: PRINT AB$(IA%(IN%,I)): NEXT 
  142. 8127  VTAB 19: HTAB 25: PRINT "WINS -- LOSS": HTAB 25: PRINT "----    ----": HTAB 25: PRINT WI%;: HTAB 33: PRINT LO%: VTAB 23: HTAB 1: PRINT L$
  143. 8132  VTAB 17: HTAB 24: PRINT "1ST:"T1%;: HTAB 32: PRINT "2ND:"T2%
  144. 8137  VTAB 24: HTAB 1: CALL  -958: VTAB 24: HTAB 4: INVERSE : PRINT " [ANY]=CONT  [P]RINT  [ESC]=EXIT";: NORMAL : GOSUB 3100: GET A$: IF A$ = ES$  THEN  POP : RETURN 
  145. 8142  IF A$ < >"P"  THEN  RETURN 
  146. 8147  POKE 34,22: HOME :VT% = 22: GOSUB 5200: IF A$ = ES$  THEN  HOME : GOTO 8137
  147. 8152  HOME : INVERSE : PRINT CP$(1);: NORMAL : PRINT CP$(2);: GOSUB 3100: GET A$: PRINT : IF A$ = ES$  THEN  HOME : GOTO 8137
  148. 8153  PRINT : GOSUB 5100: GOTO 8137
  149. 9000  VTAB 8
  150. 9003  ONERR  GOTO 19010
  151. 9004  PRINT "CHOOSE FROM TEAM ROSTER [Y/N] ? [Y]";: HTAB  PEEK(36) -1: GOSUB 3100: GET A$: IF A$ = ES$  THEN  POP : RETURN 
  152. 9006  IF A$ = "N"  THEN  PRINT "N": RETURN 
  153. 9009  PRINT 
  154. 9012  PRINT : PRINT SR$;: GOSUB 3003:PN$ = C$: IF PN$ = "C"  THEN  GOSUB 10500: GOTO 9012
  155. 9015  RETURN 
  156. 9200  INVERSE :X1$ = "  UTILITIES  ": GOSUB 15000:FU% = 0:DD% =  PEEK(798): NORMAL : POKE 44452,18: POKE 44605,17: ONERR  GOTO 19010
  157. 9205  VTAB 8: PRINT  TAB( 6)"[1]  EDIT/CREATE TEAM ROSTER": PRINT : PRINT  TAB( 6)"[2]  REVIEW STUDENT(S)": PRINT : PRINT  TAB( 6)"[3]  PRINT OUT STUDENT(S)": PRINT : PRINT  TAB( 6)"[4]  EXPEL STUDENT/DELETE ROSTER": PRINT 
  158. 9210  PRINT  TAB( 6)"[5]  REVIEW PROMOTION REQUIREMENTS": PRINT : PRINT  TAB( 6)"[6]  DISK AND SYSTEM UTILITIES": PRINT : PRINT  TAB( 6)"[7]  SAYONARA"
  159. 9215  VTAB 23: HTAB 9: PRINT "SELECT -> [ ]";: GOSUB 3100: HTAB 20: GET Q$: PRINT Q$;: IF Q$ = ES$  THEN Q$ = "7"
  160. 9220  IF Q$ <"1"  OR Q$ >"7"  THEN  VTAB 23: HTAB 19: CALL  -868: GOTO 9215
  161. 9225  ON  VAL(Q$) GOSUB 4000,8000,5000,7000,6000,10000,13000: GOTO 9200
  162. 10000  INVERSE :X1$ = " SYSTEM UTILITY ": GOSUB 15000: NORMAL :DD% =  PEEK(798): ONERR  GOTO 19010
  163. 10012  VTAB 8: PRINT  TAB( 10)"[1]  CREATE DATA DISK": PRINT : PRINT  TAB( 10)"[2]  TRANSFER STUDENT": PRINT : PRINT  TAB( 10)"[3]  RENAME STUDENT": PRINT : PRINT  TAB( 10)"[4]  PRINTER SLOT": PRINT : PRINT  TAB( 10)"[5]  DISK DRIVES": PRINT : PRINT  TAB( 10)"[6]  EXIT"
  164. 10030  VTAB 22: HTAB 1: CALL  -958: HTAB 9: PRINT "SELECT -> [ ]";: GOSUB 3100: HTAB 20: GET Q1$: PRINT Q1$;: IF (Q1$ <"1"  OR Q1$ >"6")  AND Q1$ < >ES$  THEN 10030
  165. 10032  IF Q1$ = ES$  OR Q1$ = "6"  THEN Q1$ = "": RETURN 
  166. 10034  ON  VAL(Q1$) GOSUB 10100,10200,10600,10400,10300,10500: GOTO 10000
  167. 10100  HOME :X1$ = " CREATE DATA DISK ": FLASH : VTAB 7: GOSUB 15001: NORMAL : POKE 34,7
  168. 10110  VTAB 10: FLASH : PRINT S$" WARNING ";: NORMAL : PRINT " CREATION OF DATA DISK DESTROYS  ANY EXISTING DATA ON THE TARGET DISK."
  169. 10120  PRINT : PRINT "STRIKE [!] TO PROCEED, [ANY KEY] ABORTS";: GET A$: PRINT : IF A$ < >"!"  THEN  RETURN 
  170. 10123  POKE KB%,0: POKE 34,13: VTAB 13: CALL  -958
  171. 10125  PRINT : PRINT "INSERT TARGET DISK IN DRIVE " PEEK(798): PRINT : PRINT "STRIKE [ANY KEY] TO CONTINUE ";: GOSUB 3100: GET A$: PRINT : IF A$ = ES$  THEN  RETURN 
  172. 10127  ONERR  GOTO 10140
  173. 10130  PRINT : PRINT D$"VERIFYP20,D" PEEK(798)
  174. 10131  PRINT : FLASH : PRINT S$S$" REMOVE GAME DISK FROM DRIVE!! ": NORMAL : PRINT : PRINT "STRIKE [ANY KEY] TO CONTINUE ";: GET A$: PRINT : GOTO 10123
  175. 10140  CALL 787: ONERR  GOTO 19010
  176. 10145  PRINT : VTAB 20: HTAB 15: FLASH : PRINT " CREATING ": NORMAL : POKE 34,23: VTAB 23
  177. 10150  PRINT : POKE 214,0: PRINT D$"INITCKH,D" PEEK(798)
  178. 10151  POKE 214,128
  179. 10155  PRINT D$"DELETECKH,D" PEEK(798)
  180. 10160  PRINT D$"BSAVESTUDENTS & ROSTERS,A768,L1,D" PEEK(798)
  181. 10165  PRINT D$"LOCKSTUDENTS & ROSTERS,D" PEEK(798)
  182. 10170  INVERSE : VTAB 20: HTAB 15: GOSUB 3100: PRINT " COMPLETED ": NORMAL : FOR I = 1 TO 2000: NEXT :DFL% = 1: RETURN 
  183. 10200  HOME :X1$ = " TRANSFER STUDENT ": FLASH : VTAB 7: GOSUB 15001: NORMAL : POKE 34,7:RF% = 0:C% = 0:OK% = 0: POKE 44452,16: POKE 44605,15
  184. 10203  VTAB 10: PRINT "TRANSFER [S]TUDENT OR [R]OSTER -> [S]";: HTAB 36: GOSUB 3100: GET A$: IF A$ = ES$  THEN  RETURN 
  185. 10206  IF A$ = "R"  THEN  PRINT A$: GOTO 10254
  186. 10209  PRINT : PRINT : GOSUB 9003: IF A$ = "N"  THEN 10245
  187. 10212  IF A$ = ES$  THEN  RETURN 
  188. 10215  IF PN$ = ""  THEN 10200
  189. 10218  GOSUB 25200: POKE 34,6: HOME : VTAB 6: FLASH : GOSUB 15001: NORMAL : POKE 34,7: GOSUB 3200: IF RF%  THEN  VTAB 4: HTAB 1: CALL  -868: VTAB 6: CALL  -958: GOTO 10200
  190. 10221  GOSUB 10290
  191. 10224  POKE KB%,0: FOR P = 1 TO RC%: IF   NOT RC%(P)  THEN 10236
  192. 10225  HOME : IF  PEEK(798) = 1  THEN  GOSUB 10293
  193. 10227 X$ = RN$(P): HOME : INVERSE : PRINT "READING";: NORMAL : PRINT SP$;X$: GOSUB 25010: IF  PEEK(798) = 1  THEN  GOSUB 10296
  194. 10230  IF  PEEK(KP%) = 27 +KN%  OR FU%  THEN  GOSUB 24000: GOTO 10239
  195. 10233  HOME : INVERSE : PRINT "WRITING";: NORMAL : PRINT SP$;X$:DD% = 1:FU% = 1: GOSUB 25280:FU% = 0: IF  PEEK(KP%) = K7% +KN%  THEN 10239
  196. 10236  NEXT 
  197. 10239  IF  PEEK(798) = 2  THEN  HOME : PRINT "MAKE SURE ";: FLASH : PRINT "GAME";: NORMAL : PRINT " DISK IS IN DRIVE 1 ": PRINT "STRIKE [ANY KEY] TO RETURN TO MENU ";: GOSUB 3100: GET A$
  198. 10242 FU% = 0: RETURN 
  199. 10245  PRINT : PRINT SN$;: GOSUB 3003:X$ = C$: IF X$ = ""  THEN 10200
  200. 10248  IF X$ = "C"  THEN  GOSUB 10500: GOTO 10245
  201. 10251 RC%(1) = 1:RC% = 1:RN$(1) = X$: POKE 34,16: GOTO 10221
  202. 10254  PRINT : PRINT SR$;: GOSUB 3003:PN$ = C$: IF PN$ = ""  THEN  GOTO 10200
  203. 10257  IF PN$ = "C"  THEN  GOSUB 10500: GOTO 10254
  204. 10260  POKE 34,14:OK% = 5: GOSUB 10290
  205. 10263  POKE KB%,0: IF  PEEK(798) = 1  THEN  GOSUB 10293
  206. 10266  HOME : INVERSE : PRINT "READING ROSTER";: NORMAL : PRINT SP$;PN$: GOSUB 25200
  207. 10269  IF  PEEK(KP%) = 27 +KN%  THEN 10239
  208. 10272  IF  PEEK(798) = 1  THEN  GOSUB 10296
  209. 10275  HOME : INVERSE : PRINT "WRITING ROSTER";: NORMAL : PRINT SP$;PN$: GOSUB 25231:DD% =  PEEK(798): GOTO 10239
  210. 10290  IF  PEEK(798) = 2  THEN  HOME : PRINT "INSERT ORIGIN IN DRIVE 2": PRINT "INSERT TARGET IN DRIVE 1"CP$(3);: GOSUB 3100: GET A$: IF A$ = ES$  THEN  POP : RETURN 
  211. 10291  RETURN 
  212. 10293  HOME : PRINT "INSERT ORIGIN IN DRIVE 1"CP$(3);: GOSUB 3100: GET A$: PRINT : IF A$ = ES$  THEN  POP : GOTO 10239
  213. 10294  RETURN 
  214. 10296  HOME : PRINT "INSERT TARGET IN DRIVE 1"CP$(3);: GOSUB 3100: GET A$: PRINT : IF A$ < >ES$  THEN  RETURN 
  215. 10297  POP : IF OK% < >5  THEN  GOSUB 24000
  216. 10298  GOTO 10239
  217. 10300  HOME :X1$ = " DISK  DRIVES ": FLASH : VTAB 7: GOSUB 15001: NORMAL : POKE 34,7
  218. 10302  VTAB 12: PRINT "CURRENT NUMBER OF DRIVES IS  : ["; PEEK(798);"]"
  219. 10305  VTAB 15: HTAB 1: CALL  -958: PRINT "ENTER NUMBER OF DRIVES [1-2] : [ ]";: GOSUB 3100: HTAB 33: GET A$: PRINT A$: IF A$ = ES$  OR A$ =  CHR$(13)  THEN  RETURN 
  220. 10307  IF A$ <"1"  OR A$ >"2"  THEN 10305
  221. 10310  IF  VAL(A$) =  PEEK(798)  THEN  RETURN 
  222. 10312  POKE 798, VAL(A$):DD% =  PEEK(798)
  223. 10313  GOSUB 10430: RETURN 
  224. 10400  HOME :X1$ = " PRINTER SLOT ": FLASH : VTAB 7: GOSUB 15001: NORMAL : POKE 34,7
  225. 10402  VTAB 12: PRINT "CURRENT PRINTER SLOT IS  : ["; PEEK(799);"]"
  226. 10405  VTAB 15: HTAB 1: CALL  -958: PRINT "ENTER PRINTER SLOT [1-7] : [ ]";: GOSUB 3100: HTAB 29: GET A$: PRINT A$: IF A$ = ES$  OR A$ =  CHR$(13)  THEN  RETURN 
  227. 10410  IF A$ <"1"  OR A$ >"7"  THEN 10405
  228. 10412  IF  VAL(A$) =  PEEK(799)  THEN  RETURN 
  229. 10415  POKE 799, VAL(A$)
  230. 10430  GOSUB 11100: ONERR  GOTO 19010
  231. 10431  PRINT D$"UNLOCK UL.2,D1"
  232. 10432  PRINT D$"BSAVE UL.2,A768,L45"
  233. 10433  PRINT D$"LOCK UL.2"
  234. 10434  RETURN 
  235. 10500  HOME : PRINT D$"CAT,D" PEEK(798): GET A$: HOME : PRINT : RETURN 
  236. 10600  HOME :X1$ = " RENAME STUDENT ": FLASH : VTAB 7: GOSUB 15001: NORMAL : POKE 34,7: POKE 4452,16: POKE 44605,15:RF% = 0
  237. 10603  VTAB 10: PRINT "RENAME [S]TUDENT OR [R]OSTER -> [S]";: HTAB 34: GOSUB 3100: GET A$: IF A$ = ES$  THEN  RETURN 
  238. 10605  IF A$ = "R"  THEN  PRINT A$: GOTO 10620
  239. 10610  PRINT : PRINT : PRINT SN$;: GOSUB 3003:X$ = C$: IF X$ = ""  THEN 10600
  240. 10611  IF X$ = "C"  THEN  GOSUB 10500: GOTO 10610
  241. 10612  GOSUB 10700:X$ = "^" +X$: GOTO 10630
  242. 10620  PRINT : PRINT SR$;: GOSUB 3003:X$ = C$: IF X$ = ""  THEN 10600
  243. 10621  IF PN$ = "C"  THEN  GOSUB 10500: GOTO 10620
  244. 10622 X$ = X$ +RS$:RF% = 1
  245. 10630  PRINT : PRINT "[NEW NAME] [C]ATALOG -> ";: GOSUB 3003:Q1$ = C$: IF Q1$ = ""  THEN 10600
  246. 10635  IF Q1$ = "C"  THEN  GOSUB 10500: GOTO 10630
  247. 10636  IF RF%  THEN Q1$ = Q1$ +RS$: GOTO 10639
  248. 10637 Q1$ = "^" +Q1$
  249. 10639  IF X$ = Q1$  THEN  RETURN 
  250. 10640  GOSUB 11000: ONERR  GOTO 10655
  251. 10645  PRINT D$"VERIFY"Q1$",D" PEEK(798)
  252. 10650  PRINT : FLASH : PRINT ND$;: GOSUB 3500: PRINT : GOTO 10600
  253. 10655  CALL 787: ONERR  GOTO 19010
  254. 10660  FLASH : VTAB 16: HTAB 16: PRINT " RENAMING ": NORMAL : PRINT : PRINT D$"UNLOCK"X$",D" PEEK(798)
  255. 10665  PRINT D$"RENAME"X$","Q1$
  256. 10670  PRINT D$"LOCK"Q1$
  257. 10671  IF RF%  THEN  RETURN 
  258. 10673 X$ =  RIGHT$(X$, LEN(X$) -1): GOSUB 22500: FOR V = 0 TO 3: FOR I = 1 TO 15: IF X$ = T1$(V,I,1)  THEN T1$(V,I,1) =  RIGHT$(Q1$, LEN(Q1$) -1):WC%(V) = 1:V = 3:I = 15
  259. 10675  NEXT : GOSUB 22700: RETURN 
  260. 10700  FOR I = 1 TO 5: IF X$ = IN$(I)  THEN  PRINT : FLASH : PRINT " CAN'T RENAME INSTRUCTOR ";: GOSUB 3500: POP : RETURN 
  261. 10701  NEXT : RETURN 
  262. 11000  ONERR  GOTO 11010
  263. 11005 VT% =  PEEK(37) +1:SS% = 786: IF  PEEK(798) = 2  OR DFL%  OR Q1$ = "2"  THEN 11020
  264. 11010  CALL SS%: VTAB 24: PRINT "INSERT DATA DISK IN DRIVE ";DD%;" AND HIT KEY";: GOSUB 3100: GET A$: VTAB 23: CALL  -958: PRINT 
  265. 11012  IF A$ = ES$  THEN DD% =  PEEK(798): POP : POP : GOTO 11030
  266. 11020 SS% = 787: PRINT D$"VERIFYSTUDENTS & ROSTERS,D"DD%
  267. 11030 AB% = 0:DD% =  PEEK(798):DFL% = 1: RETURN 
  268. 11100  ONERR  GOTO 11110
  269. 11105 SS% = 786: IF  PEEK(798) = 2  OR   NOT DFL%  THEN 11120
  270. 11110  CALL SS%: VTAB 24: PRINT "INSERT GAME DISK IN DRIVE 1 AND HIT KEY";: GOSUB 3100: GET A$: VTAB 23: CALL  -958: PRINT 
  271. 11120 SS% = 787: PRINT D$"VERIFY P20,D1"
  272. 11130 DFL% = 0: RETURN 
  273. 13000  POKE 34,4: HOME : VTAB 12: HTAB 8: PRINT "ONE ETERNAL MOMENT PLEASE"
  274. 13004  GOSUB 11100: ONERR  GOTO 19010
  275. 13005  PRINT D$"RUNP20,D1"
  276. 15000  POKE 34,3: HOME : VTAB 5
  277. 15001  HTAB (40 - LEN(X1$))/2 +1: PRINT X1$: POKE 34,5: VTAB 8: POKE KB%,0: RETURN 
  278. 19000  CALL 787: POKE KB%,0: IF  PEEK(222) = 11  THEN  VTAB 14: FLASH : PRINT "INVALID ROSTER NAME";: GOSUB 3500: POP : GOTO 4000
  279. 19001  IF  PEEK(222) = 255  THEN  CALL 803
  280. 19002  IF  PEEK(222) = 9  THEN 19020
  281. 19003  IF  PEEK(222) < >6  THEN 19030
  282. 19004  CALL 787: IF  PEEK(222) = 6  THEN  VTAB 14: INVERSE : PRINT S$S$"ROSTER NOT ON DISK";: NORMAL : PRINT " CREATE IT [Y/N] ? [N]";: HTAB 39: VTAB  PEEK(37): GET A$: IF A$ < >"Y"  THEN  POP : GOTO 4000
  283. 19005  PRINT A$:RC% = 0: RETURN 
  284. 19010  CALL 787: POKE KB%,0: IF  PEEK(222) = 6  THEN  VTAB VT% +2 *(VT% <23): HTAB 1: FLASH : PRINT " NOT ON DISK ";: GOSUB 3500: POP : POP : GOTO 9200
  285. 19015  IF  PEEK(222) = 255  THEN  CALL 803
  286. 19016  IF  PEEK(222) < >9  THEN 19025
  287. 19020  FLASH : PRINT : PRINT S$" DATA DISK FULL ";: NORMAL : PRINT " INSERT DATA DISK WITH": PRINT " FREE SPACE: ";CP$(0);: GET A$: IF A$ < >ES$  THEN  VTAB  PEEK(37) -1: CALL  -958: PRINT : VTAB  PEEK(37): RESUME 
  288. 19021  IF FU%  THEN  POP : GOTO 10230
  289. 19022  POP : RETURN 
  290. 19025  IF  PEEK(222) < >10  THEN 19030
  291. 19026  PRINT : PRINT D$"CLOSE"
  292. 19027  FLASH : PRINT ND$;: GOSUB 3500: PRINT : POP : GOSUB 24000: GOTO 10239
  293. 19030  FLASH : PRINT S$" DISK ERROR ";: NORMAL : PRINT " CHECK SETUP AND STRIKE KEY";: GET A$: HTAB 1: CALL  -868: VTAB  PEEK(37): PRINT : RESUME 
  294. 19050  CALL 787: IF  PEEK(222) = 5  THEN  PRINT : PRINT D$"CLOSE": RETURN 
  295. 19051  IF  PEEK(222) = 255  THEN  RESUME 
  296. 19052  GOTO 19030
  297. 22500  VTAB 18: PRINT SP$NY$: POKE 34,23: VTAB 24: IF F1%  THEN  RETURN 
  298. 22503  GOSUB 11100: ONERR  GOTO 19050
  299. 22504 F1% = 1: FOR I = 0 TO 3: GOSUB 22600
  300. 22505  NEXT : RETURN 
  301. 22600  PRINT D$"OPENTOP10."V$(I)",D1"
  302. 22601  PRINT D$"READTOP10."V$(I)
  303. 22602  FOR Z = 1 TO 15: FOR J = 1 TO 9: INPUT T1$(I,Z,J): NEXT J,Z
  304. 22603  PRINT D$"CLOSE"
  305. 22604  RETURN 
  306. 22700  GOSUB 11100: ONERR  GOTO 19010
  307. 22701  FOR I = 0 TO 3: IF   NOT WC%(I)  THEN 22721
  308. 22703  PRINT D$"OPENTOP10."V$(I)",D1"
  309. 22706  PRINT D$"UNLOCKTOP10."V$(I)
  310. 22709  PRINT D$"WRITETOP10."V$(I)
  311. 22712  FOR Z = 1 TO 15: FOR J = 1 TO 9: PRINT T1$(I,Z,J): NEXT J,Z
  312. 22715  PRINT D$"CLOSE"
  313. 22718  PRINT D$"LOCKTOP10."V$(I)
  314. 22721  NEXT I: RETURN 
  315. 23000 SP$ = " ":BS$ =  CHR$(8):DD% =  PEEK(798):DFL% = 0:CP$(1) = " READY ":CP$(2) = "  [ANY]=PRINT  [ESC]=EXIT ":SN$ = "[STUDENT] [C]ATALOG -> ":SR$ = "[ROSTER] [C]ATALOG -> ":CP$(3) = " - STRIKE KEY ":KB% =  -16368:SD% = 768: POKE 6,46
  316. 23105 D$ =  CHR$(4):CF% = 0:S$ =  CHR$(7):F1% = 0: GOSUB 23200:L1$ = "========================================":L2$ = "     C O M P E T I T I O N    K A R A T E     -     T E A M    R O S T E R":RS$ = ".ROSTER":KP% =  -16384:KN% = 128:ES$ =  CHR$(27)
  317. 23106  DIM RN$(31),AB%(9),RA$(16),PP%(16),AP%(16),T1$(3,16,9),WC%(3),RC%(30): FOR I = 0 TO 3: READ V$(I): NEXT : FOR I = 1 TO 9: READ AB$(I): NEXT : FOR I = 1 TO 16: READ RA$(I),PP%(I),AP%(I): NEXT :ND$ = " NAME ALREADY ON DISK ":NY$ = "* *  NOTIFYING TOP 10 COMMISSION * *"
  318. 23132  FOR I = 0 TO 3: READ US$(I): NEXT :L3$ = "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^":CU$ = "]":BR$ = "[ ] ":K5% = 15:K6% = 6:K2% = 32:K3% = 13:K8% = 8:K1% = 21:K7% = 27:K9% = 33:CP$(0) = "  [ANY]=CONT  [ESC]=ABORT ": RETURN 
  319. 23200  GOSUB 11100: ONERR  GOTO 19000
  320. 23205  PRINT D$"OPEN UL.4,D1"
  321. 23210  PRINT D$"READ UL.4"
  322. 23215  FOR I = 1 TO 5: INPUT INST$(I): FOR J = 1 TO 4: INPUT IA%(I,J): NEXT J,I
  323. 23220  PRINT D$"CLOSE"
  324. 23225  RETURN 
  325. 24000  HTAB 1: VTAB 4: CALL  -868: POKE 34,5: HOME : PRINT S$S$S$S$: FLASH : VTAB 7: GOSUB 15001: NORMAL : POKE 34,7
  326. 24005  VTAB 9: PRINT "THE TRANSFER PROCESS HAS BEEN ";: FLASH : PRINT " ABORTED ": NORMAL : VTAB 12: PRINT "HOWEVER, <"X$"> WAS DELETED": PRINT "FROM THE ORIGIN DISK, AND NOT YET COPIEDONTO THE TARGET DISK."
  327. 24015  PRINT : PRINT "INSERT THE ORIGIN DISK OR A COMPETITION KARATE DATA DISK IN DRIVE (" PEEK(798)") AND PRESS [ANY KEY] TO RESTORE THE FILE.";: GET A$: PRINT 
  328. 24020  PRINT : INVERSE : PRINT "WRITING";: NORMAL : PRINT SP$;X$:AB% = 0: GOSUB 11000: ONERR  GOTO 19010
  329. 24021  PRINT D$"OPEN^"X$;",D"; PEEK(798)
  330. 24022  GOSUB 25290: POKE 34,8: RETURN 
  331. 25010 AB% = 1: GOSUB 11000: ONERR  GOTO 19010
  332. 25015  PRINT D$"VERIFY^"X$",D" PEEK(798)
  333. 25020  PRINT D$"OPEN^"X$
  334. 25030  PRINT D$"READ^"X$
  335. 25040  FOR I = 1 TO 9: INPUT AB%(I): NEXT : INPUT US%,AVG%,IN%,WE%,HT%,RA%,WI%,LO%,XP%,T1%,T2%,KO%,PNTS%,RDY%,NS$
  336. 25070  PRINT D$"CLOSE^"X$
  337. 25071  IF   NOT US%  THEN NS$ = INST$(IN%)
  338. 25072  IF Q$ < >"6"  OR Q1$ < >"2"  THEN  RETURN 
  339. 25073  PRINT D$"UNLOCK^"X$",D" PEEK(798)
  340. 25074  PRINT D$"DELETE^"X$
  341. 25075  RETURN 
  342. 25200  FOR I = 1 TO 30:RN$(I) = "": NEXT 
  343. 25202 AB% = 1: GOSUB 11000: ONERR  GOTO 19010
  344. 25204  IF Q$ = "1"  THEN  ONERR  GOTO 19000
  345. 25206  PRINT D$"VERIFY"PN$".ROSTER,D" PEEK(798)
  346. 25208  PRINT D$"OPEN"PN$RS$
  347. 25210  PRINT D$"READ"PN$RS$
  348. 25212  INPUT RC%
  349. 25214  IF RC%  THEN  FOR I = 1 TO RC%: INPUT RN$(I): NEXT 
  350. 25216  PRINT D$"CLOSE"PN$RS$
  351. 25218  RETURN 
  352. 25220  IF   NOT FL%  THEN  RETURN 
  353. 25225  HOME : HTAB 13: FLASH : PRINT " SAVING CHANGES ": NORMAL 
  354. 25230  GOSUB 11000: GOTO 25234
  355. 25231 AB% = 1:DD% = 1: GOSUB 11000:DD% = 1
  356. 25234  ONERR  GOTO 19000
  357. 25235  PRINT D$"OPEN"PN$".ROSTER,D"DD%
  358. 25240  PRINT D$"UNLOCK"PN$RS$
  359. 25245  PRINT D$"WRITE"PN$RS$
  360. 25250  PRINT RC%
  361. 25255  IF RC%  THEN  FOR I = 1 TO RC%: PRINT RN$(I): NEXT 
  362. 25260  PRINT D$"CLOSE"PN$RS$
  363. 25265  PRINT D$"LOCK"PN$RS$
  364. 25270 DD% =  PEEK(798): RETURN 
  365. 25280 AB% = 1: GOSUB 11000: ONERR  GOTO 19010
  366. 25285  PRINT D$"OPEN^"X$",D1"
  367. 25290  IF Q1$ < >"2"  THEN  PRINT D$"UNLOCK^"X$
  368. 25292  IF   NOT US%  THEN NS$ = ""
  369. 25295  PRINT D$"WRITE^"X$
  370. 25300  FOR I = 1 TO 9: PRINT AB%(I): NEXT : PRINT US%: PRINT AVG%: PRINT IN%: PRINT WE%: PRINT HT%: PRINT RA%
  371. 25310  PRINT WI%: PRINT LO%: PRINT XP%: PRINT T1%: PRINT T2%: PRINT KO%: PRINT PNTS%: PRINT RDY%: PRINT NS$
  372. 25315  PRINT D$"CLOSE"
  373. 25320  PRINT D$"LOCK^"X$
  374. 25325  RETURN 
  375. 25335  DATA  WHITE,BLUE,BROWN,BLACK,STRENGTH,AGILITY,QUICKNESS,STAMINA,PERCEPTION,COURAGE,ARMS,LEGS,BODY
  376. 25385  DATA WHITE,1,3,YELLOW,110,20,PURPLE,310,31,BLUE,520,43,GREEN,750,56,BROWN,1020,71,1ST DEG BLACK,1420,91,2ND DEG BLACK,1830,112
  377. 25390  DATA  3RD DEG BLACK,2260,134,4TH DEG BLACK,2730,157,5TH DEG BLACK,3200,181,6TH DEG BLACK,3700,206,7TH DEG BLACK,4230,232
  378. 25395  DATA  8TH DEG BLACK,4760,259,9TH DEG BLACK,5320,287,RED BELT,6070,317,STUDENT,CHALLENGER,INSTRUCTOR,RETIRED