MODULE 'intuition/screens', 'graphics/rastport', 'graphics/gfx',
			 'exec/memory', 'graphics/scale'

DEF tempbmap:PTR TO bitmap, myrast:rastport,
		scr:PTR TO screen,rast:PTR TO rastport,r=0,
		scaleargs:bitscaleargs

PROC main()

	IF scr:=OpenS(640,256,3,$8000,'Test screen!',NIL)
		rast:=scr.rastport
		IF tempbmap:=createbitmap(640,1024,3,BMF_CLEAR,rast.bitmap)
			InitRastPort(myrast)
			myrast.bitmap:=tempbmap
			clearshitt()

			scaleargs.srcx:=10
			scaleargs.srcy:=52
			scaleargs.srcwidth:=325
			scaleargs.srcheight:=64
			scaleargs.xsrcfactor:=2
			scaleargs.ysrcfactor:=1
			scaleargs.destx:=10
			scaleargs.desty:=52
			scaleargs.destwidth:=32
			scaleargs.destheight:=32
			scaleargs.xdestfactor:=3
			scaleargs.ydestfactor:=1
			scaleargs.srcbitmap:=myrast.bitmap
			scaleargs.destbitmap:=scr.bitmap
			scaleargs.flags:=NIL
			
			fakepattern()
			FOR r:=0 TO 63
				movedisplay(r)
			ENDFOR
			Delay(50)
			deletebitmap(tempbmap)
		ENDIF
		CloseS(scr)
	ENDIF

 CleanUp(0)
ENDPROC

PROC movedisplay(r)
/*
	BltBitMap(myrast.bitmap,10,52+24+((r-3)*8),myrast.bitmap,10,52+24+((r-3)*8),400,8,$030,$3,NIL)
	BltBitMap(myrast.bitmap,10,52+((r-3)*8),scr.bitmap,40,036,400,8*8,$0C0,$3,NIL)			
	BltBitMap(myrast.bitmap,10,52+24+((r-3)*8),myrast.bitmap,10,52+24+((r-3)*8),400,8,$030,$3,NIL)
*/
	scaleargs.srcy:=52+((r-3)*8)
	scaleargs.desty:=036
	BitMapScale(scaleargs)
ENDPROC





PROC createbitmap(width,height,depth,flags,friend:PTR TO bitmap)
  DEF bm:PTR TO bitmap,memflags,pl:PTR TO LONG,i
  IF KickVersion(39)
    bm:=AllocBitMap(width,height,depth,flags,friend)
  ELSE
    memflags:=MEMF_CHIP OR MEMF_CLEAR
    IF bm:=New(SIZEOF bitmap)
      InitBitMap(bm,depth,width,height)
      pl:=bm.planes
      IF flags AND BMF_CLEAR THEN memflags:=memflags OR MEMF_CLEAR
      pl[0]:=AllocVec(depth*rassize(width,height),memflags)
      IF pl[0]
        FOR i:=1 TO depth-1 DO pl[i]:=pl[i-1]+rassize(width,height)
      ELSE
        Dispose(bm)
      ENDIF
    ENDIF
  ENDIF
ENDPROC bm

PROC deletebitmap(bm:PTR TO bitmap)
  IF bm
    IF KickVersion(39)
      FreeBitMap(bm)
     ELSE
       FreeVec(Long(bm.planes))
       Dispose(bm)
     ENDIF
  ENDIF
ENDPROC

PROC rassize(w,h) IS Shr(w+15,3) AND $FFFE * h

PROC clearshitt()
DEF o,x
	IF o:=SetStdRast(myrast)
		FOR x:=0 TO 8*74 STEP 8
			TextF(10,10+x,'                                                  ')
		ENDFOR
		SetStdRast(o)
	ENDIF
ENDPROC

PROC fakepattern()
DEF o,x,y=0
	IF o:=SetStdRast(myrast)
		SetAPen(stdrast,1)
		FOR x:=0 TO 8*62 STEP 8
			INC y
			TextF(10,58+x,'\z\d[2]|---00000|---00000|---00000|---00000',y)
		ENDFOR
		SetStdRast(o)
	ENDIF
ENDPROC