rem #####################################################
rem #     Program : Sir Tet
rem # 
rem #      Author : Marc Gale
rem #
rem # Description : An old favourite using falling blocks
rem #
rem #####################################################

gosub initialise
gosub main_loop
exit

rem #####################################################
rem # Procedure name : quitgame
rem # 
rem #        Details : This routine is essentially
rem #                  a pause with quit option
rem # 
rem #####################################################
label quitgame
 highlight=0
 repeat
  for a=1 to 2
   gosub flip_screen
   setrgb 1,0,0,0
   fill rectangle 0,480,640,512
   setrgb 1,255,255,255
   text 150,500,"Quit Game?"
   if highlight=0 then
    setrgb 1,255,255,255
   else
    setrgb 1,100,100,100
   fi
   text 280,500,"No"

   if highlight=1 then
    setrgb 1,255,255,255
   else
    setrgb 1,100,100,100
   fi
   text 340,500,"Yes"
  next a

  joypad=peek("port1")
  if and(joypad,32)>0 then highlight=1 fi

  if and(joypad,128)>0 then highlight=0 fi

  if and(joypad,16384)>0 then
   if highlight=1 then
    endgame=1
   fi
  fi
 until (and(joypad,16384)>0)
return

rem #####################################################
rem # Procedure name : main_loop
rem # 
rem #        Details : The main housekeeping routine.
rem #                  This is basically the heart of
rem #                  the program, calling routines 
rem #                  to do the various tasks required
rem #                  by the program.
rem #
rem #####################################################
label main_loop
 joypad=0
 repeat
  gosub title_screen
  gosub main_menu
 until (1=2)
return

rem #####################################################
rem # Procedure name : init_main_menu
rem # 
rem #        Details : reset the main variables of the
rem #                  main menu
rem #
rem #####################################################
label init_main_menu
 edgered=255
 edgeblue=0
 edgegreen=0
 edgenewred=0
 edgenewblue=255
 edgenewgreen=0
 cycle_delay=cycle_reset
 m$=me$
 mx=10
 mpos=0
 colval=0
 coldir=1
 mouth=0
 mouthdir=1
 option=0
 numoptions=3
 oldjoypad=joypad
return

rem #####################################################
rem # Procedure name : waitfornoinput
rem # 
rem #        Details : Wait until nothing is being
rem #                  pressed
rem #
rem #####################################################
label waitfornoinput
 repeat
  joypad=or(peek("port1"),peek("port2"))
 until (joypad=0)
return

rem #####################################################
rem # Procedure name : display_scroller
rem # 
rem #        Details : This routine displays the scroll
rem #                  text message.  As well as 
rem #                  displaying the message, it deals
rem #                  with everything to do with it.
rem #                  This includes advancing the text
rem #                  and looping back to the start.
rem # 
rem #####################################################
label display_scroller
 setrgb 1,0,0,0
 fill rectangle 0,480,640,512
 setrgb 1,255,255,255
 mx=mx-2
 if mx<=0 then 
  mx=mx+10
  mpos=mpos+1
  if mpos>len(m$) then
   mpos=0
  fi
 fi

 text mx-10,500,mid$(m$,mpos,65)
return

rem #####################################################
rem # Procedure name : main_menu
rem # 
rem #        Details : The main menu handler
rem #
rem #####################################################
label main_menu
 gosub init_main_menu
 curpos=3

 repeat
  gosub flip_screen
  clear window

  gosub draw_main_menu
  gosub cycle
  gosub display_scroller

  joypad=peek("port1")
  if oldjoypad<>joypad then
   if and(joypad,64)>0 and curpos<numoptions then
    curpos=curpos+1
   fi

   if and(joypad,16)>0 and curpos>1 then
    curpos=curpos-1
   fi

   if and(joypad,16384)>0 then
    option=curpos
   fi
   oldjoypad=joypad
  fi

  if option=1 then
   gosub game_loop
   gosub init_main_menu
  fi

  if option=2 then
   gosub instructions
   gosub init_main_menu
  fi

 until (option=numoptions)
return

