# Paste: Bresenham

Author: Capital Ex factor Wed, 6 Apr 2022 04:45:01
Plain Text |
```! Copyright (C) 2022 Capital Ex.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays generalizations kernel math ranges sequences ;
IN: bresenham-cat

: >x0,x1 ( p0 p1 -- x0 x1 )
[ first ] bi@ ; inline

: >y0,y1 ( p0 p1 -- y0 y1 )
[ second ] bi@ ; inline

: neg-nth ( seq n -- )
swap 2dup '[ _ _ nth neg _ _ set-nth ] call ;

: >dx/dy ( p1 p2 -- dx dy )
[ >x0,x1 swap - ] [ >y0,y1 swap - ] 2bi ;

: (compute-ds) ( d range dx dy -- ds )
[ '[ 2 _ _ - * + ] ] [ drop '[ 2 _ * + ] ] 2bi
'[ drop dup 0 > _ _ if dup ] map nip 0 prefix ;

: (next-x/y) ( x/y i d -- x' )
0 > [ + ] [ drop ] if ;

: ?invert-iter ( {dx,dy,i} -- {dx,dy,i} )
dup first 0 < [ dup [ 0 neg-nth ] [ 2 neg-nth ] bi ] [  ] if ;

: get-x0-i ( x0 x x x x x x i -- x0 i ) nip 5nip ;

: get-y0-i ( x y0 x x x x x i -- y0 i ) 5nip nipd ;

: get-dlist ( x x x x range dx dy x -- ds )
drop [ 4drop ] 3dip rot 2over
'[ _ 2 * _ - _ _ _ (compute-ds) ] call ;

: get-2map-pred-lo ( x x x x range x x x -- range quot )
3drop 4nip [ [ [ (next-x/y) ] 3keep drop swap ] [ swap 2array ] bi* ] ;

: get-2map-pred-hi ( x x x x range x x x -- range quot )
3drop 4nip [ [ [ (next-x/y) ] 3keep drop swap ] [ 2array ] bi* ] ;

: get-points ( x0/y0 i dlist range quot -- x )
[ call( x x x x -- x x x ) ] curry 2map 2nip ;

: unpack-args ( p0 p1 _ {d0,d1,i} -- x0 y0 x1 x0 _ d0 d1 i )
[ first2 ] 3dip [ first2 ] 2dip first3 ;

: (bresenham-lo) ( p0 p1 -- points )
2dup >dx/dy swap 1 3array ?invert-iter
[ [ >x0,x1 [a..b] ] 2keep rot ] dip unpack-args {
[ get-y0-i ] [ get-dlist ] [ get-2map-pred-lo ]
} 8 ncleave get-points ;

: (bresenham-hi) ( p0 p1 -- points )
2dup >dx/dy 1 3array ?invert-iter
[ [ >y0,y1 [a..b] ] 2keep rot ] dip unpack-args {
[ get-x0-i ] [ get-dlist ] [ get-2map-pred-hi ]
} 8 ncleave get-points ;

: bresenham-cat ( u v -- points )
2dup [ >y0,y1 - abs ] [ >x0,x1 - abs ] 2bi <
[ 2dup >x0,x1 > [ swap (bresenham-lo) ] [ (bresenham-lo) ] if ]
[ 2dup >y0,y1 > [ swap (bresenham-hi) ] [ (bresenham-hi) ] if ] if ; ```

## New Annotation

Summary: textPostgreSQLPowerCenter Parameter Fileactionscriptadaada95ans-forth94antantlrantlr4apacheconfapdlapplescriptaspaspect-jassembly-agcassembly-agsassembly-arm32assembly-m68kassembly-macro32assembly-mcs51assembly-parrotassembly-r2000assembly-x86avroawkbbatchbbjbcelbeanshellbibtexbinsource-agccc#c++cfscriptchillcilclipsclojurecmakecobolcoffeescriptcoldfusioncplex-lpcsscsvcvs-commitddartdjangodockerfiledotdoxygendrawj2ddsssleiffelembperlerlangfactorfhtmlforthfortranfortran90foxprofreemarkergcbasicgettextgherkingnuplotgogradlegroovygsphaskellhaxehexhl7v2hlslhtaccesshtmlhxmli4glicalendariconidlinforminiinno-setupinterlisiojamonjavajava module-infojavaccjavafxjavascriptjcljedit-actionsjflexjhtmljmkjsonjspkotlinlatexlexlilypondlispliterate-haskelllogslogtalklotosluam4macroschedulermailmakefilemaplemarkdownmavenmavscriptmetapostmlmodula3moinmqscmustache-templatemxmlmyghtymysqln3netrexxnqcnsis2objective-cobjectrexxoccamomnimarkopensipsoutlinepascalpatchperlphppikepl-sqlpl-sql9pl1plaintexplantumlpop11postscriptpovraypowerdynamopowershellprogressprologpropertiesprotobufpspptlpurepvwavepyrexpythonqdocrakefilercprdrebolredcoderelax-ng-compactrenderman-ribrestrfcrhtmlroffrpm-specrtfrubyrustrviews#s+sassbtscalaschemesdl/prsgmlshellscriptshtmlsipsippslateslaxsmalltalksmartysmi-mibsparqlsql-loadersqrsquidconfstatasvn-commitswiftswigtcltemplate-toolkittextexinfotldtransact-sqltsptwikityposcripturluscriptvalavbscriptvelocityverilogvhdlvisualbasicvrml2wellknowntextxmlxqxslyabyamlzpt