image of READY prompt

Wang2200.org

Listing of file='3741090A' on disk='vmedia/3741_util.wvd.zip'

# Sector 179, program filename = '3741090A'
0010 REM 3741090A,02.00(12/1/78),THIS PROGRAM IS A PRODUCT OF WANG LABS. INC.
3000 % THIS MUST BE STATEMENT 3000
3010 %SECTOR #### (##/##) RECORD ####
3020 %      ##########################    #######################
3030 DIM Q$(2)64,Q6$64,Q7$1,Q5$64,Q6$64
   : DIM Y$(1,128)1,Y$1,X9$(8)32,X$17
   : GOSUB '188
   : INIT(20)X9$(1)
   : X9$(2)=HEX(202122232425262728292A2B2C2D2E2F303132333435363738393A3B3C3D3E
     3F)
   : FOR I=3TO 8
3110 X9$(I)=X9$(I-1)
   : ADD(X9$(I),X9$(1))
   : NEXT I
   : INIT("?")X9$(1),X9$(5)
3170 DEFFN'15
   : PRINT HEX(030A0A0A)
   : PRINT TAB(20);"   DISK I/O FUNCTIONS"
   : PRINT
   : PRINT "---------------------------------------------------------------"
   : PRINTUSING 3020,"FN KEY    DESCRIPTION","FN KEY    DESCRIPTION"
3230 PRINT "---------------------------------------------------------------"
   : PRINTUSING 3020,"  01  -  READ","  08  -  WRITE END"
   : PRINTUSING 3020,"  02  -  WRITE","  09  -  OPEN (OLD)"
3260 PRINTUSING 3020,"  03  -  BACKSPACE","  10  -  OPEN (NEW)"
   : PRINTUSING 3020,"  04  -  SKIP","  11  -  CLOSE"
   : PRINTUSING 3020,"  05  -  SKIP TO 'EOD'","  12  -  DELETE RECORD"
3290 PRINTUSING 3020,"  06  -  SKIP TO ADDRESS","  13  -  DELETE FILE"
   : PRINTUSING 3020,"  07  -  REREAD","  14  -  SET LABLE CODES"
   : PRINTUSING 3020,"  15  -  RETURN TO MENU","  31  -  LOAD 'START'"
3320 PRINT HEX(01);"PRESS DESIRED FUNCTION KEY";
3330 A$=" "
   : KEYIN A$,3330,3360
   : GOTO 3330
3360 IF A$=HEX(1F)THEN 4980
   : IF A$<HEX(01)THEN 3330
   : IF A$>HEX(0E)THEN 3330
   : ON VAL(A$)GOSUB 3730,3840,4180,4230,4280,4320,4370,4420,4460,4530,3690,47
     00,4740,4780
   : IF Q$=" "THEN 3170
   : PRINT HEX(07)
   : GOSUB '248(1,0,3)
   : PRINT "ERROR - ";
   : HEXPRINT STR(Q$,1,1);
   : PRINT " - ";
3480 ON VAL(Q$)GOTO 3510,3530,3550,3570,3590,3610,3630,3650
   : PRINT "CATALOG END ERROR"
   : GOTO 3660
3510 PRINT "END OF FILE"
   : GOTO 3660
3530 PRINT "RECORD LENGTH GREATER THAN 128"
   : GOTO 3660
3550 PRINT "FILE FULL"
   : GOTO 3660
3570 PRINT "FILE ALREADY CATALOGED"
   : GOTO 3660
3590 PRINT "FILE NOT FOUND"
   : GOTO 3660
3610 PRINT "CATALOG FULL"
   : GOTO 3660
3630 PRINT "NO FILE OPEN"
   : GOTO 3660
3650 PRINT "DELETED RECORD"
3660 GOSUB '254
   : GOTO 3170
3690 PRINT HEX(03);,"CLOSE ";X$
   : GOSUB '188
   : RETURN
3730 PRINT HEX(03);,"READ"
   : GOSUB '181
   : IF Q$<>" "THEN 3820
   : $TRAN(Z$(),X9$())
3770 PRINT HEX(010A0A0A0A)
   : PRINTUSING 3010,Z0-1,INT((Z0-2)/26),Z0-1-INT((Z0-2)/26)*26,Z0-Z1
   : MAT PRINT Z$
   : IF Q$<>" "THEN 3820
   : GOSUB '254
3820 RETURN
3840 PRINT HEX(03);,"WRITE"
   : GOSUB 253
   : IF Q$<>" "THEN 4160
   : PRINT HEX(010A0A0A0A)
   : PRINTUSING 3010,Z0,INT((Z0-1)/26),Z0-INT((Z0-1)/26)*26,Z0-Z1+1
   : PRINT HEX(0A);"ENTER DATA-KEY (EXEC) TO TERMINATE INPUT"
   : INIT(20)Y$()
   : GOTO 3980
