Listing of file='@2273VFU' on disk='vmedia/701-2118M.wvd.zip'
# Sector 647, program filename = '@2273VFU'
0010 REM @2273VFU, (06/09/80), THIS PROGRAM IS A COPYRIGHT PRODUCT OF WANG LAB
ORATORIES INC., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0020 REM ---------- VARIABLES ----------
0030 DIM F$(12,126)1,Q6$31,G$10,T$(128)2,N$8,N1$8,D$3,H$(12)1,F$4,Q1$1,P$3,
W3$3,Q$1,R,A$2,Q0$1
0040 REM A$ = CHANNEL TO SKIP TO (FOR TEST OF VFU)
0050 REM F$( = SCREEN BUFFER
0060 REM E = CURRENT ARRAY ROW POSITION
0070 REM E1 = CURRENT ARRAY COLUMN POSITION
0080 REM I = CURRENT COLUMN BEING DISPLAYED
0090 REM L = NUMBER OF LINES PER PAGE
0100 REM L1 = NUMBER OF LINES PER INCH
0110 REM L2 = BOTTOM OF FORM LOCATION
0120 REM P = NUMBER OF LINES DISPLAYED
0130 REM P1 = RELATIVE LINE COUNTER
0140 REM Q$ = OPERATOR'S INPUT (ONE BYTE)
0150 REM Q6$ = WORK VARIABLE
0160 REM R = DEVICE NUMBER (DEFFN'205)
0170 REM T$( = OUTPUT BUFFER (ACTUAL VFU)
0180 REM W3$ = DEVICE ADDRESS (DEFFN '205)
0190 REM -------------------------------
0200 SELECT PRINT 005(80)
0210 PRINT HEX(030E); TAB(15);"2 2 7 3 D A V F U D A T A P R E P A R
A T I O N"
: PRINT
0215 $PSTAT = "@2273VFU"
0220 F$() =ALL(00)
0240 H$() = HEX(010204081020010204081020)
0250 REM ---------- INPUT VFU ----------
0260 PRINT HEX(0E);"Purpose: "; HEX(0F);"This program facilitates the preparat
ion of 2273 DAVFU format data when the Forms Length Selector
(FLS) is inadequate for forms control. Note, however, that FLS
is more convenient for most printing."
0270 PRINT "Format data can be created, edited, and saved on disk for later
loading into the DAVFU. Format data is saved in a standard
2200 data file, named by the user.";HEX(0D0A0A);
0280 PRINT HEX(0E);"When using DAVFU sequences, the following control codes
are effective:";HEX(0D0A); TAB(7);"HEX(0B) - Vertical Tab (as specified
in channel two)";HEX(0D0A);TAB(7); "HEX(0C) - Top of form (as specified i
n channel one)"; HEX(0D0A);
0290 PRINT TAB(7);"HEX(1F0X) - Vertical tab (as specified in channel X)";
0300 PRINT HEX(0D0A0E); "Note: Programs using DAVFU control sequences can load
a previously defined sequence by executing the following stat
ements in the application program:";
0310 PRINT " DIM T$(128)"; HEX(0D0A090909090909); "DATA LOAD DC OPEN T'fi
lename' : REM 'filename' = name of the user file"; HEX(0D0A090909090909);
"DATA LOAD DC T$()"; HEX(0D0A090909090909); "$GIO/xyy, (A000,G$) T$() :
REM xyy represents the printer address";
0320 PRINT HEX(020404000E); AT(23,32); "Press 'RETURN'";HEX(020402000F);
0330 KEYIN K$,,330
0340 ON POS(HEX(0D)<>K$) GOTO 330
0350 Q1$ = "N"
0360 REM % ANY USER FILE?
: PRINT AT(1,0,);
: LINPUT "Do you want to load VFU from a file?",-Q1$
: ON POS("YyNn"=Q1$) GOTO 370,370,590,590
: ELSE GOTO 360
0370 REM %USER ROUTINE FOR LOADING DAVFU (FILE NAME SPECIFIED)
: PRINT AT(1,0,80);AT(2,0);HEX(0D);
: LINPUT "Name of file containing VFU? "-N$
0380 D$ = "310"
0390 PRINT AT(3,0,39);
: LINPUT "Device address?",-D$
: GOSUB ' 205(1,D$)
: IF Q$ <> " " THEN 390
0400 LIMITS T#1, N$,A,A,A,A
: ERRORPRINT HEX(070E);AT(3,0);"Error "; ERR; " at address "; D$;
: LINPUT Q$
: GOTO 370
0410 IF A <> 2 THEN 370
0420 DATA LOAD DC OPEN T#1, N$
: ERRORPRINT HEX(070E);AT(3,0);"Error "; ERR; " at address "; D$;
: LINPUT Q$
: GOTO 370
0430 DATA LOAD DC #1, Q6$,T$(),L,L1,L2
: ERRORPRINT HEX(070E);AT(3,0);"Error "; ERR; " at address "; D$;
: LINPUT Q$
: GOTO 370
0440 REM MAKE SURE IT IS A VFU FILE
: IF Q6$ <> "THIS FILE CONTAINS A VFU FORMAT" THEN 370
0450 REM %^ CONVERT REAL IMAGE TO DISPLAY IMAGE
0460 REM %ODD BYTES GO TO THE FIRST LINE OF F$(
: FOR I = 3 TO POS(T$()=HEX(1E))-2 STEP 2
: STR(F$(),INT(I/2),1) = STR(T$(),I,1)
: NEXT I
0470 REM %EVEN BYTES GO TO THE SEVENTH LINE OF F$(
: FOR I = 4 TO POS(T$()=HEX(1E))-1 STEP 2
: STR(F$(),755+INT(I/2)-MOD(I,2),1) = STR(T$(),I,1)
: NEXT I
0480 F$() = XOR ALL(40)
: REM STRIP 40th BIT FROM F$(
0490 REM % INITIALIZE FIRST SIX ELEMENTS OF ARRAY WITH CHANNEL NUMBERS
: FOR I = 2 TO 6
: STR(F$(),I*126-125,L) = ALL(H$(I))
: NEXT I
0500 REM % INITIALIZE SECOND SIX ELEMENTS OF ARRAY WITH CHANNEL NUMBERS
: FOR I = 8 TO 12
: STR(F$(),I*126-125,L) = ALL(H$(I))
: NEXT I
0510 REM %DISTRIBUTE FOUND TABS THROUGH ALL LINES
0520 REM %FIRST SIX ELEMENTS
: FOR I = 2 TO 6
: REM TURN 'CHANNEL' BITS ON
: STR(F$(),I*126-125,L) = AND STR(F$(),1,L)
: REM GET RID OF USED BITS
: STR(F$(),1,L) = SUB STR(F$(),I*126-125,L)
: NEXT I
0530 REM %LAST SIX ELEMENTS
: FOR I = 8 TO 12
: REM TURN 'CHANNEL' BITS ON
: STR(F$(),I*126-125,L) = AND STR(F$(),7*126-125,L)
: REM GET RID OF USED BITS
: STR(F$(),7*126-125,L) = SUB STR(F$(),I*126-125,L)
: NEXT I
0540 REM % TRANSLATE CHANNEL NUMBERS INTO TABS
: FOR I = 1 TO 12
: F$ = "T"&H$(I)&HEX(2E00)
: $TRAN(STR(F$(),I*126-125,L),F$)R
: NEXT I
0550 REM DISPLAY PARAMETERS
0560 PRINT AT(4,0); "No. of lines per page - "; L; AT(5,0); "No. of lines p
er inch - "; L1; AT(6,0);
: IF L2 <> 0 THEN PRINT "Bottom of form is at line "; L2
: ELSE PRINT "No Bottom of form"
0570 GOTO 660
0580 REM % OPERATOR'S INPUT
0590 PRINT AT(1,0,80);AT(2,0);
: INPUT "No. of lines per page",L
: ERRORGOTO 590
0600 IF L>126 OR L<18 OR INT(L) <> L THEN 590
0610 PRINT AT(3,0);
: INPUT "No. of lines per inch",L1
: ERRORGOTO 610
0620 IF L1<>6 AND L1<>8 OR INT(L1) <> L1 THEN 610
0630 PRINT AT(4,0);
: INPUT "Bottom of form is at line (0 = No Bof)",L2
: ERRORGOTO 630
0640 IF L2>L OR L2<0 OR INT(L2) <> L2 THEN 630
0650 F$() = ALL(".")
: REM DEFAULT FORMAT FOR TAPE
: F$(1,1) = "T"
: IF L2 >0 THEN F$(1,L2),F$(2,L2)="T"
0660 PRINT AT(2,40); "\C5\EE\F4\E5\F2 'T' for TAB stops,"; AT(3,40);"Back spac
e and space to delete them.";
: PRINT AT(4,40);"T in channel 1 is TOF (only 1 allowed).";
: PRINT AT(5,40);"T in channels 1 & 2 (same line) is BOF."; AT(7,0,);
0670 PRINT AT(8,50);"To move cursor use:";AT(9,49); BOX(8,27);AT(9,50);
0680 PRINT "S.F.'4 - LAST LINE";AT(10,50);"S.F.'5 - NEXT LINE"; AT(11,50)
; "S.F.'6 - PREVIOUS LINE"; AT(12,50);"S.F.'7 - FIRST LINE ";
0690 PRINT AT(13,50);"S.F.'12 - NEXT CHANNEL"; AT(14,50);"S.F.'13 - PREVIO
US CHANNEL";AT(15,50);"S.F.'20 - DONE EDITING";AT(16,50);" FN - RESTA
RT";
0700 REM % STATIC DISPLAY
: PRINT AT(7,0);
: Q6$ = HEX(09090909090909090909) & "CHANNEL" & HEX(0D0A0D)&"L" &HEX(0D)&"I
"&HEX(0D)&"N"&HEX(0D)&"E"
: PRINT Q6$;
: PRINT AT(8,11);"1 2 3 4 5 6 7 8 9 10 11 12"; AT(9,11);"---------
-------------------------";
0710 REM MAIN LINE
0720 REM FIRST ROW AND COLUMN; FIRST RELATIVE LINE ON SCREEN
: P = 0
: E,E1,P1 = 1
0730 REM DISPLAY DINAMIC SCREEN (FIRST TIME THROUGH)
: GOSUB '90(E)
0740 REM % CLEAR BUFFER AND ACCEPT OPERATOR INPUT
: KEYIN Q$,740,740
: KEYIN Q$,,750
: ON POS(HEX(0D542E2008)=Q$) GOTO 770,790,800,810,820
: ELSE GOTO 740
0750 REM % SPECIAL FUNCTION KEY
: ON POS(HEX(040506070C0D14)=Q$) GOTO 830,860,880,840,850,870,960
: ELSE GOTO 740
0760 REM % EDIT VFU
0770 REM %Q$ = HEX(0D) ==> GET TO NEXT LINE
: IF P1 >= 14 THEN 780
: P1=P1+1
: E = E + 1
: PRINT AT(9+P1,8+E1*3);
: GOTO 740
0780 REM FIRST LINE OF NEXT COLUMN
: E = E - 13
: IF E1>=12 THEN E1=1
: ELSE E1 = E1+1
: P1 = 1
: PRINT AT(9+P1,8+E1*3);
: GOTO 740
0790 REM %Q$ = "T" ==> PUT TAB IN CURRENT POSITION
: IF E1 = 1 XOR E = 1 OR (E+1)*SGN(L2)>L2 THEN 740
: F$(E1,E) = "T"
: PRINT AT(9+P1,8+E1*3);"T";HEX(08);
: GOTO 740
0800 REM %Q$ = "." ==> NO TAB IN CURRENT POSITION
: IF E1=1 AND E=1 OR (E+1)*SGN(L2)>L2 THEN 740
: F$(E1,E) = "."
: PRINT AT(9+P1,8+E1*3);".";HEX(08);
: GOTO 740
0810 REM %Q$ = " " ==> GET TO NEXT COLUMN (DELETE TAB FROM CURRENT ENTRY)
: IF E1 + E <> 2 AND (E+1)*SGN(L2)<=L2 THEN F$(E1,E) = "."
: PRINT AT(9+P1,8+E1*3);F$(E1,E);HEX(08);
: E1 = MIN(12,E1+1)
: PRINT AT(9+P1,8+E1*3);
: GOTO 740
0820 REM %Q$ = BACKSPACE ==> GET TO PREVIOUS COLUMN (DESTRUCTIVE BACKSPACE)
: E1 = MAX(1,E1-1)
: IF E1 + E <> 2 AND (E+1)*SGN(L2)<=L2 THEN F$(E1,E) = "."
: PRINT AT(9+P1,8+E1*3);F$(E1,E);HEX(08);
: GOTO 740
0830 REM %Q$ = S.F. '4 ==> GO TO THE END OF TAPE
: IF E = L OR E+14-P1 >= L THEN 740
: E = L - 13
: GOSUB '90(E)
: PRINT AT(10,8+E1*3);
: P1=1
: GOTO 740
0840 REM %Q$ = S.F. '7 ==> GOTO BEGINNING OF TAPE
: E = 1
: GOSUB '90(E)
: PRINT AT(10,8+E1*3);
: GOTO 740
0850 REM %S.F.'12 ON ENTRY ==> ADVANCE ONE COLUMN
: IF E1 >= 12 THEN 740
: E1 = E1+1
: PRINT AT(9+P1,8+E1*3);
: GOTO 740
0860 REM %S.F.'5 ON ENTRY ==> GO DOWN ONE ROW
: IF E >= L THEN 740
: E = E+1
: IF P1>=14 THEN P1=1
: ELSE P1=P1+1
: IF P1 = 1 THEN GOSUB '90(E)
: PRINT AT(9+P1,8+E1*3);
: GOTO 740
0870 REM %S.F. '13 ON ENTRY ==> GO BACK ONE COLUMN
: IF E1 = 1 THEN 740
: E1 = E1-1
: PRINT AT(9+P1,8+E1*3);
: GOTO 740
0880 REM %S.F.'6 ON ENTRY ==> GO UP ONE ROW
: IF E <= 1 THEN 740
: P1=P1-1
: IF P1 >= 1 THEN 890
: GOSUB ' 90(MAX(E-14,1))
: P1 = 14
0890 E = MAX(E-1,P1)
: PRINT AT(9+P1,8+E1*3);
: GOTO 740
0900 REM % DISPLAY DYNAMIC SCREEN
0910 DEFFN ' 90(J)
: P = 1
0920 REM %DISPLAY FRAME
: FOR I = J TO MIN(L,J+13)
: PRINT HEX(06);AT(9+P,1,4);I;AT(9+P,9);
: IF MOD(I,L1)=1 THEN PRINT "+!";AT(9+P,45);"!+";
: ELSE PRINT "-!";AT(9+P,45);"!-";
: PRINT AT(9+P,11);
0930 REM %DISPLAY 14 ROWS
: REM ----- FIRST SIX ELEMENTS
: PRINT F$(1,I);TAB(14);F$(2,I);TAB(17);F$(3,I);TAB(20);F$(4,I);TAB(23);F$(
5,I);TAB(26);F$(6,I);
: REM ----- LAST SIX ELEMENTS
: PRINT TAB(29);F$(7,I);TAB(32);F$(8,I);TAB(35);F$(9,I);TAB(38);F$(10,I);TA
B(41);F$(11,I);TAB(44);F$(12,I);
: P = P + 1
: NEXT I
0940 IF P > 14 THEN 950
: FOR I = P TO 14
: PRINT AT(9+I,0,47);
: NEXT I
0950 PRINT HEX(05);
: IF MOD(E,14)<>0 THEN PRINT AT(9+MOD(E,14),8+E1*3);
: ELSE PRINT AT(23,8+E1*3);
: RETURN
0960 REM % FORMAT CHECK-OUT
: PRINT AT(18,48);
: Q1$ = "Y"
: LINPUT "Is Format OK? "-Q1$
: ON POS("YyNn"=Q1$) GOTO 980,980,720,720
: ELSE GOTO 960
0970 REM TRANSLATE TABS INTO CHANNEL NUMBERS
0980 REM %TRANSLATE TABS INTO CHANNEL NUMBERS
: FOR I = 1 TO 12
: F$ = H$(I) & "T" & HEX(002E)
: $TRAN (STR(F$(),I*126-125,L),F$)R
: NEXT I
0990 REM %ACUMULATE CHANNEL BITS IN FIRST LINE
: FOR I = 2 TO 6
: STR(F$(),1,L) = OR STR(F$(),I*126-125,L)
: NEXT I
1000 REM %ACUMULATE CHANNEL BITS IN SEVENTH LINE
: FOR I = 8 TO 12
: STR(F$(),7*126-125,L) = OR STR(F$(),I*126-125,L)
: NEXT I
1010 REM TURN 40th BIT ON
: F$() = OR ALL(40)
1020 REM %PUT IMAGE INTO PRINTER BUFFER
: FOR I = 1 TO L
: T$(I) = F$(1,I) & F$(7,I)
: NEXT I
1030 REM %PUT CONTROL BYTES
1040 STR(T$(),L*2+1) = HEX(1E0F) & ALL(00)
: ROTATEC(T$(),-8)
: ROTATEC (T$(),-8)
: STR(T$(),,2) = HEX(021D)
1050 P$ = "215"
1060 REM
: PRINT AT(19,48);
: LINPUT "Enter Printer Address"-P$
: GOSUB ' 205 (15,P$)
: IF Q$ <> " " THEN 1060
1070 REM ---------- LOAD VFU INTO PRINTER
: $GIO LOAD VFU #15,(A000,G$) T$()
: PRINT AT(9,49); BOX(-8,-27);
1080 REM % GIVE TEST OPTION
: PRINT AT(7,0,); AT(8,0);
: LINPUT "VFU loaded, do you want to test format?",-Q1$
: ON POS("YyNn"=Q1$) GOTO 1090,1090, 1130, 1130
: ELSE GOTO 1080
1090 REM % TEST VFU (TRY SPECIFIED CHANNEL)
: SELECT PRINT 005
: PRINT AT(8,45);
: INPUT "Channel No.? (0=end)", Q1
: ERRORGOTO 1090
1093 IF Q1 = 0 THEN 1120
: IF Q1 < 0 OR Q1 > 12 OR INT(Q1) <> Q1 THEN 1090
1095 REM DETERMINE TAB STOPS IN SPECIFIED CHANNEL
: J1=0
: FOR I = 3 TO MAX(L2,(-SGN(L2)+1)*L+1)
: A$ = ALL(H$(Q1)) AND T$(I)
: IF STR(A$,-INT(-Q1/6),1) <> HEX(00) THEN J1 = J1+1
: NEXT I
: IF J1<=0 THEN 1090
1115 SELECT PRINT <P$>
: A$ = HEX(1F) & BIN(Q1)
: PRINT HEX(0C)
1117 FOR J = 1 TO J1
: PRINT A$; "TAB STOP # ";J
: NEXT J
: GOTO 1090
1120 REM ----------
: LINPUT "Is format OK?",-Q1$
: ON POS("YyNn"=Q1$) GOTO 1130,1130, 650,650
: ELSE GOTO 1120
1130 REM % OUTPUT TO DISK?
: LINPUT "Do you want to save VFU?",-Q1$
: ON POS("YyNn"=Q1$) GOTO 1140,1140,1200,1200
: ELSE GOTO 1130
1140 REM % CREATE VFU FILE
: PRINT AT(11,0);
: LINPUT "Enter Output File Name"-N1$
1150 PRINT AT(11,40);
: LINPUT "Enter Device address",-D$
: GOSUB ' 205(2,D$)
: IF Q$ <> " " THEN 1150
: LIMITS T#2, N1$ ,A,A,A,A
: ERRORPRINT AT(11,0,35); HEX(070E); "ERROR "; ERR; "AT ADDRESS "; D$;
: LINPUT Q$
: GOTO 1140
1160 IF A = 0 THEN 1190
1170 PRINT AT(12,0); N1$;" Already Exists, OK to Overwrite?";
: Q1$ = "N"
: LINPUT Q1$
: ON POS("YyNn"=Q1$) GOTO 1180,1180,1140,1140
: ELSE GOTO 1170
1180 REM SCRATCH OLD FILE
: SCRATCH T#2, N1$
: ERRORPRINT AT(11,0,35); HEX(070E); "ERROR "; ERR ; "AT ADDRESS "; D$
: LINPUT Q$
: GOTO 1140
1190 REM RE-OPEN
: IF A <> 0 THEN DATA SAVE DC OPEN T#2, N1$,N1$
: ELSE DATA SAVE DC OPEN T#2,(4) N1$
: REM SAVE VFU
: Q6$ = "THIS FILE CONTAINS A VFU FORMAT"
: DATA SAVE DC #2, Q6$,T$(),L,L1,L2
: DATA SAVE DC #2, END
1200 REM ANOTHER VFU?
: PRINT AT(13,0);
: LINPUT "Another VFU? (Y/N)",-Q1$
: ON POS("YyNn"=Q1$) GOTO 200,200,1210,1210
: ELSE GOTO 1200
1210 END
1220 REM % VALIDATE AND SELECT DISK OR PRINTER ADDRESS
1230 DEFFN ' 205 (R,W3$)
: Q$ = " "
: MAT SEARCH "310320321325330350360370B10B20B21B22B30B50B60B70D10D11D12D13D
14D15D20D21D22D23D24D25D30D31D32D33D34D35D50D51D52D53D54D55D60D61D62D63D6
4D65D70D71D72D73D74D7500001D204211212213214215216217005", = STR(W3$,,3) T
O Q6$ STEP 3
1240 IF STR(Q6$,,2) <> HEX(0000) THEN SELECT #R <W3$>
: ELSE Q$ = "I"
: RETURN