G-Pascal cross platform editing

Posted by AussieSmitty on Thu 19 Nov 2015 07:13 AM — 5 posts, 22,880 views.

AussieSmitty Thu 19 Nov 2015 07:13 AM #0

Just thought I’d show what I’ve done that might be of interest for the G-Pascal forum.

Attached is a G-Pascal 3.1 virtual floppy disk gp5.d64

http://www.gammon.com.au/GPascal/gp5.d64

On this disk I have written 3 programs in G-Pascal:

Sine Wave
GPascal2Text
Text2GPascal

What I have enabled here is that anyone can use say Microsoft Word to edit a GPascal program. Once they are ready to try it in GPascal all that is required is to do a Save-As text and call the program PCTEXT.

The file needs to have the extension changed from .txt to .prg which is easy to do using Windows Explorer.

Then using a utility program that can open Commodore 64 .D64 files (I use D64 Editor which is free on the net with optional donation at http://www.d64editor.com/), import the PCTEXT.PRG file onto any GPascal .D64 virtual floppy disk file.

When you fire up that copy of G-Pascal and check the catalogue, you should see the PCTEXT.PRG file on the directory.

Then just load, compile and run the program TEXT2GPASCAL which will read into memory the program text, converting to PET ASCII and terminates with CR NUL (the marker for the end of the file) in memory. This enables the program just loaded to be listed or saved as a Tokenized G-Pascal program on the same disk.

I also wrote GPASCAL2TEXT that does this in reverse. The text file it creates has line numbering for ease of reading. In Microsoft Word it’s easy to strip off the leading line numbers using ALT when left mouse click and drag over the leading characters (note: use Courier New as the font so that all the text is fixed width for this trick to work). This is also good if one gets hold of other Pascal files from the net or after scanning and OCR (which is also a method I have used to turn paper listings back into real text programs, like the Detokenize program also on the attached GP5.D64 disk).

I then decided to try to write a program that would draw a sine wave in hi res on the screen. I discovered that G-Pascal does not have any SIN TAN or COS nor can it handle floating point numbers. But, as you can see in the program, I found a suitable approximation formula (Bhaskara) and simply returned the results 100 times in value. This was enough resolution as I was plotting to a screen of only 200 pixels high and 320 pixels wide. Here is a screen shot of the Sin Wave from the program (first written in MS Word, then imported into G-Pascal using the above programs). I know the editor in G-Pascal is great but I just thought I’d add this option for those who want to work with their PC keyboard and PC fonts, etc.

http://www.gammon.com.au/images/G-Pascal_sine_wave_image.jpg

The Sine Wave function I created got me thinking that if someone had the time, a library of trigonometry formulas might be handy if anyone is needing this for any G-Pascal retro programming. Just a thought.

Note: If going the other way (i.e. using GPascal2Text) any utility that has an Export of a file from within the .D64 'floppy' will deliver a text file in standard ASCII that can be opened in any editor like MSWORD.

Nick Gammon Australia Forum Administrator Thu 19 Nov 2015 09:53 PM #1

The output:

For nostalgia reasons, it would be interesting to post the text of those three programs here (inside code tags). :)

AussieSmitty Thu 19 Nov 2015 11:57 PM #2

Here is the code for the Sine Wave program:


(* Sine Wave plotting program
By Steve Smit  Oct 2015
Written in G-Pascal *)
const   bitmap = 1;
        base = 8;
        black = 0;
        yellow = 7;
        on = 1;
var     x, y, p, n : integer ;

function sin (x);
begin 
  sin := 4 * x * (180 - x) * 100 / ( 40500 - x * (180 - x))
end ;

(* main program *)
begin 
writeln (chr (147),"Sine Wave Programe by Steve Smit");
writeln ;
writeln ("press enter when ready");
repeat until getkey ;
graphics (bitmap,on);
graphics (8,4);
clear (yellow,black);
for x := 0 to 319 do 
begin 
p := x;
n := 0;
    if x > 180 then 
      begin 
      n := 1;
      p := x - 180;
      end ;
    y := sin (p);
    if y > 99 then y := 99;
    if n = 1 then y := - y;
    plot (1, x, 100-y);
    end ;
repeat until getkey ;
end .

AussieSmitty Sun 22 Nov 2015 11:01 AM #3

Here is the text2GPascal program:


(* open PCTEXT file and load into memory *)

(* %a $810 *)

const 
  CR = 13;
  start_ad = $4000;

var 
  i : integer ;
  TEXT_LINE : array [82] of char ;
  GOTCH, x : char ;

function eof;
  begin 
    eof := memc [$90] and $40 <> 0
  end ;

(* start of main program *)

begin 
  i := start_ad;
  writeln (chr (147),"PCTEXT to G-Pascal program");
  writeln ("On success, the read program will be in");
  writeln ("memory for listing and saving as a new");
  writeln ("G-Pascal program.");
  writeln ("Written by Steve Smit 2015");
  open (5,8,5,"0:pctext,p,r");
  get (5);
  repeat 
    read (TEXT_LINE);
    GOTCH := -1;
    while TEXT_LINE [GOTCH] <> cr do 
      begin 
      GOTCH := GOTCH + 1;
      x := TEXT_LINE [GOTCH];
      if (x > 64) and ((x and $5f) < 91) then 
        x := x xor $20; (* swap upper/lower case *)
      if x <> 10 then 
        begin 
        write (chr (x));
        memc [i] := x;
        i := i + 1
        end ;
      end 
  until eof;
  memc [i] := 13;
  memc [i + 1] := 0;
  get (0);
  close (5)
