REM ...OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO

REM                                                

REM                Gfx routines Demo               

REM                                                

REM         Ronald Pieket Weeserik 10/11/94        

REM                                                

REM OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO



PROC Main%:



	LOCAL Win%,TempWin%,k%



	CACHE $1000,$1000			: REM Enable Turbo mode

	gUPDATE OFF						: REM Faster even!



	BUSY "Initialising..."

	TempWin%=gCREATE(0,0,160,86,0,1)

	gXBORDER 1,$201

	gFONT 6

	gGREY 0

	gAT 12,24

	PrtShad%:("[Z]oom demonstration")

	gAT 12,38

	PrtShad%:("[L]ive zoom update")

	gAT 12,52

	PrtShad%:("[F]ast-ish Flood Fill")

	gAT 12,66

	PrtShad%:("[ESC] to Exit")

	Win%=gCREATE(80,37,320,86,1,1)

	gAT 0,0

	Enlarge%:(TempWin%,0,0,160,86,2,1,0)

	gCLOSE TempWin%

	BUSY OFF



	WHILE k%<>27

		gUSE Win%

		gVISIBLE ON

		ClrKey%:

		DO

			k%=ASC(UPPER$(GET$))

		UNTIL k%=27 OR k%=%Z OR k%=%L OR k%=%F

		gVISIBLE OFF

		IF k%=%Z

			DemZoom%:

		ELSEIF k%=%L

			DemLive%:

		ELSEIF k%=%F

			DemFill%:

		ENDIF

	ENDWH



	gCLOSE Win%



ENDP



REM  



PROC DemLive%:



	REM All global ZmXXX Variables used by the

	REM ZmXXX: routines

	GLOBAL ZmX%,ZmY%,ZmW%,ZmH%,ZmHFac%,ZmVFac%

	GLOBAL ZmWin%,ZmWinX%,ZmWinY%,ZmGap%



	LOCAL Win%,k%



	Win%=gCREATE(0,0,360,160,1,1)

	DrwLive%:



	ZmOpen%:(480-(24*4+4),0,0,0,24,24,4,4,1)

	ZmBox%:



	k%=GET

	WHILE k%<>27

		ZmBox%:

		IF k%=258

			REM Right Arrow

			ZmMove%:(4,0)

		ELSEIF k%=259

			REM Left Arrow

			ZmMove%:(-4,0)

		ELSEIF k%=257

			REM Down Arrow

			ZmMove%:(0,4)

		ELSEIF k%=256

			REM Up Arrow

			ZmMove%:(0,-4)

		ENDIF

		ZmBox%:



		k%=GET

	ENDWH



	ZmClose%:

	gCLOSE Win%



ENDP



REM  



PROC DrwLive%:



	LOCAL t$(100)



	gXBORDER 1,$203



	gFONT 8

	gSTYLE 8



	gAT 12,40

	PrtShad%:("Use cursor keys to move around")



	gFONT 10

	gSTYLE 0



	t$="Press ESC to exit"

	gAT 12,60

	PrtShad%:(t$)

	gAT 12,60-9

	Enlarge%:(gIDENTITY,gX,gY,gTWIDTH(t$)+2,11,3,1,0)



	gFONT 6

	gSTYLE 32



	gGREY 0

	gAT 12,79

	gPRINT "The ENLARGE%: procedure works by copying"

	gAT 12,91

	gPRINT "whole lines and columns at a time, instead of"

	gAT 12,103

	gPRINT "addressing each pixel individually."



	gAT 12,110

	gFILL 336,38,0



	gFONT 11

	gTMODE 2

	gSTYLE 0



	gGREY 0

	gAT 16,125

	gPRINT "Wide, short areas enlarge faster than narrow, tall"

	gAT 16,142

	gPRINT "ones. (Because vertical lines take longer to draw.)"



ENDP



REM  