rem #####################################################
rem # Procedure name : draw_main_menu
rem # 
rem #        Details : Draw the main menu
rem #
rem #####################################################
label draw_main_menu
 setrgb 0,0,0,0
 setrgb 1,edgered,edgegreen,edgeblue
 setrgb 2,edgered,edgegreen,edgeblue
 setrgb 3,0,0,0

 ypos=curpos*50+95

 x=220-int(ran(10))
 repeat
  gtriangle x,ypos to x+30,ypos to x+15,ypos-int(ran(10))-20
  gtriangle x,ypos to x+30,ypos to x+15,ypos+int(ran(10))+20
  x=x+int(ran(5))+10
 until (x>=390)

 if curpos=1 then
  setrgb 1,0,0,0
  for x=-1 to 1 step 2
   for y=-1 to 1 step 2
    text 270+x,150+y,"Start Game"
   next y
  next x
  setrgb 1,255,255,255
  text 270,150,"Start Game"
 else
  setrgb 1,100,100,100
  text 270,150,"Start Game"
 fi

 if curpos=2 then
  setrgb 1,0,0,0
  for x=-1 to 1 step 2
   for y=-1 to 1 step 2
    text 260+x,200+y,"Instructions"
   next y
  next x
  setrgb 1,255,255,255
  text 260,200,"Instructions"
 else
  setrgb 1,100,100,100
  text 260,200,"Instructions"
 fi

 if curpos=3 then
  setrgb 1,0,0,0
  for x=-1 to 1 step 2
   for y=-1 to 1 step 2
    text 240+x,250+y,"Return to title"
   next y
  next x
  setrgb 1,255,255,255
  text 240,250,"Return to title"
 else
  setrgb 1,100,100,100
  text 240,250,"Return to title"
 fi
return

rem #####################################################
rem # Procedure name : instructions
rem # 
rem #        Details : Displays the instructions
rem #####################################################
label instructions
  setdispbuf curbuf
  setdrawbuf curbuf

  setrgb 0,100,50,0
  clear window

  setrgb 1,0,0,0
  line 50,60 to 600,60

  gosub waitfornoinput

  setrgb 1,50,50,0
  for x=-1 to 1 step 2
   for y=-1 to 1 step 2
    text 50+x,50+y,"Sir Tet - Copyright Marc Gale (Xalthorn) 2001","lb"
   next y
  next x
  setrgb 1,150,150,255
  text 50,50,"Sir Tet - Copyright Marc Gale (Xalthorn) 2001","lb"

  for a=1 to instructlines
    if in$(a)<>"" then
      for b=1 to len(in$(a))
        setrgb 1,50,50,50
        for x=-1 to 1 step 2
         for y=-1 to 1 step 2
          text b*12+50+x,a*18+70+y,mid$(in$(a),b,1)
         next y
        next x
        setrgb 1,255,255,255
        text b*12+50,a*18+70,mid$(in$(a),b,1)
        buttons=or(peek("port1"),peek("port2"))
        if buttons=0 then
          wait 0.1
        fi
      next b
    fi
  next a

  gosub waitfornoinput

  setrgb 1,255,255,255
  text sw/2,sh-20,"Press the X button for the main menu","cc"

  repeat
    joypad=or(peek("port1"),peek("port2"))
  until (and(joypad,16384)=16384)
return

rem #####################################################
rem # Procedure name : draw_game_screen
rem # 
rem #        Details : This procedure prepares the game
rem #                  screen.
rem #
rem #####################################################
label draw_game_screen
 for a=1 to 2
  setrgb 0,0,0,0
  gosub flip_screen
  clear window
  setrgb 1,200,200,200
  for x=-1 to 1 step 2
   for y=-1 to 1 step 2
    text 180+x,20+y,"Score :"
    text 180+x,40+y," High :"
    text 335+x,20+y,"Lvl :"
   next y
  next x

  setrgb 1,0,0,50
  text 180,20,"Score :"
  setrgb 1,50,0,0
  text 180,40," High :"
  setrgb 1,0,50,0
  text 335,20,"Lvl :"

 next a
return

rem #####################################################
rem # Procedure name : draw_scores
rem # 
rem #        Details : Displays the current scores
rem #
rem #####################################################
label draw_scores
 setrgb 1,0,0,0
 fill rectangle 250,8 to 330,26
 fill rectangle 250,28 to 330,44
 setrgb 1,255,255,255
 text 250,21,score$
 text 250,41,hiscore$
return

rem #####################################################
rem # Procedure name : draw_level
rem # 
rem #        Details : Displays the current level
rem #
rem #####################################################
label draw_level
 setrgb 1,0,0,0
 fill rectangle 385,8 to 420,26
 setrgb 1,255,255,255
 text 385,21,level$
return

