(*Crashball version 1.0 (C) 1994 Robert Quezada This can be freely distributed (with compiled program), provided that the source code is not modified in any way. *) (*Turn off overlay, range checking, stack checking, and debug information when compiling. Makes the program run faster. Should be used only when you are sure that the program runs properly (to avoid problems). *) {$o-} uses pstuff21; {$M 8192,0,0} (*Set stacksize to 8192 bytes and set heap to 0 bytes*) {$f-} (*Turn off FAR calling for procedures*) CONST XMIN=6; (*Extreme left of play area*) HORIZLIM=168+8+8; (*Extreme right of play area*) vertlim=140; (*Height of used screen (out of 200) *) PIECEHEIGHT=7; PIECEWIDTH=24; var HI_NAME:ARRAY[1..6] OF STRING; HI_SCOR:ARRAY[1..6] OF LONGINT; BACKBUFFER:doubleSCREEN; sc:array[0..6] of INTEGER; bounce,speedup,slowdown,SHRINK,ENLARGE,STICKYBLOCKS,piece: array[0..(horizlim div piecewidth)+1,0..(vertlim div pieceheight)+1] of boolean; i,ii,x,y,totalblocks,screenposition,angle:INTEGER; DIST,ballx,bally:REAL; ch:char; arrow,BALLMASK,ball:graftype; BRICKS:ARRAY[1..9] OF GRAFTYPE; paddle:array[1..3] of graftype; oldy,newy,BOUNCEBACKTIME,highesthit,paddlewidth,LIVES:INTEGER; score:longINT; english,NOMORE,stuckon,sticky,FASTERBALL,SLOWERBALL:boolean; PLATX,CHANGEX,level:real; PROCEDURE CLS; BEGIN (*Clears background screen and displays it*) for i:=0 to screenlength do doublebackg[i]:=0; if lcd_ok then for i:=0 to screenlength do mem[$b800:i]:=0; appear(doublebackg); END; FUNCTION HIPLACEMENT:INTEGER; (*Placement of score in hi-score table*) VAR I:byte; BEGIN HIPLACEMENT:=7; FOR I:=5 DOWNTO 1 DO IF SCORE>=HI_SCOR[I] THEN HIPLACEMENT:=I END; function input(Y:INTEGER):string; var a:char;N:STRING; begin INC(Y,2); (*Make vertical position 2 rows lower on screen*) a:=chr(0); (*Clear character in our buffer*) N:=''; (*Erase string*) repeat if a=chr(8) then rite(4,Y,copy(n+'~ ',1,15),true) else rite(4,Y,copy(n+'~ ',1,15),true); (*If backspace key is hit, erase last letter entered.*) a:=upcase(keyhit); if (a in ['0'..'9','A'..'Z','.','?','*',' ']) then n:=n+a; (*If it is a legal character, then put it in our name*) if (length(n)>15) or ((a=chr(8)) and (length(n)>1)) then n:=copy(n,1,length(n)-1) (*If name is too long or backspace key is hit, erase last character*) else if a=chr(8) then n:=''; (*If we only have one letter in our name and backspace key is hit, then erase the name*) until (a=chr(13)); (*Keep going until RETURN key is hit*) input:=n; end; PROCEDURE HISCORES(NEW:BOOLEAN); VAR I:INTEGER;STUFFOUT:tEXT; BEGIN IF NEW THEN BEGIN HI_NAME[HIPLACEMENT]:=' '; HI_SCOR[HIPLACEMENT]:=SCORE; END; cls; slidescreen(0); CENTER(1,'TOP 5 PLAYERS',TRUE); (*Show hi-scores*) FOR I:=1 TO 5 DO rite(4,I+2,COPY(HI_NAME[I]+'...............',1,15) +'...'+LONGSTR(HI_SCOR[I]),TRUE); IF NEW THEN BEGIN CENTER(9,'ENTER YOUR NAME.',true); HI_NAME[HIPLACEMENT]:=INPUT(HIPLACEMENT); (*Get name and put it into hi-score table*) END; CENTER(9, ' PRESS A KEY ',true); KEYHIT; (*Save high scores*) ASSIGN(STUFFOUT,'CRASH.HI'); REWRITE(STUFFOUT); FOR I:=1 TO 5 DO BEGIN WRITELN(STUFFOUT,HI_NAME[I]); writeln(stuffout,HI_SCOR[I]); END; CLOSE(STUFFOUT); END; procedure setpaddlewidth(i:integer); var ii:integer;l:word; begin paddlewidth:=i; if i=16 then begin (*Make it small paddle*) SPRITEOFF(2);SPRITEOFF(6); changesprite(2,null_graph,full_graph); changesprite(3,paddle[1],full_graph); changesprite(5,paddle[3],full_graph); sprite[6]:=sprite[2]; end else begin (*Make it big paddle*) for ii:=1 to 2 do begin changesprite(1+ii,paddle[ii],full_graph); changesprite(4+ii,paddle[1+ii],full_graph); end; end; scancode:=0; end; procedure newangle(start,finish:integer); (*Used to calculate the angle of the ball when it hits a paddle or a block and its angle is proPORTional to where it hit*) var width:integer; begin width:=(finish-start); if angle>180 then angle:=180-trunc(ballx+width-start) div width*180 else angle:=trunc(((ballx-start+width)/width*180)); end; PROCEDURE PLACEPIECE(X,Y:INTEGER;B:BOOLEAN;C:INTEGER); VAR I,ii:integer; BEGIN if b and not(piece[x,y]) then inc(totalblocks) (*If piece is to be placed and it is not a piece, increase total number of pieces*) else if not(b) and (piece[x,y]) and (totalblocks>0) then dec(totalblocks); (*If piece is to be removed and a piece exists in that spot, decrease total number of pieces*) PIECE[X,Y]:=B; (*Turn off all power-ups at this location*) STICKYBLOCKS[X,Y]:=FALSE; SHRINK[X,Y]:=FALSE; ENLARGE[X,Y]:=FALSE; bounce[x,y]:=false; speedup[x,y]:=false; slowdown[x,y]:=false; if b then (*If block is to be placed and a power-up is requested, make the particular power up known to the computer*) case c of 2:STICKYBLOCKS[X,Y]:=true; 3:SHRINK[X,Y]:=true; 4:ENLARGE[X,Y]:=true; 5:bounce[x,y]:=true; 6:speedup[x,y]:=true; 7:slowdown[x,y]:=true; end; (*Setup horizontal and vertical positions*) x:=x*PIECEWIDTH; y:=y*pieceheight; IF B THEN BEGIN (*If piece is to be put, then show us the piece*) PUTscreen(doubleBACKG,X+8,Y,BRICKS[1]); PUTDIRECT(X+8,Y,BRICKS[1]); PUTscreen(doubleBACKG,X+8+8,Y,BRICKS[C+1]); PUTDIRECT(X+8+8,Y,BRICKS[C+1]); PUTscreen(doubleBACKG,X+8+16,Y,BRICKS[9]); PUTDIRECT(X+8+16,Y,BRICKS[9]); END ELSE BEGIN (*Otherwise, copy the BACKBUFFER image at that place and send it to the display and to the logical and background screens*) FOR I:=0 TO 2 DO BEGIN ii:=x+8+(i shl 3); COPYSCREEN(BACKBUFFER,Ii,Y,doubleBACKG); COPYSCREEN(DOUBLEBACKG,iI,Y,DOUBLELOGIC); COPYLOGIC2LCD(iI,Y); END; END; END; PROCEDURE setshapes; VAR I,III,II:INTEGER;ch:integer;CH2:graftype;CHOUT:FILE OF graftype; bEGIN (*These are all the shapes to be used in this program*) (*Set all the brick and the paddle sprites to blank images*) for i:=1 to 8 do bricks[i]:=null_graph; for i:=1 to 3 do paddle[i]:=null_graph; (*Now set the images*) arrow[1]:=0; arrow[2]:=convert('....X...'); arrow[3]:=convert('....X...'); arrow[4]:=convert('..X.X.X.'); arrow[5]:=convert('...XXX..'); arrow[6]:=convert('....X...'); arrow[7]:=0; CHANGESPRITE(7,ARROW,FULL_GRAPH); CHANGESPRITE(8,ARROW,FULL_GRAPH); SPRITE[8].SLOW:=TRUE; SPRITE[7].SLOW:=TRUE; { bricks[1,1]:=0;} bricks[1,2]:=convert('..XXXXXX'); bricks[1,3]:=convert('.XXXXXXX'); bricks[1,4]:=convert('.X......'); bricks[1,5]:=convert('.XXXXXXX'); bricks[1,6]:=convert('..XXXXXX'); {bricks[1,7]:=0;} { bricks[2,1]:=0;} bricks[2,2]:=255;{convert('XXXXXXXX');} bricks[2,3]:=255;{convert('XXXXXXXX');} {bricks[2,4]:=0;} bricks[2,5]:=255;{convert('XXXXXXXX');} bricks[2,6]:=255;{convert('XXXXXXXX');} { bricks[2,7]:=0;} {bricks[3,1]:=0;} bricks[3,2]:=convert('..XXXXX.'); bricks[3,3]:=convert('.XX.....'); bricks[3,4]:=convert('..XXXX..'); bricks[3,5]:=convert('.....XX.'); bricks[3,6]:=convert('.XXXXX..'); { bricks[3,7]:=0;} {bricks[4,1]:=0;} bricks[4,2]:=convert('.XXXXXX.'); bricks[4,3]:=convert('...XX...'); bricks[4,4]:=convert('...XX...'); bricks[4,5]:=convert('...XX...'); bricks[4,6]:=convert('...XX...'); { bricks[4,7]:=0;} { bricks[5,1]:=0;} bricks[5,2]:=convert('.XXXXX..'); bricks[5,3]:=convert('.XX...X.'); bricks[5,4]:=convert('.XXXXX..'); bricks[5,5]:=convert('.XX...X.'); bricks[5,6]:=convert('.XXXXX..'); { bricks[5,7]:=0;} { bricks[6,1]:=0; bricks[6,2]:=0;} bricks[6,3]:=convert('X...XXX.'); bricks[6,4]:=convert('.X...XX.'); bricks[6,5]:=convert('..X.X.X.'); bricks[6,6]:=convert('...X....'); { bricks[6,7]:=0;} {bricks[7,1]:=0;} bricks[7,2]:=convert('...XX...'); bricks[7,3]:=convert('...XX...'); bricks[7,4]:=convert('.XXXXXX.'); bricks[7,5]:=convert('...XX...'); bricks[7,6]:=convert('...XX...'); { bricks[7,7]:=0;} { bricks[8]:=null_graph;} bricks[8,4]:=convert('..XXXX..'); { bricks[9,1]:=0;} bricks[9,2]:= convert('XXXXXX..'); bricks[9,3]:=254;{convert('XXXXXXX.');} bricks[9,4]:= convert('.....XX.'); bricks[9,5]:=254;{convert('XXXXXXX.');} bricks[9,6]:= convert('XXXXXX..'); {bricks[9,7]:=0;} ball[1]:=0; ball[2]:=convert('...XX...'); ball[3]:=convert('..XXXX..'); ball[4]:=convert('.XXXX.X.'); ball[5]:=convert('..X..X..'); ball[6]:=convert('...XX...'); BALL[7]:=0; ballMASK[1]:= convert('..XXXX..'); ballMASK[2]:= convert('.XXXXXX.'); ballMASK[3]:=255;{convert('XXXXXXXX');} ballMASK[4]:=255;{convert('XXXXXXXX');} ballMASK[5]:=255;{convert('XXXXXXXX');} ballMASK[6]:= convert('.XXXXXX.'); ballMASK[7]:= convert('..XXXX..'); { PADDLE[1,1]:=0; PADDLE[1,2]:=0;} PADDLE[1,3]:=4+2+1; {CONVERT('.....XXX');} PADDLE[1,4]:=8+2+1; {CONVERT('....X.XX');} PADDLE[1,5]:=8+4; {CONVERT('....XX..');} PADDLE[1,6]:=8+4+2+1;{CONVERT('....XXXX');} { PADDLE[1,7]:=0;} {PADDLE[2,1]:=0;} PADDLE[2,2]:=255;{CONVERT('XXXXXXXX');} { PADDLE[2,3]:=0;} PADDLE[2,4]:=255;{CONVERT('XXXXXXXX');} {PADDLE[2,5]:=0;} PADDLE[2,6]:=255;{CONVERT('XXXXXXXX');} { PADDLE[2,7]:=0;} {PADDLE[3,1]:=0; PADDLE[3,2]:=0;} PADDLE[3,3]:=CONVERT('XXX.....'); PADDLE[3,4]:=CONVERT('XX.X....'); PADDLE[3,5]:=CONVERT('..XX....'); PADDLE[3,6]:=CONVERT('XXXX....'); { PADDLE[3,7]:=0;} END; procedure ballmove(x,y:REAL); begin ballx:=x; bally:=y; MOVESPRITE(TRUNC(ballX),TRUNC(ballY),9) end; PROCEDURE MOVEPLATFORM(X:REAL;Y:INTEGER); var i:integer; BEGIN (*Move paddle X places to the right at a vertical position of Y*) PLATX:=PLATX+X; (*Make sure paddle does not move past edges of playing area*) if PLATxHORIZLIM-paddlewidth then PLATx:=HORIZLIM-paddlewidth else if sticky and stuckon then ballmove(ballx+x,bally); (*Show arrows one screen or higher above where the paddle is, so that when the screen is scrolled up, you know where the paddle is.*) I:=TRUNC(BALLY)+SCREENHEIGHT-16; IF I>vertlim-16 THEN I:=-500;(*Don't show them when we can see the paddle*) movesprite(trunc(platx)-16+PADDLEWIDTH,I-8,8); MOVESPRITE(TRUNC(PLATX)-16,I-8,7); IF PADDLEWIDTH=16 THEN BEGIN INC(SPRITE[8].POS_X,8);INC(SPRITE[7].POS_X,7);END; (*Move the paddle to the new position*) for i:=0 to 4 do movesprite(trunc(platx)-16+(i shl 3),y,i+2); END; PROCEDURE SHOWMESSAGE(N:STRING); VAR ii,I:INTEGER; BEGIN (*Take temporary control of interupts, so user doesn't pause the computer while we do this*) asm cli;end; (*Center the messgae on the screen a couple of lines down from the "virtual" screen location*) ii:=lcdposition div screenlinelength div 7+6; CENTER(ii,N,FALSE); FOR I:=0 TO 32767 DO; (*Delay a few seconds*) (*Clean up the message on the screen by copying the background image back to the logical screen*) FOR I:=0 TO 29 DO COPYSCREEN(DOUBLEBACKG,(I SHL 3),ii*7-7,DOUBLELOGIC); appear(doubleLOGIC);(*Show that screen*) asm sti;end; (*Release control of interupts*) END; PROCEDURE FORWARD(var DIST:REAL); VAR X,Y:REAL; xpos,ypos,bx2,by2,bx,by,i:integer; XLOC,YLOC:array[0..3] of integer; found:boolean; N:STRING; WEAPONNUM:integer; BEGIN if not sticky then stuckon:=false; (*The following few IF statements respond to the ball hitting the walls of the playing area*) if bally<6 then begin if (angle>90) then begin angle:=360-angle;end else if (angle<90) then begin angle:=360-angle;end; bally:=6; end; if ballx>HORIZLIM-14 then begin ballx:=horizlim-14; if (angle<90) then begin angle:=(180-angle);end else if (angle>270) then begin angle:=180+360-(ANGLE);end; end; if ballx180) then begin angle:=360+180-(angle);end else if (angle>90) then begin angle:=(180-angle);end; end; bx:=trunc(ballx); by:=trunc(bally); (*These are the points of collision that we are going to check*) xloc[0]:=bx+3; yloc[0]:=by-3; xloc[1]:=bx+3; yloc[1]:=by+6+3; xloc[2]:=bx-3; yloc[2]:=by+3; xloc[3]:=bx+7+3; yloc[3]:=by+3; found:=false; for i:=0 to 3 do if not(found) AND NOT(NOMORE) then begin xloc[i]:=trunc(xloc[i]); yloc[i]:=trunc(yloc[i]); bx2:=xloc[i] DIV PIECEWIDTH; by2:=(yloc[i] div pieceheight); if not(found) and piece[bx2,by2] then begin ypos:=yloc[i] mod pieceheight; xpos:=xloc[i] and 15; case i of 0:IF NOT(PIECE[BX2,BY2+1]) then (*If top of ball hit a piece and it is a legal hit...*) begin found:=true; if (angle<180) then begin if not(english) then angle:=360-angle;end ELSE FOUND:=FALSE; end; 1:if NOT(PIECE[BX2,BY2-1]) then (*If bottom of ball hit a piece and it is a legal hit...*) begin found:=true; IF (ANGLE>=180) THEN begin if not(english) then ANGLE:=360-ANGLE;end ELSE FOUND:=FALSE; end; 2:IF NOT(PIECE[BX2+1,BY2]) THEN (*If left side of ball hit a piece and it is a legal hit...*) begin found:=true; if (angle<=180) and (angle>90) then begin if not(english) then angle:=180-angle;end else if (angle>180) AND (angle<=270) then begin if not(english) then angle:=360+180-(angle);end ELSE FOUND:=FALSE; end; 3:IF NOT(PIECE[BX2-1,BY2]) THEN (*If right side of ball hit a piece and it is a legal hit...*) begin found:=true; if (angle>270) then begin if not(english) then angle:=180+360-angle;end else if (angle<=90) then begin if not(english) then angle:=360-angle;end ELSE FOUND:=FALSE; end; end; IF FOUND THEN BEGIN nomore:=true; (*Tell routine so that if it is run again, to not check for collisions*) if english then (*If special bounce on the blocks are ON, then make return angle be proPORTional to where it hit*) newangle((bx2)*piecewidth,(bx2+1)*piecewidth); if highesthit>by2 then highesthit:=by2; WEAPONNUM:=0; (*If power-up exists at this position, do necessary adjustments*) IF SHRINK[bx2,by2] THEN BEGIN SETPADDLEWIDTH(16);WEAPONNUM:=2;END; IF ENLARGE[bx2,by2] THEN BEGIN SETPADDLEWIDTH(32);WEAPONNUM:=3;END; IF BOUNCE[BX2,BY2] THEN BEGIN WEAPONNUM:=4;BOUNCEBACKTIME:=1000;END; IF SPEEDUP[BX2,BY2] THEN BEGIN WEAPONNUM:=5;FASTERBALL:=TRUE;SLOWERBALL:=FALSE;END; IF SLOWDOWN[BX2,BY2] THEN BEGIN WEAPONNUM:=6;FASTERBALL:=FALSE;SLOWERBALL:=TRUE;END; { IF (WEAPONNUM>0) AND (WEAPONNUM<5) THEN BEGIN FASTERBALL:=FALSE;SLOWERBALL:=FALSE;END;} if stickyblocks[bx2,by2] then WEAPONNUM:=1; if weaponnum>0 then sticky:=stickyblocks[bx2,by2]; (*If sticky power-up then turn ball catching on*) PLACEPIECE(bx2,by2,FALSE,1); (*Remove piece from screen*) INC(SCORE,((vertlim DIV PIECEHEIGHT)-by2-6)*trunc((1.20-level)/0.075+1)); (*Make adjustment in score*) IF SCORE>99999 THEN SCORE:=99999; N:=COPY(LONGSTR(SCORE),2,5);(*Show last 5 digits in score*) rite(24,2,n,true); (*RITE it to the screen at the top and bottom*) rite(24,13,n,true); IF WEAPONNUM<>0 THEN begin (*If a power-up was hit, display the appropriate message*) case weaponnum of 1: SHOWMESSAGE(' STICKY PADDLE '); 2: SHOWMESSAGE(' TINY PADDLE '); 3: SHOWMESSAGE(' BIG PADDLE '); 4: SHOWMESSAGE(' BOUNCE BACK '); 5: SHOWMESSAGE(' FAST BALL '); 6: SHOWMESSAGE(' SLOW BALL '); END; end; END; end; end; for i:=0 to 3 do (*Check to see if the ball hit the paddle or if it the bottom of the playing area and BOUNCEBACK was ON*) begin bx2:=xloc[i] DIV PIECEWIDTH; by2:=(yloc[i] div pieceheight); if not(stuckon) then (*If ball catching is off, and the ball hit our paddle, or bounce back is on...*) if not(found) and (ANGLE>=180) AND (by2=vertlim DIV PIECEHEIGHT) and ((abs(ballx-platx)<(paddlewidth shr 1)+4) OR ((BOUNCEBACKTIME>0))) THEN begin stuckon:=sticky and (bouncebacktime=0); newangle(TRUNC(platx),TRUNC(platx)+paddlewidth); found:=true; end; end; IF (BALLY>vertlim-pieceheight shr 1) THEN dist:=0; (*If ball fell through the bottom of playing field, then change the distance to be travelled to 0, so that the calling routine knows*) (*Make it so the angle is within 0 to 360 degree range*) while(angle>359) do dec(angle,360); while(angle<0) do inc(angle,360); (*Make adjustments if angle of ball is too extreme*) if (angle>80) and (angle<90) then angle:=80; if (angle>=90) and (angle<100) then angle:=100; if (angle>155) AND (ANGLE<=180) then angle:=155; if (angle>180) and (angle<195) then angle:=195; if (angle>220) and (angle<=270) then angle:=220; if (angle>270) and (angle<320) then angle:=320; if (angle>345) then angle:=345; if angle<15 then angle:=15; X:=ANGLE*pi/180; if not(stuckon) then (*If ball is not caught by paddle, then move it*) ballmove(ballx+COS(X)*DIST,bally-SIN(X)*DIST); end; procedure game; begin CLS; center(2,'STARTING LEVEL...',true); RITE(11,4,'0...SLOW',true); RITE(11,5,'9...FAST',true); CENTER(7,'MAKE YOUR CHOICE',true); REPEAT CH:=KEYHIT UNTIL CH IN ['0'..'9']; level:=1.20-(ord(ch)-48)*0.075; score:=0; for i:=2 to 6 do sprite[i].slow:=true; (*Setup background screen of borders of playing field*) FOR I:=0 TO (VERTLIM-5)*30-1 DO BEGIN ii:=I MOD 30; doublebackg[i]:=0; IF (I<60) AND (ii IN [1..HORIZLIM SHR 3-2]) THEN doubleBACKG[I]:=255; IF ii=0 THEN doubleBACKG[I]:=3; IF ii=HORIZLIM SHR 3-1 THEN DOUBLEBACKG[I]:=128+64; END; setshapes; LIVES:=2; doublelogic:=doublebackg; (*Copy background screen to the logical screen*) slidescreen(0); (*Move "virtual" screen so that it is displaying the top of the screen.*) CHANGESPRITE(9,BALL,BALLMASK); SPRITE[9].SLOW:=TRUE; (*Make it so sprite #13 (ball) will redraw its previous position, so it won't leave a mess when it's moved*) CHANGESPRITE(4,PADDLE[2],null_graph); FOR I:=1 TO 3 DO begin sprite[i+1].slow:=true; end; sticky:=false; angle:=random(60); PLATX:=80; ballmove(50,120); RITE(24,2,'00000',true); RITE(24,13,'00000',true); BACKBUFFER:=doubleBACKG;(*copy background screen to the BACKBUFFER screen. BACKBUFFER is used to coverup pieces that have been hit by the ball.*) appear(doublebackg); repeat totalblocks:=0; (*Erase all power-ups from the board*) for i:=0 to horizlim div piecewidth do for ii:=0 to vertlim DIV PIECEHEIGHT do STICKYBLOCKS[i,ii]:=FALSE; PIECE:=STICKYBLOCKS; ENLARGE:=PIECE; SHRINK:=ENLARGE; BOUNCE:=SHRINK; SPEEDUP:=SHRINK; SLOWDOWN:=SHRINK; (*Setup power-ups for the current board*) for i:=3 to 12 do for ii:=0 to 6 do PLACEPIECE(ii,i,TRUE,1); (*Display all pieces as being normal blocks*) randomize; FOR II:=2 TO 7 DO begin FOR I:=1 TO random(2)+1 DO (*Place either 1 or 2 of each power-up*) begin REPEAT X:=random(10)+3; Y:=RANDOM(7); UNTIL (NOT ENLARGE[Y,X]) AND (NOT STICKYBLOCKS[Y,X]) AND (NOT SHRINK[Y,X]) AND (NOT SLOWDOWN[Y,X]) AND (NOT SPEEDUP[Y,X]) AND (NOT BOUNCE[Y,X]); PLACEPIECE(Y,X,TRUE,ii); end; (*Now change certain blocks to the power-ups, but make sure that the ones to be placed in a certain location does not already contain a power-up*) end; screenposition:=(trunc(bally)-10)*screenlinelength; (*Location of "virtual" screen now*) if screenposition<0 then screenposition:=0 else if screenposition>(vertlim-64)*screenlinelength then screenposition:=(vertlim-64)*screenlinelength; (*Make sure that the "virtual" screen is not too far up or too far down*) WHILE LCDPOSITION<>SCREENPOSITION DO BEGIN IF LCDPOSITION(vertlim-screenheight)*screenlinelength then screenposition:=(vertlim-screenheight)*screenlinelength; slidescreen(screenposition); if keybuffer then (*If a key has been hit....*) begin ch:=keyhit; (*Get that key*) if stuckon and (ch>chr(0)) then stuckon:=false (*If ball catching is on and an arrow key was not hit, release ball*) else if (ch in ['R','r']) then appear(doublelogic); (*If "R" or "r" is hit by the user, tell the Portfolio/IBM to redraw the screen. Useful when someone turns the power off and back on when using a Portfolio.*) end else BEGIN DIST:=2.9+0.5*LEVEL+0.1*ORD(FASTERBALL); case scancode of 75: CHANGEX:=-DIST; (*Left arrow key*) 77: CHANGEX:=DIST; (*Right arrow key*) 57: CHANGEX:=0; (*Space bar*) end; END; IF BOUNCEBACKTIME>0 THEN DEC(BOUNCEBACKTIME); (*If Bounce back is on, decrease "bounce back" counter*) IF BOUNCEBACKTIME=1 THEN BEGIN IF ANGLE>=180 THEN inc(BOUNCEBACKTIME) (*If ball is moving downwards, increment BOUNCEBACKTIME by 1 so that it will not become 0 next time the loop comes around*) ELSE SHOWMESSAGE(' END OF BOUNCE BACK '); (*Otherwise, end bounce back*) END; DIST:=2.8+2.0*(1.2-LEVEL)+(10-HIGHESTHIT)*0.5*(2-LEVEL); IF FASTERBALL THEN DIST:=DIST+1.0; IF SLOWERBALL THEN DIST:=DIST-0.8; DIST:=DIST/2; NOMORE:=FALSE; FOR I:=1 TO 2 DO forward(dist); (*Collision routines are more accurate when the distance is divided into two and the ball is moved forward twice*) UPDATESPRITES(TRUE); (*Redraw all sprites in their new positions*) if (DIST=0) then (*If ball got passed our paddle...*) begin dec(lives); (*Take away one life*) if (lives>=0) then (*If we have another paddle, reset ball and paddle*) begin sticky:=false; BOUNCEBACKTIME:=0; highesthit:=10; RITE(26,16,CHR(48+LIVES),true); FOR I:=0 TO TOTALSPRITES DO SPRITEOFF(I); ballmove(50,120); setpaddlewidth(32); RANDOMIZE; angle:=random(60); SPRITE[5].SLOW:=TRUE; SPRITE[6].SLOW:=TRUE; updatesprites(true); platx:=80; FOR I:=TRUNC(BALLY)-40 TO VERTLIM-6 DO BEGIN MOVEPLATFORM(0,I); UPDATESPRITES(true); END; SPRITE[5].SLOW:=FALSE; SPRITE[6].SLOW:=FALSE; SCANCODE:=0; end; end; MOVEPLATFORM(CHANGEX,vertlim-6); (*Move paddle to current position*) until (LIVES<0) OR (scancode=1) or (totalblocks=0); (*Leave loop if we have no more paddles, ESC key is hit, or no more blocks are in playing field*) if (totalblocks=0) then showmessage(' LEVEL COMPLETED. '); stuckon:=false; (*Turn off ball catching*) if totalblocks=0 then begin slidescreen((vertlim-64)*30); (*Slide screen to bottom of playing area*) (*Reset other variables, ball position, etc.*) level:=level-0.075; if level<1.20-0.075*9 then level:=1.20-0.075*9; highesthit:=10; RITE(26,16,CHR(48+LIVES),true); FOR I:=0 TO TOTALSPRITES DO SPRITEOFF(I); (*Remove all sprites from screen*) ballmove(50,120); setpaddlewidth(32); (*Turn paddle into full size paddle*) RANDOMIZE; angle:=random(60); updatespriteS(true); platx:=80; SCANCODE:=0; end; until (lives<0) or (scancode=1); SHOWMESSAGE(' GAME OVER'); end; PROCEDURE READHIGHSCORES; VAR I:INTEGER;STUFFOUT:TEXT; BEGIN ASSIGN(STUFFOUT,'CRASH.HI'); RESET(STUFFOUT); CLOSE(STUFFOUT); (*Does file exist?*) (*If not, then reset list*) IF IORESULT>0 THEN BEGIN FOR I:=1 TO 5 DO BEGIN HI_NAME[I]:='SPACE FOR RENT'; HI_SCOR[I]:=0; END; END ELSE BEGIN (*Otherwise, get hi-score table*) RESET(STUFFOUT); FOR I:=1 TO 5 DO READln(STUFFOUT,HI_NAME[I],HI_SCOR[I]); CLOSE(STUFFOUT); END; END; var ch2:char; begin LOADLETTERS('alpha.dat'); (*load letter data for RITE commands*) videomode(4); (*Change to graphics mode*) REPEAT READHIGHSCORES; CLS; slidescreen(0); (*Move "virtual" screen to top*) PBOX(5,5,235,59,1); (*Draw graphic boxes around the side*) PBOX(4,4,236,60,1); center(1,'CRASHBALL',true); center(3,'COPYR. 1994 ROB QUEZADA',true); CENTER(5,'PRESS SPACE FOR HISCORES',true); center(6,'PRESS A FOR NORMAL GAME',true); CENTER(7,'PRESS B FOR HARDER GAME',TRUE); CENTER(8,'OR ESC TO QUIT',true); repeat Ch2:=UPCASE(keyhit); until ((ord(ch2) in [65,66,32,27])); IF CH2=CHR(32) THEN HISCORES(FALSE); (*If space is hit, just show scores*) ENGLISH:=CH2 IN ['B','b']; (*This makes game a little harder*) if ch2 IN ['A','a','B','b'] THEN game; I:=HIPLACEMENT; (*Check to see where we stand in Hi-score table*) IF (I<6) AND (SCORE>0) THEN BEGIN (*If we are in the top 5 and our score is higher than 0...*) FOR II:=6 DOWNTO I+1 DO BEGIN (*Move all other scores down a notch and insert ours*) HI_SCOR[II]:=HI_SCOR[II-1]; HI_NAME[II]:=HI_NAME[II-1]; END; HISCORES(TRUE) (*Shows list and inputs name*) END; SCORE:=0; (*Reset score*) UNTIL CH2=CHR(27); videomode(3); (*Change back into text mode*) END.