PROC DemZoom%:



	LOCAL Win1%,Win2%

	LOCAL x%,y%,HFac%,VFac%,Gap%

	LOCAL k%



	Win1%=gCREATE(0,0,80,24,0,1)

	DrwZoom%:



	Win2%=gCREATE(0,0,480,160,1,1)



	WHILE k%<>27



		HFac%=1+INT(RND*6)

		VFac%=1+INT(RND*6)



		IF HFac%=1 OR VFac%=1

			Gap%=0

		ELSE

			Gap%=INT(RND*2)

		ENDIF



		x%=INT(RND*(480-(80*HFac%)))

		y%=INT(RND*(160-(24*VFac%)))



		gUSE Win2%

		gAT x%,y%

		Enlarge%:(Win1%,0,0,80,24,HFac%,VFac%,Gap%)



		IOYIELD

		k%=KEY

	ENDWH



	gCLOSE Win2%

	gCLOSE Win1%



ENDP



REM  



PROC DrwZoom%:



	LOCAL t$(100)



	gGREY 0

	gAT 0,0

	gBOX gWIDTH,gHEIGHT

	gAT 1,1

	gBOX gWIDTH-2,gHEIGHT-2

	gGREY 1

	gAT 2,2

	gBOX gWIDTH-4,gHEIGHT-4

	gAT 3,3

	gBOX gWIDTH-6,gHEIGHT-6



	gFONT 10

	gAT 7,16

	PrtShad%:("ESC to Exit")



ENDP



REM  



PROC ClrKey%:

	WHILE KEY

	ENDWH

ENDP



REM  



PROC PrtShad%:(t$)



	LOCAL x%,y%



	x%=gX

	y%=gY



	gGREY 0

	gPRINT t$

	gAT x%+2,y%+2

	gGREY 1

	gPRINT t$

	gMOVE -2,-2



ENDP



REM 



PROC DemFill%:



	LOCAL Win%



	Win%=gCREATE(0,0,480,160,1,0)

	gGREY 0					: REM Bug in OPL requires this!

	gBORDER 0



	DrwFil1%:

	DrwFil2%:

	DrwFil3%:

	DrwFil4%:



	BEEP 1,300

	BUSY "Press any key..."

	GET

	BUSY OFF



	gCLOSE Win%



ENDP



REM 



PROC DrwFil1%:



	gGMODE 0

	gFONT 12

	gAT 20,30

	gPRINT "Simple open shapes are filled fairly quickly:"



	gAT 410,30					: REM Centre

	DrwCros%:



	gAT 410,30

	NewFill%:



ENDP



REM 



PROC DrwFil2%:



	gGMODE 0

	gFONT 8

	gSTYLE 1

	gAT 20,66

	gPRINT "Complex areas take a lot longer..."

	gFONT 10

	gSTYLE 0

	gAT 20,90

	gPRINT "But it's still a lot faster than the old recursive method!"



	gAT 40,61

	gLINEBY 120,-20

	gLINEBY 120,20

	gLINEBY -120,20

	gLINEBY -120,-20



	gAT 200,50

	NewFill%:



ENDP



REM 



PROC DrwFil3%:



	LOCAL t1&,t2&



	gGMODE 0

	gAT 50,118

	DrwDiam%:



	gFONT 6

	gSTYLE 0

	gAT 110,122

	gPRINT "<< Old Method"

	t1&=MINUTE*60+SECOND



	gAT 50,118

	OldFill%:



	t2&=MINUTE*60+SECOND

	gAT 110,122+16

	gPRINT t2&-t1&;" Seconds"



ENDP



REM 



PROC DrwFil4%:



	LOCAL t1&,t2&



	gGMODE 0

	gAT 430,118

	DrwDiam%:



	gFONT 6

	gSTYLE 0

	gAT 270,122

	gPRINT "New Method >>"

	t1&=MINUTE*60+SECOND



	gAT 430-32,118

	NewFill%:



	t2&=MINUTE*60+SECOND

	gAT 270,122+16

	gPRINT t2&-t1&;" Seconds"



ENDP



REM 



PROC OldFill%:



	LOCAL d%(1)



	gPEEKLINE gIDENTITY,gX,gY,d%(),1



	IF (d%(1) AND 1)=0

		gLINEBY 0,0



		gMOVE -1,0

		OldFill%:

		gMOVE 2,0

		OldFill%:

		gMOVE -1,-1

		OldFill%:

		gMOVE 0,2

		OldFill%:

		gMOVE 0,-1



	ENDIF