end .

AussieSmitty Mon 23 Nov 2015 02:20 AM #4

And here is the GPascal2text program:


(* program to save a g-pascal file

   as a PC text file called pctext

Author: Steve Smit

Using code from 'Centronics Print'

Written by: Nick Gammon of Gambit Games

Public Domain.


%a $800  *)

const 
      disk = 8;
      cassette = 1;
      medium = disk;

      strobereg = $dd00;  (* strobe register *)
      ddra = $dd02; (* data direction registers *)
      ddrb = $dd03;
      start_address = $4000;
      true = 1;
      false = 0;
      cr = 13;

var reprint,
    screen_only : integer ;

procedure init;
(*************)
const home = 147;

procedure load_nominated_file;
(****************************)

var 
    i,
    got_cr,
    error,
    length : integer ;
    name1, name2 : array [20]
                   of char ;

procedure get_file_name;
(**********************)
begin 
repeat 
  writeln ;
  write ("File name? ");
  read (name1);
  got_cr := false;
  for i := 0 to 20 do 
  if not got_cr then 
    begin 
    name2 [20 - i] := name1 [i];
    if name1 [i] = cr then 
      begin 
      length := i;
      got_cr := true;
      end 
    end 
until length <> 0
end ;

procedure load_file;
(******************)
const 
     areg = $2b2;
     xreg = $2b3;
     yreg = $2b4;
     cc = $2b1;
     loadit = $ffd5;
     setlfs = $ffba;
     setnam = $ffbd;
     readst = $ffb7;

begin 
  memc [areg] := 1;
  memc [xreg] := medium;
  memc [yreg] := 0; (* relocate *)
  call (setlfs);
  memc [areg] := length;
  memc [xreg] := address (name2[20]);
  memc [yreg] := address (name2[20]) shr 8;
  call (setnam);
  memc [areg] := 0; (* load *)
  memc [xreg] := start_address;
  memc [yreg] := start_address shr 8;
  call (loadit);
  if memc [cc] and 1 then 
    error := memc [areg]  (* got error *)
  else 
    begin 
    call (readst);
    error := memc [areg] and $bf
    end ;
  writeln ; writeln ;
  if error then 
    writeln ("Load error, code: ",
           error)
  else 
    writeln ("Loaded ok.")
end ;

(***** start of : load_nominated_file ***)
begin 
repeat 
  get_file_name;
  load_file
until not error
end ;

procedure open_pctext;
(*********************)
begin 
  open (5,8,2,"0:pctext,s,w")
end ;


function yes_no;
(**************)
var reply : char ;
begin 
  repeat 
    read (reply)
  until (reply = "y")
     or (reply = "n");
  writeln (chr (reply));
  writeln ;
  yes_no := reply = "y"
end ;

(****** start: init ***********)

begin 
  writeln (chr (home),
    "Convert G-Pascal PRG files to PCTEXT");
  writeln ;
    load_nominated_file;
    open_pctext
end ;

procedure print_file;
(*******************)
var 
   line,
   pointer,
   limit,
   count : integer ;
   ch : char ;

procedure next_char;
(*****************)
begin 
  ch := memc [pointer];
  pointer := pointer + 1
end ;

procedure print_char (x);
(**********************)
begin 
  write (chr (x));  (* echo on screen *)
  if not screen_only then 
    begin 
    (* convert x to ASCII *)
    if x >= 192 then 
      x := x and $7f
    else 
      if (x > 64) and ((x and $5f) < 91) then 
        x := x xor $20;  (* swap upper/lower case *)
    (* send data to pctext file *)
    put (5);
    write (chr (x));
    put (0)
    end 
end ;

procedure print_reserved_word (x);
(********************************)
const table = $81b5;
var position,
    length
    : integer ;

begin 
position := table;
while (memc [position + 1] <> x)
  and (memc [position] <> 0) do 
  position := position +
              memc [position] + 2;
if memc [position + 1] <> x then 
  print_char (x)
else 
  begin 
  length := memc [position];
  repeat 
    print_char (memc [position + 2]);
    position := position + 1;
    length := length - 1
  until length <= 0;
  print_char (" ")
  end 
end ;

procedure print_line;
(*******************)
var i,
    leading_zero : integer ;

procedure print_power (which);
(****************************)
begin 
  if (i / which > 0)
  or not leading_zero then 
    begin 
    leading_zero := false;
    print_char (i / which + "0")
    end 
  else 
    print_char (" ");
  i := i - line / which * which
end ;

(****** start: print_line ******)
begin 
  line := line + 1;
  i := line;
  leading_zero := true;
  print_power (1000);
  print_power (100);
  print_power (10);
  print_char (line mod 10 + "0");
  print_char (":");
  print_char (" ")
end ;

(******* start: print_file *******)
begin 
  pointer := start_address;
  line := 0;
  print_line;
  next_char;  (* get first character *)
  if ch <> 0 then  (* not blank file *)
  repeat 
    if ch = $10 then (* space count *)
      begin 
      next_char;
      limit := ch and $7f;
      for count := 1 to limit do 
        print_char (" ")
      end 
    else 
      if ch > $80 then 
        print_reserved_word (ch)
      else 
        print_char (ch);
    if ch = cr then 
      print_line;
    next_char  (* next character if any *)
until ch = 0
end ;

procedure wrap_up;
(***************)
begin 
  close (5);
  writeln ("File pctext write complete!")
end ;

(****** program starts here ******)
begin 
  init;
  print_file;
  wrap_up
end .