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