Jump to content
IGNORED

Mad Pascal


Recommended Posts

  • 2 weeks later...

Hello folks,

 

I had some time to play with this new thing TeBe brought to us :)

 

Have fun with these 3 lines:

// GFX 7 Lines
// pps 2015-08-11
 

var
x1,y1,xx1,yy1 : byte; 
i : byte;
rx1,ry1,rxx1,ryy1 : byte;

x2,y2,xx2,yy2 :byte;
i2 :byte;
rx2,ry2,rxx2,ryy2 : byte;

x3,y3,xx3,yy3 :byte;
i3 :byte;
rx3,ry3,rxx3,ryy3 : byte;

begin

writeln;
writeln;
writeln;
writeln;
writeln;
writeln('       Pascal Lines by PPs');
writeln;
writeln;
writeln('   done with Mad  Pascal by TeBe');
writeln;
writeln;
writeln;
writeln;
writeln;
write('        Strike SPACE bar! ');
repeat until keypressed;
poke(764,255);
InitGraph(7);
i:=1;
i2:=2;
i3:=3;
x1:= Random(160);
y1:= Random(80);
xx1:= Random(160);
yy1:=Random(80);
x2:= Random(160);
y2:= Random(80);
xx2:= Random(160);
yy2:=Random(80);
x3:= Random(160);
y3:= Random(80);
xx3:= Random(160);
yy3:=Random(80);
rx1:=0;
ry1:=0;
rxx1:=0;
ryy1:=0;
rx2:=1;
ry2:=0;
rxx2:=0;
ryy2:=1;
rx3:=1;
ry3:=1;
rxx3:=0;
ryy3:=0;
setcolor(i);
line(x1,y1,xx1,yy1);
setcolor(i2);
line(x2,y2,xx2,yy2);
setcolor(i3);
line(x3,y3,xx3,yy3);
repeat
	setcolor(0);
	line(x1,y1,xx1,yy1);
	if rx1=0 then begin
		inc(x1);
		if x1>158 then rx1:=1;
	end else begin
		dec(x1);
		if x1<1 then rx1:=0;
	end;
	if ry1=0 then begin
		inc(y1);
		if y1>78 then ry1:=1;
	end else begin
		dec(y1);
		if y1<1 then ry1:=0;
	end;
	if rxx1=0 then begin
		inc(xx1);
		if xx1>158 then rxx1:=1;
	end else begin
		dec(xx1);
		if xx1<1 then rxx1:=0;
	end;
	if ryy1=0 then begin
		inc(yy1);
		if yy1>78 then ryy1:=1;
	end else begin
		dec(yy1);
		if yy1<1 then ryy1:=0;
	end;
	setcolor(i);
	line(x1,y1,xx1,yy1);

// 2nd line

	setcolor(0);
	line(x2,y2,xx2,yy2);
	if rx2=0 then begin
		inc(x2);
		if x2>158 then rx2:=1;
	end else begin
		dec(x2);
		if x2<1 then rx2:=0;
	end;
	if ry2=0 then begin
		inc(y2);
		if y2>78 then ry2:=1;
	end else begin
		dec(y2);
		if y2<1 then ry2:=0;
	end;
	if rxx2=0 then begin
		inc(xx2);
		if xx2>158 then rxx2:=1;
	end else begin
		dec(xx2);
		if xx2<1 then rxx2:=0;
	end;
	if ryy2=0 then begin
		inc(yy2);
		if yy2>78 then ryy2:=1;
	end else begin
		dec(yy2);
		if yy2<1 then ryy2:=0;
	end;
	setcolor(i2);
	line(x2,y2,xx2,yy2);

// line 3

//	setcolor(0);
//	line(x3,y3,xx3,yy3);
	inc(i3);
	if rx3=0 then begin
		inc(x3);
		if x3>158 then rx3:=1;
	end else begin
		dec(x3);
		if x3<1 then rx3:=0;
	end;
	if ry3=0 then begin
		inc(y3);
		if y3>78 then ry3:=1;
	end else begin
		dec(y3);
		if y3<1 then ry3:=0;
	end;
	if rxx3=0 then begin
		inc(xx3);
		if xx3>158 then rxx3:=1;
	end else begin
		dec(xx3);
		if xx3<1 then rxx3:=0;
	end;
	if ryy3=0 then begin
		inc(yy3);
		if yy3>78 then ryy3:=1;
	end else begin
		dec(yy3);
		if yy3<1 then ryy3:=0;
	end;
	setcolor(i3);
	line(x3,y3,xx3,yy3);

	poke(77,0);
until keypressed;
end.

Edited by pps
Link to comment
Share on other sites

