Jump to content
Gury

Mad Pascal examples

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

Share this post


Link to post
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

Share this post


Link to post
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

Share this post


Link to post
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

Share this post


Link to post
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

Share this post


Link to post
Share on other sites
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!

Share this post


Link to post
Share on other sites

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