connect4

pas2js/pas2js Tutorials/Demo11 - Connect4/Connect4/assets.pas

@@ -0,0 +1,94 @@
+unit assets;
+
+{$R assets/red.png}
+{$R assets/yellow.png}
+{$R assets/blue.png}
+{$R assets/blink.png}
+{$R assets/c4name.png}
+
+Interface
+  uses Web,JS,p2jsres;
+
+var  
+ ShipImage : TJSHTMLImageElement;
+ BulletImage : TJSHTMLImageElement;
+ EnemyImage : TJSHTMLImageElement;
+ FireSound : TJSHTMLAudioElement;
+ ExplodeSound : TJSHTMLAudioElement;
+ RedImage : TJSHTMLImageElement;
+ YellowImage : TJSHTMLImageElement;
+ BlueImage : TJSHTMLImageElement;
+ BlinkImage : TJSHTMLImageElement;
+ C4NameImage : TJSHTMLImageElement;
+
+Procedure LoadResources(resfilename : string);
+
+Implementation
+
+Procedure CreateAssetElements;
+begin
+  ShipImage:=TJSHTMLImageElement.New;
+  BulletImage:=TJSHTMLImageElement.New;
+  EnemyImage:=TJSHTMLImageElement.New;
+  RedImage:=TJSHTMLImageElement.New;
+  YellowImage:=TJSHTMLImageElement.New;
+  BlueImage:=TJSHTMLImageElement.New;
+  BlinkImage:=TJSHTMLImageElement.New;
+  C4NameImage:=TJSHTMLImageElement.New;
+
+  FireSound:= TJSHTMLAudioElement(Document.CreateElement('audio'));
+  ExplodeSound:= TJSHTMLAudioElement(Document.CreateElement('audio'));
+end;
+
+Procedure  LoadImage(ImageName : string; var Img : TJSHTMLImageElement);
+var
+  aInfo : TResourceInfo;
+begin
+  if not GetResourceInfo(ImageName,aInfo) then
+    Writeln('No info for image ',ImageName)
+  else
+    Img.Src:='data:'+aInfo.format+';base64,'+aInfo.Data;
+end;
+
+Procedure  LoadSound(SoundName : string; var Snd : TJSHTMLAudioElement);
+var
+  aInfo : TResourceInfo;
+begin
+  if not GetResourceInfo(SoundName,aInfo) then
+    Writeln('No info for sound file ',SoundName)
+  else
+    Snd.Src:='data:'+'audio/wav'+';base64,'+aInfo.Data;
+end;
+
+procedure OnLoadFailed(const aError: string);
+begin
+  window.alert('Failed to load resources : '+AError)
+end;
+
+procedure OnLoaded(const LoadedResources: array of String);
+Var
+  S : String;
+begin
+  //for S in LoadedResources do
+  //  Writeln('Found resource: ',S);
+
+  LoadImage('red',RedImage);
+  LoadImage('yellow',YellowImage);
+  LoadImage('blue',BlueImage);
+  LoadImage('blink',BlinkImage);
+  LoadImage('c4name',c4NameImage);
+
+//  LoadSound('fire',FireSound);
+//  LoadSound('explode',ExplodeSound);
+end;
+
+Procedure LoadResources(resfilename : string);
+begin
+  CreateAssetElements;
+  SetResourceSource(rsHTML);
+  LoadHTMLLinkResources(resfilename,@OnLoaded,@OnLoadFailed);
+ // writeln('LoadResources'); 
+end;
+
+begin
+end.

pas2js/pas2js Tutorials/Demo11 - Connect4/Connect4/board.pas

