APP Pbm2PicA
	TYPE $9000
	ICON "\PIC\P2pa.pic"
ENDA


PROC main:
	GLOBAL even%(6),k%,w$(128),id%(8)
	GLOBAL w%(3),h%(3),x%,y%,planes%

	gUPDATE OFF
	CACHE 1000,5000
	gSETWIN 0,0,0,0

	planes%=1

	id%(2)=cutpic%:(2)
	grey:

	about:

	GIPRINT "Press MENU"

	DO
		getev:
	UNTIL 0

ENDP

PROC about:
	LOCK ON
	dINIT "Pbm2Pic V1.1"
	dTEXT "","Series 3a Version",$202
	dTEXT "","By Andrew Baldwin",2
	dTEXT "","e-mail: ar.baldwin@ic.ac.uk",2
	dTEXT "","or andrew@zarquon.demon.co.uk",2
	DIALOG
	LOCK OFF
ENDP

PROC menu%:

	LOCAL k%

	LOCK ON
	mINIT
	mCARD "Load","PBM",%b,"PGM",%g,"PIC",%c
	mCARD "Save","PBM",%n,"PGM",%h,"PIC",%v
	mCARD "Special","B/W-2-Grey",%2,"Info",%i,"About",%a,"Exit",%x
	k%=MENU
	LOCK OFF

	RETURN k%

ENDP

PROC getev:
	LOCAL l$(1)

	GETEVENT even%()

	IF even%(1)=$404
		w$=GETCMD$
		l$=LEFT$(w$,1)
		w$=MID$(w$,2,128)
		IF l$="X"
			STOP
		ENDIF
	ENDIF

	IF even%(1) AND 512
		even%(1)=even%(1)-512
	ENDIF

	IF even%(1)=290 :REM Menu key
		even%(1)=menu%:
	ENDIF

	IF even%(1)=%a
		about:
	ENDIF

	IF even%(1)=%i
		info:
	ENDIF

	IF even%(1)=%b
		loadpbm:
	ENDIF

	IF even%(1)=%c
		loadpic:
	ENDIF

	IF even%(1)=%g
		loadpgm:
	ENDIF

	IF even%(1)=%n
		IF id%(1)<>0
			savepbm:
		ENDIF
	ENDIF

	IF even%(1)=%h
		IF id%(1)<>0
			savepgm:
		ENDIF
	ENDIF

	IF even%(1)=%v
		IF id%(1)<>0
			savepic:
		ENDIF
	ENDIF

	IF even%(1)=%2
		IF id%(1)<>0
			IF planes%=1
				b2grey:
				planes%=2
			ELSE
				GIPRINT "Picture already has grey plane"
			ENDIF
		ELSE
			GIPRINT "You must load a bitmap first!"
		ENDIF
	ENDIF

	IF even%(1)=%x
		STOP
	ENDIF



REM Up arrow

	IF even%(1)=256
		y%=y%-5
	ELSEIF even%(1)=260
		y%=y%-20
	ENDIF

REM Down arrow

	IF even%(1)=257
		y%=y%+5
	ELSEIF even%(1)=261
		y%=y%+20
	ENDIF

REM Left arrow

	IF even%(1)=259
		x%=x%-5
	ELSEIF even%(1)=262
		x%=x%-20
	ENDIF

REM Right arrow

	IF even%(1)=258
		x%=x%+5
	ELSEIF even%(1)=263
		x%=x%+20
	ENDIF

	IF id%(1)<>0
		gUSE id%(1)
		gSETWIN x%,y%
	ENDIF

ENDP

PROC info:
	LOCK ON
	dINIT "Picture Info"
	IF id%(1)=0
		dTEXT "","No picture loaded yet!",2
	ELSE
		dTEXT "Bitplanes:",gen$(planes%,1),$202
		dTEXT "Width:",gen$(w%(1),4),2
		dTEXT "Height:",gen$(h%(1),4),2
	ENDIF
	DIALOG
	LOCK OFF
ENDP

