$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 18-JUN-1993 00:19:15.58 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 $! $! 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. SINISTER.FOR;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 program sinister_island X implicit none X character *16 money_str,risk_str,answer X character *8 item(21) X real *16 money,risk X real *4 value,wait X integer *4 i,j,k,l,m,n,now(3),seed,number,disp,paste,keyb,status X integer *4 odds(16),slot(3),winner,kind(6),length X integer *4 mask,save X data item/' BAR ', X + ' BELL ',' BELL ', X + ' ORANGE ',' ORANGE ',' ORANGE ', X + ' LEMON ',' LEMON ',' LEMON ',' LEMON ', X + ' BANANA ',' BANANA ',' BANANA ',' BANANA ',' BANANA ', X + ' CHERRY ',' CHERRY ',' CHERRY ',' CHERRY ',' CHERRY ', X + ' CHERRY '/ X data odds/15625,1875,550,231,125,66,2604,625,275,154,104, X + 433,208,137,104,83/ X include '(lib$routines)' X include '(mth$routines)' X include '(smg$routines)' X include '($libdef)' X include '($smgdef)' X include '($smgmsg)' X include '($ssdef)' X X call ec(lib$disable_ctrl(mask,save)) X money = 100 X risk = 0 X call numstr(money,money_str) X call numstr(risk,risk_str) X call ec(smg$create_virtual_display(24,80,disp)) X call ec(smg$create_pasteboard(paste)) X call ec(smg$create_virtual_keyboard(keyb)) X call ec(smg$set_broadcast_trapping(paste)) X call ec(smg$begin_display_update(disp)) X call ec(smg$draw_rectangle(disp,6,5,8,14)) X call ec(smg$draw_rectangle(disp,6,35,8,44)) X call ec(smg$draw_rectangle(disp,6,65,8,74)) X call ec(smg$end_display_update(disp)) X call ec(smg$paste_virtual_display(disp,paste,1,1)) X call ec(smg$put_chars_highwide(disp,'SINISTER ISLAND',2,25)) X call ec(smg$put_chars_highwide(disp,'CASH: $'//money_str,11,5)) X call ec(smg$put_chars_highwide(disp,'RISK: $'//risk_str,13,5)) X X 5 call ec(smg$set_cursor_abs(disp,18,5)) X status = smg$read_string(keyb,answer,'How much money do you '// X + 'wish to risk? ',,,,,length,,disp) X if (status.eq.smg$_eof) goto 90 X call ec(status) X read(answer(1:length),'(f16.0)',iostat=status) risk X call ec(smg$erase_display(disp,13,2,22,78)) X if ((risk.lt.0).or.(risk.gt.money)) goto 5 X if (status.eq.0) then X call numstr(risk,risk_str) X call ec(smg$put_chars_highwide(disp,'RISK: $'//risk_str,13,5)) X else X goto 5 X endif X X call time(now) X seed = now(2)/2 + 1 X if (.not.seed) seed = seed + 1 X do i = 1,210 X do j = 1,3 X 10 value = mth$random(seed) * 25.0 X number = value X if ((number.lt.1).or.(number.gt.21)) goto 10 X if ((i.le.30).and.(j.eq.1)) then X call ec(smg$put_chars(disp,item(number),7,6)) X slot(1) = number X endif X if ((i.le.81).and.(j.eq.2)) then X call ec(smg$put_chars(disp,item(number),7,36)) X slot(2) = number X endif X if ((i.le.150).and.(j.eq.3)) then X call ec(smg$put_chars(disp,item(number),7,66)) X slot(3) = number X endif X enddo X enddo X X winner = 0 X do i = 1,3 X if (slot(i).eq.1) kind(i) = 1 X enddo X do i = 1,3 X if ((slot(i).ge.2).and.(slot(i).le.3)) kind(i) = 2 X enddo X do i = 1,3 X if ((slot(i).ge.4).and.(slot(i).le.6)) kind(i) = 3 X enddo X do i = 1,3 X if ((slot(i).ge.7).and.(slot(i).le.10)) kind(i) = 4 X enddo X do i = 1,3 X if ((slot(i).ge.11).and.(slot(i).le.15)) kind(i) = 5 X enddo X do i = 1,3 X if ((slot(i).ge.16).and.(slot(i).le.21)) kind(i) = 6 X enddo X X if ((kind(1).eq.kind(2)).and.(kind(1).eq.kind(3))) X + winner = kind(1) X if ((kind(1).eq.kind(2)).and.(kind(3).eq.6)) X + winner = kind(1) + 6 X if ((kind(2).eq.kind(3)).and.(kind(3).eq.6)) X + winner = kind(1) + 11 X X if (winner.ne.0) then X call ec(smg$ring_bell(disp,3)) X money = money + risk*odds(winner) X if (money.gt.1e10) goto 80 X call ec(smg$put_chars_highwide(disp,'YOU WON!!',21,30)) X else X money = money - risk X call ec(smg$put_chars_highwide(disp,'YOU LOST!',21,30)) X if (money.eq.0) then X call ec(lib$wait(5.0)) X goto 90 X endif X endif X X risk = 0 X call numstr(money,money_str) X call numstr(risk,risk_str) X call ec(smg$put_chars_highwide(disp,'CASH: $'//money_str,11,5)) X call ec(smg$put_chars_highwide(disp,'RISK: $'//risk_str,13,5)) X goto 5 X X 80 risk = 0 X call numstr(money,money_str) X call numstr(risk,risk_str) X call ec(smg$put_chars_highwide(disp,'CASH: $'//money_str,11,5)) X call ec(smg$put_chars_highwide(disp,'RISK: $'//risk_str,13,5)) X call ec(smg$put_chars_highwide(disp,'YOU BROKE THE BANK!', X + 21,20)) X call ec(smg$put_chars_highwide(disp,'ARRRRGGGGHHHHHHHHH!', X + 23,20)) X call ec(lib$wait(5.0)) X X 90 call ec(smg$disable_broadcast_trapping(paste)) X call ec(smg$delete_pasteboard(paste)) X call ec(smg$delete_virtual_keyboard(keyb)) X call ec(smg$delete_virtual_display(disp)) X call ec(lib$enable_ctrl(save)) X end X X X subroutine numstr (number,string) X character *(*) string X real *16 number X write(string,'(f16.2)') number X end X X X subroutine ec (status) X integer *4 status X if (.not.status) call lib$signal(%val(status)) X end X X**************************************************************************** V**** X* `20 V * X* Program: SINISTER_ISLAND V * X* Author: William W. Brennessel V * X* BITNET: MASMUMMY@UBVMS V * X* Internet: masmummy@ubvms.cc.buffalo.edu V * X* `20 V * X* This program was created for personal use, and may be copied and altered V * X* under the condition that the author is not responsible for any problems V * X* that may occur. Comments and criticisms are always welcome. V * X* `20 V * X**************************************************************************** V**** $ CALL UNPACK SINISTER.FOR;1 2118868837 $ v=f$verify(v) $ EXIT