Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/1/1819

Internet Message Format | 1990-12-28 | 10.9 KB

From: [e-mail] (G.M.T.)
Newsgroups: alt.sources,vmsnet.sources.games
Subject: How to convert shapes to 100% pascal
Message-ID: <[e-mail]>
Date: 11 Sep 90 20:15:54 GMT


    Hmmm.... pascal, fortran and C???

    Here's a proggy to convert shapes.pas into pure 100% Pascal..

    Mail me if you have any probs....

    Instructions are in the .TXT file this produces..

--
+------------------------------------------------------------------------------+
| Gordon M. Tervit.            JANET: [e-mail]                 |
|                             BITNET: CADP17%VAXB.STRATH.AC.UK@UKACRL          |
|                           INTERNET: [e-mail] |
+------------------------------------------------------------------------------+

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.1-004  3-AUG-1989
$!   On 11-SEP-1990 19:56:05.67   By user CADP17
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. SORT_SHAPES.COM;2
$!       2. SORT_SHAPES.EDT;2
$!       3. SORT_SHAPES.PAS;1
$!       4. SORT_SHAPES.TXT;2
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ if f$getsyi("version") .ges. "V4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete/nolog 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete/nolog 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");
buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff))
;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);x:=
ERASE_CHARACTER(1);IF g = 0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x=
"V" THEN APPEND_LINE;MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;
IF x="+" THEN g:=1;ERASE_LINE;ENDIF;ELSE IF x="-" THEN g:=0;ENDIF;ERASE_LINE;
ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD);
EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));
ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o);
ENDPROCEDURE;Unpacker;EXIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create/nolog 'f'
X$! (C) 1990 [e-mail]
X$!
X$! This converts CADP02's SHAPES.PAS to pure 100% PASCAL (Wow!) 8-)
X$!
X$ write sys$output "Converting...."
X$ EDIT/EDT /COMMANDS=SORT_SHAPES.EDT SHAPES.PAS
X$ type sys$input
XSHAPES.PAS has been converted to pure PASCAL
X
XYou can now delete INCLUDES.C, RAND.FOR and SORT_SHAPES.*
X
XThe COMPILE.COM is also defunct....
X
XSimply PASCAL SHAPES, then LINK SHAPES
$ CALL UNPACK SORT_SHAPES.COM;2 1364791213
$ create/nolog 'f'
Xdelete 106 thru 120
X107
Xinclude sort_shapes.pas
Xexit
$ CALL UNPACK SORT_SHAPES.EDT;2 52383506
$ create/nolog 'f'
X`123* Here's a tricky situation for you..... 8-)`009`009`009`009*`125
X`123*`009`009`009`009`009`009`009`009`009*`125
X`123* The algorithms for the following routines are (C) Copyright to`009*`12
V5
X`123* CHBS08 and [e-mail], but the pascal code is (C) Copyright  *
V`125
X`123* 1990 [e-mail] "Noddysoft"`009`009`009`009`009*`125
X`123*`009`009`009`009`009`009`009`009`009*`125
X`123* This code may be used, abused and distributed as you like, on the`009*
V`125
X`123* condition that this message appears in any distribution/version`009*`1
V25
X`123* and you have the permission to distribute the original routines`009*`1
V25
X`123* from CADP02.`009`009`009`009`009`009`009`009*`125
X`123*`009`009`009`009`009`009`009`009`009*`125
X`123* These routines replace the includes.c and rand.for files in the 1990`0
V09*`125
X`123* distribution of CADP02's SHAPES.... This makes the program 100%`009*`1
V25
X`123* PASCAL.... 8-)`009(Wow!)`009`009`009`009`009`009*`125
X`123*`009`009`009`009`009`009`009`009`009*`125
X`123* And before I forget... a quick mention goes to GAVIN (CBAP09)`009*`125
X`123* simply for being a reasonably great guy.`009`009`009`009*`125
X
X`123*** THESE ROUTINES REPLACE INCLUDES.C ***`125
XTYPE
X`009USRSTR =  packed array `0911..5`093 of char;
X`009VARSTR`009= VARYING`091255`093 OF CHAR;
X`009BYTE`009= `091BYTE`093 -128..127;
X`009WORD`009= `091WORD`093 -32768..32767;
X`009UBYTE`009= `091BYTE`093 0..255;
X`009UWORD`009= `091WORD`093 0..65535;
X`009UQUAD`009= RECORD
X`009`009    a,b : unsigned
X`009`009  END;
X
X`091ASYNCHRONOUS,EXTERNAL`093`009FUNCTION LIB$STOP
X`009(
X`009%REF`009STATUS`009: INTEGER := %IMMED 0
X`009) : INTEGER; EXTERN;
X
X`091ASYNCHRONOUS,EXTERNAL`093`009FUNCTION LIB$GET_FOREIGN
X`009(
X`009%DESCR`009RESSTR`009: VARSTR  := %IMMED 0;
X`009%DESCR`009PROMPT`009: VARSTR  := %IMMED 0;
X`009%REF`009RESLEN`009: UWORD   := %IMMED 0;
X`009%REF`009FLAGS`009: INTEGER := %IMMED 0
X`009) : INTEGER; EXTERN;
X
X`091ASYNCHRONOUS,EXTERNAL`093`009FUNCTION LIB$GETJPI
X`009(
X`009%REF`009ITEM`009: UWORD   := %IMMED 0;
X`009%REF`009PROCID`009: INTEGER := %IMMED 0;
X`009%DESCR`009PROCNM`009: VARSTR  := %IMMED 0;
X`009%REF`009RESNUM`009: INTEGER := %IMMED 0;
X`009%DESCR`009RESSTR`009: VARSTR  := %IMMED 0;
X`009%REF`009RESLEN`009: UWORD   := %IMMED 0
X`009) : INTEGER; EXTERN;
X
X`091ASYNCHRONOUS,EXTERNAL`093`009FUNCTION LIB$SPAWN (
X`009%DESCR`009COMMAN`009: VARSTR  := %IMMED 0;
X`009%DESCR`009INFILE`009: VARSTR  := %IMMED 0;
X`009%DESCR`009OUFILE`009: VARSTR  := %IMMED 0;
X`009%REF`009FLAGS`009: INTEGER := %IMMED 0;
X`009%DESCR`009PRNAME`009: VARSTR  := %IMMED 0;
X`009%REF`009PROCID`009: INTEGER := %IMMED 0;
X`009%REF`009COMPST`009: INTEGER := %IMMED 0;
X`009%REF`009BIEFN`009: UBYTE   := %IMMED 0;
X`009%REF`009CRAP_A`009: INTEGER := %IMMED 0;
X`009%REF`009CRAP_B`009: INTEGER := %IMMED 0;
X`009%DESCR`009PROMPT`009: VARSTR  := %IMMED 0;
X`009%DESCR`009CLI`009: VARSTR  := %IMMED 0
X`009) : INTEGER; EXTERN;
X
X`091ASYNCHRONOUS,EXTERNAL`093`009FUNCTION LIB$WAIT
X`009(
X`009%REF`009TIMETW`009: REAL    := %IMMED 0
X`009) : INTEGER; EXTERN;
X`032
X`091ASYNCHRONOUS,EXTERNAL`093 FUNCTION SYS$ASSIGN
X`009(
X`009DEVNAM : `091CLASS_S`093 PACKED ARRAY `091$l1..$u1:INTEGER`093 OF CHAR;
X`009VAR CHAN : `091VOLATILE`093 integer;
X`009%IMMED ACMODE : UNSIGNED := %IMMED 0;
X`009MBXNAM : `091CLASS_S`093 PACKED ARRAY `091$l4..$u4:INTEGER`093 OF CHAR :
V= %IMMED 0
X`009) : INTEGER; EXTERNAL;
X
X`091ASYNCHRONOUS,EXTERNAL`093 FUNCTION SYS$QIOW (
X`009%IMMED EFN : UNSIGNED := %IMMED 0;
X`009%IMMED CHAN : INTEGER;
X`009%IMMED FUNC : INTEGER;
X`009VAR IOSB : `091VOLATILE`093UQUAD := %IMMED 0;
X`009%IMMED `091UNBOUND, ASYNCHRONOUS`093 PROCEDURE ASTADR := %IMMED 0;
X`009%IMMED ASTPRM : UNSIGNED := %IMMED 0;
X`009%REF P1 : `091UNSAFE`093 ARRAY `091$l7..$u7:INTEGER`093 OF UBYTE := %IMM
VED 0;
X`009%IMMED P2 : INTEGER := %IMMED 0;
X`009%IMMED P3 : INTEGER := %IMMED 0;
X`009%IMMED P4 : INTEGER := %IMMED 0;
X`009%IMMED P5 : INTEGER := %IMMED 0;
X`009%IMMED P6 : INTEGER := %IMMED 0) : INTEGER; EXTERNAL;
X
Xconst
X  JPI$_USERNAME = 514;
X  IO$_READVBLK = 49;
X  IO$M_NOECHO = 64;
X  IO$M_TIMED = 128;
X  IO$M_PURGE = 2048;
X  READFUNC = IO$_READVBLK + IO$M_NOECHO + IO$M_TIMED;
X  WAITFUNC = IO$_READVBLK + IO$M_NOECHO + IO$M_PURGE;
X
Xprocedure makechan (var chan : integer);
Xvar
X  state : integer;
Xbegin
X  state := sys$assign ('TT',chan,,);
X  if state<>1 then lib$stop(state);
Xend;
X
Xprocedure readkey (var key, chan : integer);
Xvar
X  state : integer;
X  inkey : char;
Xbegin
X  inkey := chr(0);
X  state := sys$qiow (,chan,readfunc,,,,inkey,1,,,,);
X  if state<>1 then lib$stop (state);
X  key := ord(inkey);
Xend;
X
Xprocedure waitkey (var key, chan : integer);
Xvar
X  state : integer;
X  inkey : char;
Xbegin
X  inkey := chr(0);
X  state := sys$qiow (,chan,waitfunc,,,,inkey,1,,,,);
X  if state<>1 then lib$stop (state);
X  key := ord(inkey);
Xend;
X
Xprocedure spawn;
Xbegin
X  lib$spawn (,,,,'Shapes_Refugee',,,,,,,);
Xend;
X
Xprocedure param (var word : USRSTR);
Xvar
X  count : integer;
X  tempstr : varstr;
Xbegin
X  lib$get_foreign (tempstr);
X  if length(tempstr)<5 then tempstr := pad(tempstr,' ',5);
X  for count := 1 to 5 do word`091count`093 := tempstr`091count`093;
Xend;
X
Xprocedure usernum (var userid : string);
Xvar
X  count : integer;
X  tempstr : varstr;
Xbegin
X  lib$getjpi (JPI$_USERNAME,,,,tempstr,);
X  if length(tempstr) < 8 then tempstr := pad(tempstr,' ',8);
X  for count := 1 to 8 do userid`091count`093 := tempstr`091count`093;
Xend;
X
Xprocedure waitx (time : real);
Xbegin
X  lib$wait (time);
Xend;
X
X`123*** THESE ROUTINES REPLACE RAND.FOR ***`125
X
X`091ASYNCHRONOUS,EXTERNAL`093 FUNCTION LIB$DATE_TIME
X`009(
X`009%DESCR DATIM : VARSTR
X`009) : UWORD; EXTERNAL;
X
Xvar `123GLOBAL!`125
X  seed : integer;
X
XPROCEDURE RANDOMISE;
Xvar
X  date : VARSTR;
XBEGIN
X  LIB$DATE_TIME (date);
X  seed := 10000*(ord(date`09116`093)-ord('0'))
X`009 + 1000*(ord(date`09117`093)-ord('0'))
X`009 +  100*(ord(date`09119`093)-ord('0'))
X`009 +   10*(ord(date`09120`093)-ord('0'))
X`009 +      (ord(date`09122`093)-ord('0'))
Xend;
X
Xfunction random (min,max : integer) : integer;
Xvar
X  rnd : real;
X  realseed : integer;
Xbegin
X  seed := INT(UAND((((seed+1)*75)-1),65535));
X  realseed := seed;
X  rnd := (realseed/65536)*(max-min)+min;
X  random := round(rnd);
Xend;
X
X`123* END OF PASCAL REPLACEMENT *`125
$ CALL UNPACK SORT_SHAPES.PAS;1 420053111
$ create/nolog 'f'
XWell... after the complaint about SHAPES being in PASCAL,C AND FORTRAN,
XI decided to convert it into pure PASCAL.
X
XWhat (dis-?) advantages this may have, I have no idea....
X
XThe mod is very simple, and uses the EDT editor to replace some lines in
Xthe SHAPES.PAS file...
X
X***WARNING***
X
XThe SHAPES.PAS file **MUST** be in the original format that it is in
Ximmeadiatley after it has been decoded from the SHAR file
X
XTo convert the program simply type @SORT_SHAPES
X
XThe files SHAPES.PAS, SORT_SHAPES.EDT, SORT_SHAPES.COM and SORT_SHAPES.PAS
Xmust be in the current directory for this to work......
$ CALL UNPACK SORT_SHAPES.TXT;2 2052529465
$ v=f$verify(v)
$ EXIT