home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / PdSrc / scroll.e < prev    next >
Encoding:
Text File  |  1996-08-29  |  3.2 KB  |  102 lines
  1. MODULE 'exec/memory',
  2.        'intuition/intuition','intuition/screens',
  3.        'graphics/text','graphics/view'
  4.  
  5. CONST NUMIMAGE=4,IMAGEDATASIZE=2*16*2,SCROLLSPEED=1
  6.  
  7. ENUM ER_NONE,ER_NOSCRN,ER_NOMEM
  8.  
  9. DEF s=NIL,w=NIL:PTR TO window,sprite=NIL,imagedata=NIL
  10.  
  11. PROC setupimages()
  12.   IF (imagedata:=AllocVec(NUMIMAGE*IMAGEDATASIZE,
  13.                           MEMF_CHIP OR MEMF_CLEAR))=NIL THEN Raise(ER_NOMEM)
  14.   CopyMemQuick([$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,
  15.                 $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,
  16.                 $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,
  17.                 $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,
  18.  
  19.                 $FFFF,$FFFF,$C003,$C003,$C003,$C003,$C3C3,$C3C3,
  20.                 $C3C3,$C3C3,$C003,$C003,$C003,$C003,$FFFF,$FFFF,
  21.                 $0000,$0000,$0000,$0000,$0000,$0000,$03C0,$03C0,
  22.                 $03C0,$03C0,$0000,$0000,$0000,$0000,$0000,$0000,
  23.  
  24.                 $0000,$0000,$0000,$0000,$0000,$0000,$03C0,$03C0,
  25.                 $03C0,$03C0,$0000,$0000,$0000,$0000,$0000,$0000,
  26.                 $FFFF,$FFFF,$C003,$C003,$C003,$C003,$C003,$C003,
  27.                 $C003,$C003,$C003,$C003,$C003,$C003,$FFFF,$FFFF,
  28.  
  29.                 $FFFF,$FFFF,$C003,$C003,$C003,$C003,$C003,$C003,
  30.                 $C003,$C003,$C003,$C003,$C003,$C003,$FFFF,$FFFF,
  31.                 $FFFF,$FFFF,$C003,$C003,$C003,$C003,$C3C3,$C3C3,
  32.                 $C3C3,$C3C3,$C003,$C003,$C003,$C003,$FFFF,$FFFF]:INT,
  33.                 imagedata,NUMIMAGE*IMAGEDATASIZE)
  34. ENDPROC
  35.  
  36. PROC setupscreen()
  37.   CloseWorkBench()
  38.   IF (s:=OpenScreenTagList(NIL,
  39.     [SA_WIDTH,784,SA_HEIGHT,200,SA_DEPTH,2,SA_DISPLAYID,0,
  40.      SA_QUIET,TRUE,SA_FONT,['topaz.font',8,0,0]:textattr,
  41.      SA_OVERSCAN,OSCAN_TEXT,
  42.      0,0]))=NIL THEN Raise(ER_NOSCRN)
  43.   IF (w:=OpenWindowTagList(NIL,
  44.     [WA_LEFT,0,WA_TOP,0,WA_WIDTH,784,WA_HEIGHT,256,
  45.      WA_IDCMP,0,
  46.      WA_FLAGS,WFLG_SIMPLE_REFRESH OR WFLG_NOCAREREFRESH OR
  47.               WFLG_BORDERLESS OR WFLG_ACTIVATE OR WFLG_RMBTRAP,
  48.      WA_CUSTOMSCREEN,s,
  49.      WA_MOUSEQUEUE,0,WA_RPTQUEUE,0,
  50.      0,0]))=NIL THEN Raise(ER_NOSCRN)
  51.   IF sprite:=AllocMem(20,MEMF_CHIP OR MEMF_CLEAR)
  52.     SetPointer(w,sprite,1,16,0,0)
  53.   ENDIF
  54.   LoadRGB4(ViewPortAddress(w),
  55.            [$000,$F00,$0F0,$FF0]:INT,16)
  56. ENDPROC
  57.  
  58. PROC shutdown()
  59.   IF w THEN CloseWindow(w)
  60.   IF sprite THEN FreeMem(sprite,20)
  61.   IF s THEN CloseScreen(s)
  62.   IF imagedata THEN FreeVec(imagedata)
  63.   OpenWorkBench()
  64. ENDPROC
  65.  
  66. PROC scroll()
  67.   DEF vp:PTR TO viewport,bigx,smallx,tile,imagenum,i,r,ypos
  68.   r:=w.rport
  69.   vp:=s+44
  70.   REPEAT
  71.     FOR bigx:=0 TO 384 STEP 16
  72.       IF Mouse()
  73.         Raise(ER_NONE)
  74.       ENDIF
  75.       FOR smallx:=0 TO 15 STEP SCROLLSPEED
  76.         PutInt(vp.rasinfo+8,32+bigx+smallx)
  77.         ScrollVPort(vp)
  78.         WaitTOF()
  79.         FOR tile:=0 TO SCROLLSPEED-1
  80.           IF smallx+tile<12
  81.             imagenum:=Rnd(NUMIMAGE)
  82.             ypos:=smallx+tile*16
  83.             i:=[0,0,16,16,1,imagenum*IMAGEDATASIZE+imagedata,3,0,NIL]:image
  84.             DrawImage(r,i,bigx,ypos)
  85.             DrawImage(r,i,bigx+400,ypos)
  86.           ENDIF
  87.         ENDFOR
  88.       ENDFOR
  89.     ENDFOR
  90.   UNTIL FALSE
  91. ENDPROC
  92.  
  93. PROC main() HANDLE
  94.   setupimages()
  95.   setupscreen()
  96.   scroll()
  97.   Raise(ER_NONE)
  98. EXCEPT
  99.   shutdown()
  100.   IF exception<>ER_NONE THEN WriteF('There was an error.\n')
  101. ENDPROC
  102.