PROC main()
	opengui()
	game()
EXCEPTDO
	closegui()
ENDPROC

/*
** 01 - open gui/variable screen/window size 24 bit
** 02 - map
** 03 - render environment
** 04 - lights
*/

MODULE	'intuition/intuition',
			'intuition/screens',
			'utility/tagitem',
			'exec/memory',
			'dos/dos',
			'libraries/cybergraphics',
			'cybergraphics'

DEF	CyberGfxBase

DEF	window:PTR TO Window
DEF	bitmap:PTR TO bitmap

PROC opengui()
	loadopts('dungeon.opts')
	IFN CyberGfxBase:=OpenLibrary('cybergraphics.library',0) THEN Raise("CGFX")
	IFN window:=OpenWindowTags(NIL,
			WA_InnerWidth,opts.wi,
			WA_InnerHeight,opts.he,
			WA_Left,opts.le,
			WA_Top,opts.to,
			WA_Title,'dungeon',
			WA_ScreenTitle,'dungeon v1.0 by MarK (mark@tbs-software.com) 2008',
			WA_Flags,WFLG_GIMMEZEROZERO|WFLG_ACTIVATE|WFLG_CLOSEGADGET|WFLG_DEPTHGADGET|WFLG_SIZEGADGET|WFLG_SIZEBBOTTOM|WFLG_DRAGBAR|WFLG_RMBTRAP,
			WA_IDCMP,IDCMP_CLOSEWINDOW|IDCMP_REFRESHWINDOW|IDCMP_MOUSEBUTTONS|IDCMP_RAWKEY|IDCMP_SIZEVERIFY.
			WA_MinWidth,320,
			WA_MaxWidth,1600,
			WA_MinHeight,240,
			WA_MaxHeight,1200,
			TAG_END) THEN Raise("WIN")
	IFN bitmap:=createbitmap(opts.wi,opts.he) THEN Raise("BM")
ENDPROC

PROC closegui()
	saveopts('dungeon.opts')
	IF bitmap THEN freebitmap(bitmap)
	IF window THEN CloseWindow(window)
	IF CyberGfxBase THEN CloseLibrary(CyberGfxBase)
ENDPROC

OBJECT options
	wi/he/le/to:UW		// window size/position

DEF	opts=NIL:PTR TO options

PROC loadopts(filename:PTR TO CHAR)
	IF opts THEN FreeVec(opts)
	IFN opts:=AllocVec(SIZEOF_options,MEMF_CLEAR|MEMF_PUBLIC) THEN Raise("MEM")

	DEF	file,head[3]:UL
	IF file:=Open(filename,MODE_OLDFILE)
		Read(file,head,12)
		IF (head[0]="DNGS") AND (head[2]=SIZEOF_options)
			Read(file,opts,SIZEOF_options)
		ENDIF
		Close(file)
	ELSE
		opts.wi:=320
		opts.he:=240
		opts.to:=0
		opts.le:=0
	ENDIF
ENDPROC

PROC refreshopts()
	IF window
		opts.wi:=window.GZZWidth
		opts.he:=window.GZZHeight
		opts.to:=window.TopEdge
		opts.le:=window.LeftEdge
	ENDIF
	IF bitmap
		freebitmap(bitmap)
		IFN bitmap:=createbitmap(opts.wi,opts.he) THEN Raise("BM")
	ENDIF
ENDPROC

PROC saveopts(filename:PTR TO CHAR)
	DEF	file
	IF opts
		refreshopts()
		IF file:=Open(filename,MODE_NEWFILE)
			Write(file,["DNGS",0,SIZEOF_options]:UL,12)
			Write(file,opts,SIZEOF_options)
			Close(file)
		ENDIF
	ENDIF
ENDPROC

OBJECT map
	x/y/l/d:UW,			// position/direction
	wi/he/le:UW,		// dimensions
	blocks:PTR TO UW,	// blocks
	items:PTR TO item,// items
	units:PTR TO unit	// units

DEF	map=NIL:PTR TO map

ENUM	D_East,
		D_South,
		D_West,
		D_North

