Jump to content
IGNORED

Mad Pascal


Recommended Posts

recursion test

 

uses crt;

const
  size = 5; // permutations counter = (size+1)!

var
  board   : array [0..size] of byte;
  i       : byte;
  counter : word = 0;

procedure generate(n: byte);
var
  i, tmp: byte;
begin

  if n = 0 then
    begin
      for tmp in board do write(tmp); writeln;
      inc(counter);
    end
  else
    begin
      for i := 0 to n do begin
        tmp := board[i]; board[i] := board[n]; board[n] := tmp;
        generate(n-1);
        tmp := board[i]; board[i] := board[n]; board[n] := tmp;
      end;
    end;

end;

begin
  for i := 0 to size do board[i] := i;

  generate(size);

  writeln('permutations counter: ', counter);

  repeat until keypressed;
end.

Screenshot_2021-10-26_11-34-58.thumb.png.2ceffe837172ffb4e930a2a564342818.png

  • Like 1
Link to comment
Share on other sites

Eight queens puzzle Mad Pascal benchmark. No ZP optimization.

https://en.wikipedia.org/wiki/Eight_queens_puzzle

//Eight queens puzzle
//link: https://en.wikipedia.org/wiki/Eight_queens_puzzle

uses crt, sysutils, atari;

const
  size = 8;

var
  board   : array [0..size] of byte;
  i       : byte;
  ticks   : word;
  //counter is word for boards size greater than 8x8
  counter : word = 0;


function check(n, c: byte): boolean;
var
  i: byte;
begin
  check := true;
  for i := 1 to (n - 1) do
    if (board[i] = c) or
       (board[i] - i = c - n) or
       (board[i] + i = c + n)
    then check := false;
end;

procedure generate(n: byte);
var
  c: byte;
begin

  if n > size then
    begin
      //for i := 1 to size do write(board[i]); writeln;
      inc(counter); colbaks := counter;
    end
  else
    for c := 1 to size do
      if check(n, c) then begin
        board[n] := c;
        generate(n + 1);
      end;

end;

begin
  colbaks := counter;
  for i := 0 to size do board[i] := 0;

  pause; ticks := GetTickCount;
  generate(1);
  ticks := word(GetTickCount) - ticks;

  writeln('solutions: ', counter);
  writeln('ticks: ', ticks);

  repeat until keypressed;
end.

Screenshot_2021-10-26_19-08-00.thumb.png.825bc2783e9ca62a274e0a8364adb7c5.png

8queens.xex 8queens.pas

Edited by zbyti
  • Like 1
Link to comment
Share on other sites

function check(n, c : byte): boolean;
var
  i: byte;
begin
  check := true;
  for i := 1 to (n - 1) do
    if (board[i] = c) or
       (board[i] - i = c - n) or
       (board[i] + i = c + n)
    then begin check := false; Break end;
end;
Edited by tebe
Link to comment
Share on other sites

function check(n, c : byte): boolean;
var
  i: byte;
begin
  check := true;
  for i := 1 to (n - 1) do
    if (board[i] = c) or
       (byte(board[i] - i) = byte(c - n)) or
       (byte(board[i] + i) = byte(c + n))
    then exit(false);
end;

 

228 ticks

Edited by tebe
  • Like 1
Link to comment
Share on other sites

function check(n, c : byte): boolean;
var
  i: byte;
  dud: byte;
  tim: byte;
  tip: byte;
begin
  check := true;
  tip:=c + n;
  tim:=c - n;
  for i := 1 to (n - 1) do
  begin
    dud:=board[i];
    if (dud = c) or
       ((dud - i) = tim) or
       ((dud + i) = tip)
    then exit(false);
  end;
end;

216

obvious simple things

Link to comment
Share on other sites

8 hours ago, Estece said:

216

obvious simple things

The aim of the benchmark is to check how "fast code" will be generated by the compiler, not improvement of the algorithm ;)

 

I think you are now use more space on tiny Mad Pascal stack.

Edited by zbyti
Link to comment
Share on other sites