PROC savepic:
	LOCAL name$(128)
	LOCK ON
	ONERR errhand
	name$="\PIC\"
	dINIT "Save .pic file as?"
	dFILE name$,"",49
	IF DIALOG<>0
		gUSE id%(1)
		gSAVEBIT name$
	ENDIF
	LOCK OFF
	GIPRINT "Saved pic file "+name$
	RETURN
	errhand::
	GIPRINT ERR$(ERR)
	RETURN
ENDP

PROC savepbm:
	LOCAL name$(128),bg%,t%
	LOCK ON
	name$="\PBM\"
	dINIT "Save .pbm file as?"
	dFILE name$,"",49
	IF planes%=2
		bg%=1
		dCHOICE bg%,"Which plane?","Black,Grey"
	ENDIF
	IF DIALOG<>0
		gUSE id%(1)
		t%=savepbm%:(name$,bg%)
		IF t%=0
			GIPRINT "Saved pbm file "+name$
		ELSE
			GIPRINT "Error"
		ENDIF
	ENDIF
	LOCK OFF
ENDP

PROC savepgm:
	LOCAL name$(128),t%
	LOCK ON
	name$="\PBM\"
	dINIT "Save .pgm file as?"
	dFILE name$,"",49
	IF DIALOG<>0
		gUSE id%(1)
		t%=savepgm%:(name$)
		IF t%=0
			GIPRINT "Saved pgm file "+name$
		ELSE
			GIPRINT "Error"
		ENDIF
	ENDIF
	LOCK OFF
ENDP

PROC loadpbm:
	LOCAL name$(128)
	LOCAL p%(6),t%,bg%,keep%
	LOCK ON
	bg%=1
	name$="\PBM\"
	dINIT "Choose .pbm file to convert"
	dFILE name$,"",0
	dCHOICE bg%,"Load as which plane?","Black,Grey"
	keep%=1
	IF planes%=2
		dCHOICE keep%,"Other plane?","Retain,Lose"
	ENDIF
	IF DIALOG<>0
		w$=name$
		IF keep%=2
			gCLOSE id%(1)
			id%(1)=gCREATE(0,0,w%(1),h%(1),1,bg%-1)
			planes%=bg%
		ENDIF
		t%=loadpbm%:(w$,bg%)
		IF t%<0
			GIPRINT "Error"
		ELSEIF t%>0
			GIPRINT "Not a PBM file"
		ENDIF
	ENDIF
	x%=0
	y%=0
	LOCK OFF
ENDP

PROC loadpgm:
	LOCAL name$(128)
	LOCAL p%(6),t%,dith%
	LOCK ON
	dith%=1
	name$="\PBM\"
	dINIT "Choose .pgm file to convert"
	dFILE name$,"",0
	dCHOICE dith%,"Handle how?","2 plane straight,Expand and dither"
	IF DIALOG<>0
		w$=name$
		t%=loadpgm%:(w$,dith%)
		IF t%<0
			GIPRINT "Error"
		ELSEIF t%>0
			GIPRINT "Not a PGM file"
		ENDIF
	ENDIF
	x%=0
	y%=0
	LOCK OFF
ENDP