ENDP



REM 



PROC DrwDiam%:



	gMOVE -40,0

	gLINEBY 40,-20

	gLINEBY 40,20

	gLINEBY -40,20

	gLINEBY -40,-20

	gMOVE 10,0

	gLINEBY 30,-15

	gMOVE 0,30

	gLINEBY 30,-15



ENDP



REM 



PROC DrwCros%:



	gMOVE -10,0

	gLINEBY -40,-10

	gLINEBY 30,-15

	gLINEBY 20,20

	gLINEBY 20,-20

	gLINEBY 30,15

	gLINEBY -40,10

	gLINEBY 40,10

	gLINEBY -30,15

	gLINEBY -20,-20

	gLINEBY -20,20

	gLINEBY -30,-15

	gLINEBY 40,-10



ENDP



REM ...OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO

REM           THE NEW FLOOD FILL ROUTINE           

REM OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO



PROC NewFill%:



	GLOBAL ToDoIdx%

	GLOBAL DoneIdx%

	GLOBAL ToDoMin%(128)	: REM LEFT MOST X

	GLOBAL ToDoMax%(128)	: REM RIGHT MOST X

	GLOBAL ToDoY%(128)

	GLOBAL BitTab%(16)		: REM Quick bit no -> mask

	LOCAL i%,b%



	b%=$0001

	i%=1

	WHILE i%<=16

		BitTab%(i%)=b%

		b%=UADD(b%,b%)

		i%=i%+1

	ENDWH



	FlScan%:(gX,gX,gY)

	FlDoLin%:



ENDP



REM 



PROC FlDoLin%:



	LOCAL MinX%,MaxX%,y%



	WHILE DoneIdx% <> ToDoIdx%



		DoneIdx%=(DoneIdx% AND 127)+1	: REM wrap 1..128

		MinX%=ToDoMin%(DoneIdx%)

		MaxX%=ToDoMax%(DoneIdx%)

		y%=ToDoY%(DoneIdx%)



		IF FlRd1%:(MinX%,y%,1)

			gGMODE 2

			gAT MinX%,y%				: REM Draw a line from MinX%

			gLINETO MaxX%+1,y%	: REM to MaxX% inclusive.

			FlScan%:(MinX%,MaxX%,y%+1)

			FlScan%:(MinX%,MaxX%,y%-1)

		ENDIF



	ENDWH



ENDP



REM 



PROC FlScan%:(MinX%,MaxX%,y%)



	LOCAL ScanX%



	ScanX%=MinX%



	IF FlRd1%:(ScanX%,y%,1)

		ToDoIdx%=(ToDoIdx% AND 127)+1	: REM wrap 1..128

		ScanX%=FlLM%:(ScanX%,y%,0)

		ToDoMin%(ToDoIdx%)=FlLM%:(ScanX%,y%,0)

		ScanX%=FlRM%:(ScanX%,y%,0)

		ToDoMax%(ToDoIdx%)=ScanX%

		ToDoY%(ToDoIdx%)=y%

		ScanX%=ScanX%+1

	ENDIF



	ScanX%=1+FlRM%:(ScanX%,y%,1)



	WHILE ScanX%<=MaxX%

		ToDoIdx%=(ToDoIdx% AND 127)+1	: REM wrap 1..128

		ToDoMin%(ToDoIdx%)=ScanX%

		ScanX%=FlRM%:(ScanX%,y%,0)

		ToDoMax%(ToDoIdx%)=ScanX%

		ToDoY%(ToDoIdx%)=y%

		ScanX%=1+FlRM%:(ScanX%+1,y%,1)

	ENDWH



ENDP



REM 