PROC loadmap(filename:PTR TO CHAR)
	IF map THEN FreeVec(map)
	IFN map:=AllocVec(SIZEOF_map,MEMF_CLEAR|MEMF_PUBLIC) THEN Raise("MEM")

	DEF	file,head[3]:UL
	IF file:=Open(filename,MODE_OLDFILE)
		Read(file,head,12)
		IF (head[0]="DNGM") AND (head[2]=SIZEOF_map)
			Read(file,map,SIZEOF_map)
			IFN map.blocks:=AllocVec(map.wi*map.he*map.le*SIZEOF_UWORD,MEMF_CLEAR|MEMF_PUBLIC) THEN Raise("MEM")
			Read(file,map.blocks,map.wi*map.he*map.le*SIZEOF_UWORD)
		ENDIF
		Close(file)
	ELSE
		map.wi:=16
		map.he:=16
		map.le:=4
		map.x:=1
		map.y:=1
		map.l:=1
		map.d:=D_East
		map.blocks:=[
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,	// level 0 ground
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,	// level 1 base/walls
			1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
			1,1,1,0,1,1,1,1,1,1,1,1,1,0,1,1,
			1,1,1,0,0,0,0,0,0,0,0,1,1,0,0,1,
			1,1,1,0,0,0,0,1,0,1,0,0,0,0,1,1,
			1,1,1,0,1,0,0,1,0,1,0,1,1,1,1,1,
			1,1,1,0,1,0,0,0,0,1,0,0,0,0,0,1,
			1,1,1,0,1,0,0,0,1,1,0,1,1,1,0,1,
			1,1,1,0,0,0,0,0,1,1,0,1,1,1,0,1,
			1,1,0,0,0,0,0,0,0,1,0,1,0,0,0,1,
			1,0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,
			1,1,0,0,0,0,0,0,1,0,0,1,0,1,1,1,
			1,1,1,1,0,0,0,0,1,0,0,1,0,0,0,1,
			1,1,1,1,0,1,0,0,1,1,0,1,1,1,0,1,
			1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,	// level 2 walls
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,
			1,1,1,1,1,0,1,0,1,1,1,1,1,1,1,1,
			1,1,1,1,1,0,0,0,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,0,0,0,0,0,0,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,	// level 3 ceiling
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
			1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
			]:UW
	ENDIF
ENDPROC

PROC savemap(filename:PTR TO CHAR)
	DEF	file
	IF map
		IF file:=Open(filename,MODE_NEWFILE)
			Write(file,["DNGM",0,SIZEOF_map]:UL,12)
			Write(file,map,SIZEOF_map)
			Write(file,map.blocks,map.wi*map.he*map.le*SIZEOF_UWORD)
			Close(file)
		ENDIF
	ENDIF
ENDPROC

PROC turnleft()
	SELECT map.d
	CASE D_East		map.d:=D_North
	CASE D_South	map.d:=D_East
	CASE D_West		map.d:=D_South
	CASE D_North	map.d:=D_West
	ENDSELECT
ENDPROC

PROC turnright()
	SELECT map.d
	CASE D_East		map.d:=D_South
	CASE D_South	map.d:=D_West
	CASE D_West		map.d:=D_North
	CASE D_North	map.d:=D_East
	ENDSELECT
ENDPROC

ENUM	M_Front,
		M_Back,
		M_Left,
		M_Right,
		M_Up,
		M_Down

PROC move(where)
	DEF	xx,yy,ll
	xx:=map.x
	yy:=map.y
	ll:=map.l
	SELECT where
	CASE M_Front
		SELECT map.d
		CASE D_East		xx++
		CASE D_South	yy++
		CASE D_West		xx--
		CASE D_North	yy--
		ENDSELECT
	CASE M_Back
		SELECT map.d
		CASE D_East		xx--
		CASE D_South	yy--
		CASE D_West		xx++
		CASE D_North	yy++
		ENDSELECT
	CASE M_Left
		SELECT map.d
		CASE D_East		yy--
		CASE D_South	xx++
		CASE D_West		yy++
		CASE D_North	xx--
		ENDSELECT
	CASE M_Right
		SELECT map.d
		CASE D_East		yy++
		CASE D_South	xx--
		CASE D_West		yy--
		CASE D_North	xx++
		ENDSELECT
	CASE M_Up
		ll++
	CASE M_Down
		ll--
	ENDSELECT
	IF getmap(xx,yy,ll)<>1
		map.x:=xx
		map.y:=yy
		map.l:=ll
	ENDIF
ENDPROC

