home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / various / arrows.amos / arrows.amosSourceCode
AMOS Source Code  |  1993-01-08  |  4KB  |  91 lines
  1. ' An example of how to use procedure Arrows  
  2. ' Firstly set up the screen
  3. SET_UP
  4. ' Now call Arrows procedure
  5. ARROWS_[10,50,-100,-50]
  6. ' Now get the number 
  7. NUM=Param
  8. ' Now print the number 
  9. Print Pen$(0)+"You selected number";NUM
  10. Procedure ARROWS_[SMALLEST,BIGGEST,X,Y]
  11.    'written by Brett George 
  12.    Curs Off : Reserve Zone : Reserve Zone 2 : Print 
  13.    _DRAW[252+X,75+Y,274+X,89+Y,1,""] : _DRAW[252+X,90+Y,274+X,104+Y,2,""] : Ink 0
  14.    Polygon 262+X,86+Y To 262+X,82+Y To 259+X,82+Y To 263+X,78+Y To 267+X,82+Y To 264+X,82+Y To 264+X,86+Y
  15.    Get Block 1,256+X,77+Y,16,10,0 : Get Block 2,256+X,77+Y,16,10,0 : Vrev Block 2
  16.    AZ=SMALLEST
  17.    PUSH[218+X,79+Y,244+X,94+Y,Str$(AZ)-" ",0]
  18.    _DRAW[252+X,75+Y,274+X,89+Y,-1," "] : _DRAW[252+X,90+Y,274+X,104+Y,-1," "]
  19.    Put Block 1 : Put Block 2,256+X,93+Y : ZB=3
  20.    Repeat 
  21.       If ZB=1 Then _DRAW[252+X,75+Y,274+X,89+Y,-1,""] : Put Block 1 : ZB=3
  22.       If ZB=2 Then _DRAW[252+X,90+Y,274+X,104+Y,-1,""] : Put Block 2,256+X,93+Y : ZB=3
  23.       While Mouse Key=1
  24.          If Mouse Zone=1
  25.             If ZB=3
  26.                ZB=1
  27.                PUSH[252+X,75+Y,274+X,89+Y,"",0] : Put Block 1
  28.             End If 
  29.             Wait 3
  30.             If AZ<BIGGEST
  31.                Inc AZ : Cls 1,222+X,82+Y To 242+X,91+Y : Text 224+X,89+Y,Str$(AZ)-" "
  32.             End If 
  33.          End If 
  34.          If Mouse Zone=2
  35.             If ZB=3
  36.                ZB=2
  37.                PUSH[252+X,90+Y,274+X,104+Y,"",0] : Put Block 2,256+X,93+Y
  38.             End If 
  39.             Wait 3
  40.             If AZ>SMALLEST
  41.                Dec AZ : Cls 1,222+X,82+Y To 242+X,91+Y : Text 224+X,89+Y,Str$(AZ)-" "
  42.             End If 
  43.          End If 
  44.       Wend 
  45.    Until(Mouse Key=3) or(Inkey$=" ")
  46.    Cls : Curs On : Reserve Zone : Print : Del Block : ZB=0
  47. End Proc[AZ]
  48. Procedure PUSH[X,Y,X1,Y1,MESSAGE$,TIME]
  49.    'by Brett George 
  50.    Ink 1 : Bar X,Y To X1,Y1
  51.    If MESSAGE$<>""
  52.       Ink 0 : Box X-1,Y-1 To X1+1,Y1+1
  53.       Ink 1 : Plot X-1,Y-1 : Plot X-1,Y1+1 : Plot X1+1,Y-1 : Plot X1+1,Y1+1
  54.    End If 
  55.    Ink 5 : Draw X1,Y1 To X,Y1 : Draw X1,Y1-1 To X+1,Y1-1
  56.    Draw X1,Y1 To X1,Y : Draw X1-1,Y1-1 To X1-1,Y : Ink 4
  57.    Draw X,Y To X1,Y : Draw X,Y+1 To X1-1,Y+1 : Draw X,Y To X,Y1
  58.    Draw X+1,Y To X+1,Y1-1 : _=((X+X1)/2-(Text Length(MESSAGE$))/2)-2 : Ink 0
  59.    If MESSAGE$<>""
  60.       Gr Writing 0 : Ink 4
  61.       If(X+X1)/2<213 : Dec _ : ZZZ=-1 : End If 
  62.       If(X+X1)/2<426 : Inc _ : ZZZ=1 : End If 
  63.       Text _,(Y+Y1)/2+(Text Base/2)+1,MESSAGE$ : Ink 0
  64.       If ZZZ : Inc _ : End If 
  65.       If ZZZ=1 : Dec _ : End If 
  66.       Text _,(Y+Y1)/2+Text Base/2,MESSAGE$
  67.    End If 
  68.    If TIME>0 Then Wait TIME : _DRAW[X,Y,X1,Y1,-1,MESSAGE$] : Wait TIME
  69. End Proc
  70. Procedure _DRAW[X,Y,X1,Y1,NUM,MESSAGE$]
  71.    Ink 0 : Box X-1,Y-1 To X1+1,Y1+1
  72.    Ink 1 : Plot X-1,Y-1 : Plot X-1,Y1+1 : Plot X1+1,Y-1 : Plot X1+1,Y1+1
  73.    Ink 1 : Bar X,Y To X1,Y1 : Ink 4 : Draw X1,Y1 To X,Y1
  74.    Draw X1,Y1-1 To X+1,Y1-1 : Draw X1,Y1 To X1,Y : Draw X1-1,Y1 To X1-1,Y-1
  75.    Ink 5 : Draw X,Y To X1,Y : Draw X,Y+1 To X1-1,Y+1
  76.    Draw X,Y To X,Y1 : Draw X+1,Y To X+1,Y1-1 : If NUM>0 Then Set Zone NUM,X,Y To X1,Y1 : Ink 0
  77.    If MESSAGE$<>""
  78.       _=((X+X1)/2-(Text Length(MESSAGE$))/2)-2 : Gr Writing 0 : Ink 4
  79.       If(X+X1)/2<213 : Dec _ : ZZZ=-1 : End If 
  80.       If(X+X1)/426 : Inc _ : ZZZ=1 : End If 
  81.       Text _,(Y+Y1)/2+(Text Base/2)+1,MESSAGE$ : Ink 0
  82.       If ZZZ : Inc _ : End If 
  83.       If ZZZ=1 : Dec _ : End If 
  84.       Text _,(Y+Y1)/2+Text Base/2,MESSAGE$
  85.    End If 
  86. End Proc
  87. Procedure SET_UP
  88.    'by Brett George 
  89.    Screen Open 0,640,256,16,Hires : Curs Off : Flash Off 
  90.    Palette 0,$888,$777,$CCC,$444,$999 : Cls 1
  91. End Proc