Jump to content
IGNORED

Mad Pascal examples


Gury

Recommended Posts

Wave with MP

 

http://atarionline.pl/forum/comments.php?DiscussionID=5979&page=1#Item_18

 

uses crt, atari, efast;

const

CHARSET_ADDRESS = $8000;

var i: byte;
    ch: array [0..31] of byte absolute CHARSET_ADDRESS;
begin

chbas:=hi(CHARSET_ADDRESS);
lmargin:=0;

for i:=0 to 7 do ch[i+i*8]:=255;

repeat

 poke(690, 255);
 write(#32#33#34#35#36#37#38#39#38#37#36#35#34#33);

until keypressed;

end.

wave.png

wave.7z

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

Hi!

59 minutes ago, tebe said:

Wave with MP

 

http://atarionline.pl/forum/comments.php?DiscussionID=5979&page=1#Item_18

 


uses crt, atari, efast;

const

CHARSET_ADDRESS = $8000;

var i: byte;
    ch: array [0..31] of byte absolute CHARSET_ADDRESS;
begin

chbas:=hi(CHARSET_ADDRESS);
lmargin:=0;

for i:=0 to 7 do ch[i+i*8]:=255;

repeat

 poke(690, 255);
 write(#32#33#34#35#36#37#38#39#38#37#36#35#34#33);

until keypressed;

end.

 

Be careful!

 

- The array is defined from 0...31, but used from 0 to 63.

- The memory area is not cleared, so the program will only work of no other program was loaded first in that memory.

 

Have Fun!

  • Like 1
Link to comment
Share on other sites

DMSC, thank you for your vigilance :)

 

uses crt, atari, efast;

const
CHARSET_ADDRESS = $8000;

var i: byte;
    ch: array [0..255] of byte absolute CHARSET_ADDRESS;

begin
fillchar(ch, sizeof(ch), 0);

chbas:=hi(word(@ch));
lmargin:=0;

for i:=0 to 7 do ch[i+i*8]:=255;

repeat

 poke(690, 255);
 write(#32#33#34#35#36#37#38#39#38#37#36#35#34#33);

until keypressed;

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

@ilmenit you know :D Power C and PROMAL ;)

 

sieve_action.rc

SIEVE rcdata 'action_sieve.xex' 6

main.pas

{$r sieve_action.rc}

const
  SIEVE          = $4000;
  ATTRIBUTE_ADDR = $0800;
  SCREEN_ADDR    = $0c00;
  CHARSET        = $3000;

var
  DETIRQSRC                          : byte absolute $ff09;
  SETIRQSRC                          : byte absolute $ff0a;
  RC                                 : byte absolute $ff0b;
  TED_FF12                           : byte absolute $ff12;
  CHBAS                              : byte absolute $ff13;
  IRQVEC                             : word absolute $fffe;

var
  count                              : word absolute $ca;
  time                               : word absolute $cc;
  i, tmp                             : byte;

procedure initFonts;
begin
  Move(pointer($d000), pointer(CHARSET), $400);
  TED_FF12 := TED_FF12 and %11111011;
  CHBAS := (CHBAS and %11) or 12 shl 2;
end;

procedure printBinScore;
begin
  FillChar(pointer(SCREEN_ADDR), 24 * 40, $20);
  tmp := 128;
  for i := 0 to 7 do begin
    if boolean(time and tmp)
      then poke(SCREEN_ADDR + i, $31)
      else poke(SCREEN_ADDR + i, $30);
    tmp := tmp shr 1;
  end;
end;

procedure vbi; assembler; interrupt;
asm
      pha
      inc c4p_time+2
      inc $14
      mva #2 DETIRQSRC
      pla
end;

procedure initSystem; assembler;
asm
      sei
      sta $ff3f
      lda #2
      sta DETIRQSRC
      sta SETIRQSRC
      mva #204 RC
      mwa #VBI IRQVEC
      cli
end;

begin
  initFonts; pause; initSystem; pause;

  asm
    jsr SIEVE+$a
  end;

  printBinScore;

  repeat until false;
end.

Screenshot_2021-04-23_16-02-17.thumb.png.96852a299213fa8b84b87f01decb53c0.png

 

Action! SIEVE code taken from https://atariwiki.org/wiki/Wiki.jsp?page=Review Action source and binary included in archive.

 

 

Action.zip

Edited by zbyti
Link to comment
Share on other sites

action_sieve.act

SET $E=$4000 SET $491=$4000

BYTE ARRAY FLAGS(8190)

CARD I,K,PRIME

CARD
  COUNT=$70

PROC SIEVE()
  COUNT=0         ; init count
  FOR I=0 TO 8190 ; and flags
    DO
    FLAGS(I)='T
  OD

  FOR I=0 TO 8190
    DO
    IF FLAGS(I)='T THEN
      PRIME=I+I+3
      K=I+PRIME
      WHILE K<=8190
        DO
        FLAGS(K)='F
        K==+PRIME
      OD
      COUNT==+1
    FI
  OD
RETURN

sieve_action.rc

SIEVE rcdata 'action_sieve.xex' 6

main.pas

{$r sieve_action.rc}

const
  SIEVE = $4000;


var
  count : word absolute $70;
  clock : byte absolute $a2;

begin
  pause; clock := 0;
  asm
    jsr SIEVE+$a
  end;

  writeln('FRAMES COUNTER = ', clock);
  writeln('PROBE SIZE ', count);

  repeat until false;
end.

Screenshot_2021-04-23_22-37-59.thumb.png.774be9e027a173aa8f878112a0b2bb5f.png

 

@ilmenit do your job ;) 

