home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
ARK.ARJ
/
SERVICE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-07-07
|
113KB
|
3,176 lines
{$F+}
unit service;
{ ------------------------------------------------------------------------- }
interface
{ ----------------------------------------------------------------------- }
uses crt,dos,graph,mouse,snd;
const
SCRMIN = 10; { Coordinata X del bordo sinistro dell'area di gioco }
SCRMAX = 216; { Coordinata X del bordo destro dell'area di gioco }
SCRTOP = 12; { Coordinata Y del bordo superiore dell'area di gioco }
SCRBOT = 200; { Coordinata Y del bordo inferiore dell'area di gioco }
VAUS_W = 34; { Larghezza in pixel del VAUS }
VAUS_H = 4; { Altezza in pixel del VAUS }
VAUS_LINE = 184; { Coordiana Y su cui scorre orizzontalmente il VAUS }
EMP = -1; { Uso EMP (empty) al posto di -1 }
BALLDIM = 5; { Diametro della pallina (in pixel) }
BALLSPOT = 3; { Raggio della pallina (in pixel) = diametro/2 +1 }
BALLARRAY : array[0..4,0..4] of byte = ((0,1,1,1,0),
(1,1,2,1,1),
(1,2,1,1,1),
(1,1,1,1,1),
(0,1,1,1,0));
{ Disegno della pallina }
BALLDEV = 30; { Angolo di deviazione quando }
{ urta i bordi rossi del VAUS }
SPEEDFLASH = 10; { Numero di 50-esimi di secondo che deve aspettare }
{ prima di cambiare il colore dei bordi del vaus }
FLASH : array[0..10] of byte = ( 255,212,211,210,209,
208,207,206,205,204,203);
{ Colori che gli estremi del vaus assumono durante il lampeggio }
SCORE_WALL : array[1..10] of integer = ( 10,20,30,40,50,100,200,250,500,1000 );
EMERG_DEV : array[1..8] of byte = ( $02,$13,$24,$35,$12,$23,$34,$45 );
COLORBLOCK : array[0..9] of byte = ( 212,211,210,209,208,
207,206,205,204,203 );
{ Colore dei mattoncini }
GRAYDOWN = 1; { Numero di colpi-1 per abbattere un mattone grigio }
STARTWALL = 01; { Livello di partenza }
BALLSPEED = 500; { Velocita' della pallina (256 = 70 pixel al secondo }
MAXSPEED = 2000;{ Velocita' massima raggiungibile dalla pallina }
MAXBRWHIT = 100; { Numero massimo di blocchi indistr. che puo' colpire }
{ prima di schizzare via cambiando velocita' }
PATNUMBER = 4; { Numero dei fondali disponibili }
POS_DIGIT : array[1..3] of integer = (60,93,128);
{ Coordinata y dei tre punteggi (player 1, player 2, hiscore) }
DIGITS : array[0..10] of byte = ( 125,96,55,103,106,79,
95,97,127,111,0 );
{ Dati per la visualizzazione delle cifre digitali nei punteggi }
LEVEL : array[1..5] of integer = (1000,300,100,60,35);
SBDIR = 600; { Cicli che deve fare prima che la palla devi (dev. regolare) }
DEFLEVEL = 3; { Livello di gioco di default }
LETTER_PROB= 300; { range in cui viene estratto il numero casuale della lettera }
LETTER_DROP= 1000;{ numero che deve raggiungere la somma per far cadere la lettera }
LETTER_NUMB= 8; { numero di lettere+1 }
LETTER_FRM = 8; { numero dei frames che costituiscono l'animazione della lettera }
LETTER_SBF = 5; { numero di cicli che deve compiere prima di passare al frame }
{ successivo }
{Prob in % di caduta delle lettere } { L E B D S C P }
LETTER_DIS : array[1..7] of integer = ( 16, 20, 3, 18, 20, 20, 3 );
FLUXLEVEL = 176;
type
arr768 = array[0..767] of byte; { per i 256 colori in RGB (x3) }
arr64k = array[0..64000] of byte; { per la schermata di 320x200 }
BTMTYPE = RECORD { per un disegno in fomrato BTM }
width : word; { larghezza disegno }
height : word; { altezza }
trasp : byte; { trasparenza (non usato) }
palette : ^arr768; { puntatore alla palette di colori }
palused : boolean; { flag TRUE = la palette esiste }
map : ^arr64k; { dati contenenti il disegno }
end;
VAUSTYPE = RECORD { per i dati del vaus }
x,y, { attuali coordinate x,y }
oldx, { vecchie coordinate del vaus }
oldy : longint;
oldlen : integer; { e vecchia lunghezza }
width, { larghezza }
height : integer; { spessore (o altezza) }
flash : byte; { indica il colore attuale dei bordi }
iflash : integer; { contatore di ritardo per il }
{ il lampeggio dei bordi }
letter : integer;
end;
BALLTYPE = RECORD { contiene i dati della pallina }
x,y, { coordinate x,y attuali }
finex,finey, { sottomultipli delle coordinate }
oldx,oldy, { vecchie coordinate }
speed : longint; { velocita' (256 = 70 pixel al sec. }
finespeed : longint; { velocita' (sottomultiplo) }
speedx, { velocita' sull'asse x }
speedy : longint; { velocita' sull'asse y }
sbd : longint; { per evitare i loop della pallina }
brwhit : integer; { n. di blocchi marroni colpiti di seguito }
attrib : integer; { atributi (non usato) }
inplay : boolean; { flag, TRUE se la palla e' in gioco }
launch : boolean; { flag, TRUE se la palla deve essere }
{ ancora lanciata }
onvaus : integer; { larghezza in pixel del vaus }
stm : integer; { contatore di calamita }
end;
WALLTYPE = array[0..12,-1..15] of byte; { per il muro (13x15 mattoncini) }
WHOLEWALLS = array[0..33] of WALLTYPE; { per tutti e 33 i muri }
SCORETYPE = RECORD { tiene i punteggi }
player : array[1..2] of longint; { player 1 e 2 }
wall_n : array[1..2] of integer; { muro corrente }
wall_p : array[1..2] of WALLTYPE;{ memoriz. del muro stesso }
lives : array[1..2] of integer; { vite rimaste }
hiscore: longint; { record }
pl_numb: integer; { giocatore corrente }
roundsel : array[1..2] of boolean;
abortplay : boolean;
end;
SHREC = RECORD { per lo scintillio dei mattoncini }
xb,yb,frame : integer;
block : integer;
active : boolean;
end;
LETTERREC = RECORD { dati relativi alla lettera }
x,y : word; { coord. }
typ : integer; { Tipo, B,C,E,L,P,D,S }
frame : integer; { numero del frame }
subframe : integer; { numero di cicli per ogni frame }
active : boolean; { la lettera puo' essere attiva }
incoming : longint; { tiene la somma, >1000 la lettera cade }
nextx, { coord di dove deve cadere se attivata }
nexty,
nexttype : word; { tipo di lettera che dovra' cadere }
last : integer; { ultima lettera caduta }
end;
FIRETYPE = RECORD { per i laser }
x,y : word; { coord. }
shot : boolean; { se il colpo e' partito }
avl : boolean; { se e' dispoibile (grazie alla L) }
nw : boolean; { se e' appena partito dal VAUS }
end;
var
playscreen : BTMTYPE; { area di gioco (320x200) }
playvaus : BTMTYPE; { vaus }
normal : BTMTYPE; { vaus normale }
enlarged : BTMTYPE; { allargato }
lasers : BTMTYPE; { traformato per sparare }
pattern : BTMTYPE; { sfondo }
explosion : BTMTYPE; { esplosione vaus }
newvaus : BTMTYPE; { sequenza di animazione di partenza }
presents : BTMTYPE; { scritta ARKANOID }
soundfx : BTMTYPE; { l'icona con la nota e la nota sbarrata }
shinewall : BTMTYPE; { luccichio dei mattoncini grigi e beige }
minivaus : BTMTYPE; { vaus piccolino che indica le vite }
levelsel : BTMTYPE; { 5 frames dei numeri per scegliere il livello }
letters : BTMTYPE; { le animazioni delle 7 lettere }
shoots : BTMTYPE; { e il disegno dei laser }
flux : BTMTYPE;
vaus : VAUSTYPE; { dati relativi al vaus (vedi sopra) }
row : array[0..250] of word; { array (vedere initRowArray) }
success : boolean; { flag di stato per il caric. BTM }
screen : array[0..65530] of byte absolute $a000:0000;
{ forzatura della mappa di schermo all'indirizzo della VGA }
{ a000:0000 inerente alla modalita' grafica 320x200x256 col. }
wall : walltype; { muro }
cn : integer; { variabile di servizio usata qua e la' }
modx : array[0..319] of integer;
mody : array[0..199] of integer;
all_walls : WHOLEWALLS; { tutti i muri }
remain_blk : integer; { mattoni ancora da abbattere }
totalwall : integer; { mattoni in tutto }
score : SCORETYPE; { punteggio corrente }
cur_player : integer; { giocatore corrente }
shinerec : shrec; { tiene i dati dell'blocco }
{ che scintilla in questo }
{ momento }
lv : integer; { livello di gioco }
trainer : integer;
lett : LETTERREC; { i parametri delle lettere }
fire : FIRETYPE; { e dei raggi laser }
balls_in_play : integer; { numero di palline in gioco }
scrflux : boolean;
scrfluxcnt : integer;
{ ------------------------------------------------------------------------- }
{ Queste sono le funzioni che devono essere viste dal programma principale }
function mainscreen : integer;
procedure fatal_error(err_type : string);
procedure loadBTM(name : string; var BTMREC : BTMTYPE; pal : boolean);
procedure load_all_walls;
procedure InitSVGA;
procedure initRowArray;
function random_letter_drop : integer;
procedure start_game(players : integer);
procedure closeprogram;
{ ------------------------------------------------------------------------- }
implementation
{ ------------------------------------------------------------------------- }
procedure closeprogram;
begin
clrscr;
textcolor(7);
writeln('Important!');
writeln;
writeln('This game is only a demostration of how is possible to build');
writeln('sophisticated programs, even in Turbo Pascal, using a powerful');
writeln('shareware utility whose name is Power Design 386 (or PD386 for short).');
writeln('PD386 offers all the features you need to create multicolored sprites');
writeln('and pictoresque background screens for your games, your aplications');
writeln('and your programs in general. It also supports the .GIF graphic format!');
writeln('If you are interested in programming graphics you cannot miss PD386.');
writeln('Please take a look.');
writeln;
writeln('End of message.');
halt;
end;
{ ritorna il massimo fra a e b }
function max(a,b : integer) : integer;
begin
if(a>b) then max:=a
else max:=b;
end;
{ idem per il minimo }
function min(a,b : integer) : integer;
begin
if(a<b) then min:=a
else min:=b;
end;
{ chiara, no? }
procedure fatal_error(err_type : string);
begin
nosound;
closegraph;
write;
writeln('Arkanoid can run no long');
writeln('Fatal Error: ',err_type);
halt;
end;
function inkey : word; { restituisce il codice del tasto premuto }
var ch,ch2: char; { 0 = nessun tasto premuto }
begin
ch:=#0;
ch2:=#0;
if keypressed then
begin
ch:=readkey;
if ch=#0 then ch2:=readkey;
end;
inkey:=(ord(ch2)*256)+ord(ch);
end;
procedure initRowArray; { inizializza l'array ROW; row[n]:=320*n }
var y : word;
begin
for y:=0 to 199 do
row[y]:=y*320;
for y:=200 to 250 do
row[y]:=64000;
end;
{ quanto segue fa parte della procedura per installare un driver esterno }
{ come da esempio nell'help di Turbo Pascal. }
procedure svgadrv; external; {$L SVGADRV.OBJ}
function DetectVGA : Integer;
begin
DetectVGA := 0;
end;
procedure InitSVGA; { Inizializza il driver della SuperVGA come da esempio }
var
AutoDetect : pointer;
GraphMode, GraphDriver, ErrCode: integer;
begin
GraphDriver := InstallUserDriver('SVGA256',@DetectVGA);
if RegisterBGIDriver(@svgadrv)<0 then
fatal_error('Unable to register driver');
ErrCode:=GraphResult;
if ErrCode <> grOk then
begin
WriteLn('Error installing TestDriver:');
Writeln(GraphErrorMsg(ErrCode));
Halt(1);
end;
GraphDriver:=Detect;
InitGraph(GraphDriver,GraphMode,'');
ErrCode := GraphResult;
if ErrCode <> grOk then
begin
WriteLn('Error during Init: ', GraphErrorMsg(ErrCode));
Halt(1);
end;
end; { Fine della procedura InitSVGA }
{ ------------------------------------------------------------------------ }
procedure shine_block; { esegue lo scintillio di un blocco }
var
xb,yb, { i parametri del blocco sono contenuti nella }
frame : word; { variabile globale SHINEREC }
x,y,
xf,yf,
fr,og : word;
begin
xb :=shinerec.xb; { mette in xb,yb le coordinate del blocco }
yb :=shinerec.yb;
if wall[xb,yb]>8 then { se il blocco e grigio o marrone }
begin
frame:=(shinerec.frame shr 1); { calcola il n. del frame }
if wall[xb,yb]<>10 then inc(frame,5);
xf:= 9+(xb shl 4); { trova le coordinate sullo shermo del blocco }
yf:=22+(yb shl 3); { da far scintillare }
fr:=frame shl 7; { si calcola la posizione del n-esimo frame }
for y:=0 to 7 do { e copia il frame n-esimo sullo schermo }
begin
og:=y shl 4; { equivale ad y*16, ma piu' veloce }
memcpy(addr(shinewall.map^[fr+og]),addr(screen[xf+row[yf+y]]),16);
end;
end;
inc(shinerec.frame); { incrementa il frame counter }
if shinerec.frame=10 then shinerec.active:=FALSE;
{ e quando il frame e' l'ultimo allora lo scintillio e' finito }
end;
procedure unshine_block; { interrompe lo scintillio di un blocco se la }
{ palla urtandone un altro causa lo scintillio }
{ di un altro blocco }
begin
shinerec.frame:=9; { cioe' setta il frame come ultimo }
shine_block; { ed esegue lo scintillio del blocco con l'ultimo }
{ frame, cioe' il blocco torna normale }
end;
procedure shine(xb,yb : integer); { questa procedura imposta lo }
{ scintillio di un blocco }
var t : integer;
begin
if shinerec.active then unshine_block;
shinerec.xb :=xb; { coordinate del blocco }
shinerec.yb :=yb; { x,y }
shinerec.frame :=0; { frame di partenza }
shinerec.active:=TRUE; { scintillio attivo }
shinerec.block :=wall[xb,yb]; { tipo di blocco (marrone o grigio) }
end;
procedure checkshine; { se lo scintillio e' attivato allora lo esegue }
{ passando al frame successivo }
begin
if shinerec.active=TRUE then shine_block;
end;
function random_letter_drop : integer;
var rn,sum,letter : integer;
begin
repeat
rn:=random(100); { Tira a caso un numero fra 0 e 99 }
sum:=0; { pone la somma a zero }
letter:=0; { e la lettera corrente a 0 }
repeat
inc(letter); { Incrementa la lettera corrente }
inc(sum,LETTER_DIS[letter]); { Incrementa somma della percentuale di }
{ probabilita' della lettera corrente }
until sum>rn; { Se la somma oltrepassa il numero casuale scelto }
{ il programma fa cadere la lettera corrente }
{ altrimenti passa alla lettera dopo. }
until (letter-1)<>lett.last;
random_letter_drop:=(letter-1);
end;
procedure put_letter;
var xl,yl,fl,fw,cl : word;
begin
fl:=(lett.typ shl 10)+(lett.frame shl 4);
for yl:=0 to 7 do
begin
fw:=yl shl 7;
memzerocpy(addr(letters.map^[fw+fl]),addr(screen[lett.x+row[lett.y+yl]]),16);
end;
end;
procedure remove_letter;
var ad,yl : word;
begin
if (lett.x>=0) and (lett.x<320) and (lett.y>0) and (lett.y<240) then
begin
for yl:=0 to 7 do
begin
ad:=lett.x+row[lett.y+yl];
if ad<64000 then
memcpy(addr(playscreen.map^[ad]),addr(screen[ad]),16);
end;
end;
end;
procedure disable_letter;
begin
remove_letter;
lett.active:=FALSE;
end;
procedure start_letter(xl,yl,letter : word);
begin
if lett.active then disable_letter;
with lett do
begin
x :=xl;
y :=yl;
typ :=letter;
frame :=0;
subframe:=0;
active :=TRUE;
end;
end;
procedure check_letter;
begin
if lett.active then
begin
remove_letter;
inc(lett.y);
if lett.y>=200 then disable_letter
else
begin
put_letter;
inc(lett.subframe);
if lett.subframe=LETTER_SBF then
begin
lett.subframe:=0;
inc(lett.frame);
end;
if lett.frame=LETTER_FRM then lett.frame:=0;
if (vaus.x<(lett.x+16)) and ((vaus.x+vaus.width)>lett.x) and
(vaus.y<(lett.y+8)) and ((vaus.y+vaus.height)>lett.y) then
begin
ball_block_sound(100,10);
vaus.letter:=lett.typ+1;
inc(score.player[cur_player],SCORE_WALL[10]);
disable_letter;
end;
end;
lett.incoming:=0;
end
else if (lett.incoming>LETTER_DROP) then
with lett do start_letter(nextx,nexty,nexttype);
end;
{ Copia sullo schermo a partire dalla coordinata 0,0 il disegno specificato }
procedure showBTMpicture(BTM : BTMTYPE);
var x,y,ofst : word;
begin
for y:=0 to BTM.height-1 do { la y varia da 0 all'altezza-1 del disegno }
begin
ofst:=y*BTM.width; { calcola l'indirizzo nella matrice del dis.}
for x:=0 to BTM.width-1 do
screen[x+row[y]]:=BTM.map^[x+ofst]; { mette il disegno sullo schermo }
end;
end;
procedure setpalette(var BTM : BTMTYPE);
var regs : REGISTERS;
begin
regs.ax:=$1012; { setta i colori usando l'interrupt 10h }
regs.bx:=0; { del BIOS }
regs.cx:=256;
regs.es:=SEG(BTM.palette^);
regs.dx:=OFS(BTM.palette^);
intr($10,regs);
end;
procedure loadBTM(name : string; var BTMREC : BTMTYPE; pal : boolean);
var
h1 : file;
s : array[0..10] of byte; { carica un file in formato BTM }
cnt : word;
size : longint;
pl : array[0..767] of byte;
begin
{$I-}
assign(h1,name); { apre il file }
reset(h1,1); { e si pone all'inizio }
blockread(h1,s,11,cnt); { legge 11 bytes di intestazione }
blockread(h1,pl,768,cnt); { legge la palette dei colori }
BTMREC.width :=s[6]+s[7]*256; { legge la larghezza, byte 6 e 7 }
BTMREC.height:=s[8]+s[9]*256; { l'altezza, byte 8 e 9 }
BTMREC.trasp :=s[10]; { e il colore di trasparenza }
size:=(BTMREC.width)*(BTMREC.height); { calcola dimensione immagine }
getmem(BTMREC.map,size); { alloca la memoria per l'immagine }
blockread(h1,BTMREC.map^,size,cnt); { e si legge l'immagine da disco }
if pal=TRUE then { se occorre tenere anche la palette }
begin
getmem(BTMREC.palette,768); { alloca la mem. per la palette }
for cnt:=0 to 767 do
BTMREC.palette^[cnt]:=pl[cnt]; { e ci copia la palette appena }
{ caricata che altrimenti verrebbe }
{ perduta al termine della proc. }
BTMREC.palused:=TRUE; { quindi setta a TRUE il flag PALETTE USATA }
end
else BTMREC.palused:=FALSE; { altrimenti lo setta a false }
close(h1); { e chiude il file letto da disco }
{$I+}
if IOResult<>0 then success:=FALSE;
end;
{ disegna la palla sullo schermo, le coordinate sono specificate in }
{ BALL.x e BALL.y, BALLSPOT.x = BALLSPOT.y e' il raggio della palla }
{ in pixel }
procedure place_ball(var ball : BALLTYPE);
var xp,yp,adr : longint;
begin
for yp:=0 to BALLDIM-1 do
begin
adr:=ball.x-BALLSPOT+row[yp-BALLSPOT+ball.y];
memzerocpy(addr(BALLARRAY[yp,0]),addr(screen[adr]),BALLDIM);
end;
end;
{ Cancella la palla dallo schermo, viene chiamata un istante prima di }
{ place_ball }
procedure remove_ball(var ball: BALLTYPE);
var
xp,
yp : longint;
temp : longint;
begin
for yp:=0 to BALLDIM-1 do
begin
temp:=ball.oldx-BALLSPOT+row[yp-BALLSPOT+ball.oldy];
if (temp>0) and (temp<64000) then
memcpy(addr(playscreen.map^[temp]),addr(screen[temp]),BALLDIM);
end;
end;
procedure Wait_VBL;
label ALTO,BASSO;
begin
{ questa porzione di codice assembler attende che il pennello }
{ elettronico del monitor sia nella posizione di vertical blank }
{ in modo da evitare lo sfarfallamento dell'immagine. }
{ provvede anche a temporizzare la CPU regolando la velocita' di }
{ esecuzione del programma indipendentemente dal tipo di processore }
{ ogni scheda VGA in modalita' 320x200x256 col. lavora ad una }
{ frequenza di 70Hz. }
asm
mov dx,$03da
BASSO:
in al,dx
test al,8
jz BASSO
ALTO:
in al,dx
test al,8
jnz ALTO
end;
end;
procedure set_ball(var ball : BALLTYPE);
begin
if((ball.oldx<>EMP) and (ball.oldy<>EMP)) and
((ball.oldx<>ball.x) or (ball.oldy<>ball.y)) then
remove_ball(ball); { appena ha inizio il VB si sposta la palla alle }
place_ball(ball); { nuove coordinate }
ball.oldx:=ball.x; { si settano le vecchie coordinate uguali a quelle }
ball.oldy:=ball.y; { correnti, le correnti verrano modificate poi }
end;
procedure set_ball_speed(var ball : BALLTYPE; speed : longint);
var
sx,sy : longint; { imposta la velocita' della palla in base al modulo }
vm : real; { del vettore velocita' passato in SPEED : longint. }
begin
sx:=ball.speedx; { memorizza le componenti x e y della velocita' }
sy:=ball.speedy; { rispettivamente in sx ed sy }
vm:=speed / sqrt(sx*sx+sy*sy); { calcola il coef. di proporzionalita' }
{ fra la vecchia e la nuova velocita' }
{ (la direzione non cambia, cambia solo }
{ il modulo). }
ball.speedx:=round(sx * vm); { e quindi moltiplica per tale coef. }
ball.speedy:=round(sy * vm); { le due proiezioni della velocita'. }
end;
procedure set_ball_direction(var ball : BALLTYPE; angle : integer);
var w : real;
begin { imposta l'angolo di traiettoria della palla }
w:=angle*3.14/180.0; { w viene espresso in gradi }
ball.speedx:=round(256*cos(w)); { la velocita' si suppone unitaria }
ball.speedy:=-round(256*sin(w)); { v=256 equivale a 70 pixel al sec. }
end;
function get_ball_direction(var ball : BALLTYPE): integer;
var w : integer; { restituisce la direzione in cui si muove la palla }
begin
if ball.speedx=0 then w:=-90*(ball.speedy div abs(ball.speedy))
else
begin
{ calcola l'arcotangente e aggiunge multipli di 90 gradi a seconda dei }
{ segni di ball.speedx e ballspeed.y }
w:=round(arctan(-ball.speedy/ball.speedx)*180.0/3.14);
if(ball.speedx<0) then inc(w,180);
inc(w,360);
w:=w mod 360;
end;
get_ball_direction:=w;
end;
procedure start_ball(var ball : BALLTYPE);
begin
{ inizializza i parametri della palla quando questa deve essere }
{ lanciata dal vaus. }
ball.x:=vaus.x+ball.onvaus;
{ la coord. di partenza e' quella del vaus+16 }
{ cioe' essendo il vaus di 34 pixel, la palla deve }
{ partire al centro del vaus, cioe' vaus.x+16 }
ball.y:=vaus.y-BALLSPOT;
{ chiaramente il centro della palla sara' sulla }
{ linea dove scorre il vaus, meno il raggio }
{ della palla }
ball.finex:=0; { e i due sottomultipli della posizione sono 0 }
ball.finey:=0;
ball.inplay:=TRUE; { setta il flag che memorizza se la palla e' in gioco }
ball.sbd:=0;
ball.brwhit:=0;
end;
function ball_speed(ball : BALLTYPE): integer;
begin
{ restituisce il modulo della velocita' della palla, usa il teorema di }
{ pitagora (v=sqrt(x^2+y^2)) }
ball_speed:=round(sqrt(ball.speedx*ball.speedx+ball.speedy*ball.speedy));
end;
procedure move_ball(var ball : BALLTYPE);
var
x,y,z : longint;
angle : integer;
begin
{ muove la palla sommando alle coordinate x,y i due vettori velocita' }
{ prima di eseguire tale somma viene moltiplicato tutto per 256 in modo }
{ da avere un numero di posizioni piu' elevato. }
x:=(ball.x shl 8)+ball.finex+ball.speedx;
y:=(ball.y shl 8)+ball.finey+ball.speedy;
ball.x:=x shr 8;
ball.y:=y shr 8;
ball.finex:=x and $ff;
ball.finey:=y and $ff;
{ controlla se avviene un urto della pallina sulla parete di destra }
{ in caso d'urto inverte il segno }
if(ball.x>SCRMAX) then
begin
ball.speedx:=-ball.speedx; { inverte il vettore x della velocita' }
ball.x:=2*SCRMAX-ball.x; { riflette sull'asse x=SCRMAX la palla }
ball.finex:=255-ball.finex; { aggiusta i sottomultipli della velocita' }
ball_block_sound(240,5); { emette il suono dell'urto sulla la parete }
end;
{ idem per la parete di sinistra }
if(ball.x<SCRMIN) then
begin
ball.speedx:=-ball.speedx;
ball.x:=2*SCRMIN-ball.x;
ball.finex:=255-ball.finex;
ball_block_sound(240,5);
end;
{ ... e per quella superiore }
if(ball.y<SCRTOP) then
begin
ball.speedy:=-ball.speedy;
ball.y:=2*SCRTOP-ball.y;
ball.finey:=255-ball.finey;
ball_block_sound(240,5);
end;
{ se la palla si trova sull'ordinata del vaus, se la velocita' vy e'
maggiore di 0 (cioe' la palla si muove verso il basso), e se la
palla prima si trovava al di sopra del vaus, allora ...}
if(ball.y+BALLSPOT>VAUS_LINE) and (ball.speedy>0) and (ball.oldy<=VAUS_LINE) then
begin
{ se un qualsiasi punto della palla si trova sul vaus ... }
if(ball.x>vaus.x-BALLSPOT) and (ball.x<vaus.x+vaus.width+BALLSPOT) then
begin
{ inverte il vettore vy della velocita' della palla }
ball.speedy:=-ball.speedy;
if (vaus.letter=6) and (not ball.launch) then
begin
ball.stm:=0;
ball.launch:=TRUE;
ball.onvaus:=ball.x-vaus.x;
end;
ball_block_sound(300,6);
{ emette il suono d'urto palla-vaus }
{ se la palla urta il cilindretto rosso di sinistra del vaus }
if (ball.x<vaus.x+10) then
begin
{ inverte il vettore vx, velocita' x della palla }
ball.speedx:=-ball.speedx;
{ mette nella variabile angle l'angolo di movimento della palla
piu' un valore casuale di deviasione compreso fra 0 e BALLDEV }
angle:=get_ball_direction(ball)+random(BALLDEV);
{ re-imposta secondo questo nuovo angolo la direzione di movimento
della pallina. Comunque sia' l'angolo e' compreso fra 120 e 160
gradi. Valori superiori o inferiori a questo range vengono auto
maticamente riportati ai valori estremi del range stesso.
Ad esempio 175 gradi viene riportato a 160 gradi. }
set_ball_direction(ball,max(120,min(160,angle)));
{ re-imposta la velocita' della palla, perche' cambiando l'angolo
di movimento la velocita' viene perduta. }
set_ball_speed(ball,ball.speed);
end;
{ del tutto simile al precedente con la differenza che il discorso
viene fatto per il cilindretto rosso di destra. }
if (ball.x>vaus.x+vaus.width-10) then
begin
ball.speedx:=-ball.speedx;
angle:=get_ball_direction(ball)-random(BALLDEV);
set_ball_direction(ball,min(60,max(20,angle)));
set_ball_speed(ball,ball.speed);
end;
end;
end;
{ se la palla supera il vaus, senza che avvenga una collisione, vale
a dire: se entrambe, la vecchia e la nuova coordinata y sono maggiori
della dell'ordinata su cui scorre il vaus e la velocita' y della palla
e maggiore di 0, cioe' la palla si muove verso il basso, allora la palla
e' persa e il vaus viene fatto esplodere.}
if (ball.oldy>VAUS_LINE) and (ball.y>SCRBOT) and (ball.speedy>0) then
begin
ball.inplay:=FALSE; { per adesso viene solo settato il flag, palla non
piu' in gioco. }
remove_ball(ball); { e si cancella la palla dallo schermo }
end;
end;
procedure modify_vaus;
begin
vaus.oldlen:=vaus.width;
vaus.width :=playvaus.width; { larghezza del vaus }
vaus.height:=playvaus.height; { altezza del vaus }
end;
procedure set_vaus; { setta i parametri iniziali (di partenza) del vaus }
begin
vaus.x:=((SCRMAX-SCRMIN) shr 1)-8;
vaus.y:=VAUS_LINE;
vaus.oldx:=EMP; { le vecchie coordinate vengono poste a EMP }
vaus.oldy:=EMP; { poiche' il vaus non si e' spostato }
vaus.iflash:=0; { Questo viene incrementato ogni 1/70 sec. }
{ e quando arriva ad un certo valore viene }
{ azzerato e viene incrementato vaus.flash }
vaus.flash:=0; { Da questa var. dipende il colore dei }
{ dei bordini del vaus. }
{ (che cambia in continuazione) }
vaus.width :=playvaus.width; { larghezza del vaus }
vaus.height:=playvaus.height; { altezza del vaus }
vaus.oldlen:=vaus.width;
vaus.letter:=EMP;
{ entrambi sono contenuti nel file .BTM }
end;
procedure start_vaus;
begin
mouse_x_limit(SCRMIN*2,(SCRMAX-vaus.width-1) shl 1);
mousemove((SCRMAX-SCRMIN)-16,VAUS_LINE);
vaus.x:=((SCRMAX-SCRMIN) shr 1)-8;
vaus.y:=VAUS_LINE;
{ imposta il vaus al centro dell'area di gioco }
{ x=(x1+x2)/2 media fra il massimo e il minimo }
{ anche la freccina del mouse (che non si vede) }
{ viene portato al centro }
end;
procedure remove_vaus;
label L1,L2,L3;
var y,cnt : word;
begin
{ Toglie il vaus e disegna al suo posto lo sfondo }
for y:=vaus.oldy to (vaus.oldy+vaus.height) do
memcpy(addr(playscreen.map^[vaus.oldx+row[y]]),
addr(screen[vaus.oldx+row[y]]),vaus.oldlen);
vaus.oldlen:=vaus.width;
end;
procedure place_vaus;
var
x,y,cnt : word;
begin
inc(vaus.iflash); { viene incrementato ogni ciclo (1/70 sec.) }
if vaus.iflash>SPEEDFLASH then { se raggiunge il valore SPEEDFLASH... }
begin
inc(vaus.flash); { viene incrementato vaus.flash }
vaus.iflash:=0; { e viene riazzerato vaus.iflash }
end;
if vaus.flash>10 then vaus.flash:=0;
{ 10 sono i diversi colori che possono assumere i bordini del vaus }
{ dopodiche' il ciclo si ripete dall'inizio (cioe' da 0) }
{ Disegna il vaus facendo attenzione che i bordini (che hanno colore 255 }
{ nel disegno .BTM) devono essere sostituiti dal colore specificato da }
{ flash[vaus.flash], dove ovviamente flash[] e' una funzione dipendente da }
{ vaus.flash di cui sopra. Per esempio flash[2]:=211 (vedi all'inizio nella }
{ dichiarazione delle costanti. }
for y:=0 to vaus.height-1 do
begin
{ questa moltiplicazione viene fatta qui per non ripeterla }
{ vaus.width volte }
cnt:=y * vaus.width;
memzerocpy(addr(playvaus.map^[cnt]),addr(screen[vaus.x+row[y+vaus.y]]),vaus.width);
if (y>=2) and (y<(vaus.height-2)) then
begin
screen[vaus.x+row[y+vaus.y]]:=FLASH[vaus.flash];
screen[vaus.x+vaus.width-1+row[y+vaus.y]]:=FLASH[vaus.flash];
end;
end;
end;
{ muove il vaus alle coordinate x,y }
procedure move_vaus(x,y : integer);
begin
{ se le coordinate oldx,oldy sono valide allora bisogna cancellarlo }
{ da quella posizione }
if(vaus.oldx<>EMP) and (vaus.oldx<>vaus.x) or (vaus.width<>vaus.oldlen) then
remove_vaus;
vaus.oldx:=vaus.x; { le nuove coordinate diventano le vecchie }
vaus.oldy:=vaus.y;
{ le coordinate x,y diventano le nuove }
{ viene eseguito un clipping delle coordinate, cioe' se i valori ad }
{ esempio sono troppo alti, vengono settate al massimo valore accettabile }
{ analogamente per il minimo }
vaus.x:=max(SCRMIN,min(x,(SCRMAX-vaus.width)));
vaus.y:=max(SCRTOP,min(y,(SCRBOT-vaus.height)));
place_vaus; { chiama la funzione placevaus di cui sopra }
end;
{ togli un mattoncino dallo schermo }
procedure remove_block(xa,ya : integer);
var
x,y,
xs,ys : word;
yh,cl : integer;
shadow: integer;
begin
xs:=(xa shl 4)+9; { si calcola le coordinate sullo schermo }
ys:=(ya shl 3)+22; { del mattoncino es. 0,0 ---schermo---> 9,22 }
for y:=0 to 7 do
begin
yh:=pattern.width*mody[ys+y]; { calcola la coord. y relativa alla }
{ mattonella di sfondo che deve rim- }
{ piazzare il mattoncino che non c'e' }
{ piu' }
{ il mattoncino viene rimpiazzato col fondale, tuttavia il fondale }
{ potrebbe essere inscurito da un ombra proiettata da un altro }
{ mattoncino }
for x:=0 to 15 do
if (x+xs)<SCRMAX then
begin
{ calocla l'eventuale ombra proiettata da un altro mattoncino }
{ shadow:=128 nessuna ombra, shadow:=0 c'e' l'ombra }
shadow:=playscreen.map^[x+xs+row[y+ys]] and 128;
{ prende il pixel di sfondo e ci aggiunge l'ombra se necessario }
cl:=(pattern.map^[modx[x+xs]+yh] and 127) or shadow;
{ dopodiche' mette il colore sia sullo schermo della VGA sia }
screen[x+xs+row[y+ys]]:=cl;
{ sullo schermo ausiliario dove sono presenti solo gli oggetti }
{ statici e non quelli in movimento tipo pallina o vaus.}
playscreen.map^[x+xs+row[y+ys]]:=cl;
end;
end;
{ In ogni modo, con il mattoncino deve sparire anche la sua ombra }
{ l'ombra non e' altro che un rettangolino delle stesse dimensioni del }
{ mattoncino ma spostato rispetto a questo di 8 pixel sulla asse x, e 4 }
{ pixel sull'asse y, in altre parole lo spigolo dell'ombra coincide con }
{ il centro del mattoncino }
for y:=ys+4 to ys+12 do
for x:=xs+8 to xs+24 do
{ Occorre controllare che le coordinate non siano superiori a }
{ quelle del campo di gioco poiche' in tal caso non c'e' nessuna }
{ ombra da rimuovere poiche' l'ultimo mattoncino proietta un }
{ ombra parziale che non si riflette sul muro di lato }
{ Quindi sul muro di lato non c'e' da togliere nessuna ombra }
{ Lo stesso discorso non viene fatto per il minimo, poiche' }
{ l'ombra e' sempre piu' a destra e piu' in basso del mattone }
{ che la proietta, quindi nessun mattoncino puo' proiettare un }
{ ombra sulla parete di sinistra. Nondimeno nessun mattoncino }
{ e' talmente basso da proiettare un ombra sul vaus. }
{ Dunque il caso da tenere in considerazione e' solo x<SCRMAX }
if x<SCRMAX then
begin
{ prende il colore di sfondo e toglie l'ombra }
cl:=playscreen.map^[x+row[y]] or 128;
{ e lo memorizza sia sullo schermo fisico ...}
screen[x+row[y]]:=cl;
{ che su quello virtuale (cioe' quello che tiene solo }
{ gli oggetti fissi }
playscreen.map^[x+row[y]]:=cl;
end;
end;
procedure place_block(xa,ya,block : integer);
var
x,y,
xs,ys : word;
cl,cl2: integer;
shadow: integer;
begin
xs:=(xa shl 4)+9; { calcola le coordinate sullo schermo relativa }
ys:=(ya shl 3)+22; { al mattoncino xa,ya }
for y:=0 to 7 do
for x:=0 to 15 do
begin
{ controlla se alle coordinate specificate qualche mattoncino }
{ proietta un ombra }
shadow:=playscreen.map^[xs+x+row[ys+y]] and 128;
if (y<7) and (x<15) then
begin
{ se si tratta dell'interno del mattoncino, lo disegna del }
{ colore specificato in block }
cl:=(COLORBLOCK[(block-1) and 15] and 127) or shadow;
screen[xs+x+row[ys+y]]:=cl;
playscreen.map^[xs+x+row[ys+y]]:=cl;
end
else
begin
{ nel caso le coordinate si trovino sul bordo destro o }
{ inferiore, disegna i pixel in nero }
screen[xs+x+row[ys+y]]:=shadow; { sarebbe shadow or 0 }
playscreen.map^[xs+x+row[ys+y]]:=shadow; {...quindi shadow }
end;
end;
{ adesso disegna l'ombra del mattoncino }
for y:=ys+4 to ys+12 do
for x:=xs+8 to xs+24 do
if x<SCRMAX then { controlla come in remove_block che le coord }
{ non siano oltre alla parete di destra, poiche' }
{ l'ombra non viene proiettata su tale parete }
begin
{ preleva il pixel x,y dallo schermo e ci proietta sopra }
{ l'ombra. }
cl:=playscreen.map^[x+row[y]] and 127;
{ dopo di che lo rimette sullo schermo fisico... }
screen[x+row[y]]:=cl;
{ e su quello virtuale }
playscreen.map^[x+row[y]]:=cl;
end;
if block>8 then { ma se il blocco e' grigio (=9) o marrone (=10) ... }
begin
cl2:=0;
if (block and 15)=9 then
begin
cl2:=202; { il colore del mattoncino e' quello grigio }
wall[xa,ya]:=9+(GRAYDOWN shl 4); { e il numero del mattone e 9+16*n }
{ dove n+1 e' il numero di colpi necessari per abbatterlo }
{ es. wall[1,2]=9+(1*16)=25 significa che il mattoncino alle }
{ coord. 1,2 cade se colpito 2 volte }
end
else if block=10 then cl2:=201;
{ se il blocco e marrone il colore e' il n.201 }
{ disegna il bordo superiore del mattoncino }
for y:=0 to 6 do
begin
{ preleva il pixel xs,y+ys dallo schermo, ci mette l'ombra }
{ cioe' fa in modo che il colore sia di tonalita' scura }
cl:=playscreen.map^[xs+row[y+ys]] and 128;
cl2:=(cl2 and 127) or cl;
{ ... e lo rimette sullo schermo fisico }
screen[xs+row[ys+y]]:=cl2;
{ ... e su quello virtuale }
playscreen.map^[xs+row[ys+y]]:=cl2;
end;
{ disegna il bordo destro del mattoncino }
for x:=0 to 14 do
begin
{ commenti analoghi a sopra }
cl:=playscreen.map^[xs+x+row[ys]] and 128;
cl2:=(cl2 and 127) or cl;
screen[xs+x+row[ys]]:=cl2;
playscreen.map^[xs+x+row[ys]]:=cl2;
end;
end;
end;
procedure put_wall; { mette sullo schermo il muro contenuto in wall[x,y] }
var
x,y : integer;
begin
for y:=0 to 14 do
for x:=0 to 12 do
if wall[x,y]<>0 then place_block(x,y,wall[x,y]);
end;
procedure set_wall; { imposta il muro }
var x,y,wl : integer;
name : string;
begin
remain_blk:=0; { sono i blocchi da distruggere }
wl:=score.wall_n[cur_player]; { questo e' il muro a cui e' fermo il }
{ giocatore cur_player }
for y:=0 to 14 do { conta i blocchi distruttibili }
for x:=0 to 12 do { cioe' il blocco deve essere <>0 e <>10 }
{ poiche' 0 = nessun blocco, 10 = marrone }
if (wall[x,y]<>0) and (wall[x,y]<>10) then inc(remain_blk);
name:='PATTERN'+chr(48+((wl-1) mod PATNUMBER))+'.BTM';
{ name e' una stringa che contiene il nome del file di sfondo da caricare }
loadBTM(name,pattern,FALSE);
if not success then
fatal_error('Some Background files seems to be missing');
{ e quindi carica il file in questione }
end;
{ prende in entrata le coordinate di due punti e calcola i punti in cui il }
{ reticolo di mattoncini interseca il segmento congiungente i due punti. }
{ i punti di intersezione possono essere 1 o 2 }
function split_line(var x1,y1,x2,y2 : integer) : integer;
var
x,y,
xk,yk,
xj,yj,
xh,yh,
xn,yn,
xp1,yp1,
xp2,yp2,
xp,yp,
xa,ya,
collision : integer;
px1,px2,py1,py2 : longint;
s1,s : string;
begin
inc(x1,16); { incrementa le coordinate di tutti i punti }
inc(y1,24); { per evitare che nel corso delle operazioni }
inc(x2,16); { qualche coordinata diventi negativa }
inc(y2,24); { prima di terminare la proc. li rimette a posto }
collision:=0; { numero di intersezioni fra segmento e reticolo }
xp1:=x1 shr 4; { si calcola all'interno di quale mattoncino stanno }
yp1:=y1 shr 3; { i due punti in questione }
xp2:=x2 shr 4;
yp2:=y2 shr 3;
xk:=x1; { copia temporaneamente le coord. dei due punti }
yk:=y1; { in due vettori in modo da poter operare liberamente }
xj:=x2; { le coord. iniziali vengono passate per indirizzo }
yj:=y2; { e quindi non devono perdersi i valori }
xh:=x1;
yh:=y1;
xn:=x2;
yn:=y2;
{ Se e' vero questo "if" vuol dire che c'e' un baco nel programma }
{ e quindi il gioco quit-ta all'istante segnalando l'errore. }
{ Tale errore si verifica facilmente se si pone MAXSPEED >> 2000 }
if (abs(x1-x2)>16) or (abs(y2-y1)>8) then
fatal_error('Ball speed exceed program capability');
if (xp1<>xp2) or (yp1<>yp2) then { se i due punti non coincidono... }
begin
if (yp1<>yp2) then { se i due punti hanno diversa y }
begin
collision:=collision or 1; { il bit piu' basso viene messo a 1 }
while ((yn and 7)<>0) and ((yn and 7)<>7) do
begin
x:=(xh+xn) shr 1; { dopo di che continua a dividere il segmento }
y:=(yh+yn) shr 1; { (x1,y1)-(x2,y2) finche non trova un inter- }
{ sezione con un reticolo }
yp:=y shr 3;
if yp=yp1 then { dei tre punti (due sono gli estremi del }
begin { segmento) ne scarta uno con lo stesso }
xh:=x; { principio del teorema di Weierstrass. }
yh:=y;
end;
if yp=yp2 then { Il punto di mezzo sostituisce cioe' uno }
begin { dei due estremi in modo che il segmento }
xn:=x; { sia ancora a cavallo del reticolo. }
yn:=y;
end;
end;
end;
if (xp1<>xp2) then { se i due punti hanno diversa coord. x ... }
begin
collision:=collision or 2; { in questo caso setta il secondo bit }
while ((xj and 15)<>0) and ((xj and 15)<>15) do
begin
x:=(xk+xj) shr 1; { e i passi sono analoghi per le x }
y:=(yk+yj) shr 1;
xp:=x shr 4;
if xp=xp1 then
begin
xk:=x;
yk:=y;
end;
if xp=xp2 then
begin
xj:=x;
yj:=y;
end;
end;
end;
{ vengono ri-assegnati i valori agli estremi a seconda di quali }
{ porzioni del programma sono state eseguite sopra }
if collision=1 then { ovvero le due x uguali, le due y diverse }
begin
x2:=xn;
y2:=yn;
end
else if collision=2 then { le due x diverse, le due y uguali }
begin
x2:=xj;
y2:=yj;
end
else if collision=3 then { sia le due x che le due y diverse }
begin
x1:=xj; { in questo caso le intersezioni sono 2 }
y1:=yj; { e la procedura li restituisce in (x1,y1) }
x2:=xn; { (x2,y2). }
y2:=yn;
end;
end
else fatal_error('Ball seems to be still');
{ altrimenti qualcosa e' andato storto! }
dec(x1,16); { ripristina le vecchie coordinate }
dec(y1,24);
dec(x2,16);
dec(y2,24);
x1:=min(207,max(0,x1));
x2:=min(207,max(0,x2));
{ per la y non vengono tagliate le coordinate <0 e >120 poiche' la }
{ matrice che li contiene e' virtualmente piu' lunga per ragioni di }
{ sicurezza e per coord. non valide non si trova alcun mattoncino da }
{ urtare. Il clipping in questo caso e' piu' semplice. }
split_line:=collision;
end;
{ Considera colpito il blocco xb,yb: se e' un blocco normale lo toglie,
se e' un grigio che resiste a piu' colpi ne decrementa la resistenza.
Se il blocco non viene abbattuto allora lo fa luccicare. }
procedure shoot_block(xb,yb : integer; var ball : BALLTYPE);
begin
{ Controlla che le coordinate del blocco siano numeri validi... }
if (xb>=0) and (xb<=12) and (yb>=0) and (yb<=14) then
begin
if wall[xb,yb]<>0 then { ... che ci sia un blocco da colpire... }
begin
if wall[xb,yb]<10 then { se il blocco puo' essere abbattuto... }
begin
remove_block(xb,yb); { ..lo toglie dallo schermo }
dec(remain_blk); { ..decrementa il numero di blocchi che restano }
{ Incrementa lo SCORE del giocatore attuale a seconda }
{ del blocco colpito (i punti sono nell'array in SCORE_WALL) }
inc(score.player[cur_player],SCORE_WALL[wall[xb,yb]]);
inc(lett.incoming,random(LETTER_PROB));
with lett do
begin
nextx:=(xb shl 4)+9;
nexty:=((yb+1) shl 3)+22;
nexttype:=random_letter_drop;
end;
wall[xb,yb]:=0; { il blocco viene cancellato }
ball_block_sound(440,3); { emette un LA (nota musicale) }
ball.sbd:=0; { azzera il contatore di deviazione }
ball.brwhit:=0; { e il cont. di dev. di emergenza }
end
else { se il blocco e marrone, o un grigio che non cade subito }
begin
if (wall[xb,yb] and 15)=9 then { ...se e' grigio... }
begin
ball.brwhit:=0; { azzera il cont. di dev. di emergenza }
dec(wall[xb,yb],16); { decrementa la resistenza del blocco }
ball_block_sound(370,4);{ Emette un Fa# (nota musicale) }
shine(xb,yb); { e imposta il luccichio del blocco }
end
else
begin
inc(ball.brwhit); { incrementa il cont. di dev. di emergenza }
shine(xb,yb); { imposta il luccichio }
ball_block_sound(200,7); { ed emette una nota piuttosto bassa }
end;
end;
end;
end;
end;
{ Simile a quella prima ma per la collisione fire_blocco }
procedure shoot_block_with_fire(xb,yb : integer);
begin
if (xb>=0) and (xb<=12) and (yb>=0) and (yb<=14) then
begin
if wall[xb,yb]<>0 then { ... che ci sia un blocco da colpire... }
begin
if wall[xb,yb]<10 then { se il blocco puo' essere abbattuto... }
begin
remove_block(xb,yb); { ..lo toglie dallo schermo }
dec(remain_blk); { ..decrementa il numero di blocchi che restano }
inc(score.player[cur_player],SCORE_WALL[wall[xb,yb]]);
wall[xb,yb]:=0; { il blocco viene cancellato }
ball_block_sound(440,3); { emette un LA (nota musicale) }
end
else { se il blocco e marrone, o un grigio che non cade subito }
begin
if (wall[xb,yb] and 15)=9 then { ...se e' grigio... }
begin
dec(wall[xb,yb],16); { decrementa la resistenza del blocco }
ball_block_sound(370,4);{ Emette un Fa# (nota musicale) }
shine(xb,yb); { e imposta il luccichio del blocco }
end
else
begin
shine(xb,yb); { imposta il luccichio }
ball_block_sound(200,7); { ed emette una nota piuttosto bassa }
end;
end;
end;
end;
end;
procedure ball_hit_block(var ball : BALLTYPE);
var x,y,z : integer;
xb,yb : integer;
x1,y1 : array[0..4] of integer;
a,b,
ox,oy,
lx,ly,
mx,my,
nx,ny,
f1,f2,
collision: integer;
betaflag : boolean;
touch : integer;
adjw : array[0..2,0..2] of integer;
deflect,
around,
emergency,
mimax,
angle,
myx,myy : integer;
begin
emergency:=EMP; { l'indicatore di rimbalzo di emergenza }
nx:=ball.x-9; { nx,ny hanno le coordinate della palla rispetto }
ny:=ball.y-22; { all'origine fissata nell'angolo Nord-Ovest del }
{ campo di gioco (entro cui si muove la palla). }
ox:=ball.oldx-9; { idem per le vecchie coordinate, l'origine e' }
oy:=ball.oldy-22; { quindi il punto dello schermo (9,22). }
xb:=nx shr 4; { xb,yb sono le coordinate del blocco (eventualmente }
yb:=ny shr 3; { ipotetico) su cui si trova ora la pallina. }
{ Ricordarsi che (0,0) e' il blocco in altro a destra }
if wall[xb,yb]<>0 then { ...se il blocco non e' ipotetico ma esiste }
begin
collision:=split_line(ox,oy,nx,ny);
{ calcola l'intersezione del segmento che unisce le vecchie alle }
{ nuove coordinate. "Collision" contiene un valore che dipende dal }
{ tipo di intersezioni riscontrate fra il segmento e la griglia dei }
{ blocchi. }
if collision=3 then { se sono avvenute due collisioni... }
begin
lx:=ball.oldx-ox-9; { si calcola la distanza della vecchia }
ly:=ball.oldy-oy-22; { coordinata dal punto di intersezione 1 }
mx:=ball.oldx-nx-9; { e dal punto di intersezione 2 }
my:=ball.oldy-ny-22;
f1:=lx*lx+ly*ly; { indi sceglie fra i due il punto di }
f2:=mx*mx+my*my; { intersezione piu' vicino alle vecchie coord. }
if (f1<f2) then { f1 e f2 sono il quadrato del modulo del }
{ vettore distanza (vedi sopra) }
{ Si considera il caso in cui l'intersezione piu' vicina sia }
{ la numero 1. }
begin
xb:=min(12,max(ox shr 4,0)); { Vengono assegnate le coord. }
yb:=((oy+24) shr 3)-3; { del blocco relative a tale }
{ intersezione. }
if wall[xb,yb]=0 then { Se non vi e' alcun blocco }
begin
xb:=min(12,max(0,nx shr 4)); { Allora l'urto avviene sull' }
yb:=((ny+24) shr 3)-3; { altra intersezione. La n.2 }
end
else
begin { Se invece il blocco esiste }
nx:=ox; { allora alle nuove coord. si }
ny:=oy; { assegna il punto di inter- }
{ sezione contenuto nelle vec-}
{ chie. }
end;
end
else
begin
{ Nel caso sia la seconda intersezione piu' vicina alle }
{ vecchie coord. si procede analogamente. }
xb:=min(12,max(0,nx shr 4)); { Si calcolano le coord. del blocco }
yb:=((ny+24) shr 3)-3; { sull'intersezione nx,ny (la seconda) }
if wall[xb,yb]=0 then { Se il blocco non c'e'... }
begin
nx:=ox; { allora l'intersezione valida e' }
ny:=oy; { l'altra, e si procede... }
xb:=min(12,max(0,nx shr 4)); { ...riassegnando alle nuove }
yb:=((ny+24) shr 3)-3; { coord. l'intersezione n.1 }
end;
end;
end;
ball.x:=nx+9; { Le nuove coordinate della palla sono quelle }
ball.y:=ny+22; { contentenute nelle variabili nx,ny, ritraslando }
{ gli assi. nx,ny avevano i relativi assi centrati }
{ in (9,22). }
shoot_block(xb,yb,ball); { abbatte il blocco in questione }
x:=(nx and 15) shr 1; { si calcola il punto d'urto della palla }
y:=(ny and 7); { rispetto al mattoncino. }
{ Dividendo per 2 la coord. x dell'urto si ottiene una sezione d'urto }
{ su di un mattone quadrato invece che rettangolare che semplifica in }
{ seguito i calcoli. Il mattone e' infatti di 16x8 pixel dividendo }
{ per 2 diventa di 8x8 pixel, e i calcoli sulle diagonali sono piu' }
{ semplici. }
{ Se l'urto non avviene su uno dei bordi del mattone allora vuole }
{ dire che qualcosa e' andato storto. In teoria non dovrebbe mai }
{ verificarsi. }
if (x<>0) and (x<>7) and (y<>0) and (y<>7) then
fatal_error('Ball hit a block not on its surface');
{ Questi sono i valori che assume EMERGENCY a seconda del punto d'urto }
{ 5 1 8 }
{ ----------- }
{ 2 | mattone | 4 }
{ ----------- }
{ 6 3 7 }
{ Se la palla urta il bordo superiore del mattoncino... }
if (y<x) and (x<7-y) then
begin
ball.speedy:=-ball.speedy; { Si inverte la coord. y della vel. }
emergency:=1; { e segna l'eventiale punto di contatto }
end;
{ ...il bordo inferiore... }
if (7-y<x) and (x<y) then
begin
ball.speedy:=-ball.speedy; { inverte la y della vel. }
emergency:=3;
end;
{ ...il bordo sinistro... }
if (x<y) and (y<7-x) then
begin
ball.speedx:=-ball.speedx; { inverte la x della vel. }
emergency:=2;
end;
{ ... e quello destro ... }
if (7-x<y) and (y<x) then
begin
ball.speedx:=-ball.speedx; { inverte la x della vel. }
emergency:=4;
end;
{ ... se invece avviene su uno dei quattro spigoli ... }
if (x=y) or (x=7-y) then
begin
deflect:=$00;
touch:=0;
{ touch assume valori diversi a seconda dello spigolo }
{ Segue la tabella (per es. 0 = angolo in alto a sinistra) }
{ 0 1 }
{ 2 3 }
if x>4 then touch:=touch or 1;
if y>4 then touch:=touch or 2;
{ Qui riempie una matrice 3x3 con degli 1 o degli 0 a seconda che }
{ attorno al blocco urtato rispettivamente vi siano o no altri }
{ mattoncini }
{ I bordi sinistro e destro del campo di gioco vengono considerati }
{ come mattoncini indistruttibili in questo caso. }
for lx:=-1 to 1 do
for ly:=-1 to 1 do
begin
mx:=max(min(xb+lx,12),0); { quando si fa rif. alla x la }
my:=yb+ly; { coord deve essere compresa }
{ fra 0 e 12. }
if ((xb+lx)<0 ) or
((xb+lx)>12) or
(wall[mx,my]<>0) then
adjw[lx+1,ly+1]:=1 { Vi sono mattoncini }
else
adjw[lx+1,ly+1]:=0; { Non vi sono mattoncini }
end;
{ Around contiene un valore che in binario rappresenta lo stato }
{ dei mattoncini che stanno attorno al mattone urtato. }
{ ------------- }
{ | 1 | 2 | 4 | }
{ ------------- }
{ |128| U | 8 | U = mattone urtato }
{ ------------- }
{ | 64| 32| 16| }
{ ------------- }
{ Es. se attorno ad U si trovano i mattoncini 1,2,128 il valore }
{ di around e' 1+2+128=131. }
around:=adjw[0,0]+(adjw[1,0] shl 1)+
(adjw[2,0] shl 2)+(adjw[2,1] shl 3)+
(adjw[2,2] shl 4)+(adjw[1,2] shl 5)+
(adjw[0,2] shl 6)+(adjw[0,1] shl 7);
{ Deflect contiene un valore che in esadecimale rappresenta le }
{ modifiche da apportare alla vx (prima cifra esadec.) e alla }
{ y (seconda cifra esadec.). Secondo la seguente tabella. }
{ 0 = coordinata inalterata }
{ 1 = '' negativa }
{ 2 = '' positiva }
{ 3 = '' invertita }
{ Es. Deflect:=$13 significa poni vx negativo e inverti vy }
{ Deflect:=$20 significa poni vx positivo e lascia stare vy }
{ ------------------------------------------------------------- }
{ Seguono le combinazioni caso per caso dello spigolo urtato, dei }
{ mattoni che questo a attorno e di conseguenza ricava la direzione }
{ della palla. }
{ l'and logico significa considera solo i mattoni la cui somma }
{ da il numero che segue. }
{ Per es. "and 131" significa considera solo i mattoni 1+2+128 }
{ gli altri se ci sono o no non importa. }
if touch=0 then { spigolo in alto a sinistra }
begin
if (around and 131)=0 then deflect:=$11;
if (around and 131)=1 then deflect:=$33;
if (around and 131)=2 then deflect:=$10;
if (around and 131)=3 then deflect:=$12;
if (around and 131)=128 then deflect:=$01;
if (around and 131)=129 then deflect:=$21;
if (around and 131)=130 then deflect:=$11;
emergency:=5;
shoot_block(xb-1,yb-1,ball);
end;
{ "and 14" sono i mattoni 2+4+8, gli altri non importa }
if touch=1 then { spigolo in altro a destra }
begin
if (around and 14)=0 then deflect:=$21;
if (around and 14)=2 then deflect:=$20;
if (around and 14)=4 then deflect:=$33;
if (around and 14)=6 then deflect:=$22;
if (around and 14)=8 then deflect:=$01;
if (around and 14)=10 then deflect:=$21;
if (around and 14)=12 then deflect:=$11;
emergency:=8;
shoot_block(xb+1,yb-1,ball);
end;
if touch=2 then { Spigolo in basso a sinistra }
begin
if (around and 224)=0 then deflect:=$12;
if (around and 224)=32 then deflect:=$10;
if (around and 224)=64 then deflect:=$33;
if (around and 224)=96 then deflect:=$11;
if (around and 224)=128 then deflect:=$02;
if (around and 224)=160 then deflect:=$12;
if (around and 224)=192 then deflect:=$22;
emergency:=6;
shoot_block(xb-1,yb+1,ball);
end;
if touch=3 then { Spigolo in basso a destra }
begin
if (around and 56)=0 then deflect:=$22;
if (around and 56)=8 then deflect:=$02;
if (around and 56)=16 then deflect:=$33;
if (around and 56)=24 then deflect:=$12;
if (around and 56)=32 then deflect:=$20;
if (around and 56)=40 then deflect:=$22;
if (around and 56)=48 then deflect:=$21;
emergency:=7;
shoot_block(xb+1,yb+1,ball);
end;
{ La prima cifra hex (esadecimale) viene messa in myx }
{ e la seconda in myy. }
myx:=deflect shr 4;
myy:=deflect and 15;
if myx=1 then ball.speedx:=-abs(ball.speedx);
if myx=2 then ball.speedx:= abs(ball.speedx);
if myx=3 then ball.speedx:=- ball.speedx ;
if myy=1 then ball.speedy:=-abs(ball.speedy);
if myy=2 then ball.speedy:= abs(ball.speedy);
if myy=3 then ball.speedy:=- ball.speedy ;
end;
end;
{ Nel caso che il numero di mattoni indistruttibili urtati consecutivamente }
{ prima di urtare un mattone di un altro tipo superi una determinata soglia }
if ball.brwhit>MAXBRWHIT then
begin
{ Se emergency e' rimasto a EMP significa che qualcosa e' andato storto }
if emergency=EMP then fatal_error('No collisions detected');
mimax:=EMERG_DEV[emergency]; { Altrimenti si calcola la deviazione }
{ massima e minima del mattoncino. }
{ e a seconda di quale spigolo viene urtato e di come sono i mattoni }
{ attorno a tale spigolo, la deviazione viene modificata. }
{ Per quanto il rimbalzo finale possa essere strano, questo controllo }
{ viene fatto per evitare che la palla si incastri in un loop infinito }
{ ovviamente il caso vale per i mattoni indistruttibili perche' gli }
{ altri prima o poi cadono e quindi non possono bloccare la palla }
{ per un tempo infinito. }
{ Ogni cifra hex di mimax esprime un angolo a multipli di 90 gradi }
{ la prima cifra e' l'angolo minimo, la seconda quello massimo. }
{ Es. MIMAX:=$03; singifica angolo minimo 0*90 = 0 gradi, angolo max }
{ 3*90 = 270 gradi, e cosi' via... }
{ una scrittura del tipo "mimax:=mimax and $0f or 10" significa }
{ metti a 1 la prima cifra di mimax indipendentemente da quanto }
{ vale adesso, lasciando inalterata la seconda. }
{ Analogo il ragionamento per "... and $f0 or $03" che agisce }
{ sulla seconda cifra invece che sulla prima... }
case emergency of
5: begin
if adjw[1,0]=0 then mimax:=mimax and $0f or $00;
if adjw[0,1]=0 then mimax:=mimax and $f0 or $03;
end;
6: begin
if adjw[0,1]=0 then mimax:=mimax and $0f or $10;
if adjw[1,2]=0 then mimax:=mimax and $f0 or $04;
end;
7: begin
if adjw[1,2]=0 then mimax:=mimax and $0f or $20;
if adjw[2,1]=0 then mimax:=mimax and $f0 or $05;
end;
8: begin
if adjw[2,1]=0 then mimax:=mimax and $0f or $30;
if adjw[1,0]=0 then mimax:=mimax and $f0 or $06;
end;
end;
repeat
lx:=90*(mimax shr 4); { la prima cifra di mimax viene posta in }
mx:=90*(mimax and 15); { lx e la seconda in mx. }
angle:=random(mx-lx)+lx; { L'angolo e' una variabile casuale fra }
{ lx e mx }
until ((angle mod 90)>30) and ((angle mod 90)<60);
{ e questo ciclo si ripete finche' la palla ha un inclinazione }
{ compresa fra i 30 e i 60 gradi piu' multipli di 90 gradi. }
set_ball_direction(ball,angle mod 360);
set_ball_speed(ball,ball.speed);
ball.brwhit:=0; { Azzera il contatore di emergenza }
end;
end;
{ Disegna il fondale sul terreno di gioco }
procedure fill_picture_with_pattern(var patt : BTMTYPE);
var x,y,
cl,
shadow,
yb : integer;
begin
{ Si calcola a priori tutti i valori di x mod patt.width }
{ patt.width = larghezza del quadrattino che definisce lo sfondo }
for x:=0 to 319 do
modx[x]:=x mod patt.width;
{ analogamente per y mod patt.height }
for y:=0 to 199 do
mody[y]:=y mod patt.height;
{ Esegue il ciclo principale e il ciclo secondario che riempiono lo }
{ schermo con tanti quadretti di sfondo quanti sono necessari }
for y:=SCRTOP-2 to SCRBOT-2 do
begin
yb:=mody[y]*patt.width;
for x:=SCRMIN-1 to SCRMAX-1 do
begin
cl:=patt.map^[modx[x]+yb]; { Prende il pixel dallo sfondo }
shadow:=128; { Shadow = 128 -> ombra non presente }
{ Fa l'ombra sul fianco sinistro e superiore dello schermo }
{ E' l'ombra proiettata dal bordo metallico sullo sfondo di }
{ gioco. }
if (y<16) or (x<18) then shadow:=0; { Shadow=0 -> ombra presente }
{ Disegna il pixel sullo schermo con l'eventuale ombra }
playscreen.map^[x+row[y]]:=(cl and 127) or shadow;
end;
end;
end;
{ Carica tutti i muri contenuti nel file WHWALLS.BTM }
procedure load_all_walls;
var
s : string;
f1 : text;
x,
y,
z,
w : integer;
loop : boolean;
begin
loop:=TRUE;
assign(f1,'whwalls.dta'); { Apre il file }
reset(f1); { si porta all'inizio dello stesso }
x:=0; { coordinata x del mattoncino attuale-3 }
y:=0; { coordinata y del mattoncino attuale }
z:=0; { numero del muro attuale-1 }
while(loop) do
begin
s:=' ';
readln(f1,s);
if s[1]='*' then { Se il primo carattere della riga e' un asterisco }
begin
if (y>14) then fatal_error('Too many blocks');
for x:=3 to 15 do { Allora dal terzo al 15 vi sono i 13 blocchi }
begin { che costituiscono la fila }
w:=ord(s[x])-96; { Se e' un "a" (codice 97) allora w:=1 }
if w<0 then w:=0;
all_walls[z][x-3,y]:=w; { Quindi all_walls contiene tutti }
end; { i muri. z=numerod del muro. }
inc(y); { Passa alla fila successiva }
for x:=0 to 12 do { Le due file estreme sono sempre vuote }
begin { vale a dire [x,-1] e [x,15] }
all_walls[z][x,-1]:=0;
all_walls[z][x,15]:=0;
end;
end
else if s[1]=';' then { Il ";" indica che si intende passare al }
begin { prossimo muro. }
x:=0;
y:=0;
if (z>32) then fatal_error('Too many walls');
inc(z);
end
else if s[1]='/' then loop:=false;
{ lo slash indica la fine logica del file, tutto cio' che segue }
{ viene ignorato. }
{ Qualunque riga incominci con un carattere diverso da ";" "*" "/" }
{ viene considerata una linea di commento e viene pertanto ignorata }
end;
close(f1);
totalwall:=z;
end;
procedure write_round_level;
var x,y : integer; { Stampa la scritta ROUND xx, READY. }
s,r, { eventualmente anche il nome del giocatore }
sc : string[20]; { cioe' PLAYER ONE o PLAYER TWO. }
begin
settextstyle(DefaultFont,HorizDir,1);
str(score.wall_n[cur_player]:2,s);
r:='Round '+s;
sc:='';
if score.pl_numb=2 then { Nel caso di 2 giocatori, occorre anche }
begin { dire a chi tocca. }
if cur_player=1 then sc:='Player One'
else sc:='Player Two';
end;
setcolor(0); { Stampa le scritte in nero }
for x:=0 to 2 do { come contorno spostandole }
for y:=0 to 2 do { di una coordinata in tutte }
begin { le direzioni. }
outtextxy(72+x,129+y,sc);
outtextxy(80+x,139+y,r);
outtextxy(90+x,149+y,'Ready');
end;
setcolor(1); { E poi centrata, in bianco stampa }
outtextxy(73,130,sc); { la scritta vera e propria. }
outtextxy(81,140,r);
outtextxy(91,150,'Ready');
end;
procedure remove_round_level; { Togli la scritta ROUND xx, READY }
var x,y : word; { copiandoci sopra il fondale. }
begin
for y:=129 to 160 do
memcpy(addr(playscreen.map^[72+row[y]]),
addr(screen[72+row[y]]),88);
end;
{ Stampa la scitta GAME OVER }
procedure Game_over;
var x,y : integer;
sc : string[20];
begin
settextstyle(DefaultFont,HorizDir,1); { Setta la font di default }
sc:='';
if score.pl_numb=2 then { Se vi sono 2 giocatori }
begin { deve dire quale dei due }
if cur_player=1 then sc:='Player One' { ha finito. }
else sc:='Player Two'; { E mette in sc "PLAYER ... " }
end; { altrimenti sc rimane vuoto }
setcolor(0);
for x:=0 to 2 do
for y:=0 to 2 do
begin { Disegna la scritta in }
outtextxy(72+x,129+y,sc); { nero spostata di una }
outtextxy(76+x,139+y,'Game Over'); { coord. in tutte le direz.}
end;
setcolor(1); { E poi al centro delle scritte in nero }
outtextxy(73,130,sc); { stampa quella in bianco. }
outtextxy(77,140,'Game Over');
mydelay(500);
remove_round_level; { in questo caso rimuove la scritta GAME OVER }
{ invece della scritta ROUND xx, READY. }
end;
{ Mostra in sequenza i fotogrammi del vaus che si distrugge. }
procedure destroy_vaus;
var x,y,z,w : word;
a,b : word;
begin
playvaus:=normal;
modify_vaus;
move_vaus(vaus.x,vaus.y);
a:=vaus.x-4; { Si calcola uno spostamento dovuto al brush }
b:=vaus.y-5; { dell'animazione che e' leggermente spostato }
{ dall'origine degli assi. }
for w:=0 to 6 do { w = fotogramma da mostrare, li cicla tutti da 0 a 6 }
begin
for y:=0 to 15 do
begin
z:=y*explosion.width+w*(explosion.width shl 4);
for x:=0 to explosion.width-1 do
begin
{ Se il colore e' trasparente o il fotogramma e' il 6 }
{ allora viene usato il colore del fondale. }
if (w=6) or (explosion.map^[x+z]=0) then
screen[x+a+row[y+b]]:=playscreen.map^[x+a+row[y+b]]
else
screen[x+a+row[y+b]]:=explosion.map^[x+z];
end;
end;
death_sound(w); { Il cicalino di quando il vaus viene distrutto }
{ per ogni valore di w c'e' una nota diversa }
end;
death_sound(7);
mydelay(150); { attende qualche istante. }
disable_letter; { se nel frattempo stava scendendo una lettera, }
{ la toglie. }
end;
{ E' esattamente come quella di prima, soltanto che mostra l'animazione }
{ del vaus che si costruisce. }
procedure create_vaus;
var x,y,z,w : word;
a,b : word;
begin
nosound;
a:=((SCRMAX-SCRMIN) div 2)-12;
b:=vaus_line-5;
for w:=11 downto 0 do
begin
for y:=0 to 15 do
begin
z:=y*newvaus.width+w*(newvaus.width*16);
for x:=0 to newvaus.width-1 do
begin
if (newvaus.map^[x+z]=0) then
screen[x+a+row[y+b]]:=playscreen.map^[x+a+row[y+b]]
else
screen[x+a+row[y+b]]:=newvaus.map^[x+z];
end;
end;
mydelay(1);
end;
end;
procedure put_digit(px,py,num : word); { Stampa la cifra digitale num }
{ alle coord. px,py. }
var x,y,a : word;
begin
a:=222; { Il colore 222 e' il rosso scuro che viene usato se il led }
{ in questione deve apparire spento. }
{ Mentre il colore 223 e' il rosso vivo di quando il led e' }
{ acceso. }
{ ----------------- }
{ | 0 | }
{ ----------------- }
{ | | | | }
{ | 3 | | 5 | }
{ | | | | }
{ | | | | }
{ ----------------- }
{ | 1 | }
{ ----------------- }
{ | | | | }
{ | 4 | | 6 | }
{ | | | | }
{ | | | | }
{ ----------------- }
{ | 2 | }
{ ----------------- }
{ Bit 0 }
if (DIGITS[num] and 1)=1 then a:=223; { Se il bit 0 e' 1 allora }
for x:=1 to 4 do { il colore del led in altro }
screen[px+x+row[py]]:=a; { e' rosso vivo, altrimenti }
{ rosso scuro. }
{ Bit 1 }
a:=222; { "a" viene assunto come rosso scuro }
if (DIGITS[num] and 2)=2 then a:=223; { eventualmente viene poi cambiato }
for x:=1 to 4 do
screen[px+x+row[py+5]]:=a; { py+5 perche' il trattino in mezzo }
{ e' 5 pixel piu' sotto di quello }
{ in altro. }
{ Bit 2 }
a:=222;
if (DIGITS[num] and 4)=4 then a:=223;
for x:=1 to 4 do
screen[px+x+row[py+10]]:=a;
{ Bit 3 }
a:=222;
if (DIGITS[num] and 8)=8 then a:=223;
for y:=1 to 4 do
screen[px+row[py+y]]:=a;
{ Bit 4 }
a:=222;
if (DIGITS[num] and 16)=16 then a:=223;
for y:=1 to 4 do
screen[px+row[py+y+5]]:=a;
{ Bit 5 }
a:=222;
if (DIGITS[num] and 32)=32 then a:=223;
for y:=1 to 4 do
screen[px+5+row[py+y]]:=a;
{ Bit 6 }
a:=222;
if (DIGITS[num] and 64)=64 then a:=223;
for y:=1 to 4 do
screen[px+5+row[py+y+5]]:=a;
end;
{ Stampa le 5 cifre del punteggio alle coordinate px,py }
procedure write_score(px,py : integer; sc : longint);
var n1 : longint;
f : boolean;
begin
f:=false; { Finche' questo rimane a false, gli 0 non vengono stampati }
{ Questo per far si che' all'inizio il punteggio sia 0 e non }
{ 000000 che sta male. }
{ prima cifra digitale }
n1:=(sc div 100000) mod 10;
if n1>0 then f:=true; { Se la prima cifra e' >0 allora }
if f then put_digit(px,py,n1) { occorre stamparla }
else put_digit(px,py,10); { altrimenti stampa un numero spento }
{ seconda cifra digitale }
n1:=(sc div 10000) mod 10; { Idem per i restanti blocchi }
if n1>0 then f:=true;
if f then put_digit(px+7,py,n1)
else put_digit(px+7,py,10);
{ terza cifra digitale }
n1:=(sc div 1000) mod 10;
if n1>0 then f:=true;
if f then put_digit(px+14,py,n1)
else put_digit(px+14,py,10);
{ quarta cifra digitale }
n1:=(sc div 100) mod 10;
if n1>0 then f:=true;
if f then put_digit(px+21,py,n1)
else put_digit(px+21,py,10);
{ quinta cifra digitale }
n1:=(sc div 10) mod 10;
put_digit(px+28,py,n1);
{ sesta e ultima cifra digitale (che ovviamente e' sempre 0 perche' }
{ il punteggio viaggia a multipli di 10 punti. }
put_digit(px+35,py,0);
end;
{ Quando si richiama la pausa il controllo passa a questa procedura }
procedure pause_game;
var x,y,z : integer;
begin
nosound; { disattiva qualunque suono del cicalino }
setcolor(0); { Stampa la scritta in nero spostandola }
for x:=0 to 2 do { in tutte le direzioni. }
for y:=0 to 2 do
outtextxy(66+x,129+y,'Game Paused');
setcolor(1); { Indi stampa quella in bianco }
outtextxy(67,130,'Game Paused');
repeat
z:=inkey; { e aspetta finche' non viene premuto }
until (z=ord('p')) or (z=32); { o la "p" o lo spazio (z=32) }
{ Cancella la scritta ricopiandoci sopra il fondale }
for y:=129 to 140 do
memcpy(addr(playscreen.map^[66+row[y]]),
addr(screen[66+row[y]]),textwidth('Game Paused')+1);
{ textwidth('Game Paused') e' una funziona che ritorna la lunghezza }
{ in pixel della scritta 'Game Paused'. }
end;
{ Stampa i vaus piccolini in basso a sinistra che indicano il numero di }
{ vite che restano disponibili (senza contare quella in gioco). }
procedure plot_lives(lives : integer);
const XLIVES = 11;
YLIVES = 192;
var x,y,cn,
xp,yp,
xl,yl : word;
shadow : integer;
begin
dec(lives); { Il numero di vite deve essere decrementato di uno }
{ perche' non va contata quella in gioco. }
for cn:=0 to 7 do { al massimo ne disegna 8 }
for y:=0 to minivaus.height-1 do
for x:=0 to minivaus.width-1 do
begin
xl:=x+XLIVES+cn*minivaus.width;
yl:=y+YLIVES;
xp:=modx[xl];
yp:=mody[yl]*pattern.width;
{ se il numero di vite e maggiore del contatore }
{ allora disegna un vaus. }
if (lives>cn) and (minivaus.map^[x+y*minivaus.width]<>0) then
begin
screen[xl+row[yl]]:=minivaus.map^[x+y*minivaus.width];
playscreen.map^[xl+row[yl]]:=minivaus.map^[x+y*minivaus.width];
end
{ altrimenti ricopia il fondale dello schermo in modo che }
{ se il vaus era presente viene ora cancellato. }
else
begin
shadow:=playscreen.map^[xl+row[yl]] and 128;
screen[xl+row[yl]]:=(pattern.map^[xp+yp] and 127) or shadow;
playscreen.map^[xl+row[yl]]:=(pattern.map^[xp+yp] and 127) or shadow;
end;
end;
end;
procedure place_fire;
var y,fw : word;
begin
for y:=0 to shoots.height-1 do
begin
fw:=shoots.width*y;
memzerocpy(addr(shoots.map^[fw]),
addr(screen[fire.x+row[y+fire.y]]),shoots.width);
end;
end;
procedure remove_fire;
var y,fw : word;
begin
for y:=0 to shoots.height-1 do
begin
fw:=shoots.width*y;
memcpy(addr(playscreen.map^[fire.x+row[y+fire.y]]),
addr(screen[fire.x+row[y+fire.y]]),shoots.width);
end;
end;
procedure check_fire;
var x1,x2,y1,y2 : word;
begin
if (fire.avl) then
begin
if (mouseclick=1) and (fire.avl) and (not fire.shot) then
begin
fire.x:=vaus.x+(vaus.width-shoots.width) shr 1;
fire.y:=vaus.y-shoots.height;
fire.shot:=TRUE;
fire.nw :=FALSE;
ball_block_sound(700,5);
end;
if fire.shot then
begin
if fire.nw then remove_fire;
fire.nw:=TRUE;
dec(fire.y,4);
if fire.y<22 then fire.shot:=FALSE
else
begin
place_fire;
if ((fire.y-22)>=0) and ((fire.y-22)<120) then
begin
x1:=(fire.x-9 ) shr 4;
y1:=(fire.y-22) shr 3;
x2:=(fire.x+shoots.width-9) shr 4;
y2:=y1;
if (wall[x1,y1]<>0) or (wall[x2,y2]<>0) then
begin
remove_fire;
fire.shot:=FALSE;
shoot_block_with_fire(x1,y1);
shoot_block_with_fire(x2,y2);
end;
end;
end;
end;
end;
end;
procedure remove_flux;
var y : word;
begin
for y:=0 to 19 do
memcpy(addr(playscreen.map^[217+row[y+FLUXLEVEL]]),
addr(screen[217+row[y+FLUXLEVEL]]),8);
end;
procedure check_flux;
var y,fx : word;
begin
fx:=scrfluxcnt;
if scrflux then
begin
for y:=0 to 19 do
memcpy(addr(flux.map^[(y+fx) shl 3]),
addr(screen[217+row[y+FLUXLEVEL]]),8);
inc(scrfluxcnt);
if scrfluxcnt>20 then scrfluxcnt:=0;
end;
end;
procedure vaus_out;
var x,y,z : word;
begin
nosound;
inc(score.player[cur_player],10000);
remain_blk:=0;
z:=vaus.x;
wait_vbl;
remove_vaus;
place_vaus;
for x:=z to z+44 do
begin
Wait_VBL;
vaus.oldx:=vaus.x;
vaus.x:=x;
remove_vaus;
check_flux;
place_vaus;
for y:=vaus.y to vaus.y+vaus.height do
memcpy(addr(playscreen.map^[225+row[y]]),
addr(screen[225+row[y]]),40);
end;
end;
procedure check_bonus_type(var b1,b2,b3 : BALLTYPE);
var x,y : longint;
begin
if vaus.letter>0 then
begin
lett.last:=vaus.letter-1;
if b2.inplay then remove_ball(b2);
if b3.inplay then remove_ball(b3);
b2.inplay:=FALSE;
b3.inplay:=FALSE;
scrflux:=FALSE;
remove_flux;
if vaus.letter<>6 then
begin
b1.launch:=FALSE;
b2.launch:=FALSE;
b3.launch:=FALSE;
end;
end;
case vaus.letter of
1: begin { Lettera L }
if fire.shot then remove_fire;
playvaus:=lasers;
modify_vaus;
vaus.letter:=0;
fire.avl:=TRUE;
fire.shot:=FALSE;
end;
2: begin { Lettera E }
if fire.shot then remove_fire;
playvaus:=enlarged;
modify_vaus;
vaus.letter:=0;
fire.avl:=FALSE;
end;
3: begin { Lettera B }
if fire.shot then remove_fire;
playvaus:=normal;
modify_vaus;
vaus.letter:=0;
fire.avl:=FALSE;
scrflux:=TRUE;
end;
4: begin { Lettera D }
if fire.shot then remove_fire;
playvaus:=normal;
modify_vaus;
fire.avl:=FALSE;
end;
5: begin { Lettera S }
if fire.shot then remove_fire;
playvaus:=normal;
modify_vaus;
vaus.letter:=0;
x:=max(b1.speed-500,BALLSPEED);
set_ball_speed(b1,x);
fire.avl:=FALSE;
end;
6: begin { Lettera C }
if fire.shot then remove_fire;
playvaus:=normal;
modify_vaus;
fire.avl:=FALSE;
end;
7: begin { Lettera P }
if fire.shot then remove_fire;
playvaus:=normal;
modify_vaus;
vaus.letter:=0;
inc(score.lives[cur_player]);
plot_lives(score.lives[cur_player]);
ball_block_sound(2000,10);
fire.avl:=FALSE;
end;
end;
end;
procedure deviate_ball(var ball : BALLTYPE);
var temp : integer;
begin
repeat
temp:=get_ball_direction(ball)+random(BALLDEV)-(BALLDEV shr 1);
until ((temp mod 90)>30) and ((temp mod 90)<60);
set_ball_direction(ball,temp);
set_ball_speed(ball,ball.speed);
ball.sbd:=0;
end;
{ ------------------------------------------------------------------------ }
{ Questa e' la procedura principale che durante il gioco chiama tutte le }
{ altre. Finche' la palla non viene persa o il quadro viene terminato }
{ (o eventualmente viene abortita la partita) la procedura mantiene il }
{ controllo. Termina in uno solo in uno dei casi sopra citati o in caso }
{ si verifichi un fatal_error a causa del quale il programma e' costretto }
{ a quittare automaticamente e inevitabilmente. }
function Bounceball : boolean;
var
x,y : integer;
key : integer;
ball : array[1..3] of BALLTYPE;
stm : integer;
temp : integer;
t1,t2: longint;
begin
scrfluxcnt:=0;
scrflux:=FALSE;
balls_in_play:=1;
fire.avl:=FALSE;
playvaus:=normal;
lett.last:=EMP;
lett.active:=FALSE;
{ Mette lo sfondo giusto a seconda del muro }
fill_picture_with_pattern(pattern);
{ Disegna il quadro di gioco con lo sfondo pocanzi settato}
showBTMpicture(playscreen);
{ Stampa il numero delle vite del giocatore corrente }
{ cur_player=1 o 2 a seconda di quale giocatore deve giocare }
plot_lives(score.lives[cur_player]);
{ regola i colori, in teoria dovrebbero gia' essere a posto. }
setpalette(playscreen);
{ Stampa il punteggio dei 2 giocatori e l'hi-score. }
write_score(253,POS_DIGIT[1],score.player[1]);
write_score(253,POS_DIGIT[2],score.player[2]);
write_score(253,POS_DIGIT[3],score.hiscore);
{ Disegna i mattoncini }
put_wall;
{ Esegue un reset nel caso il mouse abbia qualche problema, alle volte }
{ succede. }
mousereset;
{ La palla e' in gioco e deve essere lanciata }
ball[1].inplay:=TRUE;
ball[1].launch:=TRUE;
{ Setta le coordinate iniziali della palla }
ball[1].x:=((SCRMAX+SCRMIN) shr 1)-2;
ball[1].y:=VAUS_LINE-BALLSPOT;
{ annulla quelle vecchie }
ball[1].oldx:=EMP;
ball[1].oldy:=EMP;
{ La deviazione avviene quando questo valore supera una certa soglia }
ball[1].sbd:=0;
{ La distanza iniziale della palla quando si trova sul vaus dal bordo }
{ sinistro del vaus stesso. }
ball[1].onvaus:=16;
{ Tiene il numero di vertical-blank che passano da quando appare }
{ il vaus con la pallina a quando essa viene lanciata. }
{ Se il valore supera le 2000 unita' la palla parte automaticamente }
ball[1].stm:=0;
{ Alla partenza la variabile lett.incoming assume un valore casuale }
{ fra 0 e LETTER_DROP (costante definita all'inizio della unit. }
lett.incoming:=random(LETTER_DROP);
{ Mostra l'animazione del vaus che si materializza dal nulla }
create_vaus;
{ e stampa la scritta ROUND xx, READY. }
write_round_level;
set_vaus; { Regola i parametri iniziali del vaus. }
start_vaus;
move_vaus(vaus.x,VAUS_LINE); { lo porta al centro dell'area di gioco }
start_level; { Se il suono e' attivo fa la musichetta }
start_vaus;
remove_round_level; { Toglie la scritta ROUND xx, READY }
set_ball(ball[1]);
{ Questo e' il ciclo principale, puo' uscire da esso solo se : }
{ - la palla viene persa, }
{ - il quadro viene terminato (cioe' non restano piu' mattoni }
{ da distruggere. }
{ - la partita viene in qualche modo abortita. }
set_ball_direction(ball[1],random(15)+60); { angolo di partenza casuale }
{ 60 e 75 gradi }
set_ball_speed(ball[1],BALLSPEED);
{ velocita' iniziale = BALLSPEED costante }
ball[1].finespeed:=0; { i sottomultipli della velocita' sono 0 }
ball[2].inplay:=FALSE;
ball[3].inplay:=FALSE;
while(ball[1].inplay) and (remain_blk>0) and (not score.abortplay) do
begin
Wait_VBL; { Attende il vertical blank }
mousecoords(x,y); { legge le coordinate del mouse }
{ se il trainer (vaus in modalita' automatica) non e' attiva }
{ muove il vaus alla coord.x del mouse. }
if trainer=0 then move_vaus(x,VAUS_LINE)
{ se invece e' attivo impone che la x del vaus sia uguale alla x della }
{ palla, con un opportuno coefficiente di traslazione per far si che }
{ la palla batta al centro del vaus e non sul bordo sinistro. }
else if trainer=1 then
move_vaus(min(SCRMAX-32,max(ball[1].x-ball[1].onvaus,SCRMIN)),VAUS_LINE);
{ ball[1].launch vale TRUE se la palla e' attaccata al vaus e deve }
{ essere lanciata. Altrimenti quando e' in gioco vale false. }
if ball[1].launch=TRUE then
begin
inc(ball[1].stm); { se la palla e' attaccata il contatore di scatti }
{ viene continuamente incrementato. }
{ Quando raggiunge quota 250 la palla parte automaticamente }
if ball[1].stm=250 then ball[1].launch:=FALSE;
{ Fa in modo che la palla segua il vaus se questo viene spostato }
start_ball(ball[1]);
{ Se si preme il tasto del mouse allora la palla parte }
if mouseclick=1 then ball[1].launch:=FALSE;
end
else
{ altrimenti se la palla non e' attaccata occorre semplicemente }
{ muoverla. Chiaramente se le palle sono 3 bisogna muoverle tutte }
{ e tre. }
for cn:=1 to 3 do
if ball[cn].inplay then move_ball(ball[cn]);
{ Se le coord. della pallina cn sono comprese fra 22 e 142 (rispettivamente }
{ massima e minima coord. in cui si puo' urtare un mattoncino) allora }
{ occorre controllare se la palla ha effettivamente urtato un mattoncino }
{ oppure no. }
for cn:=1 to 3 do
begin
if (ball[cn].inplay) then { tutte le considerazioni valgono se }
{ la palla e' in gioco. }
begin
if (ball[cn].y>=22) and (ball[cn].y<142) then
ball_hit_block(ball[cn]);
set_ball(ball[cn]);
ball[cn].speed:=ball_speed(ball[cn]);
end;
end;
checkshine; { controlla se c'e' da far scintillare un mattoncino }
check_letter; { se sta scendendo una lettera }
check_bonus_type(ball[1],ball[2],ball[3]); { se viene raccolta una lettera }
check_fire; { se e' stato sparato un colpo di laser }
check_flux;
if ((vaus.x+vaus.width)=(SCRMAX-1)) and (scrflux) then vaus_out;
if vaus.letter=4 then { nel caso sia stata raccolta una D le palle }
begin { diventano 3. }
balls_in_play:=3;
ball[2]:=ball[1]; { la palla 2 e 3 vengono poste uguale alla 1 }
ball[3]:=ball[1];
t1:=get_ball_direction(ball[1]) div 90;
{ si il quadrante in cui si trova il vettore velocita' }
t2:=ball[1].speed; { nonche' il modulo del vettore stesso }
{ si impone un inclinazione di 30 gradi rispetto al quadrante alla }
{ prima palla, di 45 alla seconda e di 60 alla terza. }
{ A questo punto le tre palle sono costrette a dividersi. }
set_ball_direction(ball[1],(t1*90+30));
set_ball_direction(ball[2],(t1*90+45));
set_ball_direction(ball[3],(t1*90+60));
{ Le tre velocita' invece rimangono quella della prima palla }
set_ball_speed(ball[1],t2);
set_ball_speed(ball[2],t2);
set_ball_speed(ball[3],t2);
vaus.letter:=0;
end;
{ finche' c'e' piu' di una palla in gioco, nessuna lettera deve arrivare }
if balls_in_play>1 then lett.incoming:=0;
{ Aggiorna lo score del giocatore }
write_score(253,POS_DIGIT[cur_player],score.player[cur_player]);
{ Se lo score del giocatore e maggiore dell'hi-score }
if score.player[cur_player]>score.hiscore then
begin
{ pone l'hi-score uguale allo score del giocatore }
score.hiscore:=score.player[cur_player];
{ e stampa l'hi-score sullo schermo }
write_score(253,POS_DIGIT[3],score.hiscore);
end;
{ Questo ciclo aumenta la velocita' di tutte le palle in gioco }
{ il valore di LEVEL[lv] dipende ovviamente dal lv, cioe' dal livello }
{ selezionato prima di cominciare la partita. }
for cn:=1 to 3 do
begin
if ball[cn].inplay then
begin
inc(ball[cn].finespeed);
if ball[cn].finespeed>LEVEL[lv] then
begin
ball[cn].finespeed:=0;
{ se la velocita' e' inferiore a quella massima }
if ball[cn].speed<MAXSPEED then
begin
inc(ball[cn].speed,10); { la si incrementa }
set_ball_speed(ball[cn],ball[cn].speed); { e la si aggiorna }
end;
end;
inc(ball[cn].sbd); { questo e' il contatore di deviazione regolare }
{ se supera una certa soglia (SBDIR) viene imposta una deviazione }
{ casuale di un angolo compreso fra i -BALLDEV/2 e +BALLDEV/2 }
if (ball[cn].sbd>=SBDIR) and (ball[cn].speedy<0) then
deviate_ball(ball[cn]);
end;
end;
{ Questo ciclo fa in modo che la palla n.1 sia sempre in gioco }
{ (a meno che non vengano perse tutte e tre) }
{ Se si pedre la n.1, la n.2 prende il posto della n.1, la n.3 prende }
{ il posto nella n.2, infine la n.3 viene disattivata }
{ poiche' le tre palle sono uguali, il processo avviene senza che il }
{ giocatore percepisca materialmente la sostituzione. }
{ in questo modo se terminato il ciclo la palla n.1 risulta non essere }
{ in gioco, significa che tutte e tre sono cadute. }
for cn:=1 to 3 do
if not ball[1].inplay then
begin
ball[1]:=ball[2];
ball[2]:=ball[3];
ball[3].inplay:=FALSE;
end;
balls_in_play:=0; { Si ricalcola ogni volta il numero delle palle in }
for cn:=1 to 3 do { gioco. }
if ball[cn].inplay then inc(balls_in_play);
if (not ball[1].inplay) then { Se la palla n.1 non e' piu' in gioco }
begin
ball[1].launch:=TRUE;
remove_ball(ball[1]); { la si toglie dallo schermo }
destroy_vaus; { mostra la sequenza di distruzione }
dec(score.lives[cur_player]); { decrementa di 1 il numero delle vite }
score.wall_p[cur_player]:=wall; { memorizza il una variabile assegnata }
{ al giocatore il muro corrente }
{ Questo accade perche' se i giocatori sono due, occorre passare }
{ all'altro giocatore che probabilmente non si trovera nella stessa }
{ posizione. I mattoncini devono poi essere riportati tali e quali }
{ quando il turno passa di nuovo al giocatore che ora a perso una }
{ vita. }
nosound; { e disabilita' il suono }
end;
{ Se la nota corrente dura finche' snd_delay non diventa 0 }
if snd_delay>0 then dec(snd_delay)
else nosound;
{ ---------------------- Trainer Options -------------------- }
key:=inkey; { si guarda se viene premuto un tasto }
if (key=ord('p')) or (key=32) then pause_game; { Il tasto P pausa il gioco }
if key=7680 then score.abortplay:=TRUE; { ALT+A, la partita e' abortita }
if (key=ord('T')) then { Se si preme la T (maiuscola) viene generata }
begin { una fila di mattoncini. }
for cn:=0 to 12 do
begin
{ Chiaramente se il mattoncino indistruttibile deve sostituire }
{ un altro mattoncino distruttibile, bisogna che il numero totale }
{ di mattoncini da abbattere per finire il quadro diminuisca di 1 }
if (wall[cn,14]>0) and (wall[cn,14]<>10) then
dec(remain_blk);
wall[cn,14]:=10; { e il mattoncino in questione diventa indistruttibile }
end;
put_wall; { e viene fatto l'aggiornamento sullo schermo }
end;
{ La 'R' maiuscola abilita la modalita' automatica del vaus }
if key=ord('R') then trainer:=1;
{ La 'r' minuscola la disabilita }
if key=ord('r') then trainer:=0;
{ Se il tasto e' una a,b,c,d,e,f,g: viene fatta cadere una lettera }
if (key>=97) and (key<(97+LETTER_NUMB-1)) then { Fa cadere la lettera }
start_letter(104,30,key-97);
if key=11520 then { ALT+X, quit-ta }
begin
closegraph;
nosound;
closeprogram;
end;
end;
{ BounceBall esce con false se la palla e' stata persa, con true se }
{ il quadro e' stato finito. }
Bounceball:=FALSE;
if remain_blk=0 then Bounceball:=TRUE;
end;
{ ------------------------------------------------------------- }
function choose_start_wall : integer;
const px = 70;
py = 100;
dx = 34;
dy = 35;
ddx= 19;
ddy= 14;
var x,y,z : longint;
st : integer;
oldx,
oldy,
newx,
newy : integer;
sc : string[20];
begin
st:=1; { Si comincia a scegliere partendo dal muro n.1 }
settextstyle(DefaultFont,HorizDir,1);
setcolor(0);
{ Stampa PLAYER xxx se il numero di giocatori e' 2 }
if cur_player=1 then sc:='Player One'
else sc:='Player Two';
{ stampa le scritte CHOOSE YOER WALL, ecc... }
for x:=-1 to 1 do
for y:=-1 to 1 do
begin
outtextxy(px+5+x,py+y,sc);
outtextxy(px+x,py+y+10,'Choose your');
outtextxy(px+6+x,py+y+20,'start wall');
outtextxy(px-39+x,py+58+y,'Move mouse to select;');
outtextxy(px-45+x,py+68+y,'left button to confirm');
end;
setcolor(1);
outtextxy(px+5,py,sc);
outtextxy(px,py+10,'Choose your');
outtextxy(px+6,py+20,'start wall');
outtextxy(px-39,py+58,'Move mouse to select;');
outtextxy(px-45,py+68,'left button to confirm');
{ Disegna il quadrato nero in cui devono apparire i numeri del muro }
{ da scegliere. }
for y:=py+dy to py+dy+ddy do
for x:=px+dx to px+dx+ddx do
screen[x+row[y]]:=0;
mousecoords(oldx,oldy); { rileva le coordinate del mouse }
while(mouseclick=1) do;
while(mouseclick<>1) do
begin
put_digit(px+dx+3,py+dy+2,st div 10); { Scrive il numero del quadro }
put_digit(px+dx+11,py+dy+2,st mod 10);
mousecoords(newx,newy); { Se le coord. sono diverse: }
if newx>oldx then inc(st); { se la x e' maggiore il quadro aumenta }
if newx<oldx then dec(st); { se e' munore diminuisce. }
{ Se supera il massimo selezionabile torna al n.1 }
if st>totalwall then st:=st-totalwall;
{ se supera il minimo selezionabile torna al massimo (n.32) }
if st<1 then st:=st+totalwall;
oldx:=newx; { le nuove coord. diventano le vecchie. }
oldy:=newy;
end;
choose_start_wall:=st; { e ritorna il numero selezionato }
end;
procedure set_start_parameters;
var x : integer;
begin
{ Imposta i parametri del giocatore 1 e 2 }
for x:=1 to 2 do
begin
score.player[x]:=0;
score.lives[x] :=5;
score.wall_n[x]:=STARTWALL;
score.wall_p[x]:=all_walls[STARTWALL-1];
score.roundsel[x]:=FALSE;
end;
cur_player:=1;
end;
procedure soundicon;
var x,y,fl,fw,h : word;
begin
{ Altezza dell'icona (l'icona e' alta il doppio perche' il brush }
{ e' composto dall'icona con la nota e l'icona con la X una sopra l'altra }
h:=soundfx.height div 2;
fl:=0; { se sound_on non e' false, cioe' e' TRUE allora fl:=0 }
{ punto in cui inizia il disegno dell'icona con la nota }
{ altrimenti fl viene spostato al punto in cui c'e' l'icona con la X }
if sound_on=FALSE then
fl:=soundfx.width*h;
{ e quindi copia uno dei due disegni sullo schermo }
for y:=0 to h-1 do
begin
fw:=y*soundfx.width;
for x:=0 to soundfx.width-1 do
screen[320-soundfx.width+x+row[y+200-h]]:=soundfx.map^[x+fw+fl];
end;
end;
procedure level_selection;
var x,y,fl,fw,h : word;
begin
{ Disegna sullo schermo uno dei 5 numeri a seconda del valore di lv }
h:=levelsel.height div 5; { I frames sono 5 quindi l'altezza di un }
{ frame e' l'altezza totale del disegno/5 }
fl:=(lv-1)*h*levelsel.width; { fl contiene l'indirizzo del frame da }
{ copiare sullo schermo. }
for y:=0 to h-1 do
begin
fw:=y*levelsel.width;
for x:=0 to levelsel.width-1 do
screen[x+row[y+200-h]]:=levelsel.map^[x+fw+fl];
end;
end;
function mainscreen : integer;
var x,y,z : word;
ps : integer;
srow : array[0..100] of word;
k,ik : integer;
begin
nosound; { spegne il cicalino }
score.abortplay:=FALSE; { e' imposta il flag di partita abortita a FALSE }
for x:=0 to 63999 do { Cancella lo schermo }
screen[x]:=0;
setpalette(playscreen); { Imposta i colori }
{ E copia la pagina di presentazione con la scritta ARKANOID sullo schermo }
{ tramite la procedura scritta in assembler. }
memcpy(addr(presents.map^),addr(screen),64000);
soundicon; { disegna l'icona del suono }
level_selection; { e quella del livello }
mousereset; { resetta il mouse per precauzione }
repeat { cicla finche' non viene fatto qualcosa }
{ k tiene lo stato del mouse, ik gli eventuali tasti premuti }
k:=mouseclick;
ik:=inkey;
if ik=11520 then k:=-1; { ALT+X = quit } { k<>0 interrompe il ciclo }
if ik=32 then { SPACE BAR = switch del suono on/off }
begin
sound_on:=sound_on XOR TRUE; { x xor 1 inverte il valore di x }
soundicon; { e disegna l'icona} { 0 xor 1 = 1; 1 xor 1 = 0 }
end;
if ik=15104 then { se si preme F1 il livello aumenta }
begin
inc(lv);
if lv>5 then lv:=1; { se e' superiore a 5 torna ad 1 }
level_selection; { e stampa il numero sullo schermo }
end;
if ik=15360 then { se si preme F2 il livello diminuisce }
begin
dec(lv);
if lv<1 then lv:=5; { se e' inferiore a 1 torna a 5 }
level_selection; { e stampa il numero sullo schermo }
end;
until k<>0; { il ciclo si interrompe se k e' diverso da 0 }
mainscreen:=k; { ritorna dunque: -1=quit, 1=un giocatore, 2=due giocatori }
end;
procedure start_game(players : integer);
var nwall : boolean;
begin
set_start_parameters; { imposta i parametri di partenza }
if players=1 then score.lives[2]:=0; { se c'e' un solo giocatore il }
{ seconda non ha neanche una vita }
trainer:=0; { il trainer viene disattivato }
wall:=score.wall_p[cur_player]; { si copia nel muro corrente }
{ quello del giocatore corrente }
set_wall; { e lo si disegna }
fill_picture_with_pattern(pattern); { si imposta lo sfondo }
showBTMpicture(playscreen); { e si disegna tutto quanto sullo }
{ schermo }
setpalette(playscreen); { si impostano i colori. }
{ si stampano i tre punteggi, player 1, 2 e hi-score }
write_score(253,POS_DIGIT[1],score.player[1]);
write_score(253,POS_DIGIT[2],score.player[2]);
write_score(253,POS_DIGIT[3],score.hiscore);
{ e si disegnano i mattoncini del muro }
put_wall;
repeat
repeat
{ se non e' ancora stato scelto il muro da cui partire }
{ viene fatto scegliere al giocatore (cur_player) ora }
if not score.roundsel[cur_player] then
begin
score.wall_n[cur_player]:=choose_start_wall;
{ viene assegnato il muro scelto al giocatore }
score.wall_p[cur_player]:=
all_walls[score.wall_n[cur_player]-1];
{ a questo punto e' stato scelto il muro }
score.roundsel[cur_player]:=TRUE;
end;
{ viene messo il muro del giocatore nel muro corrente }
wall:=score.wall_p[cur_player];
set_wall;
{ Si parte, questa assegnazione chiama bounceball, che non }
{ termina finche ho vieen perso il vaus o viene terminato }
{ il quadro. }
nwall:=BounceBall;
{ Se viene terminato il quadro nwall vale TRUE }
if nwall then
begin
{ quindi si incrementa il numero del muro a cui si trova }
{ il giocatore cur_player }
inc(score.wall_n[cur_player]);
{ e se viene superato il numero massimo si riparte dal n.1 }
if score.wall_n[cur_player]>totalwall then
score.wall_n[cur_player]:=1;
{ e viene prelevato in nuovo muro dalla matrice generale }
score.wall_p[cur_player]:=
all_walls[score.wall_n[cur_player]-1];
end
else
{ se non e' stato completato il muro si guarda se il numero }
{ delle vite e' sceso a zero }
{ nel qual caso si stampa la scritta GAME OVER }
if score.lives[cur_player]=0 then Game_Over;
{ il ciclo si ripete finche bounceball dice che non e' stato }
{ completato il muro (nwall=FALSE) il che significa che e' stata }
{ persa una vita }
until nwall=FALSE;
{ allora il controllo passa all'altro giocatore }
inc(cur_player);
if cur_player>players then cur_player:=1;
{ a meno che un giocatore non abbia terminato il numero di vite }
{ a disposizione, nel qual caso il controllo resta del giocatore }
{ che ha perso la vita. Notare che questo funziona benissimo anche }
{ se c'e' un giocatore solo, poiche' l'altro giocatore ha le vite }
{ a 0. }
if score.lives[cur_player]=0 then cur_player:=3-cur_player;
{ il ciclo si ripete finche entrambi i giocatori non esauriscono le vite }
{ o la partita viene abortita con ALT+A }
until ((score.lives[1]=0) and (score.lives[2]=0)) or (score.abortplay);
end;
end.