home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format 50
/
af050sub.adf
/
Menu_System
/
SOURCE_MSYSB.AMOS
/
SOURCE_MSYSB.AMOS
/
SOURCE_MSYSB.amosSourceCode
Wrap
AMOS Source Code
|
1993-06-25
|
10KB
|
487 lines
FIL$=Command Line$
Request Wb
Screen Open 1,640,256,8,Hires
Paper 0 : Cls : Flash Off : Curs Off
Palette 0,0,0,0,0,0,0,0
Break Off
Limit Mouse 0,0 To 640,300
Screen Display 1,,40,,
Dim MNU$(90,2),MNI(90,4),ARRS(2,4),WINCON(4),PAL(8)
Global MNU$(),MNI(),ARRS(),ERR,WINCON(),SFNT,VER$
Global PAL(),_SYS$
VER$="5.00B"
_SYS$="SYS:"
_WIN
_SEARCH["Peridot.Font"]
SFNT=Param
Set Font SFNT
Gr Writing 0
If FIL$<>""
_LOAD[FIL$]
If Param=False
_WINDCLOSE[1]
_WINDOPEN[1,300,0,340,10,"Error: Loading Failed !!",0]
Wait 100
_WINDCLOSE[1]
Screen Close 1
End
End If
Else
_WINDCLOSE[1]
_WINDOPEN[1,300,0,340,10,"Error: No Filename !!",0]
Wait 100
_WINDCLOSE[1]
Screen Close 1
End
End If
_SETDIS[20]
_SCANMATRIX[20]
Procedure _SETDIS[BDOWN]
Screen 1
_BOX[0,240,580,9,False,2,4,3,1,"** MENU SYSTEM V"+VER$+" ** ",%11]
_BOX[585,240,45,9,False,2,4,3,1,"QUIT",%11]
If Amos Here=False
Amos To Front
End If
For _ROW=1 To BDOWN
_REDO_ROW[_ROW-1]
Next
Fade 3,PAL(0),PAL(1),PAL(2),PAL(3),PAL(4),PAL(5),PAL(6),PAL(7)
Wait 3*15
End Proc
Procedure _BOX[X,Y,W,H,INV,CINS,CHIG,CLOW,CTEX,TEX$,TTYP]
If CINS<>-1
Ink CINS
Bar X,Y To X+W,Y+H
End If
If INV=False Then Ink CLOW Else Ink CHIG
Box X,Y To X+W,Y+H
If INV=False Then Ink CHIG Else Ink CLOW
Draw X,Y To X+W,Y
Draw X,Y To X,Y+H
If TEX$<>""
If Btst(0,TTYP)=True
TX=Text Length(TEX$)
TX=X+((W-TX)/2)
Else
TX=X+6
End If
If Btst(1,TTYP)=True
Ink 0
Text TX+1,Y+8,TEX$
End If
Ink CTEX
Text TX,Y+7,TEX$
End If
End Proc
Procedure _SCANMATRIX[SZ]
Screen 1
_BXWD=157
_BXHI=11
_BXXS=2
_BXYS=14
_MXY=_BXYS+(SZ*_BXHI)
_MXX=_BXXS+(4*_BXWD)
_PARRAY[2,0,0,0,0,0]
_PARRAY[1,1,585,240,45,9] : Rem QUIT
Repeat
Repeat
MCOND=Mouse Key
If MCOND>0
BT=-1
MX=X Screen(X Mouse)
MY=Y Screen(Y Mouse)
If MX>_BXXS and MX<_MXX
X=MX-_BXXS
If MY>_BXYS and MY<_MXY
Y=MY-_BXYS
_ROW=Int(Y/_BXHI)
_COL=Int(X/_BXWD)
BT=(_ROW*4)+_COL
Rem If The Area Activated Is Part Of Another Button Then The Locates
Rem The Start Position Of The Button And Sets The Position Vector
Rem To Point To The Start
If MNI(BT,2)=-1
_PCOL=_COL
FOUND=False
Repeat
Dec _PCOL
If MNI((_ROW*4)+_PCOL,2)>-1
FOUND=True
End If
Until _PCOL=0 or FOUND=True
_COL=_PCOL
BT=(_ROW*4)+_COL
End If
Rem Invert The Button If TYPE [MNI(BT,1)] Is Less Than 3
If MNI(BT,1)<4
_INVERT_BUTTON[_ROW,_COL,BT]
End If
End If
End If
End If
If BT=-1
If MY>240 and MY<249
_EDITING_CONTROL[MX,MY]
End If
End If
If MCOND=1 and BT>-1
If MNU$(BT,2)<>""
If MNI(BT,1)<3
_EXECUTE[BT]
Else
If MNI(BT,1)=3
If Exist(MNU$(BT,2))=True
Fade 3,0,0,0,0,0,0,0,0
Wait 3*15
_LOAD[MNU$(BT,2)]
_SETDIS[20]
End If
End If
End If
End If
End If
Until BT>0
Until False
End Proc
Procedure _SCAN[X,Y]
_FOUND=False
_FPOINT=0
_POINT=1
_NA=ARRS(0,0)
Repeat
If ARRS(_POINT,0)=1
If X>ARRS(_POINT,1)
If Y>ARRS(_POINT,2)
If X<(ARRS(_POINT,1)+ARRS(_POINT,3))
If Y<(ARRS(_POINT,2)+ARRS(_POINT,4))
_FOUND=True
_FPOINT=_POINT
End If
End If
End If
End If
End If
If _FOUND=False
Inc _POINT
End If
Until _POINT=_NA or _FOUND=True
End Proc[_FPOINT]
Procedure _PARRAY[O,ZNID,X,Y,W,H]
ARRS(ZNID,0)=O
ARRS(ZNID,1)=X
ARRS(ZNID,2)=Y
ARRS(ZNID,3)=W
ARRS(ZNID,4)=H
End Proc
Procedure _WINDOPEN[N,X,Y,XX,YY,NAME$,CL]
X$=Str$(X)-" "
Y$=Str$(Y)-" "
XX$=Str$(XX)-" "
YY$=Str$(YY)-" "
CON$="CON:"+X$+"/"+Y$+"/"+XX$+"/"+YY$+"/"+NAME$
If CL=1
CON$=CON$+"/CLOSE"
End If
CON$=CON$+Chr$(0)
Dreg(1)=Varptr(CON$)
Dreg(2)=1005
WINCON(N)=Doscall(-30)
If WINCON(N)=0
ERR=Doscall(-132)
End If
End Proc
Procedure _WINDEXECUTE[N,COM$]
If WINCON(N)=0 Then Goto ERR
COM$=COM$+Chr$(0)
Dreg(1)=Varptr(COM$)
Dreg(2)=0
Dreg(3)=WINCON(N)
X=Doscall(-222)
If X=0
Goto ERR
End If
Pop Proc
ERR:
ERR=Doscall(-132)
End Proc
Procedure _WINDCLOSE[N]
If WINCON(N)=0 Then Goto ERR
Dreg(1)=WINCON(N)
X=Doscall(-36)
If X=0
Goto ERR
End If
Pop Proc
ERR:
ERR=Doscall(-132)
End Proc
Procedure _WIN
If Exist("SYS:Fonts/Peridot.Font")=True
_WINDOPEN[1,400,0,240,10,"Menu System V"+VER$+"",0]
Else
Screen Close 1
End
End If
End Proc
Procedure _SEARCH[_FNT$]
Get Disc Fonts
N=1
_FNT$=Upper$(_FNT$)
Repeat
F$=Mid$(Upper$(Font$(N)),1,Len(_FNT$))
If F$<>_FNT$
Inc N
End If
Until F$=_FNT$
End Proc[N]
Procedure _INVERT_BUTTON[_ROW,_COL,BUT]
SZ=153+(MNI(BUT,2)*157)
If MNI(BUT,4)=0
CHIGH=7 : CLOW=6
Else
CHIGH=4 : CLOW=3
End If
_BOX[2+(_COL*157),14+(_ROW*11),SZ,9,True,True,CHIGH,CLOW,1,"",0]
Repeat
Until Mouse Key=0
_BOX[2+(_COL*157),14+(_ROW*11),SZ,9,False,True,CHIGH,CLOW,1,"",0]
End Proc
Procedure _GENERATE_BUTTON[_ROW,_COL,BUT,TYPE]
SZ=153+(MNI(BUT,2)*157)
If MNI(BUT,1)<5
If TYPE=0
_BOX[2+(_COL*157),14+(_ROW*11),SZ,9,False,5,7,6,1,MNU$(BUT,1),%11]
End If
If TYPE=1
_BOX[2+(_COL*157),14+(_ROW*11),SZ,9,False,2,4,3,1,MNU$(BUT,1),%11]
End If
Else
Ink 0
Bar 2+(_COL*157),14+(_ROW*11) To 2+(_COL*157)+SZ,23+(_ROW*11)
If MNU$(BUT,1)>""
_BOX[2+(_COL*157),14+(_ROW*11),SZ,9,False,True,0,0,1,MNU$(BUT,1),%11]
End If
End If
End Proc
Procedure _EDITING_CONTROL[MX,MY]
_SCAN[MX,MY]
ZN=Param
If ZN=1
_BOX[585,240,45,9,True,True,4,3,1,"",0]
Repeat
Until Mouse Key=0
_BOX[585,240,45,9,False,True,4,3,1,"",0]
Fade 2,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF
Wait 2*30
Fade 3,0,0,0,0,0,0,0,0
Wait 3*30
Amos To Back
Wait 20
_WINDCLOSE[1]
Screen Close 1
End
End If
End Proc
Procedure _EXECUTE[BUT]
If MNI(BUT,0)=0
Fade 2,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF
Wait 2*30
Fade 3,0,0,0,0,0,0,0,0
Wait 3*30
Amos To Back
End If
FL$=MNU$(BUT,2)
MEM_PRES=Chip Free+Fast Free
If Exist(FL$)=True
If MNI(BUT,1)=0
_WINDEXECUTE[1,_SYS$+"C/Run <Nil: >Nil: "+FL$+" "+MNU$(BUT,0)]
Else
If MNI(BUT,1)=1
_WINDEXECUTE[1,_SYS$+"C/Execute "+FL$+" "+MNU$(BUT,0)]
Else
If MNI(BUT,1)=2
_WINDEXECUTE[1,FL$+" "+MNU$(BUT,0)]
End If
End If
End If
End If
If MNI(BUT,0)=0
Wait 20
_WINDCLOSE[1]
Screen Close 1
End
Else
If MNI(BUT,3)=1
Repeat
MEM_NOW=Chip Free+Fast Free
Multi Wait
Until MEM_NOW<MEM_PRES
_WINDCLOSE[1]
_WINDOPEN[1,300,0,340,10,"LEFT AMIGA + A - Return To Menu",0]
Fade 3,0,0,0,0,0,0,0,0
Wait 3*30
Amos To Back
Repeat
Multi Wait
_FL=Amos Here
Until _FL=True
Amos To Front
Fade 3,PAL(0),PAL(1),PAL(2),PAL(3),PAL(4),PAL(5),PAL(6),PAL(7)
Wait 3*30
_WINDCLOSE[1]
_WINDOPEN[1,400,0,240,10,"Menu System V"+VER$+"",0]
End If
End If
End Proc
Procedure _REDO_ROW[_ROW]
_COL=0
Ink 0
Bar 2,14+(_ROW*11) To 626,23+(_ROW*11)
BN=_ROW*4
Repeat
BUT=BN+_COL
If MNI(BUT,2)>-1
_GENERATE_BUTTON[_ROW,_COL,BUT,MNI(BUT,4)]
End If
Inc _COL
Until _COL=4
End Proc
Procedure _LOAD[FIL$]
If Exist(FIL$)=True
_CRIPT$="ABCDEFGHIJLKLMNOPQRSTUVWXYXZ"
_FOUND=True
Open In 1,FIL$
Input #1,VS$
If VS$="5.00"
Input #1,_SYS$
For CL=0 To 7
Input #1,PAL(CL)
Next
For I=0 To 4
Input #1,_STR$
For N=0 To 90
CHAR$=Mid$(_STR$,N+1,1)
MNI(N,I)=Instr(_CRIPT$,CHAR$)-2
Next
Next
For I=0 To 2
For N=0 To 90
Line Input #1,MNU$(N,I)
Next
Next
Else
_FOUND=False
End If
Close 1
Else
_FOUND=False
End If
End Proc[_FOUND]