Hi Folks,

 

I created a small Mad Pascal "Masterdisc" maybee someone here find it useful too.

 

Simply dezip the file anywhere you want. Then go into subdir: owncode and edit source.pas, then you need to go back and double click the @make.bat. If it runs fine, the resulting xex is within output subfolder.

 

MAD Pascal 1.05.zip

 

All files, needed are included (mads is v.1.9.8 )

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

  • 3 weeks later...
  • 4 weeks later...

Mad Pascal 1.1.4

 

first, create Windows Enviroment Variable MPASUNITPATH (path for LIB files)

 

expanded syntax:

var
 tmp: array [0..7] of byte = (0,1,2,3,4,5,6,7);
 s: string[15] = 'atari';
 a: string = 'power'#$9b'with'#$9b'price';
 j: array [0..3] of boolean = (true, false, true, true);
 time: byte absolute $14;
 ptr: ^byte;

predefined function, constants

PI TRUE FALSE
 
LENGTH SIZEOF READLN WRITE WRITELN HALT BREAK EXIT INC DEC CHR ORD ASM
 
PROGRAM USES
 
IF ELSE THEN
 
FOR TO DOWNTO DO
WHILE DO
REPEAT UNTIL
 
LO HI
 
DIV MOD NOT OR AND XOR SHR SHL

String (default [255]) Turbo Pascal style

s[0] - length 0..255
s[1]..[255] chars

Library (LIB)

CRT
ClrScr CursorOff CursorOn Delay DelLine GotoXY InsLine Keypressed ReadKey TextMode TextBackground TextColor WhereX WhereY
 
DOS
SetTime WaitVBL
 
GRAPH
InitGraph SetBkColor SetColor PutPixel MoveTo LineTo Line FloodFill (not working) Circle
 
MATH
Max Min
 
SYSTEM (USES System = default)
Cos DPeek DPoke Fillchar Frac lowerCase Move Peek Poke Random Round Sin Str Trunc upCase Val
 
SYSUTILS
StrToInt IntToHex IntToReal IntToStr StrToFloat

in attachment (EXAMPLE) game Snake, pure Pascal (PC_EXAMPLE compiled examples for PC)

 

p.s.

changes in Delay function, more accuracy with WSYNC

post-4486-0-52597400-1443990984_thumb.jpg

MadPascal114.zip

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

WAW! Amazing, what a gift! Features we all hoped to be implemented! Thank you, Tebe.

 

I did follow your instructions for setting MPASUNITPATH variable, but it only works if you set fixed directory c:\prg\MadPascal\ and you must additionally copy all lib files to MadPascal root directory. So, if I may to suggest a solution, it would be to make lib directory relative to MadPascal root directory, or make it custom, by referencing it in command prompt.

 

Anyway, this is great new language, with huge potential.

Gury

Link to comment
Share on other sites

I did follow your instructions for setting MPASUNITPATH variable, but it only works if you set fixed directory c:\prg\MadPascal\ and you must additionally copy all lib files to MadPascal root directory.

 

any directory, not only c:\prg etc. , set enviroment variable and restart Windows

Link to comment
Share on other sites

Excellent, I like it.

 

Below is simple player/missile example with custom library, all written in Mad Pascal, which I made for testing purposes. The program shows all four players with different colors and different positions.

 

post-7301-0-67131600-1444138611_thumb.png

{
  P/M Graphics demonstration
  by Bostjan Gorisek 2015
  
  Developed in Mad-Pascal by Tebe / Madteam
}
uses crt, graph, pmg;

var
  // Player data
  p0Data2 : array [0.._PM_MAX] of byte = (60, 66, 129, 165, 129, 153, 129, 165, 153, 66, 60, 0, 0, 0, 0);
  p1Data2 : array [0.._PM_MAX] of byte = (124, 130, 254, 254, 124, 56, 16, 16, 16, 16, 16, 16, 16, 124, 254);
  p2Data2 : array [0.._PM_MAX] of byte = (60, 102, 110, 118, 118, 118, 102, 60, 24, 0, 0, 0, 0, 0, 0);
  p3Data2 : array [0.._PM_MAX] of byte = (10, 20, 30, 40, 50, 60, 70, 80, 55, 28, 255,0, 0, 0, 0);
    
