\ Another areafill demo \ by Don Colburn, CSI \ Large portions derived from work done by Bob Benedict, Dave Butler \ This demo is the result of questions that we have received about \ Amiga AreaFill facilities. \ This demo provides common PolyDraw and PolyFill operators that expect \ the same stack arguments. If no temporary raster is supplied in the \ supplied designated rasterport, this code \ allocates, and initializes one. It is deallocated, if appropriate, \ upon exit. anew demomarker \ define a custom screen struct NewScreen demoscrn demoscrn InitScreen \ copy default values to new screen structend \ define window for demo struct NewWindow demowindow \ define a window demowindow InitWindow \ copy default values to new window 0 demowindow +nwLeftEdge w! 10 demowindow +nwTopEdge w! 640 demowindow +nwWidth w! 190 demowindow +nwHeight w! 0" Multi-Forth " demowindow +nwTitle ! WINDOWSIZING WINDOWDRAG | WINDOWCLOSE | ACTIVATE | \ set flags GIMMEZEROZERO | demowindow +nwFlags ! fCLOSEWINDOW demowindow +nwIDCMPFlags ! CUSTOMSCREEN demowindow +nwType w! \ open on a custom screen structend \ \ 4th polygon creation and translation \ : p, ( x1\y1\dx\dy --x2\y2 ) \ emplace point into object at here negate +point 2dup ( reflect in y from q1 to q4 ) swap here 4 allot !point ; create 4thpoints \ list of relative points comprising 4th symbol \ in relative coordinates. If the xformation matrix \ is applied to these points, integrating the current \ position, an absolute list results \ point pairs are compatible with polydraw format 33 , \ # of point pairs 0 0 \ zero relative, could be adjusted for other \ physical coordinates -100 -10 p, \ moveto offset \ draws 0 50 p, 20 0 p, 0 -30 p, 30 0 p, 0 30 p, 20 0 p, 0 -30 p, 20 0 p, 0 20 p, 20 0 p, 0 -20 p, 20 0 p, 0 30 p, 20 0 p, 0 -30 p, 50 0 p, 0 -50 p, -20 0 p, 0 30 p, -30 0 p, 0 -30 p, -20 0 p, 0 30 p, -20 0 p, 0 -20 p, -20 0 p, 0 20 p, -20 0 p, 0 -30 p, -20 0 p, 0 30 p, -50 0 p, \ last drawto 2drop \ final position here 4thpoints - constant 4thlen create currentpoints \ current points specification in physical \ coordinate space, suitable for polydraw 4thlen allot : clipx ( x -- x' ) 4 max currentwindow @ +wWidth w@ 4- min ; : clipy ( y -- y' ) 1 max currentwindow @ +wHeight w@ ( 2- ) 14 - min ; : xlate.points ( addr\xformarray -- ) \ transforms point array according to 02 needed locals| xarray addr | addr dup @ 1+ 4* + addr 4+ do i @point xarray xlate ( clipx) 630 min swap clipy ( 170 min) swap i !point 4 +loop ; : compute.current \ copy template to current, apply current xform \ matrix 4thpoints currentpoints 4thlen 4/ lmove currentpoints xform.array xlate.points ; \ Area fill structures per Bob Benedict struct AreaInfo myAreaInfo structend struct TmpRas myTmpRas \ make temp structure structend create tr 0 , create Abuf 1000 allot \ create buffer for area fill : initabuf ( -- ) \ initialize area structure myAreaInfo Abuf 200 InitArea ; create polyflag 0 , : EndDemo \ action for when demo complete polyflag @ if tr @ 640 200 FreeRaster \ free temp raster polyflag off then currentwindow @ CloseWindow currentscreen @ CloseScreen ?turnkey if bye else cr ." done." abort then ; \ Handle IDCMPs, errors : DemoEvents \ only event here is close window GetEvent case fCLOSEWINDOW of EndDemo endof endcase ; : fillpoly ( rport\addr\len -- ) \ same stackmap as drawpoly below \ but fills polygon locals| polylen polyaddr rastport | polyflag @ not \ no tempras allocated if \ so allot a sensible minimum 640 200 AllocRaster dup myTmpRas +trRasPtr ! tr ! 640 200 * myTmpRas +trSize ! myTmpRas rastport +rpTmpRas ! \ tell rport about tmpras myAreaInfo rastport +rpAreaInfo ! \ tell rport about areainfo 1 polyflag ! then rastport polyaddr @point swap areamove error" area move error" polylen 4* polyaddr + polyaddr 4+ do rastport i @point swap areadraw error" area draw error" 4 +loop rastport areaend ; : drawpoly ( rport\addr\len -- ) \ draw polygon locals| polylen polyaddr rastport | rastport polyaddr @point swap move rastport polylen 1- polyaddr 4+ polydraw ; : fill4th ( -- ) \ solid 4th polygon compute.current \ transform array rport currentpoints 4+ 33 fillpoly ; \ fill polygon : draw4th ( -- ) \ hollow 4th polygon compute.current \ transform array rport currentpoints 4+ 33 drawpoly ; \ draw polygon : spin4th ( token in-- ) \ spin out solid or filled polygon locals| spintoken | ginit \ must init csi 2d graphics max.x 2/ max.y 2/ swap xyoffset \ center of window 720 ( 360 ) 1 do 360 ( 180 ) i- 3 / dup 2* xyscale \ increase scale, rect pixels \ x = 2*y i xyangle rport i setapen \ change color spintoken execute \ draw symbol 5 +loop ; \ interesting, try your own : turn4th ( -- ) \ turn on axis, then split ginit max.x 2/ max.y 2/ swap xyoffset \ center of window rport 2 SetDrMd \ COMPLEMENT demoevents 0 100 do get.xyangle 15 + xyangle get.xyoffset i sin 1000 w/ + swap i cos 1500 w/ + swap xyoffset i i i 2/ + xyscale fill4th fill4th -5 +loop ginit max.x 2/ max.y 2/ swap xyoffset \ center of window rport JAM1 SetDrMd ; : dospin ( -- ) initabuf 0" Multi-Forth Spin Demo " demoscrn +nsDefaultTitle ! demoscrn OpenScreen verifyscreen \ open a 4 bit plane screen CurrentScreen @ demowindow +nwScreen ! \ store screen ptr in window 0" (click closebox to end after next cycle) " demowindow +nwTitle ! \ relocated title demowindow OpenWindow verifywindow \ open demo window rport 1 setapen ?turnkey \ on turnkey, any error exits demo if on.error EndDemo resume then begin token.for draw4th spin4th demoevents token.for fill4th spin4th demoevents clr.window turn4th demoevents again ; \ wait for window close trace off cr ." ready for demo or turnkey. " cr ." enter: dospin " cr ." turnkey with: turnkey" 34 emit ." spin" 34 emit ." dospin"