Mad Pascal examples

[tebe]

 

 
{
Just a test of 3-frame snake-bob animation. By Bill Kendrick 12/29/94.
After watching the DragonBob part of Slight's "Bitter Reality" megademo,
I decided to try my hand at the animation routine.
(I should use the display list, but was lazy).
 
The animation is done by having three screens which are constantly flipped
through.  An object ("bob"), in this case a small circle, is moved around
the screen.  It is placed on the current screen, so when the next
frame appears, it is gone.  In the next frame after THAT, it is gone
as well.  Finally, in the NEXT frame, it reappears.  It sounds dumb, but
when it's moving, it looks like they are ALL constantly moving.  (Oh, and
you use THREE frames because if you used only two, there'd be only motion
and no DIRECTION).
 
-bill!  kendrick@vax.sonoma.edu
}
 
uses crt, graph, joystick;
 
var
ss: array [0..2, 0..1920-1] of byte;
 
q: byte;
x, y, xm, ym: smallint;
 
sc: pointer;
 
begin
 
 InitGraph(6+16);
 
 sc:=pointer(dpeek(88)); SetColor(1);
 
 repeat
pause;
 
inc(q);
if q > 2 then q:=0;
 
move(@ss[q,0], sc, 1920);
 
if strig0=1 then begin inc(x, xm); inc(y, ym) end;
 
if x>=152 then begin x:=152; xm:=-(random(3)+1) end;
if x<=0 then begin x:=0; xm:=random(3)+1 end;
if y>=88 then begin y:=88; ym:=-(random(3)+1) end;
if y<=0 then begin y:=0; ym:=random(3)+1 end;
 
Circle(x+4, y+4, 2);
 
move(sc, @ss[q][0], 1920);
 
 until keypressed;
 
end.

bobs.zip

[funkheld]

what is this :

 

intr(iVBL, @scroll);

intr(iDLI, @dli);

intr not found.

greeting

[tebe]

https://www.freepascal.org/docs-html/rtl/dos/intr.html

[funkheld]

where can I find it in Madpascal?

I can not integrate it.

greeting

[tebe]

it's build in

 

