/*
clip.c original code by Thomas Rapp
clip.e by ghh 2022
*/
OPT PREPROCESS
MODULE 'utility/tagitem','dos/dos','exec/memory','exec/ports'
MODULE 'intuition/intuition','intuition/screens'
MODULE 'layers',
'graphics/view',
'graphics/rastport',
'graphics/gfx',
'graphics/regions',
'graphics/gfxbase',
'graphics/layers','graphics/clip'
/*----------------------------------------------------------------------------*/
/* Constants and macros */
/*----------------------------------------------------------------------------*/
CONST MAXVEC = 20 /* maximum number of Area calls before AreaEnd */
/*----------------------------------------------------------------------------*/
/* Type definitions */
/*----------------------------------------------------------------------------*/
OBJECT draw_area
bm:PTR TO bitmap
rp:PTR TO rastport
layerinfo:PTR TO layer_info
layer:PTR TO layer
tmpbuf:PTR TO BYTE
tmpras:tmpras
areabuf:PTR TO BYTE
areainfo:areainfo
ENDOBJECT
/*----------------------------------------------------------------------------*/
/* Free resources of a draw_area structure */
/*----------------------------------------------------------------------------*/
PROC free_draw_area(da:PTR TO draw_area)
IF (da.areabuf) THEN FreeVec(da.areabuf)
IF (da.tmpbuf) THEN FreeVec(da.tmpbuf)
IF (da.layer) THEN DeleteLayer(0,da.layer)
IF (da.layerinfo) THEN DisposeLayerInfo(da.layerinfo)
IF (da.bm) THEN FreeBitMap(da.bm)
FreeVec(da)
ENDPROC
/*----------------------------------------------------------------------------*/
/* Allocate and initialize a draw area for off-screen drawing with clipping */
/*----------------------------------------------------------------------------*/
PROC new_draw_area(width,height,friend:PTR TO bitmap)
DEF da:PTR TO draw_area
DEF rassize
da:= AllocVec(SIZEOF draw_area,MEMF_CLEAR)
IF (da = NIL) THEN RETURN NIL
da.bm:= AllocBitMap(width,height,GetBitMapAttr(friend,BMA_DEPTH),
BMF_CLEAR OR BMF_MINPLANES,friend)
IF (da.bm)
da.layerinfo:= NewLayerInfo()
ENDIF
IF (da.layerinfo) THEN da.layer:= CreateUpfrontLayer(da.layerinfo,da.bm,
0,0,width - 1,height - 1,0,NIL)
IF (da.layer) THEN da.rp:= da.layer.rp
IF (da.rp = NIL)
free_draw_area(da)
RETURN NIL
ENDIF
/* the following is needed to use the Area commands. It is not related to clipping */
rassize:= RASSIZE((width*2)+16,(height*2)+16) /* the tmpras must cover the entire */
/* area which is calculated before */
/* clipping and not only the part */
/* which is drawn after clipping */
IF (da.tmpbuf:= AllocVec(rassize,MEMF_CHIP OR MEMF_CLEAR))
InitTmpRas (da.tmpras,da.tmpbuf,rassize)
da.rp.tmpras:= da.tmpras
ENDIF
IF (da.areabuf:= AllocVec(5*MAXVEC,MEMF_CLEAR))
InitArea(da.areainfo,da.areabuf,MAXVEC)
da.rp.areainfo:= da.areainfo
ENDIF
ENDPROC da
/*----------------------------------------------------------------------------*/
/* Draw a sequence of circles into the drawing area */
/*----------------------------------------------------------------------------*/
PROC draw_something(rp:PTR TO rastport,size)
DEF r
DEF pen=1
DEF region:PTR TO region,oldregion:PTR TO region
DEF rect:rectangle
SetAPen(rp,pen)
RectFill(rp,0,0,size-1,size-1) /* fill the entire area */
r:= size
WHILE (r > 0) /* draw colored circles */
/* center is in the lower left of the */
/* drawing area */
SetAPen(rp,pen++) /* so that only the top right quarter */
/* of the circles */
AreaEllipse(rp,0,size-1,r+10,r+10) /* is drawn. */
AreaEnd(rp)
r -= 10
ENDWHILE
/* install a smaller clip region into the rastport */
IF (region:= NewRegion()) /* create a new region structure */
rect.minx:= (size / 2)
rect.miny:= (size / 2) - (size / 3)
rect.maxx:= (size / 2) + (size / 3)
rect.maxy:= (size / 2)
OrRectRegion(region,rect) /* add an area where can be drawn into to the region */
ENDIF
oldregion:= InstallClipRegion(rp.layer,region) /* install the region */
r:= (size / 3)
WHILE (r > 0)
SetAPen(rp,pen++)
AreaEllipse(rp,(size / 3) + (size / 3),(size / 2) - (size / 3),r,r)
AreaEnd(rp)
r -= 5
ENDWHILE
InstallClipRegion(rp.layer,oldregion) /* remove the new region and reinstall the old region */
IF (region) THEN DisposeRegion(region)
ENDPROC
/*----------------------------------------------------------------------------*/
/* Return the smaller of two numbers (signed) */
/*----------------------------------------------------------------------------*/
PROC min(a,b) IS (IF a < b THEN a ELSE b)
/*----------------------------------------------------------------------------*/
/* Main program */
/*----------------------------------------------------------------------------*/
PROC main()
DEF win:PTR TO window
DEF imsg:PTR TO intuimessage
DEF cont
DEF size
DEF da:PTR TO draw_area
IF (layersbase:=OpenLibrary('layers.library', 33))
IF win:= OpenWindowTagList(NIL,
[WA_Title,'Clip',
WA_Width,320,
WA_Height,240,
WA_Flags,WFLG_CLOSEGADGET OR WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR
WFLG_ACTIVATE OR WFLG_NOCAREREFRESH,
WA_IDCMP,IDCMP_CLOSEWINDOW OR IDCMP_VANILLAKEY,
TAG_END])
size:= min(win.gzzwidth,win.gzzheight) - 10
IF (da:= new_draw_area(size,size,win.rport.bitmap))
draw_something(da.rp,size)
BltBitMapRastPort(da.bm,0,0,win.rport,win.borderleft + ((win.gzzwidth - size) / 2),
win.bordertop + ((win.gzzheight - size) / 2),size,size,$c0)
free_draw_area(da)
ENDIF
cont:= TRUE
REPEAT
IF (Wait((1 << win.userport.sigbit) OR SIGBREAKF_CTRL_C) AND
SIGBREAKF_CTRL_C) THEN cont:= FALSE
WHILE (imsg:= GetMsg(win.userport))
SELECT (imsg.class)
CASE IDCMP_VANILLAKEY
IF (imsg.code = $1b)
cont:= FALSE
ENDIF
CASE IDCMP_CLOSEWINDOW
cont:= FALSE
ENDSELECT
ReplyMsg(imsg)
ENDWHILE
UNTIL (cont = FALSE)
CloseWindow (win)
ENDIF
IF layersbase THEN CloseLibrary(layersbase)
RETURN (RETURN_OK)
ENDIF
ENDPROC
/*----------------------------------------------------------------------------*/
/* End of source text */
/*----------------------------------------------------------------------------*/
|