rem #####################################################
rem # Procedure name : game_loop
rem # 
rem #        Details : The game housekeeping routine.
rem #
rem #####################################################
label game_loop
 edgered=0
 edgeblue=0
 edgegreen=0
 edgenewred=0
 edgenewblue=255
 edgenewgreen=0
 level=1
 score=0
 hiscore$=str$(hiscore)
 score$=str$(score)
 level$=str$(level)
 cycle_delay=cycle_reset
 m$=ga$

 gosub draw_game_screen
 gosub clear_well
 gosub draw_well

 gosub new_shape

 linesleft=level*10
 drop_delay=20
 drop=0
 endgame=0
 stuck=0

 repeat
  gosub check_stuck

  for scr=1 to 2
   gosub flip_screen
   gosub draw_scores
   gosub draw_level
   gosub draw_edges
   gosub cycle
   gosub draw_sparks
   gosub display_scroller
   gosub undraw_shape
   if drop>=drop_delay then
    gosub move_shape
    drop=0
   fi
   gosub draw_shape
  next scr
  oldshape=curshape
  olddir=direction
  oldxpos=xpos
  oldypos=ypos

  drop=drop+1
  gosub process_input
  gosub check_hiscore
 until (endgame=1)
return

rem #####################################################
rem # Procedure name : cycle
rem # 
rem #        Details : Cycles the edge colours
rem #
rem #####################################################
label cycle
 cycle_delay=cycle_delay-1
 if cycle_delay=0 then
  cycle_delay=cycle_reset
  gosub change_colour
 fi

 if edgered<edgenewred then
  edgered=edgered+1
 fi

 if edgered>edgenewred then
  edgered=edgered-1
 fi

 if edgegreen<edgenewgreen then
  edgegreen=edgegreen+1
 fi

 if edgegreen>edgenewgreen then
  edgegreen=edgegreen-1
 fi

 if edgeblue<edgenewblue then
  edgeblue=edgeblue+1
 fi

 if edgeblue>edgenewblue then
  edgeblue=edgeblue-1
 fi
return

rem #####################################################
rem # Procedure name : change_colour
rem # 
rem #        Details : changes the edge colours
rem #
rem #####################################################
label change_colour
 edgenewred=int(ran(255))
 edgenewgreen=int(ran(255))
 edgenewblue=int(ran(255))
return

rem #####################################################
rem # Procedure name : check_stuck
rem # 
rem #        Details : Checks to see if the piece is
rem #                  stuck
rem #
rem #####################################################
label check_stuck
 if stuck>2 then
  if moved=1 then
   stuck=0
   gosub set_shape
   drop=0
   gosub new_shape
  else
   endgame=1
  fi
 fi
return

rem #####################################################
rem # Procedure name : draw_edges
rem # 
rem #        Details : draw the edges of the game screen
rem #
rem #####################################################
label draw_edges
 setrgb 1,edgered,edgegreen,edgeblue
 setrgb 2,edgered,edgegreen,edgeblue
 setrgb 3,0,0,0
 gtriangle 0,0 to 0,512 to 180,0
 gtriangle 640,0 to 640,512 to 420,0
 setrgb 2,0,0,0
 gtriangle 0,512 to 180,0 to 180,512
 gtriangle 640,512 to 420,0 to 420,512
return

rem #####################################################
rem # Procedure name : title_screen
rem # 
rem #        Details : The game housekeeping routine.
rem #
rem #####################################################
label title_screen
 m$=ti$
 mx=10
 mpos=0
 oldjoypad=joypad
 cont=0
 point=1
 pointdelay=5
 holddelay=300
 hold=0

 clear window
 gosub flip_screen
 clear window
 repeat
  gosub flip_screen

  if hold=0 then
   pointdelay=pointdelay-1
   if pointdelay<2 then
    block=titlepoints(point,1)
    blockx=titlepoints(point,2)
    blocky=titlepoints(point,3)
    gosub draw_block
   fi
   if pointdelay<1 then
    pointdelay=5
    point=point+1
    if point>maxpoints then
     point=1
     hold=1
    fi
   fi
  else
   holddelay=holddelay-1
   if holddelay<2 then
    clear window
   fi
   if holddelay<1 then
    holddelay=300
    hold=0
   fi
  fi
 
  gosub display_scroller

  joypad=peek("port1")
  if joypad<>oldjoypad and joypad>0 then
   cont=1
  fi
  if joypad<>oldjoypad then
   oldjoypad=joypad
  fi
 until (cont=1)
return