PROC getmap(x,y,l)(L)
	IF (x<0) OR (y<0) OR (l<0) THEN RETURN 0
	IF (x>=map.wi) OR (y>=map.he) OR (l>=map.le) THEN RETURN 0
ENDPROC map.blocks[map.wi*map.he*l+map.wi*y+x]

PROC getmaprel(x,y,l)(L)	// relative to direction/position
	DEF	xx,yy,ll
	SELECT map.d
	CASE D_East
		xx:=x+map.x
		yy:=y+map.y
		ll:=l+map.l
	CASE D_North
		xx:=map.x+y
		yy:=map.y-x
		ll:=map.l+l
	CASE D_West
		xx:=map.x-x
		yy:=map.y-y
		ll:=l+map.l
	CASE D_South
		xx:=map.x-y
		yy:=map.y+x
		ll:=map.l+l
	ENDSELECT
ENDPROC getmap(xx,yy,ll)

PROC drawmap()
	DEF	x,y
	FOR y:=0 TO map.he-1
		FOR x:=0 TO map.wi-1
			SetAPen(window.RPort,getmap(x,y,map.l))
			WritePixel(window.RPort,x,y)
		ENDFOR
	ENDFOR
ENDPROC

PROC drawmapdir()
	DEF	x,y
	FOR y:=-3 TO 3
		FOR x:=0 TO 8
			SetAPen(window.RPort,getmaprel(x,y,0))
			RectFill(window.RPort,(y+3)*8,opts.he-8-x*8,(y+3)*8+7,opts.he-8-x*8+7)
		ENDFOR
	ENDFOR
ENDPROC

ENUM	VISIBILITY=8

PROC renderdungeon()
	DEF	x,y,l,id,ll:PTR TO W,yy:PTR TO W
//	SetRast(window.RPort,0)
	fill(bitmap,$ff0000)
	ll:=[-3,3,-2,2,-1,1,0]:W
	yy:=ll
	FOR x:=VISIBILITY DTO 0
		FOR l:=0 TO 6
			FOR y:=0 TO 6
				id:=getmaprel(x,yy[y],ll[l])
				renderbox(yy[y],ll[l],x,id)
			ENDFOR
		ENDFOR
	ENDFOR
/*
	FOR x:=8 DTO 0
		FOR l:=0 TO 6
			FOR y:=0 TO 6
				id:=getmaprel(x,yy[y],ll[l])
				SetAPen(window.RPort,id)
				WritePixel(window.RPort,yy[y]+32,ll[l]*10+3+24-x)
			ENDFOR
		ENDFOR
	ENDFOR
*/
/*
	renderbox(1,0,7,1)
	renderbox(-1,0,7,1)
	renderbox(1,0,5,1)
	renderbox(-1,0,5,1)
	renderbox(1,0,3,1)
	renderbox(-1,0,3,1)
	renderbox(1,0,1,1)
	renderbox(-1,0,1,1)
*/
	WritePixelArray(bitmap.data,0,0,bitmap.wi*SIZEOF_rgb,window.RPort,0,0,bitmap.wi,bitmap.he,RECTFMT_RGB)
ENDPROC

OBJECT xy
	x/y:L

OBJECT xyz
	x/y/z:L

PROC renderbox(x,y,z,id)
	IF id=0 THEN RETURN
	DEF	cube=[	// cube point definition
		-1,-1,+1,
		+1,-1,+1,
		+1,+1,+1,
		-1,+1,+1,

		-1,-1,-1,
		+1,-1,-1,
		+1,+1,-1,
		-1,+1,-1]:xyz

	// 4           5
	// *-----------*
	// |\         /|
	// | \0     1/ |
	// |  *-----*  |
	// |  |     |  |
	// |  |     |  |
	// |  *-----*  |
	// | /3     2\ |
	// |/         \|
	// *-----------*
	// 7           6

	// selection of cube sides to render (to not to render invisible sides) (3 sides at most)
	// 1 - front
	// 2 - top
	// 3 - bottom
	// 4 - right
	// 5 - left
	// 6 - back (always invisible)
	DEF	list[4]:UW,n
	FOR n:=0 TO 3 list[n]:=0	// fourth must be always zero (for the loop below)
	IF y=0
		IF x>0
			list[0]:=5
			list[1]:=1
		ELSEIF x<0
			list[0]:=4
			list[1]:=1
		ELSE
			list[0]:=1
		ENDIF
	ELSEIF y<0
		IF x>0
			list[0]:=5
			list[1]:=2
			list[2]:=1
		ELSEIF x<0
			list[0]:=4
			list[1]:=2
			list[2]:=1
		ELSE
			list[0]:=2
			list[1]:=1
		ENDIF
	ELSEIF y>0
		IF x>0
			list[0]:=5
			list[1]:=3
			list[2]:=1
		ELSEIF x<0
			list[0]:=4
			list[1]:=3
			list[2]:=1
		ELSE
			list[0]:=3
			list[1]:=1
		ENDIF
	ENDIF

	DEFF	intensity
	intensity:=(VISIBILITY-Sqrt(x*x+y*y+z*z))/VISIBILITY
