$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 21-MAY-1992 01:15:47.10 By user MASMUMMY $! $! This VMS_SHARE Written by: $! Andy Harper, Kings College London UK $! $! Acknowledgements to: $! James Gray - Original VMS_SHARE $! Michael Bednarek - Original Concept and implementation $! $!+ THIS PACKAGE DISTRIBUTED IN 3 PARTS, TO KEEP EACH PART $! BELOW 30 BLOCKS $! $! 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. BUILD.COM;1 $! 2. DERAN.PAS;1 $! 3. DERANHGH.DAT;1 $! 4. SYS.PAS;1 $! $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 = "!" $ ve=f$getsyi("version") $ if ve-f$extract(0,1,ve) .ges. "4.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 '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 'f'* $ exit $dirok: $ w "-I-PROCESS, Processing file ''P1'." $ if .not. f$verify() then $ 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");b:= CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b)); LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);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 IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")= 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF"; POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r); ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1; COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE, "output_file"));ENDPROCEDURE;Unpacker;QUIT; $ delete/nolog 'f'* $ CHECKSUM 'P1' $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT $ e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ ENDSUBROUTINE $START: $ create 'f' X$ pascal deran X$ pascal sys X$ link deran,sys X$ write sys$output "DONE!" X$ exit $ CALL UNPACK BUILD.COM;1 139858574 $ create 'f' XPROGRAM De_doo_ranranran(input,output,high); X X `7B Written 11/89 by Eric Olson `7D X Xconst xmax = 61; X ymax = 21; X hsmax = 60; X maxbots = 50; X version = '3.1'; X maxold = 5; X hsfile = 'deran_data:deranhgh.dat'; X Xtype `7B`7D X oldaray = array`5B1..maxold`5D of integer; X string = varying `5B80`5D of char; X thing = (the_hero,a_robot,nothing,rubble); X robotype = array`5B1..maxbots`5D of integer; X gridtype = array`5B0..xmax+1,0..ymax+1`5D of thing; X str = varying`5B8`5D of char; X hscore = record X uname:str; X score:integer; X end; X Xvar highscore:array`5B1..hsmax`5D of hscore; X c:char; X highest:str; X high:file of hscore; X botscount:0..maxbots; X score:integer; X username,prompt:string; X kb_id,tc:unsigned; X timeout:integer; X may_play:boolean; X X`5Bexternal,asynchronous`5D function mth$random (var seed:integer):real; ext Vern; X X`5Bexternal(smg$create_virtual_keyboard)`5D function create_virtual_keyboard V( X %ref new_kb:unsigned; X %descr filespec:`5Btruncate`5D varying `5Bu1`5D of char := % Vimmed 0; X %descr default :`5Btruncate`5D varying `5Bu2`5D of char := % Vimmed 0; X %descr result:`5Btruncate`5D varying `5Bu3`5D of char := %im Vmed 0; X %ref recall:unsigned := %immed 0):unsigned; X external; X X`5Bexternal(smg$read_keystroke)`5D function read_keystroke( X %ref kb_id:unsigned; X %ref tc:unsigned; X %descr prompt:varying `5Bu3`5D of char := %immed 0; X %ref disp_id:unsigned := %immed 0; X %ref rend_set:unsigned := %immed 0; X %ref rend_comp:unsigned := %immed 0):unsigned; X external; X Xfunction get_userid:string; extern; X X`5Bexternal(smg$delete_virtual_keyboard)`5D function delete_virtual_keyboard V( X %ref kb_id:unsigned):unsigned; X external; X X function _getch:char; external; X X procedure clearscreen; X begin X writeln (chr(27),'`5B2J'); X end; `7Bprocedure clearscrean`7D X X procedure gotoxy (x,y:integer); X begin X write (chr(27),'`5B',y:0,';',x:0,'H'); X end; `7Bprocedure gotoxy`7D X X procedure showcommands; X var t:integer; X begin `7Bprocedure showcommands `7D X t := xmax+5; X gotoxy(t,2); WriteLn ('SCORE ='); X gotoxy(t,3); WriteLn ('WAVE'); X gotoxy(t,6); WriteLn ('ZOBOS ='); X gotoxy(t+3,8); WriteLn ('7 8 9'); X gotoxy(t+4,9); WriteLn ('\`7C/'); X gotoxy(t+3,10); WriteLn ('4-5-6'); X gotoxy(t+4,11); WriteLn ('/`7C\'); X gotoxy(t+3,12); WriteLn ('1 2 3'); X gotoxy(t,14); WriteLn ('T - teleport'); X gotoxy(t,15); WriteLn ('B -'); X gotoxy(t,16); WriteLn ('W - wait'); X gotoxy(t,17); WriteLn ('R - redraw'); X gotoxy(t,19); WriteLn ('DERAN ',version,' by'); X gotoxy(t,20); WriteLn ('Eric Olson'); X gotoxy(t,21); WriteLn ('Modified by'); X gotoxy(t,22); WriteLn ('Karl Lohner'); X end; X X procedure gridxy (x,y:integer); X begin X gotoxy(x+1,y+1); X end; `7Bgridxy`7D X X procedure play; X var grid,ogrid:gridtype; X wholething,blasted,h_dead:boolean; X wave,rval,numbots,x,y,seed:integer; X robx,roby:robotype; X X procedure initialize; `7Bin play`7D X var bogus:real; X i,j:integer; X begin `7Bprocedure initialize in play`7D X seed := ((clock div 100)*43); X wholething := false; X wave := 0; X x := 0; X y := 0; X h_dead := false; X numbots := 5; X score := 0; X for i := 0 to xmax+1 do X for j := 0 to ymax+1 do X begin X ogrid`5Bi,j`5D := nothing; X end; X end; `7Bprocedure initialize in play`7D X X procedure display; X var x,y:integer; X what:thing; X begin `7Bprocedure display in play`7D X if wholething then X begin `7Bin wholething`7D X for y := 1 to ymax do X begin X for x := 1 to xmax do X begin X what:=grid`5Bx,y`5D; X if what=a_robot then begin gridxy(x,y); writeln ('O'); en Vd; X if what=the_hero then begin gridxy(x,y); writeln ('+'); e Vnd; X if what=rubble then begin gridxy(x,y); writeln ('*'); end V; X ogrid`5Bx,y`5D := grid`5Bx,y`5D; X end; X end; X wholething := false; X end X else `7Bif not wholething`7D X for x := 1 to xmax do for y := 1 to ymax do X if not (grid`5Bx,y`5D=ogrid`5Bx,y`5D) then X begin X gridxy(x,y); X case grid`5Bx,y`5D of X nothing:writeln (' '); X a_robot:writeln ('O'); X the_hero:writeln('+'); X rubble:writeln ('*'); X end; X ogrid`5Bx,y`5D := grid`5Bx,y`5D; X end; X end; `7Bprocedure display in play`7D X X procedure border; X var i,j:integer; X begin X gridxy(0,0); X write('+'); X for i := 1 to xmax do write ('-'); X writeln('+'); X for j := 1 to ymax do X begin X write('`7C'); X gridxy(xmax+1,j); X writeln('`7C'); X end; X write('+'); X for i := 1 to xmax do write ('-'); X writeln('+'); X end; X X procedure redraw; `7Bhas a bug: leaves a + behind. but you can move`7D X var i,j:integer;`7Bthrough it, so it's not a real bug, so i'm ignorin Vg`7D X begin `7Bit.`7D X clearscreen; X showcommands; X if not blasted then X gotoxy(xmax+9,15); writeln ('blast'); X wholething := true; X display; X border; X gotoxy(xmax+13,2); writeln (score:4); X gotoxy(xmax+10,3); writeln (wave:3); X gotoxy(xmax+16,6); writeln (botscount:3); X end; `7Bprocedure redraw in play`7D X X procedure init_array(n:integer); `7Bn is the number of robots.`7D X var i,j,k:integer; `7Bx,y are the hero's coords`7D X begin `7Binit_array in play`7D X blasted := false; X wave := wave + 1; X botscount := n; X gotoxy(xmax+13,2); writeln (score:4); X gotoxy(xmax+10,3); writeln (wave:3); X gotoxy(xmax+16,6); writeln (botscount:3); X rval := 1; X for i := 0 to xmax+1 do X for j := 0 to ymax+1 do X grid`5Bi,j`5D := nothing; X grid`5Bx,y`5D := the_hero; X gotoxy(xmax+9,15); writeln ('blast'); X for k := 1 to n do X begin X repeat X i := trunc(mth$random(seed)*xmax)+1; X j := trunc(mth$random(seed)*ymax)+1; X until grid`5Bi,j`5D = nothing; X grid`5Bi,j`5D := a_robot; X robx`5Bk`5D := i; roby`5Bk`5D := j; X end; X if x=0 then X begin X repeat X x := trunc(mth$random(seed)*xmax)+1; X y := trunc(mth$random(seed)*ymax)+1; X until grid`5Bx,y`5D = nothing; X grid`5Bx,y`5D := the_hero; X end; X display; X end; `7Bprocedure init_array in play`7D X X function safeway(x,y:integer):boolean; X var dx,dy:integer; X r:boolean; X X function safe(x,y,dx,dy:integer):boolean; X var zx:boolean; X begin X zx := false; X if (x<1) or (y<1) or (x>xmax) or (y>ymax) or (grid`5Bx,y`5D=rubble V) X then zx := true X else if grid`5Bx,y`5D=a_robot then zx := false X else if dx*dy<>0 then zx := safe(x+dx,y+dy,dx,dy) X else if dx=0 then X if dy=1 then zx := safe(x,y+1,0,1) and safe(x-1,y+1,-1,1) X and safe(x+1,y+1,1,1) X else zx := safe(x,y-1,0,-1) and safe(x-1,y-1,-1,-1) X and safe(x+1,y-1,1,-1) X else if dy=0 then X if dx=1 then zx := safe(x+1,y,1,0) and safe(x+1,y-1,1,-1) X and safe(x+1,y+1,1,1) X else zx := safe(x-1,y,-1,0) and safe(x-1,y-1,-1,-1) X and safe(x-1,y+1,1,-1); X safe := zx; X end; X X begin X r := true; X for dx := -1 to 1 do X for dy := -1 to 1 do X if (dx<>0) or (dy<>0) then X r := r and safe(x,y,dx,dy); X safeway := r; X end; X X function botsleft:boolean; `7Balso moves the bots`7D X var i,j:integer; X dead,b:boolean; X begin `7Bfunction botsleft in play`7D X for i := 1 to numbots do X begin X if robx`5Bi`5D<>0 then X begin X grid`5Brobx`5Bi`5D,roby`5Bi`5D`5D := nothing; X if robx`5Bi`5Dx then robx`5Bi`5D := robx`5Bi`5D - 1; X if roby`5Bi`5Dy then roby`5Bi`5D := roby`5Bi`5D - 1; X end; X end; X for i := 1 to numbots-1 do X if robx`5Bi`5D<>0 then X begin X for j := i+1 to numbots do X if (robx`5Bi`5D<>0) and X ((robx`5Bi`5D=robx`5Bj`5D) and (roby`5Bi`5D=roby`5Bj`5D)) V then X begin X grid`5Brobx`5Bj`5D,roby`5Bj`5D`5D := rubble; X robx`5Bi`5D := 0; X robx`5Bj`5D := 0; X score := score + rval + rval; X botscount := botscount - 2; X gotoxy(xmax+16,6); writeln (botscount:3); X gotoxy(xmax+13,2); writeln (score:4); X end; X end; X for i := 1 to numbots do X if robx`5Bi`5D<>0 then X if (grid`5Brobx`5Bi`5D,roby`5Bi`5D`5D = rubble) X then begin X robx`5Bi`5D := 0; X score := score + rval; X botscount := botscount - 1; X gotoxy(xmax+16,6); writeln (botscount:3); X gotoxy(xmax+13,2); writeln (score:4); X end; X for i := 1 to numbots do X if robx`5Bi`5D<>0 then grid`5Brobx`5Bi`5D,roby`5Bi`5D`5D:=a_robot V; X botsleft := botscount<>0; X display; X end; X X function hero_dead:boolean; `7Balso moves the hero`7D X var c:char; X i,ox,oy:integer; X made_a_move:boolean; X X function botsthere:boolean; `7Bfunction botsthere in hero_dead in pl Vay`7D X var i,j:integer; X b:boolean; X begin `7Bfunction botsthere in hero_dead in play`7D X b := false; X for i := -1 to 1 do X for j := -1 to 1 do X b := b or (grid`5Bx+i,y+j`5D=a_robot); X botsthere := b; +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+-