/* Programmname bob4.c */
/* bob4.c original C code by Thomas Rapp */
/* bob4.e by ghh 2022 */
/*--------------------------------------------------------------------------*/
/* System Includes */
/*--------------------------------------------------------------------------*/
OPT PREPROCESS
MODULE 'dos/rdargs','devices/inputevent'
MODULE 'utility/tagitem','exec/ports','exec/memory'
MODULE 'intuition/intuition','intuition/screens'
MODULE 'graphics/rastport','graphics/gfx'
MODULE 'cybergraphx/cybergraphics'
/*--------------------------------------------------------------------------*/
/* Konstanten und Makros */
/*--------------------------------------------------------------------------*/
CONST WINX = 80
CONST WINY = 40
CONST WINW = 200
CONST WINH = 100
CONST BOBW = 80
CONST BOBH = 40
CONST BOBMINX = 40
CONST BOBMINY = 20
CONST BOBMAXX = (BOBMINX+BOBW-1)
CONST BOBMAXY = (BOBMINY+BOBH-1)
/*--------------------------------------------------------------------------*/
/* Typdefinitionen */
/*--------------------------------------------------------------------------*/
OBJECT bob
rp:PTR TO rastport
x
y
w
h
bm:PTR TO bitmap
backx
backy
backw
backh
back:PTR TO bitmap
ENDOBJECT
OBJECT args
pubscreen:PTR TO CHAR
ENDOBJECT
DEF args:args /* global */
/*--------------------------------------------------------------------------*/
/* */
/*--------------------------------------------------------------------------*/
PROC cut_bob (bob:PTR TO bob,rp:PTR TO rastport,x,y)
DEF temprp:rastport
IF (bob)
InitRastPort(temprp)
temprp.bitmap:= bob.bm
ClipBlit(rp,x,y,temprp,0,0,bob.w,bob.h,$c0)
ENDIF
ENDPROC
/*--------------------------------------------------------------------------*/
/* */
/*--------------------------------------------------------------------------*/
PROC remove_bob (bob:PTR TO bob)
IF (bob)
IF (bob.rp)
BltBitMap(bob.back,bob.backx,bob.backy,bob.rp.bitmap,
bob.x + bob.backx,bob.y + bob.backy,bob.backw,
bob.backh,$c0,$ff,NIL)
bob.rp:= NIL
ENDIF
ENDIF
ENDPROC
/*--------------------------------------------------------------------------*/
/* */
/*--------------------------------------------------------------------------*/
PROC add_bob(rp:PTR TO rastport,bob:PTR TO bob)
DEF scrw,scrh,x,y
IF (bob)
IF (bob.rp) THEN remove_bob(bob)
bob.rp:= rp
bob.backw:= bob.w
bob.backh:= bob.h
scrw:= GetBitMapAttr(rp.bitmap,BMA_WIDTH)
scrh:= GetBitMapAttr(rp.bitmap,BMA_HEIGHT)
IF ((bob.x + bob.backw) > scrw) THEN
bob.backw:= scrw - bob.x
IF ((bob.y + bob.backh) > scrh) THEN
bob.backh:= scrh - bob.y
bob.backx:= 0
bob.backy:= 0
IF (bob.x < 0)
bob.backx:= -bob.x
bob.backw -= bob.backx
ENDIF
IF (bob.y < 0)
bob.backy:= -bob.y
bob.backh -= bob.backy
ENDIF
x:= bob.x + bob.backx;
y:= bob.y + bob.backy;
BltBitMap(rp.bitmap,x,y,bob.back,bob.backx,bob.backy,bob.backw,
bob.backh,$c0,$ff,NIL)
BltBitMap(bob.bm,bob.backx,bob.backy,rp.bitmap,x,y,bob.backw,
bob.backh,$c0,$ff,NIL)
ENDIF
ENDPROC
/*--------------------------------------------------------------------------*/
/* */
/*--------------------------------------------------------------------------*/
PROC move_bob(bob:PTR TO bob,x,y)
DEF rp:PTR TO rastport
IF (bob)
IF (rp:= bob.rp) THEN
remove_bob(bob)
bob.x:= x
bob.y:= y
IF (rp) THEN
add_bob(rp,bob)
ENDIF
ENDPROC
/*--------------------------------------------------------------------------*/
/* */
/*--------------------------------------------------------------------------*/
PROC free_bob(bob:PTR TO bob)
IF (bob)
IF (bob.rp) THEN
remove_bob(bob)
IF (bob.bm) THEN
FreeBitMap(bob.bm)
IF (bob.back) THEN
FreeBitMap(bob.back)
FreeMem (bob,SIZEOF bob)
ENDIF
ENDPROC
/*--------------------------------------------------------------------------*/
/* */
/*--------------------------------------------------------------------------*/
PROC new_bob(w,h,d)
DEF bob:PTR TO bob
IF (bob:= AllocMem (SIZEOF bob,MEMF_CLEAR))
bob.w:= w
bob.h:= h
IF (d > 8) THEN d:= 24
bob.bm:= AllocBitMap(w,h,d,IF d = 24 THEN BMF_SPECIALFMT OR
SHIFT_PIXFMT(PIXFMT_BGR24) ELSE 0,NIL)
bob.back:= AllocBitMap(w,h,d,IF d = 24 THEN BMF_SPECIALFMT OR
SHIFT_PIXFMT(PIXFMT_BGR24) ELSE 0,NIL)
IF ((bob.bm = NIL) AND (bob.back = NIL))
free_bob(bob)
bob:= NIL
ENDIF
ENDIF
ENDPROC (bob)
/*--------------------------------------------------------------------------*/
/* Hauptprogramm */
/*--------------------------------------------------------------------------*/
PROC main()
DEF rdargs:PTR TO rdargs
DEF scr:PTR TO screen
DEF win:PTR TO window
DEF port:PTR TO mp
DEF mess:PTR TO intuimessage
DEF cont
DEF rp:PTR TO rastport
DEF i
DEF bob:PTR TO bob
DEF diffx,diffy
IF (rdargs:= ReadArgs('PUBSCREEN/K',args,NIL))
IF (scr:= LockPubScreen(args.pubscreen))
IF (win:= OpenWindowTagList (NIL,
[WA_CustomScreen,scr,
WA_Width,WINW,
WA_Height,WINH,
WA_Left,WINX,
WA_Top,WINY,
WA_Flags,WFLG_CLOSEGADGET OR WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR
WFLG_REPORTMOUSE OR WFLG_RMBTRAP OR WFLG_GIMMEZEROZERO OR
WFLG_ACTIVATE,
WA_IDCMP,IDCMP_CLOSEWINDOW OR IDCMP_MOUSEMOVE OR IDCMP_MOUSEBUTTONS,
TAG_END]))
rp:= win.rport
i:= 0
WHILE (i < BOBW )
SetAPen (rp,(i AND 3) + 1)
Move (rp,i+BOBMINX,BOBMINY)
Draw (rp,BOBMAXX-i,BOBMAXY)
i++
ENDWHILE
i:= 0
WHILE (i < BOBH )
SetAPen (rp,(i AND 3) + 1)
Move (rp,BOBMAXX,i+BOBMINY)
Draw (rp,BOBMINX,BOBMAXY-i)
i++
ENDWHILE
bob:= new_bob(BOBW,BOBH,GetBitMapAttr(scr.rastport.bitmap,BMA_DEPTH))
cut_bob(bob,rp,BOBMINX,BOBMINY)
RectFill(rp,BOBMINX,BOBMINY,BOBMAXX,BOBMAXY)
rp:= scr.rastport
port:= win.userport
cont:= TRUE
WHILE(cont)
WaitPort(port)
WHILE (mess:= GetMsg(port))
SELECT (mess.class)
CASE IDCMP_CLOSEWINDOW
cont:= FALSE
CASE IDCMP_MOUSEMOVE
move_bob(bob,scr.mousex - diffx,scr.mousey - diffy)
CASE IDCMP_MOUSEBUTTONS
IF (mess.code = IECODE_LBUTTON)
IF (win.gzzmousex >= BOBMINX AND win.gzzmousex <= BOBMAXX AND
win.gzzmousey >= BOBMINY AND win.gzzmousey <= BOBMAXY)
diffx:= scr.mousex - win.leftedge - win.borderleft - BOBMINX
diffy:= scr.mousey - win.topedge - win.bordertop - BOBMINY
move_bob (bob,scr.mousex - diffx,scr.mousey - diffy)
add_bob (scr.rastport,bob)
ENDIF
ELSE
remove_bob(bob)
ENDIF
ENDSELECT
ReplyMsg(mess)
ENDWHILE
EXIT cont = FALSE
ENDWHILE
remove_bob(bob)
free_bob(bob)
CloseWindow(win)
ENDIF
UnlockPubScreen(NIL,scr)
ENDIF
FreeArgs(rdargs)
ELSE
PrintFault(IoErr(),NIL)
ENDIF
ENDPROC 0
/*--------------------------------------------------------------------------*/
/* Ende des Quelltextes */
/*--------------------------------------------------------------------------*/
|