rem #####################################################
rem # Procedure name : check_hiscore
rem # 
rem #        Details : This routine checks if the current
rem #                  score is higher than the hiscore
rem #                  and changes the hiscore if so
rem # 
rem #####################################################
label check_hiscore
 if score>hiscore then
  hiscore=score
  hiscore$=str$(hiscore)
 fi
return

rem #####################################################
rem # Procedure name : process_input
rem # 
rem #        Details : This routine deals with the input
rem # 
rem #####################################################
label process_input
 padwait=padwait+1
 joypad=peek("port1")

 if and(joypad,8)>0 then
  gosub quitgame
  return
 fi

 if and(joypad,64)>0 then
  drop=drop_delay
  return
 fi

 if joypad=oldjoypad and padwait<10 then
  return
 fi
 oldjoypad=joypad
 padwait=0

 if and(joypad,32)>0 then
  newshape=curshape
  newdir=direction
  newxpos=xpos+1
  newypos=ypos
  gosub test_shape
  if safe=0 then return fi
  oldxpos=xpos
  xpos=xpos+1
 fi

 if and(joypad,128)>0 then
  newshape=curshape
  newdir=direction
  newxpos=xpos-1
  newypos=ypos
  gosub test_shape
  if safe=0 then return fi
  oldxpos=xpos
  xpos=xpos-1
 fi

 if and(joypad,2048)>0 then
  newshape=curshape
  newdir=direction+1
  if newdir=5 then newdir=1 fi
  newxpos=xpos
  newypos=ypos
  gosub test_shape
  if safe=0 then return fi
  olddir=direction
  direction=direction+1
  if direction=5 then
   direction=1
  fi
 fi

 if and(joypad,1024)>0 then
  newshape=curshape
  newdir=direction-1
  if newdir=0 then newdir=4 fi
  newxpos=xpos
  newypos=ypos
  gosub test_shape
  if safe=0 then return fi
  olddir=direction
  direction=direction-1
  if direction=0 then
   direction=4
  fi
 fi
return

rem #####################################################
rem # Procedure name : clear_well
rem # 
rem #        Details : This routine clears the well
rem # 
rem #####################################################
label clear_well
 for x=2 to 11
  for y=2 to 19
   well(x,y)=0
  next y
 next x
return

rem #####################################################
rem # Procedure name : draw_well
rem # 
rem #        Details : This routine draws the empty well
rem # 
rem #####################################################
label draw_well
 for a=1 to 2
  gosub flip_screen
  for y=1 to 20
   for x=1 to 12
    if x=1 or x=12 or y=20 then
     setrgb 1,100,0,100
    else
     setrgb 1,100,100,100
    fi
    fill rectangle 160+x*20,y*20+40 to 160+x*20+20,y*20+60
   next x
  next y
 next a
return

rem #####################################################
rem # Procedure name : undraw_shape
rem # 
rem #        Details : This routine undraws the shape
rem # 
rem #####################################################
label undraw_shape
 base=(oldshape-1)*4+olddir
 setrgb 1,100,100,100
 for a=1 to 4
  x=(oldxpos+shapes(base,a,1))*20
  y=(oldypos+shapes(base,a,2))*20
  fill rectangle 160+x,y+40 to 160+x+19,y+59
 next a
return

rem #####################################################
rem # Procedure name : test_shape
rem # 
rem #        Details : This routine tests the shape to
rem #                  see if it will fit in it's 
rem #                  new position
rem # 
rem #####################################################
label test_shape
 base=(newshape-1)*4+newdir
 safe=1
 for a=1 to 4
  x=(newxpos+shapes(base,a,1))
  y=(newypos+shapes(base,a,2))

  if x<1 or x>12 or y<1 or y>20 then
   safe=0
  else
   if well(x,y)>0 then
    safe=0
   fi
  fi
 next a
return