INTR is replaced by GETINTVEC, SETINTVEC (12.06.2016)

 

  GETINTVECTOK:
    begin
    CheckTok(i + 1, OPARTOK);

    i := CompileConstExpression(i + 2, ConstVal, ActualParamType);
    GetCommonType(i, INTEGERTOK, ActualParamType);

    CheckTok(i + 1, COMMATOK);

    if not(ConstVal in [0..1]) then
      Error(i, 'Interrupt Number in [0..1]');

    CheckTok(i + 2, IDENTTOK);
    IdentIndex := GetIdent(Tok[i + 2].Name^);

    if IdentIndex = 0 then
      iError(i + 2, UnknownIdentifier);

    if not (Ident[IdentIndex].DataType in Pointers) then
      iError(i + 2, IncompatibleTypes, 0, Ident[IdentIndex].DataType , POINTERTOK);

    svar := GetLocalName(IdentIndex);

    inc(i, 2);

    case ConstVal of
     ord(iDLI): begin
                 asm65('');
                 asm65(#9'lda VDSLST');
                 asm65(#9'sta '+svar);
                 asm65(#9'lda VDSLST+1');
                 asm65(#9'sta '+svar+'+1');
                end;

     ord(iVBL): begin
                 asm65('');
                 asm65(#9'lda VVBLKD');
                 asm65(#9'sta '+svar);
                 asm65(#9'lda VVBLKD+1');
                 asm65(#9'sta '+svar+'+1');
                end;
    end;

    CheckTok(i + 1, CPARTOK);

//    GenerateInterrupt(InterruptNumber);
    Result := i + 1;
    end;


  SETINTVECTOK:
    begin
    CheckTok(i + 1, OPARTOK);

    i := CompileConstExpression(i + 2, ConstVal, ActualParamType);
    GetCommonType(i, INTEGERTOK, ActualParamType);

    CheckTok(i + 1, COMMATOK);

    StartOptimization(i + 1);

    if not(ConstVal in [0..1]) then
      Error(i, 'Interrupt Number in [0..1]');

    i := CompileExpression(i + 2, ActualParamType);
    GetCommonType(i, POINTERTOK, ActualParamType);

    case ConstVal of
     ord(iDLI): begin
                 asm65(#9'mva :STACKORIGIN,x VDSLST');
                 asm65(#9'mva :STACKORIGIN+STACKWIDTH,x VDSLST+1');
                 a65(__subBX);
                end;

     ord(iVBL): begin
                 asm65(#9'lda :STACKORIGIN,x');
                 asm65(#9'ldy #5');
                 asm65(#9'sta wsync');
                 asm65(#9'dey');
                 asm65(#9'rne');
                 asm65(#9'sta VVBLKD');
                 asm65(#9'ldy :STACKORIGIN+STACKWIDTH,x');
                 asm65(#9'sty VVBLKD+1');
                 a65(__subBX);
                end;
    end;

Edited October 3, 2018 by tebe

[funkheld]

-------------------------------------------

INTR is replaced by GETINTVEC, SETINTVEC

-------------------------------

Hi good afternoon.

where do i find the routine?

in which folder can I read it please.

greeting.

Edited October 4, 2018 by funkheld

[tebe]

DYCP, narrow screen

dycp_narrow.zip

[tebe]

pm_starfield

 

uses crt, atari;

var
	i: byte;
	tab, add: array [0..255] of byte;

begin

 for i:=0 to 255 do begin
  tab[i]:=peek($d20a);
  add[i]:=peek($d20a) and 3 + 1;
 end;

 sizep0:=0;
 grafp0:=1;

 repeat

  i:=vcount;

  wsync:=0;

  hposp0:=tab[i];

  inc(tab[i], add[i]);


 until keypressed;

end.

pm_starfield.zip

[tebe]

hscroll by Bocianu

 

blibs, https://gitlab.com/bocianu/blibs

 

program hscroll;
{$librarypath blibs}
uses atari, b_dl;

const
  dlist = $5000;
  vmem = $5100;

var hscroll:byte = 3;
    offset:byte = 0;
    blankSize:byte = 0;
    s:string = 'hello! it is an jumping pascal scroll!!'~;
    blanks:array[0..15] of byte = (
        DL_BLANK8, DL_BLANK7, DL_BLANK6, DL_BLANK5, DL_BLANK4, DL_BLANK3, DL_BLANK2, DL_BLANK1,
        DL_BLANK1, DL_BLANK2, DL_BLANK3, DL_BLANK4, DL_BLANK5, DL_BLANK6, DL_BLANK7, DL_BLANK8
    );

begin

  DL_Init(dlist);
  DL_Push(DL_BLANK8, 12); // 12 blank lines
  DL_Push(DL_MODE_40x24T2 + DL_HSCROLL + DL_LMS, vmem); // textline
  DL_Push(DL_JVB, dlist); // jump back
  DL_Start;

  move(s[1],pointer(vmem+42),sizeOf(s)); // copy text to vram
  color2:=0;

  repeat
    pause;
    if hscroll = $ff then begin // $ff is one below zero
        hscroll := 3;
        offset := (offset + 1) mod 80; // go trough 0-79
        DL_PokeW(13, vmem + offset); // set new memory offset
    end;
    hscrol := hscroll; // set hscroll
    dec(hscroll);
    blankSize := (blankSize + 1) and 15; // go trough 0-15
    DL_Poke(10, blanks[blankSize]); // set new blankline height
  until false;

end.

hscroll.zip

Edited November 27, 2018 by tebe

[Gury]

The best thing about Mad Pascal is how short the code is for resulting effect take place. And of course, it is fast and binary is small.

 

[tebe]

few examples about cross compiling PC / ATARI 8bit

mp_pc_atari.zip

Edited December 7, 2018 by tebe

[pirx]

Happy birthday tebe!!!!

[tebe]

Vasiliy Tereshkov "My Pascal compiler and Polish contemporary art"

 

https://habr.com/en/post/440372/?fbclid=IwAR3JZRGaCP3d0SGp2BnLg7IpXNa0gw3ITtjgVKu0iFXdQz-1U-b5fr6Nqqo

[_The Doctor__]

Vasiliy Tereshkov "My Pascal compiler and Polish contemporary art"

 

https://habr.com/en/post/440372/?fbclid=IwAR3JZRGaCP3d0SGp2BnLg7IpXNa0gw3ITtjgVKu0iFXdQz-1U-b5fr6Nqqo

Very happy to click that link. I enjoyed reading it.

[gawor]

Random-dot stereogram generator - my first project made with Mad Pascal. Code optimized for readability, not speed.

stereogr.zip

[zbyti]

Sprite example WIP

 

main.xex

[xxl]

On 1/20/2020 at 3:08 PM, gawor said:

Random-dot stereogram generator - my first project made with Mad Pascal. Code optimized for readability, not speed.

stereogr.zip 9.96 kB · 20 downloads

 

this is great!!!!

have you tried colored in GTIA modes?

 

[zbyti]

Oh, well, I forgot provide some snippet.

procedure vbi; interrupt;
begin
  asm { phr };
  //------------------> test <-------------------

  if (RTCLOK and %11) = 0 then begin
    if (TRIG0 = 0) then Poke(dl2Lms + bCannonX + wCannonY,2);
  end;

  if dl2Lms > GAME_LMS_EMD then Dec(dl2Lms) else dl2Lms := GAME_LMS;

  wTmp1 := dl2Lms;

  asm {
        ldx #GAME_SCREEN_ROWS
        ldy #0
  clr:  tya
        sta (GLOBALS.WTMP1),y
        lda GLOBALS.WTMP1
        add #40
        sta GLOBALS.WTMP1
        bcc @+
        inc GLOBALS.WTMP1+1
  @:    dex
        bpl clr
  };

  //------------------> end <--------------------
  asm { plr };
end;

of course when dl2Lms reach GAME_LMS_EMD coarse scroll will not loop in the final (tutorial) game.

[zbyti]

I decided release whole source, maybe someone find it useful?

 

 

game-sources.zip main.xex

Edited December 17, 2020 by zbyti
xex

[Gury]

Wonderful, I will analyze the code.

I tried the game, moving around and shooting at the stars, but didn't get any score yet.

 

[zbyti]

Yes, its starter code only because desire to write in K65 has won in me and so far I am putting it off, indefinitely  But "I'll be back"  

Edited December 17, 2020 by zbyti
I'll be back

[zbyti]

30 minutes ago, Gury said:

I tried the game, moving around and shooting at the stars, but didn't get any score yet.

[Gury]

Probably, if my aim will be good enough

 

It will be very interesting to see which will prevail for you, K65 probably. I see you have more love for Pascal-like languages than C. KickC brought more interest of all choices for this language, I suppose.

 

[tebe]

On 12/15/2020 at 1:45 PM, zbyti said:

Oh, well, I forgot provide some snippet.

procedure vbi; interrupt;
begin
  asm { phr };
  //------------------> test <-------------------

  if (RTCLOK and %11) = 0 then begin
    if (TRIG0 = 0) then Poke(dl2Lms + bCannonX + wCannonY,2);
  end;

  if dl2Lms > GAME_LMS_EMD then Dec(dl2Lms) else dl2Lms := GAME_LMS;

  wTmp1 := dl2Lms;

  asm {
        ldx #GAME_SCREEN_ROWS
        ldy #0
  clr:  tya
        sta (GLOBALS.WTMP1),y
        lda GLOBALS.WTMP1
        add #40
        sta GLOBALS.WTMP1
        bcc @+
        inc GLOBALS.WTMP1+1
  @:    dex
        bpl clr
  };

  //------------------> end <--------------------
  asm { plr };
end;

of course when dl2Lms reach GAME_LMS_EMD coarse scroll will not loop in the final (tutorial) game.

do not mix Pascal code with the assembler in the INTERRUPT block, it is very dangerous, leads to unstable program operation

 

Pascal code reused variable :BP, :BP2, :STACKORIGIN+XX, X register

Edited December 26, 2020 by tebe

[zbyti]

3 hours ago, tebe said:

do not mix Pascal code with the assembler in the INTERRUPT block, it is very dangerous, leads to unstable program operation

 

Pascal code reused variable :BP, :BP2, :STACKORIGIN+XX, X register

Yes, I learnt this case (with X register) writing copy ship procedure.

procedure copyShip; assembler;
asm {
        ldy #>P0_ADR
        sty p0Ship+2
        sty clrP0+2
        iny
        sty p1Ship+2
        sty clrP1+2

        ldy BSHIPY
        sty p0Ship+1
        sty p1Ship+1

        ;move
        ldy #GFX_SHIP_SEG-1
@:      lda GFX_SHIP_ADR,y
p0Ship: sta P0_ADR,y
        lda GFX_SHIP_ADR+GFX_SHIP_SEG,y
p1Ship: sta P1_ADR,y
        dey
        bpl @-

        ;clear
        ldy BSHIPY
        lda JOY.JOYDIRECTION
        and #%0011
        cmp #JOY_DOWN
        beq @+
        tya
        add #SHIP_Y_STEP*2
        bne @+1
@:      tya
        sub #SHIP_Y_STEP
@:      sta clrP0+1
        sta clrP1+1

        lda #0
        ldy #GFX_SHIP_SEG-SHIP_Y_STEP-1
clrP0:  sta P0_ADR,y
clrP1:  sta P1_ADR,y
        dey
        bpl clrP0
};
end;

But now I move this stuff to X16 and on this platform ASM in Mad Pascal will not be justified because on 8MHz + VERA Mad Pascal is fast enough to not bother with MADS snippets.

Edited December 26, 2020 by zbyti
typo