image of READY prompt

Wang2200.org

Listing of file='@FORMAT' on disk='vmedia/731-8027.wvd.zip'

# Sector 465, program filename = '@FORMAT'
0010 % @FORMAT 03/20/90 -- (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 = 20 March 1990 (TBO)
0080 % --------------------------------------
0090 %
0095 DIM A1$3,A2$1,S$3,Q$1
0100 REM %VARIABLE DEFINITIONS
0110 DIM V$8
   : V$="01.05.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
0280 DIM G1$17,E1$32,P$1,G1$(32)3,B$3,G2$1
   : P$=HEX(10)
   : REM VARIABLES FOR GETTING DISK STATUS
0290 DIM D$(32)4,K1$80,T$1,D$3,D2$2
   : DIM G$40,E$40
   : DIM G$(15)1
0300 REM %^.Initialize everything
   : REM %.1st display
0510 SELECT PRINT /005(80)
   : PRINT HEX(020D0C030F)
0520 $CLOSE#1
   : PRINT HEX(03060E);TAB(15);"SOFTWARE FORMATTABLE DISK PLATTER FORMAT UTILI
     TY"
   : PRINT TAB(20);"(c) Copr. Wang Laboratories, Inc. 1990"
   : PRINT TAB(31);"Release ";V$
0540 PRINT AT(22,52);"RETURN - Proceed";AT(23,52);"FN/TAB - Previous Menu";HEX
     (01)
0560 REM %Get Disk Address
0565 PRINT AT(4,0);HEX(020402040F);"Enter platter address: ";HEX(0E);D0$;HEX(0
     20402000F)
0570 F=0
   : PRINT AT(4,22);
   : LINPUT HEX(0E),-D0$
0572 GOSUB '201(" ")
0580 A1$=D0$
   : $TRAN(A1$,"BbDd")R
   : B$=A1$
   : GOSUB '100(A1$)
   : IF Q$=" "THEN 610
0585 GOSUB '201("Platter address must be 3 hex digits")
   : PRINT HEX(07)
   : GOTO 570
0600 REM %.Show Platter information
   : REM .Unhog disk and show 2nd screen
0610 $CLOSE#1
   : PRINT HEX(03060E);TAB(15);"SOFTWARE FORMATTABLE DISK PLATTER FORMAT UTILI
     TY"
   : PRINT TAB(30);"Platter Information"
   : PRINT AT(4,0);"Platter address  = ";D0$,
   : M2=-1
   : A2$="1"
   : IF A1$="D10"OR A1$="D20"OR A1$="D30"THEN 615
   : GOTO 620
0615 GOSUB 5040
   : ON T+1GOTO 565,565,565
   : A$="360 KB"
   : IF VAL(STR(E$,6,3),3)=4160THEN A$="1.2 mB"
   : PRINT AT(5,0,80);HEX(0E);STR(A$,,LEN(A$));" Floppy Drive.  Please Select"
   : PRINT "  [1] CS/2200 format"
   : PRINT "  [2] DOS format"
   : LINPUT "  "-A2$
   : PRINT HEX(06);
0620 PRINT AT(9,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)
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)
0705 IF A2$="2"THEN 795
0710 IF M2=-1THEN SELECT #1<A1$>
   : 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)
   : $GIOGETDISKTYPE#1(0200030F12220600070070A04000870B,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(6,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 IF A2$="2"THEN 812
   : $FORMATDISK T#1
   : ERRORGOSUB '255
   : GOTO 610
   : REM - FINALLY!  FORMAT THE DISK
0811 GOTO 820
0812 REM ! PC FORMAT
   : SELECT #1<A1$>
   : G$=ALL(20)
   : $GIO#1(0600070070A0400288D0704001306A10680240018B67,G$)
0813 IF STR(G$,6,3)=HEX(000000)THEN 815
0814 IF STR(G$,6,3)<>HEX(000000)THEN DO
   : PRINT HEX(07);
   : M$=HEX(0204020E)&"Disk Error - Press any Key "&HEX(0F)
   : GOSUB '201(M$)
   : KEYIN K$
   : M$=ALL(" ")
   : END DO
   : GOTO 610
0815 GOTO 510
0820 GOSUB '201("Format Completed")
   : REM - WE MADE IT!
0822 F=2
0825 REM %GET NEW INDEX PARAMETERS & SCRATCH THE DISK
0830 PRINT AT(6,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
5040 REM %^.Get disk status
5050 A$=ALL(20)
   : STR(B$,2,1)=STR(B$,2,1)AND HEX(33)
   : SELECT #2<B$>
5080 $GIOGETDISKTYPE#2(0200030F12220600070070A04000870B,G$())
5090 T$=G$(11)
   : T=POS(HEX(C0D0)=T$)
   : IF T=0THEN 5140
   : IF T=2THEN GOSUB 5150
5100 ON TGOSUB 5260,5250,5240,5230
   : PRINT K1$
5110 D$=D$(1)
5130 RETURN
5140 PRINT "Unknown disk type check connector"
   : D$()=" "
   : RETURN
5150 REM %^.Check for DS cabinet
5160 G$=HEX(30)
   : STR(G$,2,7)=ALL(00)
   : $GIOSTATUSREQUEST#2(0E140F0012E20600070070A0400288D070406A106816400087051
     A00C340,G$)G$;STR(E$,,VAL(STR(G$,5,1)))
5170 T=VAL(E$)-47
5180 G1$=STR(G$,8,1)AND HEX(10)
   : IF G1$=HEX(00)THEN 5190
   : K1$="Disk unavailable"
   : RETURN
5190 IF STR(G$,8,1)<>HEX(00)THEN 5200
   : IF STR(E$,1,1)=HEX(33)THEN 5220
   : IF I=32AND STR(E$,1,2)=HEX(4533)THEN 5210
5200 REM "specified disk is not a DS"
   : RETURN
5210 STR(E$,1,2)=HEX(3345)
5220 RETURN
5230 K1$="DS cabinet"
   : RETURN
5240 K1$="2275 type"
   : RETURN
5250 K1$="Phoenix type"
   : RETURN
5260 K1$="2270 type"
   : RETURN
6000 REM % GET DISK STATUS
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