Listing of file='@FORMAT' on disk='vmedia/731-8009-F.wvd.zip'
# Sector 387, program filename = '@FORMAT'
0010 % @FORMAT 12/11/87 -- (c) Copr. Wang Laboratories, Inc. 1986
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 = 11 December 1987 (CSN)
0080 % --------------------------------------
0090 %
0095 DIM A1$3
: DIM S$3,Q$1
0100 REM %VARIABLE DEFINITIONS
0110 DIM V$8
: V$="01.03.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
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
0500 REM %DISK ADDRESS SELECTION MENU
0510 SELECT PRINT /005(80)
: PRINT HEX(020D0C030F)
: REM - INITIALIZE DISPLAY
0520 $CLOSE#1
: PRINT HEX(03060E);TAB(15);"SOFTWARE FORMATTBLE DISK PLATTER FORMAT UTILIT
Y"
: PRINT TAB(20);"(c) Copr. Wang Laboratories, Inc. 1986"
: PRINT TAB(31);"Release ";V$
0540 PRINT AT(22,52);"RETURN - Proceed";AT(23,52);"FN/TAB - Previous Menu";HEX
(01)
: REM - KEY DEFINITIONS
0560 REM %Get Disk Address
0565 PRINT AT(4,0);HEX(020402040F);"Enter platter address: ";HEX(0E);D0$;HEX(0
20402000F)
: REM - DISPLAY THE FIELD
0570 F=0
: PRINT AT(4,22);
: LINPUT HEX(0E),-D0$
0572 GOSUB '201(" ")
0580 A1$=D0$
: $TRAN(A1$,"BbDd")R
: GOSUB '100(A1$)
: IF Q$=" " THEN 610
0585 GOSUB '201("Platter address must be 3 hex digits")
: PRINT HEX(07)
: GOTO 570
: REM - YELL AT HIM & LET HIM TRY 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
0615 PRINT AT(4,0);"Platter address = ";D0$
: M2=-1
0620 PRINT AT(5,0);HEX(0E);"Mount disk to be formatted and press RETURN:"
: REM - PROMPT
0625 GOSUB '201(M$)
: REM - DISPLAY MESSAGE (IF ANY)
0630 PRINT AT(22,52);"RETURN - Proceed";AT(23,52);"FN/TAB - Previous Screen";H
EX(01)
: REM - KEY DEFINITIONS
0650 F=1
: KEYIN K$
: IF K$=HEX(7E)OR K$=HEX(7F)THEN 1880
: IF K$<>HEX(0D)THEN 650
0700 REM %GET & DISPLAY INDEX INFORMATION (IF INDEX SECTORS > 0)
0710 IF M2=-1THEN SELECT #1<D0$>
: ERRORGOSUB '255
: GOTO 610
: REM - SELECT DISK hhh
0725 V$(1)="24"
: V$(2)=" "
: V$(3)="0"
: REM - INITIALIZE THE INDEX INFORMATION FIELDS
: X=0
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 Already In Use or Not Ready"
: PRINT HEX(07)
: GOTO 610
: REM - DISPLAY MESSAGE IF CAN'T $OPEN DRIVE
0740 IF D0$="340"THEN 760
: G$(11)=HEX(FF)
: $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 752
: M$="Drive Not Responding"
: PRINT HEX(07)
: GOTO 610
0752 IF G$(11)=HEX(D0)THEN 760
: IF G$(11)=HEX(C0)THEN 760
: IF G$(11)=HEX(FF)THEN PRINT AT(5,0,80);"No disk controller at address"
: GOTO 565
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
0776 IF STR(S$(),,1)<>HEX(00)THEN PRINT AT(15,51);"'"
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 M$=HEX(020404000E)&"(Formatting)"&HEX(020400000E)
: GOSUB '201(M$)
: 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!
0822 F=2
0825 REM %GET NEW INDEX PARAMETERS & SCRATCH THE DISK
0830 PRINT AT(5,0,80);HEX(0E);"Enter new index information and press RUN:"
: 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 AT(21,52);"RETURN - Next Field";AT(22,52);"RUN - Accept paramete
rs"
: 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(827E7F)=K$)GOTO 900,520,520
: REM - RUN , FN / TAB
0865 K0=K0+1
: IF K0>3THEN K0=1
: GOTO 855
: REM - RETURN PRESSED, ADVANCE TO NEXT FIELD
0875 GOSUB '202(15,45,V$(1),5,"#",HEX(7F7E))
: V$(1)=I0$(1)
: RETURN
: REM - ACCEPT INDEX SECTORS
0880 GOSUB '202(16,45,V$(3),5,"#",HEX(7F7E))
: V$(3)=I0$(1)
: RETURN
: REM - ACCEPT END OF CATALOGED AREA
0885 GOSUB '202(17,45,V$(2),3,"A",HEX(7F7E))
: 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
1870 DEFFN'126
1880 DEFFN'127
: GOSUB '201("FN/TAB keyed")
1890 IF F=1THEN 510
2000 COM CLEAR
: GOSUB '201("(Returning to System Menu)")
: $PSTAT=" "
: LOAD DC T"@MENU"
: END
: REM - THAT'S ALL SHE WROTE
5025 DEFFN'100(S$)
: IF S$="340"THEN 5035
: $TRAN(S$,"AaBbCcDdEeFf")R
: IF POS("DB3"=S$)>0AND POS("123567"=STR(S$,2))>0AND VER(STR(S$,3),"H")>0TH
EN 5030
: Q$="I"
: RETURN
5030 IF POS("3B"=S$)=0OR POS("123"=STR(S$,2))=0OR STR(S$,3)<>"0"THEN 5035
: IF STR(S$,,1)="3"THEN STR(S$,3)="1"
: STR(S$,,1)="D"
5035 Q$=" "
: RETURN
7000 DEFFN'201(M$)
: REM % DISPLAY M$ IN LOWER LEFT CORNER OF THE DISPLAY
7010 PRINT AT(23,0,33);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$
7325 IF K$=HEX(7E)OR K$=HEX(7F)THEN K$="N"
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