image of READY prompt

Wang2200.org

Listing of file='KFAMOPEN' on disk='vmedia/701-2606C.wvd.zip'

# Sector 105, program filename = 'KFAMOPEN'
0010 REM KFAMOPEN, RELEASE 2.1, (04/14/80) THIS PROGRAM IS A COPYRIGHT PRODUCT
      OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0170 COM V7$(Q)8,V0$(Q)14,T5$(Q)58
   : COM T0$16,V7$16,V8,T8,V3$2,V2$2,Q3$2,Q2$2,V8$1,V6$1
   : COM Q2,Q3,Q$1,T6$1,T0,T2$2,T8$1,T$(3)48,T3$3,T7$30,V,T2
   : COM V7,Q,V1,V4$4,S2,V6,T1,V0$2,T$8,T2$(8)2,T9,T1$30,T9$2
   : COM V0,T6,T4$3,T0$(4)60,T4,T3,T5,V9$2,T
0199 GOSUB '99
0579 $BREAK1
0580 IF @T=0THEN @T=S2
   : ELSE GOTO 579
   : RETURN
0590 @T=0
   : RETURN
0726 SELECT @PARTS$
   : IF T9>0AND T6=T9THEN 750
   : IF V0$(T6)=" "THEN 2908
   : GOSUB 858
   : T9=T6
   : $UNPACK(F=@Q8$)V0$(T9)TO V0$,V6,V4$,V0,T2,T4,T5,V7,V1
   : SELECT #T1<V4$>
   : $UNPACK(F=@T5$)T5$(T9)TO T4$,T7$,T8$,T$,T2$()
   : V4$=HEX(A0)&BIN(T4)&HEX(A003)
   : GOSUB 818
   : T9$=HEX(FF)
0750 $CLOSE#T1,#T2
   : IF MOD(V0,2)=0THEN 812
   : Q$=BIN(V6)
   : Q2$=BIN(S2)&Q$
   : MAT SEARCH@V4$(),=STR(Q2$)TO V9$STEP 5
   : T=VAL(V9$,2)
   : IF T>0THEN STR(@V4$(),T,5)=ALL(FF)
   : GOSUB 580
   : STR(@Q$,@Q)=STR(Q2$,,1)
   : STR(@Q9$,@Q)=Q$
   : STR(@Q0$,@Q*3-2)=STR(@T$(V6),4,3)
   : @Q=@Q+1
0784 MAT SEARCH@Q0$,=STR(@T$(V6),4,3)TO V7$STEP 3
   : IF VAL(STR(@Q$,(VAL(V7$,2)+2)/3))=S2THEN 794
   : @T=0
   : $BREAK1
   : GOSUB 580
   : GOTO 784
0794 @T=0
   : HEXUNPACKSTR(@T$(V6),10)TO V7$
   : T8$=STR(V7$,S2)
   : HEXPACKQ$FROMT8$
   : Q$=AND HEX(60)
   : IF Q$>HEX(20)THEN GOSUB 818
   : Q$=AND HEX(20)
   : IF Q$=HEX(20)THEN T6$=BIN(0)
0812 IF V>4AND VAL(T6$)<>T9THEN 873
   : RETURN
0818 $UNPACK(F=@V$)STR(@T$(V6),7)TO T0,T2$
   : RETURN
0824 HEXUNPACKSTR(@T$(V6),10)TO V7$
   : STR(V7$,S2,1)=T8$
   : HEXPACKSTR(@T$(V6),10)FROMV7$
   : RETURN
0858 IF T9>0THEN $PACK(F=@T5$)T5$(T9)FROMT4$,T7$,T8$,T$,T2$()
   : RETURN
0873 DATA LOAD DA T#T1,(V0$)Q2,T$()
   : T6$=BIN(T9)
   : RETURN
0908 Q2$=BIN(S2)
   : T=POS(@Q$=Q2$)
   : STR(@Q9$,T)=STR(@Q9$,T+1)
   : STR(@Q$,T)=STR(@Q$,T+1)
   : STR(@Q0$,T*3-2)=STR(@Q0$,T*3+1)
   : @Q=@Q-1
   : GOTO 590
1435 SELECT @PARTS0$
   : RETURN
