/* fix to releast 0.1:
*/

MODULE	'dos/dos',
			'intuition/intuition',
			'utility/tagitem'

PROC main()
	open()
	menu()
EXCEPTDO
	close()
ENDPROC

DEF	window:PTR TO Window

PROC open()
	IFN window:=OpenWindowTags(NIL,
		WA_InnerWidth,160,
		WA_InnerHeight,320,
		WA_Title,'tetris 0.1',
		WA_Flags,WFLG_ACTIVATE|WFLG_CLOSEGADGET|WFLG_DEPTHGADGET|WFLG_RMBTRAP|WFLG_GIMMEZEROZERO|WFLG_DRAGBAR,
		WA_IDCMP,IDCMP_CLOSEWINDOW|IDCMP_RAWKEY|IDCMP_INTUITICKS,
		TAG_END) THEN Raise()
	DEF	fh,tmp[8]:CHAR
	IF fh:=Open('tetris.highscore',MODE_OLDFILE)
		Read(fh,tmp,8)
		Read(fh,highscore,10*SIZEOF_highscore)
		Close(fh)
		IFN StrCmp(tmp,'TETRIS') THEN Raise()
	ELSE
		StrCopy(highscore[0].name,'MarK')
		StrCopy(highscore[1].name,'MarK')
		StrCopy(highscore[2].name,'MarK')
		StrCopy(highscore[3].name,'MarK')
		StrCopy(highscore[4].name,'MarK')
		StrCopy(highscore[5].name,'MarK')
		StrCopy(highscore[6].name,'MarK')
		StrCopy(highscore[7].name,'MarK')
		StrCopy(highscore[8].name,'MarK')
		StrCopy(highscore[9].name,'MarK')
		highscore[0].score:=10
		highscore[1].score:=9
		highscore[2].score:=8
		highscore[3].score:=7
		highscore[4].score:=6
		highscore[5].score:=5
		highscore[6].score:=4
		highscore[7].score:=3
		highscore[8].score:=2
		highscore[9].score:=1
	ENDIF
	DEF	a,b
	CurrentTime(&a,&b)
	Rnd(-(a+b))
ENDPROC

PROC close()
	IF window THEN CloseWindow(window)
	DEF	fh
	IF fh:=Open('tetris.highscore',MODE_NEWFILE)
		Write(fh,["TE","TR","IS",1]:UW,8)
		Write(fh,highscore,10*SIZEOF_highscore)
		Close(fh)
	ENDIF
ENDPROC

OBJECT highscore
	name[16]:CHAR,
	score:UL

DEF	highscore[10]:highscore

PROC menu()
	DEF	act=0,id
	WHILE (id:=wait4message())<>OPER_Quit
		SELECT id
		CASE OPER_KeyUp		act--
		CASE OPER_KeyDown		act++
		CASE OPER_Space
			SELECT act
			CASE MENU_Start	id:=game()
			CASE MENU_High		id:=highscores()
			CASE MENU_About	id:=about()
			CASE MENU_Quit		id:=OPER_Quit
			ENDSELECT
		CASE OPER_Escape		id:=OPER_Quit
		ENDSELECT
	EXITIF id=OPER_Quit
		IF act<MENU_Start THEN act:=MENU_Quit
		IF act>MENU_Quit THEN act:=MENU_Start
		menu_render(act)
	ENDWHILE
ENDPROC

ENUM	MENU_Start,
		MENU_High,
		MENU_About,
		MENU_Quit

PROC menu_render(act)
	DEF	pen,n
	SetRast(window.RPort,0)
	FOR n:=0 TO MENU_Quit
		pen:=IF n=act THEN 2 ELSE 1
		SetAPen(window.RPort,pen)
		SELECT n
		CASE MENU_Start	TextF("CE",20,pen,'Start')
		CASE MENU_High		TextF("CE",40,pen,'High scores')
		CASE MENU_About	TextF("CE",60,pen,'About')
		CASE MENU_Quit		TextF("CE",80,pen,'Quit')
		ENDSELECT
	ENDFOR
ENDPROC

ENUM	OPER_None,
		OPER_Quit,
		OPER_KeyUp,
		OPER_KeyDown,
		OPER_KeyLeft,
		OPER_KeyRight,
		OPER_Space,
		OPER_Vanilla,
		OPER_BackSpace,
		OPER_Escape,
		OPER_Tick