Simple procedural map generator for my incoming (also simple) roguelike game. Maybe someone find it useful and tweak it :]

 

uses crt;

//-----------------------------------------------------------------------------

var
  RTCLOK : byte absolute $14;
  SAVMSC : word absolute $58;
  COLOR4 : byte absolute $2c8;
  RANDOM : byte absolute $D20A;
  VCOUNT : byte absolute $D40B;

  seed1, seed2, seed3 : byte;
  level               : byte;
  screen              : word;

//-----------------------------------------------------------------------------

function pseudo_rnd_dir: byte;
var
  tmp        : word;
begin
  tmp := 0; //workaround
  Inc(seed2);
  tmp := seed2 + seed2 + seed1;
  seed1 := lo(tmp);
  seed2 := (seed1 xor seed2) + hi(tmp);
  seed3 := seed2 - seed3;
  pseudo_rnd_dir := seed3 and 3;
end;

//-----------------------------------------------------------------------------

procedure render_map(l, x, y, s1, s2, s3: byte);
var
  dir        : byte;
  i          : word;
begin
  FillByte(pointer(screen), 960, 0);
  GotoXY(0,0);
  write('level=', l,' x=', x, ' y=', y);
  GotoXY(0,24);
  write('s1=', s1,' s2=', s2, ' s3=', s3);

  seed1 := s1; seed2 := s2; seed3 := s3;

  for i := 800 downto 0 do begin
    dir := pseudo_rnd_dir;
    case dir of
      0 : if y > 1  then Dec(y);
      1 : if y < 22 then Inc(y);
      2 : if x > 1  then Dec(x);
      3 : if x < 38 then Inc(x);
    end;
    Poke(screen + x + y * 40, $80);
  end;
end;

//-----------------------------------------------------------------------------

procedure slide_show;
var
  x, y       : byte;
  s1, s2, s3 : byte;
begin
  level := 1;
  repeat
    //x := 19; y := 11;
    //play with x & y values ;)
    x := 12 + RANDOM and %111; y := 8 + RANDOM and %11;
    s1 := RANDOM xor level; s2 := RANDOM xor s1; s3 := RANDOM xor s2;

    render_map(level, x, y, s1, s2, s3);

    Inc(level); COLOR4 := s3;
    pause(200);
  until false;
end;

//-----------------------------------------------------------------------------

begin
  screen := SAVMSC; CursorOff;

  slide_show;

  //render_map(1, 19, 11, 129, 137, 233);
  //pause(200);
  //render_map(2, 19, 11, 186, 14, 37);

  repeat until false
end.

atari000.png.fccddf6fbbde0d4ca5e8a21560e6879c.pngatari000.png.03d8f9d8c5f6a70abe501c8cf0788b0d.png

map-generator.xex

Edited by zbyti
  • Like 4
Link to comment
Share on other sites

  • 3 weeks later...

As a reminder, for those who are new here, I continue to develop, maintain, and extend a set of useful libraries for Mad-Pascal:

 

https://gitlab.com/bocianu/blibs

 

It gets updated every few months and now it can really help you develop new stuff.

CHANGELOG https://gitlab.com/bocianu/blibs/-/blob/master/CHANGELOG

Documentation: https://bocianu.gitlab.io/blibs/

 

You can also find couple of examples for every library included.

I hope some of you find it useful in your projects.

  • Like 3
  • Thanks 3
Link to comment
Share on other sites

These are great programming tools. I check them periodically and it is great to see they are actively maintained. Before that I was looking for a solution for xbios and thought of working on it myself, but I knew it would be big chore to do. I was happy to see its support with blibs libraries. I will go through all the features and probably make use of them in future projects, including support for extra memory and display lists. These are seen in Mad Pascal examples already.

 

Thanks to you and Tebe for continuous work on these great development tools.

And of course zbyti for making good example listings and benchmarks :)

 

  • Like 1
Link to comment
Share on other sites

  • 2 weeks later...
  • 3 weeks later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...