//	intensity:=(VISIBILITY-z)/VISIBILITY

	DEF	coords[8]:xy

	FOR n:=0 TO 7
		coords[n].x,coords[n].y:=perspective(x*2+cube[n].x,-y*2+cube[n].y,z*2+cube[n].z)
//		PrintF('\d: \d,\d\n',n,coords[n].x,coords[n].y)
	ENDFOR

	n:=0
	WHILE list[n]
		SELECT list[n]
		CASE 1
			renderfrontwall(coords[4].x,coords[4].y,coords[6].x-coords[4].x,coords[6].y-coords[4].y,intensity)
		CASE 2
			renderfloorceiling(coords[0].x,coords[0].y,coords[4].x,coords[4].y,coords[1].x,coords[5].x,intensity)
		CASE 3
			renderfloorceiling(coords[3].x,coords[3].y,coords[7].x,coords[7].y,coords[2].x,coords[6].x,intensity)
		CASE 4
			rendersidewall(coords[2].x,coords[2].y,coords[6].x,coords[6].y,coords[1].y,coords[5].y,intensity)
		CASE 5
			rendersidewall(coords[3].x,coords[3].y,coords[7].x,coords[7].y,coords[0].y,coords[4].y,intensity)
		ENDSELECT
		n++
	ENDWHILE
ENDPROC

CONST LOOKHEIGHT=0.4

PROC perspective(x:F,y:F,z:F)(L,L)
	DEFF	xx,yy,cc

	y+=LOOKHEIGHT

	cc:=2.0+z
	IF cc
		xx:=x/cc
		yy:=y/cc
	ENDIF
	xx*=opts.wi*1.1
	yy*=opts.he*1.1
	xx+=opts.wi/2
	yy+=opts.he/2

	yy-=opts.he*LOOKHEIGHT/2
ENDPROC xx,yy

PROC renderfrontwall(x,y,w,h,intensity:F)
//	SetAPen(window.RPort,0)
//	RectFill(window.RPort,x,y,x+w,y+h)
//	SetAPen(window.RPort,1)
//	Move(window.RPort,x,y)
//	Draw(window.RPort,x+w,y)
//	Draw(window.RPort,x+w,y+h)
//	Draw(window.RPort,x,y+h)
//	Draw(window.RPort,x,y)

	h--
	w--
	putbox(bitmap,x,y,w,h,shade(intensity,$cccccc))
//	puthline(bitmap,x,x+w,y,$000000)
//	puthline(bitmap,x,x+w,y+h,$000000)
//	putvline(bitmap,x,y,y+h,$000000)
//	putvline(bitmap,x+w,y,y+h,$000000)
ENDPROC

PROC renderfloorceiling(x1,y1,x2,y2,x1r,x2r,intensity:F)
	DEF	xxl,xxr,y,sy,dy,sx,dx,sr,dr
	DEFD	deltax,deltar
	IF y2>y1
		// floor
		sy:=y1
		dy:=y2
		sx:=x1
		dx:=x2
		sr:=x1r
		dr:=x2r
	ELSE
		// ceiling
		sy:=y2
		dy:=y1
		sx:=x2
		dx:=x1
		sr:=x2r
		dr:=x1r
	ENDIF
	deltax:=(dx-sx)/(dy-sy)
	deltar:=(dr-sr)/(dy-sy)
	FOR y:=sy TO dy
		xxl:=(y-sy)*deltax+sx
		xxr:=(y-sy)*deltar+sr