Action_C64.zip

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

  • 2 months later...
6 hours ago, tebe said:

I tried this on my U1MB equipped machine.  I had to set the RAM to stock else the display was corrupt.  I have not tried in emulator to see if I can reproduce the issue.  Cool project - thanks for the source!

Link to comment
Share on other sites

  • 11 months later...

Hi all!

 

I'm back to 8-bit Atari after more than 30 years.

 

I wrote a simple program in Mad-Pascal that draws and rotates Sierpiński carpet.
I haven't used Pascal for around 28 years so I learn it again.


RotatingSierpinskiCarpet.pas

RotatingSierpinskiCarpet.xex (or run it now)

 

The snippet on GitLab

 

Comments to the program are welcome (here or there).
Especially, how to draw a single frame faster.

 

Regards

Edited by Signum Temporis
  • Like 6
  • Thanks 1
Link to comment
Share on other sites

4 hours ago, Signum Temporis said:

Hi all!

 

I'm back to 8-bit Atari after more than 30 years.

 

I wrote a simple program in Mad-Pascal that draws and rotates Sierpiński carpet.
I haven't used Pascal for around 28 years so I learn it again.

welcom back

thank you for the reported issues on github

 

thank for the sophisticated example :)

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

  • 2 months later...

Hi. Yesterday I wrote simple snake game in text mode. Just for fun.

It has less than 130 lines of code, and maybe my example will be useful for you to learn something.

 

program snake;
uses atari, crt, joystick;

const 
    BOARD_SIZE = 24 * 40;
    TAIL_MAX = 1023;
    BORDER = ord(' '*~);
    FOOD = ord('+'~);
    BODY = ord('O'~);
    DEAD = ord('@'~);

var 
    tail: array [0..TAIL_MAX] of integer;
    headPos, headPtr, clearPtr, tailLength:word;
    b, speed, field, input:byte;
    dir: shortInt;
    gameover: boolean;
    
procedure DrawSnake;
begin
    b := BODY;
    if gameover then b := DEAD;
    Poke(headPos,b);
end;

procedure PutFood;
var foodPos: word;
begin
    repeat 
        foodPos := savmsc + Random(BOARD_SIZE);
    until Peek(foodPos) = 0;
    Poke(foodPos, FOOD);
end;

procedure ClearTail;
var offset: word;
begin
    offset := 0;
    headPtr := (headPtr + 1) and TAIL_MAX;
    tail[headPtr] := headPos;
    if headPtr < clearPtr then offset := TAIL_MAX + 1;
    if headPtr + offset - clearPtr >= tailLength then begin
        if tail[clearPtr] <> tail[headPtr] then Poke(tail[clearPtr],0);
        clearPtr := (clearPtr + 1) and TAIL_MAX;
    end;
end;

procedure DrawBorder;inline;
begin
    for b:=0 to 39 do begin
        poke(savmsc + b, BORDER);
        poke(savmsc + 23*40 + b, BORDER);
        if b<23 then begin
            poke(savmsc + b * 40, BORDER);
            poke(savmsc + b * 40 + 39, BORDER);
        end;
    end;
end;

procedure InitSnake;inline;
begin
    headPos := savmsc + 20 + (12 * 40); // initial position mid screen (20,12) 
    dir := 0;
    headPtr := 0;
    clearPtr := 0;
    tailLength := 5;
    speed := 8;
    tail[0] := headPos;
    gameover := false;
end;

procedure InitGame;inline;
begin
    Randomize;
    InitSnake;
    CursorOff;
    ClrScr;
    DrawBorder;
    DrawSnake;
    PutFood;
end;

function GetInput:byte;
begin
    result := joy_none;
    for b := 0 to speed do begin
        if stick0 <> joy_none then result := stick0;
        Pause;
    end;
end;

