16 16 * create-buffer blockbuf "" hpp-block.pat blockbuf load-buffer X 16 * create-buffer rowbuf X 16 / constant #blocks rowbuf buffer constant rowbuf.base blockbuf buffer constant blockbuf.base : row>block (s row# block# -- ) swap blockbuf.base over 16 /w* * + -rot ( source.addr blk# row# ) X /w* * swap 32 * + rowbuf.base + 32 cmove ; : init-rowbuf 16 0 do #blocks 0 do j i row>block loop loop ; : row-point (s block# x y -- rowbuf.addr ) X * + swap 16 * + rowbuf.base swap wa+ ; \ ul: position ( 4, 4) bits 0 and 10 \ ur: position (11, 4) bits 3 and 9 \ ll: position ( 4,11) bits 6 and 12 \ lr: position (11,11) bits 5 and 15 4 4 2constant ul-xy 1 0 << 1 10 << or constant ul-signal 11 4 2constant ur-xy 1 3 << 1 9 << or constant ur-signal 4 11 2constant ll-xy 1 6 << 1 12 << or constant ll-signal 11 11 2constant lr-xy 1 5 << 1 15 << or constant lr-signal : add-ul (s block# -- ) ul-signal swap ul-xy row-point w! ; : add-ur (s block# -- ) ur-signal swap ur-xy row-point w! ; : add-ll (s block# -- ) ll-signal swap ll-xy row-point w! ; : add-lr (s block# -- ) lr-signal swap lr-xy row-point w! ; : rm-ul (s block# -- ) 0 swap ul-xy row-point w! ; : rm-ur (s block# -- ) 0 swap ur-xy row-point w! ; : rm-ll (s block# -- ) 0 swap ll-xy row-point w! ; : rm-lr (s block# -- ) 0 swap lr-xy row-point w! ; variable force-block force-block off : add-ul? force-block @ if force-block @ else random then 1 and 0<> ; : add-ur? force-block @ if force-block @ else random then 2 and 0<> ; : add-ll? force-block @ if force-block @ else random then 4 and 0<> ; : add-lr? force-block @ if force-block @ else random then 8 and 0<> ; : rand>block (s block# -- ) add-ul? if dup add-ul else dup rm-ul then add-ur? if dup add-ur else dup rm-ur then add-ll? if dup add-ll else dup rm-ll then add-lr? if dup add-lr else dup rm-lr then drop ; : zero>block (s block# -- ) dup rm-ul dup rm-ur dup rm-ll rm-lr ; 2 constant logvoid : void (s -- void.width ) 1 logvoid << ; : left/f (s -- num denom ) void 1- void 2* ; : right/f (s -- num denom ) void 1+ void 2* ; : rand-row (s zero.middle.flag block.row# -- ) 0 #blocks left/f */ bounds ?do i rand>block loop #blocks right/f */ #blocks left/f */ bounds ?do i rand>block loop Y 16 / left/f */ Y 16 / right/f */ 1- between and if #blocks left/f */ #blocks void / bounds ?do i zero>block loop else #blocks left/f */ #blocks void / bounds ?do i rand>block loop then ; : rand-blocks>cam (s zero.middle.flag -- ) init-rowbuf undo-display-shift U 16 UVsubsector select select-buf read kick site-src host #modules 0 ?do select i module step V 16 / 0 ?do dup j limit * i + rand-row scan-io rowbuf *step* loop loop select select-buf full-space shift-for-display step step-count off drop ;