-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+ X enddo X pile(i-2) = tmp(1) X pile(i-1) = tmp(2) X end X X X subroutine help (paste,keyb) X implicit none X integer *4 hdisp,smg$create_virtual_display,smg$put_chars X integer *4 smg$paste_virtual_display,smg$read_keystroke X integer *4 smg$delete_virtual_display,paste,keyb,stroke,status X include '($smgdef)' X X call ec(smg$create_virtual_display(11,60,hdisp, X + smg$m_block_border)) X call ec(smg$paste_virtual_display(hdisp,paste,5,5)) X call ec(smg$put_chars(hdisp, X + ' PF1,F18,L8 - Places a new card on top of the stack.',2,1)) X call ec(smg$put_chars(hdisp, X + ' PF2,? - This help menu.',3,1)) X call ec(smg$put_chars(hdisp, X + ' PF3,F19,L9 - Play a card from the stack.',4,1)) X call ec(smg$put_chars(hdisp, X + ' PF4,F20,L10 - Move a card to the "save" stacks.',5,1)) X call ec(smg$put_chars(hdisp, X + ' q - Quits the game.',6,1)) X call ec(smg$put_chars(hdisp, X + ' 1-7 - Moves a card to or from the selected column.', X + 7,1)) X call ec(smg$put_chars(hdisp, X + ' r - Redraws the screen.',8,1)) X call ec(smg$put_chars(hdisp, X + ' `5BPress any key to continue`5D',10,1)) X status = smg$read_keystroke(keyb,stroke) X call ec(smg$delete_virtual_display(hdisp)) X end X X X subroutine illegal (disp) X implicit none X integer *4 smg$put_chars,smg$set_cursor_abs,disp,lib$wait X X call ec(smg$put_chars(disp,'ILLEGAL MOVE!',24,6)) X call ec(lib$wait(1.0)) X call ec(smg$put_chars(disp,' ',24,6)) X call ec(smg$put_chars(disp,' ',22,10)) X call ec(smg$set_cursor_abs(disp,22,10)) X end X X X subroutine num_to_str(num,str,length) X implicit none X character *(*) str X integer *4 i,num,length X X write(str,'(i4)') num X do i = 1,4 X if (str(i:i).ne.' ') go to 60 X enddo X 60 length = 5 - i X str(1:4) = str(i:4) X end X X subroutine ec (status) X implicit none X integer *4 status X X if (.not.status) call lib$signal(%val(status)) X end X X**************************************************************************** V**** X* `20 V * X* Program: SOLITAIRE 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 SOLITAIRE.FOR;1 223243083 $ v=f$verify(v) $ EXIT