0100 ;SAVE#D:DMPT2.M65
0110     .OPT NO LIST
0120 ;
0130 ;--------------------;
0140 ; Disk Master part 2 ;
0150 ;  by: Barry Kolbe   ;
0160 ;     (c) 1989       ;
0170 ;--------------------;
0180 ;
0190 ;Graphics 0 Display List
0200 ;
0210 GR0DL .BYTE $70,$70,$10,$46
0220     .WORD CR1
0230     .BYTE $10,$42
0240     .WORD BORDER
0250     .BYTE $42
0260     .WORD SM
0270     .BYTE 2,2,2,2,2
0280     .BYTE 2,2,2,2,2
0290     .BYTE 2,2,2,2,2,$10
0300     .BYTE $01
0310 OLDD .WORD CONT ;flip bottom
0320 CONT .BYTE $42  ;of screen
0330     .WORD STATUS ;for HELP
0340     .BYTE 0,2   ;screen at
0350     .BYTE $30,$42
0360     .WORD INPLIN
0370     .BYTE $10,$42
0380     .WORD LINE0
0390     .BYTE $20,$42
0400     .WORD PRLINE
0410     .BYTE $41
0420     .WORD GR0DL
0430 ;
0440 ;The Help Screen Display
0450 ;Code used by HELPME
0460 ;
0470 HELPDL .BYTE $42
0480     .WORD HELPS
0490     .BYTE 0,2,2,2,2,2,$41
0500     .WORD GR0DL
0510 ;
0520 ;Low and High bytes of
0530 ;Screen Lines
0540 ;
0550 GL  .BYTE  <SM, <[SM+40]
0560     .BYTE  <[SM+80], <[SM+120]
0570     .BYTE  <[SM+160], <[SM+200]
0580     .BYTE  <[SM+240], <[SM+280]
0590     .BYTE  <[SM+320], <[SM+360]
0600     .BYTE  <[SM+400], <[SM+440]
0610     .BYTE  <[SM+480], <[SM+520]
0620     .BYTE  <[SM+560], <[SM+600]
0630     .BYTE  <[SM+640], <[SM+680]
0640     .BYTE  <[SM+720], <[SM+760]
0650     .BYTE  <[SM+800], <[SM+840]
0660     .BYTE  <[SM+880], <[SM+920]
0670 ;
0680 GH  .BYTE  >SM, >[SM+40]
0690     .BYTE  >[SM+80], >[SM+120]
0700     .BYTE  >[SM+160], >[SM+200]
0710     .BYTE  >[SM+240], >[SM+280]
0720     .BYTE  >[SM+320], >[SM+360]
0730     .BYTE  >[SM+400], >[SM+440]
0740     .BYTE  >[SM+480], >[SM+520]
0750     .BYTE  >[SM+560], >[SM+600]
0760     .BYTE  >[SM+640], >[SM+680]
0770     .BYTE  >[SM+720], >[SM+760]
0780     .BYTE  >[SM+800], >[SM+840]
0790     .BYTE  >[SM+880], >[SM+920]
0800 ;
0810 CREDIT .SBYTE "disk master "
0820     .BYTE "HcI",0,"QYXY"
0830 CR1 .SBYTE "    disk  "
0840     .SBYTE "editor    "
0850 CR2 .SBYTE " disk  dis"
0860     .SBYTE "assembler "
0870     .SBYTE "     data "
0880     .SBYTE "entry     "
0890 ;
0900 STATUS .SBYTE " SEC:      FI"
0910     .SBYTE "L:      LNK:      "
0920     .SBYTE "BYT:     "
0930 ;
0940 DRLIN .SBYTE " SRC:1     DS"
0950     .SBYTE "T:1     INP:H     "
0960     .SBYTE "DNS:1    "
0970 ;
0980 ;Help Screen
0990 ;
1000 HELPS .SBYTE "Disk Master Help"
1010     .SBYTE " Screen - Select C"
1020     .SBYTE "ommand"
1030     .SBYTE "R-read  +-up    "
1040     .SBYTE "--dn    E-edit  "
1050     .SBYTE "W-write "
1060     .SBYTE "U-undo  N-#base "
1070     .SBYTE "C-chars B-bfill "
1080     .SBYTE "J-eor   "
1090     .SBYTE "T-trace F-file# "
1100     .SBYTE "L-link# V-dens  "
1110     .SBYTE "M-menu  "
1120     .SBYTE "S-serch H-H	D   "
1130     .SBYTE ".-D	H   I-input "
1140     .SBYTE "O-sorce "
1150     .SBYTE "D-destn $)-rfrsh "
1160     .SBYTE EOL,"-abort <-hue . "
1170     .SBYTE ">-lum . "
1180 ;
1190 PRLINE .SBYTE "  Press CONTROL-"
1200     .SBYTE "P to print this "
1210     .SBYTE "screen   "
1220 ;
1230 ;The Beginning of the
1240 ;Disk Editor
1250 ;
1260 DISKED JSR CLRSCN ;clear screen
1270     JSR ERAINP  ;clear input
1280     LDA # <GR0DL ;set up DL
1290     STA SDLSTL
1300     LDA # >GR0DL
1310     STA SDLSTL+1
1320     LDA # <[INPLIN+6]
1330     STA INPLOC
1340     LDA # >[INPLIN+6]
1350     STA INPLOC+1
1360     LDX #0      ;initialize
1370     STX SRFLG
1380     STX SECH
1390     STX AIFLAG  ;ASC/INT flag
1400     STX HDF     ;hex/dec flag
1410     STX HXORST  ;input flag
1420     STX DENSITY ;0=sngl 1 =dbl
1430     INX 
1440     STX SECL
1450     STX SRCDRV
1460     STX DESDRV
1470     STX IMODE
1480     JSR DOLEFT  ;show border
1490     LDA #0      ;show empty
1500     JSR BFC
1510     JSR MASIN
1520 JG  JSR C_OFF
1530     JSR GETCOM  ;get comand
1540     JSR ERAINP  ;zap input
1550     JMP JG      ;more
1560 ;
1570 ;Get a Command
1580 ;
1590 GETCOM LDA CH   ;force uppercase
1600     CMP #$FF
1610     BEQ GETCOM  ;get key
1620     LDX #$FF
1630     STX CH
1640     PHA         ;save it
1650     LDA # <CONT ;reset DLIST
1660     STA OLDD
1670     LDA # >CONT
1680     STA OLDD+1
1690     PLA         ;get key
1700     LDX #26     ;check it
1710 CC1 CMP COMKEY,X
1720     BEQ CC2     ;valid
1730     DEX 
1740     BPL CC1
1750     BMI GETCOM  ;overs
1760 CC2 TXA         ;x 2 for offset
1770     ASL A
1780     TAX 
1790     ASL A
1800     TAY 
1810     CPY #40
1820     BCC N40
1830     LDY #40
1840 N40 JSR SHO_COM
1850     LDA COMTAB,X ;get address
1860     STA JOFF+1  ;of routine
1870     LDA COMTAB+1,X
1880     STA JOFF+2
1890     JSR ERATXT  ;window
1900 JOFF JSR $FFFF  ;carry out
1910 ;
1920 C_OFF LDY #40
1930 ;
1940 ;Show the Command
1950 ;
1960 SHO_COM TXA 
1970     PHA 
1980     LDX #0
1990 SHC LDA CTXT,Y
2000     STA INPLIN,X
2010     INY 
2020     INX 
2030     CPX #4
2040     BNE SHC
2050     LDA #$9A
2060     STA INPLIN+4
2070     PLA 
2080     TAX 
2090     RTS 
2100 ;
2110 ;Command Keys
2120 ;
2130 COMKEY .BYTE $2A,$39,$22,$15,$01
2140     .BYTE $38,$3E,$00,$28,$2E
2150     .BYTE $12,$23,$66,$0B,$08
2160     .BYTE $3A,$36,$76,$0E,$06
2170     .BYTE $0D,$2D,$10,$37,$25
2180     .BYTE $B6,$8A
2190 ;
2200 ;Get a Key
2210 ;
2220 GETKEY LDA $E425 ;the easy way
2230     PHA         ;to get keys
2240     LDA $E424   ;from the OS!
2250     PHA 
2260     RTS 
2270 ;
2280 ;Get Input until ESCape or
2290 ;RETURN is pressed
2300 ;
2310 INPUT STY MAXLEN ;save length
2320     LDY #0      ;counter
2330 INLOOP STY Y2   ;save it
2340     LDA #$80    ;cursor is a
2350     STA (INPLOC),Y ;block.
2360     JSR GETKEY  ;get a key
2370     LDY Y2      ;restore Y
2380     CMP #EOL    ;is it EOL?
2390     BEQ INDONE  ;yes!
2400     CMP #27     ;is it ESC?
2410     BNE NOESC   ;NO!
2420     SEC         ;signal abort
2430     RTS         ;so long.
2440 NOESC CMP #126  ;delete?
2450     BNE NODEL   ;nope.
2460     CPY #0      ;on 1st char?
2470     BEQ INLOOP  ;yes!
2480     LDA #0      ;remove cursor
2490     STA (INPLOC),Y
2500     DEY         ;decrease cntr
2510     BPL INLOOP  ;and loop
2520 ;
2530 NODEL LDX IMODE ;get mode?
2540     BEQ IS_OK   ;string mode.
2550     AND #$7F    ;mask inverse
2560     CMP #'9+1   ;>9?
2570     BCC ITS     ;no.
2580     AND #223    ;make uppercase.
2590 ITS JSR CHEX    ;is legal?
2600     CPX #0      ;test X.
2610     BPL IS_OK   ;legal!
2620     BMI INLOOP  ;no good.
2630 ;
2640 IS_OK CPY MAXLEN ;at max len?
2650     BEQ INLOOP  ;yes.
2660     STA IBUF,Y  ;no save char
2670     JSR ASC2IC  ;and put it
2680     STA (INPLOC),Y ;on screen
2690     INY         ;up cntr
2700     BNE INLOOP  ;and loop.
2710 ;
2720 INDONE STA IBUF,Y ;save EOL
2730     LDA #0      ;erase cursor
2740     STA (INPLOC),Y
2750     CLC         ;show good.
2760     RTS         ;boogie.
2770 ;
2780 ;Erase Input Line
2790 ;
2800 ERAINP LDA #0
2810     LDX #34
2820 ER1 STA INPLIN+5,X
2830     DEX 
2840     BPL ER1
2850     RTS 
2860 ;
2870 ;Get a String
2880 ;
2890 G_STR LDA #0
2900     STA IMODE
2910     LDY #33
2920     JMP INPUT
2930 ;
2940 ;Get a Hexstring
2950 ;
2960 G_HEX LDA #1    ;hex mode.
2970     STA IMODE
2980     LDY #32     ;32 chars max
2990     JSR INPUT   ;get input.
3000     BCC MEV     ;ok?
3010     RTS         ;no.
3020 MEV LDX #0      ;get length of
3030 G4E LDA IBUF,X  ;the input.
3040     CMP #EOL
3050     BEQ G4L
3060     INX 
3070     BNE G4E
3080 ;
3090 G4L TXA         ;is the input
3100     AND #1      ;even?
3110     BEQ G4R     ;yes!
3120 ;
3130     LDX #43     ;no. add a
3140 MDN LDA IBUF,X  ;leading zero
3150     STA IBUF+1,X ;to the input
3160     DEX         ;buffer.
3170     BPL MDN
3180     LDA #'0
3190     STA IBUF
3200 G4R LDX #0      ;input pntr
3210     LDY #0      ;output pntr
3220 GH2 LDA IBUF,X  ;get char
3230     CMP #EOL    ;all done?
3240     BEQ GHID    ;yes!
3250     STA HXH     ;save it
3260     INX         ;get next char
3270     LDA IBUF,X
3280     STA HXL     ;save it
3290     STX X3      ;save x
3300     STY Y3      ;save y
3310     JSR HEX2BIN ;make binary
3320     LDY Y3      ;get Y
3330     LDX X3      ;get X
3340     STA IBUF,Y  ;save binary
3350     INY         ;up Y
3360     INX         ;up X
3370     BNE GH2     ;and loop
3380 GHID CLC        ;signal good
3390     RTS         ;later.
3400 ;
3410 ;Get a Number
3420 ;
3430 G_NUM LDA #1    ;hex mode.
3440     STA IMODE
3450     LDY #4      ;4 chars
3460     JSR INPUT   ;grab it.
3470     BCC GNK     ;good?
3480     RTS         ;no.
3490 GNK JSR ZFR     ;zap FR0
3500     TAY         ;Y=0
3510 G4LOOP LDA IBUF,Y ;get a char
3520     CMP #EOL    ;done?
3530     BNE TESTIT  ;nope.
3540 G4G CLC         ;signal good
3550     RTS         ;spater.
3560 ;
3570 TESTIT JSR CHEX ;get value
3580     ASL FR0     ;*2
3590     ROL FR0+1
3600     ASL FR0     ;*4
3610     ROL FR0+1
3620     ASL FR0     ;*8
3630     ROL FR0+1
3640     ASL FR0     ;*16
3650     ROL FR0+1
3660     TXA         ;get value
3670     ORA FR0     ;add to FR0
3680     STA FR0     ;save it
3690     INY         ;up count
3700     BNE G4LOOP  ;and loop
3710 ;
3720 ;Clear out Screen Memory
3730 ;
3740 CLRSCN LDA #0
3750     LDY #0
3760 CLRS STA SM,Y
3770     STA SM+$0100,Y
3780     STA SM+$0200,Y
3790     STA SM+$0300,Y
3800     INY 
3810     BNE CLRS
3820     LDA LMARGN
3830     STA COLCRS
3840     TYA 
3850     STA ROWCRS
3860     RTS 
3870 ;
3880 ;Show the Screen Borders
3890 ;
3900 DOLEFT LDA GL   ;first line
3910     STA T       ;of memory
3920     LDA GH
3930     STA T+1
3940     LDX #0
3950 LFB LDY #0      ;left column
3960     LDA LEFTB,X
3970     STA (T),Y
3980     STY Y1
3990     LDY #28     ;repeat in
4000     STA (T),Y   ;middle
4010     LDY Y1
4020     INX         ;over 1
4030     INY 
4040     LDA LEFTB,X ;column 2
4050     STA (T),Y
4060     STY Y1
4070     LDY #29     ;and in middle
4080     STA (T),Y
4090     LDY Y1
4100     JSR ADD40   ;down 1 line
4110     INX 
4120     CPX #32     ;16 lines?
4130     BNE LFB
4140     RTS 
4150 ;
4160 ;Add 40 onto pointer to
4170 ;move down one line
4180 ;
4190 ADD40 LDA T
4200     CLC 
4210     ADC #$28
4220     STA T
4230     BCC A40
4240     INC T+1
4250 A40 RTS 
4260 ;
4270 ;Display the Sector Data
4280 ;
4290 SHWSEC LDA GL   ;start at top
4300     STA T
4310     LDA GH
4320     STA T+1
4330     LDA #2      ;y pos =2
4340     STA Y2
4350     LDA HDF     ;hex or dec?
4360     BEQ H9      ;HEX
4370     JMP SDEC
4380 H9  LDY #0
4390 H1  JSR ZFR
4400     STY Y1
4410     LDA MYBUF,Y ;get a byte
4420     STA FR0
4430     JSR BIN2HEX ;to hex
4440     INC Y1
4450     LDY Y2      ;screen pos Y
4460     INY 
4470     LDA LBUFF+2 ;hi byte of hex
4480     JSR ASC2IC
4490     STA (T),Y   ;show it
4500     LDA LBUFF+3 ;now low byte
4510     JSR ASC2IC
4520     INY 
4530     STA (T),Y
4540     INY 
4550     STY Y2
4560     CPY #26     ;end of line?
4570     BEQ H4      ;yes
4580 H5  LDY Y1      ;end of buffer?
4590     CPY #$80
4600     BNE H1      ;no
4610     RTS 
4620 H4  JSR ADD40   ;down 1 line
4630     LDA #2      ;reset LMargin
4640     STA Y2
4650     JMP H5
4660 ;
4670 ;Show Sector in Decimal Mode
4680 ;If 'tens' digit is inversed
4690 ;the number is over 200,if the
4700 ;'units' digit is inversed the
4710 ;number is between 100 and 200
4720 ;
4730 SDEC LDY #0
4740     INC Y2      ;3
4750 SD1 LDA #$FF    ;set inverse
4760     STA IV      ;flag
4770     LDA MYBUF,Y ;get byte
4780     INY 
4790     STY Y1      ;save buf pos
4800     CMP #200    ;over 200?
4810     BCC DD1
4820     SEC         ;- 200
4830     SBC #200
4840     INC IV      ;set flag
4850     INC IV      ;to 1
4860     BNE DD3
4870 DD1 CMP #100    ;over 100?
4880     BCC DD3
4890     SEC 
4900     SBC #100
4910     INC IV      ;set flag to 0
4920 DD3 LDX #'0     ;default '00'
4930     STX TENS
4940     STX UNITS
4950 DD5 CMP #$0A    ;over 10?
4960     BCS DD4     ;yes
4970     CLC 
4980     ADC UNITS   ;add units digit
4990     STA UNITS
5000     LDY IV      ;see if any are
5010     BMI DD2     ;inversed
5020     LDA UNITS,Y ;do inverse
5030     ORA #$80
5040     STA UNITS,Y
5050 DD2 LDY Y2      ;get screen pos
5060     LDA TENS    ;convert to
5070     JSR ASC2IC  ;screen code
5080     STA (T),Y
5090     INY 
5100     LDA UNITS   ;same for
5110     JSR ASC2IC  ;units digit
5120     STA (T),Y
5130     INY         ;move right
5140     INY 
5150     STY Y2
5160     CPY #27     ;done w/line?
5170     BEQ DD6
5180 DD7 LDY Y1      ;done with
5190     CPY #$80    ;sector?
5200     BNE SD1
5210     RTS 
5220 DD6 JSR ADD40   ;next line
5230     LDA #3
5240     STA Y2      ;reset LMargin
5250     BNE DD7
5260 DD4 SEC         ;get tens digit
5270     SBC #$0A
5280     INC TENS
5290     BNE DD5
5300     RTS 
5310 ;
5320 ;Show Data as ATASCII or
5330 ;Internal Code
5340 ;
5350 ASCINT JSR MASIN ;show type
5360     LDA GL      ;top line
5370     STA T
5380     LDA GH
5390     STA T+1
5400     LDX #0      ;data pos
5410 AIM LDY #30     ;screen Y
5420 AIL LDA MYBUF,X ;get byte
5430     STX X2
5440     LDX AIFLAG  ;ATASCII or
5450     BNE AIN     ;Internal
5460     JSR ASC2IC  ;convert
5470 AIN LDX X2
5480     STA (T),Y   ;show it
5490     INX 
5500     INY 
5510     CPY #$26    ;end of line?
5520     BNE AIL
5530     JSR ADD40   ;next line
5540     CPX #$80    ;end of buffer?
5550     BNE AIM
5560     RTS 
5570 ;
5580 ;Show it as ATASCII on screen
5590 ;
5600 ASC2IC JSR BITER
5610     ORA A2I,X
5620     LDX X1
5630     RTS 
5640 ;
5650 ;Show as Internal Code on screen
5660 ;
5670 IC2ASC JSR BITER
5680     ORA I2A,X
5690     LDX X1
5700     RTS 
5710 ;
5720 ;Do bit work
5730 ;
5740 BITER STX X1
5750     PHA 
5760     ROL A
5770     ROL A
5780     ROL A
5790     ROL A
5800     AND #3
5810     TAX 
5820     PLA 
5830     AND #$9F
5840     RTS 
5850 ;
5860 ;Do heading of 'ATASCII' or
5870 ;'INTERNAL' code
5880 ;
5890 MASIN LDX #7
5900     LDA AIFLAG  ;get flag
5910     BNE IN      ;no, internal
5920     LDX #15
5930 IN  LDY #7      ;copy header
5940 MA1 LDA INMS,X  ;on screen
5950     STA BORDER+30,Y
5960     DEX 
5970     DEY 
5980     BPL MA1
5990     RTS 
6000 ;
6010 ;Display the Sector Data
6020 ;
6030 SECINF LDA SECL ;sector #
6040     STA FR0
6050     LDA SECH
6060     STA FR0+1
6070     LDX #5      ;at position 5
6080     JSR PH1     ;put it on.
6090     LDA MYBUF+127 ;# of bytes
6100     STA FR0
6110     LDX #35     ;posit. 35
6120     JSR PH2     ;put it on.
6130     LDA MYBUF+125 ;file #
6140     LSR A       ;is in the
6150     LSR A       ;6 hi bits
6160     STA FR0
6170     LDX #15     ;posit. 15
6180     JSR PH2     ;display.
6190     LDA MYBUF+126 ;sector link
6200     STA FR0     ;low
6210     LDA MYBUF+125 ;sector link
6220     AND #3      ;high
6230     STA FR0+1
6240     LDX #25     ;posit 25
6250     LDA SRCDRV  ;get source
6260     ORA #$90    ;make inverse
6270     STA DRLIN+5 ;on screen
6280     LDA DESDRV  ;dest drive
6290     ORA #$90
6300     STA DRLIN+15 ;on screen
6310     LDA DENSITY ;disk density
6320     CLC 
6330     ADC #$91
6340     STA DRLIN+35 ;on screen
6350     LDY HXORST  ;input mode
6360     LDA INPMS,Y ;get letter
6370     STA DRLIN+25 ;on screen
6380 ;
6390 ;Put Hex # on Status Line
6400 ;enter with X = position
6410 ;
6420 PH1 LDY #1      ;start at dig#2
6430     BNE P_IN
6440 PH2 LDY #2      ;digit #3
6450 P_IN STY TMP1   ;save Y
6460     STX TMP2    ;save X
6470     JSR BIN2HEX ;make hex
6480     LDY TMP1    ;restore X&Y
6490     LDX TMP2
6500 P_LP LDA LBUFF,Y ;get char
6510     JSR ASC2IC  ;make ICODE
6520     ORA #$80    ;inverse it
6530     STA STATUS,X ;on screen
6540     INX 
6550     INY 
6560     CPY #4      ;at end?
6570     BNE P_LP    ;no.
6580     JMP ZFR     ;zap FR0
6590 ;
6600 ;Copy DSBUF to MYBUF
6610 ;
6620 TOMYBUF LDY #$7F
6630 TOM LDA DSBUF,Y
6640     STA MYBUF,Y
6650     DEY 
6660     BPL TOM
6670     RTS 
6680 ;
6690 ;Tables for ATASCII and
6700 ;Internal code conversions
6710 ;
6720 I2A .BYTE $20,$40,$00,$60
6730 A2I .BYTE $40,$00,$20,$60
6740 ;
6750 ;The Command Table
6760 ;
6770 COMTAB .WORD EDITS ;block edit
6780     .WORD HX2DEC ;hex>dec
6790     .WORD DECH  ;dec>hex
6800     .WORD BFILL ;block fill
6810     .WORD EORS  ;eor sector
6820     .WORD CHNFIL ;file #
6830     .WORD SEARCHS ;search
6840     .WORD SLINKS ;link #
6850     .WORD READS ;read sec
6860     .WORD WRITES ;write sec
6870     .WORD AIFLIP ;flip chars
6880     .WORD HDFLIP ;flip #'s
6890     .WORD HELPME ;help scrn
6900     .WORD UNDO  ;undo
6910     .WORD CHNSRC ;src drive
6920     .WORD CHNDES ;dest drive
6930     .WORD KOLOR ;next hue
6940     .WORD REFRESH ;clear scrn
6950     .WORD DOWN1 ;sec=sec-1
6960     .WORD UP1   ;sec=sec+1
6970     .WORD HEXSTR ;input flip
6980     .WORD TRACES ;trace link
6990     .WORD CHNDENS ;new density
7000     .WORD LUMIN ;luminance
7010     .WORD INTRO ;menu screen
7020     .WORD REFRESH ;clear scrn
7030     .WORD DMPSCN ;prnt scrn
7040 ;
7050 ;Routines
7060 ;
7070 ;Show Sector as ATASCII (0) or
7080 ;Internal Code (1)
7090 ;
7100 AIFLIP LDA AIFLAG
7110     EOR #1
7120     STA AIFLAG
7130     JMP ASCINT
7140 ;
7150 ;Show Sector as Hex (0) or
7160 ;Decimal (1) data
7170 ;
7180 HDFLIP LDA HDF
7190     EOR #1
7200     STA HDF
7210     JMP SHWSEC
7220 ;
7230 ;Edit the sector:Set INP to
7240 ;H(hex) or S(string) input
7250 ;
7260 EDITS JSR G_NUM ;get start byte
7270     BCC EE1
7280 EDN RTS 
7290 EE1 LDA FR0+1   ;is the #<$80?
7300     BNE EDN
7310     LDA FR0
7320     CMP #$80
7330     BCS EDN     ;no way.
7340     STA FBYTE   ;save it
7350     JSR ERAINP  ;clear INPLIN
7360     LDA #$A4    ;a 'D'
7370     STA INPLIN+3
7380     JSR G_HS    ;get data
7390     BCS EDN
7400     STY Y1      ;save length
7410     DEY 
7420 MIC LDA IBUF,Y  ;make the data
7430     LDX AIFLAG  ;ASC/ICODE
7440     BEQ MIO
7450     JSR ASC2IC
7460 MIO STA IBUF,Y
7470     DEY 
7480     BPL MIC
7490 EE2 LDY FBYTE   ;Y= pos
7500     LDX #0
7510 CPM LDA IBUF,X  ;get byte
7520 EE3 STA MYBUF,Y ;store it
7530     INX 
7540     INY 
7550     CPY #$80    ;end of sec?
7560     BEQ ERT     ;yes.
7570     CPX Y1      ;end of data?
7580     BNE CPM     ;no.
7590 ERT JMP SHOWALL ;show changes
7600 ;
7610 ;Decimal to Hex converter
7620 ;
7630 DECH LDA #1     ;hex mode
7640     STA IMODE
7650     LDY #5      ;5 chars max
7660     JSR INPUT
7670     BCC G_IB
7680     RTS 
7690 G_IB LDA # <IBUF ;point FP
7700     STA INBUFF  ;to buffer
7710     LDA # >IBUF
7720     STA INBUFF+1
7730     LDA #0
7740     STA CIX
7750     JSR AFP     ;ASCII to FP
7760     JSR FPI     ;FP to Integer
7770     BCC U5      ;CLC->good.
7780     JSR ZFR     ;'0000' on error
7790 U5  LDA FR0+1
7800     PHA         ;save the #
7810     LDA FR0
7820     PHA 
7830     LDX #1
7840     STX HXDC    ;force decimal
7850     DEX         ;posit 0
7860     JSR COPYNUM
7870     INX         ;insert =
7880     LDA #'=
7890     STA IBUF,X
7900     INX 
7910     PLA         ;get # back
7920     STA FR0
7930     PLA 
7940     STA FR0+1
7950     JSR COP_ALL ;copy hex
7960     JMP SHO_IT
7970 ;
7980 ;Hex to Decimal Converter
7990 ;
8000 HX2DEC JSR G_NUM ;get number
8010     BCS ANRTS
8020 ;
8030     LDX #1      ;force decimal
8040     STX HXDC
8050     DEX         ;insert hex
8060     JSR COP_ALL
8070     LDA #'=     ;insert "="
8080     STA IBUF+5
8090     LDX #6      ;posit #6
8100     JSR COPYNUM ;copy number
8110 SHO_IT LDA IBUF,X ;put the str
8120     JSR ASC2IC  ;on the
8130     STA LINE0,X ;screen.
8140     DEX 
8150     BPL SHO_IT
8160 ANRTS RTS 
8170 ;
8180 ;Copy all 4 Hex digits to IBUF
8190 ;
8200 COP_ALL STX TMP1
8210     JSR BIN2HEX
8220     LDX TMP1
8230     LDA #'$
8240     STA IBUF,X
8250     INX 
8260     JMP ALL
8270 ;
8280 ;Block Fill
8290 ;
8300 BFILL JSR G_NUM
8310     BCC BFB
8320     RTS 
8330 BFB LDA FR0
8340 BFC LDY #$7F    ;fill mybuf
8350 BFF STA MYBUF,Y ;with value
8360     DEY 
8370     BPL BFF
8380 BFD JMP SHOWALL ;Show it
8390 ;
8400 ;Convert Hex to Binary value
8410 ;returns with A = value
8420 ;
8430 HEX2BIN LDA HXL ;check if
8440     JSR CHEX
8450     STX HXL
8460     LDA HXH     ;same for hi
8470     JSR CHEX
8480     TXA         ;x16
8490     ASL A
8500     ASL A
8510     ASL A
8520     ASL A
8530     ORA HXL     ;add low
8540     RTS         ;=A
8550 ;
8560 ;See if digit is in the Hex
8570 ;table
8580 ;
8590 CHEX LDX #$0F   ;16 digits
8600 HH4 CMP HXTAB,X
8610     BEQ HH3
8620     DEX 
8630     BPL HH4
8640 HH3 RTS 
8650 ;
8660 ;Sets flag for Hex or
8670 ;String (Character) Input
8680 ;
8690 HEXSTR LDA HXORST
8700     EOR #1
8710     STA HXORST
8720     JMP SECINF
8730 ;
8740 ;EOR the data with a byte
8750 ;
8760 EORS JSR G_NUM
8770     BCC E_GO
8780     RTS 
8790 E_GO LDY #$7F   ;eor whole
8800 ERP LDA MYBUF,Y ;sector
8810     EOR FR0
8820     STA MYBUF,Y
8830     DEY 
8840     BPL ERP
8850     JMP SHOWALL ;show it
8860 ;
8870 ;Show Sector Data, Characters
8880 ;and Sector information
8890 ;
8900 SHOWALL JSR SHWSEC ;data
8910     JSR ASCINT  ;characters
8920     JMP SECINF  ;inofrmation
8930 ;
8940 ;Install the HELP screen
8950 ;
8960 HELPME LDA # <HELPDL ;change
8970     STA OLDD    ;display list
8980     LDA # >HELPDL ;part way
8990     STA OLDD+1  ;down
9000     PLA 
9010     PLA 
9020     JMP GETCOM
9030 ;
9040 ;Restore the Sector's Data
9050 ;
9060 UNDO JSR TOMYBUF
9070     JMP SHOWALL
9080 ;
9090 ;Erase text in Window
9100 ;
9110 ERATXT LDY #39
9120     LDA #0
9130 ET1 STA LINE0,Y
9140     DEY 
9150     BPL ET1
9160     RTS 
9170 ;
9180 ;Change Source Drive
9190 ;
9200 CHNSRC LDX SRCDRV
9210     JSR DRV_UP
9220     STX SRCDRV
9230     JMP SECINF
9240 ;
9250 ;Change Destination Drive
9260 ;
9270 CHNDES LDX DESDRV
9280     JSR DRV_UP
9290     STX DESDRV
9300     JMP SECINF
9310 ;
9320 ;Increment Drive Number
9330 ;
9340 DRV_UP INX 
9350     CPX #9
9360     BNE SHX
9370     LDX #1
9380 SHX RTS 
9390 ;
9400 ;Change the File Number
9410 ;
9420 CHNFIL JSR G_NUM
9430     BCC FF1
9440 FF3 RTS 
9450 FF1 LDA FR0+1
9460     BNE FF3
9470     LDA FR0
9480     CMP #64     ;0-63 allowed
9490     BCC FF4
9500     LDY #181
9510     JMP IOERR
9520 FF4 ASL A       ;high 6 bits
9530     ASL A       ;used for file
9540     STA FR0     ;number
9550     LDA MYBUF+125 ;get byte
9560     AND #3      ;mask out low
9570     ORA FR0     ;add in File #
9580     STA MYBUF+125
9590     JMP SHOWALL ;show it
9600 ;
9610 ;Get Hex or String
9620 ;
9630 G_HS LDA HXORST
9640     BNE G_ST
9650     JMP G_HEX
9660 ;
9670 G_ST JMP G_STR
9680 ;
9690 ;Search for Hex or String.
9700 ;String can be either
9710 ;ATASCII or Internal Code
9720 ;
9730 SEARCHS JSR G_HS ;get data
9740     BCC AO2
9750 AOR RTS 
9760 ;
9770 AO2 CPY #0      ;just EOL?
9780     BEQ IS_OLD? ;yup, check buf
9790     STY SRFLG   ;save length
9800     LDY #44     ;copy bufr over
9810 AOCP LDA IBUF,Y ;to the save
9820     STA SRBUF,Y ;buffer for
9830     DEY         ;next time
9840     BPL AOCP
9850     BMI AORI
9860 IS_OLD? LDA SRFLG ;old data?
9870     BEQ AOR     ;no way!
9880 ;
9890 AORI LDY #0     ;convert to
9900 ALI LDA SRBUF,Y ;internal
9910     LDX AIFLAG
9920     BEQ A_ST
9930     JSR ASC2IC
9940 A_ST STA IBUF,Y
9950     INY 
9960     CPY SRFLG
9970     BNE ALI
9980 ;
9990 SSTR LDA #$81   ;compute the
010000   SEC         ;last posit we
010010   SBC SRFLG   ;can look at.
010020   STA MAXLEN  ;save it.
010030   LDY #0      ;sec pntr
010040 SEL LDX #0    ;bufr pntr
010050   STY Y1      ;save it
010060 TRYF LDA IBUF,X ;get buffer
010070   CMP MYBUF,Y ;in sector?
010080   BNE GS_UP   ;no increment.
010090   INY         ;get next char
010100   INX 
010110   CPX SRFLG   ;at end?
010120   BNE TRYF    ;no yet...
010130   LDA Y1      ;first byte
010140   STA FBYTE   ;save
010150   JSR SHO_POS ;sho match!
010160 ;
010170 GS_UP LDY Y1  ;get posit
010180   INY         ;increment
010190   CPY MAXLEN  ;at end?
010200   BNE SEL     ;no loop.
010210   RTS         ;so long
010220 ;
010230 ;find place on screen to
010240 ;mark the match
010250 ;
010260 SHO_POS LDA FBYTE ;byte #
010270   LSR A       ;div by 8
010280   LSR A       ;to get row
010290   LSR A
010300   TAY 
010310   LDA GL,Y    ;get memory
010320   STA T       ;position
010330   LDA GH,Y
010340   STA T+1
010350   TYA 
010360   ASL A
010370   ASL A
010380   ASL A       ;x8
010390   STA TMP3
010400   LDA FBYTE   ;get remainder
010410   SEC 
010420   SBC TMP3    ;go right by
010430   STA TMP3    ;threes!
010440   ASL A       ;x2
010450   CLC 
010460   ADC TMP3    ;x3
010470   CLC 
010480   ADC #2      ;for margin
010490   TAY 
010500   LDA #127    ;wedge
010510   STA (T),Y   ;show it
010520   RTS 
010530 ;
010540 ;Refresh the screen to
010550 ;erase the arrows
010560 ;
010570 REFRESH JSR CLRSCN
010580   JSR DOLEFT
010590   JMP SHOWALL
010600 ;
010610 ;Change Screen Color
010620 ;
010630 KOLOR LDA COLOR2
010640   CLC 
010650   ADC #$10
010660   STA COLOR2
010670   RTS 
010680 ;
010690 ;Change Luminance
010700 ;
010710 LUMIN LDA COLOR2
010720   TAX 
010730   AND #$F0
010740   STA CTMP
010750   TXA 
010760   CLC 
010770   ADC #2
010780   AND #$0F
010790   ORA CTMP
010800   STA COLOR2
010810   RTS 
010820 ;
010830 ;Change Sector Link
010840 ;
010850 SLINKS JSR G_NUM
010860   BCC SL_G
010870   RTS 
010880 SL_G LDA FR0  ;chk for 0
010890   ORA FR0+1
010900   BEQ LN_ER
010910   LDA FR0+1
010920   LDX DENSITY ;make sure the
010930   CMP SDHI,X  ;new link is
010940   BCC G_LNK   ;allowed in
010950   BEQ G_TLO   ;this density.
010960   BCS LN_ER
010970 G_TLO LDA FR0
010980   CMP SDLO,X
010990   BCC G_LNK
011000   BEQ G_LNK
011010   BCS LN_ER
011020 G_LNK LDA FR0 ;store it
011030   STA MYBUF+126
011040   LDA FR0+1
011050   AND #3
011060   STA FR0
011070   LDA MYBUF+125 ;mask off
011080   AND #$FC    ;file #
011090   ORA FR0+1   ;add in link
011100   STA MYBUF+125
011110   JMP SHOWALL ;show it
011120 ;
011130 LN_ER LDY #180
011140   JMP IOERR
011150 ;
011160 ;Read a Sector
011170 ;
011180 READS JSR G_NUM ;get sector
011190   BCC G_RD
011200   RTS 
011210 G_RD LDA FR0  ;just EOL?
011220   ORA FR0+1
011230   BEQ DORED   ;yes, reread
011240   LDA FR0     ;copy the new
011250   STA SECL    ;# to area
011260   LDA FR0+1
011270   STA SECH
011280 ;
011290 DORED JSR READIT ;do the read
011300   BPL G.Q
011310   JSR IOERR
011320 G.Q JSR TOMYBUF ;move to mybuf
011330   JMP SHOWALL ;show it
011340 ;
011350 ;Set up Reading
011360 ;
011370 READIT LDA SRCDRV ;source drv
011380   STA DUNIT
011390   LDA # >DSBUF ;read into
011400   STA DBUFHI  ;dsbuf
011410   LDA # <DSBUF
011420   STA DBUFLO
011430   LDA #$52
011440   BNE REDWRT
011450 ;
011460 ;Set up Write
011470 ;
011480 WRITIT LDA DESDRV ;dest. drv
011490   STA DUNIT
011500   LDA # >MYBUF ;write out
011510   STA DBUFHI  ;mybuf
011520   LDA # <MYBUF
011530   STA DBUFLO
011540   LDA #$57
011550 ;
011560 ;general read,write
011570 ;
011580 REDWRT STA DCOMND ;save cmd
011590   LDA SECL    ;sector 0?
011600   ORA SECH
011610   BNE C_D     ;no.
011620   INC SECL    ;now sector 1.
011630 C_D LDX DENSITY ;test to be
011640   LDA SECH    ;sure that the
011650   CMP SDHI,X  ;sector is on
011660   BCC S_OK    ;the disk.
011670   BEQ T_LO
011680   BCS T_NO
011690 T_LO LDA SECL ;test lo.
011700   CMP SDLO,X
011710   BCC S_OK
011720 T_NO LDA SDLO,X ;move max #
011730   STA SECL    ;into sec #
011740   LDA SDHI,X
011750   STA SECH
011760 S_OK LDA SECL ;save the
011770   STA DAUX1   ;sector in SIO
011780   LDA SECH    ;work area
011790   STA DAUX2
011800   LDA #$80    ;128 bytes
011810   STA DBYTLO
011820   LDA #0
011830   STA DBYTHI
011840   JMP DSKINV  ;do SIO
011850 ;
011860 ;Format an I/O Error #
011870 ;
011880 F_ERR JSR ZFR ;zap FR0
011890   STY FR0     ;save err #
011900   LDX #1      ;force decimal
011910   STX HXDC
011920   LDX #7      ;copy error msg
011930 DS.1 LDA ERMS,X ;to buffer
011940   STA IBUF,X
011950   DEX 
011960   BPL DS.1
011970   LDX #8      ;copy number in
011980   JSR COPYNUM
011990   LDA #0
012000   STA IBUF+1,X
012010   RTS 
012020 ;
012030 ;Disk editor Error Routine
012040 ;
012050 IOERR JSR F_ERR
012060   JMP SHO_IT  ;show error.
012070 ;
012080 ;Read Down One Sector
012090 ;
012100 DOWN1 LDA SECH
012110   BNE DA2     ;ok
012120   LDA SECL
012130   CMP #2      ;if LT 2 no
012140   BCS DA2     ;decrease
012150   RTS 
012160 DA2 DEC SECL  ;go down 1
012170   LDA SECL
012180   CMP #$FF
012190   BNE DA1
012200   DEC SECH
012210 DA1 JMP DORED ;read it
012220 ;
012230 ;Read Up One Sector
012240 ;
012250 UP1 INC SECL
012260   BNE UPA
012270   INC SECH
012280 UPA JMP DORED
012290 ;
012300 ;Trace a file
012310 ;
012320 TRACES LDA SECL ;save cur
012330   STA SSECL   ;number just
012340   LDA SECH    ;in case
012350   STA SSECH
012360   LDA MYBUF+125 ;get link
012370   AND #3      ;hi
012380   STA SECH
012390   LDA MYBUF+126 ;and low
012400   STA SECL
012410   ORA SECH
012420   BNE D_R     ;if 0 end of
012430   LDY #182
012440   JMP IOERR
012450 D_R JMP DORED ;trace
012460 ;
012470 EOFT LDA SSECL ;reset current
012480   STA SECL    ;sector number
012490   LDA SSECH
012500   STA SECH
012510   RTS 
012520 ;
012530 ;Write a Sector
012540 ;
012550 WRITES JSR G_NUM ;sector to
012560   BCC WR1     ;write.
012570   RTS 
012580 WR1 LDA SECL  ;save old #
012590   STA SSECL   ;for later.
012600   LDA SECH
012610   STA SSECH
012620   LDA FR0     ;sector 0?
012630   ORA FR0+1
012640   BEQ WR2     ;yes.
012650   LDA FR0     ;copy new sec#
012660   STA SECL    ;into pntr
012670   LDA FR0+1
012680   STA SECH
012690 WR2 LDA SECL  ;use old sector
012700   STA FR0     ;number.
012710   LDA SECH
012720   STA FR0+1
012730   JSR BIN2HEX ;make hex
012740   LDY #3      ;copy to the
012750 WR3 LDA LBUFF,Y ;message.
012760   STA SUREMS+11,Y
012770   DEY 
012780   BPL WR3
012790   LDA DESDRV  ;put in the
012800   ORA #$30    ;destn drive
012810   STA SUREMS+20
012820   LDY #0
012830 WR4 LDA SUREMS,Y
012840   BEQ GYN
012850   JSR ASC2IC
012860   STA (INPLOC),Y
012870   INY 
012880   BNE WR4
012890 GYN JSR GETKEY
012900   CMP #27
012910   BEQ WRU
012920   AND #$7F
012930   CMP #'Y
012940   BEQ WR5
012950   CMP #'N
012960   BNE GYN
012970   BEQ WRU
012980 ;
012990 WR5 JSR WRITIT
013000   BPL WRU
013010   JSR IOERR
013020 WRU JMP EOFT  ;restore
013030 ;
013040 ;Change Density
013050 ;
013060 CHNDENS LDA DENSITY
013070   EOR #1
013080   STA DENSITY
013090   JMP SECINF
013100 ;
013110 BORDER .SBYTE "   +0 +1 +2 +3"
013120   .SBYTE " +4 +5 +6 +7    A"
013130   .SBYTE "TASCII    "
013140 ;
013150 INMS .SBYTE "INTERNAL"
013160 ATMS .SBYTE "ATASCII "
013170 INPMS .SBYTE "HS"
013180 SDLO .BYTE $D0,$10
013190 SDHI .BYTE $02,$04
013200 ERMS .BYTE "Error # "
013210 ;
013220 ;Left Border
013230 ;
013240 LEFTB .SBYTE " 0 810182028303"
013250   .SBYTE "84048505860687078"
013260 ;
013270 ;Various Messages & Prompts
013280 ;
013290 SUREMS .BYTE "Write SEC: 0000"
013300   .BYTE " to D : Y/N?",0
013310 HXTAB .BYTE "0123456789ABCDEF"
013320 CTXT .SBYTE "Edt# H	D D	H"
013330   .SBYTE "Bfil EorFil#"
013340   .SBYTE "SrchLinkRead"
013350   .SBYTE "Writ    "