Listing of file='IDS2PC11' on disk='vmedia/701-2725B.wvd.zip'
# Sector 690, program filename = 'IDS2PC11'
1000 REM "IDS2PC11" --- SCREEN CONVERSION , PART 4- CONVERT FIELD PARAMETERS
1010 IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM"
: MAT REDIM E3$(249)8
: DIM J2$(24)83,J4$8,E3(9),J4$(250)9,J5$(128)8,J1$(128)8,J3$(1)9
: FOR I=1TO 9
: READ E3(I)
: NEXT I
: DATA 0,2,1,3,4,5,6,7,9
: J4$()=ALL(00)
: J0$=HEX(1001100110041002100210021001)
: X,Y=1
: GOSUB '39(F1$,D1)
: MAT REDIM F$(256)1
: A=A+8
1080 FOR I=1TO 769STEP 256
: DATA LOAD BA T#P,(A,A)F$()
: MAT COPY F$()<1,256>TO J5$()<I,256>
: NEXT I
: FOR I=1TO 769STEP 256
: DATA LOAD BA T#P,(A,A)F$()
: MAT COPY F$()<1,256>TO J1$()<I,256>
: NEXT I
: MAT REDIM F$(E9)1
: INIT(00)E8$
: MAT SEARCHJ5$(),=STR(E8$,,8)TO F9$STEP 8
: F0=128
: IF F9$=HEX(0000)THEN 1110
: F0=(VAL(F9$,2)-1)/8
1110 IF J3$=" "THEN 1120
: J4$=J3$OR ALL(20)
: GOSUB '39(J4$,D3)
: IF Q<2THEN STOP "Illegal Data File"
: DATA LOAD DA T#P,(A+8)J2$()
1120 GOTO 1850
1130 MAT C=ZER
: UNPACK(#############)J5$(S)TO Q
: CONVERT QTO E$,(#############)
: $UNPACK(F=J0$)E$TO C(6),C(13),C(3),C(5),R,C(2),M
: R=R*.25
: C(1)=INT(R)+1
: C(2)=C(2)+1
: R=4*(R-INT(R))
: ON R+1GOTO 1160,1140,1150
1140 C(7)=1
: IF R=1THEN 1160
1150 C(8)=1
1160 C(4)=INT(127.5-VAL(STR(J5$(S),8,1)))
: IF M<4THEN 1170
: C(9)=1
: M=M-4
1170 IF M<2THEN 1180
: M=M-2
: C(10)=1
1180 IF M=0THEN 1190
: C(14)=1
1190 E6$=HEX(03)
: AND (E6$,STR(J5$(S),7,1))
: M=VAL(E6$)
: ON VAL(E6$)+1GOTO 1220,1210,1200,1200
1200 C(12)=1
1210 C(11)=1
1220 RETURN
1850 PRINT AT(23,0,80);
: FOR S=1TO F0
: IF E0$<>"IDS2sS01"THEN GOSUB '33("IDS2sS01")
: PRINT AT(23,20);BOX(1,43);AT(23,22);HEX(0F);"Converting parameters for Fi
eld: ";HEX(020402000E);J1$(S);TAB(70);
: J4$=" "
: IF J3$=" "THEN 1900
: MAT SEARCHJ2$(),=J1$(S)TO F9$STEP 8
: IF F9$<>HEX(0000)THEN J4$=J3$
1900 STR(E$(),,8)=J4$
: IF J4$=" "THEN E$="0"
: ELSE E$="1"
: STR(E$(),56,1)=E$
: STR(E$(),9,8)=J1$(S)
: GOSUB 1130
: CONVERT C(1)TO E$,(##)
: STR(E$(),17,2)=E$
: CONVERT C(2)TO E$,(##)
: STR(E$(),19,2)=E$
1910 CONVERT C(5)TO E$,(###)
: STR(E$(),21,3)=E$
: CONVERT C(3)TO E$,(####)
: STR(E$(),24,4)=E$
: CONVERT E3(C(6))TO E$,(#)
: STR(E$(),28,1)=E$
: IF C(11)=1THEN STR(E$(),29,1)="Y"
: ELSE STR(E$(),29,1)="N"
1920 IF C(12)=0THEN STR(E$(),30,1)="N"
: ELSE STR(E$(),30,1)="Y"
: IF C(13)>7THEN C(13)=7
: CONVERT C(13)TO E$,(#)
: STR(E$(),31,1)=E$
: IF C(8)=0THEN STR(E$(),32,1)="1"
: ELSE STR(E$(),32,1)="0"
: IF C(7)=0THEN STR(E$(),33,1)="Y"
: ELSE STR(E$(),33,1)="N"
1930 IF C(9)=0THEN STR(E$(),34,1)="N"
: ELSE STR(E$(),34,1)="Y"
: IF C(10)=0THEN STR(E$(),35,1)="N"
: ELSE STR(E$(),35,1)="Y"
: IF C(14)=1THEN STR(E$(),36,1)="Y"
: ELSE STR(E$(),36,1)="N"
: STR(E$(),37,4)="NNNN"
: IF C(4)>0THEN 1950
: STR(E$(),41,8)=" "
: GOTO 1960
1950 STR(E$(),41,8)=" "
1960 STR(E$(),49,3)="NNN"
: STR(E$(),52,3)=" 0"
: CONVERT STO STR(E$(),58,3),(###)
: STR(E$(),61,8)=J2$
: F=16
: GOSUB 2050
: NEXT S
: GOTO 2580
2010 DEFFN'71(F1)
: GOSUB '43(F1)
: IF E$<>"Y"THEN X=0
: ELSE X=1
: RETURN
2020 DEFFN'76(F1,Y,Z)
: GOSUB '71(F1)
2030 DEFFN'77(Y,Z)
: STR(J3$(),Y,1)=STR(J3$(),Y,1)OR BIN(X*Z)
: RETURN
2040 DEFFN'72(F1,Y,Z)
: GOSUB '43(F1)
: X=Q
: GOTO 2030
2050 GOSUB '43(5)
: J3$(1)=BIN(Q)&ALL(00)
: GOSUB '43(6)
: STR(J3$(),2,2)=BIN(Q*16,2)
: GOSUB '76(13,3,8)
: GOSUB '76(14,3,4)
: GOSUB '76(8,3,2)
: GOSUB '76(9,3,1)
: GOSUB '72(3,4,8)
: R=Q-1
: ADD(STR(J3$(),4,1),F8)
: GOSUB '72(10,4,1)
: GOSUB '72(4,5,2)
: C=Q-1
: ADD(STR(J3$(),5,1),FE)
: GOSUB '76(12,5,1)
: GOSUB '72(7,6,16)
: GOSUB '43(1)
: X=1
: IF Q>0THEN GOSUB '77(6,Q)
2170 GOSUB '72(11,7,64)
: GOSUB '76(23,6,8)
: GOSUB '77(7,0)
: GOSUB '76(16,8,32)
: GOSUB '76(15,8,2)
: GOSUB '43(34)
: I=Q
: GOSUB '43(2)
: E3$(I)=E$
: J4$(I)=J3$()
: RETURN
2550 STOP #
2580 F5$="IDS2wS"
: CONVERT R0TO STR(F5$,7),(##)
: LIMITS T#3,F5$,A,B,C,D
2610 IF D=2THEN 2620
: STOP "WORK FILE DOES NOT EXIST -- THAT'S IMPOSSIBLE!! "
: GOTO 2610
2620 DATA LOAD DC OPEN T#3,F5$
: MAT REDIM E$(24)83
: DATA LOAD DA T#3,(A)E$()
: MAT REDIM E$(E8)1
: X=VAL(E$(137))
: Y=VAL(E$(138))
: D9=F0
: J7=0
: PRINT AT(23,20);BOX(1,43);AT(23,22);"Saving screen specifications to file
";TAB(70);
: P=D2
: GOSUB '39(J2$,P)
: IF Q=0THEN DATA SAVE DC OPEN T#P,(27)J2$
: DATA LOAD DC OPEN T#P,J2$
: MAT REDIM E$(24)83
: DATA SAVE DC #P,E$()
: MAT REDIM E$(E8)1
2730 IF X=0THEN 2800
: F$()=J4$()
: STR(F$(),D9*9+1)=ALL(00)
: MAT REDIM F$(X)83
: DATA SAVE DC #P,F$()
: MAT REDIM F$(E9)1
: IF Y=0THEN 2800
: MAT REDIM E3$(Y)83
: DATA SAVE DC #P,E3$()
: MAT REDIM E3$(249)8
2800 DATA SAVE DC #P,END
: COM CLEAR D1$
: LOAD T#2,"IDS2PCMN"1000,
3699 ON ERRORE1$,E2$GOTO 3700
3700 DEFFN'31
: E$="IDS2PC11"
: IF E5$<"Y"THEN LOAD T#2,"IDS2PER1"1000,
: STOP "ERROR"