PROC loadpic:
	LOCAL name$(128),im&,pich%,inbuf$(12),add%,ret%,t%
	LOCAL bg%,keep%,tx%,ty%
	LOCK ON
	name$="\PIC\"
	dINIT "Choose .pic file to load"
	dFILE name$,"",0
	IF DIALOG<>0
		add%=ADDR(inbuf$)+1
		ret%=IOOPEN(pich%,name$,$0400)
		IF ret%<0
			RETURN
		ENDIF
		ret%=IOREAD(pich%,add%,8)
		IF ret%<0
			RETURN
		ENDIF
		im&=ispic%:(add%)
		IF im&=0
			GIPRINT "Not a PIC file"
			RETURN
		ENDIF
		IF im&>1
			ret%=IOREAD(pich%,add%,12)
			IF ret%<0
				RETURN
			ENDIF
			tx%=PEEKW(add%+2)
			ty%=PEEKW(add%+4)
			ret%=IOREAD(pich%,add%,12)
			IF ret%<0
				RETURN
			ENDIF
			IF tx%=PEEKW(add%+2)
				IF ty%=PEEKW(add%+4)
					dINIT "2 plane picture?"
					dTEXT "","This PIC file has the first 2"
					dTEXT "","bitmaps the same size. Should"
					dTEXT "","I load both of them?"
					dBUTTONS "Yes!",%Y,"No!",%N
					IF DIALOG=(%Y Or %y)
						ret%=IOCLOSE(pich%)
						IF ret%<0
							RETURN
						ENDIF
						IF id%(1)<>0
							gCLOSE id%(1)
							id%(1)=0
						ENDIF
						id%(5)=gLOADBIT(name$,0,0)
						w%(1)=gWIDTH :w%(2)=w%(1) :w%(3)=w%(2)
						h%(1)=gHEIGHT :h%(2)=h%(1) :h%(3)=h%(2)
						id%(1)=gCREATE(0,0,w%(1),h%(1),1,1)
						gGREY 0
						gCOPY id%(5),0,0,w%(1),h%(1),3
						gCLOSE id%(5)
						id%(5)=gLOADBIT(name$,0,1)
						gUSE id%(1)
						gGREY 1
						gCOPY id%(5),0,0,w%(1),h%(1),3
						gCLOSE id%(5)
						planes%=2
						gGREY 0
						RETURN
					ENDIF
				ENDIF
			ENDIF
		ENDIF
		ret%=IOCLOSE(pich%)
		IF ret%<0
			RETURN
		ENDIF
		IF im&>1
			dINIT "Multi bitmap PIC file"
			dLONG im&,"Choose bitmap",0,im&-1
		ELSE
			dINIT "Single bitmap PIC file"
			im&=0
		ENDIF
		bg%=1
		dCHOICE bg%,"Load as which plane?","Black,Grey"
		keep%=1
		IF planes%=2
			dCHOICE keep%,"Other plane?","Retain,Lose"
		ENDIF
		DIALOG
		IF keep%=2
			gCLOSE id%(1)
			id%(1)=gCREATE(0,0,w%(1),h%(1),1,bg%-1)
			planes%=bg%
		ENDIF
		IF planes%=1 AND bg%=1
			IF id%(1)<>0
				gCLOSE id%(1)
				id%(1)=0
			ENDIF
			id%(5)=gLOADBIT(name$,0,im&)
			w%(1)=gWIDTH :w%(2)=w%(1) :w%(3)=w%(2)
			h%(1)=gHEIGHT :h%(2)=h%(1) :h%(3)=h%(2)
			id%(1)=gCREATE(0,0,w%(1),h%(1),1,0)
			gCOPY id%(5),0,0,w%(1),h%(1),3
		ELSEIF planes%=1 AND bg%=2
			id%(5)=gLOADBIT(name$,0,im&)
			w%(3)=gWIDTH
			h%(3)=gHEIGHT
			w%(1)=MAX(w%(2),w%(3))
			h%(1)=MAX(h%(2),h%(3))
			id%(6)=gCREATE(0,0,w%(1),h%(1),1,1)
			gGREY 0
			gCOPY id%(1),0,0,w%(2),h%(2),3
			gGREY 1
			gCOPY id%(5),0,0,w%(3),h%(3),3
			gCLOSE id%(5)
			gCLOSE id%(1)
			id%(5)=0
			id%(1)=id%(6)
			id%(6)=0
			planes%=2
		ELSEIF planes%=2
			gUSE id%(1)
			id%(5)=gLOADBIT(name$,0,im&)
			w%(bg%+1)=gWIDTH
			h%(bg%+1)=gHEIGHT
			w%(1)=MAX(w%(2),w%(3))
			h%(1)=MAX(h%(2),h%(3))
			gUSE id%(1)
			gSETWIN 0,0,w%(1),h%(1)
			gGREY bg%-1
			gCLS
			gCOPY id%(5),0,0,w%(bg%+1),h%(bg%+1),3
			gCLOSE id%(5)
			id%(5)=0
		ENDIF
		x%=0
		y%=0
		GIPRINT "Finished - Use cursor keys + Psion to scroll"
	ENDIF
	LOCK OFF

ENDP


PROC loadpbm%:(f$,pl%)
	GLOBAL ret%,add%,te$(4),handle%,mode%
	LOCAL t%,in$(4),t%(4),per%,oper%,buf%(125),bp%,sw%,ow%,oh%


	mode%= $0600

	ret%=IOOPEN(handle%,f$,mode%)
	IF ret%<0
		RETURN ret%
	ENDIF

	add%=ADDR(te$)

