/* ScolTris - Mar 98 - by Sylvain HUET */

defcom Cregister=register;;
defcom Cscore=score I;;
defcom CgameOver=gameOver;;

typeof Font=ObjFont;;

typeof win=ObjWin;;
typeof bmp=ObjBitmap;;
typeof scoreT=ObjText;;
typeof t=tab I;;
var sizeX=16;;
var sizeY=32;;
var square=12;;
var sizeDown=30;;
var outH=2;;
var iH=0;;
var iB=0;;
var colbord=0xd0d0d0;;
var score=0;;

typeof Xc=I;;
typeof Yc=I;;
typeof Nc=I;;
typeof Kc=I;;

typedef Game= iniG| startG | downG | runningG | clignoG [I I]|endG|pauseG;;
typeof state=Game;;
typeof tim=Timer;;

var pieces0=
[0xff ([0 (-1)]::[0 0]::[0 1]::[0 2]::nil)::
 ([(-1) 0]::[0 0]::[1 0]::[2 0]::nil)::
 ([0 (-1)]::[0 0]::[0 1]::[0 2]::nil)::
 ([(-1) 0]::[0 0]::[1 0]::[2 0]::nil)::nil]::
[0xb0ff ([0 0]::[1 0]::[0 1]::[1 1]::nil)::
 ([0 0]::[1 0]::[0 1]::[1 1]::nil)::
 ([0 0]::[1 0]::[0 1]::[1 1]::nil)::
 ([0 0]::[1 0]::[0 1]::[1 1]::nil)::nil]::
[0xffff ([0 0]::[(-1) 0]::[0 1]::[1 0]::nil)::
 ([0 0]::[0 (-1)]::[0 1]::[1 0]::nil)::
 ([0 0]::[(-1) 0]::[0 (-1)]::[1 0]::nil)::
 ([0 0]::[0 (-1)]::[0 1]::[(-1) 0]::nil)::nil]::
[0xff00 ([0 0]::[(-1) 0]::[0 1]::[1 1]::nil)::
 ([0 0]::[0 1]::[1 0]::[1 (-1)]::nil)::
 ([0 0]::[(-1) 0]::[0 1]::[1 1]::nil)::
 ([0 0]::[0 1]::[1 0]::[1 (-1)]::nil)::nil]::
[0xff00 ([0 0]::[1 0]::[0 1]::[(-1) 1]::nil)::
 ([0 0]::[1 0]::[1 1]::[0 (-1)]::nil)::
 ([0 0]::[1 0]::[0 1]::[(-1) 1]::nil)::
 ([0 0]::[1 0]::[1 1]::[0 (-1)]::nil)::nil]::
[0xffff00 ([0 0]::[0 (-1)]::[0 1]::[1 1]::nil)::
 ([0 0]::[(-1) 0]::[1 0]::[1 (-1)]::nil)::
 ([0 0]::[0 (-1)]::[0 1]::[(-1) (-1)]::nil)::
 ([0 0]::[(-1) 0]::[1 0]::[(-1) 1]::nil)::nil]::
[0xff00ff ([0 0]::[0 (-1)]::[0 1]::[(-1) 1]::nil)::
 ([0 0]::[(-1) 0]::[1 0]::[1 1]::nil)::
 ([0 0]::[0 (-1)]::[0 1]::[1 (-1)]::nil)::
 ([0 0]::[(-1) 0]::[1 0]::[(-1) (-1)]::nil)::nil]::
nil;;

fun setScore(i)=
 set score=i;
 _SETtext scoreT itoa score;
 _DMSsend this Cscore [score];;
fun gameOver()=_DMSsend this CgameOver [];;
fun _destroyE(x,y)=_DMSdelete this;;

fun _paintE(a,b)=
 _BLTbitmap win bmp 0 0;
 match state with
 (endG ->(_TXTout win Font sizeX*square/2 sizeY*square/2 TD_CENTER 0xffffff "Game Over";
  _TXTout win Font sizeX*square/2 sizeY*square/2+square*5 TD_CENTER 0xffffff "press 'space'"))
|(pauseG ->(_TXTout win Font sizeX*square/2 sizeY*square/2 TD_CENTER 0xffffff "Pause";
  _TXTout win Font sizeX*square/2 sizeY*square/2+square*5 TD_CENTER 0xffffff "press 'P'"))