rem #####################################################
rem # Procedure name : set_shape
rem # 
rem #        Details : This routine sets the shape in
rem #                  the grid and then tests for 
rem #                  completed lines.
rem # 
rem #####################################################
label set_shape
 score=score+level*40
 base=(curshape-1)*4+direction
 miny=ypos
 maxy=ypos
 for a=1 to 4
  x=(xpos+shapes(base,a,1))
  y=(ypos+shapes(base,a,2))

  if y<miny then miny=y fi
  if y>maxy then maxy=y fi

  well(x,y)=curshape
 next a

 linebonus=0
 linemult=1

 cx=0
 cxd=1
 for yyy=maxy to miny step-1

  repeat

   full=1
   for x=2 to 11
    if well(x,yyy)=0 then
     full=0
    fi
   next x

   if full=1 then
    linebonus=linebonus+1
    score=score+(linemult*(level*100))
    linemult=linemult*2
    for x=2 to 11
     well(x,yyy)=0
    next x

    for yy=yyy to 2 step -1
     for z=1 to 2

      for xx=2 to 11
       well(xx,yy)=well(xx,yy-1)
       block=well(xx,yy)
       blockx=xx
       blocky=yy
       gosub draw_block

       setrgb 1,0,0,0
       fill rectangle 0,480,640,512
       setrgb 1,int(ran(255)),255,255
       text cx,500,"Line Clear"
       cx=cx+cxd
       if cx>550 or cx<0 then cxd=-cxd fi

      next xx
      gosub flip_screen

     next z

    next yy
   fi
  until (full=0)
 next yyy

 linesleft=linesleft-linebonus
 if linesleft<1 then
  level=level+1
  level$=str$(level)
  drop_delay=drop_delay-2
  if drop_delay<1 then
   drop_delay=1
  fi
  linesleft=10  
 fi
 score$=str$(score)
return

rem #####################################################
rem # Procedure name : draw_shape
rem # 
rem #        Details : This routine draws the shape
rem # 
rem #####################################################
label draw_shape
 red=shapecol(curshape,1)
 green=shapecol(curshape,2)
 blue=shapecol(curshape,3)

 setrgb 1,red,green,blue
 setrgb 2,red,green,blue
 setrgb 3,255,255,255
 base=(curshape-1)*4+direction
 for a=1 to 4
  setrgb 1,red,green,blue
  x=(xpos+shapes(base,a,1))*20+160
  y=(ypos+shapes(base,a,2))*20+40
  gtriangle x,y to x,y+18 to x+10,y+10
  gtriangle x,y to x+18,y to x+10,y+10
  gtriangle x+18,y to x+18,y+18 to x+10,y+10
  gtriangle x,y+18 to x+18,y+18 to x+10,y+10

  setrgb 1,0,0,0
  rectangle x,y to x+18,y+18
 next a
return

rem #####################################################
rem # Procedure name : draw_block
rem # 
rem #        Details : This routine draws a single block
rem # 
rem #####################################################
label draw_block
 if block=0 then
  x=blockx*20+160
  y=blocky*20
  setrgb 1,100,100,100
  fill rectangle x,y+40 to x+20,y+60
 else
  red=shapecol(block,1)
  green=shapecol(block,2)
  blue=shapecol(block,3)

  setrgb 1,red,green,blue
  setrgb 2,red,green,blue
  setrgb 3,255,255,255
  setrgb 1,red,green,blue
  x=blockx*20+160
  y=blocky*20+40
  gtriangle x,y to x,y+18 to x+10,y+10
  gtriangle x,y to x+18,y to x+10,y+10
  gtriangle x+18,y to x+18,y+18 to x+10,y+10
  gtriangle x,y+18 to x+18,y+18 to x+10,y+10

  setrgb 1,0,0,0
  rectangle x,y to x+18,y+18
 fi
return

rem #####################################################
rem # Procedure name : move_shape
rem # 
rem #        Details : This routine moves the shape down
rem #                  the screen
rem # 
rem #####################################################
label move_shape
 newshape=curshape
 newdir=direction
 newxpos=xpos
 newypos=ypos+1
 gosub test_shape
 if safe=0 then
  stuck=stuck+1
  return
 fi
 ypos=ypos+1
 moved=1
return

rem #####################################################
rem # Procedure name : flip_screen
rem # 
rem #        Details : This is the screen buffer handling
rem #                  routine.  Call this routine just
rem #                  before you start drawing your 
rem #                  screen.  Oh, you might want to 
rem #                  clear the window just after you've
rem #                  called this routine.
rem # 
rem #####################################################
label flip_screen
 setdispbuf curbuf 
 curbuf=1-curbuf
 setdrawbuf curbuf
return

rem #####################################################
rem # Procedure name : new_shape
rem # 
rem #        Details : This routine creates a new shape
rem #
rem #####################################################
label new_shape
 curshape=int(ran(7))+1
 direction=1
 xpos=5
 ypos=1
 oldshape=curshape
 olddir=direction
 oldxpos=xpos
 oldypos=ypos
 moved=0
return

