image of READY prompt

Wang2200.org

Listing of file='@MENU' on disk='vmedia/2282_graphics_crt_demos.wvd.zip'

# Sector 16, program filename = '@MENU'
0010 REM %@MENU  -- SOFTWARE MENU
   : REM 12/31/79 REV 07/09/81 BY R.L.Droz
0020 REM @MENU provides a menu structure for program selection.
   : REM Multiple levels of menu can be set up with each successive screen
   : REM displaying the next menu node.  Node information is overlayed in at
0030 REM lines 9000-9999; each node is saved as a separate program file ('24).
   : REM Access to the root node is always available with RESET & LOADRUN if
   : REM the progam START is this program or loads in this program.
   : REM
0035 REM @MENU1 generally operates under the control of a menu stack
   : REM kept in file @MENUSTK; @MENU is used in the absence of the stack file
0040 REM @MENU is loaded from a program (eg START) that sets $PSTAT=" ".
   : REM $PSTAT indicates which node is to be loaded (if " ", the root node).
   : REM @MENU sets $PSTAT=node-name when a program is selected, so that the
0050 REM program can return to this menu node by overlaying in @MENU.
0060 REM %VARIABLES........
   : COM C9
   : DIM U$8,U1$68,U8$68,U2$30,U6$1,W$(95,3)1,U(5),R$10,W$1,U4$8
0061 REM These variables are not ISS compatible; should be changed
0065 DIM M$(7)33,M1$(7)33,M,S1$64,M0$80
0070 REM Display
   : REM  W$=cursor
   : REM  W1=column#
   : REM  W0=CRT column
   : REM  W5=# CRT columns
   : REM  U3=tab
   : REM  R1=row#
   : REM  R0=CRT row
   : REM  R5=# CRT rows
   : REM  R9=# rows
   : REM  W$(=item coordinates
   : REM  U(i)=length column(i)
0080 REM Node Items
   : REM  U1=# fields/item
   : REM  U$=filename
   : REM  U1$,U8$=description
   : REM  U2$=type
   : REM  W,R=item#
   : REM  R2=data record#
   : REM  U=# extra fields in node descriptor
   : REM  W9=# items (including blank lines)
   : REM  W8=# items (excluding blank lines)
   : REM  U4$=password
0090 REM Other
   : REM  U6$=keystroke
   : REM  U4,R$=scratch
0091 REM Menu stack handling
   : REM M=Stack pointer
   : REM M$()=stack
   : REM M1$() external node buffer
0100 DEFFN'126
   : RETURN  CLEAR  ALL
0108 U$=$PSTAT(#PART)
   : IF U$=" " THEN U$=".STARTD"
0116 IF U$<>".STARTD" AND U$<>"@STARTD" THEN 130
   : DATA LOAD DC OPEN T#U2,U$
   : DATA LOAD DC #U2,U$
   : IF M>1 THEN $PSTAT=U$
   : ELSE $PSTAT=" "
   : GOTO 130
0120 REM %GET NEXT NODE
   : $PSTAT=U$
0130 LOAD T#U2,U$ 9000,9999 BEG  140
   : ERRORPRINT AT(23,0,);HEX(02040B000F0E);"ERROR LOADING MENU NODE ";U$;
   : $PSTAT=" "
   : GOTO 108
0140 REM NODE DESCRIPTORS
   : RESTORE LINE 8100
   : READ U$,U1$,U1,U
0150 %DATA LOAD DC #0,M,M$(): DBACKSPACE #0,1S
0160 REM %CRT SIZE
   : REM Exit-- R5=#rows, W5=#columns, W$=cursor character
   : R5=24
   : W5=80
   : W$=HEX(8B)
   : $GIO/005(7601,R$)
   : R$=AND HEX(10)
   : IF STR(R$,,1)=HEX(10) THEN 170
   : R5=16
   : W5=64
   : W$="*"
0165 REM %DETERMINE DISPLAY COORDINATES OF NODE ITEMS........
0170 REM %# NODE ITEMS
   : R=-1
   : RESTORE LINE 8100,5+U
0180 GOSUB 935
   : IF U$<>"no more" THEN 180
   : W9=R
   : W1=INT((W9+R5-6)/(R5-5))
   : R9=-INT(-W9/W1)
0190 REM %MAX ITEM LENGTH FOR EACH COL
   : R=-1
   : W1=0
   : MAT U=ZER
   : RESTORE LINE 8100,5+U
0200 FOR W=1 TO W9
   : GOSUB 935
   : IF MOD(R,R9)=0 THEN W1=W1+1
   : U(W1)=MAX(U(W1),LEN(U1$)+2)
   : NEXT W
0210 REM %CALC. DISPLAY COORDS
   : R0=INT((R5-5-R9)/2)+5
   : W0,U3=INT((W5-U(1)-U(2)-U(3)-U(4)-U(5))/(W1+1))
   : IF U3<5 THEN STOP "Screen too small -- reduce length or no. of items. "
   : W8=0
   : RESTORE LINE 8100,5+U
   : R2=-1
0220 FOR W=1 TO W9
   : R1=MOD(W-1,R9)
   : W1=INT((W-1)/R9)
   : IF R1=0 AND W1>0 THEN W0=W0+U(W1)+U3
   : GOSUB 935
   : IF STR(U2$,,1)="B" THEN 230
   : W8=W8+1
   : W$(W8,1)=BIN(R1+R0)
   : W$(W8,2)=BIN(W0)
   : W$(W8,3)=BIN(R2)
0230 NEXT W
0240 REM %DISPLAY NODE.........
0280 REM %DISPLAY NODE TITLE
   : RESTORE LINE 8100
   : READ U$,U1$,U1,U
   : SELECT PRINT 005(W5),P
   : PRINT HEX(020D0C030F06);AT(0,(W5-LEN(U1$))/2);HEX(0E);U1$;HEX(0F)
   : PRINT
0290 REM %DISPLAY INSTRUCTIONS
   : PRINT AT(2,0);"Select item with SPACE & BACKSPACE."
   : PRINT AT(3,0);"Key RETURN to execute, FN for previous menu,"
   : PRINT AT(4,0);"    SHIFT FN for root menu."
   : PRINT AT(2,W5-22);"Partition";#PART;HEX(08);",";SPACEK;"K"
   : PRINT AT(3,W5-15);"Terminal";#TERM
0300 REM %DISPLAY NODE
   : RESTORE LINE 8100,5+U
   : FOR W=1 TO W8
   : GOSUB 920
   : U8$=U1$
   : GOSUB 980
   : NEXT W
   : W=1
0301 REM % DISPLAY PARTITION WAITING OR $MSG
0302 $IF ON /001,325
   : IF R0+R9>21 THEN 325
   : M0$=$MSG
   : IF M0$<>" " AND RND(1)>.6 THEN 310
0303 GOSUB 700
   : IF R$<>"T" THEN 310
0308 PRINT AT(22,10);HEX(020404000E);"At least one background partition is wai
     ting for service."
0309 PRINT AT(23,0);HEX(020402000E);TAB(25);"Key SF '4 to Release Terminal";HE
     X(0F);
   : GOTO 325
0310 M0$=$MSG
   : IF M0$=" " THEN 325
0315 PRINT AT(22,0);"SYSTEM BROADCAST MESSAGE:"
   : PRINT AT(23,0);M0$;HEX(020402000F);
0324 REM %PROCESS USER REQUESTS........
0325 REM %DISPLAY CURRENT ENTRY HIGHLIT
   : RESTORE LINE 8100,5+U+U1*VAL(W$(W,3))
   : GOSUB 920
   : U8$=U1$
   : PRINT HEX(0E);AT(VAL(W$(W,1)),VAL(W$(W,2)));W$;" ";U8$;HEX(0F);
0330 REM %USER REQUEST
   : KEYIN U6$,,465
   : ON POS(HEX(200882810D)=U6$) GOTO 400,410,420,470,420
0340 REM %Starting character?
   : $TRAN(U6$,"AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz") R
   : RESTORE LINE 8100,5+U
   : R=0
0350 GOSUB 920
   : IF W<>R THEN 350
0360 GOSUB 920
   : IF U$="no more" THEN 370
   : IF STR(U1$,,1)<>U6$ THEN 360
   : GOTO 390
0370 RESTORE LINE 8100,5+U
   : R=0
0380 GOSUB 920
   : IF W=R THEN 330
   : IF STR(U1$,,1)<>U6$ THEN 380
0390 GOSUB 980
   : W=R
   : GOTO 325
0400 REM %SPACE key
   : GOSUB 980
   : W=MOD(W,W8)+1
   : GOTO 325
0410 REM %BACKSPACE key
   : GOSUB 980
   : W=MOD(W-2,W8)+1
   : GOTO 325
0420 REM %RUN key
   : RESTORE LINE 8100,5+U
   : R=0
   : M=M+1
0430 GOSUB 920
   : IF W<>R THEN 430
0440 REM Unpack rest of entry
   : U7$,U3$,U5$,U4$=" "
   : $UNPACK(D=HEX(012C)) U2$ TO R$,U7$,U4$,U3$,U5$
0441 IF STR(R$,,1)="P" THEN 442
   : REM IF U3$=" " OR U3$="0" THEN U3$="1"
   : REM IF U5$=" " THEN U5$=STR(M$(M-1),22)
   : GOTO 443
0442 IF U3$=" " THEN U3$="0"
   : REM IF U5$=" " THEN U5$=STR(M$(M-1),22)
0443 CONVERT U3$ TO U2
   : ERRORU2=0
0444 CONVERT U7$ TO U4
   : ERRORU4=1.25
0445 GOSUB 7010
   : $PACK (F=U1$) M$(M) FROM U$,R$,U4,U4$,U2,U5$
0446 %DATA SAVE DC #0,M,M$(): DBACKSPACE #0,1S
0450 REM Check for password
   : GOSUB 945
   : IF U4$<>" " THEN 108
0452 REM Check SPACEK
   : IF U7$=" " THEN 455
   : CONVERT U7$ TO U4
   : ERRORPRINT "Error in spacek."
   : END
0454 IF U4<=SPACEK THEN 455
   : SELECT P9
   : PRINT HEX(0E);AT(2,0,40);"Insufficient memory.";AT(3,0,48);U4;"K partitio
     n required."
   : PRINT TAB(79)
   : PRINT
   : GOTO 108
0455 GOSUB 960
   : PRINT AT(4,0,79);AT(3,0,48);AT(2,0,40);HEX(0E05);"Loading ";BOX(1,LEN(U$)
     +1);" ";U$;"    ";HEX(0F);
   : IF STR(R$,,1)<>"P" THEN 130
   : RESTORE LINE 8100
   : READ R$
   : $PSTAT=R$
   : IF U2>0 OR U5$=STR(M$(1),22) THEN 464
0464 DATA SAVE DC CLOSE#0
   : DATA SAVE DC CLOSE#U2
   : LOAD T#U2,U$
   : ERRORGOTO 726
0465 REM %SF KEYS
   : IF U6$=HEX(7E) OR U6$=HEX(F0) OR U6$=HEX(1F) THEN 470
   : IF U6$=HEX(04) THEN 475
   : IF U6$<>HEX(7F) AND U6$<>HEX(50) THEN 330
   : M=1
   : GOTO 108
0470 REM %CLEAR key
   : IF U=0 THEN 108
   : RESTORE LINE 8100,5
   : READ U$
   : $PSTAT=U$
   : U2$="M"
   : R$=" "
   : IF U>2 THEN READ R$
   : $UNPACK(D=HEX(012C)) R$ TO U3$,U5$
   : GOSUB 955
   : GOTO 455
0475 GOSUB 700
   : IF R$<>"T" THEN 325
   : PRINT HEX(020D0C030F);
   : $RELEASE TERMINAL
   : FOR U4=1 TO 10
   : $BREAK 255
   : NEXT U4
   : GOTO 280
0480 REM %SUBROUTINES.........
0700 PACK (##) R$ FROM #TERM
   : STR(R$,2)="W"
0705 FOR U4=1 TO 16
   : S1$=$PSTAT(U4)
   : ERRORRETURN
0710 IF STR(S1$,15,2)=STR(R$,,2) THEN 715
   : NEXT U4
   : RETURN
0715 R$="T"
   : RETURN
0720 REM % SCAN @XNODES
0725 IF U2>0 THEN 730
   : U2=1
   : SELECT #0 <STR(M$(1),22)>
0726 DATA LOAD DC OPEN T#0,"@MENUSTK"
   : U4=(C9-1)*16+#PART-1
   : IF U4>0 THEN DSKIP #0,U4 S
0727 %DATA LOAD DC #0,M,M$(): DBACKSPACE #0,1S
0730 SELECT #U2 <STR(M$(1),22)>
   : DATA LOAD DC OPEN T#U2,"@XNODES"
0735 GOSUB '30(STR(M$(M),,9))
   : IF U4=0 THEN 755
0740 GOSUB 7010
   : $UNPACK (F=U1$) M1$(U4) TO U$,R$,U4,U4$,Q,U5$
   : GOSUB 890
0741 SELECT #U2 <U5$>
   : ERRORGOTO 755
0742 LIMITS T#U2,U$,U4,U4,U4,Q
   : ERRORGOTO 755
0750 IF Q>0 THEN 795
0755 GOSUB 7010
   : $UNPACK (F=U1$) M$(M) TO U$,R$,U4,U4$,Q,U5$
   : PRINT AT(4,0,)
0760 PRINT AT(6,0); HEX(07); HEX(020404000F0E);"Unable to find file ";U$;" on
     disk ";U5$
0765 PRINT AT(7,0);HEX(020402000F0E);"Correct disk address, or key FN to abort
      ->";
   : LINPUT ?- STR(U5$,,3)
0770 IF POS("3BD" = STR(U5$,,1))=0 OR VER(U5$,"HHH")<3 THEN 765
0771 SELECT #U2 <U5$>
   : ERRORGOTO 760
0772 LIMITS T#U2,U$,U4,U4,U4,Q
   : ERRORGOTO 760
0773 IF Q<1 THEN 760
0780 GOSUB 890
0785 SELECT #U2 <STR(M$(1),22)>
   : DATA LOAD DC OPEN T#U2,"@XNODES"
0790 M0$=STR(U$,,8) & R$
   : GOSUB '30(M0$)
   : IF U4>0 THEN 791
   : GOSUB '30(" ")
   : IF U4=0 THEN 792
0791 M1$(U4)=M$(M)
   : DBACKSPACE #U2,1S
   : DATA SAVE DC #U2,M1$()
0792 DATA SAVE DC CLOSE#U2
0795 $UNPACK (F=U1$) M$(M) TO U$,R$,U4,U4$,U2,U5$
0797 GOTO 441
0824 REM % SCAN @XNODES
0825 DEFFN'30(M0$)
   : U4=0
   : DBACKSPACE #U2,BEG
0830 DATA LOAD DC #U2,M1$()
   : IF END  THEN RETURN
0850 MAT SEARCH M1$(),=STR(M0$,,9) TO U5$ STEP 33
   : IF STR(U5$,,2)=HEX(0000) THEN 830
0855 U4=(32+VAL(U5$,2))/33
   : RETURN
0890 REM % UPDATE STACK ENTRY
   : $UNPACK (F=U1$) M$(M) TO U$,R$,U4,U4$,Q,M0$
   : $PACK (F=U1$) M$(M) FROM U$,R$,U4,U4$,Q,U5$
   : RETURN
0900 DEFFN'29"LISTSD 9000,";HEX(0D)
0905 DEFFN'24
   : PRINT "Saving node data"
   : RESTORE LINE 8100
   : READ U$
   : SAVE T#U2,(5)U$ 9000,
   : ERRORSCRATCH T#U2,U$
   : SAVE T#U2,()U$ 9000,
0910 RETURN
0915 REM %GET NEXT NODE ITEM (excluding blank lines)
0920 READ U$,U1$,U2$
   : IF U1=3THEN 925
   : FOR U4=4 TO U1
   : READ R$
   : NEXT U4
0925 IF POS("MP "=STR(U2$,,1))=0THEN 920
   : R=R+1
   : RETURN
0930 REM %GET NEXT NODE ITEM (including blank lines)
0935 READ U$,U1$,U2$
   : IF U1=3THEN 940
   : FOR U4=4 TO U1
   : READ R$
   : NEXT U4
0940 R2=R2+1
   : IF POS("MPB "=STR(U2$,,1))=0THEN 935
   : R=R+1
   : RETURN
0945 REM %CHECK FOR PASSWORD
   : REM RETURN -- U4$=" " iff password ok or none
   : REM
   : IF U4$=" " THEN RETURN
0950 PRINT AT(4,0,79);AT(3,0,48);AT(2,0,40);HEX(0E05);"Enter password ";
   : FOR U4=1 TO LEN(U4$)
   : KEYIN U6$
   : STR(U4$,U4,1)=XOR U6$
   : PRINT W$;
   : NEXT U4
   : $TRAN(U4$,HEX(2000))R
   : RETURN
0955 REM %DISK SELECT
   : REM Entry-- N$=file# (" " ==> #0), A$=device-addr (" " ==> no selection)
   : REM Return-- N=file# (selected)
0960 U2=0
   : IF U3$<>" " THEN CONVERT U3$ TO U2
   : ERRORGOTO 975
0965 IF U2<0 OR U2>15 THEN 975
   : IF U5$<>" " THEN SELECT #U2<U5$>
   : ERRORGOTO 975
0970 RETURN
0975 PRINT "Error in selecting";U2;" ";U5$
   : END
0980 REM %DISPLAY CURRENT ENTRY (W) WITHOUT HIGHLIGHT
   : PRINT AT(VAL(W$(W,1)),VAL(W$(W,2)));". ";U8$;
   : RETURN
0985 REM % RETURNS R$="T" IF A BACKGROUND IS PARTITION WAITING
7000 REM % $FORMAT OF MENU STACK
7010 $FORMAT U1$=A8,A1,P2.2,A8,P2,A12
   : RETURN
7450 LOAD T#0,"START"
   : ERRORGOTO 7550
7500 REM % START or ! GENERATED BY MENU PACKAGE
7505 $PSTAT=" "
7510 DATA LOAD DC OPEN T#0,"APPSAVE"
   : ERROR$PSTAT=" "
   : LOAD T#0,"@MENU"
7520 DATA LOAD DC #0,U5$
7530 SELECT #1 <U5$>
   : LIMITS T#1,"@MENU",U4,U4,U4,Q
   : ERRORGOTO 7550
7540 IF Q<>1 THEN 7550
   : SELECT #0 <U5$>
   : LOAD T#0,"@MENU"
7550 PRINT AT(22,0,);HEX(02040B000F0E);"Unable to find disk or file containing
      next menu."
7560 LINPUT "DISK ADDRESS?",U5$
   : IF POS("3BD"=STR(U5$,,1))=0 OR VER(U5$,"HHH")<>3 THEN 7560
7570 DATA LOAD DC OPEN T#0,"APPSAVE"
   : ERRORGOTO 7530
7580 DATA SAVE DC #0,U5$
   : ERRORGOTO 7530
7585 GOTO 7530
8000 REM %NODE DATA (lines 9000-)
8010 REM 1st line of data is the NODE DESCRIPTION --
   : REM
   : REM   DATA "node filename" (required)
   : REM     "node title" (required)
   : REM     "# items in each ITEM DESCRIPTION" (required)
8020 REM     "# other items in NODE DESCRIPTION" (required)
   : REM     "previous node name" (optional)
   : REM     "[file#][,device-address]" (optional,see below)
8030 REM     other alpha items (optional)
   : REM
8040 REM Each other line of data is an ITEM DESCRIPTION --
   : REM
   : REM   DATA "item name (ie, filename)" (required)
   : REM      "item description (displayed information)" (required)
8050 REM      "type" (required)
   : REM        P=program
   : REM        M=menu node
   : REM        B=blank display line
   : REM        O=overlay or related file (not used by @MENU)
   : REM         (must follow an item of type P or O)
8060 REM        other alpha items   (optional)
   : REM
8070 REM     Types P & M can optionally be followed by, separated by commas,
   : REM
   : REM       required partition size (SPACEK)
   : REM       execution password (8 bytes)
8080 REM       file# to load from (default #0)
   : REM       device-addr (file# selected to this, same disk as menu node)
   : REM
   : REM       Eg,   "P,14,password,1,B10"
   : REM             "M,,,,D32"
   : REM
8090 REM Last line of data defines the end of items --
   : REM
   : REM    DATA "no more","end of node"," "
8100 REM