PROC FlLM%:(xx%,y%,m%)



	LOCAL x%	: REM Running X

	LOCAL d%	: REM Data from screen

	LOCAL b%	: REM Bit number to test



	b%=15



	x%=xx%-16

	IF x%<0 : b%=x%+16 : x%=0 : ENDIF

	d%=FlRd16%:(x%,y%,m%)

	WHILE (d%=0) AND (x%>0)

		x%=x%-16

		IF x%<0 : b%=x%+16 : x%=0 : ENDIF

		d%=FlRd16%:(x%,y%,m%)

	ENDWH



	VECTOR b%+1

		B0,B1,B2,B3,B4,B5,B6,B7,B8

		B9,B10,B11,B12,B13,B14,B15

	ENDV

		B15:: IF d% AND $8000 : RETURN x%+16 : ENDIF

		B14:: IF d% AND $4000 : RETURN x%+15 : ENDIF

		B13:: IF d% AND $2000 : RETURN x%+14 : ENDIF

		B12:: IF d% AND $1000 : RETURN x%+13 : ENDIF

		B11:: IF d% AND $0800 : RETURN x%+12 : ENDIF

		B10:: IF d% AND $0400 : RETURN x%+11 : ENDIF

		B9::  IF d% AND $0200 : RETURN x%+10 : ENDIF

		B8::  IF d% AND $0100 : RETURN x%+9  : ENDIF

		B7::  IF d% AND $0080 : RETURN x%+8  : ENDIF

		B6::  IF d% AND $0040 : RETURN x%+7  : ENDIF

		B5::  IF d% AND $0020 : RETURN x%+6  : ENDIF

		B4::  IF d% AND $0010 : RETURN x%+5  : ENDIF

		B3::  IF d% AND $0008 : RETURN x%+4  : ENDIF

		B2::  IF d% AND $0004 : RETURN x%+3  : ENDIF

		B1::  IF d% AND $0002 : RETURN x%+2  : ENDIF

		B0::  IF d% AND $0001 : RETURN x%+1  : ENDIF

		RETURN x%



ENDP



REM 



PROC FlRM%:(xx%,y%,m%)



	LOCAL x%	: REM Running X

	LOCAL d%	: REM Data from screen

	LOCAL b%	: REM Bit number to test

	LOCAL w%	: REM Maximum X for screen read



	w%=gWIDTH-16

	b%=0



	x%=xx%

	IF x%>=w% : b%=x%-w% : x%=w% : ENDIF

	d%=FlRd16%:(x%,y%,m%)

	WHILE (d%=0) AND (x%<w%)

		x%=x%+16

		IF x%>=w% : b%=x%-w% : x%=w% : ENDIF

		d%=FlRd16%:(x%,y%,m%)

	ENDWH



	VECTOR b%+1

		B0,B1,B2,B3,B4,B5,B6,B7,B8

		B9,B10,B11,B12,B13,B14,B15

	ENDV

		B0::  IF d% AND $0001 : RETURN x%-1  : ENDIF

		B1::  IF d% AND $0002 : RETURN x%    : ENDIF

		B2::  IF d% AND $0004 : RETURN x%+1  : ENDIF

		B3::  IF d% AND $0008 : RETURN x%+2  : ENDIF

		B4::  IF d% AND $0010 : RETURN x%+3  : ENDIF

		B5::  IF d% AND $0020 : RETURN x%+4  : ENDIF

		B6::  IF d% AND $0040 : RETURN x%+5  : ENDIF

		B7::  IF d% AND $0080 : RETURN x%+6  : ENDIF

		B8::  IF d% AND $0100 : RETURN x%+7  : ENDIF

		B9::  IF d% AND $0200 : RETURN x%+8  : ENDIF

		B10:: IF d% AND $0400 : RETURN x%+9  : ENDIF

		B11:: IF d% AND $0800 : RETURN x%+10 : ENDIF

		B12:: IF d% AND $1000 : RETURN x%+11 : ENDIF

		B13:: IF d% AND $2000 : RETURN x%+12 : ENDIF

		B14:: IF d% AND $4000 : RETURN x%+13 : ENDIF

		B15:: IF d% AND $8000 : RETURN x%+14 : ENDIF

		RETURN x%+15



ENDP



REM 