REM Read the magic number

	IF read%:(%P)=0
		RETURN 1
	ENDIF
	IF read%:(%4)=0
		RETURN 2
	ENDIF

REM Read the whitespace

	DO
		t%=read%:(0)
	UNTIL (t%<>$0A) AND (t%<>$20)
	IF t%>47 AND t%<58
		in$=CHR$(t%)
	ELSE
		RETURN 3
	ENDIF

REM Read the width

	DO
		t%=read%:(0)
		IF t%>47 AND t%<58
			in$=in$+CHR$(t%)
		ELSEIF (t%<>$0A) AND (t%<>$20)
			RETURN 4
		ENDIF
	UNTIL (t%=$0A) OR (t%=$20)
	w%(pl%+1)=VAL(in$)

REM Read the whitespace

	DO
		t%=read%:(0)
	UNTIL (t%<>$0A) AND (t%<>$20)
	IF t%>47 AND t%<58
		in$=CHR$(t%)
	ELSE
		RETURN 3
	ENDIF

REM Read the height

	DO
		t%=read%:(0)
		IF t%>47 AND t%<58
			in$=in$+CHR$(t%)
		ELSEIF (t%<>$0A) AND (t%<>$20)
			RETURN 4
		ENDIF
	UNTIL (t%=$0A) OR (t%=$20)
	h%(pl%+1)=VAL(in$)

REM Lets open a window, width w%, height h% if there isn't one,
REM or move to the correct window type if there is one already.

	w%(1)=MAX(w%(2),w%(3))
	h%(1)=MAX(h%(2),h%(3))

	IF id%(1)=0
		id%(1)=gCREATE(0,0,w%(1),h%(1),1,pl%-1)
		gGREY pl%-1
		planes%=pl%
	ELSEIF pl%=1 AND planes%=1
		gCLOSE id%(1)
		id%(1)=gCREATE(0,0,w%(1),h%(1),1)
		gGREY 0
	ELSEIF pl%=2 AND planes%=1
		id%(5)=gCREATE(0,0,w%(1),h%(1),1,1)
		gGREY 0
		gCOPY id%(1),0,0,w%(2),h%(2),3
		gCLOSE id%(1)
		id%(1)=id%(5)
		id%(5)=0
		gGREY 1
		planes%=2
	ELSEIF planes%=2
		gUSE id%(1)
		id%(5)=gCREATE(0,0,w%(1),h%(1),1,1)
		gGREY 2
		gCOPY id%(1),0,0,w%(pl%+1),h%(pl%+1),3
		gCLOSE id%(1)
		id%(1)=id%(5)
		id%(5)=0
		gGREY pl%-1
	ENDIF

REM Now we are at the start of the bitmap data

	gAT 0,0
	gFILL w%(1),h%(1),1
	sw%=w%(1)/8
	IF sw%<w%(1)/8.0
		sw%=sw%+1
	ENDIF
	t%(1)=1 :t%(2)=1 :t%(3)=0
	bp%=ADDR(buf%())+1
	ret%=IOREAD(handle%,bp%,sw%)
	t%=PEEKB(bp%+t%(3))
	DO
		DO
			gAT t%(1)-1,t%(2)-1
			gCOPY id%(2),0,t%,8,1,0
			t%(1)=t%(1)+8
			t%(3)=t%(3)+1
			t%=PEEKB(bp%+t%(3))
		UNTIL t%(1)>w%(1)

		per%=(INT(t%(2))*100)/INT(h%(1))
		IF per%<>oper%
			oper%=per%
			GIPRINT "Read "+GEN$(per%,3)+"%"
		ENDIF

		ret%=IOREAD(handle%,bp%,sw%)
		t%(3)=0
		t%=PEEKB(bp%+t%(3))
		t%(2)=t%(2)+1
		t%(1)=1
	UNTIL t%(2)>h%(1)
	GIPRINT "Finished - Use cursor keys + Psion to scroll"

	ret%=IOCLOSE(handle%)
	IF ret%<0
		RETURN ret%
	ENDIF


	RETURN 0

