Sunday, May 3, 2020

PARSED.P

[Table of Contents]

PARSED.P is a demo program from the Kyan Pascal 2.x Utilities Disk 2.

Source Code


PROGRAM PARSE_DEMO;

(* INPUT BUFFER PARSE ROUTINE

   COPYRIGHT (C) 1986 BY
   KYAN SOFTWARE, INC.  *)

TYPE
#I PARSET.I

VAR
   ARGCOUNT:INTEGER;
   BASE:STRPOINTER;

#I PARSELN.I

PROCEDURE PRINTBUFFER;
VAR WALKER:STRPOINTER;
BEGIN
   WALKER:=BASE;
   WHILE WALKER<>NIL DO
   BEGIN
      WRITELN(WALKER^.STRFOUND);
      WALKER:=WALKER^.NEXTSTR
   END
END;

FUNCTION COUNTINPUT:INTEGER;
VAR WALKER:STRPOINTER;
    I:INTEGER;
BEGIN
   I:=0;
   BASE:=PARSELINE;
   WALKER:=BASE;
   WHILE WALKER<>NIL DO
   BEGIN
      I:=I+1;
      WALKER:=WALKER^.NEXTSTR
   END;
   COUNTINPUT:=I
END;

PROCEDURE INIT;
BEGIN
   ARGCOUNT:=COUNTINPUT;
   WRITELN; WRITELN;
   WRITELN('*** PARSE DEMO ***');
   WRITELN;
   WRITELN('THE PARSE ROUTINE PROVIDES YOU');
   WRITELN('WITH AN EASY WAY TO WRITE KIX-LIKE');
   WRITELN('PASCAL PROGRAMS IN THAT YOU CAN');
   WRITELN('HAVE A USER TYPE PARAMETERS');
   WRITELN('DIRECTLY AFTER THE NAME OF THE');
   WRITELN('PROGRAM AT THE KIX COMMAND');
   WRITELN('PROMPT.  FOR EXAMPLE: WHEN');
   WRITELN('YOU CALLED THIS PROGRAM, YOU');
   WRITELN('TYPED ',ARGCOUNT:1,' WORDS:');
   PRINTBUFFER
END;

BEGIN
   INIT;
   WRITELN('TRY RUNNING THIS DEMO AGAIN WITH');
   WRITELN('MORE PARAMETERS ON THE COMMAND');
   WRITELN('LINE AFTER THE "PARSE.DEMO".');
   WRITELN;
   WRITE('PRESS RETURN...');
   READLN;
   WRITELN('THE PARSELINE ROUTINE CAN BE USED');
   WRITELN('AT ANY TIME IN A PROGRAM TO PARSE');
   WRITELN('THE CONTENTS OF THE INPUT BUFFER.');
   WRITELN;
   WRITE('FOR EXAMPLE:  '); READLN;
   ARGCOUNT:=COUNTINPUT;
   WRITELN(ARGCOUNT,' WORDS TYPED: ');
   PRINTBUFFER
END.

ESORTD.P

[Table of Contents]

 ESORTD.P is a demo program from the Kyan Pascal 2.x Utilities Disk 2.

Source Code


PROGRAM ESORT_DEMO;

(* EXTERNAL SORT ROUTINE
   DEMONSTRATION PROGRAM.

  COPYRIGHT (C) 1986 BY
  KYAN SOFTWARE, INC.  *)


TYPE
#I SRTMERGT.I
(* RECORD OF 100 BYTES *)
   BIGRECTYPE   = RECORD
                     EXTRA1  : ARRAY[1..98] OF CHAR;
                     INFOKEY : INTEGER
                  END;

VAR
#I SRTMERGV.I

#I ADDDEV.I
#I DELETE.I
#I MERGE.I
#I ESORT.I


FUNCTION RND:REAL;
BEGIN
RND:=0;
#A
 TXA
 PHA
 LDA #0
 STA _T