PROC FlRd16%:(x%,y%,m%)



	REM m%=0 -> Return black data

	REM m%=1 -> Return black data inverted

	REM m%=2 -> Return black+grey data

	REM m%=3 -> Return black+grey data inverted



	REM DOES NOT CHECK FOR END-OF-SCREEN!

	REM =================================



	LOCAL Black%(1),Grey%(1)



	gPEEKLINE gIDENTITY,x%,y%,Black%(),16

	VECTOR m%+1

		L0,L1,L2,L3

	ENDV

		L0:: RETURN Black%(1)

		L1:: RETURN NOT Black%(1)

		L2:: gPEEKLINE (gIDENTITY OR $8000),x%,y%,Grey%(),16

					RETURN (Black%(1) OR Grey%(1))

		L3:: gPEEKLINE (gIDENTITY OR $8000),x%,y%,Grey%(),16

					RETURN NOT (Black%(1) OR Grey%(1))

ENDP



REM 



PROC FlRd1%:(xx%,y%,m%)



	REM m%=0 -> Return true if black data

	REM m%=1 -> Return true if no black data

	REM m%=2 -> Return true if black+grey data

	REM m%=3 -> Return true if no black+grey data



	REM Does its own end-of-screen handling



	LOCAL b%,x%

	LOCAL Black%(1),Grey%(1)



	x%=xx%

	b%=$0001

	IF x%>(gWIDTH-16)

		x%=gWIDTH-16

		b%=BitTab%(xx%-x%+1)

	ENDIF



	gPEEKLINE gIDENTITY,x%,y%,Black%(),16

	VECTOR m%+1

		L0,L1,L2,L3

	ENDV

		L0:: RETURN (b% AND (NOT Black%(1)))=0

		L1:: RETURN (b% AND Black%(1))=0

		L2:: gPEEKLINE (gIDENTITY OR $8000),x%,y%,Grey%(),16

					RETURN (b% AND (NOT (Black%(1) OR Grey%(1))))=0

		L3:: gPEEKLINE (gIDENTITY OR $8000),x%,y%,Grey%(),16

					RETURN (b% AND (Black%(1) OR Grey%(1)))=0

ENDP



REM ...OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO

REM        THE MAIN ENLARGEMENT DRAW ROUTINE       

REM OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO



PROC Enlarge%:(SrcDrw%,SrcX%,SrcY%,SrcW%,SrcH%,HFac%,VFac%,Gap%)



	REM This is the main enlargement routine.



	REM It draws the enlarged image into the CURRENT

	REM drawable, at the CURRENT position.

	REM In this implementation, black+grey windows are

	REM assumed for source and destination. Hack the

	REM routines to make them work with bitmaps or black

	REM only windows.



	REM Parameters:



	REM SrcDrw%     = Source drawable

	REM SrcX%,SrcY% = Top left of area to be enlarged

	REM SrcW%,SrcH% = Width and height of area

	REM HFac%,VFac% = Horizontal and vertical zoom factor

	REM Gap%        = 1->pixel gap; 0->no gap.







	LOCAL DstDrw%,DstX%,DstY%,DstW%,DstH%

	LOCAL TmpDrw%,TmpW%,TmpH%

	LOCAL i%,j%



	DstDrw%=gIDENTITY

	DstX%=gX

	DstY%=gY

	DstW%=SrcW%*HFac%

	DstH%=SrcH%*VFac%



	TmpDrw%=gCREATE(0,0,DstW%,DstH%,0,1)



	REM Horizontal



	gUSE TmpDrw%

	gGREY 2

	gCLS

	i%=0

	WHILE i%<SrcW%

		gCOPY SrcDrw%,SrcX%+i%,SrcY%,1,SrcH%,3

		gMOVE HFac%,0

		i%=i%+1

	ENDWH



	gUSE DstDrw%

	gGREY 2

	gAT DstX%,DstY%

	gCOPY TmpDrw%,0,0,DstW%,SrcH%,3



	i%=1

	WHILE i%<HFac%-Gap%

		gMOVE 1,0

		gCOPY TmpDrw%,0,0,DstW%,SrcH%,0

		i%=i%+1

	ENDWH



	REM Vertical



	gUSE TmpDrw%

	gGREY 2

	gCLS

	i%=0

	WHILE i%<SrcH%

		gCOPY DstDrw%,DstX%,DstY%+i%,DstW%,1,3

		gMOVE 0,VFac%

		i%=i%+1

	ENDWH



	gUSE DstDrw%

	gGREY 2

	gAT DstX%,DstY%

	gCOPY TmpDrw%,0,0,DstW%,DstH%,3



	i%=1

	WHILE i%<VFac%-Gap%

		gMOVE 0,1

		gCOPY TmpDrw%,0,0,DstW%,DstH%,0

		i%=i%+1

	ENDWH



	gCLOSE TmpDrw%



