	  (* ************************************************** *)
	  (*							*)
	  (*							*)
	  (*		  RTX	 VIDEO > SCR		*)
	  (*							*)
	  (*	     Marcel Hendrix, December 6th 1989		*)
	  (* LC: December 10 1989, added histogram equalization *)
	  (* LC:    December 11 1989, added point operators	*)
	  (* LC:    October 3rd 1990, VGA 256 colour screen	*)
	  (*							*)
	  (* ************************************************** *)


?DEF -graphics 0= IFTRUE
			?DEF 256COLOURS 0= IFTRUE 0 VALUE 256COLOURS
					   IFEND
			LOAD \drawing\drivers\graphics.lib
		  OTHERWISE
			?DEF 256COLOURS 0=
			IFTRUE -graphics
				0 VALUE 256COLOURS
				LOAD \drawing\drivers\graphics.lib
			IFEND
		  IFEND

  ?DEF -proced 0= IFTRUE
			$4D00	=: -->
			$4B00	=: <--
			$4800	=: --^
			$5000	=: --v
			$4700	=: Hme
			$7700	=: ^Home
			$4F00	=: End
			$7500	=: ^End
			$5100	=: PgDn
			$7600	=: ^PgDn
			$4900	=: PgUp
			$8400	=: ^Pgup
		  IFEND

			ONLY FORTH DEFINITIONS

	REVISION -img2scr " Show 256*256*256 pics.  Vsn 1.10 "

			     INIT-LOCALS


-- A couple of utilities, useful elsewhere.
CODE (SQRT)					\ <n> <iters> --- <root>
	CX:				POP,	\ iterations
	DX:				POP,	\ argument
	BX:		BX:		XOR,	\ clear remainder
	AX:		BX:		MOV,	\ clear result/trial
:POOL	BX:				SHL,	\ partial * 2
	BX:				INC,	\ guess next bit is 1

	DX:				SHL,	\ fetch next 2 bits from arg
	AX:				RCL,
	DX:				SHL,
	AX:				RCL,

	AX:		BX:		SUB,	\ trial subtraction

NC IF,	BX:				INC,
 ELSE,	AX:		BX:		ADD,	\ wrong guess, put back
	BX:				DEC,
ENDIF,	LOOP,
	BX:				SHR,	\ remember 2* ? ==> Bit15 = 0
	BX:				PUSH,	\ result
					NXT,	END-CODE

: SQRT		8 (SQRT) ;		\ ( n --- n ) 'normal' 16bit root

: >UPC		DUP 'a' 'z' WITHIN	\ <char> --- <CHAR>
		IF $20 - ENDIF ;	\ lower case, so convert.

: COVER		OVER+ SWAP ;		\ <lo> <width> --- <lo+wi> <lo>

: UD/		UD/MOD STACK abcd|c ;	\ <ud1> <ud2> --- <u>

: EMPTYBUFFER	BEGIN ?KEY
		WHILE KEY DROP
		REPEAT ;


DOC RTX2000-digitizer file format

(*
 xx xx xx xx	(256 bytes pixelinfo, 00 (black) - 7F (white))
 yy yy yy	(next line)
 ...		(256 lines total)

Pictures made with RTX video digitizer, see Y:\RTX2000\SRC\DIGITIZE\DIGIO.
*)
ENDDOC