rem #####################################################
rem # Procedure name : draw_spark
rem # 
rem #        Details : This routine draws a spark
rem # 
rem #####################################################
label draw_spark
 setrgb 1,angle,angle,angle
 line x+cosines(angle)*size,y-sines(angle)*size to x+cosines(angle)*-size,y-sines(angle)*-size
 line x+cosines(angle+90)*size,y-sines(angle+90)*size to x+cosines(angle+90)*-size,y-sines(angle+90)*-size
return

rem #####################################################
rem # Procedure name : draw_sparks
rem # 
rem #        Details : This routine draws the sparks
rem # 
rem #####################################################
label draw_sparks
 for spark=1 to maxspark
  x=sparkx(spark)
  y=sparky(spark)
  angle=sparklife(spark)
  size=angle/20
  gosub draw_spark
  angle=angle-5
  sparklife(spark)=angle
  if angle<40 then
   sparkx(spark)=int(ran(160))
   if int(ran(2))=1 then
    sparkx(spark)=sparkx(spark)+440
   fi
   sparky(spark)=int(ran(512))
   sparklife(spark)=int(ran(255))
  fi
 next spark
return

rem #####################################################
rem # Procedure name : setup_sparks
rem # 
rem #        Details : This routine sets up the sparks
rem # 
rem #####################################################
label setup_sparks
 maxspark=30
 dim sparkx(maxspark)
 dim sparky(maxspark)
 dim sparklife(maxspark)

 dim cosines(720)
 dim sines(720)

 for angle=0 to 720
  cosines(angle)=cos(angle*(pi/180))
  sines(angle)=sin(angle*(pi/180))
 next angle

 for a=1 to maxspark
  sparkx=int(ran(160))
  if int(ran(2))>1 then
   sparkx=sparkx+400
  fi
  sparky=int(ran(512))
  sparklife=int(ran(255))
 next a
return

rem #####################################################
rem # Procedure name : setup_instructions
rem # 
rem #        Details : This routine sets up the 
rem #                  instructions.
rem # 
rem #####################################################
label setup_instructions
 instructlines=22
 dim in$(instructlines)
 for a=1 to instructlines
  in$(a)=""
 next a

 in$(1)="Many years ago, a kingdom was in danger. "
 in$(2)="A large army was invading, threatening to "
 in$(3)="destroy the kingdom and it's population, "
 in$(4)="condemning it to exist only in history."
 in$(6)="One knight came to the aid of the people, "
 in$(7)="cleverly organising them in such a way that  "
 in$(8)="they could be brought into the protection of "
 in$(9)="the castle walls.  His main problem was that "
 in$(10)="he had to move them around in small groups of "
 in$(11)="four, and only when he had ten people in "
 in$(12)="the correct places could he get them within "
 in$(13)="the walls."
 in$(15)="The knight's name was Tet.  He completed "
 in$(16)="his task, and since then, Sir Tet's "
 in$(17)="achievements have been retold and replayed."
 in$(19)="You can now replay his quest by trying to "
 in$(20)="organise the blocks of four people into "
 in$(21)="a continuous line of ten.  When such a line "
 in$(22)="has been made, they will be taken to safety."
return