|(_-> nil);;


fun _clickE(a,b,x,y,z)=_SETfocus win;;

fun drawH(x,y,i,j)=
 if i>=j then 0
 else
 (_DRAWrectangle bmp x y square square DRAW_SOLID 0 0 DRAW_SOLID t.i;
  drawH x+square y i+1 j);;

fun drawV(y,i,j)=
 if i>=j then 0
 else
 (drawH 0 y i i+sizeX;
  drawV y+square i+sizeX j);;

fun drawAll()=
 _FILLbitmap bmp 0;
 drawV 0 iH iB;
 _paintE nil nil;;

fun drawLine(y,c)=
 let sizeX-1->i in while i>=0 do
 (_DRAWrectangle bmp i*square (y-outH)*square square square DRAW_SOLID 0 0 DRAW_SOLID c;
  set i=i-1);;

fun drawMask1(x,y,c,l)=
 if l==nil then 0
 else let l->[[a _] n] in
 (_DRAWrectangle bmp (x+a)*square y square square DRAW_SOLID 0 0 DRAW_SOLID c;
  drawMask1 x y c n);;

fun drawMask(x,n,k)=
 let nth_list pieces0 n ->[c l] in
 let nth_list l k->ll in
 drawMask1 x (sizeY-outH)*square c ll;;
  
fun drawPiece1(x,y,c,l)=
 if l==nil then 0
 else let l->[[a b] n] in
 let x+a+(y+b)*sizeX-> i in
 if t.i then 1
 else if drawPiece1 x y c n then 1
 else
 (set t.i=c;
  if i>=iH then _DRAWrectangle bmp (x+a)*square (y+b-outH)*square square square
   DRAW_SOLID 0 0 DRAW_SOLID c
  else nil;
  0);;

fun drawPiece(x,y,n,k)=
 let nth_list pieces0 n ->[c l] in
 let nth_list l k->ll in
 drawPiece1 x y c ll;;

fun erasePiece1(x,y,l)=
 if l==nil then 0
 else let l->[[a b] n] in
 let x+a+(y+b)*sizeX-> i in
 (set t.i=0;
  if i>=iH then _DRAWrectangle bmp (x+a)*square (y+b-outH)*square square square
   DRAW_SOLID 0 0 DRAW_SOLID 0
  else nil;
  erasePiece1 x y n);;

fun erasePiece(x,y,n,k)=
 let nth_list pieces0 n ->[c l] in
 let nth_list l k->ll in
 erasePiece1 x y ll;;

fun iniTab()=
 set t=mktab sizeX*sizeY 0;
 let 0->i in while i<iB do
 (set t.i=set t.(i+sizeX-1)=colbord;
  set i=i+sizeX);
 let iB-sizeX->i in while i<iB do
 (set t.i=colbord;
  set i=i+1);;

fun choosepiece()=
 set Xc=sizeX/2;
 set Yc=1;
 set Nc=((rand&255)*sizelist pieces0)/256;
 set Kc=((rand&255)*4)/256;
 drawPiece Xc Yc Nc Kc;;

fun testLine(y,i)=
 if i<0 then 1
 else if t.(y+i) then testLine y i-1
 else 0;;

fun scroll(y)=
 let y*sizeX-1 -> i in
 while i>=0 do
 (set t.(i+sizeX)=t.i;
  set i=i-1);;

fun testFull(ymin,y)=
 if y<ymin then nil
 else if testLine y*sizeX sizeX-1 then y
 else testFull ymin y-1;;

fun downpiece()=
 let Yc+1->y in
 (erasePiece Xc Yc Nc Kc;
  if drawPiece Xc y Nc Kc
  then drawPiece Xc Yc Nc Kc
  else
  (set Yc=y;
   downpiece)
 );;