3920 KEYIN Y$,3940,3920
   : GOTO 3920
3940 IF Y$=HEX(0D)THEN 4140
   : IF Y$<>HEX(08)THEN 4010
   : X=X-2
   : IF X>-1THEN 3990
3980 X=0
3990 Y$(1,X+1)=" "
   : GOTO 4040
4010 IF Y$<HEX(20)THEN 3920
   : IF Y$>HEX(7F)THEN 3920
   : Y$(1,X)=Y$
4040 PRINT
   : PRINT HEX(010A0A0A0A0A0A0A0A0A)
   : $GIO/005(A200400D400A,A$)Y$()<1,64>
   : $GIO/005(A200400D400A,A$)Y$()<65,64>
   : PRINT HEX(0A0A);"COLUMN";X+1
   : PRINT TAB(X-INT(X/64)*64);HEX(0C0C0C0C);
   : IF X>63THEN 4120
   : PRINT HEX(0C);
4120 X=X+1
   : IF X<=YTHEN 3920
4140 MAT COPY Y$()<1,Y>TO Z$()
   : GOSUB '182
4160 RETURN
4180 PRINT HEX(03);,"BACKSPACE"
   : GOSUB '200("0","1924",4,0,"ENTER THE NUMBER OF SECTORS TO BACKSPACE.",1)
   : GOSUB '183(Q9)
   : RETURN
4230 PRINT HEX(03);,"SKIP"
   : GOSUB '200("0","1924",4,0,"ENTER THE NUMBER OF SECTORS TO SKIP.",1)
   : GOSUB '184(Q9)
   : RETURN
4280 PRINT HEX(03);,"SKIP TO 'EOD'"
   : GOSUB '190
   : RETURN
4320 PRINT HEX(03);,"SKIP TO ADDRESS"
   : GOSUB '200("27","1950",4,0,"ENTER THE ADDRESS TO SKIP TO.",1)
   : GOSUB '191(Q9)
   : RETURN
4370 PRINT HEX(03);,"REREAD"
   : GOSUB '180
   : IF Q$=" "THEN 3770
   : RETURN
4420 PRINT HEX(03);,"WRITE END"
   : GOSUB '185
   : RETURN
4460 PRINT HEX(03);,"OPEN (OLD)"
   : GOSUB '200(" "," ",17,0,"ENTER THE NAME OF THE FILE TO OPEN.",2)
   : GOSUB '186(Q6$)
   : IF Q$<>" "THEN 4510
   : Y=Z5
4510 RETURN
4530 PRINT HEX(03);,"OPEN (NEW)"
   : GOSUB '200(" "," ",17,0,"ENTER THE NAME OF THE FILE TO BE CREATED.",2)
   : X$=Q6$
   : GOSUB '248(6,24,0)
   : PRINT "FILE NAME = ";X$
4580 GOSUB '200("1","128",3,0,"ENTER THE RECORD LENGTH.",1)
   : Y=Q9
   : GOSUB '248(7,20,0)
   : PRINT "RECORD LENGTH =";Y
   : GOSUB '200("2","1924",4,0,"ENTER THE NUMBER OF SECTORS TO ALLOCATE.",1)
   : X1=Q9
4640 GOSUB '248(8,16,0)
   : PRINT "NUMBER OF SECTORS =";X1
   : GOSUB '248(1,0,3)
   : GOSUB '187(X$,X1,Y)
   : RETURN
4700 PRINT HEX(03);,"DELETE A RECORD"
   : GOSUB '192
   : RETURN
4740 PRINT HEX(03);,"DELETE A FILE"
   : GOSUB '193
   : RETURN
4780 PRINT HEX(03);,"SET LABLE CODES"
   : GOSUB '200(" "," ",1,0,"ENTER BYPASS CODE (' ',B)",2)
   : X1$=Q6$
   : GOSUB '248(6,27,0)
   : PRINT "BYPASS CODE = ";X1$
   : GOSUB '200(" "," ",1,0,"ENTER PROTECT CODE (' ',P)",2)
4840 X2$=Q6$
   : GOSUB '248(7,26,0)
   : PRINT "PROTECT CODE = ";X2$
   : GOSUB '200(" "," ",1,0,"ENTER MULTI-VOLUME CODE (' ',C,L)",2)
   : X3$=Q6$
   : GOSUB '248(8,21,0)
   : PRINT "MULTI-VOLUME CODE = ";X3$
   : GOSUB '248(1,0,3)
4920 GOSUB '194(X1$,X2$,X3$)
   : IF Q$<>" "THEN 4950
   : Z0=Z1
4950 RETURN
4980 DEFFN'31
   : PRINT HEX(03);"SYSTEM NOW LOADING - 'START'"
   : LOAD DC T#1,"3741010A"
5020 DEFFN'200(Q$(1),Q$(2),Q3,Q4,Q6$,Q5)
   : Q6=Q9
   : SELECT PRINT 005
   : IF Q6$=" "THEN 5030
   : PRINT HEX(010A);Q6$;TAB(80)
