Listing of file='@FORMAT' on disk='vmedia/mvp-boot-2.7.0.wvd.zip'
# Sector 723, program filename = '@FORMAT'
0010 % --------------------------------------
0020 % (c) Copr. Wang Laboratories, Inc. 1986
0030 % --------------------------------------
0040 % Program Name = @FORMAT
0050 % Author = Steve McGarry
0060 % Date Written = 22 April 1986
0070 % Last Revised = 25 June 1986
0080 % --------------------------------------
0090 %
0100 REM %VARIABLE DEFINITIONS
0110 DIM V$8
: V$="01.02.00"
: REM - VERSION NUMBER
0120 DIM D$3, K, P$1
: REM - DEVICE/PLATTER ADDRESS VARIABLES
0130 DIM E$(40)1, G$(15)1
: REM - STATUS/$GIO VARIABLES
0140 DIM D$(96)3,D1(96),D(96)
: REM - VARIABLES RETURNED BY '210
0150 DIM D1$(10)30
: REM - DISK DESCRIPTION STRINGS
0160 DIM K$1
: REM - KEYIN BYTE
0170 DIM M$40
: REM - MESSAGE ('201)
0180 DIM M
: REM - ERROR HANDLER WORK VARIABLE
0190 DIM I0$(1)80,I0$1,I1$80,I0,I1,I2,I3
: REM - VARIABLES FOR ACCEPTING A FIELD
0200 DIM I,J,J0
: REM - LOOP INDEXES
0210 DIM N
: REM - GENERAL WORK VARIABLE
0220 DIM M2,C,R
: REM - DISK MENU VARIABLES ('210)
0230 DIM D,D1
: REM - DISK SIZE, DESCRIPTION NUMBER ('222)
0240 DIM D0$3
: REM - "OTHER" DISK ADDRESS
0250 DIM S$(128)2
: REM - INDEX SECTOR BUFFER
0260 DIM V$(3)5
: REM - INDEX SECTOR DATA CONVERSION VARIABLES
0270 DIM V1,V3
: REM - INDEX INFORMATION VALUES
0300 REM %INITIALIZE EVERYTHING
0310 RESTORE LINE320
: MAT READ D1$
: REM - LOAD THE DISK DESCRIPTION STRINGS
0320 DATA "2275 5 1/4-inch Floppy"
0330 DATA "2275 10M Winchester"
0340 DATA "2275 16M Winchester"
0350 DATA "2280 Pheonix Cartridge"
0360 DATA "2280 Pheonix Fixed"
0370 DATA "LVP/SVP 8-inch Floppy"
0380 DATA "LVP/SVP Winchester"
0390 DATA "2275 F/R Floppy"
0400 DATA "2275 F/R 10M Winchester"
0410 DATA "2275 F/R 16M Winchester"
0500 REM %DISK ADDRESS SELECTION MENU
0510 SELECT PRINT /005(80)
: PRINT HEX(020D0C030F)
: REM - INITIALIZE DISPLAY
0520 $CLOSE#1
: PRINT HEX(0306);TAB(15);"SOFTWARE FORMATTABLE DISK PLATTER FORMAT UTILITY
"
: PRINT TAB(20);"(c) Copr. Wang Laboratories, Inc. 1986"
: PRINT TAB(31);"Release ";V$
: REM - "UNHOG" THE DISK (IF NEEDED) & DISPLAY THE TITLE, COPYRIGHT & VERSI
ON NUMBER
0530 PRINT AT(4,0);HEX(0E);"Select a disk to format and press RUN/EXEC:"
: REM - PROMPT
0540 PRINT AT(21,50);HEX(0E);"SF'15/GOTO - Other Address";AT(22,50);"RUN/EXEC
- Proceed";AT(23,50);"CANCEL/EDIT - Previous Menu";HEX(01)
: REM - KEY DEFINITIONS
0550 GOSUB '201("(Searching for Disks)")
: REM - TELL HIM WHAT WE'RE DOING (IF HE DOESN'T BLINK)
0560 GOSUB '220
: REM - GET THE DISK INFORMATION
0565 GOSUB '201(" ")
: REM - REMOVE THE MESSAGE
0570 GOSUB '210
: REM - LET THE USER SELECT A DISK ADDRESS
0580 ON M2+2GOTO 1010,2000
: REM - BRANCH FOR SF'15 AND CANCEL/EDIT
0590 IF N=0THEN 520
: REM - IF HE PRESSED RUN/EXEC & THERE AREN'T ANY ADDRESSES, SEARCH AGAIN
0600 REM %DISPLAY PLATTER INFORMATION
0610 $CLOSE#1
: PRINT HEX(0306);TAB(15);"SOFTWARE FORMATTABLE DISK PLATTER FORMAT UTILITY
"
: PRINT TAB(30);"Platter Information"
: REM - "UNHOG" DISK (IF HERE BECAUSE OF ERROR) & DISPLAY THE INFORMATION S
CREEN TITLE
0620 PRINT AT(4,0);HEX(0E);"Mount disk to be formatted and press RUN/EXEC:"
: REM - PROMPT
0625 GOSUB '201(M$)
: REM - DISPLAY MESSAGE (IF ANY)
0630 PRINT AT(22,50);HEX(0E);"RUN/EXEC - Proceed";AT(23,50);"CANCEL/EDIT -
Previous Screen";HEX(01)
: REM - KEY DEFINITIONS
0635 IF M2=-1THEN PRINT AT(7,29);"Platter Address = ";D0$
: REM - DISPLAY "OTHER" DISK INFORMATION
0640 IF M2>0 THEN PRINT AT(7,25);"Platter Address = ";D$(M2);AT(8,25);"Highe
st Sector =";D(M2)-1;AT(9,25);"Model Number = ";STR(D1$(D1(M2)),,
8);AT(10,25);"Description = ";STR(D1$(D1(M2)),10)
: REM - DISPLAY NORMAL DISK INFORMATION
0650 KEYIN K$,,660
: IF K$=HEX(82)THEN 710
: GOTO 650
: REM - GET A KEY. JUMP IF RUN/EXEC
0660 IF K$=HEX(F0)THEN 520
: GOTO 650
: REM - GO TO PREVIOUS SCREEN IF CANCEL
0700 REM %GET & DISPLAY INDEX INFORMATION (IF INDEX SECTORS > 0)
0710 IF M2=-1THEN SELECT #1<D0$>
: ERRORGOSUB '255
: GOTO 610
: REM - SELECT "OTHER" DISK
0720 IF M2>0 THEN SELECT #1<D$(M2)>
: REM - SELECT NORMAL DISK (MUST BE VALID BY NOW)
0725 V$(1)="24"
: V$(2)=" "
: V$(3)="0"
: IF M2>0THEN CONVERT D(M2)-1TO V$(3),(#####)
: IF M2>0THEN V$(3)=STR(V$(3),POS(V$(3)<>"0"))
: REM - INITIALIZE THE INDEX INFORMATION FIELDS
0730 $OPEN 732,#1
: ERRORGOSUB '255
: GOTO 610
: REM - "HOG" THE DISK
0731 GOTO 740
: REM - SKIP THE "CAN'T $OPEN" MESSAGE
0732 M$="Drive Reserved by Another Partition"
: PRINT HEX(07)
: GOTO 610
: REM - DISPLAY MESSAGE IF CAN'T $OPEN DRIVE
0740 $GIO GET DISK TYPE #1 (0200 030F 1222 0600 0700 70A0 4000 870B,G$())
: REM - GET THE DRIVE TYPE (DPU TYPE)
0750 IF STR(G$(),6,3)=HEX(000000)THEN 760
: M$="Drive Not Responding"
: PRINT HEX(07)
: GOTO 610
0760 DATA LOAD BA T#1,(0)S$()
: ERRORGOSUB '255
: IF M<>93THEN 610
: M$=" "
: GOTO 800
: REM - GET FIRST INDEX SECTOR. FORMAT DISK IF FORMAT ERROR. REPORT ALL O
THER ERRORS
0765 IF STR(S$(),2,1)=HEX(00)THEN 800
: REM - IF INDEX SECTORS = 00000, FORMAT IT
0770 FOR I=1TO 3
: IF I=1THEN CONVERT VAL(STR(S$(I),2,1))TO V$(I),(#####)
: ELSE CONVERT VAL(S$(I),2)-1TO V$(I),(#####)
: IF V$(I)="00000"THEN V$(I)="0"
: ELSE V$(I)=STR(V$(I),POS(V$(I)<>"0"))
: NEXT I
: REM - CHANGE THE 2-BYTE VALUES TO STRINGS
0775 PRINT AT(13,27);"\C3\F5\F2\F2\E5\EE\F4\A0\C9\EE\E4\E5\F8\A0\C9\EE\E6\EF\F
2\ED\E1\F4\E9\EF\EE";AT(15,29);"Index Sectors = ";V$(1);AT(16,29);"End Ca
t. Area = ";V$(3);AT(17,29);"Current End = ";V$(2)
: REM - SHOW HIM THE CURRENT INDEX
0780 PRINT HEX(07)
: GOSUB '201("Are you sure (Y/N)?")
: M$=" "
: GOSUB '204
: IF K$="N"THEN 610
: REM - GIVE HIM THE FINAL WARNING
0795 REM %TRASH THE SUCKER!
0800 GOSUB '201("(Formatting)")
: REM - TELL HIM THE NASTY THINGS WE'RE DOING
0810 $FORMATDISK T#1
: ERRORGOSUB '255
: GOTO 610
: REM - FINALLY! FORMAT THE DISK
0820 GOSUB '201("Format Completed")
: REM - WE MADE IT!
0825 REM %GET NEW INDEX PARAMETERS & SCRATCH THE DISK
0830 PRINT AT(4,0,80);HEX(0E);"Enter new index information and press RUN/EXEC:
"
: REM - CHANGE THE PROMPT
0835 IF STR(S$(),,1)=HEX(01)THEN V$(2)="NEW"
: ELSE V$(2)="OLD"
: REM - INITIALIZE THE STRUCTURE FIELD
0840 PRINT AT(13,0,400);HEX(020402040F);AT(13,29);"\CE\E5\F7\A0\C9\EE\E4\E5\F8
\A0\C9\EE\E6\EF\F2\ED\E1\F4\E9\EF\EE";AT(15,29);"Index Sectors = ";HEX(0E
);STR(V$(1));HEX(0F);AT(16,29);"End Cat. Area = ";HEX(0E);STR(V$(3));HEX(
0F);AT(17,29);"Structure = ";HEX(0E);STR(V$(2),,3);HEX(020402000F);"
(OLD or NEW)"
: REM - DISPLAY THE FIELDS
0845 PRINT HEX(0E);AT(20,50);"RETURN - Next Field";AT(21,50);"FN/TAB
- Previous Field"
: REM - ADDITIONAL KEY DEFINITIONS
0850 K0=1
: REM - RESET FIELD COUNTER
0855 ON K0GOSUB 875,880,885
: REM - PROCESS THE CURRENT FIELD
0858 GOSUB '201(" ")
: REM - ERASE THE MESSAGE (IF ANY)
0860 ON POS(HEX(F0827E)=K$)GOTO 520,900,870
: REM - CANCEL, RUN, TAB
0865 K0=K0+1
: IF K0>3THEN K0=1
: GOTO 855
: REM - RETURN PRESSED, ADVANCE TO NEXT FIELD
0870 K0=K0-1
: IF K0<1THEN K0=3
: GOTO 855
: REM - TAB PRESSED, BACK UP TO PREVIOUS FIELD
0875 GOSUB '202(15,45,V$(1),5,"#",HEX(F07E))
: V$(1)=I0$(1)
: RETURN
: REM - ACCEPT INDEX SECTORS
0880 GOSUB '202(16,45,V$(3),5,"#",HEX(F07E))
: V$(3)=I0$(1)
: RETURN
: REM - ACCEPT END OF CATALOGED AREA
0885 GOSUB '202(17,45,V$(2),3,"A",HEX(F07E))
: V$(2)=I0$(1)
: $TRAN(V$(2),"AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz")R
: IF V$(2)="OLD"OR V$(2)="NEW"THEN RETURN
: GOSUB '201("Index Structure Must be 'OLD' or 'NEW'")
: PRINT HEX(07)
: GOTO 885
: REM - ACCEPT INDEX STRUCTURE
0900 GOSUB '201("(Creating Disk Index)")
: REM - TELL HIM WHAT WE'RE UP TO
0910 CONVERT V$(1)TO V1
: ERRORPRINT HEX(07)
: GOSUB '201("Index Sectors may not be blank")
: GOTO 850
: REM - CHANGE INDEX SECTORS INTO A NUMERIC VALUE
0912 IF V1>=1AND V1<=255THEN 915
: PRINT HEX(07)
: GOSUB '201("Index Sectors must be from 1 to 255")
: GOTO 850
: REM - VALIDATE INDEX SECTORS VALUE
0915 CONVERT V$(3)TO V3
: ERRORPRINT HEX(07)
: GOSUB '201("End Cat. Area may not be blank")
: GOTO 850
: REM - CHANGE END OF CATALOGED AREA INTO A NUMERIC VALUE
0917 IF V1<=V3THEN 920
: PRINT HEX(07)
: GOSUB '201("End Cat. Area less than Index Sectors")
: GOTO 850
0920 IF V$(2)="OLD"THEN SCRATCH DISK T#1,LS=V1,END =V3
: ERRORGOSUB '255
: GOSUB '201(M$)
: GOTO 850
: REM - BUILD THE OLD INDEX STRUCTURE & HANDLE ERROR
0930 IF V$(2)="NEW"THEN SCRATCH DISK 'T#1,LS=V1,END =V3
: ERRORGOSUB '255
: GOSUB '201(M$)
: GOTO 850
: REM - BUILD THE NEW INDEX STRUCTURE & HANDLE ERROR
0940 GOSUB '201("Index Created - Press Any Key to Exit")
: PRINT HEX(07)
: KEYIN K$
: REM - LET HIM KNOW WE'RE FINISHED
0999 $CLOSE#1
: GOTO 520
: REM - FORMAT/SCRATCH COMPLETED. "UNHOG" THE DISK & GO TO THE DISK ADDRES
S MENU
1000 REM %GET "OTHER" DISK ADDRESS
1010 PRINT AT(21,0);HEX(020402040F);"Enter platter address: ";HEX(0E);D0$;HEX(
020402000F)
: REM - DISPLAY THE FIELD
1020 GOSUB '202(21,23,D0$,3,"H",HEX(F0))
: D0$=I0$(1)
: REM - ACCEPT PLATTER ADDRESS
1021 IF K$=HEX(F0)THEN 520
: REM - BRANCH IF CANCEL/EDIT PRESSED
1025 IF VER(D0$,"HHH")=3THEN 1030
: REM - IF ADDRESS IS PSEUDO-OK (ALL HEX), SKIP ERROR MESSAGE
1026 GOSUB '201("Platter address must be 3 hex digits")
: PRINT HEX(07)
: GOTO 1020
: REM - YELL AT HIM & LET HIM TRY AGAIN
1030 ON POS(HEX(0D82)=K$)GOTO 1020,610
: GOTO 1020
: REM - BRANCH ON RETURN OR RUN/EXEC
2000 COM CLEAR
: GOSUB '201("(Returning to System Menu)")
: $PSTAT=" "
: LOAD DC T"@MENU"
: END
: REM - THAT'S ALL SHE WROTE
5000 DEFFN'210
: REM %PROCESS MENU OF DISK ADDRESSES IN D$() (RETURNS M2=0 IF CANCEL, -1 I
F SF'15)
5010 N=(POS(D$()=" ")-1)/3
: IF N<0THEN N=96
: REM - DETERMINE NUMBER OF ADDRESSES IN D$() (COMPENSATE FOR D$() FULL)
5015 IF N=0THEN 5100
: REM - DON'T PRINT ANYTHING IF NO ADDRESSES TO DISPLAY
5020 C=INT((N-1)/12)+1
: REM - C=NUMBER OF COLUMNS NEEDED TO DISPLAY N ADDRESSES
5030 R=INT((N-1)/C)+1
: REM - R=NUMBER OF ROWS NEEDED TO DISPLAY N ADDRESSES
5040 REM *** THE FOLLOWING FUNCTIONS ASSUME C=# OF COLUMNS & R=# OF ROWS ***
5050 DEFFNC(N)=INT((N-1)/R+1)
: REM - RETURNS COLUMN NUMBER FOR ENTRY N
5060 DEFFNR(N)=N-(FNC(N)-1)*R
: REM - RETURNS ROW NUMBER FOR ENTRY N
5070 DEFFNX(N)=42-C*5+(FNC(N)-1)*10
: REM - RETURNS HORIZONTAL CRT POSITION FOR ENTRY N
5080 DEFFNY(N)=FNR(N)+6
: REM - RETURNS VERTICAL CRT POSITION FOR ENTRY N
5090 FOR K=1 TO N
: PRINT AT(FNY(K),FNX(K));HEX(85);" ";D$(K)
: NEXT K
: REM - DISPLAY THE ADDRESSES
5100 M2=1
: REM - SET INITIAL POSITION
5110 IF N>0THEN PRINT AT(FNY(M2),FNX(M2));HEX(0E8B);" ";D$(M2)
: REM - DISPLAY THE CURRENT POSITION (WITH PSEUDO-BLANK) AS BRIGHT
5115 IF N=0THEN PRINT AT(12,30);"(No Disks Available!)"
: REM - TELL HIM THE BAD NEWS
5120 KEYIN K$,,5180
: REM - GET A KEY (BRANCH IF SF KEY)
5130 IF N>0THEN PRINT AT(FNY(M2),FNX(M2));HEX(85);" ";D$(M2)
: REM - DISPLAY THE CURRENT POSITION (WITHOUT PSEUDO-BLANK) AS DIM
5140 ON POS(HEX(200882)=K$)GOTO 5150,5160,5170
: GOTO 5110
: REM - HANDLE SPACE, BACK SPACE AND RUN KEYS
5150 M2=M2+1
: IF M2>NTHEN M2=1
: GOTO 5110
: REM - SPACE BAR PRESSED
5160 M2=M2-1
: IF M2<1THEN M2=N
: GOTO 5110
: REM - BACK SPACE PRESSED
5170 IF N>0THEN PRINT AT(FNY(M2),FNX(M2));HEX(8B)
: GOTO 5200
: REM - RUN/EXEC PRESSED (DISPLAY DIM PSEUDO-BLANK)
5180 IF N>0THEN PRINT AT(FNY(M2),FNX(M2));HEX(85);" ";D$(M2)
: REM - DISPLAY THE CURRENT POSITION (WITHOUT PSEUDO-BLANK) AS DIM
5190 IF K$=HEX(F0)THEN M2=0
: REM - IF CANCEL, UPDATE M2
5195 IF K$=HEX(0F)OR K$=HEX(1F)THEN M2=-1
: REM - IF SF'15/SF'31, UPDATE M2
5196 IF M2>0THEN 5110
: REM - IF M2 UNCHANGED, GET ANOTHER KEY
5200 RETURN
6000 DEFFN'220
: REM %RETURNS D$()=ADDRESSES OF D0-TYPE DRIVES, D1()=DESCRIPTION POINTERS
& D()=# OF SECTORS ON EACH PLATTER
6005 D$()=" "
: MAT D1=ZER
: MAT D=ZER
: REM - INITIALIZE RETURN ARRAYS
6010 FOR J=1TO 7
: IF J=4THEN 6370
: REM - LOOP GENERATES ADDRESSES D10, D20, D30, D50, D60 AND D70 (SKIP D40)
6020 D$="D"&BIN(J+48)&"0"
: REM - CONVERT J TO AN ADDRESS
6030 GOSUB '221(D$,0)
: REM - GET STATUS OF FIRST FIXED PLATTER ON DISK D$
6040 IF G$(5)=HEX(00)THEN 6370
: REM - IF STATUS WASN'T RETURNED, GO CHECK THE NEXT ADDRESS
6050 CONVERT E$(1)TO D
: REM - GET DPU TYPE
6060 ON D GOTO 6070,6150,6270
: GOTO 6370
: REM - BRANCH TO APPROPRIATE DPU TYPE HANDLER (INVALID DPU TYPES ARE SKIPP
ED)
6070 FOR I=0TO 5
: K=I-1
: IF K=-1THEN K=16
: REM - PHEONIX/LVP/SVP HANDLER. LOOP THROUGH REMOVABLE & 5 FIXED (ADJUST
PLATTER # FOR REMOVABLE)
6080 STR(D$,3,1)=BIN(I+48)
: REM - ADJUST DISK ADDRESS TO CURRENT PLATTER
6090 GOSUB '221(D$,K)
: REM - GET STATUS OF CURRENT PLATTER
6100 IF G$(5)=HEX(00)OR STR(E$(),7,2)=HEX(0000)THEN 6130
: REM - JUMP IF NO STATUS RETURNED OR SECTORS = 0
6110 D1=5
: IF I=0THEN D1=4
: IF E$(2)="8"THEN D1=D1+2
: REM - SET DESCRIPTION POINTER
6120 GOSUB '222(D$,D1,VAL(STR(E$(),7,2),2))
: REM - ADD THIS PLATTER TO THE TABLES
6130 NEXT I
: REM - PROCEED TO NEXT PHEONIX PLATTER
6140 GOTO 6370
: REM - PROCESS NEXT ADDRESS
6150 ON POS("1234"=E$(2))GOTO 6160,6170,6160,6180
: REM - 2275 HANDLER. BRANCH FOR "SECOND" DRIVE (FLOPPY...)
6160 D1=1
: GOTO 6190
: REM - "SECOND" DRIVE IS FLOPPY
6170 D1=2
: GOTO 6190
: REM - "SECOND" DRIVE IS 10-MEG
6180 D1=3
: REM - "SECOND" DRIVE IS 15-MEG
6190 GOSUB '222(D$,D1,VAL(STR(E$(),10,2),2))
: REM - ADD "SECOND" DRIVE TO TABLES
6200 ON POS("1234"=E$(2))GOTO 6210,6210,6220,6220
: REM - BRANCH FOR "FIRST" DRIVE
6210 D1=2
: GOTO 6230
: REM - "FIRST" DRIVE IS 10-MEG
6220 D1=3
: REM - "FIRST" DRIVE IS 15-MEG
6230 STR(D$,3,1)="1"
: GOSUB '222(D$,D1,VAL(STR(E$(),7,2),2))
: REM - UPDATE DISK ADDRESS & ADD "FIRST" DRIVE TO TABLES
6240 IF D1<>3THEN 6250
: STR(D$,3,1)="2"
: GOSUB '222(D$,3,VAL(STR(E$(),7,2),2))
: REM - JUMP IF "FIRST" DRIVE ISN'T A 15-MEG. GENERATE SECOND PARTITION AS
ABOVE
6250 IF E$(2)<>"4"THEN 6260
: STR(D$,3,1)="3"
: GOSUB '222(D$,3,VAL(STR(E$(),10,2),2))
: REM - JUMP IF "SECOND" DRIVE ISN'T A 15-MEG. GENERATE SECOND PARTITION A
S ABOVE
6260 GOTO 6370
: REM - PROCESS NEXT ADDRESS
6270 FOR I=0TO 14
: K=I-1
: IF K=-1THEN K=16
: REM - 2275 F/R/S HANDLER. LOOP THROUGH REMOVABLE & 14 FIXED (ADJUST PLAT
TER # FOR REMOVABLE)
6280 IF I<10THEN STR(D$,3,1)=BIN(I+48)
: ELSE STR(D$,3,1)=BIN(I+55)
: REM - ADJUST DISK ADDRESS TO CURRENT PLATTER
6290 GOSUB '221(D$,K)
: REM - GET STATUS OF CURRENT PLATTER
6300 IF G$(5)=HEX(00)OR STR(E$(),7,2)=HEX(0000)THEN 6360
: REM - JUMP IF NO STATUS RETURNED OR SECTORS = 0
6310 ON POS("1234F"=E$(2))GOTO 6320,6320,6330,6330,6340
: GOTO 6360
: REM - BRANCH ON DRIVE TYPE SWITCH SETTING
6320 D1=9
: GOTO 6350
: REM - 10/20 MEG FIXED
6330 D1=10
: GOTO 6350
: REM - 30/67 MEG FIXED
6340 D1=8
: REM - FLOPPY
6350 GOSUB '222(D$,D1,VAL(STR(E$(),7,2),2))
: REM - ADD THIS PLATTER TO THE TABLES
6360 NEXT I
: REM - PROCEED TO NEXT PLATTER
6370 NEXT J
: REM - GO TO NEXT ADDRESS
6380 RETURN
: REM - ALL DRIVES POLLED, EXIT
6400 DEFFN'221(D$,K)
: REM %GET DISK STATUS MESSAGE (D$=DISK ADDRESS, K=PLATTER #) STATUS IS IN
E$()
6410 G$()=ALL(00)
: REM - INITIALIZE $GIO REGISTERS
6420 P$=BIN(K)
: REM - CONVERT PLATTER # TO A 1-BYTE VALUE
6430 G$(1)=HEX(20) OR P$
: REM - "OR" IT WITH X'20' TO INDICATE AN EXTENDED COMMAND AND STORE IT IN
$GIO REGISTER 1
6440 SELECT #1<D$>
: ERRORGOTO 6490
: REM - PUT THE DISK ADDRESS INTO THE DEVICE TABLE & EXIT IF ERROR
6450 FOR J0=1TO 10
: $OPEN 6455,#1
: ERRORGOTO 6455
: REM - TRY 10 TIMES TO "HOG" THE DISK. IF ERROR, TREAT IT AS IF WE COULDN
'T GET THE DRIVE.
6452 J0=99
: REM - IF $OPEN WAS SUCCESSFUL, SET J0=99 (TO EXIT LOOP)
6455 NEXT J0
: IF J0<>99THEN 6490
: REM - FINISH "HOG" LOOP. JUMP IF NOT SUCCESSFUL
6460 $GIO GET DISK TYPE #1 (0200 030F 1222 0600 0700 70A0 4000 870B,G$())
: REM - GET THE DRIVE TYPE (DPU TYPE)
6470 IF G$(11)<>HEX(D0)THEN 6490
: REM - EXIT IF NOT A "D0" DRIVE
6480 $GIO READ STATUS #1 (0600 0700 70A0 4002 88D0 7040 6A10 6816 4000 8705 1A
00 C340, G$()) G$(); STR(E$(),,VAL(G$(5)))
: ERRORREM - ATTEMPT TO GET STATUS MESSAGE FROM THE DISK DRIVE
6490 $CLOSE#1
: RETURN
: REM - THAT'S ALL FOLKS!!!
6500 DEFFN'222(D$,D1,D)
: REM %ADD D$ TO D$(), D1 TO D1() & D TO D()
6510 N=(POS(D$()=" ")-1)/3+1
: REM - FIND THE NEXT EMPTY ELEMENT
6520 D$(N)=D$
: D1(N)=D1
: D(N)=D
: REM - STORE THE VALUES IN THE ARRAYS
6530 RETURN
: REM - ALL DONE!
7000 DEFFN'201(M$)
: REM % DISPLAY M$ IN LOWER LEFT CORNER OF THE DISPLAY
7010 PRINT AT(23,0);HEX(0E);STR(M$);HEX(01)
: REM - DISPLAY MESSAGE
7020 RETURN
7030 DEFFN'202(I1,I2,I0$(1),I3,I0$,I1$)
: REM % ACCEPT FIELD (I1,I2=ROW,COL I0$(1)=DATA I3=LEN I0$=VER MASK I1$=EXI
T SFKEYS)
7040 MAT REDIM I0$(1)I3
: REM - CHANGE LENGTH OF FIELD TO LENGTH SPECIFIED
7050 PRINT HEX(020402040E)
: REM - SET ATTRIBUTES TO BRIGHT/UNDERSCORE
7060 I0=1
: REM - INITIALIZE CURSOR POSITION
7070 PRINT HEX(06);AT(I1,I2);STR(I0$(1))
: REM - DISPLAY THE FIELD
7080 PRINT AT(I1,I2+I0-1);HEX(02050F);
: REM - POSITION CURSOR
7090 KEYIN K$,,7200
: REM - WAIT FOR A KEY. BRANCH IF SF KEY PRESSED
7100 PRINT HEX(06);
: REM - "NORMAL" KEY PRESSED; SHUT OFF THE CURSOR
7110 ON POS(HEX(20080D82)=K$)GOTO 7130,7150,7180,7190
: REM - BRANCH IF SPACE, BACKSPACE, RETURN OR RUN/EXEC
7120 IF VER(K$,I0$)<>1THEN 7080
: REM - IF NOT A VALID KEY, WAIT FOR ANOTHER
7130 IF I0$=HEX(00)THEN 7080
: STR(I0$(1),I0,1)=K$
: PRINT K$;
: REM - IF ACCEPTING CHARACTERS, PUT THE CHARACTER INTO THE FIELD & PRINT I
T
7140 IF I0<I3THEN I0=I0+1
: GOTO 7080
: REM - INCREMENT CURSOR POSITION & UPDATE IT
7150 IF I0=1THEN 7080
: REM - BACKSPACE PRESSED; GET ANOTHER KEY IF AT LEFTMOST COLUMN
7160 IF I0<I3OR STR(I0$(1),I0,1)=" "THEN I0=I0-1
: REM - DON'T DECREMENT CURSOR POSITION IF AT RIGHTMOST POSITION & IT'S NON
-BLANK
7170 STR(I0$(1),I0,1)=" "
: GOTO 7070
: REM - REMOVE THE CHARACTER & UPDATE THE CRT
7180 K$=HEX(20)
: GOTO 7280
: REM - RETURN PRESSED; TRANSLATE IT TO HEX(20) & EXIT
7190 GOTO 7280
: REM - RUN/EXEC PRESSED; EXIT
7200 PRINT HEX(06);
: REM - SF KEY PRESSED; SHUT OFF THE CURSOR
7210 IF POS(I1$=K$)<>0THEN 7280
: REM - IF AN EXIT KEY, EXIT
7220 IF I0$<>HEX(00)THEN ON POS(HEX(48494A4C4D)=K$)GOTO 7230,7240,7250,7260,72
70
: GOTO 7080
: REM - IF MODIFIABLE, BRANCH TO ERASE, DELETE, INSERT, RIGHT OR LEFT
7230 STR(I0$(1),I0)=" "
: GOTO 7070
: REM - ERASE PRESSED; DO IT & UPDATE THE CRT
7240 IF I0<I3THEN STR(I0$(1),I0)=STR(I0$(1),I0+1)
: STR(I0$(1),I3,1)=" "
: GOTO 7070
: REM - DELETE PRESSED; DO IT & UPDATE THE CRT
7250 IF I0<I3THEN MAT COPY -STR(I0$(1),I0,I3-I0)TO -STR(I0$(1),I0+1)
: STR(I0$(1),I0,1)=" "
: GOTO 7070
: REM - INSERT PRESSED; DO IT & UPDATE THE CRT
7260 IF I0<I3THEN I0=I0+1
: GOTO 7070
: REM - RIGHT PRESSED; MOVE CURSOR & REPOSITION IT
7270 IF I0>1THEN I0=I0-1
: GOTO 7070
: REM - LEFT PRESSED; MOVE CURSOR & REPOSITION IT
7280 PRINT HEX(020402000F)
: REM - SET THE ATTRIBUTES TO BRIGHT (NORMAL)
7290 MAT REDIM I0$(1)80
: REM - RESET THE FIELD LENGTH TO ITS MAXIMUM
7300 RETURN
7310 DEFFN'204
: REM % RETURN K$ = "Y" or "N"
7320 KEYIN K$
7330 $TRAN(K$,"YyNn")R
: IF K$<>"Y"AND K$<>"N"THEN 7320
7340 RETURN
9000 DEFFN'255
: REM % ERROR HANDLER (SETS M$=ERROR DESCRIPTION & BEEPS)
9005 M=ERR
: REM - GET THE ERROR NUMBER
9010 M$=" "
: REM - INITIALIZE MESSAGE
9015 IF M<90THEN 9025
: RESTORE LINE9020,M-89
: READ M$
: REM - GET MESSAGE IF DISK ERROR
9020 DATA "Disk Hardware Error","Disk Drive Not Ready","Disk Drive Time-Out","
Disk Format Error","Disk Format Key Engaged"
: REM - DISK ERRORS
9021 DATA "Disk Seek Error or Platter Protected","Disk CRC Error","Disk LRC Er
ror","Bad Sector Address/Platter Not Mounted","Verify Error"
: REM - DISK ERRORS (CONT.)
9025 IF M=48THEN M$="Illegal Device Specification"
9030 IF M$<>" "THEN 9040
: M$="Unexpected Error ### Occurred"
: CONVERT MTO STR(M$,18,3),(###)
: REM - CATCH-ALL
9040 PRINT HEX(07)
: RETURN
9998 DEFFN'30
: SELECT LIST 215(132)
: LIST "@FORMAT - Disk format utility for OS Release 2.7"D
: LIST "Line number cross-reference"#
: LIST "Subroutine cross-reference"'
: LIST "Variable cross-reference"V
: SELECT LIST 005(80)
: STOP "- LISTINGS GENERATED"
9999 DEFFN'31"Z$=";HEX(22);"@FORMAT";HEX(22);":SCRATCHTZ$:SAVET$()Z$";HEX(0D)