PROC wait4message(nowait=FALSE)(L,L)
	DEF	imsg:PTR TO IntuiMessage,id=OPER_None,key
	IFN nowait THEN WaitPort(window.UserPort) ELSE Delay(1)
	IF imsg:=GetMsg(window.UserPort)
		SELECT imsg.Class
		CASE IDCMP_CLOSEWINDOW
			id:=OPER_Quit
		CASE IDCMP_RAWKEY
			SELECT imsg.Code
			CASE $4c	id:=OPER_KeyUp
			CASE $4d	id:=OPER_KeyDown
			CASE $4f	id:=OPER_KeyLeft
			CASE $4e	id:=OPER_KeyRight
			CASE $40	id:=OPER_Space
			CASE $41	id:=OPER_BackSpace
			CASE $45	id:=OPER_Escape
			ENDSELECT
		CASE IDCMP_VANILLAKEY
			id:=OPER_Vanilla
			key:=imsg.Code
		CASE IDCMP_INTUITICKS
			id:=OPER_Tick
			timer++
		ENDSELECT
		ReplyMsg(imsg)
	ENDIF
ENDPROC id,key

PROC highscores()(L)
again:
	DEF	n,enter=FALSE
	SetRast(window.RPort,0)
	TextF("LE",20,2,'name')
	TextF("RI",20,2,'score')

	IF score
		TextF("CE",240,1,'Your score is \d',[score])
		IF highscore[9].score>score
			TextF("CE",260,1,'sorry, but not enough')
		ELSE
			ModifyIDCMP(window,IDCMP_CLOSEWINDOW|IDCMP_RAWKEY|IDCMP_VANILLAKEY)
			TextF("CE",260,1,'enter Your name')
			enter:=TRUE
		ENDIF
	ENDIF

	FOR n:=0 TO 9
		TextF("LE",36+16*n,1,'\s',[highscore[n].name])
		TextF("RI",36+16*n,1,'\d',[highscore[n].score])
	ENDFOR

	DEF	str[18]:CHAR,id,key
	FOR n:=0 TO 17 str[n]:=0
	IF enter
		LOOP
			id,key:=wait4message()
			IF id=OPER_Vanilla
				IF IsAlpha(key)=TRUE OR IsNum(key)=TRUE OR key="_" OR key=" "
					IF StrLen(str)<16
						StrAdd(str,[key,0]:UB)
					ENDIF
				ELSEIF key=8
					IF StrLen(str) THEN str[StrLen(str)-1]:=0
				ENDIF
				SetAPen(window.RPort,0)
				RectFill(window.RPort,0,265,window.GZZWidth,285)
				TextF("CE",280,1,'\l\s[16]',[str])
			ENDIF
		EXITIF key=13
		ENDLOOP
		add_score(str,score)
		score:=0
		JUMP again
	ENDIF

	TextF("CE",300,1,'press space to menu')

	ModifyIDCMP(window,IDCMP_CLOSEWINDOW|IDCMP_RAWKEY|IDCMP_INTUITICKS)

	WHILE (id:=wait4message())<>OPER_Space
	EXITIF id=OPER_Quit
	ENDWHILE

	score:=0
ENDPROC id

PROC add_score(name:PTR TO CHAR,score)
	DEF	n=9,c
	WHILE score>highscore[n].score
		IF n<9
			FOR c:=0 TO 15 highscore[n+1].name[c]:=highscore[n].name[c]
			highscore[n+1].score:=highscore[n].score
		ENDIF
		n--
	EXITIF n=-1
	ENDWHILE
	n++
	FOR c:=0 TO 15 highscore[n].name[c]:=name[c]
	highscore[n].score:=score
ENDPROC

PROC about()(L)
	DEF	id
	SetRast(window.RPort,0)

	TextF("CE",20,1,'tetris v0.1 by MarK')
	TextF("CE",40,1,'expect improvements')
	TextF("CE",60,1,'in near future!')

	TextF("CE",100,1,'this game is created')
	TextF("CE",120,1,'with powerfull')
	TextF("CE",140,2,'PowerD v0.30')
	TextF("CE",160,1,'programming language')

	TextF("CE",200,1,'contact me via email')
	TextF("CE",220,3,'mark@tbs-software.com')
	TextF("CE",240,1,'or icq: 210 510 160')
	TextF("CE",260,3,'www.tbs-software.com')

	TextF("CE",300,1,'press space to menu')

	WHILE (id:=wait4message())<>OPER_Space
	EXITIF id=OPER_Quit
	ENDWHILE

