Mad Pascal examples

[tebe]

code: Bocianu Boczansky

 

 

uses crt, fastgraph;
 
const xsize    = 80;
const ysize    = 48; 
const maxLines     = 5;
const xspeed    = 2;
 
const lineSpanX    = xsize div (maxLines-1);
const lineSpanY    = ysize div 3;
const lineY1    = 0;
const LineY2     = lineSpanY;
const LineY3     = lineSpanY shl 1;
const LineY4       = ysize-1;
const XOffset     = xsize shr 2;
      
var lineX1, lineX2, i, c, sc: byte;
 
var wsync  : byte absolute $D40A;
 
 
procedure putLine(x:byte); 
begin
lineX2 := (x shr 1) + XOffset;
MoveTo (x, lineY1);
LineTo (lineX2, lineY2); 
LineTo (lineX2, lineY3); 
LineTo (x, lineY4); 
end;
 
procedure setAtX(x:byte);
begin
for i := 0 to maxLines-1 do begin 
SetColor(0);    
wsync:=1;
putLine(x-xspeed);
if (x > xsize) then break;
SetColor(c);
putLine(x);
Inc(c);
if c>3 then c:=1;
Inc(x, lineSpanX);
    end; 
end;
 
begin
 
InitGraph(5);
LineX1 := 0; 
sc := 1;
repeat 
c := sc;
setAtX(LineX1);
Inc(LineX1,xspeed);
if LineX1 >= lineSpanX then begin
Dec(sc);
if sc<1 then sc:=3;
LineX1 := 0;
end;
until KeyPressed;
 
end.

clines.zip

[tebe]

sphere

 

 

uses crt, fastgraph;
 
var cx, cy, x, y, x2, y2: byte;
    sx, sy, size: real;
    sinx, cosx, siny, tmp: real;
 
procedure Sphere(time: byte);
begin
 
 if time=1 then 
  MoveTo(cx+round(size), cy)
 else
  MoveTo(cx, cy+round(size));
  
 sy:=-11.5*8.0;
 for y:=7 downto 0 do begin
 
  siny:=size*sin(sy*pi/180.0);
 
  sx:=0.0;
  for x:=0 to 32 do begin
 
    tmp:=sx*pi/180.0;
 
    sinx:=sin(tmp);
    cosx:=size*cos(tmp);
 
    if time=1 then begin
      x2:=cx+round(cosx);
      y2:=cy-round(sinx*siny);
    end else begin
      x2:=cx-round(sinx*siny);
      y2:=cy+round(cosx);
    end;
 
    LineTo(x2,y2);
 
    sx:=sx-12.0;
  end;
 
 sy:=sy+12.0;
 end;
 
end;
 
 
begin
 
size:=90.0;
 
cx:=160; cy:=96;
 
InitGraph(24); SetColor(1);
 
Sphere(1);
Sphere(2);
 
repeat until keypressed;
 
end.

sphere.zip

[+JAC!]

This is really getting better at an incredible speed. And having all the examples is really cool.

[tebe]

starfield

 

 

uses crt, fastgraph;
 
const star_max = 64;
star_speed = 2;
 
w = 160;
h = 96;
 
var star_x, star_y, px, py: array [0..star_max-1] of byte;
star_s: array [0..star_max-1] of shortint;
 
x, y, i: byte;
 
 
procedure init;
begin
randomize;
 
x:=w shr 1;
y:=h shr 1;
 
for i:=0 to star_max-1 do begin
star_x[i]:=random(0);
star_y[i]:=random(0);
star_s[i]:=random(0);
end;
  
end;
 
 
procedure anim;
begin
 
  for i:=0 to star_max-1 do begin
 
    SetColor(0);
    PutPixel(px[i], py[i]); 
  
    dec(star_s[i], star_speed);
    if (star_s[i] < 0) then star_s[i]:=random(64);
 
    px[i] := x+(star_x[i] div star_s[i]);
    py[i] := y+(star_y[i] div star_s[i]);
 
    SetColor(1);
    PutPixel(px[i], py[i]);
 
  end;
 
end;
 
 
 
begin
 
 InitGraph(7+16);
 SetColor(1);
 
 init;
 
 repeat
  pause;
anim; 
 until keypressed;
 
end.

starfield.zip

[Gury]

Waw, nice little effect. It shows what can be done with little effort, especially with Mad Pascal and Mad Assembler, which tandem is lightning fast.

 

It's just about imagination what limits us.

Edited February 6, 2017 by Gury

[dmsc]

Hi!

 

I ported a small text mode solitaire game that I programmed in college from TurboPascal to Mad Pascal, it was fun.

 