2090 DIM R9$(16)
2091 DEFFN'230(T6,Q,Q2,Q3,V7$,V,Q7$,V4$,T3$)
   : SELECT @PARTS$
   : IF INT((S2-1)/16)<>0THEN 2911
   : IF V0$(T6)<>" "THEN 2911
   : GOSUB 858
   : T9=0
   : IF V<1OR V>4THEN 2911
   : IF STR(T0$,Q2+1)="X"AND Q3>0THEN 2911
   : IF Q2=15THEN 2911
   : V7$(T6),T$=V7$
   : STR(T$,5,1)="K"
   : CONVERT Q3TO STR(T$,6,1),(#)
   : T1,Q=14
   : T2=Q2
   : V0=V
   : T4$=V4$
2174 IF POS("3BD"=T4$)*POS("123567"=STR(T4$,2))*POS("012345"=STR(T4$,3))=0THEN
      2911
   : SELECT #Q<T4$>
   : $GIO#Q,(70A04000870B,V7$)
   : ERRORGOTO 2911
2184 IF STR(V7$,11,1)<>HEX(D0)AND STR(T4$,3)>"0"THEN 2911
   : IF Q=Q2THEN 2194
   : Q=Q2
   : T4$=T3$
   : GOTO 2174
2194 LIMITS T#T1,T$,V,T3,T,Q
   : $CLOSE#T1
   : IF Q<>2THEN 2911
   : V0$=BIN(V,2)
   : Q2=INT(Q3/10)
   : GOSUB '217(V7$(T6),T2,S2,Q2,V0,Q7$,V9$,0)
   : IF Q$>" "THEN RETURN
   : SELECT @PARTS$
   : GOSUB 873
   : STR(T$(2),13,2)=BIN(T3-V-2,2)
   : T=VAL(STR(T$(2),12))
   : IF T>0THEN STR(T$(2),15,2)=BIN((INT(Q/T)-1)*T,2)
   : ELSE STR(T$(2),15,2)=BIN(52000,2)
   : IF T3$<"8"THEN STR(T3$,3)="1"
2224 HEXPACKQ$FROMSTR(T3$,2)
   : T3$=V4$
   : IF T3$<"8"THEN STR(T3$,3)="1"
   : HEXPACKT8$FROMSTR(T3$,2,2)
   : V7$=STR(V0$)&T8$&STR(V9$)&Q$&ALL(FF)
   : T4=VAL(STR(T$(2),22))
   : T5=T4+3
   : V7=INT(240/T5)*T5
   : V1=V7-T5+1
   : T8$="E"
   : GOSUB 580
   : T3=1
2252 MAT SEARCH@T$(),=STR(V7$,T3,3)TO V9$STEP 17
   : T=VAL(V9$,2)
   : IF T>0THEN 2274
   : T3=T3+6
   : IF T3<8THEN 2252
   : GOSUB 590
   : GOSUB '219(V7$(T6),T2,S2," ",0)
   : Q$="S"
   : RETURN
2274 V6=(T+16)/17
   : IF T3=1THEN 2278
   : STR(@T$(V6),1,9)=STR(V7$,,6)&STR(T$(2),,3)
   : DATA SAVE DA T$#T1,(V0$)0,T$()
2278 $UNPACK(F=@V$)T$(2)TO T0,T2$
   : GOSUB 824
   : GOSUB 590
   : Q$=" "
   : V8=.5
   : T9=T6
   : STR(T0$,T2+1,1)="X"
   : GOSUB 2298
   : GOTO 1435
2298 $PACK(F=@Q8$)V0$(T9)FROMV0$,V6,V4$,V0,T2,T4,T5,V7,V1
   : V4$=HEX(A0)&BIN(T4)&HEX(A003)
   : RETURN
2384 DEFFN'239(T6)
   : Q=0
   : V=5
   : IF T6>0THEN T3$="P"
   : ELSE T3$="S"
   : T6=ABS(T6)
   : GOSUB 726
   : T8$="F"
   : DATA SAVE DA T$#T1,(V0$)0,T$()
   : STR(T0$,T2+1,1)=" "
   : IF V0>2AND T3$="P"THEN GOSUB 2445
   : Q$=" "
   : GOSUB '219(V7$(T9),T2,S2," ",0)
   : SELECT @PARTS$
   : V0$(T9)=" "
   : T9=0
   : GOSUB 580
   : GOSUB 824
   : IF POS(V7$<>"F")=0THEN @T$(V6)=ALL(FF)
   : IF MOD(V0,2)=1THEN GOSUB 908
   : ELSE GOSUB 590
   : GOTO 1435
2445 T6=MOD(VAL(STR(T$(2),4),2)+VAL(STR(T$(2),12)),65536)
   : DATA LOAD DC OPEN T#T2,V7$(T9)
   : DSKIP #T2,T6S
   : SELECT @PARTS0$
   : GOSUB '218(V7$(T9),T2,V9$,0)
   : LIMITS T#T2,V7$(T9),Q2,T,T3
   : T=T-1
   : T9$=HEX(FF)
   : T0$()=HEX(A0FD)&T$()
   : DATA SAVE BA T$#T2,(T)T0$()
   : DATA LOAD DC OPEN T#T2,V7$(T9)
   : RETURN
2504 DEFFN'217(V7$,Q3,S2,Q2,T,Q7$,V9$,T8)
   : $OPEN #Q3
   : LIMITS T#Q3,V7$,Q6,Q7,Q8,Q9
   : Q=Q7-Q6-1
   : V9$=BIN(Q7,2)
   : Q$="D"
   : IF ABS(Q9)=1THEN 2626
2522 IF Q2<=0THEN 2556
   : IF Q9=2THEN 2626
   : Q$="S"
   : T=4
   : IF Q9=0THEN 2548
   : IF Q7-Q6+1<Q2THEN 2626
   : DATA SAVE DC OPEN T#Q3,V7$,V7$
   : GOTO 2560
2548 DATA SAVE DC OPEN T#Q3,Q2,V7$
   : ERRORGOTO 2626
2550 LIMITS T#Q3,Q6,Q7,Q8
   : GOTO 2560
2556 IF Q9<2THEN 2626
2560 GOSUB 2632
   : Q$="M"
   : IF STR(R9$(),4,4)<>HEX(FD4D5558)AND Q2=-2THEN 2626
   : STR(R9$(),9,8)=STR(V7$,,8)
   : IF STR(R9$(),4,4)=HEX(FD4D5558)THEN 2580
   : STR(R9$(),4,5)=HEX(FD)&"MUX "
   : STR(R9$(),17)=Q7$
2580 Q$="A"
   : Q6$=STR(R9$(),33,48)
   : IF STR(Q6$,S2,1)=" "XOR Q2<>-1THEN 2626
   : STR(Q6$,S2,1)=" "
   : ON T-1GOTO 2596,2600,2604
   : T1$=" 1 2 3"
   : GOTO 2602
2596 T1$=" 1 2"
   : GOTO 2602
2600 T1$=" 1 3"
2602 $TRAN(Q6$,T1$)R
2604 IF Q6$<>" "THEN 2626
   : IF Q7$>" "AND R9$(2)>" "THEN GOSUB 2750
   : IF Q$="P"THEN 2626
   : CONVERT TTO STR(R9$(),32+S2,1),(#)
   : GOSUB 2638
   : DATA LOAD DC OPEN T#Q3,V7$
   : Q$=" "
2626 IF T8=0THEN $CLOSE#Q3
   : SELECT @PARTS0$
   : RETURN
2632 DATA LOAD BA T#Q3,(Q7)R9$()
   : RETURN
2638 DATA SAVE BA T#Q3,(Q7)R9$()
   : RETURN
2690 DEFFN'219(V7$,Q3,S2,V9$,T8)
   : $OPEN #Q3
   : LIMITS T#Q3,V7$,Q6,Q7,Q8
   : GOSUB 2632
   : Q$,STR(R9$(),32+S2,1)=" "
   : GOSUB 2638
   : DATA SAVE DC CLOSE#Q3
   : GOTO 2626
2750 Q6$=ALL(81)
   : Q$="P"
   : PRINT AT(1,0);"ENTER PASSWORD FOR ";Q7$;" FILE";AT(2,0);STR(Q6$,,16);AT(2
     ,0)
   : Q6$,T1$=" "
   : Q9=0
2760 KEYIN Q6$,2762,2762
2762 KEYIN Q6$,2766,2766
   : GOTO 2762
2766 IF Q6$=HEX(1F)THEN 2788
   : IF Q6$=HEX(0D)THEN 2780
   : IF Q6$<HEX(1F)THEN 2760
   : Q9=Q9+1
   : STR(T1$,Q9,1)=Q6$
   : PRINT AT(2,Q9);
   : IF Q9<16THEN 2760
2780 Q$=" "
   : IF Q2>0THEN R9$(2)=T1$
   : IF T1$=R9$(2)THEN 2788
   : PRINT AT(3,0,80);"Invalid password, try again.";HEX(07)
   : GOTO 2750
2788 PRINT AT(1,0,240)
   : RETURN
2908 RETURN CLEAR
2911 Q$="X"
   : GOTO 1435
9998 DEFFN'29"Q$=";HEX(22);"KFAMOPEN";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D
     )
9999 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22);
     "GBS/MVP - Open/close KFAM/MUX files";HEX(22);":SELECT#15<I0$>:$OPEN#15:S
     ELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#15:SELECTL
     IST005(80)";HEX(0D)