ENDP

PROC loadpgm%:(f$,dith%)
	GLOBAL ret%,add%,te$(4),handle%,mode%
	LOCAL t%,in$(4),t%(4),per%,oper%,buf%(480),max%,px%,bt&,gt&,mag&

	IF id%(1)<>0
		gCLOSE id%(1)
		id%(1)=0
	ENDIF


	mode%= $0600

	ret%=IOOPEN(handle%,f$,mode%)
	IF ret%<0
		RETURN ret%
	ENDIF

	add%=ADDR(te$)

REM Read the magic number

	IF read%:(%P)=0
		RETURN 1
	ENDIF
	IF read%:(%5)=0
		RETURN 2
	ENDIF

REM Read the whitespace

	DO
		t%=read%:(0)
	UNTIL (t%<>$0A) AND (t%<>$20)
	IF t%>47 AND t%<58
		in$=CHR$(t%)
	ELSE
		RETURN 3
	ENDIF

REM Read the width

	DO
		t%=read%:(0)
		IF t%>47 AND t%<58
			in$=in$+CHR$(t%)
		ELSEIF (t%<>$0A) AND (t%<>$20)
			RETURN 4
		ENDIF
	UNTIL (t%=$0A) OR (t%=$20)
	w%(1)=VAL(in$)

REM Read the whitespace

	DO
		t%=read%:(0)
	UNTIL (t%<>$0A) AND (t%<>$20)
	IF t%>47 AND t%<58
		in$=CHR$(t%)
	ELSE
		RETURN 3
	ENDIF

REM Read the height

	DO
		t%=read%:(0)
		IF t%>47 AND t%<58
			in$=in$+CHR$(t%)
		ELSEIF (t%<>$0A) AND (t%<>$20)
			RETURN 4
		ENDIF
	UNTIL (t%=$0A) OR (t%=$20)
	h%(1)=VAL(in$)

REM Read the whitespace

	DO
		t%=read%:(0)
	UNTIL (t%<>$0A) AND (t%<>$20)
	IF t%>47 AND t%<58
		in$=CHR$(t%)
	ELSE
		RETURN 3
	ENDIF

REM Read the maxval

	DO
		t%=read%:(0)
		IF t%>47 AND t%<58
			in$=in$+CHR$(t%)
		ELSEIF (t%<>$0A) AND (t%<>$20)
			RETURN 4
		ENDIF
	UNTIL (t%=$0A) OR (t%=$20)
	max%=VAL(in$)

REM Lets open a window, width w%, height h%, 2 planes

	IF dith%=1
		bt&=max%/3
		gt&=bt&*2
		id%(1)=gCREATE(0,0,w%(1),h%(1),1,1)
		dINIT "Thresholds"
		dTEXT "Maxval is:",GEN$(max%,3)
		dLONG bt&,"Black below:",1,max%
		dLONG gt&,"Grey below:",1,max%
		DIALOG
	ELSE
		dINIT "Magnify factor"
		dLONG mag&,"Expand by:",1,10
		DIALOG
		id%(1)=gCREATE(0,0,w%(1)*mag&,h%(1)*mag&,1,1)
	ENDIF

	add%=ADDR(buf%())+1