Porting changes where:

- The original program used colors for the cards, I removed all color references so the program is "white on blue".

- As the screen is only 40 columns across, I compressed the screen somewhat.

- Mad Pascal does not support "Enumerated Types", I replaced it with char constants.

- Also, two dimensional arrays and non-zero based arrays where replaced by simple flat arrays (using "i * width + j" accesses).

 

After that, I replaced all "integer" types with "byte" and "shortint", this reduced the generated code in half.

 

Well, source is in "sol.pas" file (added a .txt extension to allow uploading), attached is a small ATR with the compiled program, simply type "SOL" to play. As the "E:" handler used to output is *slow*, I also included a simple "E:" handler replacement, load it before te game by typing "FLASH40".

sol.atr

sol.pas.txt

[dmsc]

Hi!,

 

New version of my solitaire game, now the program only redraws moved cards, so it's a lot faster.

 

As before, attached source and ATR with binary, and some images;

 

Later in the game:

 

And proof that you can win :

sol.atr

sol.pas.txt

[Gury]

Nice solitaire game, thank you. It is good to see the source code published, for others to analyze the inner workings.

[dmsc]

Hi!

 

Nice solitaire game, thank you. It is good to see the source code published, for others to analyze the inner workings.

Thanks, I'm not proud of the code, was written a really long ago. Also, comments and variable names are in spanish

 

I'm impressed with MadPascal, compatibility with TP is great (even accepts some Delphi extensions), with only a little modifications (for the control characters), the same code can be compiled with FPC to generate a Windows or Linux binary.

 

Attached is the source modified to remove all control characters and re-adding the text color changes, i does not look as good in a Linux terminal, but it works:

 

 

Included in the ZIP file are binaries for Linux, DOS and Windows

sol-txtonly_v10.pas.txt

solitario.zip

[pirx]

At last someone won this Solitario!!!

 

2 times cards were garbled, moving cursor over them fixed the view. It happened in first and last column.
The variant is a bit more difficult than windows version because taking cards from the final stack is not possible.

 

Warp speed helps a bit : )

 

Had fun, thanx : )))

[dmsc]

Hi!

 

At last someone won this Solitario!!!

 

2 times cards were garbled, moving cursor over them fixed the view. It happened in first and last column.

The variant is a bit more difficult than windows version because taking cards from the final stack is not possible.

 

Warp speed helps a bit : )

 

Had fun, thanx : )))

I fixed a display issue, perhaps it's the same that you saw, and a bug that let you put a King over the dealing deck.

 

Attached are the new versions, have fun!

sol.atr

sol_v12.pas.txt

[pirx]

magnifique!

Won again with less attempts this time!

The accelerator rulz, completely forgot such marvels existed.

 

Still a glitch - looks like card to be moved shifts one char to the left. altstate attached.

[dmsc]

Hi!,

 

magnifique!

Won again with less attempts this time!

The accelerator rulz, completely forgot such marvels existed.

 

Still a glitch - looks like card to be moved shifts one char to the left. altstate attached.

Seems you forgot to attach?

 

Thanks!

[pirx]

Hey,

yea, 2 clicks. it gets me every time.

sol.err.altstate.zip

[dmsc]

Hi!,

 

magnifique!

Won again with less attempts this time!

The accelerator rulz, completely forgot such marvels existed.

 

Still a glitch - looks like card to be moved shifts one char to the left. altstate attached.

I knew that glitch, it's because all cards don't fit in the screen. I finally re-arranged the program, simplifying it a lot and fixed that last redraw problem. Also, I put the card at that position (over the last card stack) because you can't write at the last screen column using the "E:" handler without messing all the lines bellow (never understood why atari programmed it that way).

 

New version attached, Mad Pascal sources and compiled ATR.

sol_v14.pas.txt

sol.atr

[tebe]

uses crt, fastgraph;
 
const maxLines     =16;
      maxDrawLines =500;
 
type  LineDescr  = array [0..3] of smallint;
 
var   Ball,
      Vel,
      max          : LineDescr;
      Lines        : array [0..maxLines, 0..3] of smallint;
 
      t : smallint;
 
      count: word;
 
      i, new, old: byte;
  
begin
 
  InitGraph(8 + 16);
  
  randomize;
 
  max[0]:=ScreenWidth;
  max[1]:=ScreenHeight;
  max[2]:=ScreenWidth;
  max[3]:=ScreenHeight;
 
  for i := 0 to 3 do begin
      Vel[i] :=random(16) - 7;
      Ball[i]:=random(smallint(max[i])) - 160;
  end;
 
  new   := 0;
  old   := 0;
  count := 0;
 
  repeat
 
    for i := 0 to 3 do begin 
 
        t:=Ball[i]+Vel[i];
 