5030 INIT(20)Q5$,Q6$
   : Q7=61
   : IF Q3+Q4=0THEN 5040
   : Q7=Q3+Q4+2*SGN(2-Q5)
   : INIT("-")STR(Q5$,1,Q7-SGN(2-Q5))
   : BIN(STR(Q5$,Q3+SGN(2-Q5),1))=45+2*SGN(2-Q5)
5040 PRINT HEX(0D010A0A);TAB(80)
   : PRINT HEX(010A0A);"? ";Q5$
   : PRINT HEX(010A0A0909);
   : Q8=0
   : KEYIN Q7$,5050,5050
5050 KEYIN Q7$,5100,5060
   : GOTO 5050
5060 IF Q7$=HEX(0F)THEN 5080
   : IF Q7$<>HEX(1F)THEN 5050
   : RETURN CLEAR
   : GOSUB '31
5080 RETURN CLEAR
5090 GOSUB '15
5100 IF Q7$=HEX(08)THEN 5110
   : IF Q7$=HEX(E5)THEN 5030
   : IF Q7$=HEX(0D)THEN 5120
   : IF Q7$<HEX(20)THEN 5050
   : IF Q7$>HEX(7F)THEN 5050
   : Q8=Q8+1
   : IF Q8>Q7THEN 5190
   : STR(Q6$,Q8,1)=Q7$
   : PRINT Q7$;
   : GOTO 5050
5110 SELECT PRINT 005
   : Q8=Q8-SGN(Q8)
   : STR(Q6$,Q8+1)=" "
   : IF Q8=0THEN 5040
   : PRINT HEX(08);STR(Q5$,Q8,1);HEX(08);
   : GOTO 5050
5120 Q8=Q8+1-SGN(Q8)
   : ON Q5GOTO 5130,5210
   : IF Q6$=" "THEN 5150
5130 IF Q8<>NUM(STR(Q6$,1,Q8))THEN 5190
   : CONVERT Q6$TO Q9
   : IF Q3+Q4=0THEN 5210
   : IF ABS(Q9)>=10^ABS(Q3)THEN 5190
   : IF INT(Q9*10^Q4)<>Q9*10^Q4THEN 5190
   : GOTO 5210
5140 CONVERT Q$(1)TO Q7
   : CONVERT Q$(2)TO Q8
   : IF Q7>Q9THEN 5160
   : IF Q9>Q8THEN 5160
5150 PRINT HEX(0D0A);TAB(80)
   : RETURN
5160 PRINT HEX(0D010A0A0A07);"RE-ENTER",Q7;"<= ENTRY <=";Q8;TAB(80)
5170 Q9=Q6
   : GOTO 5030
5180 IF Q$(1)>Q6$THEN 5190
   : IF Q6$<=Q$(2)THEN 5150
5190 GOSUB 5200
   : GOTO 5170
5200 DEFFN'255
   : PRINT HEX(0D010A0A0A07);"RE-ENTER";TAB(80)
   : RETURN
5210 IF Q$(1)<>Q$(2)THEN 5220
   : IF Q$(1)=" "THEN 5150
5220 ON Q5+1GOTO 5140,5140,5180
5230 DEFFN'242(W0,Q6$)
   : SELECT PRINT 005
   : IF W0<=0THEN 5240
   : INIT(Q6$)Q6$
   : PRINT STR(Q6$,1,W0-INT((W0-1)/63)*63);
   : W0=W0-(W0-INT((W0-1)/63)*63)
   : GOTO 5230
5240 RETURN
5250 DEFFN'254
   : SELECT PRINT 005
   : PRINT HEX(010A0A);TAB(80);HEX(010A0A)
   : Q6$=" "
5260 KEYIN Q6$,5260,5260
   : INPUT "KEY RETURN(EXEC) TO RESUME ",Q6$
   : PRINT HEX(010A);TAB(80),TAB(80),TAB(80)
   : RETURN
5270 DEFFN'248(Q6,Q7,Q8)
   : SELECT PRINT 005
   : IF Q8=0THEN 5290
   : IF ABS(Q8)<>9E99THEN 5280
   : PRINT HEX(03)
   : GOTO 5290
5280 GOSUB 5290
   : SELECT PRINT 205
   : PRINT TAB(72-8*SGN(Q8)-Q7)
   : IF ABS(Q8)<2THEN 5290
   : FOR W0=2TO ABS(Q8)
   : PRINT HEX(0A);TAB(72-8*SGN(Q8))
   : NEXT W0
5290 PRINT HEX(01)
   : GOSUB '242(Q7,HEX(09))
   : GOSUB '242(Q6,HEX(0A))
   : SELECT PRINT 005
   : RETURN
5300 DEFFN'0"      GOTO 3520";HEX(0D)