ENDPROC id

PROC TextF(x,y,pen,text,args=NIL:PTR TO UL)
	DEF	str[32]:STRING,tw
	StringF(str,text,args[0],args[1],args[2],args[3])
	tw:=TextLength(window.RPort,str,StrLen(str))
	SELECT x
	CASE "CE"	x:=(window.GZZWidth-tw)/2
	CASE "LE"	x:=8
	CASE "RI"	x:=window.GZZWidth-8-tw
	ENDSELECT
	SetAPen(window.RPort,pen)
	Move(window.RPort,x,y)
	Text(window.RPort,str,StrLen(str))
ENDPROC

DEF	field[10*20]:UB
DEF	gameover
DEF	score
DEF	refresh
DEF	timer

PROC game()(L)
	DEF	n
	score:=0
	refresh:=TRUE
	timer:=0

	FOR n:=0 TO 199 field[n]:=0
	gameover:=FALSE
	next_block()

	DEF	op
	WHILE (op:=wait4message(TRUE))<>OPER_Escape
		SELECT op
		CASE OPER_Space
			TextF("CE",140,2,'paused')
			TextF("CE",160,2,'press space to go on')
			WHILE wait4message()<>OPER_Space
			ENDWHILE
			refresh:=TRUE
		CASE OPER_Tick
			IFN timer\6
				block_move(OPER_KeyDown)
			ENDIF
		CASE OPER_Quit
			TextF("CE",140,2,'quit?')
			TextF("CE",160,2,'close again to quit')
			WHILE (op:=wait4message())<>OPER_Space
				IF op=OPER_Quit THEN RETURN op
			ENDWHILE
		ENDSELECT
		block_move(op)
		IF refresh THEN game_render()
	EXITIF gameover=TRUE
	ENDWHILE
	IF gameover=TRUE THEN IF score THEN highscores()
ENDPROC op

DEF	bx,by		// block coordinates
DEF	block[4*4]:UB,bs

PROC next_block()(L)
	DEF	objects=[
		0,0,1,0,
		0,0,1,0,
		0,0,1,0,
		0,0,1,0,

		1,1,0,0,
		1,1,0,0,
		0,0,0,0,
		0,0,0,0,

		0,1,0,0,
		1,1,1,0,
		0,0,0,0,
		0,0,0,0,

		0,1,0,0,
		1,1,0,0,
		1,0,0,0,
		0,0,0,0,

		1,0,0,0,
		1,1,0,0,
		0,1,0,0,
		0,0,0,0,

		0,1,1,0,
		0,1,0,0,
		0,1,0,0,
		0,0,0,0,

		1,1,0,0,
		0,1,0,0,
		0,1,0,0,
		0,0,0,0]:UB

	DEF	i
	i:=Rnd(7)
	CopyMem(objects+i*16,block,16)
	SELECT i
	CASE 0	bs:=4		// block size (to rotate)
	CASE 1	bs:=2
	DEFAULT	bs:=3
	ENDSELECT
	bx:=4-bs/2
	by:=0
	IF block_hit(bx,by) THEN gameover:=TRUE
ENDPROC

PROC block_move(dir=OPER_KeyDown)
	SELECT dir
	CASE OPER_KeyLeft
		IFN block_hit(bx-1,by)
			bx--
			refresh:=TRUE
		ENDIF
	CASE OPER_KeyRight
		IFN block_hit(bx+1,by)
			bx++
			refresh:=TRUE
		ENDIF
	CASE OPER_KeyDown
		IF block_hit(bx,by+1)
			block_set()
			next_block()
		ELSE
			by++
			refresh:=TRUE
		ENDIF
	CASE OPER_KeyUp
		rotate_block()
	ENDSELECT
ENDPROC

