Listing of file='PRGZAP.BAS;01' on disk='vmedia/ncc_12-sector.ccvf'
100 PLOT 6,2,27,24,12,14
110 PRINT "PRGZAP(16K) BY E. W. SWANK V4.28.80 FOR V6.78 DISK BASIC"
120 PLOT 10:PRINT "THIS UTILITY MAKES IN-PLACE CHANGES TO PRG TYPE FILES"
130 PLOT 10:PRINT "YOU ENTER THE PRG FILENAME; THEN THE LOCATION AND"
140 PRINT "LENGTH(UP TO 128 BYTES) OF THE AREA TO BE CHANGED."
150 PRINT "THIS AREA IS DISPLAYED IN BOTH HEX AND ASCII."
160 PRINT "YOU MOVE THE CURSOR OVER THE DATA AND MAKE CHANGES."
170 PRINT "CHANGES ARE MARKED BY A BLUE HIGHLIGHT ."
180 PLOT 10:PRINT "THE CHANGES ARE WRITTEN BACK WHEN YOU PRESS THE RETURN KEY."
190 PRINT "YOU CAN THEN ENTER ANOTHER LOCATION/LENGTH FOR THE SAME FILE."
200 PLOT 10:PRINT "YOU MUST PRESS RESET TO EXIT THIS PROGRAM"
210 PRINT "OR AVOID WRITING BACK TO THE FILE"
220 PRINT " "
230 UDOS= 44288
240 GOTO 1980:REM LOAD KEYBOARD PATCH
250 UDOS= 44288:CXJ= 33283:AD= CXJ:GOSUB 2250:KBP= Z
260 AD= 32940:GOSUB 2250:TM= Z
270 PLOT 3,0,21
280 PRINT "ENTER NAME OF PRG FILE TO ZAP: ";:ML= 31:GOSUB 2420:REM
290 EUDOS= UDOS+ 330:DSN= UDOS+ 256:RWST= UDOS+ 288
300 FSIZ= UDOS+ 303:LBC= UDOS+ 305:FLAD= UDOS+ 306:STAD= UDOS+ 308
310 FBLK= UDOS+ 319:DBUF= UDOS+ 321:FXBC= UDOS+ 323
320 FOR N= 1TO LEN (B$):POKE DSN- 1+ N,ASC (MID$ (B$,N,1)):NEXT
330 POKE DSN+ LEN (B$),0
340 GOSUB 2400:RC= CALL (0)
350 IF RC< 0 THEN PRINT "ERROR OPENING FILE":GOTO 270
360 B$= "":FOR N= 297TO 299:B$= B$+ CHR$ (PEEK (UDOS+ N)):NEXT
370 IF B$< > "PRG" THEN PRINT "ONLY PRG TYPE FILES ARE SUPPORTED":GOTO 270
380 AD= FSIZ:GOSUB 2250:PSIZ= 128* (Z- 1)+ PEEK (LBC)
390 AD= FLAD:GOSUB 2250:FLAD= Z
400 PRINT ""
410 DI= Z:GOSUB 1920:PRINT "PROGRAM EXTENT:";DI;"(";DO$;"H) -";
420 DI= FLAD+ PSIZ- 1:GOSUB 1920:PRINT DI;"(";DO$;"H)"
430 PLOT 10,10,11,28,11:PRINT "ENTER ADDRESS(DEC OR HEXH) OF ZAP AREA:";:ML= 6:GOSUB 2420:PRINT ""
440 CI$= B$:GOSUB 1720:ZA= CO
450 IF ZA< FLAD OR ZA> FLAD+ PSIZ- 1 THEN PRINT "ZAP AREA OUTSIDE LIMITS:RE-ENTER":Z= FLAD:PLOT 28,28,28,28,11,28,11:GOTO 410
460 RBA= INT ((ZA- FLAD)/ 128):REM REL BLK ADDR
470 AD= FBLK:Z= RBA:GOSUB 2240
480 AD= DBUF:Z= UDOS:GOSUB 2240
490 RL= PSIZ- 128* INT ((ZA- FLAD)/ 128):IF RL> 256 THEN RL= 256
500 AD= FXBC:Z= RL:GOSUB 2240
510 GOSUB 2400:RC= CALL (3):IF RC= 0THEN 540
520 HI= PEEK (RWST):GOSUB 1850:PRINT "READ ERROR--RWSTATUS: ";HO$
530 OUT 8,255:END :RUN
540 BF= UDOS+ (ZA- (FLAD+ 128* RBA))
550 EB= RL- (BF- UDOS):IF EB> 128THEN EB= 128
560 PRINT "ENTER LENGTH(DEC OR HEXH) OF ZAP AREA(1-";
570 EB$= STR$ (EB):PRINT RIGHT$ (EB$,LEN (EB$)- 1);"):";
580 ML= 6:GOSUB 2420:PRINT ""
590 CI$= B$:GOSUB 1720:IF CO< > 0 THEN 620
600 CO= 64:IF EB< CO THEN CO= EB
610 PRINT "LENGTH DEFAULTS TO";CO
620 IF CO> EBTHEN PRINT "LENGTH REDUCED TO";EB;"(DEC)":CO= EB
630 EB= CO
640 EB= EB+ BF- 1
650 PLOT 8:FOR N= 0TO 19:PLOT 11,10:NEXT :PLOT 11
660 SB= 28672:REM BASE FOR SCREEN REFRESH RAM
670 SY= 6:SX= 0:REM INITIAL SCREEN WRITE POS
680 PLOT 3,64,0
690 FOR IP= BFTO EBSTEP 16
700 DI= ZA+ IP- BF:GOSUB 1920
710 SA= SB+ 2* (64* SY+ SX)
720 AA= SA+ 92:POKE AA,42:POKE AA+ 34,42:AA= AA+ 2
730 FOR N= 1TO 4
740 POKE SA,ASC (MID$ (DO$,N,1))
750 SA= SA+ 2
760 NEXT N
770 SA= SA+ 4:REM " "
780 FOR J1= 0TO 3
790 FOR J2= 0TO 3
800 BA= IP+ 4* J1+ J2:REM BYTE ADDRESS
810 IF BA> EB THEN IP= EB+ 1:GOTO 930
820 HI= PEEK (BA)
830 GOSUB 1850
840 POKE SA,ASC (LEFT$ (HO$,1)):SA= SA+ 2
850 POKE SA,ASC (RIGHT$ (HO$,1)):SA= SA+ 2
860 POKE AA,HI:AA= AA+ 2
870 IF HI< 32 THEN POKE AA- 1,1:GOTO 890
880 IF HI> 96 THEN POKE AA- 1,1
890 NEXT J2
900 SA= SA+ 4
910 NEXT J1
920 SY= SY+ 1:SX= 0
930 NEXT IP
940 REM SETUP KEYBD READ
950 PLOT 27,27:GOSUB 2370
960 SY= 6:SX= 6:PLOT 3,6,6:SA= SB+ 780:AA= SA+ 82:IP= BF:DX= 0:DY= 0
970 GOTO 1580
980 REM READ KEYBOARD
990 KY= CALL (5):IF KY= - 1 THEN 990
1000 IF KY= 10 THEN DY = 1:GOTO 1320
1010 IF KY= 28 THEN DY = - 1:GOTO 1320
1020 IF KY= 26 THEN DX = - 1:GOTO 1320
1030 IF KY= 25 THEN DX = 1:GOTO 1320
1040 IF KY= 9 THEN 1200
1050 IF KY= 13 THEN 1260
1060 IF SX> 46 THEN 1150
1070 IF KY< 48 OR KY> 70 OR (KY< 65AND KY> 57) THEN 980
1080 POKE SA,KY
1090 N= SX AND - 2:N= SB+ 2* (64* SY+ N)
1100 CI$= CHR$ (PEEK (N))+ CHR$ (PEEK (N+ 2))+ "H":GOSUB 1720
1110 POKE N+ 1,34:POKE N+ 3,34:POKE IP,CO:POKE AA,CO:POKE AA+ 1,34
1120 IF (CO< 32) OR (CO> 96) THEN POKE AA+ 1,33
1130 REM DIAG HI=KY:GOSUB13800:PLOT 27,12,3,40,30:PRINTKY;" ";HO$:REMTEST
1140 GOTO 1500
1150 REM ALPHA UPD
1160 POKE AA,KY:POKE AA+ 1,34:POKE IP,KY:HI= KY:GOSUB 1850
1170 IF HI< 32 OR HI> 96 THEN POKE AA+ 1,33
1180 POKE SA,ASC (LEFT$ (HO$,1)):POKE SA+ 1,34:POKE SA+ 2,ASC (RIGHT$ (HO$,1)):POKE SA+ 3,34
1190 GOTO 1130
1200 REM : TAB KEY
1210 IF SX> 46 THEN 1240
1220 GOSUB 1680:N= INT ((SX- 6)/ 10):SA= 4* INT (SA/ 4)
1230 SX= 47+ 4* N+ INT (((SX- 6)- 10* N)/ 2):GOTO 1580
1240 GOSUB 1680:N= INT ((SX- 47)/ 4)
1250 SX= 6+ 10* N+ (SX- 47- 4* N)* 2:GOTO 1580
1260 REM : RETURN/ENTER
1270 GOSUB 2400:RC= CALL (4):IF RC= 0THEN 1300
1280 HI= PEEK (RWST):GOSUB 1850:PRINT "WRITE ERROR--RWSTATUS: ";HO$
1290 OUT 8,255:END :RUN
1300 PLOT 3,0,21:FOR N= 21TO 30:PLOT 11,10:NEXT :PLOT 11
1310 PLOT 3,0,20:PRINT "ZAP APPLIED":Z= FLAD:GOTO 400
1320 REM :CURSOR DIRECTION KEYS
1330 IF DY = 0 THEN 1390
1340 IF DY> 0 THEN 1370
1350 IF SY< 7 THEN 980:REM -Y
1360 GOSUB 1680:SY= SY- 1:SA= SA- 128:AA= AA- 128:IP= IP- 16:GOTO 1580
1370 IF SY> 12 OR IP+ 16> EBTHEN 1580:REM +Y
1380 GOSUB 1680:SY= SY+ 1:SA= SA+ 128:AA= AA+ 128:IP= IP+ 16:GOTO 1580
1390 IF DX= 0 THEN 980:REM CUR X
1400 IF DX> 0 THEN 1500
1410 IF SX< 7 THEN 980:REM -X
1420 GOSUB 1680
1430 IF SX= 47 THEN SX= 42:SA= SA+ 72:AA= AA+ 30:IP= IP+ 15:GOTO 1580
1440 IF SX< 44 THEN 1470
1450 N= SX- 46:IF (N AND 3) = 0 THEN SA = SA - 4
1460 SX= SX- 1:SA= SA- 4:AA= AA- 2:IP= IP- 1:GOTO 1580
1470 N= SX- 16:IF INT (N/ 10)= N/ 10 THEN SX= SX- 2:SA= SA- 4
1480 SX= SX- 1:SA= SA- 2:IF (SX AND 1)= 1 THEN AA= AA- 2:IP= IP- 1
1490 GOTO 1580
1500 GOSUB 1680:IF SX= 62 THEN SX= 6:SA= SA- 72:AA= AA- 30:IP= IP- 15:GOTO 1370:REM +X
1510 IF SX= 43 THEN SX= 47:SA= SA- 74:AA= AA- 30:IP= IP- 15:GOTO 1580
1520 IF SX< 44 THEN 1550
1530 N= SX- 46:IF (N AND 3) = 0 THEN SA = SA + 4
1540 SX= SX+ 1:SA= SA+ 4:AA= AA+ 2:IP= IP+ 1:GOTO 1580
1550 N= SX- 13:IF INT (N/ 10)= N/ 10 THEN SX= SX+ 2:SA= SA+ 4
1560 SX= SX+ 1:SA= SA+ 2:IF (SX AND 1)= 0 THEN AA= AA+ 2:IP= IP+ 1
1570 GOTO 1580
1580 REM COMMON MOVE CURSOR
1590 IF IP< = EBTHEN 1620
1600 IF DX> 0THEN 1500
1610 IF DX< 0THEN 1410
1620 HI= PEEK (IP):GOSUB 1850
1630 GOTO 1650:REM BYPASS DIAG AID
1640 PLOT 27,12,3,0,30:PRINT "SX/SY/SA/AA/IP ";SX;" ";SY;" ";SA;" ";AA;" ";IP;" ";HO$;" "
1650 IF SX> 46 THEN POKE SA+ 1,PEEK (SA+ 1) OR 64:POKE SA+ 3,PEEK (SA+ 3)OR 64:GOTO 1670
1660 POKE AA+ 1,PEEK (AA+ 1) OR 64
1670 DX= 0:DY= 0:PLOT 3,SX,SY:GOTO 980
1680 POKE SA+ 1,PEEK (SA+ 1)AND 191:POKE AA+ 1,PEEK (AA+ 1)AND 191
1690 POKE SA+ 3,PEEK (SA+ 3)AND 191
1700 RETURN
1710 INPUT "HEX:";CI$:GOSUB 1720:PRINT " DEC ";CO:GOTO 1710
1720 REM CONVERT HEX STRING IN CI$ TO ARITH IN CO
1730 CO= 0
1740 IF RIGHT$ (CI$,1)< > "H"THEN CO= VAL (CI$):RETURN
1750 IF LEN (CI$)< 2THEN RETURN
1760 FOR I= 1TO LEN (CI$)- 1
1770 C1= ASC (MID$ (CI$,I,1))
1780 C2= 16
1790 IF C1> 47AND C1< 58THEN C2= C1- 48
1800 IF C1> 64AND C1< 71THEN C2= C1- 55:REM HEX A-F
1810 IF C2> 15THEN PRINT "HEX INPUT ERROR ";CI$:OUT 8,255:END
1820 CO= CO* 16+ C2
1830 NEXT I
1840 RETURN
1850 REM CONVERT ARITH VALUE IN HI(0-255) TO TWO HEX CHAR
1860 REM IN HO$
1870 IF HI< 0THEN HI= HI+ 256
1880 H0= INT (HI/ 16)+ 48:IF H0> 57 THEN H0= H0+ 7
1890 H1= (HIAND 15)+ 48:IF H1> 57 THEN H1= H1+ 7
1900 HO$= CHR$ (H0)+ CHR$ (H1)
1910 RETURN
1920 REM CONVERT TWO-BYTE VALUE TO 4-BYTE HEX STRING
1930 IF DI< 0THEN DI= DI+ 65536
1940 HI= INT (DI/ 256):GOSUB 1850:DO$= HO$
1950 HI= (DI- HI* 256):GOSUB 1850
1960 DO$= DO$+ HO$
1970 RETURN
1980 REM ROUTINE TO LOAD MACHINE LANGUAGE PATCH TO READ
1990 REM KEYBOARD AS EACH KEY IS PRESSED.
2000 DATA 245,229,197,62,255,211,8
2010 DATA 1,206,40,205,36,0,202,-1,-1,11
2020 DATA 121,176,194,-1,-1,29,194,-1,-1,17,255,255,195
2030 DATA -1,-1,95,175,87,62,247,211,8,62,0
2040 DATA 50,255,129,193,225,241,201
2050 REM FIND END OF BASIC RAM
2060 AD= 32940:GOSUB 2250:TM= Z
2070 REM CHECK TO SEE IF ALREADY LOADED
2080 IF TM< > UDOS- 50THEN 2150:REM NOT LOADED
2090 RESTORE 2000
2100 FOR I= 1TO 48:READ A
2110 IF A> 0AND A< > PEEK (TM+ I)THEN I= 48:A= 999
2120 NEXT I
2130 IF A< 256THEN 2350:REM LOADED, TO SET JUMP
2140 REM LOAD PROGRAM
2150 TM= UDOS- 50:RESTORE 2000
2160 FOR I= 1TO 48:READ A:POKE TM+ I,A- (A< 0):NEXT I
2170 REM LOAD ADDRESSES
2180 Z= TM+ 33:AD= TM+ 15:GOSUB 2240
2190 Z= TM+ 11:AD= TM+ 21:GOSUB 2240
2200 Z= TM+ 8:AD= TM+ 25:GOSUB 2240
2210 Z= TM+ 36:AD= TM+ 31:GOSUB 2240
2220 GOTO 2280
2230 REM LOAD ADDRESS Z AT AD,AD+1
2240 ZZ= INT (Z/ 256):POKE AD,Z- 256* ZZ:POKE AD+ 1,ZZ:RETURN
2250 REM FETCH ADDRESS Z FROM AD,AD+1
2260 Z= PEEK (AD)+ 256* PEEK (AD+ 1):RETURN
2270 REM CHANGE END OF BASIC RAM
2280 Z= TM:AD= 32940:GOSUB 2240
2290 CLEAR 100
2300 AD= 32940:GOSUB 2250:TM= Z
2305 DV= PEEK (33044)AND 1:REM LOAD DRIVE
2310 PLOT 3,0,17,27,4:PRINT "LOAD";DV;":UDOS.PRG;1":PLOT 27,27
2320 IF PEEK (28672+ 17* 128)= 32 THEN GOSUB 2360:GOTO 250
2330 PRINT "UDOS LOAD FAILURE"
2340 PRINT "UDOS.PRG;1 MUST BE ON LOAD DISK":POKE TM+ 1,0:END :RUN
2350 GOSUB 2360:GOTO 250
2360 REM LOAD BASIC JUMP LOCATION
2370 Z= TM+ 1:AD= 33283:GOSUB 2240
2380 POKE 33282,195
2390 RETURN
2400 Z= EUDOS:AD= 33283:GOSUB 2240
2410 POKE 33282,195:RETURN
2420 GOSUB 2370:B$= ""
2430 REM READ KEYBOARD
2440 CH= CALL (5):IF CH= - 1 THEN 2440
2450 CH$= CHR$ (CH)
2460 IF CH = 26 THEN 2510:REM CURS LEFT
2470 IF CH = 13 THEN PLOT 13,10:RETURN :REM CR
2480 IF CH< 32 OR CH> 96 THEN 2440:REM INVALID INPUT IGNORED
2490 IF LEN (B$)> = ML THEN 2440
2500 PLOT CH:B$= B$+ CH$:GOTO 2440
2510 IF LEN (B$)= 0 THEN 2440
2520 IF LEN (B$)= 1 THEN B$= "":PLOT 26,32,26:GOTO 2440
2530 B$= LEFT$ (B$,LEN (B$)- 1):PLOT 26,32,26:GOTO 2440