DOC Specification IMG2SCR
(*
 Read a picture file into a segment ( PICTURE[]). The picture file has
 the following format:

	PicPixels	-- horizontal resolution (1 byte/pixel)
	PicLines	-- vertical resolution

 In the segment there are 256 pixels per line and 256 lines. Each pixel
 is represented with one byte (Future: 640 pixels per line and 480 lines).

 Once in memory, various pixel manipulations are possible.

 The pixels are displayed in VGA $13 mode with 320 pixels/line, 200 lines
 and 256 colours (gray shades). The picture starts at (dxoffset:dyoffset),
 has a width of DispPixels and a height of DispLines. In VGA $5D mode, each
 pixel and line is output twice (512*512 size).
 The display starts at the pxoffset' pixel of the pyoffset' line in memory.
 Within this window, at (Wxoffset,Wyoffset) a workarea is defined with a
 size of Workpixels x WorkLines. Transformations work on the data within this
 window. The window can be interactively defined by positioning a rectangle
 on the display.

		 segment
  (0,0) Ŀ
				
	 (pxoffset,pyoffset)	
	    >Ŀ		
	           ^			Restrictions
	       Ŀ DispLines 	============
	         			 - pxoffset+DispPixels <=  PicPixels
	        			 - pyoffset+DispLines  <=  PicLines
	           v		
	      <->		
		  DispPixels	
				
	
			(PicPixels,PicLines)

	     Display screen
	Ŀ (Xmax,Ymax)
				
		  DispPixels	
	      Ŀ		
	           ^		
	       Ŀ DispLines 	Restrictions
	         			============
	        			 - dxoffset+DispPixels <=  Xmax
	           			 - dyoffset+DispLines  <=  Ymax
	           v		
	    ><->		
	 (dxoffset,dyoffset)	
				
	
   (0,0)

One enhancement:

Scan the WorkArea with (for instance) 16x16 pixels squares, compute the
optimum CLUT for them and perform HUPDATE each time.
*)
ENDDOC


DATASEG VALUE Picture	LOCAL

FORGET>		L@
		?DUP IF (DOS:49) +ERR?-		\ deallocate
			CR ." Deallocating 64 Kbytes."
		  ENDIF
DO>		2DUP L@
		    IF 2DROP
		  ELSE 0 1 (DOS:48) +ERR?-	\ allocate 64 kbyte
		       DROP DUP TO Picture
		       DUP 0 $FFFF 0 LFILL
		       -ROT L!
		       CR ." Allocating 64 Kbytes."
		 ENDIF
BUILD>		0 CS:,
DEFWORD>	ALLOCATE: LOCAL

	ALLOCATE: PICTURE[] LOCAL


	#256 =: PicPixels  LOCAL	-- Physical Picture Size
	#256 =: PicLines   LOCAL

       0  VALUE pxoffset   LOCAL	-- Upper-left corner of picture
       0  VALUE pyoffset   LOCAL

PicPixels VALUE DispPixels LOCAL
PicLines  VALUE DispLines  LOCAL

	0 VALUE dxoffset   LOCAL	-- Lower-left corner of display
	0 VALUE dyoffset   LOCAL

      #10 VALUE WorkLines  LOCAL	-- For point-transform
      #10 VALUE WorkPixels LOCAL
      #50 VALUE Wxoffset   LOCAL
      #50 VALUE Wyoffset   LOCAL

     #64  VALUE /levels		-- digitizer resolution of original picture


-- Read a key, place a VISIBLE indicator on the screen.
: GETKEY	Xmax 8 - Ymax 8 - MOVE	\ <> --- <char>
		COlor
		/Levels 2/ SetFGColor 8 8 #FBOX
		(KEY2)
		0 SetFGColor 8 8 #FBOX
		SWAP SetFGColor ;


-- read a picture from disk
: GETPIC	PICTURE[]
		pushhandle
		Picture 0  PicLines PicPixels UM*  read
		pophandle ;

-- write a (processed?) picture (back?) to disk
: SAVEPIC	msfile
		Picture 0  PicLines PicPixels UM*  write
		pophandle ;


-- Indexing into the PictureSegment.
-- On an RTX-2000, #256 * is MUCH faster!
PicPixels #256 = IFTRUE
		   : []	   >< + ;		\ <xix> <yix> --- <offset>
		 OTHERWISE
		   : []	   PicPixels * + ;	\ <xix> <yix> --- <offset>
		 IFEND	   LOCAL


-- Display the picture on the screen, VGA mode 13h
: (DISPLAY1)	DispLines
		0 ?DO
			DispPixels
			0 ?DO
			     Picture
			     pxoffset I +  Piclines 1- pyoffset -  J -
			     [] LC@ TO Color
			     I J  dxoffset dyoffset V+	PLOT
			 LOOP
		 LOOP ; LOCAL

