sirtet2

-------



It's a tetris(tm) clone.  When you start, a dialog box appears and lets you c=

hoose=20

starting level and number of "lines", it also lets you play a saved game.



A menu comes up that lets you pick from some pic varibles, if you have an=

y. =20

I couldn't figure out how to email the pics, but the user could easily cr=

eate=20

new ones, they need to be 6 by 6 pixels in size (13 bytes each)



Then the program creates the pictures for play.  You can delete them if y=

ou want

when you quit.



During play:=20

F1 to rotate counterclockwise

F5 to rotate clockwise

Left and right arrows to move the shape

down arrow to drop shape

ESC key to pause, which then you can quit, continue, or quit and save, or=

 press=20

diamond-ON to turn the calculator off, and then continue latter.



the global vars used are:

cbx,cby,srn,csn,tes                ( deleted when you quit )

tes1,tes2,tes3,tes4,tes5,tes6,tes7,tes8,tes9  ( optional pic vars)

tetscr,tetlvl,brd           ( these are used to save the game )

tbplyr                 ( top player score and name saved here--string var=

 )



i also sent the program as an attached enclosure, whatever is easier...



and here it is... all 4989 bytes



I called it Sirtet (tetris backwards)



()

Prgm

Local a,b,c,e,k,x,y,ty1,tx1,ty,fch,ns,dlns,idg,trcl,tby,tbx,ndl,drwshp,ge=

tshp

Define drwshp(x,y)=3DPrgm

Local b

If y<17 Then

XorPic #("ts"&string(csn+7*srn)),97-6*y,6*x

Else

For b,1,4

If y+cby[b]<18

XorPic tes,103-(y+int(cby[b]))*6,12+6*(x+int(cbx[b]))

EndFor

EndIf

EndPrgm

Define getshp(s)=3DPrgm

If s=3D1 or s=3D2 Then

{.5,=D0.5,=D0.5,=D0.5}*sign(s=D01.5)=03cbx

{=D0.5,1.5,.5,=D0.5}=03cby

ElseIf s=3D3 or s=3D4 Then

{=D0.5,=D0.5,.5,.5}=03cbx

{1,0,0,=D01}*sign(s-3.5)=03cby

ElseIf s=3D5 Then

{0,0,0,0}=03cbx

{1.5,.5,=D0.5,=D01.5}=03cby

ElseIf s=3D6 Then

{0,0,0,1}=03cbx

{1,0,=D01,0}=03cby

ElseIf s=3D7 Then

{.5,.5,=D0.5,=D0.5}=03cbx

{=D0.5,.5,.5,=D0.5}=03cby

EndIf

EndPrgm

If getType(tbplyr)=AD"STR"

"10 "=03tbplyr

setMode("Split Screen","Full")

PlotsOff

FnOff

1=03xmin

2=03xmax

1=03ymin

2=03ymax

0=03xscl

0=03yscl

ClrDraw

PxlVert 0

PxlVert 5

PxlHorz 0

PxlHorz 5

If getType(tes)=AD"PIC"

StoPic tes,0,0,6,6

ClrDraw

StoPic trcl,1,1,60,6

1=03a:1=03b:4=03c

Lbl ret

1=03y

Dialog

Title "Sirtet 1.0 by G. Anderson"

Text "Top Score: "&tetplyr

Text "Press ESC to quit, not ON!"

DropDown "Games",{"New","Continue"},b

DropDown "Lines",seq(string(x),x,0,10),c

DropDown "Level",seq(string(x),x,1,6),y

Text "email: ande2115@tc.umn.edu"

EndDlog

If ok=3D0 : Stop

If b=3D2 Then

If getType(brd)=3D"MAT" Then

Goto gst

Else

Text "There is no saved game"

Goto ret

EndIf

EndIf

0=03tetscr

y=03tetlvl

newMat(10,20)=03brd

c-1=03c

For x,1,c*6

1=03brd[rand(10),rand(c)]

EndFor

Lbl gst

If getType(ts24)=AD"PIC" Then

newList(10)=03y

1=03y[1]

PxlText "Choose block pic:",1,60

PxlText "default",10,70

For x,1,9

PxlText "tes"&string(x),10+9*x,70

If getType(#("tes"&string(x)))=3D"PIC" Then

RplcPic #("tes"&string(x)),10+9*x,100

1=03y[x+1]

Else

PxlText "-no pic var",10+9*x,100

EndIf

EndFor

1=03x

PxlText "=05",x*9+1,60

Loop

getKey()=03k

If k=3D338 or k=3D344 Then

PxlText " ",x*9+1,60

x+when(k=3D344),1,=D11)=03x

If x<1:10=03x

If x>10:1=03x

PxlText "=05",x*9+1,60

ElseIf k=3D13 and y[x]=3D1 Then

If x>1

CopyVar #("tes"&string(x-1)),tes

Exit

EndIf

EndLoop

ClrDraw

For x,1,7

PxlText "Making Pics...",16,20

getshp(x)

For y,1,4

For b,1,4

XorPic tes,103-(10+int(cby[b]))*6,5+6*(1+6*y+int(cbx[b]))

EndFor