rem #####################################################
rem # Procedure name : setup_scroller
rem # 
rem #        Details : This routine sets up the scroll
rem #                  text message.  That's all it does.
rem # 
rem #####################################################
label setup_scroller
 rem title screen scroller
 ti$="                                                 "
 ti$=ti$+"                    "
 ti$=ti$+"Welcome to Sir Tet, a game that should be "
 ti$=ti$+"familiar to any true gamer.  I shouldn't "
 ti$=ti$+"need to explain how to play the game, but "
 ti$=ti$+"if you really are unsure, you can always "
 ti$=ti$+"read the instructions.  "
 ti$=ti$+"One thing I will say though, is that the "
 ti$=ti$+"controls are fairly straightforward.  "
 ti$=ti$+"Use left and right to move the shapes "
 ti$=ti$+"sideways.  Pressing down will speed up the "
 ti$=ti$+"fall of the current piece.  L1 and R1 "
 ti$=ti$+"rotate the pieces left and right "
 ti$=ti$+"respectively.  Finally, the start button "
 ti$=ti$+"pauses the game with a quit option.  "
 ti$=ti$+"I've had a bit of fun with the special "
 ti$=ti$+"effects, but have kept myself on a tight "
 ti$=ti$+"leash to keep the program size down.  "
 ti$=ti$+"Anyway time for a few hello's...."
 ti$=ti$+"Hiya doctor, keep up the good work and "
 ti$=ti$+"determination, your development should be "
 ti$=ti$+"an inspiration to others. "
 ti$=ti$+"Mr. Shockwave, keep those demos and games "
 ti$=ti$+"coming.  Rafryer. Jacob busby."
 ti$=ti$+"  Master Tonberry.  Ps2yabasic, "
 ti$=ti$+"thank you again and again for giving us the "
 ti$=ti$+"site.  And to everyone else I have momentarily "
 ti$=ti$+"forgotten, post more stuff then I'll not "
 ti$=ti$+"forget you so easily."

 rem menu screen scroller
 me$="                                                 "
 me$=me$+"                    "
 me$=me$+"Use the up and down buttons to move the "
 me$=me$+"highlight bar, and press X to select the "
 me$=me$+"option.  "
 me$=me$+"The 'Start Game' option starts the game.  "
 me$=me$+"The 'Instructions' option explains how the "
 me$=me$+"game is played.  "
 me$=me$+"Finally, the 'Return to title' option returns "
 me$=me$+"you to the main title screen."

 rem in game scroller
 ga$="                                                 "
 ga$=ga$+"                    "
 ga$=ga$+"Ooh look, an in game scrolly message.  This "
 ga$=ga$+"is possible because the game has very little "
 ga$=ga$+"to do.  Anyway, if you're reading this "
 ga$=ga$+"message, you are clearly finding the game "
 ga$=ga$+"too easy.  Well, if you're reading the message "
 ga$=ga$+"then I might as well put something interesting "
 ga$=ga$+"in it."
 ga$=ga$+"                                              "
 ga$=ga$+"                    "
 ga$=ga$+"Sorry, I was trying to think of something. "
 ga$=ga$+"Inspiration fails me, so I'll resort to "
 ga$=ga$+"telling you how the game progresses and how "
 ga$=ga$+"it is scored.  "
 ga$=ga$+"You get to the next level after you clear "
 ga$=ga$+"10 lines. "
 ga$=ga$+"You gain level x 40 points every "
 ga$=ga$+"time a piece is placed.  You gain extra points "
 ga$=ga$+"when you clear a line.  You gain level x 100 "
 ga$=ga$+"points for a single line cleared in one go, "
 ga$=ga$+"double that for the second line, double that "
 ga$=ga$+"again for the third, and double again if you "
 ga$=ga$+"manage to clear four lines in one go.  "
 ga$=ga$+"That means, a single line cleared on level 1 "
 ga$=ga$+"is worth 100 points, two cleared at once is "
 ga$=ga$+"300 points, three cleared at once is 700 "
 ga$=ga$+"points, and four cleared at once is 1500 "
 ga$=ga$+"points.  And that's just the scoring for level "
 ga$=ga$+"one.  Have fun, and see how far you get.  "
 ga$=ga$+"Oh, I forgot to mention that the pieces drop "
 ga$=ga$+"faster and faster as the levels progress."
return

rem #####################################################
rem # Procedure name : setup_title
rem # 
rem #        Details : This routine sets up the title
rem #                  screen graphics
rem # 
rem #####################################################
label setup_title
 restore titlepointdata
 read maxpoints
 dim titlepoints(maxpoints,3)
 for a=1 to maxpoints
  read titlepoints(a,1)
  read titlepoints(a,2)
  read titlepoints(a,3)
 next a
return

rem #####################################################
rem # Procedure name : initialise
rem # 
rem #        Details : This routine sets up all of the
rem #                  global variables and arrays.  I've
rem #                  placed it at the end of the code
rem #                  because it's out of the way and 
rem #                  can easily be reached by pressing
rem #                  the CTRL and END keys together.
rem # 
rem #####################################################
label initialise
 sw=640
 sh=512
 open window sw,sh
 cycle_reset=200
 curbuf=0
 curshape=1         : rem current shape
 nextshape=1        : rem    next shape
 xpos=3             : rem x position of shape
 ypos=3             : rem y position of shape
 direction=1        : rem rotation of shape
 oldxpos=xpos
 oldypos=ypos
 olddir=direction
 oldshape=curshape
 oldjoypad=0
 stuck=0
 moved=0
 padwait=0
 level=1
 score=0
 hiscore=0

 rem set up the well that the pieces will fall into
 rem the edge pieces are the wall.
 dim well(12,20)
 for y=1 to 19
  well(1,y)=99
  well(12,y)=99
 next y
 for x=1 to 12
  well(x,20)=99
 next x

 rem set up the shapes
 rem each shape is stored as four different shapes
 rem to ensure speed.  Rotation could be done in
 rem realtime, but why bother with such a small
 rem amount of data.
 rem The shapes are stored as four x,y pairs which 
 rem are offset from xpos and ypos.
 rem the main shapes are:

 rem  1: %%
 rem     %%

 rem  2: %%%%

 rem  3: %%%
 rem      %

 rem  4: %%%
 rem       %

 rem  5: %%%
 rem     % 

 rem  6: %%
 rem      %%

 rem  7:  %%
 rem     %%

 dim shapes(28,4,2)
 restore shape_data
 for a=1 to 28
  for b=1 to 4
   read shapes(a,b,1)
   read shapes(a,b,2)
  next b
 next a

 dim shapecol(7,3)
 restore shape_colours
 for a=1 to 7
  for b=1 to 3
   read shapecol(a,b)
  next b
 next a

 gosub setup_instructions
 gosub setup_scroller
 gosub setup_sparks
 gosub setup_title