REM Now we are at the start of the bitmap data
REM If dith%=1, we are just rounding to black, grey, or white.
REM If dith%=2, we double the pic size% and dither from id%(3)

	IF dith%=1
		t%(2)=0
		DO
			t%(1)=0
			DO
				t%(3)=MIN(480,w%(1)-t%(1))
				ret%=IOREAD(handle%,add%+1,t%(3))
				IF ret%<0
					RETURN 6
				ENDIF
				t%(4)=0
				DO
					px%=PEEKB(add%+1+t%(4))
					IF px%<bt&
						gGREY 0
						gAT t%(1)+t%(4),t%(2)
						gLINEBY 0,0
					ELSEIF px%<gt&
						gGREY 1
						gAT t%(1)+t%(4),t%(2)
						gLINEBY 0,0
					ENDIF
					t%(4)=t%(4)+1
				UNTIL t%(4)=t%(3)
				t%(1)=t%(1)+t%(3)
				per%=(INT(t%(2))*100)/INT(h%(1))
				IF per%<>oper%
					oper%=per%
					GIPRINT "Read "+GEN$(per%,3)+"%"
				ENDIF
			UNTIL t%(1)=w%(1)
			t%(2)=t%(2)+1
		UNTIL t%(2)=h%(1)
	ELSE
		id%(4)=gCREATE(0,0,4,4,0,1)
		t%(2)=0
		DO
			t%(1)=0
			DO
				t%(3)=MIN(480,w%(1)-t%(1))
				ret%=IOREAD(handle%,add%+1,t%(3))
				IF ret%<0
					RETURN 6
				ENDIF
				t%(4)=0
				DO
					px%=PEEKB(add%+1+t%(4))
					px%=(px%*17)/max%
					gGREY 2
					gUSE id%(4)
					IF px%=17
						gCLS
					ELSE
						gCOPY id%(3),0,px%*4,4,4,3
					ENDIF
					gUSE id%(1)
					gAT (t%(1)+t%(4))*mag&,t%(2)*mag&
					gPATT id%(4),mag&,mag&,3
					t%(4)=t%(4)+1
				UNTIL t%(4)=t%(3)
				t%(1)=t%(1)+t%(3)
				per%=(INT(t%(2))*100)/INT(h%(1))
				IF per%<>oper%
					oper%=per%
					GIPRINT "Read "+GEN$(per%,3)+"%"
				ENDIF
			UNTIL t%(1)=w%(1)
			t%(2)=t%(2)+1
		UNTIL t%(2)=h%(1)
		w%(1)=w%(1)*mag&
		h%(1)=h%(1)*mag&
	ENDIF

	w%(2)=w%(1) :w%(3)=w%(2)
	h%(2)=h%(1) :h%(3)=h%(2)

	planes%=2

	GIPRINT "Finished - Use cursor keys + Psion to scroll"

	ret%=IOCLOSE(handle%)
	IF ret%<0
		RETURN ret%
	ENDIF


	RETURN 0

ENDP

PROC savepbm%:(f$,pl%)
	GLOBAL ret%,add%,te$(5),handle%,mode%
	LOCAL t%,in$(4),t%(6),per%,oper%,buf%(125),bp%,sw%,rb%(1),id%

	ONERR errhand

	IF pl%=2
		id%=id%(1)+$8000
	ELSE
		id%=id%(1)
	ENDIF


	mode%= $0102

	ret%=IOOPEN(handle%,f$,mode%)
	IF ret%<0
		RETURN ret%
	ENDIF

	add%=ADDR(te$)

REM Write the magic number - P4 - binary PBM

	te$="P4"
	POKEB add%+3,10

	ret%=IOWRITE(handle%,add%+1,3)
	IF ret%<0
		RETURN ret%
	ENDIF

REM Write the width

	te$=GEN$(w%(1),3)
	POKEB add%+len(te$)+1,32


	ret%=IOWRITE(handle%,add%+1,len(te$)+1)
	IF ret%<0
		RETURN ret%
	ENDIF

REM Write the height

	te$=GEN$(h%(1),3)
	POKEB add%+len(te$)+1,10

	ret%=IOWRITE(handle%,add%+1,len(te$)+1)
	IF ret%<0
		RETURN ret%
	ENDIF

REM Write the bitmap data

	t%(1)=0
	t%(2)=0
	add%=ADDR(buf%())
	IF (w%(1)/8)<>(w%(1)/8.0)
		t%(3)=w%(1)/8+1
	ELSE
		t%(3)=w%(1)/8
	ENDIF
	DO
		gPEEKLINE id%,t%(1),t%(2),buf%(),w%(1)
		t%(4)=0
		DO
			t%(5)=PEEKB(add%+t%(4))
			gPEEKLINE id%(2),0,t%(5),rb%(),8
			t%(6)=PEEKB(ADDR(rb%()))
			POKEB add%+t%(4),t%(6)
			t%(4)=t%(4)+1
		UNTIL t%(4)=t%(3)
		
		ret%=IOWRITE(handle%,add%,t%(3))
		IF ret%<0
			RETURN ret%
		ENDIF
		t%(2)=t%(2)+1

		per%=(INT(t%(2))*100)/INT(h%(1))
		IF per%<>oper%
			oper%=per%
			GIPRINT "Written "+GEN$(per%,3)+"%"
		ENDIF

	UNTIL t%(2)=h%(1)