if t >= max[i] then begin
            t := max[i] shl 1  - Vel[i] - Ball[i];
            Vel[i] := -Vel[i];
end;
 
if t<0 then begin
            t := -t;
            Vel[i] := -Vel[i];
end;
 
        Ball[i] := t;
    end; 
 
    if (count >= maxLines) then begin
        SetColor(0);
 
        Line (lines[old, 0], lines[old, 1], lines[old, 2], lines[old, 3]);
 
        old:=(old+1) mod maxLines;
    end;
 
    Lines[new, 0] := Ball[0];
    Lines[new, 1] := Ball[1];
    Lines[new, 2] := Ball[2];
    Lines[new, 3] := Ball[3];
 
    new:=(new+1) mod maxLines;
 
    SetColor(1);    
    Line (ball[0], ball[1], ball[2], ball[3]);
 
    inc(count);
 
    until (consol<>cn_none) or (count=MaxDrawLines);
 
  repeat until consol<>cn_none;
  
end.

in attachment, program with one and two-dimensional array

two_dimensional.zip

Edited March 12, 2017 by tebe

[funkheld]

lines.obx 6,7 kb is the to big.

 

greeting

[Gury]

This is logical, because it uses one-dimensional array. Look at the second example, which uses two-dimensional array for the same task, producing shorter code. This is obivously new feature implemented in Mad Pascal, one of the most important. Great.

[tebe]

new unit OBJECTS (MadPascal 1.4.7) , TMemoryStream implementation

TMemoryStream.Create
TMemoryStream.ReadBuffer
TMemoryStream.ReadByte
TMemoryStream.ReadDWord
TMemoryStream.ReadWord
TMemoryStream.WriteBuffer
TMemoryStream.WriteByte
TMemoryStream.WriteDWord
TMemoryStream.WriteWord

new resource type EXTMEM

label EXTMEM 'filename'

load FILENAME at address LABEL (32bit)

 
uses crt, graph,  objects, atari;
 
{$r vscrol.rc}
 
const
 
bitmap = 0; // extended memory address 32bit
 
var
m: TMemoryStream;
 
tb: array [0..0] of byte;
 
i: byte;
 
l, d: smallint;
 
begin
 
 InitGraph(15 + 16);
 
 color0:=4;
 color1:=6;
 color2:=8;
 color4:=0;
 
 tb:=pointer(dpeek(88));
 
 m.create;
 
 d:=40;
 l:=0;
 
 repeat
m.position := l + bitmap;
m.ReadBuffer(tb, 192*40);
 
inc(l, d);
if (l = 586*40) or (l = 0) then d := -d;
 
 until keypressed;
 
end.

TMemoryStream.zip

Edited May 22, 2017 by tebe

[tebe]

new game, written in MadPascal by Wojciech Bociański (anticShop) at "WAP-NIAK 2017"

 

"Vox Regis" (Mad Kingdom)

 

http://www.pouet.net/prod.php?which=70040

 

https://gitlab.com/bocianu/MadKingdom/tree/master

Edited May 22, 2017 by tebe

[Gury]

Realy amazing, new features make this compiler even stronger, especially usage of extended memory and additional optimizations.

 

As I walk through code comparing high-level native and cross-compiler languages, I see Pascal and Action! are definitely more readable as comparable C code listings, for example CC65.

 

Game is interesting too, thanks.

[tebe]

Jet Graphics Planner (JGP), Graphics 4+

 

http://tajemnice.atari8.info/5_93/5_93_jgp.html

 

uses crt, graph, atari;

{$r engine.res}

const
	width = 32;
	mode = 4;

	fnt1	= $a000;
	fnt2	= $a400;

	jgpfnt	= fnt1-6;

type
	TLineDisplay = record
	                      cmd: byte;
			      adr: word;
	               end;

	TJGPBlock = object

		x, y: byte;

		procedure Put(a: byte);
	end;


var	scr: array [0..11, 0..15] of word;

	jgp: TJGPBlock;

	a,b: byte;


procedure TJGPBlock.Put(a: byte);
var tmp, inv: byte;
    w: word;
begin
	inv := a and $80;

	tmp := (a and $7f) * 2;
	w := tmp + (tmp or 1) shl 8;

	if inv<>0 then w:=w or $8080;

	scr[y,x] := w;

	inc(x);
	if x>15 then begin
		x:=0;
		inc(y);

		if y>11 then y:=0;
	end;