// Main code
begin
  // Set graphics mode and playfield colors
  InitGraph(0);
  
  // Initialize P/M graphics
  SetPM(_PM_DOUBLE_RES);
  InitPM(_PM_DOUBLE_RES);  
  
  // Set program colors
  Poke(710, 0); Poke(712, 0);
  // Cursor off
  Poke(752, 1);
  
  writeln(eol,'P/M Graphics demonstration');
  writeln(eol,'by Bostjan Gorisek 2015',eol);

  Move(p0Data2, pointer(p0Data), sizeof(p0Data2));
  Move(p1Data2, pointer(p1Data), sizeof(p1Data2));
  Move(p2Data2, pointer(p2Data), sizeof(p2Data2));
  Move(p3Data2, pointer(p3Data), sizeof(p3Data2));

  // Turn on P/M graphics
  ShowPM(_PM_SHOW_ON);        
            
  // Draw players
  ColorPM(0, 202);
  ColorPM(1, 250);
  ColorPM(2, 136);
  ColorPM(3, 36);
  SizePM(0, _PM_DOUBLE_SIZE);
  SizePM(1, _PM_DOUBLE_SIZE);
  SizePM(2, _PM_QUAD_SIZE);
  SizePM(3, _PM_NORMAL_SIZE);
  MovePM(0, 60, 70);
  MovePM(1, 170, 90);
  MovePM(2, 100, 85);
  MovePM(3, 140, 100);
    
  repeat until keypressed;

  // Reset P/M graphics
  ShowPM(_PM_SHOW_OFF);        
end.

All supporting routines are included in pmg unit, which can be modified and enhanced in any way you want. I didn't manage to use routines from other units, so I duplicated them in my custom unit. This will be fixed when I figure out how to exchange information between units in Mad Pascal.

 

Archive file contains all source code needed to compile, in appropriate directories of Mad Pascal root directory.

 

Greetings,

Gury

 

pmtest.zip

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

mp117 http://mads.atari8.info/mp_117.7z

 

PPS, Acces Violation problem in this version is resolved

 

Gury, PMTEST now is compiled correct (corrected version PMTEST, PMG in package)

 

 

now, is possible without tricks

uses sysutils;
 
function app(a,b: string): string;
var i,k: byte;
begin
 
 k:=1;
 for i:=1 to length(a) do begin
  Result[k] := a[i];
  inc(k);
 end;
 
 for i:=1 to length(b) do begin
  Result[k] := b[i];
  inc(k);
 end;
 
 Result[0]:=chr(k-1);              // set string length
 
end;
 
begin
 
writeln( app('mad ' , 'pascal') );
 
writeln(strtoint('119'));
Edited by tebe
Link to comment
Share on other sites

Excellent! This way projects can be made more modular. Thank you for this new version.

 

A question thou, what is the difference between Poke and DPoke, except storing 1 byte or 2-bytes of values to memory location? Poke works the same way as DPoke in pmg? Just curious...

Link to comment
Share on other sites

 

Must... resist temptation... to start another project before existing project is finished...

Link to comment
Share on other sites

pmg unit new version (1.1): added missile support.

 

Program shows all players and missiles on the screen. You can easily experiment with single-line or double-line resolution P/M graphics by using parameter_PM_DOUBLE_RES or _PM_SINGLE_RES in SetPM and InitPM routines. This program also shows how to use missiles and their sizes. Probably there will be some changes to support missiles on the same line with no data loss with some bitwise masking operations. Please note that DMA (559) should be used accordingly to program memory usage and selected text or graphics mode. Source code is attached below.

post-7301-0-07032300-1444306544_thumb.png post-7301-0-38255300-1444306561_thumb.png

{
  P/M Graphics demonstration
  by Bostjan Gorisek 2015
  
  Developed in Mad-Pascal by Tebe / Madteam
}
uses crt, graph, pmg;

