\* Generic display routines for all experiments. These pay attention to the variables set up by the topology selection, and to the display-type, in order to decide what to do. The central routine is called "xvds" (X or Video Display Step). It is called whenever a display is desired. Depending on the value of "display-type", the display will show on CAM (video), on XCAM (a window), on both, or on neither. Depending on the value of "show-zoom-mode", the display will be enlarged or not; depending on the value of "show-spread-mode", single cells will be spread out (with different bits in different pixels) or not. The value of "show-function-mode" determines (for non-spread display) whether or not a lookup table ("display-table") will be used to translate the cells into 8-bit pixels before they are sent through the colormap for display. The deferred word "space" is redefined here to not only setup information about the dimensions of the overall CAM space (and hence the size of sectors), but also to compile all of the step lists and tables needed by the generic display routines (specialized to the given dimensions of the space). We also assume that the display will in general be shifted relative to the origin of the space, in order to show the center of the space (or the front face of a higher-dimensional space, depending on the setting of "centering-hd", which is by default off). Thus i/o operations should either undo these shifts, perform the i/o, and then redo them (using "undo-display-shift" and "shift-for-display") or use information from the "display-offset" array to compensate for the shifts. The shifts are recalculated whenever you change the display mode (using "set-display-mode"). Keys for shifting the spatial data (in order to change your viewpoint) and toggling the various display options on and off are defined here. Keys also control the visibility of spread data bits (allowing some of the data to be hidden) and the use of a checkerboard background to make the boundaries of 4x4 blocks evident. LIMITATIONS: Display lists are pre-compiled when the space is defined, rather than created on demand. Thus only a fixed set of magnifications is available. Small magnifications, that would require reformating spatial data (and perhaps saving some in the host) before display are not currently supported. This should be fixed in the next version. Only two topologies were defined at the time this code was written (y-strip-topology and disjoint-topology) and so only these are supported, though all of the magnified display modes should be topology-independent. *\ \ ******************************************************************** \* First we define some words for shifting the space. "limit-kick" takes a proposed kick value and a dimension number, and reduces the absolute value of the proposed kick amount to the maximum allowed for that dimension. "perform-space-shift" uses the contents of the array "space-shift" to perform the shortest possible sequence of kicks that shifts the space by the indicated amount. When done, the array contains all zeros. "shift-space" fills the "space-shift" array from the stack, and then performs the indicated shifts. *\ max#dimensions array space-shift max#dimensions array save-shift : sig (s value -- sign.of.value ) 0< 2* 1+ ; : limit-kick (s value dim# -- limited.value ) Un over abs min swap sig * ; : perform-space-shift 0 space-shift 0 save-shift max#dimensions /n* cmove force-zero-subcell save-select/sector/src full-space site-src site display 0 fix max-subcell-declared @ 1+ 0 ?do i 0<> if i 1- i switch-subcells 0 save-shift 0 space-shift max#dimensions /n* cmove then begin 0 #dim @ 0 ?do i space-shift @ or loop 0<> while kick #dim @ 0 ?do i space-shift @ i limit-kick dup negate i space-shift +! i xn loop run free repeat loop restore-select/sector/src restore-active-subcell ; : zero-space-shift 0 space-shift max#dimensions /l* erase ; : shift-space (s shift.1 shift.2 ... shift.#dim -- ) #dim @ reverse #dim @ 0 ?do i space-shift ! loop perform-space-shift ; \* Now we introduce the concept of a display offset. Before i/o or event counting, we can use this offset to undo the display shift, perform the i/o, and then redo the display shift. This lets us have offsets that are convenient for display without complicating the spatial order of the i/o or counting. This, for example, allows the y-strip-topology to be shifted up before i/o, and magnified images to display the middle of the space, but be unshifted while i/o is done. Note that sophisticated versions of the i/o and counting routines could directly compensate for the display offsets, without needing to undo and redo them. "display-offset" is an array. For display purposes, it is set by "xy-display-offset", which takes x and y offsets from the stack, and sets all the rest of the offsets (if the space is more than 2 dimensional) to either point to the front face of the space, or (if the variable "centering-hd" is on, to point to the middle of the space). This variable is set by "start-centering-hd", and cleared by "stop-centering-hd". "shift-for-display" copies "display-offset" into "space-shift", and then performs the shift. "undo-display-shift" does the same thing, but negates all shifts as it copies them. *\ max#dimensions array display-offset : zero-display-offset 0 display-offset max#dimensions /l* erase ; : set-display-offset (s offset.1 offset.2 ... offset.#dim -- ) #dim @ reverse #dim @ 0 ?do i display-offset ! loop ; variable centering-hd : xy-display-offset (s offset.x offset.y -- ) #dim @ 2 u< if 2drop exit then #dim @ 2 ?do centering-hd @ if i Un 2/ else 0 then loop set-display-offset ; : shift-for-display max#dimensions 0 ?do i display-offset @ i space-shift ! loop perform-space-shift ; : undo-display-shift max#dimensions 0 ?do i display-offset @ negate i space-shift ! loop perform-space-shift ; \* Here is an example of i/o code using the shift/undo words above. Here we upload or download the contents of a workstation-memory buffer that is the same size as the entire space. We make the data format in the workstation independent of the number of modules in CAM. *\ 0 value #slices : buffer>cam label# @ labelbuf label# @ usebuf length #cells/space @ <> abort" `buffer' isn't the same size as the space!" full-space undo-display-shift #cells/space @ X Y * / is #slices scan-format U V * log esc! select read *select-buf site-src host #slices 0 ?do #modules 0 ?do select i module scan-io label# @ usebuf j #modules * i + #slices #modules * part loop loop select *select-buf scan-format shift-for-display step ; : pattern>cam step pattern length #cells/space @ <> abort" `pattern' isn't the same size as the space!" full-space undo-display-shift #cells/space @ X Y * / is #slices scan-format U V * log esc! select read *select-buf site-src host #slices 0 ?do #modules 0 ?do select i module scan-io pattern j #modules * i + #slices #modules * part loop loop select *select-buf scan-format shift-for-display step ; : cam>buffer label# @ labelbuf full-space undo-display-shift #cells/space @ X Y * / is #slices scan-format U V * log esc! select read *select-buf site-src site display site #slices 0 ?do #modules 0 ?do select i module scan-io label# @ usebuf read j #modules * i + #slices #modules * part loop loop select *select-buf scan-format shift-for-display step ; : cam>pattern step full-space undo-display-shift full-pattern #cells/space @ X Y * / is #slices scan-format U V * log esc! select read *select-buf site-src site display site #slices 0 ?do #modules 0 ?do select i module scan-io pattern read j #modules * i + #slices #modules * part loop loop select *select-buf scan-format shift-for-display step ; \* Begin and end slice-io, if you want to compensate for display shift. Since slices will typically be copied in a loop, we don't want to do this before and after every slice. For applications where the display shift doesn't matter (such as saving and restoring a slice) we can dispense with the begin and end altogether. *\ : begin-slices undo-display-shift step ; : end-slices shift-for-display step ; \* Copy a specified 2d slice of an n-d space to or from CAM, from or to the "pattern" buffer. All selection and scan information is restored when done. *\ : 2d-slice>pattern (s slice# -- ) step save-select/sector U by V by..1 subsector goto-nth-subsector X Y * ['] pattern change-reglen site-src site display site #modules 0 do select i module scan-io pattern read i #modules part loop restore-select/sector *step* ; : pattern>2d-slice (s slice# -- ) step save-select/sector U by V by..1 subsector goto-nth-subsector site-src host #modules 0 ?do select i module scan-io pattern i #modules part loop restore-select/sector *step* ; \* Now we define our various display routines. These routines support an X display or a video display indifferently. Four different display modes are supported at present: full-size (x1 magnification) zoom (x8 magnification) spread (x8 mag, but with each cell spread over a 4x4 region) spread-zoom (x32 mag; spread, but with x4 zoom) For an 8 module machine, x8 magnification or more is an easy case because it only involves showing data from a single module. A magnification of x4 can also be done without using extra state, but would be a bit more work. Eventually, all magnifications should be supported, by saving and restoring data in the host -- we would never have to save more than 256 K for a 512x512 display. "UVsubsector" takes arguments of the width and height of the subsector needed for the display. All other dimensions of the subsector are set to 1. "begin-display-function" saves the current lut from module 0, and ** (left off documenting at this point) NOTE: rlif on both displays, zoom mode, toggle-spread. *\ 512 value video-max-width 512 value video-max-height \ : UVsubsector (s U V -- ) \ \ swap by by..1 \ ; : UVsubsector (s U V -- ) #dim @ rot by dup 2 < abort" Space displayed must be at least 2 dimensional!" 1 ?do i limit 1- <> if by 1 else subsector then loop ; \ How about a display function? 64 K create-buffer display-table 64 K create-buffer display-save-table 64 K create-buffer display-save-table' \* Assume all modules have identical configuration. *\ : begin-display-function select read *select-buf select 0 module lut-data read display-save-table select *select-buf lut-data display-table switch-luts lut-src site display lut ; : end-display-function switch-luts lut-data display-save-table ; 8 value cell-zoom \ mag desired for individual pixels 8 value mds-zoom 8 value sds-zoom 32 value msds-zoom \ sets changes sources, sets kick to 0; all else unchanged \ Note: subsector compilation values are not preserverd. : y-strip-vds save-select/sector/src site-src site scan-index U video-max-width po2 min V video-max-height po2 min UVsubsector #dim @ 0 ?do 0 loop select-subsector scan-format U' log esc! kick V negate y run frame V' 1 ?do run line loop #modules 1 ?do i V * video-max-height po2 < if run line repeat-kick V' 1 do run line loop else scan-format U' V' * log esc! run free repeat-kick then loop restore-select/sector/src kick display 0 map! ; : Xbuf display-buf X X-max-width min Y X-max-height min * 2/ reglen ! ; : y-strip-xds save-select/sector/src site-src site scan-index kick U X-max-width po2 min V X-max-height po2 min UVsubsector #dim @ 0 ?do 0 loop select-subsector X-max-height po2 V / #modules min 1 max 0 ?do select i module' scan-io Xbuf i limit part byte-read length 2* reglen ! loop restore-select/sector/src ; : magnify-vds (s magnification -- ) is cell-zoom save-select/sector/src site-src site scan-index U cell-zoom * X min video-max-width po2 min cell-zoom / V cell-zoom * Y min video-max-height po2 min cell-zoom / UVsubsector #dim @ 0 ?do 0 loop select-subsector cell-zoom log magnify scan-format U' cell-zoom * log esc! kick run frame V' cell-zoom * 1 ?do run line loop restore-select/sector/src display 0 map! ; : magnify-xds (s magnification -- ) is cell-zoom save-select/sector/src site-src site scan-index U cell-zoom * X min X-max-width po2 min cell-zoom / V cell-zoom * Y min X-max-height po2 min cell-zoom / UVsubsector #dim @ 0 ?do 0 loop select-subsector cell-zoom log magnify select 0 module scan-io Xbuf byte-read length 2* reglen ! restore-select/sector/src ; \ In spread mode, you should be able to turn off any of the bits. 0 5 == lo-info 8 13 == hi-info 0 5 == info-out 0 2 == lo-bitnum' 0 3 == lo-bitnum 0 1 == lo-hbit 0 0 == lo-hbit0 1 1 == lo-hbit1 2 3 == lo-vbit 2 2 == lo-vbit0 3 3 == lo-vbit1 4 4 == lo-hcell 5 5 == lo-vcell 6 7 == lo-unused 8 10 == hi-bitnum' 8 11 == hi-bitnum 8 9 == hi-hbit 8 8 == hi-hbit0 9 9 == hi-hbit1 10 11 == hi-vbit 10 10 == hi-vbit0 11 11 == hi-vbit1 12 12 == hi-hcell 13 13 == hi-vcell 14 15 == hi-unused 0 3 == bitnum-out 4 4 == hcell-out 5 5 == vcell-out 6 6 == bit-out 7 7 == pixel-hi 64 K create-buffer display-hi 64 K create-buffer display-lo : display-hi-rule 0 -> cell lo-bitnum' {{ n8 n9 na nb nc nd ne nf }} -> bit-out lo-info -> info-out ( this is identity ) ; : display-lo-rule 0 -> cell hi-bitnum' {{ n0 n1 n2 n3 n4 n5 n6 n7 }} -> bit-out hi-info -> info-out ; : fill-display-hi display-hi 64 K 0 do i h# 03f and ( lo-info ) i i 7 and ( lo-info cell lo-bitnum' ) 8 + >> 1 and ( lo-info nK ) 6 << or ( cell.updated ) buffer i /w* + w! loop ; : fill-display-lo display-lo 64 K 0 do i flip h# 03f and ( hi-info ) i flip dup 7 and ( hi-info cell.flipped hi-bitnum' ) 8 + >> 1 and ( hi-info nK ) 6 << or ( cell.updated ) buffer i /w* + w! loop ; \ "display-hi" should be a 16 K table, and "display-lo" should just be \ downloaded as a permutation of "display-hi" (i.e., use just one table). : lut-src-lo lut-src site lo-vbit field address lo-vcell field address lo-hbit field address lo-hcell field address ; : lut-src-hi lut-src site hi-vbit field address hi-vcell field address hi-hbit field address hi-hcell field address ; \* Note that in the line-loop, we schedule the run *before* we change the lut-src. This is done so that if there is some delay and we don't have time to do both, we simply have a few wrong bits at the beginning of the display, rather than miss starting a whole line. Of course this means that we are always sending the lut-src for the line that we just scheduled, rather than the line we are about to schedule. *\ : bit-zoom cell-zoom 4 / ; \ each cell becomes 4x4 bits, so \ bit-zoom is 1/4 of cell-zoom : begin-spread (s magnification -- ) is cell-zoom save-select/sector/src select 0 module lut-data read display-save-table switch-luts lut-data read display-save-table' select *select-buf lut-data display-hi switch-luts lut-data display-lo site-src site display lut pixel-hi field 1 fix scan-index kick ; : end-spread restore-select/sector/src lut-data display-save-table' switch-luts lut-data display-save-table display 0 map! ; : spread-vds (s magnification -- ) begin-spread U cell-zoom * X min video-max-width po2 min cell-zoom / V cell-zoom * Y min video-max-height po2 min cell-zoom / UVsubsector #dim @ 0 ?do 0 loop select-subsector cell-zoom log magnify sa-bit bit-zoom log lo-hbit0 field dup reg! lo-hbit1 field dup 1+ reg! hi-hbit0 field dup reg! hi-hbit1 field 1+ reg! cell-zoom log lo-hcell field dup reg! hi-hcell field reg! U' cell-zoom * bit-zoom * log lo-vbit0 field dup reg! lo-vbit1 field dup 1+ reg! hi-vbit0 field dup reg! hi-vbit1 field 1+ reg! U' cell-zoom * cell-zoom * log lo-vcell field dup reg! hi-vcell field reg! scan-format U' cell-zoom * log esc! V' cell-zoom * 0 ?do run i cell-zoom 2/ mod 0= if new-table then i 0= if frame else line then i cell-zoom 2/ mod 0= if i cell-zoom 2/ / 2 mod {{ lut-src-hi lut-src-lo }} no-cam-wait then loop end-spread ; : spread-xds (s magnification -- ) begin-spread U cell-zoom * X min X-max-width po2 min cell-zoom / V cell-zoom * Y min X-max-height po2 min cell-zoom / UVsubsector #dim @ 0 ?do 0 loop select-subsector cell-zoom log magnify sa-bit bit-zoom log lo-hbit0 field dup reg! lo-hbit1 field dup 1+ reg! hi-hbit0 field dup reg! hi-hbit1 field 1+ reg! cell-zoom log lo-hcell field dup reg! hi-hcell field reg! U' cell-zoom * bit-zoom * log lo-vbit0 field dup reg! lo-vbit1 field dup 1+ reg! hi-vbit0 field dup reg! hi-vbit1 field 1+ reg! U' cell-zoom * cell-zoom * log lo-vcell field dup reg! hi-vcell field reg! scan-format U' cell-zoom * cell-zoom * 2/ log esc! select 0 module V' 2* 0 ?do i 2 mod {{ lut-src-hi lut-src-lo }} run free no-scan new-table scan-io byte-read Xbuf i limit part length 2* reglen ! loop end-spread ; : delay-step save-select/sector/src site-src site display 0 fix scan-format U log esc! kick run 1 ssm! \ frame sync, but no capture restore-select/sector/src ; variable spread-mask \* 4x4 blocks form a red/blue checkerboard, with intensity turned up for 1-bits. "spread-mask" indicates bits that shouldn't be shown: these bits appear as black. *\ defer smap : cboard-smap 1 bitnum-out << spread-mask @ and 0= if exit then hcell-out vcell-out xor if h# 0bf >red bit-out if h# 0ff >red then else h# 0af >blue h# 057 >green bit-out if h# 0ff >blue h# 07f >green then then ; : mono-cboard-smap 1 bitnum-out << spread-mask @ and 0= if exit then hcell-out vcell-out xor if h# 07f >gray bit-out if h# 0af >gray then else bit-out if h# 04f >gray then then ; : mono-smap 1 bitnum-out << spread-mask @ and 0= if exit then bit-out 0<> >green ; undefined value show-zoom-mode undefined value show-spread-mode undefined value show-function-mode : display-mode (s -- n ) show-spread-mode 2* show-zoom-mode + ; : show-function 1 is show-function-mode ; : show-state 0 is show-function-mode ; \* Note that if the X display and the video display are not the same size, then we center the images for the X-display. *\ : set-display-mode undo-display-shift step X X-max-width min is X-width Y X-max-height min is X-height display-mode {{ 1 mds-zoom sds-zoom msds-zoom }} is cell-zoom X X-width cell-zoom / - 2/ negate Y X-height cell-zoom / - 2/ negate show-zoom-mode 0= show-spread-mode 0= and if V + then ( y-strip ) xy-display-offset shift-for-display step ; : start-centering-hd undo-display-shift step centering-hd on shift-for-display step ; : stop-centering-hd undo-display-shift step centering-hd off shift-for-display step ; : init-display reset-xmon zero-display-offset fill-display-hi \ optimized fill-display-lo \ optimized ['] cboard-smap is smap set-display-mode ; : set-zoom (s n -- ) 1 and is show-zoom-mode set-display-mode ; : ?palette>display show-spread-mode 0= if palette>display then ; : send-unspread (s acf.map -- ) ['] palette palette! ?palette>display ; : colormap state @ if [compile] ['] compile send-unspread else ' send-unspread then ; immediate : file>palette (s filename.pstr -- ) palette load-buffer ?palette>display ; : palette>file (s filename.pstr -- ) palette save-buffer ; palette-length create-buffer spread-palette palette-length create-buffer save-palette : send-spread (s acf.map -- ) ['] palette ['] save-palette copy-buffer ['] palette palette! palette>display ['] save-palette ['] palette copy-buffer ; : ?send-smap show-spread-mode if ['] smap send-spread then ; : set-spread (s n -- ) 1 and is show-spread-mode ?send-smap ?palette>display set-display-mode ; : show-spread 1 set-spread ; : show-unspread 0 set-spread ; \ We should pre-define a set of colormaps that let us turn on and off \ the various spread bits. Let's have the low bit reflect on or off, \ the next 2 bits even or odd horizontal and vertical position of the \ pixel being spread, and the next four bits be the bit-number (0 to 15). \ Display Steps: defer vds defer mvds defer svds defer msvds defer xds defer mxds defer sxds defer msxds defer begin-fn defer end-fn defer before-display defer after-display \* Note that the X-display steps don't turn off the display output. *\ : (xvds) display? not if exit then before-display show-function-mode 0<> show-spread-mode 0= and if begin-fn else display site then X-display? if display-mode {{ xds mxds sxds msxds }} image>xmon then cam-display? if display-mode {{ vds mvds svds msvds }} then show-function-mode 0<> show-spread-mode 0= and if end-fn then after-display ; this is xvds : create-display-steps [""] (begin-fn "define-step begin-display-function end-step [""] (begin-fn find drop is begin-fn [""] (end-fn "define-step end-display-function end-step [""] (end-fn find drop is end-fn [""] generic-vds "define-step y-strip-vds end-step [""] generic-vds find drop is vds [""] generic-xds "define-step y-strip-xds end-step [""] generic-xds find drop is xds [""] generic-mvds "define-step mds-zoom magnify-vds end-step [""] generic-mvds find drop is mvds [""] generic-mxds "define-step mds-zoom magnify-xds end-step [""] generic-mxds find drop is mxds [""] generic-svds "define-step sds-zoom spread-vds end-step [""] generic-svds find drop is svds [""] generic-sxds "define-step sds-zoom spread-xds end-step [""] generic-sxds find drop is sxds [""] generic-msvds "define-step msds-zoom spread-vds end-step [""] generic-msvds find drop is msvds [""] generic-msxds "define-step msds-zoom spread-xds end-step [""] generic-msxds find drop is msxds [""] (idle-frame) "define-step delay-step end-step [""] (idle-frame) find drop is idle-frame ['] noop is before-display ['] noop is after-display ['] (xvds) is xvds ; : init-display-buffers 0 0 ['] display-buf >buf-addr 2! 0 0 ['] palette >buf-addr 2! display-buf buffer is display-buf.addr palette buffer is palette.addr ; \ ************************************************************************* DISPLAY-KEYS key-bindings variable shift-amount variable hide-mask variable cboard-flag variable xn-direction : (init-keys) (init-keys) 1 shift-amount ! hide-mask off cboard-flag on ['] noop is smap 2 xn-direction ! 0 is show-zoom-mode 0 is show-spread-mode 0 is show-function-mode spread-mask on centering-hd off zero-display-offset ; this is init-keys : .on/off (s bit -- ) 1 and if ." (on) " else ." (off) " then ; : Toggle-checker cboard-flag @ not dup cboard-flag ! dup .on/off if ['] cboard-smap else ['] mono-smap then is smap ?send-smap ; press c "When spread, superimpose checkerboard." : Toggle-hide arg? if arg 16 >= if h# ffff else 1 arg << then spread-mask @ xor dup not hide-mask ! spread-mask ! else hide-mask @ spread-mask @ xor spread-mask ! then ?send-smap ; press h "Hide/unhide ARG-th bit of each 4x4." : Toggle-spread show-spread-mode not dup set-spread .on/off xvds ; press s "Spread each cell over a 4x4 region." : Toggle-zoom show-zoom-mode not dup set-zoom .on/off xvds ; press z "Magnify display." : Toggle-X-display X-display? if cam-display? if use-cam-display else use-no-display then else cam-display? use-X-display xvds if use-both-displays then then X-display? .on/off ; press x "Send a copy of display to an X-window." : xn-shift (s amount n -- ) zero-space-shift 2dup space-shift ! perform-space-shift xvds nip arg? not if ." (N=" (.) type ." ) " then ; : Go-neg-xN -1 xn-direction =arg xn-direction @ xn-shift ; press [ "Travel in -ive x_ARG direction." : Go-pos-xN 1 xn-direction =arg xn-direction @ xn-shift ; press ] "Travel in +ive x_ARG direction." : xy-shift (s shift.x shift.y -- ) shift-amount =arg shift-amount @ * swap shift-amount @ * swap #dim @ 2 u< if 2drop exit then #dim @ 2 ?do 0 loop shift-space xvds shift-amount @ ?() ; : Go-rt -1 0 xy-shift ; press Right "Travel rightward (shares arrow-ARG)." : Go-lt 1 0 xy-shift ; press Left "Travel leftwards (shares arrow-ARG)." : Go-dn 0 -1 xy-shift ; press Down "Travel downwards (shares arrow-ARG)." : Go-up 0 1 xy-shift ; press Up "Travel upwards arrow-ARG positions." INITIALIZE-KEYS key-bindings \* This needs to move: put this here temporarily!! *\ \ Routine to read a file from disk to cam. It reads and writes \ the file one cam-row at a time, so that no big memory buffer is \ required. This routine assumes y-strip topology, and uses a defined \ buffer for saving and restoring the selection. Additionally we pipe \ the data through gzip so that files take up less space. create-pipe cam>gzip create-pipe gzip>cam : file-io-block (s -- n ) U V * 32 K min ; : file-blocks/UV (s -- n ) U V * file-io-block / ; : file-io-V' (s -- n ) file-io-block U / 1 max ; : fd>field (s fd -- ) ifd ! file-io-block ['] iobuf change-reglen layer-mask @ undo-display-shift U file-io-V' UVsubsector select select-buf read kick site-src site layer-mask ! host #cells/space @ X Y * / 0 ?do #modules 0 ?do select i module step file-blocks/UV 0 ?do file-io-block /w* iobuf buffer ifd @ _read_bytes 3drop ret file-io-block /w* <> abort" File too short!" scan-io iobuf *step* loop loop loop select select-buf full-space shift-for-display step step-count off ; : fd>cam (s fd -- ) cell field fd>field ; ccstr gzip2cam variable wait-return : file>field (s filename.pstr -- ) gzip>cam init-pipe cam>gzip init-pipe cstr 0 swap gzip2cam gzip>cam cam>gzip ['] stdio-proc-child fork-forth drop stdio-proc-parent gzip>cam pipe-read-fd fd>field cam>gzip pipe-write-fd sys_close gzip>cam pipe-read-fd sys_close wait-return _wait drop ; : file>cam (s pattern.pstr -- ) cell field file>field ; create-filename source-pat : Get-pattern-file source-pat [""] .pat filename: arg? if arg 16 mod nn field else cell field then source-pat file>field xvds ; press g "Read pattern from disk (ARG=plane#)." : field>fd (s fd -- ) ofd ! file-io-block ['] iobuf change-reglen layer-mask @ undo-display-shift U file-io-V' UVsubsector select select-buf read site-src site kick display 0 fix layer-mask ! site #cells/space @ X Y * / 0 ?do #modules 0 ?do select i module step file-blocks/UV 0 ?do scan-io read iobuf *step* file-io-block /w* iobuf buffer ofd @ _write_bytes 3drop ret file-io-block /w* <> abort" Write falied!" loop loop loop select select-buf display 0 map! full-space shift-for-display step ; : cam>fd (s fd -- ) cell field field>fd ; ccstr cam2gzip : field>file (s filename.pstr -- ) gzip>cam init-pipe cam>gzip init-pipe cstr 0 swap cam2gzip gzip>cam cam>gzip ['] stdio-proc-child fork-forth drop stdio-proc-parent cam>gzip pipe-write-fd field>fd cam>gzip pipe-write-fd sys_close gzip>cam pipe-read-fd sys_close wait-return _wait drop ; : cam>file (s pattern.pstr -- ) cell field field>file ; create-filename dest-pat : Put-pattern-file dest-pat [""] .pat filename: arg? if arg 16 mod nn field else cell field then dest-pat field>file ; press p "Write pattern to disk (ARG=plane#)." \ ************************************************************************* : space-init (s n -- ) (space) step create-display-steps init-display X 16 / 1 max shift-amount ! ; this is space \ *************************************************************************