image of READY prompt

Wang2200.org

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

# Sector 179, program filename = 'GBS'
0010 REM GBS,RELEASE 2.3, (12/11/80) THIS PROGRAM IS A COPYRIGHT PRODUCT OF
      WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0170 COM @Q8$18,@T5$10,@V$18,@T
   : COM @V4$(8)5,@Q,@Q$17,@Q9$17,@Q0$49,@T$(8)17
   : COM @Q1,@I0$5,I
   : DIM Q$(2)80,Q6$80,Q7$80,Q3,Q4,Q5,Q6,Q7,Q8,Q9,U9$8,U9
   : GOTO 4000
3638 DEFFN'100(Q$(1),Q$(2),Q3,Q4,Q7$,Q5)
   : Q6=Q9
   : SELECT PRINT 005(80)
   : IF Q7$<>" "THEN PRINT HEX(010A);Q7$;TAB(80)
3646 KEYIN Q7$,3646,3646
3650 Q7$=" "
   : Q7=Q3+Q4+2+17*(1-ABS(SGN(Q3+Q4)))
   : IF Q5>1THEN Q7=Q3+64*(1-ABS(SGN(Q3)))
   : PRINT AT(2,0,80);
   : IF Q5>-1AND Q5<3THEN 3668
   : STR(Q6$,Q7+1)=" "
   : LINPUT -STR(Q6$,,Q7)
   : GOTO 3694
3668 Q6$=ALL(8B)
   : IF Q5>1THEN 3688
   : STR(Q6$,Q3+1,1)="."
   : STR(Q6$,Q7)=" "
   : Q7$="Default = "&Q6$&"-"
   : $TRAN(Q7$,HEX(238B))R
   : PRINT AT(2,Q7+3);
   : IF Q5=0THEN PRINTUSING Q7$,Q9;
   : PRINT HEX(0D)
   : Q7$=Q6$
3688 LINPUT ?STR(Q6$,,Q7)
   : IF Q5=0AND Q6$=Q7$THEN Q7=0
   : IF Q5=1AND Q6$=Q7$THEN Q6$="0"
3694 $TRAN(Q6$,HEX(208B))R
   : IF Q7$=HEX(0F)THEN 3650
   : IF Q6$=HEX(1F)THEN 3728
   : IF Q5>1THEN 3734
   : $TRAN(STR(Q6$,POS(Q6$=".")+1)," .")R
   : $TRAN(Q7$,HEX(238B))R
   : IF Q7=0THEN CONVERT Q9TO Q6$,(Q7$)
   : CONVERT Q$(1)TO Q7
   : ERRORQ7=0
3712 CONVERT Q$(2)TO Q8
   : ERRORQ8=0
3714 CONVERT Q6$TO Q9
   : ERRORGOTO 3760
3718 IF Q3+Q4=0THEN 3724
   : IF ABS(Q9)>=10^ABS(Q3)OR INT(Q9*10^Q4)<>Q9*10^Q4THEN 3760
3724 IF Q7=0AND Q8=0THEN 3728
   : IF Q9<Q7OR Q9>Q8THEN 3760
3728 PRINT AT(1,0,240)
   : RETURN
3734 IF Q$()=" "THEN 3728
   : IF Q4=0AND Q$(1)<=Q6$AND Q$(2)>=Q6$THEN 3728
   : Q7$=HEX(07)
   : IF Q4=0THEN 3756
   : IF Q4=1THEN $TRAN(STR(Q6$,,Q3),Q$(2))R
   : Q7=LEN(Q$(1))
   : MAT SEARCHSTR(Q$(1),,Q7),=STR(Q6$,,Q3)TO STR(Q7$,,2)STEP Q3+1
   : Q9=INT((VAL(Q7$,2)+Q3)/(Q3+1))
   : IF Q9>0THEN 3728
   : Q7$=" - "&STR(Q$(1),,Q7)&HEX(07)
3756 PRINT AT(3,0,80);"Re-enter.";Q7$
   : GOTO 3650
3760 Q7$=HEX(07)
   : IF Q$()=" "THEN 3756
   : PRINT AT(3,0,80);Q7$;"Re-enter, ";Q7;"<= X <=";Q8
   : Q9=Q6
   : GOTO 3650
3810 DEFFN'121(U9$)
   : Q6,Q7,Q8,U9=0
   : IF POS(U9$=".")>0THEN 3834
   : $UNPACK(D=HEX(002F))U9$TO Q6,Q7,Q8
   : ERRORQ6=0
3816 IF Q6<1OR Q6>12OR Q8<1OR Q8>99THEN 3834
   : Q6$=HEX(001F1C1F1E1F1E1F1F1E1F1E1F)
   : IF MOD(Q8,4)=0THEN STR(Q6$,3,1)=HEX(1D)
   : IF Q7<1OR Q7>VAL(STR(Q6$,Q6+1,1))THEN 3834
   : ADD(STR(Q6$,,Q6),STR(Q6$,2,Q6))
   : U9=Q8*1E3+VAL(Q6$)+INT(Q6/9)*256-VAL(STR(Q6$,Q6+1,1))+Q7
   : RETURN
3834 Q6$="E"
   : RETURN
3840 DEFFN'123(Q9)
   : U9$=" "
   : IF Q9<=0THEN 3834
   : Q9=INT(Q9)
   : Q7=INT(365.25*(INT(Q9/1E3)-1))+MOD(Q9,1E3)
   : Q9=INT(Q7/365.25)
   : Q9=Q9-1+SGN(Q7-INT(365.25*Q9))
   : U9=Q9*1E3+(Q7-INT(365.25*Q9))+1E3
   : Q9=INT(U9/1E3)
   : Q6$=HEX(001F3B5A7897B5D4F311304E6D)
   : IF MOD(Q9,4)=0THEN STR(Q6$,3)=ADDALL(HEX(01))
   : FOR Q6=1TO 12
3866 IF VAL(STR(Q6$,Q6+1,1))+INT(Q6/9)*256>=U9-Q9*1E3THEN 3870
   : NEXT Q6
3870 Q7=U9-Q9*1E3-VAL(STR(Q6$,Q6))-INT(Q6/10)*256
   : CONVERT Q6*1E6+Q7*1E3+Q9TO U9$,(########)
   : U9$=XOR HEX(00001F00001F0000)
   : RETURN
4000 SELECT PRINT 005(80),LIST 005(80),CO 005(80)
   : PRINT HEX(03)
4020 GOSUB '100(HEX(00),HEX(7F),8,0,"ENTER TODAY'S DATE  (MM/DD/YY)",2)
   : GOSUB '121(Q6$)
   : IF Q6$<>"E"THEN 4070
   : PRINT AT(3,0,80);"Invalid date, Re-enter.";HEX(07)
   : GOTO 4020
4070 @Q1=U9
   : GOSUB '123(@Q1)
   : PRINT HEX(0305);U9$,@Q1
   : Q6$="Y"
   : GOSUB '100("N,Y","NnYyY ",1,1,"IS DATE OK  (Y OR N)",3)
   : IF Q6$="N"THEN 4020
   : PRINT HEX(03)
   : COM CLEAR I
   : @T=0
   : @T$(),@V4$()=ALL(FF)
   : @Q=1
   : @V$=HEX(5001A002A002A0025004A001A002A002A001)
   : @T5$=HEX(A003A01EA001A008A002)
4220 @Q8$=HEX(A0026001A003600160016001600160026002)
   : LOAD T"@GBS"
9998 DEFFN'29"Q$=";HEX(22);"GBS";HEX(22);":SCRATCH TQ$:SAVET$()Q$";HEX(0D)