PROC block_hit(x,y)(L)
	DEF	mx,my
	FOR my:=0 TO 3
		FOR mx:=0 TO 3
			IF block[my*4+mx]
				IF field[(y+my)*10+x+mx] THEN RETURN TRUE
				IF x+mx<0 THEN RETURN TRUE
				IF x+mx>=10 THEN RETURN TRUE
				IF y+my>=20 THEN RETURN TRUE
			ENDIF
		ENDFOR
	ENDFOR
ENDPROC FALSE

PROC rotate_block()	// dirty but fast
	DEF	tmp[16]:UB,n
	FOR n:=0 TO 15 tmp[n]:=0
	SELECT bs
	CASE 2
		tmp[0]:=block[4]
		tmp[1]:=block[0]
		tmp[4]:=block[5]
		tmp[5]:=block[1]
	CASE 3
		tmp[0]:=block[8]
		tmp[1]:=block[4]
		tmp[2]:=block[0]
		tmp[4]:=block[9]
		tmp[5]:=block[5]
		tmp[6]:=block[1]
		tmp[8]:=block[10]
		tmp[9]:=block[6]
		tmp[10]:=block[2]
	CASE 4
		tmp[0] :=block[12]
		tmp[1] :=block[8]
		tmp[2] :=block[4]
		tmp[3] :=block[0]
		tmp[4] :=block[13]
		tmp[5] :=block[9]
		tmp[6] :=block[5]
		tmp[7] :=block[1]
		tmp[8] :=block[14]
		tmp[9] :=block[10]
		tmp[10]:=block[6]
		tmp[11]:=block[2]
		tmp[12]:=block[15]
		tmp[13]:=block[11]
		tmp[14]:=block[7]
		tmp[15]:=block[3]
	ENDSELECT

	DEF	mx,my
	FOR my:=0 TO 3
		FOR mx:=0 TO 3
			IF tmp[my*4+mx]
				IF field[(by+my)*10+bx+mx] THEN RETURN
				IF bx+mx<0 THEN RETURN
				IF bx+mx>=10 THEN RETURN
				IF by+my>=20 THEN RETURN
			ENDIF
		ENDFOR
	ENDFOR

	CopyMem(tmp,block,16)
	refresh:=TRUE
ENDPROC

PROC block_set()(L)
	DEF	mx,my,b
	FOR my:=0 TO 3
		FOR mx:=0 TO 3
			IF b:=block[my*4+mx]
				field[(by+my)*10+bx+mx]:=b
			ENDIF
		ENDFOR
	ENDFOR
	clear_full_lines()
ENDPROC FALSE

PROC clear_full_lines()
	DEF	n,lines=0,x,y
	FOR y:=0 TO 19
		n:=0
		FOR x:=0 TO 9
			IF field[x+y*10] THEN n++
		ENDFOR
		IF n=10
			FOR x:=0 TO 9
				field[x+y*10]:=255	// to be removed
			ENDFOR
			lines++
		ENDIF
	ENDFOR
	SELECT lines
	CASE 1	score++
	CASE 2	score+=3
	CASE 3	score+=6
	CASE 4	score+=10
	ENDSELECT
	WHILE lines
		FOR y:=19 DTO 0
			WHILE field[y*10]=255
				lines_down(y-1)
			ENDWHILE
		ENDFOR
		lines--
	ENDWHILE
	refresh:=TRUE
ENDPROC

PROC lines_down(sy)
	DEF	x,y
	FOR y:=sy DTO 0
		FOR x:=0 TO 9 field[(y+1)*10+x]:=field[y*10+x]
	ENDFOR
	FOR x:=0 TO 9 field[x]:=0	// clear the top line
ENDPROC

PROC game_render()
	DEF	x,y,b
	SetRast(window.RPort,0)
	FOR y:=0 TO 19
		FOR x:=0 TO 9
			b:=field[y*10+x]
			SetAPen(window.RPort,b)
			RectFill(window.RPort,x*16,y*16,x*16+15,y*16+15)
		ENDFOR
	ENDFOR

	FOR y:=0 TO 3
		FOR x:=0 TO 3
			IF b:=block[y*4+x]
				SetAPen(window.RPort,b)
				RectFill(window.RPort,(x+bx)*16,(y+by)*16,(x+bx)*16+15,(y+by)*16+15)
			ENDIF
		ENDFOR
	ENDFOR
	refresh:=FALSE
ENDPROC