ENDP



REM ...OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO

REM          THE LIVE ZOOM WINDOW ROUTINES         

REM OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO



PROC ZmOpen%:(WinX%,WinY%,x%,y%,w%,h%,HFac%,VFac%,Gap%)



	LOCAL SrcDrw%



	SrcDrw%=gIDENTITY



	ZmX%=x%

	ZmY%=y%

	ZmW%=w%

	ZmH%=h%

	ZmHFac%=HFac%

	ZmVFac%=VFac%

	ZmWinX%=WinX%

	ZmWinY%=WinY%

	ZmGap%=Gap%



	ZmWin%=gCREATE(ZmWinX%,ZmWinY%,ZmW%*ZmHFac%+4,ZmH%*VFac%+4,1,1)

	gBOX gWIDTH,gHEIGHT

	gAT 2,2



	Enlarge%:(SrcDrw%,ZmX%,ZmY%,ZmW%,ZmH%,ZmHFac%,ZmVFac%,ZmGap%)



	gUSE SrcDrw%



ENDP



REM  



PROC ZmBox%:



	gGMODE 2

	gAT ZmX%-1,ZmY%-1

	gBOX ZmW%+2,ZmH%+2



ENDP



REM  



PROC ZmMove%:(XOffset%,YOffset%)



	LOCAL SrcDrw%

	LOCAL dx%,dy%,x%,y%,w%,h%



	SrcDrw%=gIDENTITY



	dx%=-XOffset%*ZmHFac%

	dy%=-YOffset%*ZmVFac%

	IF XOffset%<0

		x%=2

		w%=(ZmW%+XOffset%)*ZmHFac%

	ELSE

		x%=2-dx%

		w%=(ZmW%-XOffset%)*ZmHFac%

	ENDIF

	IF YOffset%<0

		y%=2

		h%=(ZmH%+YOffset%)*ZmVFac%

	ELSE

		y%=2-dy%

		h%=(ZmH%-YOffset%)*ZmVFac%

	ENDIF



	gUSE ZmWin%

	gSCROLL dx%,dy%,x%,y%,w%,h%



	ZmX%=ZmX%+XOffset%

	ZmY%=ZmY%+YOffset%



	IF XOffset%

		gUSE ZmWin%

		y%=ZmY%

		h%=ZmH%

		IF XOffset%>0

			gAT 2+(ZmW%-XOffset%)*ZmHFac%,2

			x%=ZmX%+ZmW%-XOffset%

			w%=XOffset%

		ELSE

			gAT 2,2

			x%=ZmX%

			w%=-XOffset%

		ENDIF

		Enlarge%:(SrcDrw%,x%,y%,w%,h%,ZmHFac%,ZmVFac%,ZmGap%)

	ENDIF



	IF YOffset%

		gUSE ZmWin%

		x%=ZmX%

		w%=ZmW%

		IF YOffset%>0

			gAT 2,2+(ZmH%-YOffset%)*ZmVFac%

			y%=ZmY%+ZmH%-YOffset%

			h%=YOffset%

		ELSE

			gAT 2,2

			y%=ZmY%

			h%=-YOffset%

		ENDIF

		Enlarge%:(SrcDrw%,x%,y%,w%,h%,ZmHFac%,ZmVFac%,ZmGap%)

	ENDIF



	gUSE SrcDrw%



ENDP



REM  



PROC ZmClose%:

	IF ZmWin%

		gCLOSE ZmWin%

		ZmWin%=0

	ENDIF

ENDP



REM