//		SetAPen(window.RPort,IF y=sy||y=dy THEN 1 ELSE 2)
//		Move(window.RPort,xxl,y)
//		Draw(window.RPort,xxr,y)
		puthline(bitmap,xxl,xxr,y,shade(intensity,$eeeeee))
//		SetAPen(window.RPort,1)
//		WritePixel(window.RPort,xxl,y)
//		WritePixel(window.RPort,xxr,y)
//		putpixel(bitmap,xxl,y,$0000ff)
//		putpixel(bitmap,xxr,y,$0000ff)
	ENDFOR
ENDPROC

PROC rendersidewall(x1,y1,x2,y2,y1t,y2t,intensity:F)
	DEF	yyt,yyb,x,sy,dy,sx,dx,st,dt
	DEFD	deltat,deltab
	IF x2>x1
		// left
		sy:=y1
		dy:=y2
		sx:=x1
		dx:=x2
		st:=y1t
		dt:=y2t
	ELSE
		// right
		sy:=y2
		dy:=y1
		sx:=x2
		dx:=x1
		st:=y2t
		dt:=y1t
	ENDIF
	deltab:=(dy-sy)/(dx-sx)
	deltat:=(dt-st)/(dx-sx)
//	PrintF('\d,\d\n',sx,dx)
	FOR x:=sx TO dx
		yyb:=(x-sx)*deltab+sy
		yyt:=(x-sx)*deltat+st
//		SetAPen(window.RPort,3)
//		Move(window.RPort,x,yyb)
//		Draw(window.RPort,x,yyt)
		putvline(bitmap,x,yyt,yyb,shade(intensity,$bbbbbb))
//		SetAPen(window.RPort,1)
//		WritePixel(window.RPort,x,yyt)
//		WritePixel(window.RPort,x,yyb)
//		putpixel(bitmap,x,yyt,$0000ff)
//		putpixel(bitmap,x,yyb,$0000ff)
	ENDFOR
ENDPROC

ENUM	ID_None,
		ID_Quit,
		ID_Refresh,
		ID_Front,
		ID_Back,
		ID_Left,
		ID_Right,
		ID_Up,
		ID_Down,
		ID_TurnLeft,
		ID_TurnRight

PROC wait4message(wait=FALSE)(L,L,L)
	IF wait THEN WaitPort(window.UserPort)
	DEF	msg:PTR TO IntuiMessage,
			class,code,mx,my,qual,id
	WHILE msg:=GetMsg(window.UserPort)
		class:=msg.Class
		code:=msg.Code
		qual:=msg.Qualifier
		mx:=msg.MouseX
		my:=msg.MouseY
		ReplyMsg(msg)

		SELECT class
		CASE IDCMP_CLOSEWINDOW
			id:=ID_Quit
		CASE IDCMP_NEWSIZE
			id:=ID_Refresh
			refreshopts()
		CASE IDCMP_RAWKEY
			SELECT code
			CASE $4c	id:=ID_Front
			CASE $4d	id:=ID_Back
			CASE $4f	id:=ID_Left
			CASE $4e	id:=ID_Right
			CASE $70	id:=ID_Up
			CASE $71	id:=ID_Down
			CASE $46	id:=ID_TurnLeft
			CASE $49	id:=ID_TurnRight
			ENDSELECT
		ENDSELECT
	ENDWHILE
ENDPROC id,mx,my

PROC game()
	loadmap('dungeon.map')
	drawmap()
	renderdungeon()
	drawmapdir()
	DEF	id
	WHILE (id:=wait4message(TRUE))<>ID_Quit
		SELECT id
		CASE ID_Front		move(M_Front)
		CASE ID_Back		move(M_Back)
		CASE ID_Left		move(M_Left)
		CASE ID_Right		move(M_Right)
		CASE ID_Up			move(M_Up)
		CASE ID_Down		move(M_Down)
		CASE ID_TurnLeft	turnleft()
		CASE ID_TurnRight	turnright()
		ENDSELECT
		renderdungeon()
		drawmapdir()
	ENDWHILE
	savemap('dungeon.map')
ENDPROC

OBJECT rgb
	r/g/b:UB

OBJECT bitmap
	wi/he:L,
	data:PTR TO rgb

