$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 30-MAY-1992 02:40:30.45 By user MASLIB $! $! 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 2 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. DALEKS.PAS;1 $! 3. DALEKS.PIC;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 DALEKS X$ LINK DALEKS, INTERACT/LIB X$ DELETE *.OBJ;*/NOCONFIRM X$ EXIT $ CALL UNPACK BUILD.COM;1 67178854 $ create 'f' X`5B X Inherit`20 X ( X 'SYS$LIBRARY:STARLET', X 'INTERACT' X ) X`5D X XPROGRAM Daleks; X XCONST X left = 2; X right = 39; X top = 2; X bottom = 21; X nothing = ' '; X dalek = 'D'; X doctor = 'O'; X junk = '*'; X dont_wait = false; X XTYPE X dalek_pointer = `5Edalek_node; X dalek_node = Record X x , y : integer; X prev : dalek_pointer; X next : dalek_pointer; X End; X big_array = array `5B1..(right-left+1)*(bottom-top+1)`5D of Record X x , y : integer; X End; `20 X v_array = varying `5B10`5D of char; X XVAR X board : array `5Bleft..right,top..bottom`5D of char; X score : integer; X screwdriver_used : boolean; X x_posn , y_posn : integer; X head_dalek : dalek_pointer; X level : integer; X doctor_dead : boolean; X daleks_dead : boolean; X last_stand : boolean; X beeps_on : boolean; X X XFUNCTION move_right ( n : integer ) : v_array; XBEGIN X IF n = 0 then X move_right := '' X ELSE X IF n = 1 then X move_right := VT100_esc + '`5BC' X ELSE X move_right := VT100_esc + '`5B' + dec(n) + 'C'; XEND; X X XPROCEDURE Initialize; XBEGIN X show_graphedt ('Daleks.pic'); X score := 0; X level := 0; X head_dalek := nil; X doctor_dead := false; X daleks_dead := false; X beeps_on := false; XEND; X X XPROCEDURE Place_doctor_first_time; XVAR`20 X x,y : integer; XBEGIN X x_posn := random(right-left+1)+left-1; X y_posn := random(bottom-top+1)+top-1; X FOR x := max(left,x_posn-1) to min(x_posn+1,right) do X FOR y := max(top,y_posn-1) to min(y_posn+1,bottom) do X board`5Bx,y`5D := doctor; XEND; X X XPROCEDURE Remove_doctor_with_style; XVAR X x,y,i : integer; XBEGIN X qio_write (get_posn (x_posn,y_posn)+ X VT100_graphics_on+'`60'+VT100_graphics_off); X board`5Bx_posn,y_posn`5D := nothing; X X qio_write (get_posn (x_posn,y_posn)+nothing); X X FOR i := 1 to 3 do X BEGIN X qio_write (VT100_bright+ X get_posn (x_posn,max(y_posn-i,top))+ X VT100_graphics_on+'`7E'+VT100_graphics_off+ X get_posn (x_posn,min(y_posn+i,bottom))+ X VT100_graphics_on+'`7E'+VT100_graphics_off+ X get_posn (max(x_posn-i,left),y_posn)+ X VT100_graphics_on+'`7E'+VT100_graphics_off+ X get_posn (min(x_posn+i,right),y_posn)+ X VT100_graphics_on+'`7E'+VT100_graphics_off+ X VT100_normal+ X get_posn (x_posn,max(y_posn-i,top))+ X board`5Bx_posn,max(y_posn-i,top)`5D+ X get_posn (x_posn,min(y_posn+i,bottom))+ X board`5Bx_posn,min(y_posn+i,bottom)`5D+ X get_posn (max(x_posn-i,left),y_posn)+ X board`5Bmax(x_posn-i,left),y_posn`5D+ X get_posn (min(x_posn+i,right),y_posn)+ X board`5Bmin(x_posn+i,right),y_posn`5D); X END; XEND; X X XFUNCTION Teleport_possible : boolean; XVAR`20 X x,y,i,j : integer; X r : integer; X safe_places : integer; X safe : boolean; X safe_where : big_array; XBEGIN X safe_places := 0; X FOR x := left to right do X FOR y := top to bottom do X IF board`5Bx,y`5D = nothing then X BEGIN X safe := true; X i := max(left,x-1); X r := min(x+1,right); X WHILE ( i <= r ) and safe do X BEGIN X FOR j := max(top,y-1) to min(y+1,bottom) do X IF ( board`5Bi,j`5D = dalek ) then X safe := false; X i := i + 1; X END; X IF safe then X BEGIN X safe_places := safe_places + 1; X safe_where`5Bsafe_places`5D.x := x; X safe_where`5Bsafe_places`5D.y := y; X END; X END; X `20 X teleport_possible := ( safe_places <> 0 ); X X IF safe_places <> 0 then X BEGIN X i := random(safe_places); X remove_doctor_with_style; X x_posn := safe_where`5Bi`5D.x; X y_posn := safe_where`5Bi`5D.y; X END; XEND; X X XPROCEDURE Create_daleks ( nu : integer ); XVAR X i,j : integer; X x,y : integer; X safe_places : integer; X safe_where : big_array; X this_dalek : dalek_pointer; X buffer : varying `5B200`5D of char; X spaces : integer; XBEGIN X safe_places := 0; X FOR x := left to right do X FOR y := top to bottom do X IF ( board`5Bx,y`5D = nothing ) then X BEGIN X safe_places := safe_places + 1; X safe_where`5Bsafe_places`5D.x := x; X safe_where`5Bsafe_places`5D.y := y; X END; X X reset_randomizer; X FOR j := 1 to min(nu,safe_places) do X BEGIN X NEW (this_dalek); X this_dalek`5E.next := head_dalek; X IF ( head_dalek <> nil ) then X head_dalek`5E.prev := this_dalek; X head_dalek := this_dalek; X `20 X i := randomize(safe_places); X this_dalek`5E.x := safe_where`5Bi`5D.x; X this_dalek`5E.y := safe_where`5Bi`5D.y; X X board`5Bthis_dalek`5E.x,this_dalek`5E.y`5D := dalek; X END; X X FOR y := top to bottom do X BEGIN X buffer := ''; X spaces := 100; X FOR x := left to right do X IF ( board`5Bx,y`5D = dalek ) then X BEGIN X IF ( spaces > 5 ) then X buffer := buffer + get_posn(x,y) + dalek X ELSE X buffer := buffer + pad('',' ',spaces) + dalek; X spaces := 0; X END X ELSE X spaces := spaces + 1; X qio_write (buffer); X END; XEND; X X XPROCEDURE Put_on_doctor_with_style; XVAR X x,y,i : integer; XBEGIN X FOR i := 3 downto 1 do X BEGIN X qio_write (VT100_bright+ X get_posn (x_posn,max(y_posn-i,top))+ X VT100_graphics_on+'`7E'+VT100_graphics_off+ X get_posn (x_posn,min(y_posn+i,bottom))+ X VT100_graphics_on+'`7E'+VT100_graphics_off+ X get_posn (max(x_posn-i,left),y_posn)+ X VT100_graphics_on+'`7E'+VT100_graphics_off+ X get_posn (min(x_posn+i,right),y_posn)+ X VT100_graphics_on+'`7E'+VT100_graphics_off+ X VT100_normal+ X get_posn (x_posn,max(y_posn-i,top))+ X board`5Bx_posn,max(y_posn-i,top)`5D+ X get_posn (x_posn,min(y_posn+i,bottom))+ X board`5Bx_posn,min(y_posn+i,bottom)`5D+ X get_posn (max(x_posn-i,left),y_posn)+ X board`5Bmax(x_posn-i,left),y_posn`5D+ X get_posn (min(x_posn+i,right),y_posn)+ X board`5Bmin(x_posn+i,right),y_posn`5D); X END; X qio_write (get_posn (x_posn,y_posn)+ X VT100_graphics_on+'`60'+VT100_graphics_off); X board`5Bx_posn,y_posn`5D := doctor; XEND; X X XFUNCTION beep_on_or_off : v_array; XBEGIN X IF beeps_on then X beep_on_or_off := 'ON ' X ELSE X beep_on_or_off := 'OFF'; XEND; X X XPROCEDURE Setup; XVAR X x , y , i : integer; XBEGIN X clear; X posn (1,1); X for y := 1 to 23 do X qio_writeln (VT100_wide); X square (left-1,top-1,right+1,bottom+1); X FOR x := left to right do X FOR y := top to Bottom do X board`5Bx,y`5D := nothing; X level := level + 1; X screwdriver_used := false; X last_stand := false; X qio_write (get_posn (2,23)+ X 'LEVEL : '+VT100_bright+dec(level)+VT100_normal+ X get_posn (14,23)+ X 'BEEPS : '+VT100_bright+beep_on_or_off+VT100_normal+ X get_posn (27,23)+ X 'SCORE : '+VT100_bright+dec(score)+VT100_normal); X place_doctor_first_time; X create_daleks ((level**2)*6); X FOR x := max(left,x_posn-1) to min(x_posn+1,right) do X FOR y := max(top,y_posn-1) to min(y_posn+1,bottom) do X board`5Bx,y`5D := nothing; X put_on_doctor_with_style; X qio_purge; XEND; X X XPROCEDURE Sonic_screwdriver; XVAR X this_dalek : dalek_pointer; X temp_dalek : dalek_pointer; XBEGIN X screwdriver_used := true; X qio_write (VT100_graphics_on+VT100_bright); X IF y_posn > top then X IF x_posn > left then X IF x_posn < right then X qio_write (get_posn(x_posn-1,y_posn-1)+'lqk') X ELSE X qio_write (get_posn(x_posn-1,y_posn-1)+'lq') X ELSE X qio_write (get_posn(x_posn,y_posn-1)+'qk'); X X IF x_posn > left then X IF x_posn < right then X qio_write (get_posn(x_posn-1,y_posn)+'x x') X ELSE X qio_write (get_posn(x_posn-1,y_posn)+'x ') X ELSE X qio_write (get_posn(x_posn,y_posn)+' x'); X X IF y_posn < bottom then X IF x_posn > left then X IF x_posn < right then X qio_write (get_posn(x_posn-1,y_posn+1)+'mqj') X ELSE X qio_write (get_posn(x_posn-1,y_posn+1)+'mq') X ELSE X qio_write (get_posn(x_posn,y_posn+1)+'qj'); X X qio_write (VT100_graphics_off+VT100_normal); X X this_dalek := head_dalek; X WHILE ( this_dalek <> nil ) do X BEGIN X IF ( abs(this_dalek`5E.x-x_posn) < 2 ) and`20 X ( abs(this_dalek`5E.y-y_posn) < 2 ) then X BEGIN X IF ( this_dalek`5E.prev = nil ) then X head_dalek := head_dalek`5E.next X ELSE X this_dalek`5E.prev`5E.next := this_dalek`5E.next; X IF ( this_dalek`5E.next <> nil ) then X this_dalek`5E.next`5E.prev := this_dalek`5E.prev; X board`5Bthis_dalek`5E.x,this_dalek`5E.y`5D := nothing; X IF beeps_on then X qio_write (VT100_bell); X temp_dalek := this_dalek; X this_dalek := this_dalek`5E.next; X DISPOSE (temp_dalek); X score := score + 1 + ord(last_stand); X qio_write (get_posn (27,23)+ X 'SCORE : '+VT100_bright+dec(score)+VT100_normal); X END X ELSE X this_dalek := this_dalek`5E.next; X END; X X IF y_posn > top then X IF x_posn > left then X IF x_posn < right then X qio_write (get_posn(x_posn-1,y_posn-1)+ X board`5Bx_posn-1,y_posn-1`5D+ X board`5Bx_posn,y_posn-1`5D+ X board`5Bx_posn+1,y_posn-1`5D) X ELSE X qio_write (get_posn(x_posn-1,y_posn-1)+ X board`5Bx_posn-1,y_posn-1`5D+ X board`5Bx_posn,y_posn-1`5D) X ELSE X qio_write (get_posn(x_posn,y_posn-1)+ X board`5Bx_posn,y_posn-1`5D+ X board`5Bx_posn+1,y_posn-1`5D); X X IF x_posn > left then X IF x_posn < right then X qio_write (get_posn(x_posn-1,y_posn)+ X board`5Bx_posn-1,y_posn`5D+ X ' '+ X board`5Bx_posn+1,y_posn`5D) X ELSE X qio_write (get_posn(x_posn-1,y_posn)+ X board`5Bx_posn-1,y_posn`5D+ X ' ') X ELSE X qio_write (get_posn(x_posn,y_posn)+ X ' '+ X board`5Bx_posn+1,y_posn`5D); X X IF y_posn < bottom then X IF x_posn > left then X IF x_posn < right then X qio_write (get_posn(x_posn-1,y_posn+1)+ X board`5Bx_posn-1,y_posn+1`5D+ X board`5Bx_posn,y_posn+1`5D+ X board`5Bx_posn+1,y_posn+1`5D) X ELSE X qio_write (get_posn(x_posn-1,y_posn+1)+ X board`5Bx_posn-1,y_posn+1`5D+ X board`5Bx_posn,y_posn+1`5D) X ELSE X qio_write (get_posn(x_posn,y_posn+1)+ X board`5Bx_posn,y_posn+1`5D+ X board`5Bx_posn+1,y_posn+1`5D); X qio_write (get_posn (x_posn,y_posn)+ X VT100_graphics_on+'`60'+VT100_graphics_off); XEND; X X XPROCEDURE refresh; XVAR +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+-