fun _clockE(a,b)=
 set state=match state with
  (iniG ->
   (iniTab;
    drawAll;
    setScore 0;
    startG))
 |(startG ->
   (if choosepiece then
    (_deltimer tim;set tim=nil;gameOver;endG)
    else runningG))
 |(runningG->
   let Yc+1->y in
   (erasePiece Xc Yc Nc Kc;
    if drawPiece Xc y Nc Kc
    then
    (drawPiece Xc Yc Nc Kc;
     let testFull Yc-1 sizeY-2 -> f in
     if f==nil then startG
     else clignoG [f 10])
    else
    (set Yc=y; state)
   ))
 |(downG->
   (downpiece;
    runningG))
 |(clignoG [y n]->
   if n then
   (drawLine y if n&1 then 0xffffff else 0;
    clignoG [y n-1])
   else
   (scroll y;
    drawAll;
    setScore score+1;
    let testFull Yc-1 sizeY-2 -> f in
     if f==nil then startG
     else clignoG [f 10]))
 |(_->nil);
 drawLine sizeY 0;
 drawMask Xc Nc Kc;
 _paintE nil nil
;;

fun _keyE(a,b,x,c)=
match state with
 (runningG ->
(if c==0xff54 then
  let (Kc+1)&3->k in
  (erasePiece Xc Yc Nc Kc;
   if drawPiece Xc Yc Nc k
   then drawPiece Xc Yc Nc Kc
   else set Kc=k;
   _paintE nil nil;0)
 else if c==0xff52 then
  let (Kc-1)&3->k in
  (erasePiece Xc Yc Nc Kc;
   if drawPiece Xc Yc Nc k
   then drawPiece Xc Yc Nc Kc
   else set Kc=k;
   _paintE nil nil;0)
 else if c==0xff51 then
  let Xc-1->x in
  (erasePiece Xc Yc Nc Kc;
   if drawPiece x Yc Nc Kc
   then drawPiece Xc Yc Nc Kc
   else set Xc=x;
   _paintE nil nil;0)
 else if c==0xff53 then
  let Xc+1->x in
  (erasePiece Xc Yc Nc Kc;
   if drawPiece x Yc Nc Kc
   then drawPiece Xc Yc Nc Kc
   else set Xc=x;
   _paintE nil nil;0)
 else if c==32 then
  (set state=downG;0)
 else if c=='p || c=='P then
  (_deltimer tim;set tim=nil;set state=pauseG;_paintE nil nil;0)
 else if c==27 then
  (_deltimer tim;set tim=nil;set state=endG;gameOver;_paintE nil nil;0)
 else nil))
|(endG ->
(if c==32 then
 (set state=iniG;
  set tim=_rfltimer _starttimer _channel 100 @_clockE 0;
  0)
 else nil))
|(pauseG ->
(if c=='p || c=='P then
 (set state=runningG;
  set tim=_rfltimer _starttimer _channel 100 @_clockE 0;
  0)
 else nil))
|(_->0);;

fun iniWin(wn,x,y)=
 set iH=outH*sizeX;
 set iB=sizeX*sizeY;
 set win=_CRwindow _channel wn x y square*sizeX square*(sizeY-outH)+sizeDown
  if wn==nil then WN_MENU+WN_MINBOX else WN_CHILDINSIDE|WN_NOCAPTION|WN_NOBORDER
  "ScolTris";
 set bmp=_CRbitmap _channel square*sizeX square*(sizeY-outH)+sizeDown;
 set scoreT=_CRtext _channel win 0 square*(sizeY+1-outH) square*sizeX sizeDown-square
   ET_BORDER|ET_ALIGN_CENTER "0";
 _CBwinPaint win @_paintE 0;
 _CBwinDestroy win @_destroyE 0;
 _CBwinKeydown win @_keyE 0;
 _CBwinClick win @_clickE 0;
 set state=endG;
 set Font=_CRfont _channel square*2 0 0 "arial";
 iniTab;
 drawAll;   
 _paintE nil nil;
0;;

fun _end(b)=
 _DMSdelete this;;

fun _resize(x,s)=
 let x->[wn x y w h] in _SIZEwindow win w h x y;
 0;;

fun IniDMI(param)=
 _DMSsend this Cregister [];
 srand time;
 let _DMSgetZone this "ScolTris" @_end @_resize @_end ->[wn x y w h] in
 if wn!=nil then
  iniWin wn x y
 else
  iniWin nil nil nil;
 0;;

fun __reset()=
 _deltimer tim;set tim=nil;set state=endG;gameOver;_paintE nil nil;0;;