end;


procedure VBL; interrupt; assembler;
asm
{	mva #scr32 dmactl

	lda >fnt1
	sta chbase

	mva #$12 color0
	mva #$c2 color1
	mva #$7c color2
	mva #$fe color3

	mwa #MAIN.DLI.r0 vdslst

	jmp xitvbv
};
end;


procedure DLI; interrupt; assembler;
asm
{	?fnt = fnt1

	.rept 24,#,#+1

	?fnt = ?fnt ^ [fnt1^fnt2]

r%%1	.local
	pha

fnt	lda >?fnt
	sta wsync
	sta chbase

	ift %%1<>23
	mwa #r%%2 vdslst
	eif

	pla
	rti
	.endl

	.endr
};
end;


procedure InitJGP;
var a: ^TLineDisplay;
    i: byte;
    w: word;
begin

 InitGraph(7 + 16);

 a:=pointer(dpeek(560));

 a^.cmd:=$70;
 a^.adr:=$7070;

 w := dpeek(88);

 scr:=pointer(w);

 for i:=0 to 11 do begin

  inc(a);
  a^.cmd:=$40 or mode or $80;
  a^.adr:=w;

  inc(a);
  a^.cmd:=$40 or mode or $80;
  a^.adr:=w;

  inc(w, width);

 end;

 a^.cmd := $40 or mode;

 inc(a);
 a^.cmd := $41;
 a^.adr := dpeek(560);

 SetIntVec(iVBL, @vbl);
 SetIntVec(iDLI, @dli);

 nmien := $c0;

end;



begin

 InitJGP;

 jgp.x := 0;
 jgp.y := 0;

 for b:=0 to 3 do
  for a:=0 to 15 do jgp.put(a+b*16);

 jgp.y := 5;

 for b:=0 to 3 do
  for a:=0 to 15 do jgp.put(a+b*16 + $80);


 repeat until keypressed;

end.

jgp.zip

Edited May 28, 2017 by tebe

[peteym5]

Top Ten Game Score Sample. I am working on a template to so I can build several Atari Cartridge Games in Pascal and Assembly. I like how I can use ASM {} to make ML routines to do specific tasks.

uses atari, crt, sysutils;

var	
  i : Byte;
  k : Byte;
	titlephase: Byte = 0;
  score: word = 2000;
  hiscore  : array [0..10] of word = (0,9500,8500,7500,6500,5500,4500,3500,2500,1500,500);
begin
  InitGraph(0);
asm {
  lda #0
  sta 82
  sta 710
  lda #12
  sta 709
};

  ClrScr;  
  CursorOff;
  GotoXY(0, 2);  
  writeln('  ** Top Ten High Score Demonstration **');
  k := 11;
  i := 10;
  repeat     
      if score>hiscore[i] then 
        begin;
          k := i
        end;
      i := i - 1    
  until i = 0;
  if k < 10 then 
    begin;
      i := 10;  
      repeat
        hiscore [i] := hiscore [i-1];
        i := i - 1    
      until i = k;
      hiscore [k] := score
    end;
   GotoXY(12, 6); 
   write('Score:',score);
   GotoXY (8,10);
   write ('Todays High Scores.');
   for i := 1 to 10 do
    begin;
      if k = i then
        begin 
          GotoXY(12,11+i);
          write('*');
        end;
      if i = 10 then
        begin
          GotoXY(13, 11+i);
        end
      else
        begin
          GotoXY(14, 11+i);
        end;
      write (i,' :');
      GotoXY(18, 11+i);      
      write(hiscore[i]);
     end;  
   GotoXY(7, 23);
   write('Press Start to Begin.');
 repeat until keypressed; 
end.

[tebe]

uses atari, crt;



var

  i : Byte;

  k : Byte;

  titlephase: Byte = 0;

  score: word = 2000;

  hiscore  : array [0..10] of word = (0,9500,8500,7500,6500,5500,4500,3500,2500,1500,500);

begin



  lmargin := 0;

  color2 := 0;

  color1 := 12;



  ClrScr;



  CursorOff;

  GotoXY(0, 2);

  writeln('  ** Top Ten High Score Demonstration **');

Edited May 28, 2017 by tebe

[peteym5]

Why is this not setting to the address of the screen???

  dl: array [0..28] of byte = (
  $70,$70,$43,
  lo(word(@screen)), 
  hi(word(@screen)),  
  $03,$03,$03,$03,$03,$10,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$41,
  lo(word(@dl)), 
  hi(word(@dl))
  );

var
  screen :word absolute $B000;