begin
    repeat
        InitGame;
        repeat input := GetInput until input <> joy_none; // wait for joy input to start
        
        repeat
            if (input = joy_left) and (dir <> 1) then dir := -1;
            if (input = joy_right) and (dir <> -1) then dir := 1;
            if (input = joy_up) and (dir <> 40) then dir := -40;
            if (input = joy_down) and (dir <> -40) then dir := 40;
            
            headPos := headPos + dir;
            ClearTail;
            field := Peek(headPos);
           
            case (field) of
                FOOD: begin // hit food 
                    PutFood;
                    Inc(tailLength);
                end;
                0: // empty field - do nothing ;
                else gameover := true; // hit antyhing else
            end;

            DrawSnake;
            input := GetInput; 
        until gameover;
        
        Readkey; // wait for any key to restart
    until false;
end.

snake.xex

Edited by bocianu
  • Like 7
Link to comment
Share on other sites

4 hours ago, bocianu said:

Hi. Yesterday I wrote simple snake game in text mode. Just for fun.

It has less than 130 lines of code, and maybe my example will be useful for you to learn something.

 

program snake;
uses atari, crt, joystick;

const 
    BOARD_SIZE = 24 * 40;
    TAIL_MAX = 1023;
    BORDER = ord(' '*~);
    FOOD = ord('+'~);
    BODY = ord('O'~);
    DEAD = ord('@'~);

var 
    tail: array [0..TAIL_MAX] of integer;
    headPos, headPtr, clearPtr, tailLength:word;
    b, speed, field, input:byte;
    dir: shortInt;
    gameover: boolean;
    
procedure DrawSnake;
begin
    b := BODY;
    if gameover then b := DEAD;
    Poke(headPos,b);
end;

procedure PutFood;
var foodPos: word;
begin
    repeat 
        foodPos := savmsc + Random(BOARD_SIZE);
    until Peek(foodPos) = 0;
    Poke(foodPos, FOOD);
end;

procedure ClearTail;
var offset: word;
begin
    offset := 0;
    headPtr := (headPtr + 1) and TAIL_MAX;
    tail[headPtr] := headPos;
    if headPtr < clearPtr then offset := TAIL_MAX + 1;
    if headPtr + offset - clearPtr >= tailLength then begin
        if tail[clearPtr] <> tail[headPtr] then Poke(tail[clearPtr],0);
        clearPtr := (clearPtr + 1) and TAIL_MAX;
    end;
end;

procedure DrawBorder;inline;
begin
    for b:=0 to 39 do begin
        poke(savmsc + b, BORDER);
        poke(savmsc + 23*40 + b, BORDER);
        if b<23 then begin
            poke(savmsc + b * 40, BORDER);
            poke(savmsc + b * 40 + 39, BORDER);
        end;
    end;
end;

procedure InitSnake;inline;
begin
    headPos := savmsc + 20 + (12 * 40); // initial position mid screen (20,12) 
    dir := 0;
    headPtr := 0;
    clearPtr := 0;
    tailLength := 5;
    speed := 8;
    tail[0] := headPos;
    gameover := false;
end;

procedure InitGame;inline;
begin
    Randomize;
    InitSnake;
    CursorOff;
    ClrScr;
    DrawBorder;
    DrawSnake;
    PutFood;
end;

function GetInput:byte;
begin
    result := joy_none;
    for b := 0 to speed do begin
        if stick0 <> joy_none then result := stick0;
        Pause;
    end;
end;

begin
    repeat
        InitGame;
        repeat input := GetInput until input <> joy_none; // wait for joy input to start
        
        repeat
            if (input = joy_left) and (dir <> 1) then dir := -1;
            if (input = joy_right) and (dir <> -1) then dir := 1;
            if (input = joy_up) and (dir <> 40) then dir := -40;
            if (input = joy_down) and (dir <> -40) then dir := 40;
            
            headPos := headPos + dir;
            ClearTail;
            field := Peek(headPos);
           
            case (field) of
                FOOD: begin // hit food 
                    PutFood;
                    Inc(tailLength);
                end;
                0: // empty field - do nothing ;
                else gameover := true; // hit antyhing else
            end;

            DrawSnake;
            input := GetInput; 
        until gameover;
        
        Readkey; // wait for any key to restart
    until false;
end.

snake.xex 1.53 kB · 5 downloads

Is there a version with comments so we can understand what function / command each line is performing?

 

Thanks for sharing it - I can make some of it out, but I'm less Pascal centric, and there must be some Atari specific things here that are over my head.

Link to comment
Share on other sites

31 minutes ago, rdefabri said:

Is there a version with comments so we can understand what function / command each line is performing?

Any particular place you wish me to explain in details?

I think that most of the code is self explanatory.

I tried to use comprehensible variable and function names:

 

headPos - contains snake head position,

tail - array containing snake's tail positions

DrawSnake - draws snakes new position,

ClearTail - clears Tail chars if it gets too long (based on tailLength),

and so on... :)

 

