' *********************************** ' *** AMOS Dialog Procedures V2.1 *** ' *********************************** ' Gosub INIT ' ' *********************** ' *** EXAMPLE PROGRAM *** ' *********************** ' ' ' ********************** ' *** END OF PROGRAM *** ' ********************** ' End ' ' *** Open Dialog Screen Procedure. ' Procedure _OPENDIALOGSCREEN[N,H,Y] ' Screen Open N,640,H,4,Hires Screen Display N,130,Y,, Curs Off Flash Off Cls 0 ' Palette $999,$0,$FFF,$58A ' Pen 1 Paper 0 Ink 1,0 ' _BACK=0 _SHADOW=1 _LIGHT=2 _COLOUR=3 _TEXT=1 ' End Proc ' ' *** Draw 3D Box Procedure. ' Procedure _DRAW3DBOX[X1,Y1,X2,Y2,T$,IN,FC,BC] ' I=0 IO=0 B=0 While I2 Cls BC,X1,Y1 To X2+1,Y2+1 Ink C1 Box X1,Y1 To X2,Y2 Box X1+1,Y1 To X2-1,Y2 Ink C2 Polyline X1+1,Y2 To X2,Y2 To X2,Y1 Polyline X1+1,Y2 To X2-1,Y2 To X2-1,Y1+1 Else Cls BC,X1+2,Y1+1 To X2-1,Y2 End If ' If Upper$(Left$(T$,3))="(S)" CHK$=Upper$(Mid$(T$,4)) _DRAWUSEROBJECT[X1,Y1,X2,Y2,CHK$] Goto FIN End If ' H#=((Y2-Y1)-(B*Text Base))/(B+1) Y#=Y1+H#+Text Base ' Ink FC,BC Gr Writing 0 ' I=0 IO=0 LOP=0 While LOPX2 or YY2 or M=0 Goto FIN2 End If ' AN=M ' If WT=0 Goto FIN2 End If ' Gr Writing 2 Bar X1,Y1 To X2,Y2 ' While X>=X1 and X<=X2 and Y>=Y1 and Y<=Y2 X=X Screen(X Mouse) Y=Y Screen(Y Mouse) If Mouse Key=0 Goto FIN End If Wend ' AN=0 ' FIN: Bar X1,Y1 To X2,Y2 Gr Writing 1 ' FIN2: ' End Proc[AN] ' ' *** Set Font Procedure. ' Procedure _SETFONT[FT$,FS] ' FT$=Upper$(FT$) ' OK=0 POS=1 ' While Font$(POS)<>"" ' If Upper$(Left$(Font$(POS),Len(FT$)+5))=(FT$+".FONT") If Val(Mid$(Font$(POS),30,3))=FS Set Font POS OK=1 _FONTNAME$=FT$ _FONTSIZE=FS End If End If ' Inc POS Wend ' End Proc[OK] ' ' *** Add Dialog Button Procedure . ' Procedure _ADDBUTTON[X1,Y1,X2,Y2,T$,BZ] ' _DRAW3DBOX[X1,Y1,X2,Y2,T$,1,_TEXT,0] ' If BZ<>0 ' L$=String$(" ",19)+";" ' Mid$(L$,1,3)=Str$(X1)-" " Mid$(L$,5,3)=Str$(Y1)-" " Mid$(L$,9,3)=Str$(X2)-" " Mid$(L$,13,3)=Str$(Y2)-" " Mid$(L$,17,4)=Str$(BZ)-" " ' _DIALOGBUTTON$=_DIALOGBUTTON$+L$ ' End If ' End Proc ' ' *** Check Dialog Buttons Procedure. ' Procedure _CHECKBUTTONS ' ZN=0 I1=1 I2=1 ' While I2-1 Ink BC Bar X1,Y1 To X2,Y2 End If ' End If ' I1=I2+1 ' Wend ' End Proc ' ' *** Add Dialog Tick-Box Procedure. ' Procedure _ADDTICKBOX[X1,Y1,PO,BZ] ' _ADDBUTTON[X1,Y1,X1+26,Y1+11,"",BZ] ' If BZ=0 PO=1-PO End If ' If PO=1 Ink _SHADOW X1=X1+7 Y1=Y1+2 Draw X1,Y1+3 To X1+3,Y1+6 Draw X1+1,Y1+3 To X1+4,Y1+6 Draw X1+2,Y1+3 To X1+5,Y1+6 Draw X1+10,Y1 To X1+12,Y1 Draw X1+10,Y1+1 To X1+6,Y1+5 Draw X1+9,Y1+1 To X1+5,Y1+5 End If ' End Proc[PO] ' ' *** Add Cycle Button Procedure. ' Procedure _ADDCYCLEBUTTON[X1,Y1,X2,Y2,T$,PO,BZ] ' T$=T$+"|" I1=1 I2=1 P=1 ' I=0 IO=0 B=0 While I0 _ADDBUTTON[(X*8)-4,(Y*8)-3,(X*8)+(L*8)+4,(Y*8)+8+2,"",BZ] _DRAW3DBOX[(X*8)-2,(Y*8)-2,(X*8)+(L*8)+2,(Y*8)+8+1,"",0,1,0] Locate XX,YY Print Mid$(TXT$,1,L) Goto _END End If ' X1=(X*8)-4 Y1=(Y*8)-3 X2=(X*8)+(L*8)+4 Y2=(Y*8)+8+2 ' Locate XX,YY Print Space$(SX); ' XC=Len(ED$) MN=0 PX=0 ' L=Len(ED$) If L>=SX PX=L-SX End If ' Clear Key ' Do Gosub _DED ' If Mouse Key=1 X=(X Screen(X Mouse))/8-XX If X>=0 and X<=L XC=X Gosub _DED End If End If ' Gr Writing 2 GRX=X Curs*8 GRY=YY*8 Bar GRX,GRY To GRX+7,GRY+7 If Mouse Key Repeat Until Mouse Key=0 End If ' Repeat A$=Inkey$ S=Scancode K=Key Shift Until A$<>"" or Mouse Key or(A$<>"" and K) ' XM=X Screen(X Mouse) YM=Y Screen(Y Mouse) If Mouse Key and(XMX2 or YMY2) A$=Chr$(13) End If ' Bar GRX,GRY To GRX+7,GRY+7 Gr Writing 1 ' F=1 ' If A$=Chr$(13) Exit End If ' If A$=Chr$(27) ED$=TXT$ TXT$="" Locate XX,YY Print Space$(SX); Gosub _DED Exit End If ' If S=65 and K=0 and XC+PX>MN ED$=Left$(ED$,XC+PX-1)+Mid$(ED$,PX+XC+1) E=1 Dec L S=79 End If ' If S=65 and K>0 and K<4 ED$=Mid$(ED$,PX+XC+1) L=Len(ED$) PX=0 XC=0 End If ' If S=70 and K=0 and XC+PX0 and K<4 ED$=Left$(ED$,XC+PX) L=Len(ED$) F=0 End If ' If S=79 and PX+XC>MN F=0 If XC=0 Dec PX Else Dec XC End If End If ' If S=79 and K>0 and K<4 F=0 PX=0 XC=0 End If ' If S=78 and PX+XC0 and K<4 F=0 XC=L If XC>SX XC=SX End If PX=L-SX If PX<0 PX=0 End If End If ' If F If A$>=" " and LSX If XC>=SX Inc PX Else Inc XC End If Else Inc XC End If End If End If ' Loop ' Goto _END ' _DED: ' Print At(XX,YY)+Space$(SX); Print At(XX,YY)+Mid$(ED$,PX+1,SX); ' Locate Min(XX+XC,XX+SX-1),YY ' Return ' _END: ' End Proc[ED$] ' ' *** Draw User Object Procedure. ' Procedure _DRAWUSEROBJECT[X1,Y1,X2,Y2,T$] ' If Mid$(T$,1,3)="ICO" Paste Icon X1,Y1,Val(Right$(T$,3)) End If ' If Mid$(T$,1,3)="BOB" Paste Bob X1,Y1,Val(Right$(T$,3)) End If ' ' ******************** ' *** USER OBJECTS *** ' ******************** ' ' *** Up Arrow. ' If T$="UAR" Ink _SHADOW X=X1+(X2-X1)/2 Y=Y1+(Y2-Y1)/2 Polygon X,Y1+2 To X1+4,Y2-2 To X,Y To X2-4,Y2-2 To X,Y1+2 End If ' ' *** Down Arrow. ' If T$="DAR" Ink _SHADOW X=X1+(X2-X1)/2 Y=Y1+(Y2-Y1)/2 Polygon X,Y2-2 To X1+4,Y1+2 To X,Y To X2-4,Y1+2 To X,Y2-2 End If ' ' *** Left Arrow. ' If T$="LAR" Ink _SHADOW X=X1+(X2-X1)/2 Y=Y1+(Y2-Y1)/2 Polygon X1+4,Y To X2-4,Y1+2 To X,Y To X2-4,Y2-2 To X1+4,Y End If ' ' *** Right Arrow. ' If T$="RAR" Ink _SHADOW X=X1+(X2-X1)/2 Y=Y1+(Y2-Y1)/2 Polygon X2-4,Y To X1+4,Y1+2 To X,Y To X1+4,Y2-2 To X2-4,Y End If ' End Proc ' ' *** Add Radio Button Procedure. ' Procedure _ADDRADIOBUTTON[X,Y,GP,BN,PO,BZ] ' X1=X Y1=Y ' If PO=0 C1=_LIGHT C2=_SHADOW C3=_COLOUR Else C1=_SHADOW C2=_LIGHT C3=_BACK End If ' Ink C1 Draw X1+14,Y1 To X1+14,Y1+1 Draw X1+15,Y1+1 To X1+15,Y1+7 Draw X1+16,Y1+2 To X1+16,Y1+6 Draw X1+14,Y1+7 To X1+15,Y1+7 Draw X1+14,Y1+8 To X1+3,Y1+8 Ink C2 Draw X1+13,Y1 To X1+2,Y1 Draw X1+2,Y1+1 To X1+1,Y1+1 Draw X1,Y1+2 To X1,Y1+6 Draw X1+1,Y1+2 To X1+1,Y1+7 Draw X1+2,Y1+7 To X1+2,Y1+8 Ink C3 Draw X1+4,Y1+3 To X1+4,Y1+5 Draw X1+12,Y1+3 To X1+12,Y1+5 Bar X1+5,Y1+2 To X1+11,Y1+6 ' If BZ>0 ' L$=String$(" ",21)+";" ' Mid$(L$,1,3)=Str$(X)-" " Mid$(L$,5,3)=Str$(Y)-" " Mid$(L$,9,3)=Str$(GP)-" " Mid$(L$,13,3)=Str$(BN)-" " Mid$(L$,17,3)=Str$(PO)-" " Mid$(L$,21,3)=Str$(BZ)-" " ' _RADIOBUTTON$=_RADIOBUTTON$+L$ ' End If ' End Proc ' ' *** Check Radio Buttons Procedure. ' Procedure _CHECKRADIOBUTTONS ' RZN=0 I1=1 I2=1 ' While I2NO Goto FIN End If ' Dec PO ' WID=6 ' SL#=(X2-X1)-WID SS#=Max(SL#/NO,WID) If SS#>SL#/NO SL#=(X2-X1)-4-WID End If SW#=(SL#/NO)*PO ' _DRAW3DBOX[X1,Y1,X2,Y2,"",1,1,0] Ink _SHADOW Bar X1+2+SW#,Y1+2 To X1+2+SW#+SS#,Y2-2 ' If T$<>"" SLIDP=PO+1 _SLIDERROUTINE[T$,SLIDP] End If ' FIN: ' End Proc ' ' *** Vertical Slider Procedure. ' Procedure _VERTICALSLIDER[X1,Y1,X2,Y2,NO,PO,T$] ' If PO<1 or PO>NO Goto FIN End If ' Dec PO ' HIG=3 ' SL#=(Y2-Y1)-HIG SS#=Max(SL#/NO,HIG) If SS#>SL#/NO SL#=(Y2-Y1)-2-HIG End If SH#=(SL#/NO)*PO ' _DRAW3DBOX[X1,Y1,X2,Y2,"",1,1,0] Ink _SHADOW Bar X1+4,Y1+1+SH# To X2-4,Y1+1+SH#+SS# ' If T$<>"" SLIDP=PO+1 _SLIDERROUTINE[T$,SLIDP] End If ' FIN: ' End Proc ' ' *** Grab Horizontal Slider Procedure. ' Procedure _GRABHORIZONTALSLIDER[X1,Y1,X2,Y2,NO,PO,T$] ' Dec PO ' WID=6 ' SL#=(X2-X1)-WID SS#=Max(SL#/NO,WID) If SS#>SL#/NO SL#=(X2-X1)-4-WID End If SW#=(SL#/NO)*PO ' _CHECKZONE[X1+1+SW#,Y1+1,X1+1+SW#+SS#,Y2-1,0] If Param ' OK=0 P=PO ' MX=X Screen(X Mouse) DX=MX-(X1+SW#) ' Repeat MX=X Screen(X Mouse) MY=Y Screen(Y Mouse) MK=Mouse Key ' X=MX-X1-DX ' P=(X*(NO+1))/SL# ' If P<1 P=1 End If If P>NO P=NO End If ' If P<>PO PO=P SP=PO OK=1 _HORIZONTALSLIDER[X1,Y1,X2,Y2,NO,PO,T$] End If ' Until MK=0 End If ' If OK=1 OK=PO Else OK=0 End If ' End Proc[OK] ' ' *** Grab Vertical Slider Procedure. ' Procedure _GRABVERTICALSLIDER[X1,Y1,X2,Y2,NO,PO,T$] ' Dec PO ' HIG=3 ' SL#=(Y2-Y1)-HIG SS#=Max(SL#/NO,HIG) If SS#>SL#/NO SL#=(Y2-Y1)-2-HIG End If SH#=(SL#/NO)*PO ' _CHECKZONE[X1+1,Y1+1+SH#,X2-1,Y1+1+SH#+SS#,0] If Param ' OK=0 P=PO ' MY=Y Screen(Y Mouse) DY=MY-(Y1+SH#) ' Repeat MX=X Screen(X Mouse) MY=Y Screen(Y Mouse) MK=Mouse Key ' Y=MY-Y1-DY ' P=(Y*(NO+1))/SL# ' If P<1 P=1 End If If P>NO P=NO End If ' If P<>PO PO=P SP=PO OK=1 _VERTICALSLIDER[X1,Y1,X2,Y2,NO,PO,T$] End If ' Until MK=0 End If ' If OK=1 OK=PO Else OK=0 End If ' End Proc[OK] ' ' *** Slider Routines Procedure. ' Procedure _SLIDERROUTINE[T$,P] ' Goto T$ ' HSLIDE: _DRAW3DBOX[140,25,170,35,Str$(P)-" ",1,_TEXT,_COLOUR] Goto FIN ' VSLIDE: _DRAW3DBOX[35,25,65,35,Str$(P)-" ",1,_TEXT,_COLOUR] Goto FIN ' FIN: ' End Proc ' ' *** Title Bar Procedure ' Procedure _DRAWTITLEBAR[T$] ' B_FT$=_FONTNAME$ B_FS=_FONTSIZE ' _SETFONT["Topaz",8] ' If T$="" T$="" T$=T$+"'Amiga Workbench "+Str$(Chip Free)-" "+" graphics mem "+Str$(Fast Free)-" "+" other mem" End If ' _DRAW3DBOX[-1,0,640,10,T$,1,_SHADOW,_LIGHT] ' _SETFONT[B_FT$,B_FS] ' End Proc ' ' *** Alert Requester Procedure. ' Procedure _ALERTREQUESTER[M$,B$] ' If M$="_Cc_" Goto FIN End If ' I=0 IO=0 L=0 While I64 SC=16 FF=16 Else FF=SC End If C=1 ' Screen Open 6,320,20,SC,Lowres Screen Display 6,,SY+81,, Curs Off Flash Off Cls 0 ' Get Palette S ' STP=320/SC LOP=0 While LOP42 and Y Mouse<200 SY=Y Mouse Screen Display 7,,SY-YY,, Screen Display 6,,SY-YY+81,, End If Wend End If ' If ZN=11 Goto FIN End If ' If ZN=1 and R>0 Dec R Gosub _R_SLIDER Gosub _CHANGE End If ' If ZN=4 and R<15 Inc R Gosub _R_SLIDER Gosub _CHANGE End If ' If ZN=2 and G>0 Dec G Gosub _G_SLIDER Gosub _CHANGE End If ' If ZN=5 and G<15 Inc G Gosub _G_SLIDER Gosub _CHANGE End If ' If ZN=3 and B>0 Dec B Gosub _B_SLIDER Gosub _CHANGE End If ' If ZN=6 and B<15 Inc B Gosub _B_SLIDER Gosub _CHANGE End If ' If ZN=7 ' _DRAW3DBOX[26,0,639,12,"Select Colour To Spread To (ESC Exits)",2,_LIGHT,_COLOUR] ' CC=C Screen 6 ' Repeat If Mouse Key CC=Point(X Screen(6,X Mouse),Y Screen(6,Y Mouse)) End If Until Inkey$=Chr$(27) or(CC<>C and CCC TC=C E=CC If TC>E Swap TC,E End If Screen 6 For A=TC+1 To E-1 CDIF=E-A+1 RDIF=((Colour(E) and 3840)/256)-((Colour(A-1) and 3840)/256) RA=((Colour(A-1) and 3840)/256)+(RDIF/CDIF) GDIF=((Colour(E) and 240)/16)-((Colour(A-1) and 240)/16) GA=((Colour(A-1) and 240)/16)+(GDIF/CDIF) BDIF=(Colour(E) and 15)-(Colour(A-1) and 15) BA=(Colour(A-1) and 15)+(BDIF/CDIF) Colour A,(RA*256+GA*16+BA) Next A End If ' Screen 7 _DRAW3DBOX[26,0,639,12,"Palette Requester V1.0",2,_TEXT,_COLOUR] ' Gosub _GET Gosub _R_SLIDER Gosub _G_SLIDER Gosub _B_SLIDER ' End If ' If ZN=8 _DRAW3DBOX[26,0,639,12,"Select Colour To Swap With (ESC Exits)",2,_LIGHT,_COLOUR] ' CC=C Screen 6 ' Repeat If Mouse Key CC=Point(X Screen(6,X Mouse),Y Screen(6,Y Mouse)) End If Until Inkey$=Chr$(27) or(CC<>C and CCC and CC46 and X Screen(X Mouse)<454 R=(X Screen(X Mouse)-42)/26 Gosub _R_SLIDER Gosub _CHANGE Wend End If ' _CHECKZONE[42+(G*26),36,42+(G*26)+24,54,0] If Param While Mouse Key and X Screen(X Mouse)>46 and X Screen(X Mouse)<454 G=(X Screen(X Mouse)-42)/26 Gosub _G_SLIDER Gosub _CHANGE Wend End If ' _CHECKZONE[42+(B*26),56,42+(B*26)+24,74,0] If Param While Mouse Key and X Screen(X Mouse)>46 and X Screen(X Mouse)<454 B=(X Screen(X Mouse)-42)/26 Gosub _B_SLIDER Gosub _CHANGE Wend End If ' Loop ' FIN: Screen S Get Palette 6 Screen Close 7 Screen Close 6 ' _DIALOGBUTTON$=B_DLG$ B_DLG$="" ' Pop Proc ' _PICK: While Scin(X Mouse,Y Mouse)=6 ' Screen 6 ' If Mouse Key C=Point(X Screen(6,X Mouse),Y Screen(6,Y Mouse)) Gosub _GET Gosub _LINE Gosub _R_SLIDER Gosub _G_SLIDER Gosub _B_SLIDER End If ' Wend ' Screen 7 Return ' _LINE: Screen 6 Ink 0 Draw 0,0 To 319,0 Ink 1 Draw C*STP,0 To C*STP+STP,0 Screen 7 Return ' _GET: R=Colour(C)/256 G=Colour(C)/16 mod 16 B=Colour(C) mod 16 Return ' _R_SLIDER: _HORIZONTALSLIDER[42,16,460,34,16,R+1,""] _DRAW3DBOX[497,17,519,33,Str$(R)-" ",2,_TEXT,_BACK] Return ' _G_SLIDER: _HORIZONTALSLIDER[42,36,460,54,16,G+1,""] _DRAW3DBOX[496,37,519,53,Str$(G)-" ",2,_TEXT,_BACK] Return ' _B_SLIDER: _HORIZONTALSLIDER[42,56,460,74,16,B+1,""] _DRAW3DBOX[497,57,519,73,Str$(B)-" ",2,_TEXT,_BACK] Return ' _CHANGE: R$=Hex$(R) G$=Mid$(Hex$(G),2,1) B$=Mid$(Hex$(B),2,1) Screen 6 Colour C,Val(R$+G$+B$) Screen 7 Return ' End Proc ' ' *** File Requester Procedure. ' Procedure _FILEREQUESTER[T$] ' B_DLG$=_DIALOGBUTTON$ B_FNT$=_FONTNAME$ B_FS=_FONTSIZE _DIALOGBUTTON$="" ' _OPENDIALOGSCREEN[7,110,50] _DRAWTITLEBAR[T$] ' _SETFONT["Topaz",8] ' _DRAW3DBOX[0,11,639,108,"",1,,_COLOUR] _DRAW3DBOX[8,13,334,106,"",1,,_BACK] ' _ADDBUTTON[337,89,352,97,"(S)UAR",-7] _DRAW3DBOX[337,13,352,87,"",1,0,_BACK] _ADDBUTTON[337,98,352,106,"(S)DAR",-8] ' _DRAW3DBOX[356,45,440,59,"File",1,_TEXT,_BACK] _ADDINPUTBUTTON[45,8,FIL$,31,31,2] _DRAW3DBOX[356,13,440,27,"Drawer",1,_TEXT,_BACK] _ADDINPUTBUTTON[45,4,PATH$+WILD$,31,120,1] ' _ADDBUTTON[356,77,490,91,"Parent",5] _ADDBUTTON[356,92,490,106,"Volumes",6] _ADDBUTTON[497,77,631,91,"Cancel",3] _ADDBUTTON[497,92,631,106,"OK",4] ' FIL$="" SWITCH=0 ' If PATH$<>CPATH$ Gosub _GET_DIR End If ' Gosub _GET_DEV ' Gosub _DISPLAY_LIST Gosub _DISPLAY_FILE Gosub _DISPLAY_PATH ' Do ' _CHECKBUTTONS _BUTTONZONE=Param ' If _BUTTONZONE=7 and POS>0 Dec POS Gosub _DISPLAY_LIST End If ' If _BUTTONZONE=8 and POS0 POS=Param-1 Gosub _DISPLAY_LIST End If ' If _BUTTONZONE=4 FIL$=PATH$+FIL$ Goto FIN End If ' If _BUTTONZONE=5 Gosub _PARENT Gosub _DISPLAY_PATH End If ' If _BUTTONZONE=3 FIL$="" Goto FIN End If ' If _BUTTONZONE=6 and SWITCH=0 SWITCH=1 Gosub _GET_DEV FILES=DEVS Gosub _DISPLAY_LIST Gosub _DISPLAY_PATH Gosub _DISPLAY_FILE End If ' If _BUTTONZONE=1 _ADDINPUTBUTTON[45,4,PATH$+WILD$,31,120,0] PATH$=Param$ Gosub _CUT_WILD If(Right$(PATH$,1)<>"/") and(Right$(PATH$,1)<>":") PATH$=PATH$+"/" End If Gosub _GET_DIR Gosub _DISPLAY_LIST Gosub _DISPLAY_FILE Gosub _DISPLAY_PATH End If ' If _BUTTONZONE=2 _ADDINPUTBUTTON[45,8,FIL$,31,31,0] FIL$=Param$ Gosub _DISPLAY_FILE End If ' Loop ' _PARENT: If Len(PATH$)>2 LOP=Len(PATH$)-1 While LOP>1 A$=Mid$(PATH$,LOP,1) If(A$="/") or(A$=":") PATH$=Left$(PATH$,LOP) Gosub _GET_DIR Gosub _DISPLAY_LIST Exit End If Dec LOP Wend End If Return ' _CUT_WILD: LOP=Len(PATH$) While LOP>1 A$=Mid$(PATH$,LOP,1) If(A$=":") or(A$="/") WILD$=Right$(PATH$,Len(PATH$)-LOP) PATH$=Left$(PATH$,LOP) Exit End If Dec LOP Wend Return ' _CUT_FIL: ' LOP=30 While LOP>1 If Mid$(FIL$,LOP,1)<>" " FIL$=Left$(FIL$,LOP) Exit End If Dec LOP Wend ' A$=Left$(FIL$,1) FIL$=Mid$(FIL$,2) ' If A$="*" PATH$=PATH$+FIL$+"/" Gosub _GET_DIR End If ' If Right$(FIL$,1)=":" PATH$=FIL$ Gosub _GET_DIR End If ' Gosub _DISPLAY_LIST Gosub _DISPLAY_FILE Gosub _DISPLAY_PATH ' Return ' _GET_DIR: ' If Not Exist(PATH$) PATH$=CPATH$ SWITCH=0 Gosub _GET_DEV Gosub _DISPLAY_PATH Return End If ' LOP=0 While LOP<_MAX_LIST-1 FILE$(LOP,0)="" Inc LOP Wend ' Set Dir 31 ' FILES=0 FILE$(FILES,0)=Dir First$(PATH$+WILD$) ' While FILE$(FILES,0)<>"" and FILES<_MAX_LIST If Mid$(FILE$(FILES,0),1,1)="*" Mid$(FILE$(FILES,0),31,5)="(Dir)" End If Inc FILES FILE$(FILES,0)=Dir Next$ Wend Dec FILES ' If FILES<0 FILES=0 End If ' CPATH$=PATH$ ' FIL$="" POS=0 SWITCH=0 ' Gosub _GET_DEV ' Return ' _GET_DEV: ' LOP=0 While LOP<_MAX_LIST-1 FILE$(LOP,1)="" Inc LOP Wend ' Set Dir 31 ' DEVS=0 FILE$(DEVS,1)=Dev First$("**") ' While FILE$(DEVS,1)<>"" Mid$(FILE$(DEVS,1),31,5)="(Dev)" Inc DEVS FILE$(DEVS,1)=Dir Next$ Wend Dec DEVS ' If DEVS<0 DEVS=0 End If ' FIL$="" POS=0 ' Return ' _DISPLAY_PATH: Pen _TEXT Print At(45,4)+Space$(31); Print At(45,4)+Left$(PATH$+WILD$,31); Return ' _DISPLAY_FILE: Pen _TEXT Print At(45,8)+Space$(31); Print At(45,8)+Left$(FIL$,31); Return ' _DISPLAY_LIST: ' LOP=POS While LOP"" If Left$(FILE$(LOP,SWITCH),1)="*" Pen _LIGHT Else Pen _TEXT End If Print FILE$(LOP,SWITCH); Else Print Space$(38); End If Inc LOP Wend ' _VERTICALSLIDER[337,13,352,87,Min(FILES,FILES-11),POS+1,""] ' Return ' FIN: Screen Close 7 _DIALOGBUTTON$=B_DLG$ _SETFONT[B_FNT$,B_FS] ' End Proc[FIL$] ' ' *** Get Workbench Palette Procedure. ' Procedure _GETWBPALETTE ' F$="" OK=0 ' If Exist("Env:Sys/Palette.prefs") F$="Env:Sys/Palette.prefs" OK=1 End If ' If F$="" and Exist("ENVARC:Sys/Palette.prefs") F$="EnvArc:Sys/Palette.prefs" OK=1 End If ' If F$="" and Exist("Devs:System-Configuration") F$="Devs:System-Configuration" OK=2 End If ' If F$="" Palette $999,$0,$FFF,$58A,$F00,$F0,$F,$FF0 End If ' ' *** Change To WB Colours. ' If OK=1 ' Open In 1,F$ L=Lof(1) Close 1 A$=Space$(L) Bload F$,Varptr(A$) For A=0 To 7 R=Peek(Varptr(A$)+180+A*8)/16 G=Peek(Varptr(A$)+182+A*8)/16 B=Peek(Varptr(A$)+184+A*8)/16 Colour A,(R*256+G*16+B) Next A A$="" ' End If ' If OK=2 Open In 1,F$ L=Lof(1) Close 1 A$=Space$(L) Bload F$,Varptr(A$) For A=0 To 3 Colour A,Deek(Varptr(A$)+110+A*2) Colour A+16,Deek(Varptr(A$)+102+A*2) Next A A$="" End If ' End Proc ' ' *** Initialise Dialog Stuff. ' INIT: ' ' *** SET VARIABLES & STRINGS. ' _DIALOGBUTTON$="" _RADIOBUTTON$="" ' _MAX_LIST=200 Dim FILE$(_MAX_LIST,1) CPATH$="Ram Disk:" POS=0 PATH$="Ram:" WILD$="**" ' ' *** SET GLOBAL VARIABLES & STRINGS. ' Global _DIALOGBUTTON$,_RADIOBUTTON$ Global _BACK,_SHADOW,_LIGHT,_COLOUR,_TEXT Global _FONTNAME$,_FONTSIZE ' Global _MAX_LIST,PATH$,CPATH$,POS,FILE$(),FIL$,FILES,DEVS,WILD$ ' ' *** Open Default Screen. ' OpenDialogScreen[0,200,50] ' ' *** Set Font. ' Get Rom Fonts _SETFONT["Topaz",8] ' Return