u3369429@ucsvc.dn.mu.oz (Michael Bednarek) (03/22/88)
Well, I had this Friday afternoon to kill, and then there was this discussion
here about getting keyboard input to DCL without hitting RETURN.
So I ported this game to DCL. You jump over pegs and remove them, the aim is
that only the center hole has a peg at the end of the game.
The keypad keys 2,4,6,8 are used for direction control, jumping is indicated
by a preceding PF1 (also known as GOLD). The interesting thing is that it
doesn't require RETURN/ENTER to be pressed. So there! The interested reader
might also find some novel uses of the symbol substitution operators.
As an excuse for this posting I include a one-line procedure which I use a lot.
It lets you edit a symbol. I call it "ES". I often create symbols on the fly,
and then I want to change them slightly. Entering "ES <symbol>" will define
the "DO"-key with that symbol and its definition. So pressing DO will then
allow -- via DCL editing keys -- to edit that symbol:
$! ES.COM Define key `Do' with a symbol definition, so it can be edited.
$ Define/Key/NoLog/NoErase DO "''P1'==""''&P1'"""
--
Michael Bednarek, Institute of Applied Economic and Social Research (IAESR)
// Melbourne University,Parkville 3052, AUSTRALIA, Phone:+61 3 344 5744
\X/ Domain:u3369429@{murdu.oz.au | ucsvc.dn.mu.oz.au} | mb@munnari.oz.au
"bang":...UUNET!munnari!murdu!u3369429 PSI%23343000301::U3369429
"POST NO BILLS."
$!...................... Cut on the dotted line and save ......................
$! VAX/VMS archive file created by VMS_SHAR V-5.04 04-Feb-1988
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by U3369429 (Michael Bednarek)
$! on Monday 21-MAR-1988 16:30:32.85
$!
$! It contains the following 1 file:
$! HI-Q.COM
$!=============================================================================
$Set Symbol/Scope=(NoLocal,NoGlobal)
$Version=F$GetSYI("VERSION")
$If Version.ges."V4.4" then goto Version_OK
$Write SYS$Output "Sorry, you are running VMS ",Version, -
", but this procedure requires V4.4 or higher."
$Exit 44
$Version_OK:CR[0,8]=13
$Pass_or_Failed="failed!,passed."
$Goto Start
$Convert_File:
$Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1:Define/User_Mode SYS$Output NL:
$Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;
Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$Delete VMS_SHAR_DUMMY.DUMMY;*
$Checksum 'File_is
$Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2:Return
$Start:
$File_is="HI-Q.COM"
$Check_Sum_is=1663686003
$Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$ Facility_Name=`009"HI-Q"
X$ Facility_Version=`009"V-1.00 18-Mar-1988"
X$ Verify=F$Verify(F$TRNLNM("COMMAND_DEBUG"))
X$ On Control_Y then goto Exit
X$ Set Symbol/Scope=NoGlobal
X$!
X$! Copyright `169 (c) 1988, by Michael Bednarek
X$! The distribution of this file is unrestricted as long as this notice
X$! remains intact.
X$!
X$! Michael Bednarek, Institute of Applied Economic and Social Research (IAESR)
X$! // Melbourne University,Parkville 3052, AUSTRALIA, Phone:+61 3 344 5744
X$! \X/ Domain:u3369429@{murdu.oz.au | ucsvc.dn.mu.oz.au} | mb@munnari.oz.au
X$! "bang":...UUNET!munnari!murdu!u3369429 PSI%23343000301::U3369429
X$!
X$ Say="Write SYS$Output"
X$ Ask="Inquire/NoPunctuation"
X$!
X$ Gosub Intro
X$ Say "Initializing ..."
X$ On Control_Y then goto EndGame
X$ Gosub Init
X$NewGame: Gosub InitTable
X$ Gosub DrawBoard
X$!
X$GetInput:
X$ Say CSI,"1;1H"`009! set the cursor always at the top to prevent scrolling
X$ Ask Command ""
X$ Cmd=Command-"J"
X$ Jump=Cmd.nes.Command
X$ If F$Locate(".''Cmd'.",Commands).ne.lCommands then gosub 'Cmd
X$ Goto GetInput
X$EndGame: Set Key/State=DEFAULT/NoLog
X$ Delete/Key/NoLog/All/State=(Curious,Curiouser)
X$ Set Terminal/NoApplication_Keypad/Line_Editing/Echo
X$ Say A,CSI,"23;1H",CSI,"?25h"`009! exit on last line, cursor on
X$Exit:
X$ Exit 0*F$Verify(Verify)+1
X$!----------------------------------------------------------------------------
X$Intro:
X$ Say Facility_Name," ",Facility_Version
X$ Type SYS$Input
X
XA well known one-player game, once implemented by Bill Conley for MS-DOS,
Xhere presented by Michael Bednarek, entirely in Vax/VMS DCL.
X
XA version in AmigaBasic is also available.
X
X //
X \X/ u3369429@{murdu.oz.au | ucsvc.dn.mu.oz.au} | mb@munnari.oz.au
X$ Ask Yes "Do you want help? "
X$ If .not.Yes then Return
X$ShowHelp: Type SYS$Input
X
XThe game is played on a board with 33 holes arranged in a cross pattern
Xand begins with all except the center hole being filled with a peg.
X
XThe object of the game is to remove as many pegs as possible by jumping pegs
Xeither horizontally or vertically and removing pegs that are jumped over.
XNo diagonal moves or moves without jumping are allowed.
X
XYou move around the board using the numeric keypad keys:
X
X`009 8 = Up
X 4 Left`009`009 6 = Right
X`009 2 = Down
X
VYou jump by pressing PF1 plus a keypad key, e.g. to jump upwards press PF1 KP8
X.
XPress PF1 twice to exit the game (or F10 on a VT200).
XNote: pressing CTRL/Z will not end the game!
XPF2 will produce this page again, and PF4 will reset the board.
X
XGood luck.
X$ Read/End_of_File=Exit/Error=Return/Prompt="Hit RETURN to continue"-
X`009/Time_Out=30 SYS$Command Yes
X$Return: Return
X$!----------------------------------------------------------------------------
X$UP:
X$ y=CurY-1
X$ x=CurX
X$ Goto Play
X$RIGHT:
X$ y=CurY
X$ x=CurX+1
X$ Goto Play
X$LEFT:
X$ y=CurY
X$ x=CurX-1
X$ Goto Play
X$DOWN:
X$ y=CurY+1
X$ x=CurX
X$Play:
X$ If F$Type(Table'y''x).nes."" then goto Play1
X$Error:
X$ Say BEL
X$ Return
X$Play1:
X$ If Jump then goto Jump
X$ Call DrawOne 'F$Integer(CurY*3-2) 'F$Integer(CurX*5+19) 0 &Table'CurY''CurX
X$ CurY=y
X$ CurX=x
X$ Call DrawOne 'F$Integer(CurY*3-2) 'F$Integer(CurX*5+19) 7 &Table'CurY''CurX
X$ Return
X$Jump:
X$ If Table'CurY''CurX'.ne."1" then goto Error`009! Currently on a peg?
X$ If Table'y''x'.ne."1" then goto Error`009`009! Jumping over a peg?
X$ jy=CurY+(y-CurY)*2
X$ jx=CurX+(x-CurX)*2
X$ If F$Type(Table'y''x).eqs."" then goto Error`009! Out of bounds?
X$ If Table'jy''jx'.ne."0" then goto Error`009! Target empty?
V$ Table'CurY''CurX'="0"`009! The current position becomes empty & un-highlight
Xed
X$ Call DrawOne 'F$Integer(CurY*3-2) 'F$Integer(CurX*5+19) 0 0
X$ Table'y''x'="0"`009! The skipped position becomes empty, too.
X$ Call DrawOne 'F$Integer(y*3-2) 'F$Integer(x*5+19) 0 0
X$ Table'jy''jx'="1"`009! The target position becomes filled & highlighted
X$ Call DrawOne 'F$Integer(jy*3-2) 'F$Integer(jx*5+19) 7 1
X$ CurY=jy
X$ CurX=jx
X$ nPegs=nPegs-1
X$ Gosub DrawScore
X$Return
X$!----------------------------------------------------------------------------
X$Help:
X$ Say A,CLS
X$ Gosub ShowHelp
X$ Gosub DrawBoard
X$ Return
X$!----------------------------------------------------------------------------
X$Init:
X$ If F$GetDVI("TT","TT_DECCRT") then goto Start0
X$ Say "Sorry, HI-Q needs a DEC CRT terminal."
X$ Goto Exit
X$Start0:If F$Mode().nes."BATCH" then goto Init0
X$ Say "You can't play HI-Q in batch."
X$ Goto Exit
X$!
X$Init0:
X$ BEL[0,8]=7
X$ ESC[0,8]=27
X$ CSI=ESC+"["
X$ CLS=CSI+"2J"+CSI+"1;1H"`009! Clear Screen & Home
X$ G=ESC+"(0"`009`009`009! DEC Special Graphics character set
X$ A=ESC+"(B"`009`009`009! ASCII character set
X$!
X$ Set Terminal/Application_Keypad/NoLine_Editing/NoEcho
X$ Define/Key/NoLog PF1 ""/Set_State=Curiouser/If_State=Curious
X$ Define/Key/NoLog PF2 HELP/Terminate/NoEcho/If_State=Curious
X$ Define/Key/NoLog HELP HELP/Terminate/NoEcho/If_State=Curious
X$ Define/Key/NoLog PF4 NEWGAME/Terminate/NoEcho/If_State=Curious
X$ Define/Key/NoLog KP8 UP/Terminate/NoEcho/If_State=Curious
X$ Define/Key/NoLog KP6 RIGHT/Terminate/NoEcho/If_State=Curious
X$ Define/Key/NoLog KP4 LEFT/Terminate/NoEcho/If_State=Curious
X$ Define/Key/NoLog KP2 DOWN/Terminate/NoEcho/If_State=Curious
X$ Define/Key/NoLog F10 EndGame/Terminate/NoEcho/If_State=Curious
X$ Set Key/State=Curious/NoLog
X$ Define/Key/NoLog KP8 JUP/Terminate/NoEcho/If_State=Curiouser
X$ Define/Key/NoLog KP6 JRIGHT/Terminate/NoEcho/If_State=Curiouser
X$ Define/Key/NoLog KP4 JLEFT/Terminate/NoEcho/If_State=Curiouser
X$ Define/Key/NoLog KP2 JDOWN/Terminate/NoEcho/If_State=Curiouser
X$ Define/Key/NoLog PF1 EndGame/Terminate/NoEcho/If_State=Curiouser
X$!
X$ Commands=".UP.RIGHT.LEFT.DOWN.ENDGAME.HELP.NEWGAME.CHEAT."
X$ lCommands=F$Length(Commands)
X$ Cmd=""
X$ nGames=-1
X$ nPegs=32
X$ BestResult=32
X$ Say CSI,"?25l"`009! Cursor Off
X$Return
X$!----------------------------------------------------------------------------
X$Cheat:
X$InitTable:
X$ CurY=0
X$iNextRow: CurX=0
X$ CurY=CurY+1
X$ If CurY.le.7 then goto iNextCol
X$ Table44="0"
X$ CurY=6
X$ CurX=4
X$ If nPegs.lt.BestResult then BestResult=nPegs
X$ nGames=nGames+1
X$ nPegs=32
X$ If Cmd.nes."CHEAT" then Return
X$ Table52="1"
X$ Table53="1"
X$ Table64="1"
X$ CurY=5
X$ CurX=2
X$ nPegs=3
X$ Return
X$iNextCol: CurX=CurX+1
X$ If CurX.gt.7 then goto iNextRow
X$ If (CurY.lt.3 .or. CurY.gt.5).and.(CurX.lt.3 .or. CurX.gt.5) -
X`009.or. CurY.eq.4 .and. CurX.eq.4 then goto iNextCol
X$ Table'CurY''CurX="1"
X$ If Cmd.nes."CHEAT" then goto iNextCol
X$ Table'CurY''CurX="0"
X$ Goto iNextCol
X$!----------------------------------------------------------------------------
X$DrawBoard:
X$Say CLS
X$ y=0
X$NextRow: x=0
X$ y=y+1
X$ If y.le.7 then goto NextCol
X$!
X$ Say A,CSI,"3;54H",F$FAO("!SL game!%S played",nGames),CSI,"K"
X$ Say CSI,"4;54HBest result was ",BestResult
X$ Say CSI,"17;2HKP8 = Up Precede",CSI,"17;54H6 or more left .. nice try"
V$ Say CSI,"18;2HKP6 = Right with",`009CSI,"18;54H5 left .............. good
X"
X$ Say CSI,"19;2HKP4 = Left PF1",`009CSI,"19;54H4 left ............ better"
X$ Say CSI,"20;2HKP2 = Down to jump",CSI,"20;54H3 left ..... really clever"
X$ Say`009`009`009`009`009CSI,"21;54H2 left ........ a sharpie!"
X$ Say CSI,"22;2HPF2 = Help",`009`009CSI,"22;54H1 left ... take a deep bow"
X$ Say CSI,"23;2HPF4 = Reset",`009`009CSI,"23;54H1 left in center...perfect"
X$ Say CSI,"23;15HPress PF1 twice to exit"
X$ Gosub DrawScore
X$Return
X$NextCol: x=x+1
X$ If x.gt.7 then goto NextRow
X$ If F$Type(Table'y''x).eqs."" then goto NextCol
X$ Attr=(y.eq.CurY .and. x.eq.CurX)*7
X$ Call DrawOne 'F$Integer(y*3-2) 'F$Integer(x*5+19) 'Attr &Table'y''x
X$ Goto NextCol
X$!----------------------------------------------------------------------------
X$DrawOne: Subroutine
X$! Draws a box, either filled or empty, highlighted or plain.
X$! P1 = Row number`009`009P2 = Column number
X$! P3 = Attributes for SGR`009P4 = Empty (0) /filled (1)
X$ P1=F$Integer(P1)`009! Necessary because of "P1+1" below
X$! The next line not only works if P4="0"|"1", but also if P4="TABLE44" and
X$! TABLE44="0"|"1".
X$ P4=F$Element(F$Integer('P4),",","Hx x,Hxaax")
X$ Say G,CSI,P3,"m",-
X CSI,P1,";",P2,"Hlqqk",CSI,P1+1,";",P2,P4,CSI,P1+2,";",P2,"Hmqqj",-
X CSI,"0m",A
X$EndSubroutine
X$!----------------------------------------------------------------------------
X$DrawScore:
X$ Say A,CSI,"11;63H",F$FAO("!2SL peg!%S remaining",nPegs),CSI,"K"
X$ If nPegs.eq.1 then goto Finish
X$! Check whether the player is stuck
X$ y=0
X$cNextRow: x=0
X$ y=y+1
X$ If y.le.7 then goto cNextCol
X$Finish: Say CSI,"23;2H",CSI,"5;7mPF4 = Reset"
X$ Say CSI,"23;15HPress PF1 twice to exit",CSI,"0m",BEL
X$ Goto Illuminate
X$cNextCol: x=x+1
X$ If x.gt.7 then goto cNextRow
X$ If F$Type(Table'y''x).eqs."" then goto cNextCol
X$! Look at 3 boxes horizontally and vertically at once
X$ If F$Type(Table'y''F$Integer(x+2)).eqs."" then goto cCol
X$ Check=Table'y''x+Table'y''F$Integer(x+1)+Table'y''F$Integer(x+2)
X$ If Check.eqs."110" .or. Check.eqs."011" then goto Illuminate
X$cCol:
X$ If F$Type(Table'F$Integer(y+2)''x).eqs."" then goto cNextCol
X$ Check=Table'y''x+Table'F$Integer(y+1)''x+Table'F$Integer(y+2)''x
X$ If Check.nes."110" .and. Check.nes."011" then goto cNextCol
X$Illuminate:
X$ If nPegs.gt.6 then Return
X$ Goto Illuminate'nPegs
X$Illuminate6:
X$ Say A,CSI,"17;54H",CSI,"7m6 or more left .. nice try",CSI,"0m"
X$ Return
X$Illuminate5:
X$ Say A,CSI,"17;54H6 or more left .. nice try"
X$ Say A,CSI,"18;54H",CSI,"7m5 left .............. good",CSI,"0m"
X$ Return
X$Illuminate4:
X$ Say A,CSI,"18;54H5 left .............. good"
X$ Say A,CSI,"19;54H",CSI,"7m4 left ............ better",CSI,"0m"
X$ Return
X$Illuminate3:
X$ Say A,CSI,"19;54H4 left ............ better"
X$ Say A,CSI,"20;54H",CSI,"7m3 left ..... really clever",CSI,"0m"
X$ Return
X$Illuminate2:
X$ Say A,CSI,"20;54H3 left ..... really clever"
X$ Say A,CSI,"21;54H",CSI,"7m2 left ........ a sharpie!",CSI,"0m"
X$ Return
X$Illuminate1:
X$ Say A,CSI,"21;54H2 left ........ a sharpie!"
X$ If Table44.eqs."1" then goto Illuminate0
X$ Say A,CSI,"22;54H",CSI,"7m1 left ... take a deep bow",CSI,"0m"
X$ Return
X$Illuminate0:
X$ Say A,CSI,"23;54H",CSI,"7m1 left in center...perfect",CSI,"0m"
X$ Return
$GoSub Convert_File
$Exit