4 - Forth Interest Group

I
I
251 5 IS CLEAR. BIT
253 6 IS CLEAR. BIT
254 7 IS CLEAR. BIT
\ given X and Y, light the pixel
CODE PIXEL ( x y -- ) \ set pixel at x, y
OPT"
OVER >R
XY->ADR
DDUP C@L
R> 8 MOD CLEAR.BIT AND
-ROT C!L " END-CODE
8 lVAR SELECT.BIT
128 1 IS SELECT.BIT
64 2 IS SELECT.BIT
32 3 IS SELECT.BIT
16 4 IS SELECT.BIT
8 5 IS SELECT-BIT
4 6 IS SELECT-BIT
2 7 IS SELECT.BIT
1 0 IS SELECT.BIT
\ given X and Y, see if pixel is lit
CODE PIXEL? ( x y -- f )
\ TRUE, x y "pixel lit"
\ FALSE, X Y "pixel dark"
OPT"
OVER >R
XY->ADR C@L
R> 8 MOD SELECT.BIT AND
0= " END-CODE
\ to put the file names in
CREATE GB$ 128 ALLOT \ for GETB file
CREATE PB$ 128 ALLOT \ for PUTB file
: T1
$" C:\WINDOWS\DOCS\TOOLS\ARTICLE~\BLNKPAGE.B" GB$ $ !
$" C:\WINDOWS\DOCS\TOOLS\ARTICLE~\RESULTS.B" PB$ $ !
GB$ GET-IMAGE ;
The Computer Journal ....... 25
Forth Interest Group .......... 44
Harvard Softworks ............. 29
Laboratory Microsystems .. .41
Miller Microcomputer
Services ........................... .31
Silicon Composers .............. 2
: TEST1
T1
880 0 DO 640 0 DO I J PIXEL LOOP LOOP
PB$ PUT-IMAGE ;
1 : TEST2 640 0 DO I I PIXEL LOOP ;
: TEST3 880 0 DO I2/ I PIXEL LOOP ;
: TEST4
880 0 DO
I 3 / I PIXEL
I 2/ I PIXEL
0 I PIXEL
I 639 < IF I 879 I - PIXEL THEN
LOOP :
: DO.TEST
T 1
TEST2 TEST3 TEST4
PB$ PUT-IMAGE ;
Forth Dimensions 31 November 1993 December