var
  // Player data
  p0Data : array [0.._P_MAX] of byte = (60, 66, 129, 165, 129, 153, 129, 165, 153, 66, 60, 0, 0, 0, 0);
  p1Data : array [0.._P_MAX] of byte = (124, 130, 254, 254, 124, 56, 16, 16, 16, 16, 16, 16, 16, 124, 254);
  p2Data : array [0.._P_MAX] of byte = (60, 102, 110, 118, 118, 118, 102, 60, 24, 0, 0, 0, 0, 0, 0);
  p3Data : array [0.._P_MAX] of byte = (10, 20, 30, 40, 50, 60, 70, 80, 55, 28, 255,0, 0, 0, 0);
  // Missile data
  m0Data : array [0.._M0_MAX] of byte = (3, 1, 2);
  m1Data : array [0.._M1_MAX] of byte = (;
  m2Data : array [0.._M2_MAX] of byte = (32, 16, 32, 16);
  m3Data : array [0.._M3_MAX] of byte = (192, 128, 128, 128, 64);

// Main code
begin
  // Set graphics mode and playfield colors
  InitGraph(0);
  
  // Initialize P/M custom variables
  p_data[0] := @p0Data;
  p_data[1] := @p1Data;
  p_data[2] := @p2Data;
  p_data[3] := @p3Data;
  m_data[0] := @m0Data;
  m_data[1] := @m1Data;
  m_data[2] := @m2Data;
  m_data[3] := @m3Data;
  
  // Initialize P/M graphics
  SetPM(_PM_DOUBLE_RES);
  InitPM(_PM_DOUBLE_RES);  
  
  // Program color setup
  TextBackground(0); SetBkColor (192); CursorOff;
  
  writeln(eol, 'P/M Graphics demonstration');
  writeln(eol, 'by Bostjan Gorisek and Tebe 2015', eol);

  // Turn on P/M graphics
  ShowPM(_PM_SHOW_ON);

  // Set P/M colors    
  ColorPM(0, 202);
  ColorPM(1, 250);
  ColorPM(2, 136);
  ColorPM(3, 36);

  // Set player sizes
  SizeP(0, _PM_DOUBLE_SIZE);
  SizeP(1, _PM_DOUBLE_SIZE);
  SizeP(2, _PM_QUAD_SIZE);
  SizeP(3, _PM_NORMAL_SIZE);
  // Set missile sizes
  SizeM(_PM_NORMAL_SIZE, _PM_DOUBLE_SIZE, _PM_QUAD_SIZE, _PM_QUAD_SIZE);

  // Position and show players
  MoveP(0, 60, 70);
  MoveP(1, 170, 90);
  MoveP(2, 100, 85);
  MoveP(3, 140, 100);
  // Position and show missiles
  MoveM(0, 120, 68);
  MoveM(1, 130, 72);
  MoveM(2, 140, 76);
  MoveM(3, 155, 82);
  
  repeat until keypressed;

  // Reset P/M graphics
  ShowPM(_PM_SHOW_OFF);
end.

pmtest11.zip

Link to comment
Share on other sites

  • 2 weeks later...

Tebe, does current version of Mad Pascal support assigning the routine or procedure to some memory location? I tried many variants without success. In Action! this is done for example like this (some code excerpt):

CARD vdslst=$0200
.
.
PROC dli() ; display list interrupt routine
[
$AE INDEX ; LDX INDEX
$BD $FFFF ;LDA STRCOL,X
$8D WSYNC ; STA WSYNC
$8D COLPF0 ; STA COLPF0
$EE INDEX ; INC INDEX
$40 ;RTI
]
RETURN

PROC MAIN()
.
.
vdslst=dli
nmien=192
DO OD

RETURN

Edited by Gury
Link to comment
Share on other sites

Gury, only from asm, compiler does not know where is func/proc in XE/XL memory

 

MadPascal 1.1.9 http://mads.atari8.info

 

add file types

 

assign, reset, rewrite, blockread, blockwrite, ioresult, eof, deletefile, renamefile, close

Var F : File;
    I : cardinal;
 
begin
  Assign (F,'D:TEST.TMP');
 
  { Create the file. Recordsize is 4 }
  Rewrite (F,Sizeof(I));
 
  For I:=1 to 10 do
    BlockWrite (F,I,1);
 
  close (f);
  { F contains now a binary representation of
    10 cardinals going from 1 to 10 }
end.

{ Program to demonstrate the BlockRead and BlockWrite functions. }
 
Var Fin, Fout : File;
    NumRead,NumWritten : Word;
    Buf : Array[0..2047] of byte;
    Total : word;
    
    p1,p2: string[16];
 
begin
  p1:='D:CONSTANT.OBX';
  p2:='D:COPY.DAT';
 
  Assign (Fin, p1);
  Assign (Fout, p2);
  
  Reset (Fin, 1);
  Rewrite (Fout, 1);
 
  Total:=0;
  Repeat
    BlockRead (Fin,buf,Sizeof(buf),NumRead);
    BlockWrite (Fout,Buf,NumRead,NumWritten);
 
    inc(Total,NumWritten);
  Until (NumRead=0) or (NumWritten<>NumRead);
  
  Write ('Copied ',Total,' bytes from file ', p1);
  Writeln (' to file ', p2);
 
  close(Fin);
  close(Fout);
end.

{ EOF}
 
var f: file;
    a: cardinal;
    s: string[15];
    
begin
 
 s:='D:TEST.TMP';
 
 assign(f, s);
 
 reset(f, sizeof(cardinal));
 
 while not eof(f) do begin
 
  blockread(f, a, 1);
 
  writeln(a);
 
 end;
 
 close(f);
 
end.
Edited by tebe
  • Like 1
Link to comment
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...