LIBRARY 1111 "TETRIS for HP48 by C. de DINECHIN"

COMMANDS
  TETRIS AboutTETRIS ScoresTETRIS ResetTETRIS

LOCAL
  TestScores TetrisScreen TetrisCode AboutCode

CONFIG
  PROG
    1111 ATTACH 
    CLLCD TEXT "TETRIS V2.0 Installed" 1 DISP
  END

CONTENT

@ ****************************************************************************
@ 		Main command: Let's Play Tetris...
@ ****************************************************************************
  TETRIS
    PROG
      TetrisScreen DUP NEWOB	@ Work screens put in stack
      TetrisCode CLLCD		@ Machine code executed
      ROT ROT DROP2 B->R	@ Get Score
      TestScores		@ Test and display score
      "Score" ->TAG		@ Score put in stack for display
    END


@ ****************************************************************************
@ 			Information on the program
@ ****************************************************************************
  AboutTETRIS
    PROG
	CLLCD
"
TETRIS V2.0 pour HP48, Žcrit en novembre 1992 par C.de DINECHIN...
Cette version est un exemple qui fait partie de HPDS 3.0 pour Macintosh,
un outil de dŽveloppement permettant de compiler des programmes pour HP48.
Ce Tetris est une version de dŽmonstration. Il est GRATUIT et ne peut
�tre vendu. Copiez le autant que vous voulez - - -
TETRIS V2.0 for HP48, written in November 1991 by C. de DINECHIN...
This version of Tetris is an example given as part of HPDS 3.0 for Macintosh...
This is a demo version, which is absolutely FREE.
You may give it to anybody, provided it is distributed with no charge.
- - -"
AboutCode DROP
    END


@ ****************************************************************************
@			Test a score and display it
@ ****************************************************************************

  TestScores
    PROG
      DUP -> SCORE
      <<
        @ Test if High scores table is correct
        IF TetrisScores TYPE 5 <> THEN
          ResetTETRIS
        END

        @ Scan high scores table
        1 7 FOR I
          'TetrisScores' I GET 2 GET
          IF SCORE <= THEN
            "Bravo! Vous avez un