-- Display the picture on the screen, VGA mode 5Dh
: (DISPLAY2)	DispLines
		0 ?DO
			DispPixels
			0 ?DO
			     Picture
			     pxoffset I +  PicLines 1- pyoffset -  J -
			     [] LC@ TO Color
			     I 2*  J 2*	 dxoffset dyoffset V+  2DUP PLOT
			     2DUP 1 0 V+ PLOT
			     2DUP 0 1 V+ PLOT
			     1 1 V+ PLOT
			 LOOP
		 LOOP ; LOCAL

-- Autodetect display mode and (re-)display the picture.
: (DISPLAY)	GraphMode# $13 = IF (DISPLAY1) EXIT ENDIF
		GraphMode# $5D = IF (DISPLAY2) ENDIF ;


-- Change the x- and y-coordinate of the picture part shown on the display.
: +pxoffset	pxoffset >S S +	 PicPixels MIN	0 MAX  TO pxoffset
		PicPixels pxoffset - Xmax MIN TO DispPixels
		S> pxoffset <> IF (DISPLAY) ENDIF ; LOCAL

: +pyoffset	pyoffset >S S +	 PicLines  MIN	0 MAX  TO pyoffset
		PicLines  pyoffset - Ymax MIN TO DispLines
		S> pyoffset <> IF (DISPLAY) ENDIF ; LOCAL


CREATE dummy ," Not initialized."	LOCAL

dummy VALUE 'IdKernel			LOCAL

-- Show what has been selected so far.
: .STATUS
	CR ." Point Transform	 : " 'Idkernel .NAME
	CR ."  Picture w x h	 : " PicPixels DEC. ." x " PicLines DEC.
	CR ."  Picture x : y	 : " pxoffset DEC. ." : " pyoffset DEC.
	CR ."  Display w x h	 : " DispPixels DEC. ." x " DispLines DEC.
	CR ."  Display x : y	 : " dxoffset DEC. ." : " dyoffset DEC.
	CR ."	Work  x : y	 : " Wxoffset DEC. ." : " Wyoffset DEC.
	CR ."	Work  w x h	 : " WorkPixels DEC. ." x " WorkLines DEC.
	CR ;


-- What follows next is needed for contrast expansion by the histogram method.

#256 CARRAY Histolut LOCAL

: INIT.H	/OF Histolut 0 DO  I TO I Histolut
			     LOOP ; LOCAL


#256  ARRAY intensities	   LOCAL	-- /levels NEVER > 256

/levels 1- VALUE highlimit LOCAL	-- intensities above are white
	0  VALUE lowlimit  LOCAL	-- intensities below are black
	0  VALUE /Bin	   LOCAL	-- #-of-pixels in largest bin


-- Modify GRAYPALETTE's behavior ************************************

#64 VALUE Gain

: +Levels	/Levels +  #256 CIRCULAR	\ <incr> --- <>
		#16 MAX TO /Levels
		/Levels TO highlimit ;

: +Gain		Gain +     #256 CIRCULAR	\ <incr> --- <>
		5 MAX TO Gain ;

-- Draw a vertical colour bar at the left side of the screen.
: INDICATOR	Ymax
		0 DO
		    I /Levels
			< IF I
			ELSE 0			\ color(0) always black
		       ENDIF TO Color
		    0 I MOVE  5 I DRAWTO
		LOOP ; LOCAL

: (!color)	>S palette S  3 * 2+ + C!	\ <r> <g> <b> <index> --- <>
		   palette S  3 * 1+ + C!
		   palette S> 3 *    + C! ;

: GRAYPALETTE	/Levels	 PosblColors MIN	\ <> --- <>
		   0 ?DO 0
			 I Histolut Gain /Levels */
			 0
			 I (!color)
		    LOOP
		!PALETTE ;


