home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / KAYPRO / ADVENT1.ARK / TRPATCH.BAS < prev    next >
BASIC Source File  |  1986-09-19  |  8KB  |  223 lines
  1. 10 REM TRPATCH.BAS TurboROM patch program 6/13/86
  2. 12 DEFINT A-Z
  3. 14 ON ERROR GOTO 9000
  4. 20 GOSUB 200      ' SET UP PROGRAM VARIABLES
  5. 30 GOSUB 500     ' READ OVERLAY FILE
  6. 40 CONTFLG = 1    ' FORCE INITIAL PASS PASS THROUGH MAIN PRGM LOOP
  7. 50 ' MAIN PROGRAM LOOP
  8. 60    GOSUB 1000    ' DISPLAY MENU
  9. 70    GOSUB 2000    ' PATCH PROGRAM
  10. 90 GOTO 50        ' END MAIN PROGRAM LOOP
  11. 100 ' EXIT ROUTINE FOR MAIN PROGRAM
  12. 110 PRINT:PRINT:PRINT
  13. 120 STOP
  14. 200 ' SET UP PROGRAM VARIABLES
  15. 220 WIDTH 255
  16. 240 DIM TEXT$(300),PRGNM(32),HEXBYTES(32)
  17. 250 HEXDIGTS$ = "123456789ABCDEF"
  18. 260 CLR$ = CHR$(&H1A)    ' CLEAR SCREEN SEQUENCE
  19. 270 ESC$ = CHR$(&H1B)    ' ASCII ESCAPE CHARACTER
  20. 310 POSITION$ = ESC$+"="
  21. 315 OVERLAY$ = "TRPATCH.DAT"
  22. 317 SIGNON$ = "TurboROM Patch Program  6/13/86  2.A"
  23. 320 RETURN
  24. 500 ' READ PATCH OVERLAY FILE INTO MEMORY AND BUILD INDEX ARRAY
  25. 510 TNDX = 0' TEXT INDEX [0..N]   
  26. 520 PNDX = 1' PROGRAM INDEX [1..N]
  27. 522 GOSUB 3000 ' clear the screen
  28. 524 A$ = SIGNON$:GOSUB 3100
  29. 528 PRINT:PRINT "Reading data file: ";OVERLAY$;"... ";
  30. 530 OPEN "I",#1,OVERLAY$
  31. 540 WHILE NOT EOF(1)    ' READ OVERLAY FILE
  32. 550    LINE INPUT #1, A$
  33. 555    IF LEFT$(A$,4) = ";VER" THEN VERSION$ = MID$(A$,5):GOTO 560
  34. 560    IF LEFT$(A$,1) <> ";" THEN TEXT$(TNDX)=A$: TNDX = TNDX + 1 
  35. 570 WEND
  36. 580 CLOSE #1
  37. 584 PRINT:PRINT "Scanning data... ";
  38. 590 FOR I = 0 TO TNDX-1
  39. 600    IF LEFT$(TEXT$(I),1) = ":" THEN GOTO 640
  40. 610        PRGNM(PNDX) = I
  41. 620        PNDX = PNDX + 1
  42. 630        I = I + 1    ' SKIP FILE NAME
  43. 640 NEXT I
  44. 645 PRINT
  45. 650 RETURN
  46. 1000 ' DISPLAY MENU LOOP. RETURNS INDEX OR 0
  47. 1010    GOSUB 3000 ' clear the screen
  48. 1020    A$ = SIGNON$+VERSION$+"  Main Menu" : GOSUB 3100
  49. 1030    IF PNDX < 17 THEN X = 20 ELSE X = 0
  50. 1040    Y = 3
  51. 1050    FOR I = 1 TO PNDX
  52. 1055        IF I = 17 THEN X = 40:Y = 3
  53. 1060        GOSUB 3300    ' position cursor
  54. 1070        PRINT "[";I;"]";
  55. 1072        X = X+8:GOSUB 3300: X = X-8
  56. 1074        IF I <> PNDX THEN A$ = TEXT$(PRGNM(I)) ELSE A$ = "Quit"
  57. 1076        PRINT A$;
  58. 1080        Y = Y+1
  59. 1090    NEXT I
  60. 1120    X = 20:IF PNDX > 16 THEN Y = 20 ELSE Y = Y+ 2
  61. 1130    GOSUB 3300 ' position cursor
  62. 1140    PRINT "Menu Choice ( 1 -";PNDX;"): "; 
  63. 1150    GOSUB 7000:MENU=ANS
  64. 1160    IF ((MENU >= 1) AND (MENU < PNDX)) THEN RETURN ' exit menu display
  65. 1165    IF (MENU = PNDX) THEN GOTO 100
  66. 1170 GOTO 1000    ' REDISPLAY (WASTES SOME TIME)
  67. 2000 ' patch selected program
  68. 2010 TNDX = PRGNM(MENU)
  69. 2020 PATCH$ = TEXT$(TNDX)    ' PATCH IDENTIFIER STRING
  70. 2030 COMFILE$ = TEXT$(TNDX+1)    ' NAME OF COM FILE TO PATCH
  71. 2050 GOSUB 3000 ' clear the screen
  72. 2060 PRINT "Patching: ";PATCH$;" for TurboROM compatibility"
  73. 2070 PRINT
  74. 2080 PRINT "Which drive has the ";COMFILE$;" program to patch (A,B,...P) " ;
  75. 2090 GOSUB 7000 ' GET INPUT
  76. 2100 IF LEN(ANS$) = 0 THEN ANS$ = CHR$((PEEK(4) AND 15)+ &H41)
  77. 2110 DRIVE$ =  LEFT$(ANS$,1)
  78. 2112 IF DRIVE$ < "A" OR DRIVE$ > "P" THEN GOTO 2050
  79. 2120 INFILE$=DRIVE$+":"+COMFILE$
  80. 2125 RESET ' make certain that all is ok
  81. 2130 OPEN "I",#1,INFILE$
  82. 2140 CLOSE #1:GOTO 2200 ' FILE EXISTS break loop
  83. 2150 ' file not found handler    
  84. 2155    CLOSE:PRINT:PRINT
  85. 2160    PRINT "FILE: ";INFILE$;" not found..."
  86. 2170    GOSUB 3500    ' pause 
  87. 2180    RETURN
  88. 2200 ' FILE FOUND TO PATCH, SO DO IT
  89. 2210 TNDX = TNDX+2    ' ADJUST INDEX FOR PATTERN MATCH STRING
  90. 2220 GOSUB 4000 ' TRY AND FIND PATTERN MATCH
  91. 2225 IF MFLAG THEN GOTO 2240 ' id strings match
  92. 2230    PRINT:PRINT "Version numbers do not match"
  93. 2232    PRINT "Do you want to patch the file anyway (Y/N): ";
  94. 2234    GOSUB 7000 ' get input and convert to upper case
  95. 2236    IF LEFT$(ANS$,1) <> "Y" THEN GOTO 2999 ELSE GOTO 2300 
  96. 2240 ' versions match request confirmation
  97. 2250 PRINT:PRINT"Do you want to patch the file: ";INFILE$;" (Y/N): ";
  98. 2260 GOSUB 7000
  99. 2270 IF LEFT$(ANS$,1) <> "Y" THEN GOTO 2999
  100. 2300 GOSUB 4200 ' patch the file
  101. 2999 RETURN
  102. 3000 ' clear Screen and home cursor
  103. 3010 PRINT CLR$;
  104. 3020 RETURN
  105. 3100 ' PRINT A$, CENTERED
  106. 3110 PRINT SPC((80-LEN(A$))/2);A$
  107. 3120 RETURN
  108. 3300 ' direct cursor postion
  109. 3310 PRINT POSITION$;CHR$(Y+32);CHR$(X+32);
  110. 3320 RETURN
  111. 3500 ' PAUSE QUESTION
  112. 3505 A$=INKEY$:IF A$<>""THEN GOTO 3505
  113. 3510 PRINT:PRINT "Press RETURN to continue...";
  114. 3520 GOSUB 7000
  115. 3530 RETURN
  116. 4000 ' VERIFY MATCH RETURNS MATCH FLAG TRUE ON PATTERN MATCH
  117. 4010 PRINT:PRINT "Verifing version of: ";INFILE$;"... ";
  118. 4020 OPEN "R",#1,INFILE$,128
  119. 4030 FIELD #1,128 AS SECTOR$
  120. 4040 GOSUB 6000 ' GET HEX LINE
  121. 4050 CURRENT = (ADDRESS \ 128) - 1 ' FIRST SECTOR TO PATCH
  122. 4060 GET #1,CURRENT
  123. 4070 MFLAG = 1 ' ASSUME THAT ALL BYTES WILL MATCH
  124. 4080 FOR I = 1 TO BYTECOUNT
  125. 4090    RECORD = (ADDRESS \ 128) - 1
  126. 4100    BYTENUM = (ADDRESS MOD 128)
  127. 4110    IF CURRENT = RECORD THEN GOTO 4130
  128. 4120            GET #1,RECORD: CURRENT = RECORD
  129. 4130    TEMP$ = MID$(SECTOR$,BYTENUM+1,1)
  130. 4140    IF TEMP$ <> CHR$(HEXBYTES(I)) THEN MFLAG = 0
  131. 4150    ADDRESS = ADDRESS + 1
  132. 4160 NEXT I
  133. 4170 CLOSE #1 ' CLOSE THE .COM FILE
  134. 4180 IF MFLAG THEN A$ = "OK." ELSE A$ = "Error."
  135. 4185 PRINT A$
  136. 4190 RETURN
  137. 4200 ' patch image file
  138. 5000 PRINT:PRINT "Updating ";INFILE$;" ... ";
  139. 5010 OPEN "R",#1,INFILE$,128
  140. 5020 FIELD #1,128 AS SECTOR$
  141. 5030 GOSUB 6000 ' READ FIRST LINE
  142. 5040 CURRENT = (ADDRESS \ 128) - 1 ' FIRST SECTOR TO PATCH
  143. 5050 GET #1,CURRENT
  144. 5060 SECDAT$=SECTOR$
  145. 5070 WHILE BYTECOUNT <> 0
  146. 5080     FOR I = 1 TO BYTECOUNT
  147. 5090             RECORD = (ADDRESS \ 128) - 1
  148. 5100             BYTENUM = (ADDRESS MOD 128)
  149. 5110             IF CURRENT = RECORD THEN GOTO 5170
  150. 5120                     LSET SECTOR$=SECDAT$
  151. 5130                     PUT #1,CURRENT 
  152. 5140                     GET #1,RECORD
  153. 5150                     CURRENT = RECORD
  154. 5160                     SECDAT$=SECTOR$
  155. 5170             TEMP$ = LEFT$(SECDAT$,BYTENUM) + CHR$(HEXBYTES(I))
  156. 5180             TEMP$  = TEMP$ + RIGHT$(SECDAT$,127-BYTENUM)
  157. 5190             SECDAT$=TEMP$
  158. 5200             ADDRESS = ADDRESS + 1
  159. 5210     NEXT I
  160. 5220     GOSUB 6000 ' READ NEXT LINE
  161. 5230 WEND
  162. 5240 LSET SECTOR$=SECDAT$
  163. 5250 PUT #1,CURRENT
  164. 5260 GET #1,1 ' ensure that buffers are flushed
  165. 5270 CLOSE #1 ' CLOSE THE .COM FILE
  166. 5275 RESET ' ensure flush to disk
  167. 5280 ' job completed message
  168. 5300 PRINT "Update complete."
  169. 5310 PRINT
  170. 5315 GOSUB 3500
  171. 5320 RETURN
  172. 6000 ' READ AND DECODE ONE LINE OF INTEL HEX
  173. 6010 HEXLINE$ = TEXT$(TNDX): TNDX = TNDX+1
  174. 6020 HEXPOS = 2: GOSUB 6130: BYTECOUNT = HEXDATA
  175. 6030 HEXPOS = 4: GOSUB 6110: ADDRESS = HEXDATA
  176. 6040 HEXPOS = 10 ' FIRST DATA BYTE
  177. 6050 FOR I = 1 TO BYTECOUNT
  178. 6060    GOSUB 6130
  179. 6070    HEXBYTES(I) = HEXDATA
  180. 6080    HEXPOS = HEXPOS + 2
  181. 6090 NEXT I
  182. 6100 RETURN
  183. 6110 ' CONVERT 4 HEX DIGITS TO AN INTEGER  
  184. 6120 HEXLENGTH = 4 : GOTO 6150
  185. 6130 ' CONVERT 2 HEX DIGITS TO AN INTEGER
  186. 6140 HEXLENGTH = 2 ' INITIAL VALUES
  187. 6150 HEXDATA = 0
  188. 6160 FOR DIGIT = HEXPOS TO HEXPOS + HEXLENGTH - 1
  189. 6170    HEXDATA = HEXDATA * 16 + INSTR(HEXDIGTS$,MID$(HEXLINE$,DIGIT,1))
  190. 6180 NEXT DIGIT
  191. 6190 RETURN
  192. 7000 ' INPUT ANS$ THEN CONVERT ANS$ TO UPPER CASE, ANS AS INTEGER
  193. 7010 LINE INPUT; ANS$
  194. 7020 TEMP$=""
  195. 7030 FOR J = 1 TO LEN(ANS$)
  196. 7040    A$ = MID$(ANS$,J,1)
  197. 7050    IF A$ >="a" AND A$ <= "z" THEN A$ = CHR$(ASC(A$)-32)
  198. 7060    TEMP$ = TEMP$ + A$
  199. 7070 NEXT J
  200. 7080 ANS$ = TEMP$:ANS = VAL(ANS$)
  201. 7090 RETURN
  202. 9000 ' error handlers
  203. 9010 IF ERL = 530 THEN RESUME  9200 ' PATCH DATA FILE NOT FOUND
  204. 9020 IF ERL = 2130 THEN RESUME 2150    ' FILE NOT FOUND
  205. 9030 IF ERL = 4020 THEN RESUME 9300
  206. 9035 IF ERL = 5010 THEN RESUME 9300
  207. 9040 IF ERL = 5130 THEN RESUME 9400
  208. 9042 IF ERL = 5250 THEN RESUME 9400
  209. 9044 IF ERL = 5270 THEN RESUME 9400
  210. 9050 PRINT:PRINT "Error on line: ";ERL;" Error number ";ERR
  211. 9060 GOTO 100
  212. 9200 ' PATCH DATA FILE NOT FOUND ERROR HANDLER
  213. 9210 PRINT:PRINT "Overlay file: ";OVERLAY$;" not found"
  214. 9220 GOTO 100
  215. 9300 ' error in opening target file
  216. 9310 PRINT:PRINT "Error in opening file: ";INFILE$;
  217. 9320 GOTO 9420
  218. 9400 ' error in writing to target file
  219. 9410 PRINT:PRINT "Error in writing to file: ";INFILE$;
  220. 9420 PRINT "Disk or file may be READ ONLY"
  221. 9430 GOTO 100 
  222. rget file
  223. 9410 PRINT:PRINT "Er