bon score. Votre nom?"
            { "" EXTERNAL #4358Ah }  INPUT
            SCORE 2 ->LIST 1 ->LIST
            TetrisScores 1 I OVER - SUB SWAP + TetrisScores I 7 SUB +
            'TetrisScores' STO
            8 'I' STO
          END
        NEXT

        ScoresTETRIS
      >>
    END
   


@ ****************************************************************************
@			Reset the high scores
@ ****************************************************************************
  ResetTETRIS
    PROG
      { { "" 0 } } DUP + DUP + DUP + 'TetrisScores' STO
    END


@ ****************************************************************************
@			Display the high scores
@ ****************************************************************************
  ScoresTETRIS
    PROG
      ERASE

      @ Display "Meilleurs Scores" bold
      PICT { #10h #0h }
        "Meilleurs Scores" 2 ->GROB { #1h #0h } OVER GOR 
      REPL

      @ Graphic display
      { #0h #0h } PVIEW

      @ Display scores
      1 7 FOR I 
        @ Name of the player
        PICT { #0h } I 8 * R->B + TetrisScores I GET 1 GET 2 ->GROB REPL 
        @ Score of the player
        PICT TetrisScores I GET 2 GET 2 ->GROB #83h OVER SIZE DROP -
        I 8 * R->B 2 ->LIST SWAP REPL
      NEXT

      @ Wait for a key
      0 WAIT DROP
    END


@ *****************************************************************************
@			The display screen
@ *****************************************************************************

  TetrisScreen
GROB 131 66 FFFFFFFF000000000000008FFFFFFFFF70FFFFFFFF20000000000000CFFFFFFFFF7
0FFFFFFEF60000000000000AFFFFFFFFF70FFFFFFEFE00000000000009FFFFFFFFF70FFFFF54FE0
0000000000009FFFFFFFFF70FFFFF38FE00000000000009FFFFFFFFF70FFFFF7CFE000000000000
09FFFFFFFFF70FFFFF39FE00000000000009FFFFFFFFF700CFFFBBFE000000000000090000FFFFF
702DFFFFFFE000000000000090000FFFFF703FFFFFFFE000000000000090000FFFFF703FFFFFFFE
000000000000090000FFFFF70314068CCE000000000000090000FFFFF703359294EE00000000000
0090000FFFFF7033E939CCE000000000000090000FFFFF7033F978C9E000000000000090000FFFF
F7033D978C9E000000000000090000FFFFF7031C9394CE000000000000090000FFFFF70FFFFFFFF
E000000000000090000FFFFF70FFFFFFFFE000000000000090000FFFFF70FFFFFFFFE0000000000
00090000FFFFF70FF1EFFFFE000000000000090000FFFFF70FFADFFFFE000000000000090000FFF
FF70FFA5AAEFE000000000000090000FFFFF70FF3AA2FFE00000000000009FFFFFFFFF70FFDBAAF
FE00000000000009FFFFFFFFF70FF8338FFE00000000000009EEF7FDFFF30FFFFFFFFE000000000
00009CEF7FDFFF30FFFFFFFFE00000000000009C6B2ED7B630FFFFFFFFE00000000000009AAA6FD
BAA20FFFFFFFFE00000000000009A267FD3A220FFFCFFFFE000000000000096A77FDBBA30F763CD
CFE000000000000096AA6FDB6B20FB65B4DFE00000000000009E6B6E167730FB053DEFE00000000
000009FFFFFFFFF70FF6744DFE00000000000009FFFFFFFFF70FF6BF5DFE00000000000009FFFFF
FFFF70F370F5EFE00000000000009FFFFFFFFF70FFFFFFFFE00000000000009FFFFFFFFF70FFFFF
FFFE00000000000009FFFFFFFFF70FFFFFFFFE00000000000009FFFFFFFFF70FFFFFFFFE0000000
0000009FFFFFFFFF70FFFFFFFFE00000000000009FFFFFFFFF70FFFFFFFFE00000000000009FFFF
FFFFF70FFFFFFFFE00000000000009FFFFFFFFF70FFFFFFFFE00000000000009FFFFFFFFF70FFFF
FFFFE00000000000009FFFFFFFFF70FFF89AFFE00000000000009FFFFFFFFF70FFFAACFFE000000
00000009FFFFFFFFF70FFFAAEFFE00000000000009FFFFFFFFF70FFFC0EFFE00000000000009FFF
FFFFFF70FFFEFFFFE00000000000009FFFFFFFFF70FFFEFFFFE00000000000009FFFFFFFFF70FFF
CFFFFE00000000000009FF1FFFFFF70FFFFFFFFE00000000000009FFEEFFFFF70FFF3FFFFE00000
000000009FFE77B6FF70FF8D078FE00000000000009FF1BA2BEF70F7F5DA6FE00000000000009FF
FABA3EF70FBF4DA6FE00000000000009FFEABABFF70FB7DDE6FE00000000000009FFEAAABEF70FB
5DE67FEFFFFFFFFFFFFF9FF177B7FF70F760038F65555555555555BFFFFFFFFF70FFFFFFFFAAAAA
AAAAAAAAAEFFFFFFFFF70FFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFF70


@ *****************************************************************************
@ 				The machine code part
@ *****************************************************************************
  TetrisCode
    ASM

*************************************************************************
*			TETRIS pour HP 48 SX				*
*************************************************************************


	INCLUDE	"HARD.48S"	; Registres Hard de la 48
	INCLUDE	"ROM.48S"	; Adresses ROM
	INCLUDE	"RRAM.48S"	; Adresses RRAM


*************************************************************************
*			Variables globales				*
*************************************************************************
			RSSET	RRAM_RS232Buffer; Ecran texte jusqu'ˆ 16 librairies.
SCRN_Base	RS		5		; Position de l'ecran
VARS_Score	RS		5		; Score actuel
VARS_Next	RS		3		; Piece suivante
VARS_Col	RS		1		; Colonne actuelle
VARS_Line	RS		1		; Ligne actuelle
VARS_Curnt	RS		3		; Piece actuelle
VARS_OldCol	RS		1		; Ancienne colonne
VARS_OldLine	RS		1		; Ancienne ligne
VARS_OldCurnt	RS		3		; Piece lors de rotation
VARS_Count	RS		3		; Compteur de boucles avant descente
VARS_Key	RS		1		; Touche appuyee
VARS_Seed	RS		5		; Compteur aleatoire
VARS_Pattern	RS		5		; Motif d'affichage
VARS_Lines	RS		3		; Compte les lignes faites
VARS_ScoreDec	RS		5		; Score en dŽcimal
VARS_Level	RS		1		; Niveau de jeu
VARS_OldScoreD	RS		5		; Ancien (comparaison)
VARS_OldLevel	RS		1		; Ancien niveau



*************************************************************************
*			Programme principal				*
*************************************************************************

* Initialisation
	GOSUBL	TETR_Init
	GOSUBL	TETR_FirstNew		; Calcule une piece d'avance

MAIN_Next:
* Choisit une nouvelle piece
	GOSUBL	TETR_New
	GOSUBL	TETR_Display		; Affiche la piece
	GOC	MAIN_Loop_End

MAIN_Loop:
* DŽplacement utilisateur
	GOSUBL	TETR_Key		; Teste les touches
	GONC	.no_key
	GOSUBL	TETR_Display		; Efface la piece
	GOSUBL	TETR_DispX		; Deplacement lateral
	GOSUBL	TETR_Display		; Affiche la piece
	GONC	.no_key			; Si la piece peut s'afficher
	GOSUBL	TETR_Display		; Efface la piece
	GOSUBL	TETR_CancelDisp		; Annule le deplacement lateral
	GOSUBL	TETR_Display		; et affiche la piece

.no_key	GOSUBL	TETR_Wait		; Teste si piece descend
	GONC	.no_wt			; Si la piece ne descend pas
	GOSUBL	TETR_Display		; Efface la piece
	GOSUBL	TETR_DispY		; Descend une ligne
	GOSUBL	TETR_Display		; Affiche la piece
	GONC	.no_wt			; Si la piece peut descendre

	GOSUBL	TETR_Display		; Efface la piece
	GOSUBL	TETR_CancelDisp		; Remonte la piece
	GOSUBL	TETR_Display		; Reaffiche la piece
	GOSUBL	TETR_Verify		; Verifie les lignes a effacer
	GOSUBL	TETR_MkScore		; Calcule et affiche le score
	GOTO	MAIN_Next		; Choisit une piece et recommence

.no_wt	GOTO	MAIN_Loop


* Fin du programme
.End	D0=VARS_Score
	C=DAT0
	RSTK=C

	GOSUBL	TETR_Exit

	C=RSTK
	A=C
	P=4
	GOVLNG	$0596D			; Met A comme binaire dans la pile




*************************************************************************
*			Affichage du score				*
*************************************************************************
TETR_MkScore:
	D0=	VARS_Line		; DŽcompte en fonction du score
	A=0
	A=DAT0(P)
	LC	20
	C=C-A
	D0=	VARS_Level
	A=DAT0(P)
	C=C+A
	D0=	VARS_Score
	A=DAT0
	A=A+C
	DAT0=A

	D0=	VARS_ScoreDec		; Met ˆ jour le score en dŽcimal
	A=DAT0
.loop	?C=0
	GOYES	.floop
	SETDEC
	A=A+1
	SETHEX
	C=C-1
	GOTO	.loop

.floop	DAT0=A

* Affichage du scroll selon la mŽthode "flipper"
	D0=	SCRN_Base
	A=DAT0			; Pointeur vers l'Žcran
	LC	$2B*34+30	; Affichage des chiffres du score
	C=C+A
	D0=C

	LC(3)	$03F		; Masque d'affichage des chiffres
	B=C(X)

	LC	VARS_ScoreDec
	R0=C

.digit	LC	VARS_ScoreDec+5	; Teste si fini
	A=R0
	?A<C
	GOYES	.dodig		; si pas terminŽ

	?A>C
	GOYES	.fini

	D0=	SCRN_Base
	A=DAT0
	LC	$C*34+30
	C=C+A
	D0=C
	LC(3)	$03F
	B=C(X)
	A=R0

	GOTO	.dodig

.fini	D0=	VARS_ScoreDec	; Copie le score dans la copie
	P=5
	A=DAT0(WP)
	D0=D0+6
	DAT0=A(WP)
	P=0
	RTN

.dodig	D1=A
	A=0
	A=DAT1(P)
	D1=D1+6
	C=DAT1(P)
	?A<>C(P)
	GOYES	.nochif
	GOTO	.skip

.nochif	GOSUB	.chif

* Description des chiffres
	DX	E01191513111E000406040404040E000E01101C0
	DX	2010F100E01101E00111E00080C0A090F1808000
	DX	F110F0010111E000C02010F01111E000F1018040
	DX	20202000E01111E01111E000E01111E101806000

.chif	ASL
	C=RSTK
	C=C+A
	D1=C

	GOSUB	TETR_ScrollDigit	; Affiche le chiffre

.skip	C=R0				; Chiffre suivant
	C=C+1
	R0=C

* Commute entre les deux types d'affichages de chiffre
*      B=0     B=2     B=0
* XX|XX XXXX XXXX XX|XX XXXX
	?B=0(XS)
	GOYES	.zero

	LC(3)	$03F
	B=C(X)
	D0=D0-1
	GOTO	.digit

.zero	LC(3)	$2FC
	B=C(X)
	D0=D0-2

	GOTO	.digit			; Puis passe au chiffre suivant



TETR_ScrollDigit:
*************************************************************************
* 		Scrolling d'un chiffre remplacŽ par un autre		*
*************************************************************************
* D0= Octet sur l'Žcran
* D1= Octet de donnŽes
* B(B) = Masque de l'octet	(Ex: $3F pour la partie droite)
* B(XS)= Compteur des dŽcalages
* Tous ces registres sont prŽservŽs

	LC(1)	7
	D=C(P)			; D(P)= Compteur de scrolls

.scroll	AD0EX			; Pointe sur le bas du scroll
	LC	34*8
	A=A+C
	D0=A

	A=DAT1(B)		; Lit la donnŽe ˆ insŽrer
	D1=D1+2			; DonnŽe suivante

	C=B(XS)
	D=C(XS)			; DŽcalages du bon nombre
	D=D-1(XS)
	GOC	.noshft
.shift	A=A+A(B)		; DŽcalage ˆ gauche
	D=D-1(XS)
	GONC	.shift

.noshft	A=A&B(B)
	P=15			; D(S)= Compteur de lignes
	LC(1)	7
	D=C(S)
	P=0

.line	C=DAT0(B)		; Lecture de l'octet Žcran
	RSTK=C			; StockŽ
	B=-B-1(B)
	C=C&B(B)		; Masquage de l'octet
	C=C|A(B)		; installation de la donnŽe
	DAT0(B)=C		; et Žcriture

	C=RSTK
	B=-B-1(B)
	C=C&B(B)
	A=C(B)			; A= donnŽe pour le passage suivant
	
	D0=D0-16		; Passage ˆ la ligne prŽcŽdente
	D0=D0-16
	D0=D0-2

	D=D-1(S)
	GONC	.line		; Termine une ligne de scroll

	LC	3000
.wait	C=C-1
	GONC	.wait

	D=D-1(P)
	GONC	.scroll		; Scroll suivant

	D1=D1-16

	RTN



*************************************************************************
*			VŽrification des lignes compl�tes		*
*************************************************************************
TETR_Verify:
* Partie 1: Test
	D0=	VARS_Lines	; Lecture du nombre de lignes
	C=DAT0(X)
	D=C(X)

	D0=	SCRN_Base
	A=DAT0
	D0=A
	D0=D0+9			; Pointe sur la partie gauche du terrain
	AD0EX
	R0=A			; R0= DŽbut du terrain
	AD0EX

	B=0
	P=15
	LC(1)	14
	D=C(S)

.line1	B=B+B
	P=12			; Teste si la ligne est pleine
	A=DAT0(WP)
	A=A+1(WP)
	GONC	.notful
	B=B+1
	D=D+1(X)		; IncrŽmente le compteur de lignes
.notful	P=0
	LC	34*4		; Passage ˆ la ligne suivante
	AD0EX
	A=A+C
	AD0EX
	D=D-1(S)
	GONC	.line1

	?B=0			; Si pas de ligne ˆ effacer
	RTNYES

	D0=	VARS_Lines	; Toutes les dix lignes, incrŽmente le niveau
	C=D(X)
	DAT0(X)=C
	A=C(X)
	LC(3)	10
	A=A-C(X)
	GOC	.ok_lev		; Si pas dŽpassŽ dix lignes

	DAT0(X)=A
	D0=	VARS_Level
	A=DAT0(P)
	LC(1)	9		; VŽrifie qu'on ne dŽpasse pas le niveau 9
	?A>=C(P)
	GOYES	.ok_lev
	A=A+1(P)
	DAT0(P)=A

.ok_lev	A=B
	R1=A			; Masque dans R1

* Partie 2: Affichage des lignes testŽes
	LC(2)	7		; Nombre de rŽpŽtitions de l'affichage
	D=C(B)

.blink	D(S)=0			; Nombre de lignes ˆ tester
	D=D-1(S)
	D=D-1(S)
	A=R0
	LC	34*4*15
	C=C+A
	D0=C
	C=R1
	B=C

.line	C=B
	?CBIT(0)=0
	GOYES	.noBlnk

	P=2			; Epaisseur d'une ligne
	LC(1)	3
	D=C(XS)


.sline	D0=D0-16
	D0=D0-16
	D0=D0-2
	P=12
	A=DAT0(WP)
	A=-A-1(WP)
	DAT0(WP)=A
	P=0
	D=D-1(XS)
	GONC	.sline
	GOTO	.skip

.noBlnk	LC	34*4		; Remonte de l'Žpaisseur d'une ligne
	AD0EX
	A=A-C
	AD0EX

.skip	B=B/2
	D=D-1(S)
	GONC	.line

	LC	5000
.wait	C=C-1
	GONC	.wait

	D=D-1(B)
	GONC	.blink


* Partie 3: Effacement des lignes des lignes testŽes
	D(S)=0			; Nombre de lignes ˆ tester
	D=D-1(S)
	D=D-1(S)
	A=R0
	LC	34*4*15
	C=C+A
	D0=C
	C=R1
	B=C

.line2	C=B
	?CBIT(0)=0
	GOYES	.noBlk2

	CD0EX
	D0=C
	RSTK=C
	A=C
	LC	34*4
	A=A-C
	D1=A

.sline2	A=R0
	CD1EX
	D1=C
	?A=C
	GOYES	.fini

	D0=D0-16
	D0=D0-16
	D0=D0-2
	D1=D1-16
	D1=D1-16
	D1=D1-2
	P=12
	A=DAT1(WP)
	DAT0(WP)=A
	P=0
	GOTO	.sline2

.fini	C=RSTK
	D0=C
	GOTO	.skip2

.noBlk2	LC	34*4		; Remonte de l'Žpaisseur d'une ligne
	AD0EX
	A=A-C
	AD0EX

.skip2	B=B/2
	D=D-1(S)
	GONC	.line2

	LC	1000			; Emet un petit Beep
	D=C
	LC	100
	GOSBVL	ROM_Beep

	RTN




*************************************************************************
*			Attente en fonction du niveau			*
*************************************************************************
TETR_Wait:
	D0=	VARS_Count
	A=DAT0(X)
	C=A
	C=C+1(X)
	RTNC

	A=A-1(X)
	GOC	.new
	DAT0(X)=A
	RTNCC

.new	D0=	VARS_Level
	A=0
	A=DAT0(P)
	A=A+A
	A=A+A				; *4
	GOSUB	.data

* Temps d'attente pour les diffŽrents niveaux
	DC(4)	2500			; Niveau 0
	DC(4)	2000			; Niveau 1
	DC(4)	1500			; Niveau 2
	DC(4)	1000			; Niveau 3
	DC(4)	0800			; Niveau 4
	DC(4)	0600			; Niveau 5
	DC(4)	0500			; Niveau 6
	DC(4)	0400			; Niveau 7
	DC(4)	0300			; Niveau 8
	DC(4)	0250			; Niveau 9


.data	C=RSTK
	A=A+C
	D0=A
	A=DAT0(X)

	D0=	VARS_Count
	DAT0(X)=A

	RTNSC




*************************************************************************
*			Calcul de la nouvelle piece			*
*************************************************************************
TETR_New:
	LC	2000			; Emet un petit Beep
	D=C
	LC	100
	GOSBVL	ROM_Beep

	D0=	VARS_Col
	C=DAT0
	RSTK=C
	LC(2)	$2F
	DAT0(B)=C
	D0=D0-3			; VARS_Next
	A=DAT0(B)
	D0=D0+5
	DAT0(B)=A
	GOSUBL	TETR_Display
	D0=	VARS_Col
	C=RSTK
	DAT0=C

TETR_FirstNew:
	D0=	VARS_Seed	; Lit la racine du generateur aleatoire
	A=DAT0
	B=A
	A=A+A			; *2
	A=A+A			; *4
	A=A+B			; *5
	A=A+A			; *10
	A=A+A			; *20
	A=A+A			; *40
	A=A+B			; *41

	D1=	HARD_Ticks	; Choisit un motif au hasard
	C=DAT1

	A=A+C			; Choisit la pi�ce au hasard
	DAT0=A

	GOSUB	.nop

* Pi�ces choisies en fonction du tirage alŽatoire
	DX	00102030405060708090A0B0C0D0E0F0
	DX	0111219000F09000F01050B0D09000F0

.nop	LC	31
	A=A&C
	A=A+A			; Double pour tomber sur des octets
	C=RSTK			; Adresse de la table
	A=A+C			; NumŽro de pi�ce tirŽe
	D0=A
	A=DAT0(B)		; Lue

	D0=	VARS_Next	; Prochaine piece
	C=0
	C=DAT0(B)
	DAT0=A(X)
	D0=	VARS_Curnt
	DAT0=C(X)		; Piece actuelle

	GOSUB	.nop2

* Forme des pi�ces
	DX	F99F		; CarrŽ

	DX	F9BF		; L
	DX	F9BF
	DX	F9BF
	DX	F9BF

	DX	F9DF		; L inverse
	DX	F9DF
	DX	F9DF
	DX	F9DF

	DX	FBDF		; Barre
	DX	FBDF

	DX	FB9F		; Les Z
	DX	FB9F
	DX	FB9F
	DX	FB9F

	DX	FDBF		; Les T
	DX	FDBF
	DX	FDBF
	DX	FDBF

.nop2	A=C			; Ecrit le motif lu dans la table prŽcŽdente
	A=A+A
	A=A+A
	C=RSTK
	C=C+A
	D0=C
	A=DAT0

	D0=	VARS_Pattern
	DAT0=A

	LC(1)	6		; Position de la pi�ce
	D0=	VARS_Col
	DAT0=C(P)
	D0=D0+1
	C=0
	DAT0=C(P)

	GOSUBL	TETR_Wait_new	; Initialise le compteur d'attente

	D0=	VARS_Col
	C=DAT0
	RSTK=C
	LC(2)	$2F
	DAT0(B)=C
	D0=D0-3			; VARS_Next
	A=DAT0(B)
	D0=D0+5
	DAT0(B)=A
	GOSUBL	TETR_Display
	D0=	VARS_Col
	C=RSTK
	DAT0=C

	RTN


*************************************************************************
*			Affichage d'une piece				*
*************************************************************************
* L'affichage se fait en mode XOR
* Carry Set au retour si il y a une piece dessous
TETR_Display:
	D1=	SCRN_Base
	A=DAT1				; A pointe sur l'Žcran
	A=A+8				; Colonne de gauche

	D0=	VARS_Col
	C=0
	C=DAT0(P)
	A=A+C				; A pointe sur le haut de la colonne

	D0=D0+1				; VARS_Line
	C=DAT0(P)			; C= ligne
	B=C
	CSL				; *16
	C=C+B				; *17
	C=C+C				; *34
	C=C+C
	C=C+C
	A=A+C
	D1=A				; D1 pointe sur le haut du motif

	GOSUB	.nop1			; Adresse des pi�ces

* Description Hexa de chacune des pieces
	DX	6600	; Carre

	DX	4460	; L
	DX	2E00
	DX	6220
	DX	7400

	DX	2260	; L inverse
	DX	E200
	DX	6440
	DX	4700

	DX	F000	; Barre pleine
	DX	4444

	DX	2640	; Z
	DX	C600

	DX	3600	; Z inverse
	DX	4620

	DX	4640	; T
	DX	4E00
	DX	2620
	DX	E400

.nop1	C=RSTK
	D0=	VARS_Pattern		; Motif de la pi�ce
	A=DAT0
	B=A				; B: motif

	D0=	VARS_Curnt		; Piece actuelle
	A=0
	A=DAT0(B)
	A=A+A
	A=A+A				; 4 quartets par piece
	C=C+A				; Pointe sur la piece actuelle

	D0=C				; D0 pointe sur la piece

	A(S)=0				; A(S) indique si piece touchee

	P=15				; Champ S
	LC(1)	3			; nombre de lignes
	P=0
	D=C(S)

.line	LC(1)	3
	D=C(P)
	A=DAT0(P)			; Element de la piece actuel
	D0=D0+1

.col	?ABIT(3)=0
	GOYES	.nod2			; Si rien a afficher

	P=2
	LC(1)	3			; Nombre de lignes
	P=0
	D=C(XS)
	GOTO	.disp

.nod2	GOTO	.nodisp

* Calcul d'un ou exclusif: (C|B) & non (C&B)
.disp:
	BSRC				; Passe dans B(S) le quartet OK
	C=DAT1(S)			; Lecture de la donnŽe

	A=A|C(S)			; Indique dans A(S) si contact
	ASLC				; Lib�re A(S)

	C=C&B(S)
	C=-C-1(S)			; non (C&B)
	A=C(S)
	C=DAT1(S)
	C=C|B(S)
	C=C&A(S)

	ASRC				; RŽcup�re le champ A(S)


	DAT1(S)=C			; Remplace l'ŽlŽment
	D1=D1+16			; Ligne suivante
	D1=D1+16
	D1=D1+2
	D=D-1(XS)
	GONC	.disp

	LC	4*34			; Remonte les 4 lignes
	AD1EX
	A=A-C
	AD1EX
	BSLC				; RŽcup�re la valeur initiale de B
	BSLC
	BSLC
	BSLC

.nodisp	D1=D1+1				; Colonne suivante
	A=A+A
	D=D-1(P)
	GOC	.ecol
	GOTO	.col

.ecol	AD1EX
	LC	4*34-4			; Passe ˆ la ligne suivante
	A=A+C
	AD1EX

	D=D-1(S)
	GOC	.eline
	GOTO	.line

.eline	?A(S)=0
	GOYES	.noHit

	RTNSC				; Met C ˆ 1 si on a touchŽ une piece
.noHit	RTNCC


*************************************************************************
*			Gestion du clavier
*************************************************************************

TETR_NoKey	equ	0
TETR_KeyLeft	equ	1
TETR_KeyRight	equ	2
TETR_KeyRotate	equ	3
TETR_KeyLevel	equ	4
TETR_KeyDown	equ	5
TETR_Key:
* --------------------------------------------------------------------- *
* 			Lecture des touches				*
* --------------------------------------------------------------------- *
	LC(4)	16			; Teste la touche BACK pour quitter
	OUT=CS
	GOSBVL	ROM_InputA

	?ABIT(0)=0
	GOYES	.Cont
	C=RSTK				; Recupere le niveau de pile
	GOLONG	MAIN_Loop_End		; Quitte le programme

.Cont	LC(1)	4
	OUT=CS
	GOSBVL	ROM_InputA
	C=0				; Par dŽfaut: pas de touche

	?ABIT(1)=0			; Teste la touche de droite
	GOYES	.KeyRt
	LC(1)	TETR_KeyRight

.KeyRt	?ABIT(3)=0			; Teste la touche de gauche
	GOYES	.KeyLf
	LC(1)	TETR_KeyLeft

.KeyLf	?ABIT(2)=0
	GOYES	.KeyRot
	LC(1)	TETR_KeyRotate

.KeyRot	R0=C				; Sauvegarde la touche pressŽe
	LC(1)	2
	OUT=CS
	GOSBVL	ROM_InputA		; Teste la touche du bas
	C=R0

	?ABIT(2)=0
	GOYES	.KeyDn
	LC(1)	TETR_KeyDown

.KeyDn	R0=C
	LC(1)	8
	OUT=CS
	GOSBVL	ROM_InputA		; Teste la touche du haut
	C=R0

	?ABIT(2)=0
	GOYES	.KeyUp
	LC(1)	TETR_KeyLevel

.KeyUp	D0=	VARS_Key		; Enregistre la touche pressee
	A=DAT0(P)
	DAT0(P)=C

	R0=C
	C=0
	OUT=CS
	C=R0

	?C=A(P)
	GOYES	.no_key
	RTNSC

.no_key	RTNCC


* --------------------------------------------------------------------- *
* 			InterprŽtation des touches			*
* --------------------------------------------------------------------- *
TETR_DispX:
	D0=	VARS_Col
	A=DAT0				; Copie les coordonnŽes
	D0=D0+5
	DAT0=A
	D0=D0-5

	D1=	VARS_Key
	A=DAT1(P)

	LC(1)	TETR_KeyLeft
	?A<>C(P)
	GOYES	.left

	A=DAT0(P)			; DŽplacement vers la gauche
	A=A-1(P)
	GOC	.end1
	DAT0(P)=A
.end1	GOTO	.end


.left	C=C+1(P)
	?A<>C(P)
	GOYES	.right

	A=DAT0(P)			; DŽplacement vers la droite
	A=A+1(P)
	GOC	.end2
	DAT0(P)=A
.end2	GOTO	.end


.right	C=C+1(P)
	?A<>C(P)
	GOYES	.level

	D0=	VARS_Curnt		; Effectue la rotation
	A=0
	A=DAT0(B)
	A=A+A				; Offset de la pi�ce dans la table
	GOSUB	.nop

* Enchainement des pieces par rotation
	DX	002030401060708050A090C0B0E0D0011121F0

.nop	C=RSTK
	C=C+A
	D1=C
	A=DAT1(B)
	DAT0(B)=A

	GOTO	.end

.level	C=C+1(P)
	?A<>C(P)
	GOYES	.down

	D0=	VARS_Level
	A=DAT0(P)
	LC(1)	9
	?C<=A(P)
	GOYES	.nolev

	A=A+1(P)
	DAT0(P)=A

.nolev	GOTO	.end

.down	C=C+1(P)
	?A<>C(P)
	GOYES	.end

	D0=	VARS_Count
	C=0
	C=C-1
	DAT0(X)=C

.end	RTN


* --------------------------------------------------------------------- *
*			Annulation d'un dŽplacement			*
* --------------------------------------------------------------------- *
TETR_CancelDisp:
	D0=	VARS_OldCol
	A=DAT0
	D0=D0-5
	DAT0=A
	RTN

* --------------------------------------------------------------------- *
*			DŽplacement vers le bas d'une pi�ce		*
* --------------------------------------------------------------------- *
TETR_DispY:
	D0=	VARS_Col
	A=DAT0
	D0=D0+5
	DAT0=A

	ASR
	A=A+1(P)
	D0=D0-4
	DAT0(P)=A

	RTN


TETR_Init:
*************************************************************************
*			Initialisation du Jeu				*
*************************************************************************
* Sauvegarde des registres
	GOSBVL	ROM_SaveRegs

* COUPURE DES INTERRUPTIONS CLAVIER
	ST(15)=0


* INITIALISATION DE L'ECRAN
* Passe en Full Screen et utilise le GROB en niveau 1 comme ecran
	LC(3)	63
	D0=	HARD_ScreenHeight	; Passe en "Full Screen"
	DAT0=C(X)

	A=DAT1				; Lit le GROB dans la pile
	LC	21
	A=A+C				; Saute la partie prologue du GROB
	ABIT(0)=0			; S'assure que debute sur un octet
	D0=	SCRN_Base		; Stocke le resultat dans l'ecran
	DAT0=A
	D0=	HARD_ScreenBase		; et utilise comme ecran physique
	DAT0=A
	B=A

	D1=D1+5				; Copie l'Žcran en niveau 2
	A=DAT1
	LC	20
	A=A+C
	D0=A				; Source = GROB niveau 2
	A=B
	D1=A				; Destination = Ecran
	LC	34*64			; Longueur = 1 Ecran
	GOSBVL	ROM_MoveDn		; Copie de l'Žcran

	C=0
	D0=	VARS_Score
	DAT0=C				; Initialise VARS_Score
	D0=D0+5
	DAT0=C				; ... Level et autres
	D0=D0+6
	DAT0=C(3)

	D0=	HARD_Ticks
	A=DAT0
	D0=	VARS_Seed
	DAT0=A

	D0=	VARS_ScoreDec		; Stocke le score en valeur dŽcimale
	C=0
	DAT0=C
	D0=D0+5
	DAT0=C

	C=C-1
	D0=D0+1
	DAT0=C
	D0=D0+5
	DAT0=C

	RTN




TETR_Exit:
*************************************************************************
*			Fin du jeu					*
*************************************************************************

* Restauration de l'Žcran
	D0=	RRAM_ScreenBase
	A=DAT0
	D0=	HARD_ScreenBase
	DAT0=A
	D0=	RRAM_ScreenMenuBase
	A=DAT0
	D0=	HARD_ScreenMenuBase
	DAT0=A
	D0=	HARD_ScreenShift
	LC(1)	8
	DAT0=C(1)
	D0=	HARD_ScreenWidth
	C(X)=0
	DAT0=C(X)

* Restaure le contenu des registres sauvegardŽs
	GOSBVL	ROM_LoadRegs

* Restaure les interruptions et retourne
	ST(15)=1
	RTN

    END

  AboutCode
	ASM

*************************************************************************
*		Affichage d'un texte (string niv 1) en dŽfilement	*
*************************************************************************

* Set variables at beginning of free system variables
		RSSET	RRAM_Free70
TEXT_Pointer	RS	5	; Current char to be read
TEXT_Begin	RS	5	; Beginning of the char string
TEXT_End	RS	5	; End of the char string

CHAR_Data	RS	16	; Current char to be displayed


* Initialization
		GOSBVL	ROM_SaveRegs	; Save all RPL registers

		A=DAT1			; Read stack to find string
		AD1EX
		D1=D1+5
		C=DAT1			; C = String length

		D0=	TEXT_Pointer
		D1=D1+5
		AD1EX
		DAT0=A			; TEXT_Pointer
		D0=D0+5
		DAT0=A			; TEXT_Begin
		D0=D0+5
		A=A-5
		A=A+C
		DAT0=A			; TEXT_End

CharacterLoop	D0=	TEXT_Pointer
		A=DAT0
		D0=A
		A=0
		A=DAT0(B)
		LC(2)	32
		?A>C(B)
		GOYES	.nospace
		A=C(B)

.nospace	ASL			; A*16: pointer to char
		LC	ROM_CharSet2-496
		A=A+C
		D0=A

		GOSUB	.findadr
.findadr	C=RSTK			; Adresse de .findadr
		A=C
		LC	$80000
		?A>C			; Not in HRAM: easy
		GOYES	.easy

* Difficult case: Must deconfigure $C0000 module to "see" HROM
		LC	$C0000
		UNCNFG
		LC	$80000
		AD0EX
		A=A+C			; See HROM second block
		AD0EX
		A=DAT0(W)
		LC	$C0000
		CONFIG			; Reconfig second module
		CONFIG			; in $C0000
		GOTO	.read


* Easy case: PC is after $80000 -> it is possible to configure RRAM down
.easy		LC	$70000		; Put HRAM in $60000
		UNCNFG
		LC	$F0000
		CONFIG
		LC	$60000
		CONFIG

		A=DAT0(W)

		UNCNFG			; Put HRAM in $70000
		LC	$F0000
		CONFIG
		LC	$70000
		CONFIG

		GOTO	.read

* Data read in A
.read		D1=	CHAR_Data
		DAT1(W)=A		; Write char description

		LC(2)	5		; Shifts to output char
		D=C(B)
ShiftLoop	D0=	RRAM_GROBStack
		A=DAT0
		LC	34*40+20	; Stack display data
		A=A+C
		D0=A			; D0= ptr to screen

* Scroll screen 1 pixel to the left
		LC(3)	34*8		; Shifts for screen scroll
		ABIT(8)=0
.shiftscreen	A=DAT0(B)		; Scroll screen 1 pixel left
		ABIT(9)=0
		?ABIT(0)=0
		GOYES	.nobit1
		ABIT(9)=1
.nobit1		ASRB

		DAT0(B)=A
		D0=D0-2

		C=C-1(X)
		GONC	.shiftscreen

* Display character
		D0=	RRAM_GROBStack
		A=DAT0
		LC	34*25+20-2	; Stack display data
		A=A+C
		D0=A			; D0= ptr to screen
		D1=	CHAR_Data	; Char description

		LC(2)	7
		B=C(B)
.char		C=DAT0(B)
		CBIT(7)=0
		A=DAT1(B)
		?ABIT(0)=0
		GOYES	.carry_char
		CBIT(7)=1
.carry_char	A=A/2(B)
		DAT0(B)=C
		DAT1(B)=A
		D1=D1+2
		D0=D0+16
		D0=D0+16
		D0=D0+2
		DAT0(B)=C
		D0=D0+16
		D0=D0+16
		D0=D0+2

		B=B-1(B)
		GONC	.char

		LC	1000
.wait		C=C-1
		GONC	.wait

		LC(4)	$1FF
		OUT=CS
		GOSBVL	ROM_InputA
		?A=0(X)
		GOYES	noTerminate
		GOTO	Terminate

noTerminate	D=D-1(B)
		GOC	ShiftLoopEnd

		GOTO	ShiftLoop

ShiftLoopEnd	D0=	TEXT_Pointer
		A=DAT0			; TEXT_Pointer
		A=A+2
		D0=D0+10
		C=DAT0			; TEXT_End
		D0=D0-5

		?A<C
		GOYES	.ok

		A=DAT0			; TEXT_Begin

.ok		D0=D0-5
		DAT0=A			; TEXT_Pointer

		GOTO	CharacterLoop


* Quit program when key pressed
Terminate	GOSBVL	ROM_LoadRegs
		A=DAT0
		D0=D0+5
		PC=(A)

	END


END