REM Finished - close the file

	GIPRINT "Finished"

	ret%=IOCLOSE(handle%)
	IF ret%<0
		RETURN ret%
	ENDIF

	RETURN 0

	errhand::
	GIPRINT ERR$(ERR)
	PAUSE 20

	RETURN 1

ENDP

PROC savepgm%:(f$)
	GLOBAL ret%,add%,te$(5),handle%,mode%
	LOCAL t%,in$(4),t%(6),per%,oper%
	LOCAL buf%(480),bp%,sw%,rb%(1),id%,max%

	ONERR errhand

	max%=255


	mode%= $0102

	ret%=IOOPEN(handle%,f$,mode%)
	IF ret%<0
		RETURN ret%
	ENDIF

	add%=ADDR(te$)

REM Write the magic number - P5 - binary PGM

	te$="P5"
	POKEB add%+3,10

	ret%=IOWRITE(handle%,add%+1,3)
	IF ret%<0
		RETURN ret%
	ENDIF

REM Write the width

	te$=GEN$(w%(1),3)
	POKEB add%+len(te$)+1,32


	ret%=IOWRITE(handle%,add%+1,len(te$)+1)
	IF ret%<0
		RETURN ret%
	ENDIF

REM Write the height

	te$=GEN$(h%(1),3)
	POKEB add%+len(te$)+1,10

	ret%=IOWRITE(handle%,add%+1,len(te$)+1)
	IF ret%<0
		RETURN ret%
	ENDIF

REM Write the maxvals - 255 by default

	te$=GEN$(max%,3)
	POKEB add%+len(te$)+1,10

	ret%=IOWRITE(handle%,add%+1,len(te$)+1)
	IF ret%<0
		RETURN ret%
	ENDIF

REM Write the bitmap data

	t%(2)=0
	add%=ADDR(buf%())+1
	DO
		t%(1)=0
		DO
			t%(3)=MIN(480,w%(1)-t%(1))
			t%(4)=0
			DO
				POKEB add%+t%(4),max%
				t%(4)=t%(4)+1
			UNTIL t%(4)=t%(3)
			IF planes%=2
				gPEEKLINE id%(1)+$8000,t%(1),t%(2),rb%(),t%(3)
				t%(4)=0
				DO
					IF rb%(1) AND (2**t%(4))
						POKEB add%+t%(4),max%/2
					ENDIF
					t%(4)=t%(4)+1
				UNTIL t%(4)=t%(3)
			ENDIF
			gPEEKLINE id%(1),t%(1),t%(2),rb%(),t%(3)
			t%(4)=0
			DO
				IF rb%(1) AND (2**t%(4))
					POKEB add%+t%(4),0
				ENDIF
				t%(4)=t%(4)+1
			UNTIL t%(4)=t%(3)

			ret%=IOWRITE(handle%,add%,t%(3))
			IF ret%<0
				RETURN ret%
			ENDIF

			t%(1)=t%(1)+t%(3)

			per%=(INT(t%(2))*100)/INT(h%(1))
			IF per%<>oper%
				oper%=per%
				GIPRINT "Written "+GEN$(per%,3)+"%"
			ENDIF

		UNTIL t%(1)=w%(1)

		t%(2)=t%(2)+1

	UNTIL t%(2)=h%(1)

REM Finished - close the file

	GIPRINT "Finished"

	ret%=IOCLOSE(handle%)
	IF ret%<0
		RETURN ret%
	ENDIF

	RETURN 0

	Errhand::
	GIPRINT ERR$(ERR)
	PAUSE 20

	RETURN 1

ENDP

PROC read%:(match%)
	LOCAL t%
	ret%=IOREAD(handle%,add%+1,1)
	IF ret%<0
		RETURN ret%
	ENDIF
	t%=PEEKB(add%+1)
	IF match%=0
		RETURN t%
	ELSEIF match%=t%
		RETURN 1
	ELSE
		RETURN 0
	ENDIF
ENDP

