home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Unsorted / SampleLens.AMOS / SampleLens.amosSourceCode
Encoding:
AMOS Source Code  |  1999-06-16  |  3.6 KB  |  129 lines
  1. Screen Open 1,640,512,4,$8004 : Screen Hide 
  2. Curs Off : Flash Off : Pen 1 : Paper 0 : Cls 
  3. Palette 0,$FFF,$FF0,$FF
  4. Screen Open 0,640,512,4,$8004
  5. Curs Off : Flash Off : Pen 1 : Paper 0 : Cls 
  6. Palette 0,$FFF,$FF0,$FF
  7. Wait Vbl : Limit Mouse 
  8. F$="REC:Test.aiff"
  9. Reserve As Work 9,1024
  10. ST=Start(9)
  11. Open In 1,F$
  12.    Extension_8_17A6 1 To ST,1024
  13. 'Close 1 
  14. AD=Hunt(ST To ST+1024,"SSND")
  15. LE=Leek(AD+4)/4
  16. OF=AD+8-ST
  17. LASTLOAD=-1
  18. For X=0 To 639
  19.   POS=(X*LE)/640
  20.   FETCHSAMP[POS]
  21.   V1= Extension_8_0BE4(Param) : V2= Extension_8_0BE4(Param+2)
  22.   Ink 2 : Draw X-1,OY1/128+256 To X,V1/128+256
  23.   Ink 3 : Draw X-1,OY2/128+256 To X,V2/128+256
  24.   OV1=V1 : OV2=V2
  25. Next 
  26. Screen Copy 0 To 1
  27. SCX=8 : SCY=64
  28. Do 
  29.   Multi Wait 
  30.   XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key
  31.   If OMK>0 and(OXM<>XM or OYM<>YM or MK=0)
  32.     X1=Max(OXM-65,0) : Y1=Max(OYM-65,0)
  33.     X2=Min(OXM+65,639) : Y2=Min(OYM+65,511)
  34.     Screen Copy 1,X1,Y1,X2+1,Y2+1 To 0,X1,Y1
  35.   End If 
  36.   If MK=1 and(OXM<>XM or OYM<>YM or OMK=0 or UPD)
  37.     X1=Max(XM-65,0) : Y1=Max(YM-65,0)
  38.     X2=Min(XM+65,639) : Y2=Min(YM+65,511)
  39.     POS=(XM*LE)/640
  40.     YP=(YM-256)*128
  41.     Cls 0,X1+1,Y1+1 To X2,Y2
  42.     Ink 1 : Box X1,Y1 To X2,Y2
  43.     FETCHSAMP[POS+(X1+1-XM)*SCX]
  44.     OV=YM+( Extension_8_0BE4(Param+2)-YP)/SCY
  45.     Clip X1,Y1 To X2,Y2
  46.     For X=X1+1 To X2-1
  47.       FETCHSAMP[POS+(X-XM)*SCX]
  48.       V=YM+( Extension_8_0BE4(Param)-YP)/SCY
  49.       If(OV>Y1 and V>Y1 and OV<Y2 and V<Y2) or Not((OV<Y1 and V<Y1) or(OV>Y2 and V>Y2))
  50.         Ink 2 : Draw X-1,OV To X,V
  51.       End If 
  52.       If V>Y1 and V<Y2
  53. '        Circle X,V,2
  54.       End If 
  55.       OV=V
  56.     Next 
  57.     Clip 0,0 To 640,512
  58.   End If 
  59.   If MK=2 and(OXM<>XM or OYM<>YM or OMK=0 or UPD)
  60.     X1=Max(XM-65,0) : Y1=Max(YM-65,0)
  61.     X2=Min(XM+65,639) : Y2=Min(YM+65,511)
  62.     POS=(XM*LE)/640
  63.     YP=(YM-256)*128
  64.     Cls 0,X1+1,Y1+1 To X2,Y2
  65.     Ink 1 : Box X1,Y1 To X2,Y2
  66.     FETCHSAMP[POS+(X1+1-XM)*SCX]
  67.     OV=YM+( Extension_8_0BE4(Param+2)-YP)/SCY
  68.     Clip X1,Y1 To X2,Y2
  69.     For X=X1+1 To X2-1
  70.       FETCHSAMP[POS+(X-XM)*SCX]
  71.       V=YM+( Extension_8_0BE4(Param+2)-YP)/SCY
  72.       If(OV>Y1 and V>Y1 and OV<Y2 and V<Y2) or Not((OV<Y1 and V<Y1) or(OV>Y2 and V>Y2))
  73.         Ink 3 : Draw X-1,OV To X,V
  74.       End If 
  75.       If V>Y1 and V<Y2
  76. '        Circle X,V,2
  77.       End If 
  78.       OV=V
  79.     Next 
  80.     Clip 0,0 To 640,512
  81.   End If 
  82.   UPD=0
  83.   I$=Inkey$
  84.   If I$=Cup$ Then SCY=SCY/2 : UPD=1
  85.   If I$=Cdown$ Then SCY=SCY*2 : UPD=1
  86.   If I$=Cleft$ Then Dec SCX : UPD=1
  87.   If I$=Cright$ Then Inc SCX : UPD=1
  88.   If UPD Then Home : Cline : Print SCX : Cline : Print SCY
  89.   OXM=XM : OYM=YM : OMK=MK
  90. Loop 
  91. End 
  92.   If MK=1 and(OXM<>XM or OYM<>YM or OMK=0)
  93.     X1=Max(XM-65,0) : Y1=Max(YM-65,0)
  94.     X2=Min(XM+65,639) : Y2=Min(YM+65,511)
  95.     POS=(XM*LE)/640
  96.     YP=(YM-256)*128
  97.     Cls 0,X1+1,Y1+1 To X2,Y2
  98.     Ink 1 : Box X1,Y1 To X2,Y2
  99.     OV1=YM : OV2=YM
  100.     Clip X1,Y1 To X2,Y2
  101.     For X=X1+1 To X2-1
  102.       FETCHSAMP[POS+(X-XM)*8]
  103.       V1=YM+( Extension_8_0BE4(Param)-YP)/64 : V2=YM+( Extension_8_0BE4(Param+2)-YP)/64
  104.       If(OV1>Y1 and V1>Y1 and OV1<Y2 and OV1<Y2) or(OV1<Y1 and V1>Y2) or(OV1>Y2 and V1<Y1)
  105.         Ink 2 : Draw X-1,OV1 To X,V1
  106.       End If 
  107.       If(OV2>Y1 and V2>Y1 and OV2<Y2 and OV2<Y2) or(OV2<Y1 and V2>Y2) or(OV2>Y2 and V2<Y1)
  108.         Ink 3 : Draw X-1,OV2 To X,V2
  109.       End If 
  110.       If V1>Y1 and V1<Y2
  111.         Plot X,V1,2
  112.       End If 
  113.       If V2>Y1 and V2<Y2
  114.         Plot X,V2,3
  115.       End If 
  116.       OV1=V1
  117.       OV2=V2
  118.     Next 
  119.     Clip 0,0 To 640,512
  120.   End If 
  121. Procedure FETCHSAMP[P]
  122.   Shared LASTLOAD,LE,ST,OF
  123.   If LASTLOAD*256=>P and LASTLOAD*256+256<P
  124.     Pop Proc[ST+(P mod 256)*4]
  125.   End If 
  126.   LASTLOAD=P/256
  127.   Pof(1)=LASTLOAD*1024+OF
  128.    Extension_8_17A6 1 To ST,1024
  129. End Proc[ST+(P mod 256)*4]