' This is the freeform block routine ' By Stefan Posthuma ' ------------------ ' It works in monochrome ' ' It needs a little Y-coordinate adjustment for Lo-res ' DEFFILL 1,2,4 PBOX 30,30,610,370 DEFFILL 1,2,6 PBOX 90,90,550,310 ' now we have a nice screen to fool around with DO @rubcircle !capture your block with a rubber circle IF k%=1 !left mousebutton pressed? @make_mask !yes, make the mask @free_move !move the block @wait !wait until user release mousebuttons ENDIF LOOP ' PROCEDURE rubcircle REPEAT MOUSE x%,y%,k% UNTIL k% !wait for press of mousebutton IF k%=2 !left button -> exit program EDIT ENDIF @wait !release those mousebuttons GRAPHMODE 3 !xor modus x1%=x% !old x position y1%=y% !old y position cx%=x% !centre of circle cy%=y% r%=0 !radius of circle CIRCLE cx%,cy%,r% !draw the first circle REPEAT MOUSE x%,y%,k% !get mouse IF x%<>x1% OR y%<>y1% !mouse moved? x1%=x% !yes, oldpos = newpos y1%=y% CIRCLE cx%,cy%,r% !erase old circle r%=MAX(ABS(y%-cy%),ABS(x%-cx%)) !determine radius CIRCLE cx%,cy%,r% !draw new circle ENDIF UNTIL k% !end this if you press a mousebutton @wait !wait until you release the button CIRCLE cx%,cy%,r% !erase cirlce GRAPHMODE 1 !normal graphic mode minx%=MAX(0,cx%-r%) !get coordinates of square around circle miny%=MAX(0,cy%-r%) !these are not allowed to be outside the screen maxx%=MIN(639,cx%+r%) maxy%=MIN(399,cy%+r%) RETURN ' PROCEDURE make_mask SGET pic$ !save screen CLS DEFFILL 1,1,0 !black mask PCIRCLE cx%,cy%,r% !draw the mask (a disk in this case) GET minx%,miny%,maxx%,maxy%,mask$ !grab the mask SPUT pic$ !restore screen RETURN !that's it ' PROCEDURE free_move !this is the important stuff HIDEM !get rid of mouse PUT minx%,miny%,mask$,1 !mask off parts outside the mask GET minx%,miny%,maxx%,maxy%,block$ !get the block SPUT pic$ !restore screen ' PUT minx%,miny%,mask$,4 !empty part where block came from SGET pic$ !get screen ' ' if you omit the 2 lines above, you copy the block instead of moving it ' MOUSE x%,y%,k% !get mouse PUT x%,y%,mask$,4 !make part of screen empty where block comes PUT x%,y%,block$,7 !put the block in transparent mode x1%=x% !old X-pos y1%=y% !old Y-pos REPEAT REPEAT MOUSE x%,y%,k% IF x1%<>x% OR y1%<>y% !mouse moved? SPUT pic$ !yes, restore screen x1%=x% !oldpos = newpos y1%=y% PUT x%,y%,mask$,4 !empty part of screen where block comes PUT x%,y%,block$,7 !put block ENDIF UNTIL k% !until you press a mousebutton IF k%=1 !pressed left button? SGET pic$ !get picture like this ENDIF UNTIL k%=2 !until you press right mousebutton SHOWM !here is our mouse again SPUT pic$ !restore picture RETURN ' PROCEDURE wait !wait until mousebuttons are released REPEAT UNTIL MOUSEK=0 RETURN