PROC b2grey:
	LOCAL t%(2),d1%(1),d2%(1),px%,per%,oper%

	LOCK ON
	IF id%(1)<>0
		id%(4)=gCREATE(0,0,w%(1)/2,h%(1)/2,1,1)
		DO
			DO
				px%=0
				gPEEKLINE id%(1),t%(1),t%(2),d1%(),2
				gPEEKLINE id%(1),t%(1),t%(2)+1,d2%(),2
				IF (d1%(1) AND 1)
					px%=UADD(px%,1)
				ENDIF
				IF (d1%(1) AND 2)
					px%=UADD(px%,1)
				ENDIF
				IF (d2%(1) AND 1)
					px%=UADD(px%,1)
				ENDIF
				IF (d2%(1) AND 2)
					px%=UADD(px%,1)
				ENDIF
				IF px%>2
					gGREY 0
					gAT t%(1)/2,t%(2)/2
					gLINEBY 0,0
				ELSEIF px%>0
					gGREY 1
					gAT t%(1)/2,t%(2)/2
					gLINEBY 0,0
				ENDIF
				t%(1)=t%(1)+2
				IF t%(1)>=w%(1)-1
					t%(1)=w%(1)+1
				ENDIF
			UNTIL t%(1)>=w%(1)
			t%(2)=t%(2)+2
			IF t%(2)>=h%(1)-1
				t%(2)=h%(1)+1
			ENDIF
			t%(1)=0

			per%=(INT(t%(2))*100)/INT(h%(1))
			IF per%<>oper%
				oper%=per%
				GIPRINT "Converted "+GEN$(per%,3)+"%"
			ENDIF

		UNTIL t%(2)>=h%(1)
	ENDIF

	gCLOSE id%(1)
	id%(1)=id%(4)
	id%(4)=0

	w%(1)=w%(1)/2
	h%(1)=h%(1)/2
	w%(2)=w%(1) :w%(2)=w%(3)
	h%(2)=h%(1) :h%(2)=h%(3)

	LOCK OFF

ENDP

PROC ispic%:(add%)
	LOCAL flag%,num%

	flag%=1

	IF PEEKB(add%)<>%P
		flag%=0
	ENDIF
	IF PEEKB(add%+1)<>%I
		flag%=0
	ENDIF
	IF PEEKB(add%+2)<>%C
		flag%=0
	ENDIF
	IF PEEKB(add%+3)<>$DC
		flag%=0
	ENDIF
	IF PEEKB(add%+4)<>$30
		flag%=0
	ENDIF
	IF PEEKB(add%+5)<>$30
		flag%=0
	ENDIF

	IF flag%=1
		num%=PEEKW(add%+6)
		RETURN num%
	ELSE
		RETURN 0
	ENDIF
ENDP

PROC grey:
	LOCAL yf%,cnt%

	id%(6)=cutpic%:(3)
	id%(3)=gCREATE(0,0,16,68,0,1)

	gGREY 1
	gAT 0,0
	gFILL 16,36,0
	gGREY 0

	gPATT id%(6),16,32,3
	gGREY 1
	gAT 0,32
	gPATT id%(6),16,32,3

	gCLOSE id%(6)
ENDP

PROC CutPic%:(im%)
	LOCAL id%,wi%,ht%
	LOCAL f$(128),buf%(100)
	LOCAL h%,l%,o%

	f$=CMD$(1)
	l%=IOOPEN(h%,f$,$400)

	IF l% 
		GOTO cl2 
	ENDIF

	l%=IOREAD(h%,ADDR(buf%(1)),200)

	IF l%<=140 
		GOTO cl 
	ENDIF

	IF buf%(1)<>%O+(%P*256)
		GOTO cl
	ENDIF

	IF buf%(2)<>%L+(%O*256)
		GOTO cl
	ENDIF

	o%=23+(buf%(11) and $ff)
	l%=PEEKW(ADDR(buf%(1))+o%)

	IF l%<>%P+(%I*256)
		GOTO cl
	ENDIF

	IF l%=0 
		GOTO cl 
	ENDIF

	CALL($5f8d,1,o%,0,0,0)

	cl::
	IOCLOSE(h%)
	cl2::

	id%=gLoadBit(f$,0,im%)
	RETURN id%
ENDP