PROC createbitmap(wi,he)(PTR TO bitmap)
	DEF	bm:PTR TO bitmap
	IFN bm:=AllocVec(SIZEOF_bitmap,MEMF_CLEAR|MEMF_PUBLIC) THEN Raise("MEM")
	IFN bm.data:=AllocVec(wi*he*SIZEOF_rgb,MEMF_PUBLIC|MEMF_CLEAR) THEN Raise("MEM")
	bm.wi:=wi
	bm.he:=he
ENDPROC bm

PROC freebitmap(bm:PTR TO bitmap)
	IF bm
		IF bm.data THEN FreeVec(bm.data)
		FreeVec(bm)
	ENDIF
ENDPROC

PROC putpixel(bm:PTR TO bitmap,x,y,rgb)
	DEF	pixel:PTR TO rgb
	IF x<0 THEN RETURN
	IF y<0 THEN RETURN
	IF x>=bm.wi THEN RETURN
	IF y>=bm.he THEN RETURN
	pixel:=bm.data[x+bm.wi*y]
	pixel.r:=rgb>>16
	pixel.g:=rgb>>8
	pixel.b:=rgb
ENDPROC

PROC putpixelfast(bm:PTR TO bitmap,x,y,rgb)
	DEF	pixel:PTR TO rgb
	pixel:=bm.data[x+bm.wi*y]
	pixel.r:=rgb>>16
	pixel.g:=rgb>>8
	pixel.b:=rgb
ENDPROC

PROC fill(bm:PTR TO bitmap,rgb)
	DEF	x,y,pixel:PTR TO rgb
	FOR y:=0 TO bm.he-1
		FOR x:=0 TO bm.wi-1
			pixel:=bm.data[x+bm.wi*y]
			pixel.r:=rgb>>16
			pixel.g:=rgb>>8
			pixel.b:=rgb
		ENDFOR
	ENDFOR
ENDPROC

PROC putbox(bm:PTR TO bitmap,x,y,wi,he,rgb)
	DEF	pixel:PTR TO rgb
	DEF	h,v
	IF x>=bm.wi THEN RETURN
	IF y>=bm.he THEN RETURN
	IF x+wi<0 THEN RETURN
	IF y+he<0 THEN RETURN
	IF x+wi>=bm.wi THEN wi:=bm.wi-x-1
	IF y+he>=bm.he THEN he:=bm.he-y-1
	IF x<0
		wi+=x
		x:=0
	ENDIF
	IF y<0
		he+=y
		y:=0
	ENDIF
	// now everything is cropped

	FOR v:=y TO y+he
		pixel:=bm.data[x+bm.wi*v]
		FOR h:=0 TO wi
			pixel.r:=rgb>>16
			pixel.g:=rgb>>8
			pixel.b:=rgb
			pixel+=SIZEOF_rgb
		ENDFOR
	ENDFOR
ENDPROC

PROC putvline(bm:PTR TO bitmap,x,y1,y2,rgb)
	DEF	y
	IF x<0 OR x>=bm.wi THEN RETURN
	IF y1>y2 THEN y1:=:y2
	IF y2<0 THEN RETURN
	IF y1>=bm.he THEN RETURN
	IF y1<=0 THEN y1:=0
	IF y2>=bm.he THEN y2:=bm.he-1
	FOR y:=y1 TO y2
		putpixelfast(bm,x,y,rgb)
	ENDFOR
ENDPROC

PROC puthline(bm:PTR TO bitmap,x1,x2,y,rgb)
	DEF	x
	IF y<0 OR y>=bm.he THEN RETURN
	IF x1>x2 THEN x1:=:x2
	IF x2<0 THEN RETURN
	IF x1>=bm.wi THEN RETURN
	IF x1<=0 THEN x1:=0
	IF x2>=bm.wi THEN x2:=bm.wi-1
	FOR x:=x1 TO x2
		putpixelfast(bm,x,y,rgb)
	ENDFOR
ENDPROC

PROC shade(intensity:F,rgb)(ULONG)
	DEF	r,g,b
	r:=(rgb>>16)
	g:=(rgb>>8)&$ff
	b:=rgb&$ff
	r*=intensity
	g*=intensity
	b*=intensity
	IF r>255 THEN r:=255
	IF g>255 THEN g:=255
	IF b>255 THEN b:=255
	IF r<0 THEN r:=0
	IF g<0 THEN g:=0
	IF b<0 THEN b:=0
ENDPROC (r<<16)|(g<<8)|b