All screen positions are stored as direct video memory addresses,

so if you poke at headPos it draws directly on screen, if you peek position you get charCode at that position. 

To move the snake, the direction variable is added to headPos, to get new position of snake's head on screen.

That's why direction variable valid values are

-1 (move one column left)

1 (one column right)

-40 (one row up)

40 (one row down)

 

just ask what is unclear, I will try to explain it ;)

 

 

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

23 hours ago, bocianu said:

Any particular place you wish me to explain in details?

I think that most of the code is self explanatory.

I tried to use comprehensible variable and function names:

 

headPos - contains snake head position,

tail - array containing snake's tail positions

DrawSnake - draws snakes new position,

ClearTail - clears Tail chars if it gets too long (based on tailLength),

and so on... :)

 

All screen positions are stored as direct video memory addresses,

so if you poke at headPos it draws directly on screen, if you peek position you get charCode at that position. 

To move the snake, the direction variable is added to headPos, to get new position of snake's head on screen.

That's why direction variable valid values are

-1 (move one column left)

1 (one column right)

-40 (one row up)

40 (one row down)

 

just ask what is unclear, I will try to explain it ;)

 

 

Thx!  Nothing specifically, just trying to understand what I can.  I haven't gone through it in detail, so when I do, I'll provide some questions.

Link to comment
Share on other sites

  • 1 month later...

{This is an LZH compression routine used in BRANCH version 0.97. }
{Most of the code here is adapted from LZHSRC10.???              }
{
  The file LZHUF.C is originally written in C. I have re-written it
  in  PASCAL.
}
 

changes to fit in $2000..$AFFF space, small 10KB buffer, compress/decompress one file (10KB)

 

LZHUF.COM E D:INFILE.DAT D:OUTFILE.LZH

LZHUF.COM D D:INFILE.LZH D:OUTFILE.DAT

 

possibility to compile for PC and XE/XL, MP compiler passed the test :)

LZHSRC97.PAS lzhuf.atr

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

  • 1 month later...
  • 3 months later...
9 hours ago, tebe said:

Now this is something to watch... Fast moving 3-D wireframe object...

Also, everybody can learn from this easy-to-read structured Pascal code.

 

Good stuff, Tebe 👍🍻

 

Link to comment
Share on other sites

Link to comment
Share on other sites

Link to comment
Share on other sites

  • 6 months later...

unit GRAPH update: DrawPoly, FillPoly

 

procedure DrawPoly(amount: byte; var vertices);
(*
@description:
Draw polygon
*)
var i: byte;
    P, Q: PWord;
begin

 P:=@vertices;
 Q:=@vertices;

 for i:=0 to amount-2 do begin
  Line(P[0], P[1], P[2], P[3]);

  inc(P, 2);
 end;

 Line(Q[0], Q[1], P[0], P[1]);

end;


procedure FillPoly(amount: byte; var vertices);
(*
@description:
Fill polygon

Adapted from  http://alienryderflex.com/polygon_fill/

https://github.com/tuupola/hagl/blob/master/src/hagl_polygon.c
*)
var i, j, y, miny, maxy, count: byte;
    P, Q: PWord;
    x0,y0,x1,y1, swap: word;
    nodes: array [0..63] of word;
begin

 miny := 255;
 maxy := 0;

 P:=@vertices;

 for i := 0 to amount-1 do begin

   if (miny > P[1]) then miny := P[1];

   if (maxy < P[1]) then maxy := P[1];

   inc(P, 2);

 end;

 // Loop through the rows of the image.
    for y := miny to maxy-1 do begin

        // Build a list of nodes.
        count := 0;
        j := amount - 1;

	P:=@vertices;
	Q:=@vertices + j shl 2;

        for i := 0 to amount-1 do begin

            x0 := P[0];
            y0 := P[1];

            x1 := Q[0];
            y1 := Q[1];

            if ( ((y0 < y) and (y1 >= y)) or ((y1 < y) and (y0 >= y)) ) then begin

                nodes[count] := trunc(x0 + (y - y0) / (y1 - y0) * (x1 - x0));

                inc(count);
            end;

	    Q:=P;

	    inc(P, 2);
	end;

 // Sort the nodes, via a simple 'Bubble' sort.
        i := 0;
        while (i < count - 1) do begin

            if (nodes[i] > nodes[i + 1]) then begin

                swap := nodes[i];
                nodes[i] := nodes[i + 1];
                nodes[i + 1] := swap;

                if i<>0 then dec(i);

            end else
             inc(i);

        end;

 // Draw lines between nodes.
	i:=0;
        while i < count do begin

	    Hline(nodes[i], nodes[i + 1], y);

	    inc(i, 2);
        end;

    end;

end;

 

polygon.obx polygon.pas

  • Like 3
Link to comment
Share on other sites

  • 2 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...