-- count the number of pixels that have the same intensities.
-- note that this number can be 256*256 maximum (<16 bit)
-- Routine should use DVALUE-array for higher resolutions.
: BUILD-HISTOGRAM
		'OF intensities SIZEOF intensities ERASE
		Wyoffset  WorkLines COVER
		  DO Wxoffset  WorkPixels COVER
		     DO 1  Picture I J [] LC@ +TO intensities
		   LOOP
		LOOP
		0 /OF intensities
		0 DO I intensities UMAX
		LOOP TO /Bin ; LOCAL


-- Draw a single-line border.
: FRAME		0 0 MOVE  Xmax Ymax #RECTANGLE ;


-- Draw a cross-hair over a point of interest.
: DRAW-HHAIR	Pen SWAP  Xor! TO Pen		\ <value> --- <>
		U->D Ymax /Bin U*/ DROP
		?VSYNCWAIT
		0 OVER MOVE  Xmax SWAP CLIP&DRAWTO
		TO Pen ; LOCAL

: DRAW-VHAIR	Pen SWAP  Xor! TO Pen		\ <index> --- <>
		Xmax /levels /
		STACK ab|bab * SWAP 2/ + DUP
		0 MOVE ?VSYNCWAIT
		Ymax CLIP&DRAWTO
		TO Pen ; LOCAL

: DRAW-CHAIR	DUP DRAW-VHAIR			\ <index> --- <>
		intensities DRAW-HHAIR ; LOCAL


: SHOW-HISTOGRAM				\ <> --- <>
		/levels
		0 DO Xmax /levels /  I *  0 MOVE
		     Xmax /levels /
		     I intensities U->D Ymax /Bin U*/  DROP
		     #RECTANGLE
		LOOP
		FRAME
		highlimit DRAW-VHAIR
		lowlimit  DRAW-VHAIR ; LOCAL


: [+lowlimit]	lowlimit  + highlimit 1- MIN	\ <n> --- <>
		0 MAX TO lowlimit ; LOCAL

: +lowlimit	lowlimit  DRAW-VHAIR		\ <n> --- <>
		[+lowlimit]
		lowlimit  DRAW-VHAIR ; LOCAL

: [+highlimit]	highlimit + /levels 1-	MIN	\ <n> --- <>
		lowlimit 1+ MAX TO highlimit ; LOCAL

: +highlimit	highlimit DRAW-VHAIR		\ <n> --- <>
		[+highlimit]
		highlimit DRAW-VHAIR ; LOCAL


DOC	With COMPUTE-CLUT, the new intensity value S(i) becomes:
		i-1
		   Intensities[k] /  pixels * (/levels-1)
		k=1
	Of course,   pixels = (PicLines-yoffset) * (PicPixels-xoffset)
ENDDOC



-- Make sure every intensity is as likely as any other.
: COMPUTE-CLUT	INIT.H
		WorkPixels WorkLines UM* >S >S
		0 intensities U->D
		/levels
		1 DO I intensities U->D D+	\ running total
		     2DUP /levels 1- U32*16 DROP S T  UD/
		     TO I Histolut
		LOOP
		2DROP -S -S  GRAYPALETTE ; LOCAL

DOC	REWRITE-HISTOLUT linearly stretches the intensity between
	interactively defined low and high limits. Note that COMPUTE-CLUT
	may give better results if the intensity-probability curve is
	extremely irregular.
ENDDOC

: REWRITE-CLUT	 INIT.H		\ Inefficient, but that's unimportant here.
		/levels		\ the (low/high) limits may NOT be equal!
		0 DO  I lowlimit highlimit WITHIN
			 IF I lowlimit -  /levels 1- highlimit lowlimit - */
		       ELSE I lowlimit < IF 0 ( black )
				       ELSE /levels 1- ( white )
				      ENDIF
		      ENDIF
		     TO I Histolut
		LOOP
		GRAYPALETTE ; LOCAL