@@ -0,0 +1,222 @@
+unit board;
+
+Interface
+ uses web,assets,c4core,findrows;
+type
+ TBoard = class
+           DropColumn : integer;
+           PlayerTurn : integer; 
+           DropMode   : boolean;
+           DropPosY   : integer;
+           DropEndY   : integer;
+           DropSteps  : integer;
+           DropCount  : integer;
+           ComputerDropColumn : integer;
+           timer : TJSDOMHighResTimeStamp;
+           GameOver   : Boolean;
+           renderctx        : TJSCanvasRenderingContext2D;
+
+           constructor create;
+           procedure Init;
+           procedure NewGame;
+
+
+           procedure DrawBoard;
+           procedure DrawPosition;
+           procedure DrawFalling;
+           procedure MovedropPiece(dir : integer);
+
+           procedure setRenderCTX(var ctx : TJSCanvasRenderingContext2D);
+           procedure Draw;
+           procedure Update(aTime: TJSDOMHighResTimeStamp);
+
+           procedure DropPiece;
+           procedure MovePiece;
+           procedure DumpRowInfo;
+           function isGameOver : boolean;
+ end;
+
+Implementation
+
+constructor TBoard.create;
+begin
+  Init;
+end;
+
+procedure TBoard.Init;
+begin
+  DropColumn:=4;
+  ComputerDropColumn:=0;
+  PlayerTurn:=RED;
+  DropMode:=false;
+  DropCount:=0;
+  timer:=0;
+  GameOver:=false;
+  init_board;
+end;
+
+procedure TBoard.NewGame;
+begin
+  Init;
+end; 
+
+function TBoard.isGameOver : boolean;
+begin
+  isGameOver:=GameOver;
+end;
+
+procedure TBoard.setRenderCTX(var ctx : TJSCanvasRenderingContext2D);
+begin
+  renderctx:=ctx;
+end;
+
+procedure TBoard.MovedropPiece(dir : integer);
+begin
+  if DropMode then exit; //we don't want to be moving piece while falling
+  inc(DropColumn,dir);
+  if DropColumn < 1 then DropColumn:=1;
+  if DropColumn > 7 then DropColumn:=7;
+end;
+
+procedure TBoard.DrawBoard;
+var c, r: integer;
+begin
+    for r := 1 to 6 do
+    begin
+       for c := 1 to 7 do
+       begin
+           case get_game_piece(c,r) of
+               RED:renderCTX.drawimage(RedImage,c*29,r*27,32,32);
+               YELLOW:renderCTX.drawimage(YellowImage,c*29,r*27,32,32);
+           end;
+           renderCTX.drawimage(BlueImage,c*29,r*27,32,32); 
+       end;
+   end;
+   renderCTX.drawimage(c4NameImage,8*29+4,1*27+20);
+end;
+
+procedure TBoard.DrawFalling;
+begin
+  if PlayerTurn = RED then
+  begin
+     renderCTX.drawimage(RedImage,DropColumn*29,DropPosY,32,32);
+  end   
+  else
+  begin
+     renderCTX.drawimage(YellowImage,DropColumn*29,DropPosY,32,32);
+  end;
+end;
+
+procedure TBoard.DrawPosition;
+begin
+  if PlayerTurn = RED then
+  begin
+     renderCTX.drawimage(RedImage,DropColumn*29,0,32,32);
+  end   
+  else
+  begin
+     renderCTX.drawimage(YellowImage,DropColumn*29,0,32,32);
+  end;
+end;
+
+procedure TBoard.Draw;
+begin
+  if DropMode then DrawFalling else DrawPosition;
+  DrawBoard;
+end;
+
+procedure TBoard.Update(aTime: TJSDOMHighResTimeStamp);
+begin
+  if aTime > (timer+10)  then
+  begin
+    timer:=aTime;
+    MovePiece;
+  end;  
+end;
+
+procedure TBoard.DropPiece;
+begin
+ if GameOver then exit;
+ if DropMode then exit;
+ DropMode:=true;
+ DropPosY:=0;
+ DropEndY:=(get_drop_row(DropColumn))*27;
+ DropSteps:=1;
+ DropCount:=0;
+end;  
+
+procedure TBoard.MovePiece;
+begin
+ // if GameOver then exit;
+  if DropMode then
+  begin
+    inc(DropPosY,DropSteps);
+    if (DropPosY >= DropEndY) then  //drop peice has reached drop location
+    begin
+       if PlayerTurn = RED then
+       begin       
+         Drop_Piece(DropColumn,RED);
+         inc(DropCount);
+         DropPosY:=0;
+         if is_connect_four(DropColumn) = false then
+         begin
+           //red did not win - choose drop column - but don't drop
+           PlayerTurn:=YELLOW;
+           DropColumn:=do_computer_move (YELLOW);
+           //writeln(dropcolumn,' ',get_drop_row(DropColumn));
+           DropEndY:=(get_drop_row(DropColumn))*27;
+         end
+         else
+         begin
+           //writeln('Game Over');
+           GameOver:=true;
+           DropMode:=false;
+         end;  
+       end
+       else if PlayerTurn = YELLOW then
+       begin
+         //drop piece reached drop location now - drop the piece - check for win
+         Drop_Piece(DropColumn,YELLOW);
+         inc(DropCount);
+         DropPosY:=0;
+         if is_connect_four(DropColumn) = false then
+         begin
+           PlayerTurn:=RED;
+         end
+         else
+         begin
+           //writeln('Game Over');
+           GameOver:=true;
+           DropMode:=false;
+         end;  
+       end;
+
+       if DropCount = 2 then 
+       begin
+         DropMode:=false;
+         DropCount:=0;
+       end;  
+
+    end;   
+  end;
+end;
+
+//for debug only
+procedure TBoard.DumpRowInfo;
+var
+ rowcount : integer;
+  apoints : aitempoints;
+  i : integer;
+begin
+  rowcount:=FindRowOfColors(apoints,4);
+  for i:=0 to rowcount-1 do
+  begin
+    with apoints[i] do
+    begin
+  //    writeln('x=',x,' y=',y,' stepx=',stepx,' stepy=',stepy,' item=',item,' count=',count);
+    end;  
+  end;
+end;
+
+begin
+end.