RAN1 INC _T
 JSR POLY
 CMP #0
 BEQ RAN1
 ORA #$10
 LDY #5
 STA (_SP),Y
;
RAN2 INY
 JSR POLY
 ROL
 ROL
 ROL
 ROL
 AND #$F0
 STA _T+1
 JSR POLY
 ORA _T+1
 STA (_SP),Y
 CPY #11
 BCC RAN2
 LDA _T
 INY
 STA (_SP),Y
 PLA
 TAX
#
END;
#A
POLY TYA
 PHA
 LDY #0
POLY1 INY
 CLC
 ROL POLYN
 ROL POLYN+1
 ROL POLYN+2
 ROL POLYN+3
 ROL POLYN+4
 ROL POLYN+5
 ROL POLYN+6
 ROL POLYN+7
 BCC POLY3
;
 LDX #0
POLY2 LDA POLYN,X
 EOR GEN,X
 STA POLYN,X
 INX
 CPX #8
 BCC POLY2
 SEC
;
POLY3 ROL _T+2
 CPY #4
 BCC POLY1
;
 PLA
 TAY
 LDA _T+2
 AND #$0F
 CMP #$0A
 BCS POLY
 RTS
;
GEN DB $A1
 DB $A2
 DB $1A
 DB $A2
 DB $91
 DB $C3
 DB $93
 DB $C0
;
POLYN DB $63
 DB $42
 DB $A1
 DB $23
 DB $55
 DB $09
 DB $03
 DB $87
#


PROCEDURE HOME;
BEGIN
    WRITE(CHR(125));
END;


PROCEDURE BUILD_TEST_FILE;
VAR I:INTEGER;
    F:FILE OF BIGRECTYPE;
BEGIN
   WRITELN('GENERATING RANDOM DATA...');
   REWRITE(F,'DATAFILE');
   FOR I:=1 TO 75 DO
   BEGIN
      F^.INFOKEY:=ROUND(125*RND);
      WRITE(F^.INFOKEY:10);
      PUT(F);
   END;
   WRITELN
END;


PROCEDURE SHOW_TEST_FILE;
VAR I,J:INTEGER;
   F:FILE OF BIGRECTYPE;
BEGIN
   WRITELN('PRESS RETURN TO SEE SORTED FILE...');
   READLN;
   RESET(F,'DATAFILE');
   WHILE NOT EOF(F) DO
   BEGIN
      WRITE(F^.INFOKEY:10);
      GET(F)
   END;
   WRITELN
END;


BEGIN
   FYLE:='DATAFILE            ';
   HOME;
   WRITELN('*** ESORT DEMONSTRATION ***');
   WRITELN;
   WRITELN('THERE WILL BE 75 RECORDS SORTED.  EACH');
   WRITELN('RECORD IS 100 BYTES IN LENGTH.  THE KEY');
   WRITELN('FIELD IS AN INTEGER....');
   WRITELN('PRESS RETURN TO BEGIN...'); READLN;
   BUILD_TEST_FILE;
   ORDER:=1;
   RLEN:=100;
   OSET:=98;
   KLEN:=2;
   KTYPE:=INTEGER_FIELD;
   WRITELN('SORTING....');
   WRITELN('<PLEASE WAIT APPROX 1 MINUTE>...');
   ESORT;
   SHOW_TEST_FILE
END.

RANDEMO.P

[Table of Contents]

RANDEMO.P is a demo program from the Kyan Pascal 2.x Utilities Disk 2.

It demos how to use some of the random number generation routines.

For more information on random number generations, see this Random Numbers post.

Source Code


PROGRAM RANDOMDEMO(INPUT,OUTPUT);
   VAR
      I:INTEGER;
#I RANDOMS.I
   BEGIN
      SEED(3,9,1,2);
      FOR I:=1 TO 10 DO
        WRITELN(RND,' ',RANDOM(4,25),',',RANDOM_BYTE);
END.

Sample Run





Saturday, May 2, 2020

SCANDEMO.P

[Table of Contents]