-- Interactively modify the strecthed area of the intensity scale.
: MODIFY-CLUT	GCLEAR	/levels 2/ SetFGColor SHOW-HISTOGRAM
		BEGIN (KEY2) ( for arrow keys to work! )
		      DOCASE '.' CASE  1 +lowlimit
			ELSE ',' CASE -1 +lowlimit
			ELSE --> CASE  1 +highlimit
			ELSE <-- CASE -1 +highlimit
			ELSE	 DROP REWRITE-CLUT
				 /Levels 2/ SetFGColor
				 EXIT
		      ENDCASE
		AGAIN ; LOCAL

-- User command; change CLUT according to histogram.
: BUC		GRAPHICS-IO BUILD-HISTOGRAM COMPUTE-CLUT ;

-- User command; change CLUT by eye-ball.
: BUM		GRAPHICS-IO BUILD-HISTOGRAM MODIFY-CLUT ;

: HUPDATE	Wyoffset 1+ WorkLines 2- COVER
		 ?DO
		    Wxoffset 1+ WorkPixels 2- COVER
		     ?DO
			 Picture I J [] 2DUP LC@ Histolut
			 -ROT LC!
		    LOOP
		LOOP ;

-- Selecting a Work field ****************************************

: DRAW-BOX	Wxoffset			dxoffset +
		PicLines Wyoffset Worklines + - dyoffset + MOVE
		WorkPixels WorkLines #RECTANGLE ;

TRUE VALUE Begin?

: +wx		DRAW-BOX
		Begin? IF Wxoffset +   0 MAX  PicPixels MIN  TO Wxoffset
		     ELSE WorkPixels + 2 MAX  PicPixels MIN  TO WorkPixels
		    ENDIF
		PicPixels Wxoffset - WorkPixels MIN 2 MAX TO WorkPixels ;


: +wy		DRAW-BOX
		Begin? IF Wyoffset +   0 MAX  PicLines MIN  TO Wyoffset
		     ELSE WorkLines +  2 MAX  PicLines MIN  TO WorkLines
		    ENDIF
		PicLines Wyoffset - WorkLines MIN 2 MAX TO WorkLines ;

: GetWorkField
		Pen Xor! TO Pen	 -1 SetFGColor	TRUE TO Begin?
	BEGIN	DRAW-BOX GETKEY >UPC
		DOCASE 'B' CASE DRAW-BOX TRUE  TO Begin?
		  ELSE 'E' CASE DRAW-BOX FALSE TO Begin?
		  ELSE --> CASE	 2 +wx
		  ELSE <-- CASE -2 +wx
		  ELSE --^ CASE -2 +wy
		  ELSE --v CASE	 2 +wy
		  ELSE ESC CASE	 DRAW-BOX TO Pen EXIT
		  ELSE DROP BELL DRAW-BOX
		ENDCASE
	AGAIN ; LOCAL



-- Point transformations **********************************************

FORWARD POINT-TRANSFORM		-- The user command to a point-transform