return

label shape_data
rem shape 1
rem direction 1
data 0,0,1,0,0,1,1,1
rem direction 2
data 0,0,1,0,0,1,1,1
rem direction 3
data 0,0,1,0,0,1,1,1
rem direction 4
data 0,0,1,0,0,1,1,1

rem shape 2
rem direction 1
data 0,1,1,1,2,1,3,1
rem direction 2
data 1,0,1,1,1,2,1,3
rem direction 3
data 0,1,1,1,2,1,3,1
rem direction 4
data 1,0,1,1,1,2,1,3

rem shape 3
rem direction 1
data 0,1,1,1,2,1,1,2
rem direction 2
data 1,0,1,1,1,2,0,1
rem direction 3
data 0,1,1,1,2,1,1,0
rem direction 4
data 1,0,1,1,1,2,2,1

rem shape 4
rem direction 1
data 0,1,1,1,2,1,2,2
rem direction 2
data 1,0,1,1,1,2,0,2
rem direction 3
data 0,0,0,1,1,1,2,1
rem direction 4
data 1,0,2,0,1,1,1,2

rem shape 5
rem direction 1
data 0,1,1,1,2,1,0,2
rem direction 2
data 0,0,1,0,1,1,1,2
rem direction 3
data 2,0,0,1,1,1,2,1
rem direction 4
data 1,0,1,1,1,2,2,2

rem shape 6
rem direction 1
data 0,0,1,0,1,1,2,1
rem direction 2
data 1,0,1,1,0,1,0,2
rem direction 3
data 0,0,1,0,1,1,2,1
rem direction 4
data 1,0,1,1,0,1,0,2

rem shape 7
rem direction 1
data 1,0,2,0,0,1,1,1
rem direction 2
data 0,0,0,1,1,1,1,2
rem direction 3
data 1,0,2,0,0,1,1,1
rem direction 4
data 0,0,0,1,1,1,1,2

label shape_colours
data 100,0,0
data 0,100,0
data 0,0,100
data 100,100,0
data 100,0,100
data 100,100,100
data 0,100,100

label titlepointdata
data 69
data 1,4,2
data 1,4,1
data 1,3,1
data 1,2,1
data 1,1,1
data 1,0,1
data 1,0,2
data 1,0,3
data 1,0,4
data 1,1,4
data 1,2,4
data 1,3,4
data 1,4,4
data 1,4,5
data 1,4,6
data 1,4,7
data 1,3,7
data 1,2,7
data 1,1,7
data 1,0,7
data 1,0,6

data 2,6,4
data 2,6,5
data 2,6,6
data 2,6,7
data 2,6,2

data 3,8,4
data 3,8,5
data 3,8,6
data 3,8,7
data 3,9,4
data 3,10,4
data 3,10,5

data 4,0,9
data 4,1,9
data 4,2,9
data 4,3,9
data 4,4,9
data 4,2,10
data 4,2,11
data 4,2,12
data 4,2,13
data 4,2,14
data 4,2,15

data 5,6,13
data 5,7,13
data 5,8,13
data 5,9,13
data 5,9,12
data 5,9,11
data 5,8,11
data 5,7,11
data 5,6,11
data 5,6,12
data 5,6,13
data 5,6,14
data 5,6,15
data 5,7,15
data 5,8,15
data 5,9,15

data 6,12,10
data 6,12,11
data 6,12,12
data 6,12,13
data 6,12,14
data 6,12,15
data 6,11,11
data 6,12,11
data 6,13,11