SCANDEMO.P is a demo program from the Kyan Pascal 2.x Utility Disk 2 for the Atari 8-bit.


SOURCE CODE


PROGRAM SCANDEMO(INPUT,OUTPUT);
    CONST
        MAXSEARCHLEN=20;
    TYPE
       SEARCHTYPE=ARRAY[1..MAXSEARCHLEN] OF CHAR;
       PATHSTRING=ARRAY[1..20] OF CHAR;
    VAR
       FYLE:PATHSTRING;
       IT  :SEARCHTYPE;
       I,J :INTEGER;
#I  SCANFILE.I
    BEGIN
       FYLE:='SCANDEMO.P          ';
       READLN(IT);
       SCANFILE(FYLE,IT,I);
       WRITELN(I);
END.


SAMPLE RUN


Seems to lock up when it is run.

GETDEMO.P

[Table of Contents]

GETDEMO.P is a demo program from the Kyan Pascal 2.x Utility Disk 2 for the Atari 8-bit.

It uses the following include files from the Kyan Pascal 2.x Utility Disk 1:




SOURCE CODE


program directdemo(input,output);
#i IOtypes.i
    var
        spec    :pathstring;
        top,temp:elemptr;
        r       :integer;
#i adddev.i
#i getdir.i
    begin
        new(temp); (*USE A DATALESS*)
        top:=temp; (*HEADER CELL*) 
        temp^.next:=nil;
        spec:='                    ';
        r:=get_dir(spec,top);
        writeln('now traversing linked list');
        while top^.next<>nil do begin
            writeln(top^.next^.entry);
            top:=top^.next;
        end;(*while*)
end.

SAMPLE RUN




CONVERT.P

[Table of Contents]

CONVERT.P is a demo program from the Kyan Pascal 2.x Utility Disk 2 for the Atari 8-bit.

It demos how to use the following include files from the Kyan Pascal 2.x Utility Disk 1:


If you want to convert from REAL to INTEGER, you can use the built-in ROUND() function. Of course you will lose precision and the mantissa will be removed.

Source Code


PROGRAM CONVERT_DEMO(INPUT,OUTPUT);
    TYPE
#I CONVTYPS.I
    VAR
        NUM :REAL;
        JUST:INTEGER;
        A   :STRING20;
        B   :STRING5;
        C   :STRING6;
#I RTOS.I
#I STOR.I
#I ITOS.I
#I STOI.I
    BEGIN
        NUM:=3.14159;
        REALTOSTR(NUM,2,5,A);
        WRITELN(A);
        A:='3.141592654         ';
        WRITELN(STRTOREAL(A));
        INTTOSTR(1024,'R',B);
        WRITELN(B);
        C:='-2355 ';
        WRITELN(STRTOINT(C));
END.


Sample Run




BIGDEMO.P

[Table of Contents]

BIGDEMO.P is a demo program from the Kyan Pascal 2.x Utilities Disk 2.

It shows examples of how to read the joysticks, paddles, and function keys.


SOURCE CODE


program stickdemo(input,output);
    TYPE
       PATHSTRING=ARRAY[1..20] OF CHAR;
    var
        r,i:integer;
        B  :BOOLEAN;
        STR:PATHSTRING;
#i stick.i
#I PADDLE.I
#I FUNCTKEY.I
#i helpkey.i
    begin
        WRITELN('THE STICKS');
        for i:=0 to 3 do begin
            R:=stick(i);
            writeln('stick ',i,'- ',r);
            B:=strig(i);
            writeln('strig ',i,'- ',B);
        end;
        WRITELN('THE PADDLES');
        FOR I:=0 TO 7 DO BEGIN
            R:=PADDLE(I);
            WRITELN('PAD ',I,'- ',R);
            B:=PTRIG(I);
            WRITELN('PTRIG ',I,'- ',B);
        END;
        I:=100;
        FUNCTION_KEY(str,i);
        WRITELN(STR,I);
        help_key(str);
        writeln(str);
end.


SAMPLE RUN