StoPic #("ts"&string(x+7*y)),37,36*y-1,24,24

cbx=03tbx

cby=03cbx

=D0tbx=03cby

EndFor

ClrDraw

EndFor

EndIf

PxlVert 17

PxlVert 78

For x,1,10

For y,1,17

If brd[x,y]=3D1

RclPic tes,103-y*6,12+6*x

EndFor

EndFor

PxlText "Level:",20,98

PxlText string(tetlvl),30,104

PxlText "Score:",40,98

PxlText "Next Shape:",60,98

rand(7)=03ns

getshp(ns)

ns=03csn

1=03srn

drwshp(18,4)

Lbl bgn

{0,0,0,0}=03dlns

0=03ndl

For y,1,18

For x,1,10

If brd[x,y]=3D0

Goto spc

EndFor

ndl+1=03ndl

y=03dlns[ndl]

If y=3D1 Then

submat(brd,1,2,10,20)=03brd

Else

augment(subMat(brd,1,1,10,y-1),submat(brd,1,y+1,10,20))=03brd

EndIf

augment(brd,newMat(10,1))=03brd

y-1=03y

Lbl spc

EndFor

If ndl>0 Then

tetscr+10*ndl^2=03tetscr

For y,dlns[1],17

RpclPic trcl,103-6*y,18

For x,1,10

If brd[x,y]=3D1

RplcPic tes,103-6*y,12+6*x

EndFor

EndFor

EndIf

For x,1,10

If brd[x,18]=3D1 Then

Text "Sorry dude, Game Over"

If tetscr>expr(left(tbplyr,inString(tbplyr," "))) Then

Lbl vv

Dialog

Text "You made a new high score!"

Request "Name",a

Text "   (2 to 16 length)"

EndDlog

If dim(a)>16 or dim(a)<2

Goto vv

string(tetscr)&" "&a=03tbplyr

EndIf

Goto ddone

EndIf

EndFor

PxlText string(tetscr),50,104

If tetscr>tetlvl*200 Then

tetlvl+1=03tetlvl

Text "Next Level: "&string(tetlvl)

PxlText string(tetlvl),30,104

EndIf

7-tetlvl=03idg

If idg<1:1=03idg

1=03srn

ns=03b

rand(7)=03ns

ns=03csn

getshp(ns)

drwshp(18,4)

b=03csn

getshp(csn)

drwshp(18,4)

5=03x : 17=03y

drwshp(x,y)

getkey()

Loop

For c,1,idg

getkey()=03k

If k=3D340 or k=3D337 Then

when(k=3D337,=D01,1)=03c

x+c=03x

If k=3D337 Then

If min(cbx+x)<1

Goto aa

Else

If max(cbx+x)>10.9

Goto aa

EndIf

For b,1,4

If brd[x+int(cbx[b]),y+int(cby[b])]=3D1

Goto aa

EndFor

drwshp(x-c,y)

drwshp(x,y)

Cycle

Lbl aa

x-c=03x

ElseIf k=3D268 or k=3D272 Then

If k=3D272 Then

cby=03tbx

=D0cbx=03tby

when(srn=3D4,1,srn+1)=03a

Else

cbx=03tby

=D0cby=03tbx

when(srn=3D1,4,srn-1)=03a

EndIf

For b,1,4

x+int(tbx[b])=03tx1

y+int(tby[b])=03ty1

If tx1>10 or tx1<1 or ty1<1

Goto cc

If brd[tx1,ty1]=3D1

Goto cc

EndFor

drwshp(x,y)

a=03srn

tby=03cby

tbx=03cbx

drwshp(x,y)

Lbl cc

ElseIf k=3D344 Then

y=03ty

Loop

y-1=03y

For b,1,4

If y+int(cby[b])<1

Goto pp

If brd[x+int(cbx[b]),y+int(cby[b])]=3D1

Goto pp

EndFor

drwshp(x,y+1)

drwshp(x,y)

EndLoop

Lbl pp

y+1=03y

For b,1,4

1=03brd[x+int(cbx[b]),y+int(cby[b])]

EndFor

tetscr+1=03tetscr

Goto bgn

ElseIf k=3D264 Then

Toolbar

Title "Continue",cnt

Title "Quit",ddone

Title "Quit & Save",dsv

EndTBar

Lbl cnt

EndIf

EndFor

y-1=03y

For b,1,4

If y+cby[b]<1

Goto ee

If brd[x+int(cbx[b]),y+int(cby[b])]=3D1

Goto ee

EndFor

drwshp(x,y+1)

drwshp(x,y)

Cycle

Lbl ee

For b,1,4

1=03brd[x+int(cbx[b]),y+int(cby[b])]

EndFor

tetscr+1=03tetscr

Goto bgn

EndLoop

Lbl ddone

DelVar brd,tetscr,tetlvl

Lbl dsv

Dialog

Text "Do you want to delete pics?"

Text "mem freed=3D2212 bytes"

Text "Enter=3Dyes; ESC=3Dno"

EndDlog

If ok=3D1 Then

DelVar tes

For a,8,35

DelVar #("ts"&string(a))

EndFor

EndIf

Delvar cbx,cby,srn,csn

EndPrgm