cadp17@vaxa.strath.ac.uk (G.M.T.) (09/12/90)
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: CADP17@UK.AC.STRATH.VAXB | | BITNET: CADP17%VAXB.STRATH.AC.UK@UKACRL | | INTERNET: CADP17%VAXB.STRATH.AC.UK@EDU.CUNY.CUNYVM | +------------------------------------------------------------------------------+ $! ------------------ 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 CADP17@STRATH.VAXB 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 CADP02@STRATH.VAXB, but the pascal code is (C) Copyright * V`125 X`123* 1990 CADP17@STRATH.VAXB "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