i need your help

guys hello!!!
i need your help for something very important!!
i need in pascal i)the snake table game ii)and a labyrinth
in the labyrinth i want as output the best route we could have different every time.

Comments

  • : i need your help for something very important!!
    : i need in pascal i)the snake table game ii)and a labyrinth
    : in the labyrinth i want as output the best route we could have
    : different every time.
    :

    Snake game:[code][color=Blue]{### Compiler TP/BP7 ###}

    {$A+,B-,D-,E-,F-,G+,I-,L-,N+,O-,P-,Q-,R-,S-,T-,V-,X+}
    {$M 16384,0,655360}
    program snake; { simple snake game }

    uses crt;

    const max_length=255; { maximum snake length }
    max_fruits=15; { max. no. of fruits allowed }
    heads:array[1..4] of char=(chr($10),chr($1e),chr($11),chr($1f));
    tails:array[1..4] of char=(chr($11),chr($1f),chr($10),chr($1e));
    body :array[1..2] of char=(chr($1),chr($2));
    color:array[false..true] of byte=(12,10);{ colors: dead, alive }
    msg1='Snake game. Use Arrows to steer, pickup X''s for energy, avoid Y''s, Esc to exit';
    bkg_col=0;
    bkg_col2=1;


    type _snake_element_=record
    typ:byte;{ head, body, tail }
    dir:byte;{ left, right, up, down }
    x,y:byte;{ coords, for each piece }
    end;
    _snake_=array[1..max_length] of _snake_element_;
    _screen_=array[0..80*50-1] of byte; { virtual screen , 8000 bytes }

    var s:_snake_; { snake }
    sl:byte; { actual lenght }
    fruit_no:byte; { actual number of fruits on screen }
    energy:byte; { when drops to zero the snake dies }
    direction:byte;{ actual dir. , 1 - right, 2 - up, 3 - left, 4 - down }
    moves:byte; { number of moves }
    score:word; { score }
    grow_point:byte{ grow points makes snake grow until reaches max length };
    vscr:^_screen_;{ virual screen used for double buffering }
    vddr:word; { segment of virtual screen }




    {### Display related ########################################################}


    procedure textmode_co80x50;assembler;
    asm mov ax,1112h;int 10h;end;


    procedure textmode_co80x25;assembler;
    asm mov ax,1114h;int 10h;end;


    { Writes a character @ x,y in video memory with the given attribute }
    procedure out_char(segment:word;x,y:byte;ch:char;attr:byte);
    begin
    dec(x); { convert cords to 0 based }
    dec(y);
    memw[segment:y shl 7 + y shl 5 + x shl 1]:=attr shl 8 + ord(ch);
    end;


    { Returns the character @ x,y from video memory }
    function get_char(segment:word;x,y:byte):char;
    begin
    dec(x); { convert cords to 0 based }
    dec(y);
    get_char:=chr(mem[segment:y shl 7 + y shl 5 + x shl 1]);
    end;


    { Clears screen with a given text attribute }
    procedure cls(segment:word;attr:byte);
    var i,j:byte;
    begin
    for i:=1 to 80 do
    for j:=1 to 50 do
    out_char(segment,i,j,' ',attr);
    end;


    { Write a string @ the given coords, video segment and attribute }
    procedure writeat(segment_:word;x,y:byte;st:string;attr:byte);
    var i:byte;
    stl:byte absolute st;
    begin
    { attr:=bkgcol shl 4 + txtcol;}
    for i:=1 to stl do
    out_char(segment_,x+i-1,y,st[i],attr);
    end;


    { Convert a word to string }
    function tostr(w:word):string;
    var sr:string;
    begin
    str(w,sr);
    tostr:=sr;
    end;


    { Waits to a screen refresh to happen to reduce flickers + timing }
    procedure sync;
    begin
    while ((port[$3da] and 8)<>0) do;
    while ((port[$3da] and 8) =0) do;
    end;


    {############################################################################}


    { Reset snake, lenght=10, facing right }
    procedure init_snake;
    var i:byte;
    begin
    sl:=10; { set initial lenght }
    for i:=1 to sl do
    with s[i] do begin
    typ:=1; { body }
    dir:=1; { right }
    x:=45-i;{ middle of screen }
    y:=25;
    end;
    s[1].typ:=0; { 1st element = head }
    s[sl].typ:=2; { last = tail }
    energy:=73; { set energy to max. }
    end;


    { Displays snake}
    procedure display_snake(segment:word);
    var i,col:byte;
    begin
    col:=bkg_col * 16 + color[energy>0];{ If energy=0 then shows "dead" color }
    for i:=1 to sl do
    with s[i] do begin
    case typ of
    0:{head}out_char(segment,x,y,heads[dir],col+2);
    1:{body}if odd(i) then out_char(segment,x,y,body[1],col)
    else out_char(segment,x,y,body[2],col);
    2:{tail}out_char(segment,x,y,tails[dir],col);
    end;{case}
    end;
    end;


    { Displays energy level }
    procedure display_energy(segment:word);
    var i:byte;
    begin
    for i:=1 to 80 do
    out_char(segment,i,50,' ',bkg_col2 shl 4 + 7);
    writeat(segment,1,50,'Energy',bkg_col2 shl 4 + 7);
    for i:=1 to energy do
    out_char(segment,7+i,50,chr($fe),bkg_col2 shl 4 + 7);
    end;


    { Generates a random fruit on screen }
    procedure generate_fruit(segment:word);
    var mx,my,x,y:byte;
    ch:char;
    begin
    if fruit_no>=max_fruits then begin { too many fruits ? }
    mx:=random(10);{range= 0..9, 1 element=10%}
    for x:=1 to 80 do
    for y:=2 to 49 do
    if ((get_char(segment,x,y)=#5) and (mx=5)) then begin
    { 10% chance to convert a club (#5) into a heart (#3) }
    out_char(segment,x,y,#3,$0c);
    exit;
    end;
    exit;
    end;
    mx:=s[1].x;
    my:=s[1].y;
    inc(fruit_no);
    repeat
    x:=random(80)+1;
    y:=random(50)+1;
    ch:=get_char(segment,x,y);
    out_char($b800,2,2,chr(ord(ch)+10),9);
    until ( ((x>=mx+4) or (x<=mx-4)) and (x>0) and (x<81) and
    ((y>=my+4) or (y<=my-4)) and (y>1) and (y<50) and
    (ch=#32));
    mx:=random(255);
    if odd(mx) then out_char(vddr,x,y,#3,$0c) {heart}
    else out_char(vddr,x,y,#5,$0e);{club }

    end;


    { Returns true if the snake died }
    function isdead:boolean;
    var i:byte;
    begin
    if energy=0 then begin { depeleted energy ? }
    isdead:=true;
    exit;
    end else begin
    for i:=4 to sl do
    if ((s[1].x=s[i].x) and (s[1].y=s[i].y)) then begin
    isdead:=true; { bit into himself ? }
    exit;
    end;
    isdead:=false;
    end;
    end;


    { Moves sanke 1 position according to "direction" }
    procedure move_snake(segment:word);
    var i,mx,my,nd:byte;
    st:_snake_element_;
    ch:char;
    begin
    with s[1] do begin
    mx:=x;my:=y;
    case direction of
    1:{right}begin
    if x=80 then mx:=1 else mx:=x+1;
    nd:=1;
    end;
    2:{up }begin
    if y=2 then my:=49 else my:=y-1;
    nd:=2;
    end;
    3:{left }begin
    if x=1 then mx:=80 else mx:=x-1;
    nd:=3;
    end;
    4:{down }begin
    if y=49 then my:=2 else my:=y+1;
    nd:=4;
    end;
    end;
    end;
    ch:=get_char(segment,mx,my);
    if ch=#3 then begin { Eat a heart ? }
    inc(grow_point,random(10)+1);{ increase grow points }
    inc(energy,random(5)+1); { increase energy }
    if energy>73 then energy:=73;{ level energy if is more then allowed }
    dec(fruit_no); { one less fruit }
    end;
    if ch=#5 then begin { Eat a club ? }
    energy:=0; { energy runs out }
    dec(fruit_no); { one less fruit }
    exit;
    end;
    st:=s[sl]; { store tail }
    for i:=sl downto 2 do begin { move body }
    s[i].x:=s[i-1].x;
    s[i].y:=s[i-1].y;
    s[i].dir:=s[i-1].dir;
    end;
    with s[1] do begin { move head }
    x:=mx;
    y:=my;
    dir:=nd;
    end;
    if grow_point>0 then begin { has a chance to grow ? }
    dec(grow_point); { one less grow_point }
    if sl4 then direction:=2;
    {Down} #80:if direction<>2 then direction:=4;
    {Left} #75:if direction<>1 then direction:=3;
    {Right} #77:if direction<>3 then direction:=1;
    end;
    end;
    end;
    end;

    { Erase tail }
    if grow_point=0 then out_char(vddr,s[sl].x,s[sl].y,' ',bkg_col shl 4+7)
    else if sl=max_length then
    out_char(vddr,s[sl].x,s[sl].y,' ',bkg_col shl 4+7);

    if (moves<9) then inc(moves) else { every ten move decreases energy }
    begin
    moves:=0;
    dec(energy);
    generate_fruit(vddr); { also generates a new fruit }
    end;
    inc(score);

    move_snake(vddr); { move snake }
    dead:=isdead; { check if is dead }
    display_snake(vddr); { display }
    display_energy(vddr);
    sync; { wait for a screen refresh }
    move(vscr^,ptr($b800,0)^,8000); { show virtual screen }

    delay(25); { <-- Speed adjustment ************************** }

    until (ext or dead); { Until esc is pressed or snake dies }
    if ext then run:=true else run:=false;
    end;


    {### Main ###################################################################}
    var ch:char;

    label again;

    begin
    randomize;
    new(vscr);
    vddr:=seg(vscr^);
    textmode_co80x50;
    again:
    if not(run) then begin
    writeat($b800,30,24,' ',$1f);
    writeat($b800,30,27,' Play again ? (Y/N) ',$1f);
    writeat($b800,30,26,' ',$1f);
    writeat($b800,30,25,' Score: ',$1f);
    writeat($b800,38,25, tostr(score ),$1f);
    writeat($b800,30,28,' ',$1f);
    repeat
    ch:=upcase(readkey);
    until ((ch='Y') or (ch='N') or (ch=#27));
    if ch='Y' then goto again;
    end;;
    textmode_co80x25;
    dispose(vscr);
    clrscr;
    end.[/color][/code]Maze generator:[code][color=Blue]{$A+,B-,D-,E-,F-,G+,I-,L-,N+,O-,P-,Q-,R-,S-,T-,V-,x+}
    {$M 16384,0,655360}
    program maze01;
    uses crt;

    const msg1=' Maze generator ';
    msg2=' Press: Enter - Generate new maze, Esc - Quit ';
    mazex=77;
    mazey=22;

    type _mazetype_=array[0..mazex,0..mazey] of byte;
    direction=(goup,godown,goleft,goright);

    var maze:_mazetype_;
    x,y:integer;


    { Writes a character @ x,y in video memory with the given attribute }
    procedure out_char(segment:word;x,y:byte;ch:char;attr:byte);
    begin
    dec(x); { convert cords to 0 based }
    dec(y);
    memw[segment:y shl 7 + y shl 5 + x shl 1]:=attr shl 8 + ord(ch);
    end;


    { Returns the character @ x,y from video memory }
    function get_char(segment:word;x,y:byte):char;
    begin
    dec(x); { convert cords to 0 based }
    dec(y);
    get_char:=chr(mem[segment:y shl 7 + y shl 5 + x shl 1]);
    end;


    { Write a string @ the given coords, video segment and attribute }
    procedure writeat(segment_:word;x,y:byte;st:string;attr:byte);
    var i:byte;
    stl:byte absolute st;
    begin
    { attr:=bkgcol shl 4 + txtcol;}
    for i:=1 to stl do
    out_char(segment_,x+i-1,y,st[i],attr);
    end;


    procedure show_maze(mx,my:integer;ch:char);
    begin
    writeat($b800,mx+3,my+2,ch,$0e);
    end;


    procedure create_maze;
    var x,y:integer;
    ma:direction;

    procedure set_sq(x,y:integer;value: byte);
    begin
    maze[x,y]:=value;
    case value of
    1:show_maze(x,y,' ');
    0:writeat($b800,x+3,y+2,#219,$0f);
    end
    end;
    function rnd_dir:direction;
    begin
    case random(4) of
    0:rnd_dir:=goup;
    1:rnd_dir:=godown;
    2:rnd_dir:=goleft;
    3:rnd_dir:=goright;
    end;
    end;
    function rd(max : integer) : integer;
    begin
    rd:=random(max shr 1-1) shl 1+1;
    end;
    function possible(x,y:integer;ma:direction):boolean;
    begin
    possible:=false;
    case ma of
    goup :if y>2 then possible:=(maze[x,y-2]=0);
    godown :if y2 then possible:=(maze[x-2,y]=0);
    goright:if x=mazey) or (x<=0) or (x>=mazex));
    if not(ok) then ok:=try(x,y,goleft);
    if not(ok) then ok:=try(x,y,godown);
    if not(ok) then ok:=try(x,y,goright);
    if not(ok) then ok:=try(x,y,goup);
    if not(ok) then show_maze(x,y,' ');
    end;
    end;
    try:=ok;
    end;

    begin
    fillchar(tried,sizeof(tried),false);
    solved:=false;
    x:=0;
    y:=1;
    while (not(solved) and (y<mazey)) do begin
    solved:=try(x,y,goright);
    inc(y);
    end;
    x:=mazex;
    y:=1;
    while (not(solved) and (y<mazey)) do begin
    solved:=try(x,y,goleft);
    inc(y);
    end;
    x:=1;
    y:=0;
    while (not(solved) and (x<mazex)) do begin
    solved:=try(x,y,godown);
    inc(x);
    end;
    x:=1;
    y:=mazey;
    while (not(solved) and (x<mazex)) do begin
    solved:=try(x,y,goup);
    inc(x);
    end;
    solved:=true;
    repeat until keypressed;
    end;


    {### Main ###################################################################}
    var ch:char;

    begin
    clrscr;
    writeat($b800,1,1,msg1,$70);
    writeat($b800,1,25,msg2,$70);
    randomize;
    create_maze;
    solve_maze;
    repeat
    ch:=readkey;
    if ch=#13 then begin
    create_maze;
    solve_maze;
    end;
    until (ch=#27);
    clrscr;
    end.[/color][/code]

  • Thank you very much.
    The maze was wonderfull.
    But the snake game was not that i really want
    this is the kind of game that i want
    http://www.freegamebox.com/images/screenshot/1888-ladders-snakes-board-game_2597.png
  • Here's my idea how to implement it[code]type board_cell=record
    x,y:byte; { Coordinates }
    link:boolean; { Link to other cell (snake -or- ladder) }
    linkto:byte; { Cell no. links to ( [1..100] ) }
    end;

    var board:array[1..100] of board_cell;[/code]The board consists of a linear array or cells, the coordinates are there to help with the display (ie board[1].x=1; board[1].y=10; ... board[100].x=1; board[100].y=1;), if "[b]link[/b]" is set then it means that particular cell is a snake or ladder, and "[b]linkto[/b]" will point at the cell where the player will land. Players start on [b]board[1][/b] advancing randomly till the winner reaches [b]board[100][/b] (or beyond), stepping on a link active cell will result the in a player position update to the linked cell.
  • thanks a lot alex nice job!!!!
    thanks very much this one helps a lot
Sign In or Register to comment.

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

In this Discussion