APP Pbm2Pic
	TYPE 0
	ICON "\PIC\P2p.pic"
ENDA


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

	gUPDATE OFF
	gSETWIN 0,0,0,0

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

	about:

	GIPRINT "Press MENU"

	DO
		getev:
	UNTIL 0

ENDP

PROC about:
	LOCK ON
	dINIT "Pbm2Pic V1.1"
	dTEXT "","Series 3 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,"PIC",%c
	mCARD "Save","PBM",%n,"PIC",%v
	mCARD "Special","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)=%n
		IF id%(1)<>0
			savepbm:
		ENDIF
	ENDIF

	IF even%(1)=%v
		IF id%(1)<>0
			savepic:
		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 "Width:",gen$(w%,4),2
		dTEXT "Height:",gen$(h%,4),2
	ENDIF
	DIALOG
	LOCK OFF
ENDP

PROC savepic:
	LOCAL name$(128)
	LOCK ON
	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$
ENDP

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

PROC loadpbm:
	LOCAL name$(128)
	LOCAL p%(6),t%
	LOCK ON
	name$="\PBM\"
	dINIT "Choose .pbm file to convert"
	dFILE name$,"",0
	IF DIALOG<>0
		w$=name$
		t%=loadpbm%:(w$)
		IF t%<0
			GIPRINT "Error"
		ELSEIF t%>0
			GIPRINT "Not a PBM file"
		ENDIF
	ENDIF
	x%=0
	y%=0
	LOCK OFF
ENDP

PROC loadpic:
	LOCAL name$(128),im&,pich%,inbuf$(12),add%,ret%,t%
	LOCAL 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%)
		ret%=IOCLOSE(pich%)
		IF ret%<0
			RETURN
		ENDIF
		IF im&=0
			GIPRINT "Not a PIC file"
			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
		DIALOG
		IF id%(1)<>0
			gCLOSE id%(1)
			id%(1)=0
		ENDIF
		id%(5)=gLOADBIT(name$,0,im&)
		w%=gWIDTH
		h%=gHEIGHT
		id%(1)=gCREATE(0,0,w%,h%,1)
		gCOPY id%(5),0,0,w%,h%,3
		x%=0
		y%=0
		GIPRINT "Finished - Use cursor keys + Psion to scroll"
	ENDIF
	LOCK OFF

ENDP


PROC loadpbm%:(f$)
	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%=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%=VAL(in$)

REM Lets open a window, width w%, height h% if there isn't one,

	IF id%(1)<>0
		gCLOSE id%(1)
	ENDIF
	id%(1)=gCREATE(0,0,w%,h%,1)

REM Now we are at the start of the bitmap data

	gAT 0,0
	gFILL w%,h%,1
	sw%=w%/8
	IF sw%<w%/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%

		per%=(INT(t%(2))*100)/INT(h%)
		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%
	GIPRINT "Finished - Use cursor keys + Psion to scroll"

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

	RETURN 0

ENDP

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

	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%,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%,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%/8)<>(w%/8.0)
		t%(3)=w%/8+1
	ELSE
		t%(3)=w%/8
	ENDIF
	DO
		gPEEKLINE id%(1),t%(1),t%(2),buf%(),w%
		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%)
		IF per%<>oper%
			oper%=per%
			GIPRINT "Written "+GEN$(per%,3)+"%"
		ENDIF

	UNTIL t%(2)=h%

REM Finished - close the file

	GIPRINT "Finished"

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


	RETURN 0

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 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 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