-- Compile a vector table (Kernel).
: EXEC,		 BEGIN	BEGIN -FIND 0= ABORT" Unknown?"
			      DUP (x) =
			WHILE DROP QUERY
			REPEAT
		       DUP [ ' ; ] LITERAL <>
		 WHILE DUP TYPE@ >S	\ mcode>, (spec) colon def ?
		      S 0=  S 9 = OR  S> $B = OR
			   IF LCFA , ,
			 ELSE DROP TRUE ABORT" Cannot compile this word!"
			ENDIF
		 REPEAT DROP ; LOCAL

CREATE	'Kernel #20 4 * ALLOT	LOCAL		-- room for 20 LCFA's
	'Kernel #20 4 * ERASE

: EXEC		-WORD (XNUMBER) 2DROP		\ <index> --- <>
		4 * 'Kernel +
		POSTPONE LITERAL
		POSTPONE @LEXEC ; LOCAL
		IMMEDIATE


-- Get a byte and sign-extend it.
:MACRO BC@	BX:		POP,	\ <seg> <offs> --- <byte>
		ES:		POP,
		AL: ES| (BX )	MOVB,
				CBW,
		AX:		PUSH,
;MACRO

TRUE VALUE ?Clip		-- gives special effect when off (but on is ok)

: CLIP?		?Clip IF 0 MAX		\ <word> --- <byte>
			 /levels 1- MIN
		    ELSE ABS
		   ENDIF ;


0 VALUE picture' LOCAL		-- segment of a dynamic buffer


: INIT-PTF	PICTURE[]
		0 1 allocate  buffer DROP TO picture'
		picture' 0  $FFFF 0 LFILL ; LOCAL

: EXIT-PTF	Wyoffset 1+ WorkLines 2- COVER
		 ?DO
		    Wxoffset 1+ WorkPixels 2- COVER
		     ?DO
			 Picture' I J [] BC@ Clip?
			 Picture  I J [] LC!
		    LOOP
		LOOP
		deallocate ; LOCAL



-- Transform a part of the picture. Each pixel's intensity is replaced by
-- a value depending on its neighbours' intensities, and that of its own.
DEFINE POINT-TRANSFORM 3*3Operator
		INIT-PTF
		Wyoffset 1+ WorkLines 2- COVER
		  DO
		    Wxoffset 1+ WorkPixels 2- COVER
		      DO
			 0
			 picture  I 1- J 1-  EXEC 0
			 picture  I    J 1-  EXEC 1
			 picture  I 1+ J 1-  EXEC 2
			 picture  I 1- J     EXEC 3
			 picture  I    J     EXEC 4
			 picture  I 1+ J     EXEC 5
			 picture  I 1- J 1+  EXEC 6
			 picture  I    J 1+  EXEC 7
			 picture  I 1+ J 1+  EXEC 8
					     EXEC 9
			 picture' I J [] LC!
		    LOOP
		LOOP
		EXIT-PTF ; LOCAL

: INSTALL3*3	CREATE	LABELROOT  ,		\ followed by routine names..
			HERE CELL+ ,		\ ..for all pixels + scaling
			EXEC,
		DOES>	@+ TO 'IdKernel
			@ 'Kernel #40 CMOVE	\ move 10 vectors!
			3*3Operator ; LOCAL

-- The pixel operations needed.
-- Coded for high speed (threading avoided)

: Add		>< + BC@ + ;	 LOCAL	\ <sum> <seg> <i> <j> --- <sum'>
: Sub		>< + BC@ - ;	 LOCAL	\ <sum> <seg> <i> <j> --- <sum'>
: Nop		3DROP ;		 LOCAL	\ <sum> <seg> <i> <j> --- <sum'>
: *8		>< + BC@ 8 * + ; LOCAL	\ <sum> <seg> <i> <j> --- <sum'>
: *9		>< + BC@ 9 * + ; LOCAL	\ <sum> <seg> <i> <j> --- <sum'>
: /1		NO-OP ;
: /9		9 / ;

INSTALL3*3 Sharpening	Sub Sub Sub
			Sub *9	Sub
			Sub Sub Sub
			/1 ;

INSTALL3*3 Laplace	Sub Sub Sub
			Sub *8	Sub
			Sub Sub Sub
			/1 ;

INSTALL3*3 VertOnly	Sub Nop Add
			Sub Nop Add
			Sub Nop Add
			/1 ;

INSTALL3*3 VertEnhanced Sub Nop Add
			Sub Add Add
			Sub Nop Add
			/1 ;

INSTALL3*3 HorOnly	Sub Sub Sub
			Nop Nop Nop
			Add Add Add
			/1 ;

INSTALL3*3 HorEnhanced	Sub Sub Sub
			Nop Add Nop
			Add Add Add
			/1 ;

INSTALL3*3 Lowpass	Add Add Add
			Add Add Add
			Add Add Add
			/9 ;

DEFINE POINT-TRANSFORM 3*5Operator
		INIT-PTF
		Wyoffset 2+ WorkLines 4 - COVER
		  DO
		    Wxoffset 1+ WorkPixels 2- COVER
		      DO
			 0
			 picture  I 1- J 2-  EXEC   0
			 picture  I    J 2-  EXEC   1
			 picture  I 1+ J 2-  EXEC   2
			 picture  I 1- J 1-  EXEC   3
			 picture  I    J 1-  EXEC   4
			 picture  I 1+ J 1-  EXEC   5
			 picture  I 1- J     EXEC   6
			 picture  I    J     EXEC   7
			 picture  I 1+ J     EXEC   8
			 picture  I 1- J 1+  EXEC   9
			 picture  I    J 1+  EXEC #10
			 picture  I 1+ J 1+  EXEC #11
			 picture  I 1- J 2+  EXEC #12
			 picture  I    J 2+  EXEC #13
			 picture  I 1+ J 2+  EXEC #14
					     EXEC #15
			 picture' I J [] LC!
		    LOOP
		LOOP
		EXIT-PTF ; LOCAL

: INSTALL3*5	CREATE	LABELROOT  ,		\ 16 routine names
			HERE CELL+ ,
			EXEC,
		 DOES>	@+ TO 'IdKernel
			@ 'Kernel #64 CMOVE
			3*5Operator ; LOCAL

INSTALL3*5 LVertOnly	 Sub Nop Add
			 Sub Nop Add
			 Sub Nop Add
			 Sub Nop Add
			 Sub Nop Add
			 /1 ;

INSTALL3*5 LVertEnhanced Sub Nop Add
			 Sub Nop Add
			 Sub Add Add
			 Sub Nop Add
			 Sub Nop Add
			 /1 ;

DEFINE POINT-TRANSFORM 5*3Operator
		INIT-PTF
		Wyoffset 1+ WorkLines 2- COVER
		  DO
		    Wxoffset 2+ WorkPixels 4 - COVER
		      DO
			 0
			 picture  I 2- J 1-  EXEC   0
			 picture  I 1- J 1-  EXEC   1
			 picture  I    J 1-  EXEC   2
			 picture  I 1+ J 1-  EXEC   3
			 picture  I 2+ J 1-  EXEC   4
			 picture  I 2- J     EXEC   5
			 picture  I 1- J     EXEC   6
			 picture  I    J     EXEC   7
			 picture  I 1+ J     EXEC   8
			 picture  I 2+ J     EXEC   9
			 picture  I 2- J 1+  EXEC #10
			 picture  I 1- J 1+  EXEC #11
			 picture  I    J 1+  EXEC #12
			 picture  I 1+ J 1+  EXEC #13
			 picture  I 2+ J 1+  EXEC #14
					     EXEC #15
			 picture' I J [] LC!
		    LOOP
		LOOP
		EXIT-PTF ; LOCAL

: INSTALL5*3	CREATE	LABELROOT  ,		\ 16 routine names
			HERE CELL+ ,
			EXEC,
		 DOES>	@+ TO 'IdKernel
			@ 'Kernel #64 CMOVE	\ move 16 vectors!
			5*3Operator ; LOCAL

INSTALL5*3 LHorOnly	Sub Sub Sub Sub Sub
			Nop Nop Nop Nop Nop
			Add Add Add Add Add
			/1 ;

INSTALL5*3 LHorEnhanced Sub Sub Sub Sub Sub
			Nop Nop Add Nop Nop
			Add Add Add Add Add
			/1 ;

	-- Non-linear Soble Edge detector

0 VALUE Enhanced LOCAL

DEFINE POINT-TRANSFORM SobelNL		\ I'm not proud of this monster.
		INIT-PTF
		Wyoffset 1+ WorkLines 2- COVER
		  DO
		    Wxoffset 1+ WorkPixels 2- COVER
		      DO
			 picture  I 1- J 1- [] BC@  NEGATE
			 picture  I 1+ J 1- [] BC@  +
			 picture  I 1- J    [] BC@  2* -
			 picture  I 1+ J    [] BC@  2* +
			 picture  I 1- J 1+ [] BC@  -
			 picture  I 1+ J 1+ [] BC@  +
			 picture' I J [] LC!
		    LOOP
		LOOP
		Wyoffset 1+ WorkLines 2- COVER
		  DO
		    Wxoffset 1+ WorkPixels 2- COVER
		      DO
			 picture  I 1- J 1- [] BC@
			 picture  I    J 1- [] BC@  2* +
			 picture  I 1+ J 1- [] BC@  +
			 picture  I 1- J 1+ [] BC@  -
			 picture  I    J 1+ [] BC@  2* -
			 picture  I 1+ J 1+ [] BC@  -
			 DUP *
			 picture' I J [] BC@ DUP * + SQRT
			 Enhanced IF picture  I J [] BC@ +
			       ENDIF
			 CLIP?
			 picture' I J [] LC!
		    LOOP
		LOOP
		EXIT-PTF ; LOCAL


: SobelOperator [ LABELROOT ] LITERAL TO 'Idkernel
		FALSE TO Enhanced
		SobelNL ;

: SobelEnhanced [ LABELROOT ] LITERAL TO 'Idkernel
		TRUE TO Enhanced
		SobelNL ;


-- Main loop ***********************************************

BASE DECIMAL

-- Interactive routine, shows picture and allows modification.
: DISPLAY	GRAPHICS-IO
		GRAYPALETTE			\ "grayshades" gives flash!
		Color ( save it .. )
		GCLEAR	(DISPLAY)
	BEGIN	INDICATOR
		FALSE GETKEY
		DOCASE 'r'  CASE 64 +Levels	 GRAYPALETTE
		  ELSE '+'  CASE  1 +Gain	 REWRITE-CLUT
		  ELSE '-'  CASE -1 +Gain	 REWRITE-CLUT
		  ELSE 'H'  CASE  1 [+highlimit] REWRITE-CLUT
		  ELSE 'h'  CASE -1 [+highlimit] REWRITE-CLUT
		  ELSE 'L'  CASE  1 [+lowlimit]	 REWRITE-CLUT
		  ELSE 'l'  CASE -1 [+lowlimit]	 REWRITE-CLUT
		  ELSE 'f'  CASE GetWorkField
		  ELSE 'p'  CASE POINT-TRANSFORM (DISPLAY)
		  ELSE 'b'  CASE BUC
		  ELSE 'x'  CASE HUPDATE
		  ELSE -->  CASE  -8 +pxoffset
		  ELSE <--  CASE   8 +pxoffset
		  ELSE --^  CASE   8 +pyoffset
		  ELSE --v  CASE  -8 +pyoffset
		  ELSE End  CASE -24 +pxoffset
		  ELSE Hme  CASE  24 +pxoffset
		  ELSE PgUp CASE  24 +pyoffset
		  ELSE PgDn CASE -24 +pyoffset
		  ELSE ESC  CASE NOT RESETPALETTE
		  ELSE ^Z   CASE NOT RESETPALETTE
		  ELSE DROP EMPTYBUFFER
		ENDCASE
	UNTIL	SetFGColor ; ( reset .. )

TO BASE


-- Help on the possible point transformations. ************************
: .POSSIBLE
		CUROFF
		EVAL[ printf trafo2.txt ]
		CR C/L 2- 0 DO '' EMIT LOOP CR
		CURON ;

-- Help on general commands.
: .HELP		CUROFF
		EVAL[ printf cmd2.txt ]
		CR C/L 2- 0 DO '' EMIT LOOP CR
		CURON ;

-- Setting some defaults..
: DEFAULTS	Or! TO Pen  Hres Vres  !XY-RANGE
		LowPass
		6 2^x 1- TO /Levels
		/Levels TO Gain
		0TO lowlimit  /Levels TO highlimit
		PicLines  ymax 1+ MIN TO DispLines
		Xmax 1+ picpixels - 2/ to dxoffset
		PicLines TO WorkLines  PicPixels to WorkPixels
		0TO Wxoffset 0TO Wyoffset ;


			   VGA_$13 INIT.GRAPHICS
		      CR .( Installing Vga mode 13h )
			 DEFAULTS .HELP HIDE-LOCALS

			(* End of VIDEO routines *)