' Stef's menu routine ' ' groundwork created 13.10.91 ' finished 19.10.91 ' two days of work! ' DEFFILL 1,2,4 PBOX 0,0,639,399 ' menu_init menu_read menu_bar menu_handle ' > PROCEDURE menu_init LOCAL mem% ' SELECT XBIOS(4) CASE 2 fh%=16 fw%=8 fc%=2 sh%=399 sw%=639 mem%=32000 fnt%=13 CASE 1 fh%=8 fw%=8 fc%=1 sh%=199 sw%=639 mem%=32000 fnt%=6 CASE 0 fh%=8 fw%=8 fc%=1 sh%=199 sw%=319 mem%=32000 fnt%=6 ENDSELECT ' IF FRE(0)>mem% m_back!=TRUE ELSE m_back!=FALSE ENDIF DEFTEXT ,,,fnt% RETURN > PROCEDURE menu_read LOCAL x$,i%,j%,k%,x%,max% ' RESTORE menu_data m_menus%=0 m_items%=0 m_sub%=-1 ' READ x$,i% WHILE i%<>1002 INC m_items% IF i%=1000 INC m_menus% ENDIF IF i%=1003 IF m_sub%=-1 m_sub%=m_menus%+1 ELSE INC m_sub% ENDIF ENDIF READ x$,i% WEND DEC m_menus% DEC m_sub% ' DIM m_item$(m_items%) DIM m_item%(m_items%) DIM m_menu%(m_sub%,9) DIM m_back$(m_sub%,1) ' RESTORE menu_data FOR i%=0 TO m_items%-1 READ m_item$(i%),m_item%(i%) IF m_item%(i%)=1000 OR m_item%(i%)=1003 m_menu%(j%,4)=i%+1 INC j% ENDIF NEXT i% ' x%=fw%*2-2 max%=-1 j%=0 k%=0 FOR i%=0 TO m_items%-1 IF m_item%(i%)=1000 OR m_item%(i%)=1003 IF max%>-1 m_menu%(j%,0)=x% m_menu%(j%,1)=fh%+2 m_menu%(j%,2)=x%+max%*fw%+2+fw%*2 m_menu%(j%,3)=m_menu%(j%,1)+k%*fh%+1 m_menu%(j%,5)=FALSE m_menu%(j%,6)=(LEN(m_item$(m_menu%(j%,4)-1))+2)*fw%+1 IF m_item%(i%)=1000 m_menu%(j%,7)=k%-1 ELSE m_menu%(j%,7)=k% ENDIF m_menu%(j%,8)=-1 m_menu%(j%,9)=-1 ADD x%,m_menu%(j%,6)-1 INC j% ENDIF max%=0 k%=0 ELSE max%=MAX(max%,LEN(m_item$(i%))) INC k% ENDIF NEXT i% m_menu%(j%,0)=x% m_menu%(j%,1)=fh%+2 m_menu%(j%,2)=x%+max%*fw%+2+fw%*2 m_menu%(j%,3)=m_menu%(j%,1)+k%*fh%+1 m_menu%(j%,5)=FALSE m_menu%(j%,6)=(LEN(m_item$(m_menu%(j%,4)-1))+2)*fw%+1 m_menu%(j%,7)=k% m_menu%(j%,8)=-1 m_menu%(j%,9)=-1 RETURN > PROCEDURE menu_bar LOCAL i% ' DEFFILL 1,0,0 BOUNDARY 0 PBOX 0,0,sw%,fh%+1 FOR i%=0 TO m_menus% TEXT m_menu%(i%,0)+2+fw%,fh%-fc%,m_item$(m_menu%(i%,4)-1) NEXT i% LINE 0,fh%+2,sw%,fh%+2 m_state%=0 m_m%=-1 m_i%=-1 RETURN > PROCEDURE menu_handle LOCAL x%,y%,k%,k1%,k! ' MOUSE x1%,y1%,k% menu_check(m_m%,x1%,y1%,k%) DO SHOWM k!=FALSE k1%=0 REPEAT MOUSE x%,y%,k% IF k%=2 EDIT ENDIF IF k%=0 k!=TRUE ENDIF IF k! k1%=k% ENDIF UNTIL x%<>x1% OR y%<>y1% OR k1% x1%=x% y1%=y% menu_check(m_m%,x%,y%,k1%) LOOP RETURN > PROCEDURE menu_check(m%,x%,y%,k%) LOCAL i%,mx1%,mx2%,m_m1%,m_sm!,m_im% ' m_sm!=FALSE IF y%=mx1% AND x%<=mx2% m_m1%=i% m_sm!=TRUE ENDIF NEXT i% IF m_m1%>-1 AND m_m1%<>m% menu_delete(m%) m_m%=m_m1% menu_inv1(m_m%) menu_draw(m_m%,FALSE) ENDIF ENDIF ' m_im%=-1 menu_item(m%,x%,y%) WHILE m%<>m_m% m%=m_m% menu_item(m%,x%,y%) WEND ' IF m%>-1 AND m_im%=-1 m%=m_menu%(m%,8) WHILE m%>-1 menu_item(m%,x%,y%) m%=m_menu%(m%,8) WEND ENDIF ' IF k% AND m_sm!=FALSE AND (m_m%=m_im% OR m_im%=-1) menu_delete(m_m%) IF m%>-1 IF m_menu%(m%,9)>-1 ALERT 1," OPTION VALUE: "+STR$(m_item%(m_menu%(m%,9)+m_menu%(m%,4))),1," OK ",button% ENDIF ENDIF ENDIF RETURN > PROCEDURE menu_item(m%,x%,y%) LOCAL m_i1%,m_m1%,i% ' IF m%>-1 i%=m_menu%(m%,9) IF x%>m_menu%(m%,0) AND x%m_menu%(m%,1) AND y%i% IF m_i1%>-1 WHILE m%<>m_m% f!=TRUE menu_erase(m_m%) WEND ENDIF IF m%=m_m% menu_inv2(m%,i%) i%=m_i1% m_menu%(m%,9)=m_i1% ENDIF menu_inv2(m%,m_i1%) ' ' check for cascading menu ' IF i%>-1 AND m%=m_m% m_m1%=m_item%(i%+m_menu%(m%,4)) IF m_m1%<0 m_m1%=-m_m1%+m_menus% menu_draw(m_m1%,TRUE) m_m%=m_m1% ENDIF ENDIF ENDIF ENDIF RETURN > PROCEDURE menu_delete(m%) REPEAT menu_inv1(m%) menu_erase(m%) IF m%>-1 m%=m_menu%(m%,8) ENDIF UNTIL m%=-1 RETURN > PROCEDURE menu_draw(m%,sub!) LOCAL x%,y%,mw%,w% ' IF sub! mw%=m_menu%(m%,2)-m_menu%(m%,0) m_menu%(m%,0)=m_menu%(m_m%,2)-fw% m_menu%(m%,1)=m_menu%(m_m%,1)+i%*fh%+fh%/2 m_menu%(m%,2)=m_menu%(m%,0)+mw% m_menu%(m%,3)=m_menu%(m%,1)+m_menu%(m%,7)*fh%+1 m_menu%(m%,8)=m_m% IF m_menu%(m%,2)>sw% m_menu%(m%,0)=sw%-mw% m_menu%(m%,2)=sw% ENDIF ELSE m_menu%(m%,8)=-1 ENDIF m_menu%(m%,9)=-1 ' GET m_menu%(m%,0),m_menu%(m%,1),m_menu%(m%,2),m_menu%(m%,3),m_back$(m%,1) IF m_menu%(m%,5) PUT m_menu%(m%,0),m_menu%(m%,1),m_back$(m%,0) ELSE DEFFILL 1,0,0 BOUNDARY 1 PBOX m_menu%(m%,0),m_menu%(m%,1),m_menu%(m%,2),m_menu%(m%,3) x%=m_menu%(m%,0)+2 y%=m_menu%(m%,1)+fh%-fc% mw%=(m_menu%(m%,2)-m_menu%(m%,0)-4)/fw%+1 ' FOR i%=m_menu%(m%,4) TO m_menu%(m%,4)+m_menu%(m%,7) IF m_item%(i%)<>1003 IF m_item%(i%)=1001 DEFTEXT ,2,,fnt% TEXT x%,y%,m_item$(i%)+STRING$(mw%-LEN(m_item$(i%)),LEFT$(m_item$(i%))) DEFTEXT ,0,,fnt% ELSE IF m_item%(i%)<0 AND LEN(m_item$(i%)) PROCEDURE menu_erase(m%) IF m%>-1 BOUNDARY 0 DEFFILL 1,2,4 PUT m_menu%(m%,0),m_menu%(m%,1),m_back$(m%,1) DEFFILL 1,1,0 m_m%=m_menu%(m%,8) ENDIF SHOWM RETURN > PROCEDURE menu_inv1(m%) IF m%>-1 IF m_menu%(m%,8)=-1 DEFFILL 1,1,0 GRAPHMODE 3 BOUNDARY 0 PBOX m_menu%(m%,0)+2,0,m_menu%(m%,0)+m_menu%(m%,6),fh%+1 GRAPHMODE 1 SHOWM ENDIF ENDIF RETURN > PROCEDURE menu_inv2(m%,i%) IF i%>-1 DEFFILL 1,1,0 GRAPHMODE 3 BOUNDARY 0 PBOX m_menu%(m%,0)+1,m_menu%(m%,1)+i%*fh%+1,m_menu%(m%,2)-1,m_menu%(m%,1)+(i%+1)*fh% GRAPHMODE 1 SHOWM ENDIF RETURN > PROCEDURE menu_data menu_data: DATA Menu1,1000 DATA Item 1.1,0 DATA Item 1.2,1 DATA -,1001 DATA Submenu 1,-1 DATA Item 1.3,2 ' DATA Menu 2,1000 DATA Item 2.1,3 DATA Item 2.2,4 DATA Another terrific item!,20 DATA ≡ XYZ ≡,1001 DATA Itemoid 2.3,5 DATA Item 2.4,6 DATA Item 2.5,7 ' DATA En menu 3!,1000 DATA Item 3.1,8 DATA Item 3.2,9 DATA - XYZ -,1001 DATA Itemette 3.3,10 ' DATA Submenu,1003 DATA Cascade option 1,20 DATA - Cascade heaven -,1001 DATA ANOTHER ONE!!,-2 DATA Cascade 3,-3 ' DATA Submenu,1003 DATA "yes, another one",23 DATA what a load of bollocks,24 ' DATA Submenu,1003 DATA Ah yeah,25 DATA Wonderful stuff,26 DATA Why not?,-4 DATA Item number 27,27 DATA Lovely,28 ' DATA Submenu,1003 DATA Great,29 DATA Last one,30 ' DATA END,1002 RETURN