SURROUND

heartbone · Post by **heartbone** » Tue Jun 24, 2014 10:17 am

____________________________________

After finishing with the Sna{c}key development on Sunday morning, I began thinking harder about what to program next.
After dinner I played a couple of games of SURROUND for the first time in many years with my daughter,
and then decided since it was so simple, and similar to Sna{c}key that I'd try to make a sub 800 line version of it
to post for those who want to learn more about old-school game programming.
I continue to be amazed at the ingenuity of those old Atari machine code programmers, at how they were able to pack those good games into 2K.

After reading the short game manual, and studying the GAME SELECT MATRIX

Code: Select all

Game Number        1  2  3  4  5  6  7  8  9 10 11 12      13      14
Number of Players  2  1  3  1  2  2  2  2  2  2  2  2  1 or 2  1 or 2
Speed Up                 X  X     X  X     X  X  X  X
Diagonal Movement              X  X  X        X  X  X               X
Erase                                X              X       X       X
Wraparound                              X  X  X  X  X       X       X

I decided not to bother with the VIDEO GRAFFITI™ (Game# 13 & 14), but instead to try and implement all the rest in within the 800 program line constraint in the demo-version of the compiler.

I started the programming of SURROUND at 9:48PM 6/22/14,
and I finished everything but the AI (used in game numbers 2 & 4) at 10:06 CDT PM 6/23/14.
I missed a 24 hour code development cycle by less than a half hour.
After a short break while thinking a couple of hours about the AI, I implemented it.
The Windows® v1.0 executable compile was finished at 2:33 AM CDT on 6/24/14.
I am a bit surprised at how quickly this was finished, only 9 hours of programming time within less than 29 hours total elapsed time from first keystroke start to finish.
PureBasic is quite powerful.

Because the AI procedure all by itself is 201 lines, I'm confident that adding it has made the program too big for the demo-version of the PB compiler.
So I am releasing this total game with AI as a standalone executable.
A game that I hadn't even planned on writing two days ago.
If you can't tell, I'm impressed.
After (if) I get the information about the demo-version's limitations,
I will make the source code (sans AI) conform to the demo-version compiler limits,
and I will post it in the 800 lines thread.
I'll also post the AI procedure (separately) for those of us not encumbered by the demo limitations so it can be added by the seasoned.

The sub 800 line game full game (sans AI) will compile and run without media,
however in the thread where I post the source I will also post links to 3 small .wav files,
which if present will be used by the game for sound effects.

Let me know if you find any problems with these executables before I release the source.
SURROUND for Windows®
SURROUND for x64 Linux
SURROUND for x86 Linux

IdeasVacuum · Post by **IdeasVacuum** » Tue Jun 24, 2014 11:16 am

Seems to work perfectly well on WinXP, but I have no idea of what the goal of the game is.........

heartbone · Post by **heartbone** » Tue Jun 24, 2014 11:26 am

IdeasVacuum wrote:Seems to work perfectly well on WinXP, but I have no idea of what the goal of the game is.........

SURROUND is another variation of snake.
You'll have to read the rules linked above for the details.

Things not mentioned in the sparse onscreen prompting:
• When playing using a keyboard controller, the trigger button is mapped to the closest ctrl key.
• When playing using a gamepad controller, any button will serve as the trigger.
• The Windows® version provides a full screen/window toggle by pressing W, F, S, or Alt+Enter.
• Press the space bar to pause while playing.

Play wise it's a close imitation to the original.
I had added a 'friendly trails' option, but only when I tested did I realize that I could paint an area and then just stay within it.
So I scrapped that bad idea and stuck with the original design.

heartbone · Post by **heartbone** » Wed Jun 25, 2014 2:49 pm

Compared to the version posted in the 800 lines thread, I've made a couple cosmetic tweaks to the title and option select screens, and saved 12 additional lines by moving Endifs.
The source code below is the entire SURROUND game as uploaded yesterday with the additional tweaks described above, and it should compile in the free demo-version.
If you want the locally compiled game to have sound, then place 3 short .wav files in the run folder named click.wav (~0.2 sec), boop.wav (~0.17 sec), die.wav (~0.6 sec).
Try these for starters: <click.wav> <boop.wav> <die.wav>

Code: Select all

; ********************************
; ******** SURROUND V1.01a *******
; ***** ELECTRONICAL SOFTWARE ****
; ******** June 25, 2014  ********
; ********************************
Global FULL
LoadFont(2,"Arial",24,#PB_Font_Bold|#PB_Font_HighQuality)
LoadFont(3,"Arial",36,#PB_Font_Bold|#PB_Font_HighQuality)
LoadFont(4,"Arial",48,#PB_Font_Bold|#PB_Font_HighQuality)
; ***********************************
; *** START OF PROCEDURES SECTION ***
; ***********************************
Procedure CLEARQUESC()
; EMPTIES XEVENT QUEUE AND RETURNS 1 WHEN ESCAPE KEY IS PRESSED
   ESCAPE= 0 : ExamineKeyboard() : If KeyboardPushed(#PB_Key_Escape) : ESCAPE= 1 : EndIf
   If Not FULL
      Repeat 
; THE "If" GETS EXECUTED WHEN USER CLICKS THE WINDOW CLOSE X ICON  
         X= WindowEvent() : If X = #PB_Event_CloseWindow : End : EndIf   
; THE UNTIL GETS SATISFIED WHEN THE QUEUE IS EMPTY
      Until X = 0   
   EndIf   
   ProcedureReturn ESCAPE
EndProcedure
Procedure.s CONDIS(SW)
; SAVED A FEW LINES BY MAKING THIS A PROCEDURE
   Select SW
      Case 0 : BUFF$= "WASD"
      Case 1 : BUFF$= "ARROW KEYS"
      Case 2 : BUFF$= "1st GAMEPAD"
      Case 3 : BUFF$= "2nd GAMEPAD"
   EndSelect 
   ProcedureReturn(BUFF$)
EndProcedure
Procedure CREATESPRITES()
; CREATE SCORING DIGITS BOTH PLAYER'S HEAD AND TRAIL SQUARES AND THE IN GAME MESSAGES.
   ClearScreen($00FFFF) : StartDrawing(ScreenOutput()) : DrawingMode(#PB_2DDrawing_Transparent) 
   DrawingFont(FontID(4)) : DrawText(0,0,"0123456789",$0000FF) : DrawText(0,70,"0123456789",$FF0000)
   DrawingFont(FontID(2)) : DrawText(116,430,"PRESS SPACE BAR TO PLAY AGAIN.",$000000)
   DrawText(116,500,"PRESS ENTER TO CHANGE OPTIONS.",$000000)
   DrawText(116,550,"PRESS SPACE BAR AGAIN TO RESUME.",$000000)
   Box(0,200,20,20,$0000FF) : Box(20,200,20,20,$7F7FFF) : Box(40,200,20,20,$FF0000)
   Box(60,200,20,20,$FF7F7F) : StopDrawing() 
   CompilerIf #PB_Compiler_OS=#PB_OS_Linux  ; COMPENSATE FOR SLIGHT FONT DIFFERENCES
      C1= 12 : C2= 82 : C3= 562 : C4= 584 : C5= 617
   CompilerElse
      C1= 14 : C2= 84 : C3= 560 : C4= 573 : C5= 611
   CompilerEndIf
   For I= 0 To 9 : GrabSprite(I+1,0+I*36,C1,36,47,#PB_Sprite_AlphaBlending)
       GrabSprite(I+11,0+I*36,C2,36,47,#PB_Sprite_AlphaBlending) : Next I
   GrabSprite(21,0,200,20,20) : GrabSprite(22,20,200,20,20) : GrabSprite(23,40,200,20,20) : GrabSprite(24,60,200,20,20)
   GrabSprite(25,117,436,C3,25) : GrabSprite(26,117,506,C4,25) : GrabSprite(27,117,556,C5,25)
   For I= 1 To 27 : TransparentSpriteColor(I,$00FFFF) : Next I
EndProcedure
Procedure DRAWSCREEN(PLYG,Array SNAR1(1),Array SNAR2(1),NPL,ACC,BLNK,NWAL,DIAG,CST,P1C,P2C,P1S,P2S)
; PLAYING, SNAKES, # PLAYERS, SPEEDUP, ERASE, WRAPAROUND, DIAGONALS, CAN START
; P1 CONTROL, P2 CONTROL, P1 SCORE, P2 SCORE
   If PLYG 
      ClearScreen($00FFFF)
; DRAW SNAKES
      If(SNAR1(0) > 1)
         For I= 2 To SNAR1(0) : DisplayTransparentSprite(22,(SNAR1(I)/100)*20,(SNAR1(I)%100)*20) : Next I
      EndIf
      If(SNAR2(0) > 1)
         For I= 2 To SNAR2(0) : DisplayTransparentSprite(24,(SNAR2(I)/100)*20,(SNAR2(I)%100)*20) : Next I
      EndIf
      DisplayTransparentSprite(21,(SNAR1(1)/100)*20,(SNAR1(1)%100)*20)
      DisplayTransparentSprite(23,(SNAR2(1)/100)*20,(SNAR2(1)%100)*20)
; DRAW SCORES
      P1S= P1S % 100 : P2S= P2S % 100
      If P1S > 9 : P1D1= (P1S/10)+ 1 : P1D2= (P1S % 10)+ 1
      Else : P1D1= (P1S % 10)+ 1 : P1D2= 0
      EndIf
      If P2S > 9 : P2D1= (P2S/10)+ 11 : P2D2= (P2S % 10)+ 11
      Else : P2D1= (P2S % 10)+ 11 : P2D2= 0
      EndIf
      DisplayTransparentSprite(P1D1,13,10,128) : If P1D2 : DisplayTransparentSprite(P1D2,53,10,128) : EndIf
      I= 0 : If P2D2 = 0 : I= 40 : EndIf
      DisplayTransparentSprite(P2D1,710+I,10,128) : If P2D2 : DisplayTransparentSprite(P2D2,750,10,128) : EndIf
      If PLYG > 1
         CompilerIf #PB_Compiler_OS=#PB_OS_Linux ; COMPENSATE FOR SLIGHT FONT DIFFERENCES
            C1= 119 : C2= 108 : C3= 92
         CompilerElse
            C1= 120 : C2= 114 : C3= 95
         CompilerEndIf
         If PLYG= 3 : DisplayTransparentSprite(25,C1,450) : DisplayTransparentSprite(26,C2,506)  ; AT GAME OVER
         ElseIf PLYG= 2 : DisplayTransparentSprite(27,C3,480) ; PAUSED
         EndIf
      EndIf
      FlipBuffers()
   Else
      StartDrawing(ScreenOutput()) : DrawingFont(FontID(3)) : Box(0,0,800,600,$000000)
      DrawText(260,10,"SURROUND",$FFFFFF) : DrawingFont(FontID(2))
      DrawText(20,100,"F1 -  NUMBER OF PLAYERS:  "+Str(NPL),$FFFFFF) : BUFF$= "NO" : If ACC : BUFF$= "YES" : EndIf  
      DrawText(20,150,"F2 -  SPEEDUP:  "+BUFF$,$FFFFFF) : BUFF$= "NO" : If BLNK : BUFF$= "YES" : EndIf  
      DrawText(20,200,"F3 -  ERASE:  "+BUFF$,$FFFFFF) : BUFF$= "NO" : If NWAL : BUFF$= "YES" : EndIf   
      DrawText(20,250,"F4 -  WRAPAROUND:  "+BUFF$,$FFFFFF) : BUFF$= "NO" : If DIAG : BUFF$= "YES" : EndIf  
      DrawText(20,300,"F5 -  DIAGONAL MOVES:  "+BUFF$,$FFFFFF) : BUFF$= "NO" : If Not CHSE : BUFF$= "YES" : EndIf  
      DrawText(20,350,"F6 -  PLAYER 1 CONTROLS:  "+CONDIS(P1C),$FFFFFF)
      If NPL = 2 : DrawText(20,400,"F7 -  PLAYER 2 CONTROLS:  "+CONDIS(P2C),$FFFFFF) : EndIf
      If CST Or NPL = 1 : DrawText(135,540,"PRESS THE SPACE BAR TO BEGIN",$FFFFFF) : EndIf
      StopDrawing() : FlipBuffers()               
   EndIf
EndProcedure
Procedure GETAIMOVE(CURDI,Array SNAR1(1),Array SNAR2(1),NOWALLS) 
   Dim GRID(1199)
; HERE THE AI CREATES THE MOVEMENTS (NO DIAGONALS)
   NEWDIR= 0
; BUILD OBSTRUCTION GRID
   For I= 1 To SNAR1(0) : GRID((SNAR1(I)%100)*40+(SNAR1(I)/100))= 1 : Next I
   For I= 1 To SNAR2(0) : GRID((SNAR2(I)%100)*40+(SNAR2(I)/100))= 1 : Next I
   X= SNAR2(1)/100 : Y= SNAR2(1)%100 : TX= X : TY= Y : OPT1=0: OPT2=0 : OPT3=0 : FINC= 0
   Select CURDI
      Case 0 ; UP
         Repeat 
            TY= TY-1 : If TY < 0 And NOWALLS : TY= 29 : EndIf
            If TY < 0 Or TY = Y : FINC= 1            
            Else 
               If GRID(TY*40+X) : FINC= 1
               Else : OPT1+ 1 : EndIf
            EndIf
         Until FINC
         FINC= 0
         Repeat 
            TX= TX-1 : If TX < 0 And NOWALLS : TX= 39 : EndIf
            If TX < 0 Or TX = X : FINC= 1            
            Else 
               If GRID(Y*40+TX) : FINC= 1
               Else : OPT2+ 1 : EndIf
            EndIf
         Until FINC
         FINC= 0 : TX= X
         Repeat 
            TX= TX+1 : If TX > 39 And NOWALLS : TX= 0 : EndIf
            If TX > 39 Or TX = X : FINC= 1            
            Else 
               If GRID(Y*40+TX) : FINC= 1
               Else : OPT3+ 1 : EndIf
            EndIf
         Until FINC
         If OPT2 > OPT1 And OPT2 > OPT3 : NEWDIR= 4 
         ElseIf OPT3 > OPT1 And OPT3 > OPT2 : NEWDIR= 2
         ElseIf OPT3 = OPT2 And OPT2 > OPT1 : NEWDIR= 2+Random(1)*2
         EndIf             
      Case 1 ; RIGHT
         Repeat 
            TX= TX+1 : If TX > 39 And NOWALLS : TX= 0 : EndIf
            If TX > 39 Or TX = X : FINC= 1            
            Else 
               If GRID(Y*40+TX) : FINC= 1
               Else : OPT1+ 1 : EndIf
            EndIf
         Until FINC
         FINC= 0
         Repeat 
            TY= TY-1 : If TY < 0 And NOWALLS : TY= 29 : EndIf
            If TY < 0 Or TY = Y : FINC= 1            
            Else 
               If GRID(TY*40+X) : FINC= 1
               Else : OPT2+ 1 : EndIf
            EndIf
         Until FINC
         FINC= 0 : TY= Y
         Repeat 
            TY= TY+1 : If TY > 29 And NOWALLS : TY= 0 : EndIf
            If TY > 29 Or TY = Y : FINC= 1            
            Else 
               If GRID(TY*40+X) : FINC= 1
               Else : OPT3+ 1 : EndIf
            EndIf
         Until FINC
         If OPT2 > OPT1 And OPT2 > OPT3 : NEWDIR= 1 
         ElseIf OPT3 > OPT1 And OPT3 > OPT2 : NEWDIR= 3
         ElseIf OPT3 = OPT2 And OPT2 > OPT1 : NEWDIR= 1+Random(1)*2
         EndIf 
      Case 2 ; DOWN
         Repeat 
            TY= TY+1 : If TY > 29 And NOWALLS : TY= 0 : EndIf
            If TY > 29 Or TY = Y : FINC= 1            
            Else 
               If GRID(TY*40+X) : FINC= 1
               Else : OPT1+ 1 : EndIf
            EndIf
         Until FINC
         FINC= 0
         Repeat 
            TX= TX+1 : If TX > 39 And NOWALLS : TX= 0 : EndIf
            If TX > 39 Or TX = X : FINC= 1            
            Else 
               If GRID(Y*40+TX) : FINC= 1
               Else : OPT2+ 1 : EndIf
            EndIf
         Until FINC
         FINC= 0 : TX= X
         Repeat 
            TX= TX-1 : If TX < 0 And NOWALLS : TX= 39 : EndIf
            If TX < 0 Or TX = X : FINC= 1            
            Else 
               If GRID(Y*40+TX) : FINC= 1
               Else : OPT3+ 1 : EndIf
            EndIf
         Until FINC
         If OPT2 > OPT1 And OPT2 > OPT3 : NEWDIR= 2 
         ElseIf OPT3 > OPT1 And OPT3 > OPT2 : NEWDIR= 4
         ElseIf OPT3 = OPT2 And OPT2 > OPT1 : NEWDIR= 2+Random(1)*2
         EndIf             
      Case 3 ; LEFT
         Repeat 
            TX= TX-1 : If TX < 0 And NOWALLS : TX= 39 : EndIf
            If TX < 0 Or TX = X : FINC= 1            
            Else 
               If GRID(Y*40+TX) : FINC= 1
               Else : OPT1+ 1 : EndIf
            EndIf
         Until FINC
         FINC= 0
         Repeat 
            TY= TY+1 : If TY > 29 And NOWALLS : TY= 0 : EndIf
            If TY > 29 Or TY = Y : FINC= 1            
            Else 
               If GRID(TY*40+X) : FINC= 1
               Else : OPT2+ 1 : EndIf
            EndIf
         Until FINC
         FINC= 0 : TY= Y
         Repeat 
            TY= TY-1 : If TY < 0 And NOWALLS : TY= 29 : EndIf
            If TY < 0 Or TY = Y : FINC= 1            
            Else 
               If GRID(TY*40+X) : FINC= 1
               Else : OPT3+ 1 : EndIf
            EndIf
         Until FINC
         If OPT2 > OPT1 And OPT2 > OPT3 : NEWDIR= 3 
         ElseIf OPT3 > OPT1 And OPT3 > OPT2 : NEWDIR= 1
         ElseIf OPT3 = OPT2 And OPT2 > OPT1 : NEWDIR= 1+Random(1)*2
         EndIf 
   EndSelect
   ProcedureReturn(NEWDIR)
EndProcedure
Procedure GETOFFKEY()
   ONKEY= 1  ; EXECUTION STAYS IN THIS PROCEDURE UNTIL USER RELEASES KEYBOARD KEYS
   Repeat
      Delay(20) : CLEARQUESC() : ExamineKeyboard() 
      If Not KeyboardPushed(#PB_Key_All) : ONKEY= 0 :EndIf         
   Until Not ONKEY
EndProcedure
Procedure UPDATESNAKE(Array SNAR(1),HPX,HPY,ERASED)
; USE COORDINATES HPX, HPY TO UPDATE THE SNAKE ARRAY. CREATE NEW HEAD @ HPX, HPY AND BUMP SNAKE LENGTH
   If Not ERASED   
      For I= SNAR(0)+1 To 2 Step -1 : SNAR(I)= SNAR(I-1) : Next I
      SNAR(0)= SNAR(0)+ 1
   EndIf
   SNAR(1)= HPX*100+HPY
   ProcedureReturn(SNAR())
EndProcedure
Procedure MAIN()
   Dim SNAKE1(600) : Dim SNAKE2(600)  ; MAX AT HALF THE 40X30 BOARD PER SNAKE
; MAIN LOOP INITIALIZATION 
   #FLAGS= #PB_Window_ScreenCentered|#PB_Window_MinimizeGadget
   WINTITLE$= "SURROUND ~ ELECTRONICAL SOFTWARE ~ June 2014"
   FIRSTLOOP= 1  ; SET SO FIRST TIME IN MAIN LOOP WILL EXECUTE INIT SECTION
   BYEBYE= 0     ; PROGRAM WILL EXIT WHEN BYEBYE IS SET
   Repeat ; THE PROGRAM'S MAIN LOOP STARTS HERE
; TO LIMIT DISPLAY TO 50 FPS (1000/20), HOLD AT BOTTOM OF LOOP UNTIL 20 ms AFTER LOOP START
      RELEASE= ElapsedMilliseconds()+ 20
; NEXT SECTION IS EXECUTED ONLY 1ST TIME THROUGH MAIN LOOP TO SETUP I/O DEVICES 
      If FIRSTLOOP    
; PERFORM INITIALIZATION OF DEVICES  
         InitSprite()    
         CompilerIf #PB_Compiler_OS=#PB_OS_Linux
            FULL= 0 : OpenWindow(0,0,0,800,600,WINTITLE$,#FLAGS)
            OpenWindowedScreen(WindowID(0),0,0,800,600,#True,0,0)
         CompilerElse
            FULL= 1 : OpenScreen(800,600,32,"SURROUND") 
         CompilerEndIf
         InitKeyboard() : InitSound() 
         NUMJOY= InitJoystick() : JX= 0 : JY = 0 : JB0= 0 : JB1= 0
         CompilerIf #PB_Compiler_OS=#PB_OS_Linux         
; HIDES MOUSE POINTER  UNDER LINUX WINDOW
            InitMouse() : ExamineMouse() 
         CompilerEndIf   
; END DEVICE INITIALIZATIONS, NEXT LOAD USER AUDIO
         CLICK= 0 : If FileSize("click.wav") > 0  : CLICK= 1 : LoadSound(1,"click.wav") : EndIf
         BOOP= 0 : If FileSize("boop.wav") > 0 : BOOP= 1 : LoadSound(2,"boop.wav") : EndIf
         DIESO= 0 : If FileSize("die.wav") > 0 : DIESO= 1 : LoadSound(3,"die.wav") : EndIf
; CREATE SCORING DIGITS AND PLAYER'S HEAD AND TRAIL SQUARES AND IN GAME MESSAGES
         CREATESPRITES()  : GETOFFKEY()
; SHOW TITLE SCREEN FOR SEVEN SECONDS. EXIT GAME IF USER PRESSES ESC KEY.
         PTRTIME= ElapsedMilliseconds()+ 7000 : SWAPTIME= ElapsedMilliseconds()+ 250 : S1= 22 : S2= 24
         Repeat 
            If CLEARQUESC() : PTRTIME= 0 : BYEBYE= 1 : EndIf   
            ExamineKeyboard() : If KeyboardPushed(#PB_Key_All) : PTRTIME= 0 : GETOFFKEY() : EndIf  
            StartDrawing(ScreenOutput()) : DrawingFont(FontID(3)) : Box(0,0,800,600,$000000) 
            DrawText(260,265,"SURROUND",$FFFFFF) : StopDrawing() 
            For I=0 To 10 : DisplaySprite(S1,180+I*40,200) : DisplaySprite(S2,200+I*40,200)
               DisplaySprite(S1,180+I*40,360) : DisplaySprite(S2,200+I*40,360) : Next I 
            For I=0 To 3 : DisplaySprite(S1,180,240+I*40) : DisplaySprite(S2,600,240+I*40) : Next I
            For I=0 To 3 : DisplaySprite(S2,180,220+I*40) : DisplaySprite(S1,600,220+I*40) : Next I
            FlipBuffers() : Delay(100)              
            If ElapsedMilliseconds() > SWAPTIME : SWAPTIME= ElapsedMilliseconds()+ 250 : S1= 46- S1 : S2= 46-S2 : EndIf
         Until PTRTIME < ElapsedMilliseconds()
; INITIALIZE THE GAME SETUP INTERFACE CONTROL VARIABLES
         PLAYING= 0 : NUMP= 2 : SPEEDUP= 0 : ERASE= 0 : WRAP= 0 : DIAGONALS= 0 
         P1ID= 0 : P2ID= 1 : GOOD= 1 : FIRSTLOOP= 0
      EndIf ; FIRST INITIALIZATION LOOP END
; GATHER THIS LOOP ITERATION'S USER INPUT STATE VARIABLES FROM SYSTEM 
      ExamineKeyboard()
      If NUMJOY : ExamineJoystick(0)
         JX0= JoystickAxisX(0,0,#PB_Absolute) + JoystickAxisX(0,1,#PB_Absolute) + JoystickAxisX(0,2,#PB_Absolute)
         JY0= -JoystickAxisY(0,0,#PB_Absolute) + JoystickAxisY(0,1,#PB_Absolute) + JoystickAxisY(0,2,#PB_Absolute)
         JB0= 0 : For IND= 1 To 16 : JB0= JB0+ JoystickButton(0,IND) : Next IND 
         If NUMJOY > 1 : ExamineJoystick(1)
            JX1= JoystickAxisX(1,0,#PB_Absolute) + JoystickAxisX(1,1,#PB_Absolute) + JoystickAxisX(1,2,#PB_Absolute)
            JY1= -JoystickAxisY(1,0,#PB_Absolute) + JoystickAxisY(1,1,#PB_Absolute) + JoystickAxisY(1,2,#PB_Absolute)
            JB1= 0 : For IND= 1 To 16 : JB1= JB1+ JoystickButton(1,IND) : Next IND 
         EndIf
      EndIf          
      If KeyboardPushed(#PB_Key_Escape) : BYEBYE+ 1 : If CLICK : PlaySound(1) : Delay(100) : EndIf
      EndIf  ; EXIT PROGRAM UNCONDITIONALLY WHEN USER PRESSES ESCAPE   
; PROCESS USER INPUT (OTHER THAN ESCAPE) SECTION           
      If PLAYING = 1 Or PLAYING = 2  ; IF PLAYING GAME OR PAUSED GAME
         If KeyboardPushed(#PB_Key_Space) : If CLICK : PlaySound(1) : EndIf
            PLAYING= 3- PLAYING  : GETOFFKEY() ; TOGGLE PAUSE
         EndIf
         ALREADY= NEWDIR1+ NEWDIR2 : UP= 0 : RIGHT= 0 : DOWN= 0 : LEFT= 0  ; HERE SENSE THE ARROW KEYS WHILE PLAYING
If ((KeyboardPushed(#PB_Key_W) And P1ID=0) Or (KeyboardPushed(#PB_Key_Up) And P1ID=1) Or (JY0=1 And P1ID=2) Or (JY1=1 And P1ID=3)) : UP= 1 : EndIf
If ((KeyboardPushed(#PB_Key_D) And P1ID=0) Or (KeyboardPushed(#PB_Key_Right) And P1ID=1) Or (JX0=1 And P1ID=2) Or (JX1=1 And P1ID=3)) : RIGHT= 1 : EndIf
If ((KeyboardPushed(#PB_Key_S) And P1ID=0) Or (KeyboardPushed(#PB_Key_Down) And P1ID=1) Or (JY0=-1 And P1ID=2) Or (JY1=-1 And P1ID=3)) : DOWN= 1 : EndIf
If ((KeyboardPushed(#PB_Key_A) And P1ID=0) Or (KeyboardPushed(#PB_Key_Left) And P1ID=1) Or (JX0=-1 And P1ID=2) Or (JX1=-1 And P1ID=3)) : LEFT= 1 : EndIf
         If DIAGONALS
            If UP And RIGHT : If CURDIR1<>4 And CURDIR1<>6 : NEWDIR1= 5 : EndIf
            ElseIf RIGHT And DOWN : If CURDIR1<>5 And CURDIR1<>7 : NEWDIR1= 6 : EndIf
            ElseIf DOWN And LEFT : If CURDIR1<>4 And CURDIR1<>6 : NEWDIR1= 7 : EndIf
            ElseIf LEFT And UP : If CURDIR1<>5 And CURDIR1<>7 : NEWDIR1= 8 : EndIf
            ElseIf UP And CURDIR1<> 0 And CURDIR1 <> 2 : NEWDIR1= 1
            ElseIf RIGHT And CURDIR1<> 1 And CURDIR1 <> 3 : NEWDIR1= 2
            ElseIf DOWN And CURDIR1<> 0 And CURDIR1 <> 2 : NEWDIR1= 3
            ElseIf LEFT And CURDIR1<> 1 And CURDIR1 <> 3 : NEWDIR1= 4
            EndIf
         Else
            If UP And (CURDIR1=3 Or CURDIR1=1) : NEWDIR1= 1 
            ElseIf RIGHT And (CURDIR1=0 Or CURDIR1=2) : NEWDIR1= 2 
            ElseIf DOWN And (CURDIR1=3 Or CURDIR1=1) : NEWDIR1= 3 
            ElseIf LEFT And (CURDIR1=0 Or CURDIR1=2) : NEWDIR1= 4 
            EndIf
         EndIf
         If NUMP = 2 : UP= 0 : RIGHT= 0 : DOWN= 0 : LEFT= 0 
If ((KeyboardPushed(#PB_Key_W) And P2ID=0) Or (KeyboardPushed(#PB_Key_Up) And P2ID=1) Or (JY0=1 And P2ID=2) Or (JY1=1 And P2ID=3)) : UP= 1 : EndIf
If ((KeyboardPushed(#PB_Key_D) And P2ID=0) Or (KeyboardPushed(#PB_Key_Right) And P2ID=1) Or (JX0=1 And P2ID=2) Or (JX1=1 And P2ID=3)) : RIGHT= 1 : EndIf
If ((KeyboardPushed(#PB_Key_S) And P2ID=0) Or (KeyboardPushed(#PB_Key_Down) And P2ID=1) Or (JY0=-1 And P2ID=2) Or (JY1=-1 And P2ID=3)) : DOWN= 1 : EndIf
If ((KeyboardPushed(#PB_Key_A) And P2ID=0) Or (KeyboardPushed(#PB_Key_Left) And P2ID=1) Or (JX0=-1 And P2ID=2) Or (JX1=-1 And P2ID=3)) : LEFT= 1 : EndIf 
            If DIAGONALS
               If UP And RIGHT : If CURDIR2<>4 And CURDIR2<>6 : NEWDIR2= 5 : EndIf
               ElseIf RIGHT And DOWN : If CURDIR2<>5 And CURDIR2<>7 : NEWDIR2= 6 : EndIf
               ElseIf DOWN And LEFT : If CURDIR2<>4 And CURDIR2<>6 : NEWDIR2= 7 : EndIf
               ElseIf LEFT And UP : If CURDIR2<>5 And CURDIR2<>7 : NEWDIR2= 8 : EndIf
               ElseIf UP And CURDIR2<> 0 And CURDIR2 <> 2 : NEWDIR2= 1
               ElseIf RIGHT And CURDIR2<> 1 And CURDIR2 <> 3 : NEWDIR2= 2
               ElseIf DOWN And CURDIR2<> 0 And CURDIR2 <> 2 : NEWDIR2= 3
               ElseIf LEFT And CURDIR2<> 1 And CURDIR2 <> 3 : NEWDIR2= 4
               EndIf
            Else
               If UP And (CURDIR2=3 Or CURDIR2=1) : NEWDIR2= 1 
               ElseIf RIGHT And (CURDIR2=0 Or CURDIR2=2) : NEWDIR2= 2 
               ElseIf DOWN And (CURDIR2=3 Or CURDIR2=1) : NEWDIR2= 3 
               ElseIf LEFT And (CURDIR2=0 Or CURDIR2=2) : NEWDIR2= 4
               EndIf
            EndIf
         Else
            NEWDIR2= GETAIMOVE(CURDIR2,SNAKE1(),SNAKE2(),WRAP) ; HERE THE AI CREATES THE MOVEMENTS (NO DIAGONALS)
         EndIf
         If (NEWDIR1 Or NEWDIR2) And Not ALREADY And CLICK : PlaySound(1) : EndIf         
      Else  ; NOT YET PLAYING, INSTEAD PROCESSING FRONTEND KEYBOARD INPUT 
         If PLAYING = 3 
            If KeyboardPushed(#PB_Key_Space) : If CLICK : PlaySound(1) : EndIf
               Goto RESTART
            ElseIf KeyboardPushed(#PB_Key_Return) : PLAYING= 0 : If CLICK : PlaySound(1) : EndIf
               GETOFFKEY()
            EndIf
         Else
            If ((KeyboardPushed(#PB_Key_RightAlt) Or KeyboardPushed(#PB_Key_LeftAlt)) And KeyboardPushed(#PB_Key_Return)) Or KeyboardPushed(#PB_Key_F) Or KeyboardPushed(#PB_Key_S) Or KeyboardPushed(#PB_Key_W)
               If CLICK : PlaySound(1) : EndIf  ; F, S, W, OR Alt+Enter TO TOGGLE FULLSCRFEEN 
               GETOFFKEY()
               CompilerIf #PB_Compiler_OS=#PB_OS_Windows
                  CloseScreen()
                  If Not FULL : CloseWindow(0) : FULL= 1 : OpenScreen(800,600,32,"SURROUND")
                  Else : FULL= 0 : OpenWindow(0,0,0,800,600,WINTITLE$,#FLAGS)
                     OpenWindowedScreen(WindowID(0),0,0,800,600,#True,0,0) : CLEARQUESC()
                  EndIf
                  CREATESPRITES()  ; MUST RECREATE SCORING DIGITS AND PLAYER'S HEAD AND TRAIL SQUARES
               CompilerEndIf
            ElseIf KeyboardPushed(#PB_Key_F1) : If CLICK : PlaySound(1) : EndIf
               NUMP= 3- NUMP : GETOFFKEY() : If NUMP= 1 : DIAGONALS= 0 : EndIf
            ElseIf KeyboardPushed(#PB_Key_F2) : If CLICK : PlaySound(1) : EndIf
               SPEEDUP= 1- SPEEDUP : GETOFFKEY()
            ElseIf KeyboardPushed(#PB_Key_F3) : If CLICK : PlaySound(1) : EndIf
               ERASE= 1- ERASE : GETOFFKEY()
            ElseIf KeyboardPushed(#PB_Key_F4) : If CLICK : PlaySound(1) : EndIf
               WRAP= 1- WRAP : GETOFFKEY()
            ElseIf KeyboardPushed(#PB_Key_F5) And NUMP = 2: If CLICK : PlaySound(1) : EndIf
               DIAGONALS= 1- DIAGONALS : GETOFFKEY()
            ElseIf KeyboardPushed(#PB_Key_F6) : If CLICK : PlaySound(1) : EndIf
               P1ID= P1ID+ 1 : If (P1ID = 2 And NUMJOY = 0) Or (P1ID = 3 And NUMJOY < 2) Or P1ID= 4 : P1ID= 0 : EndIf
               GETOFFKEY() : If P1ID = P2ID : GOOD= 0 
               Else : GOOD= 1 : EndIf
            ElseIf KeyboardPushed(#PB_Key_F7) And NUMP = 2 : If CLICK : PlaySound(1) : EndIf
               P2ID= P2ID+ 1 : If (P2ID = 2 And NUMJOY = 0) Or (P2ID = 3 And NUMJOY < 2) Or P2ID= 4 : P2ID= 0 : EndIf
               GETOFFKEY() : If P1ID = P2ID : GOOD= 0 
               Else : GOOD= 1 : EndIf            
            ElseIf KeyboardPushed(#PB_Key_Space) And ((GOOD And NUMP=2) Or NUMP=1) : If CLICK : PlaySound(1) : EndIf
; CHECK FOR START OF GAME, PLAYING<>0 SIGNALS IN GAME         
RESTART: :     PLAYING= 1 : P1S= 0 : P2S= 0 : GETOFFKEY()
NEXTPOINT: :   P1DEAD= 0 : P2DEAD= 0 : NEWDIR1= 0 : NEWDIR2= 0 
               SNAKE1(0)= 1 ; CREATE INITIAL SNAKES. SNAKE(0)= LENGTH OF SNAKE, SNAKE(>0) = X{0-39}*100+ Y{0-29} 
               CURDIR1= 1 : DX1= 1 : DY1= 0 : HP1X= 10 : HP1Y= 15 : SNAKE1(1)= HP1X*100+ HP1Y
               SNAKE2(0)= 1 : CURDIR2= 3 : DX2= -1 : DY2= 0 : HP2X= 30 : HP2Y= 15 : SNAKE2(1)= HP2X*100+ HP2Y        
; SET INITIAL MOVE SPEED. IF SPEEDUP IS SET, THEN USE VELCHGTIM AS TIMER FOR NEXT APPLICATION OF SPINC
               SPEED= 330 : SPINC= -60 : VELCHGTIM= 20000
; ATLIMIT GETS SET TO 1 WHEN SPEED INCREASE IS AT MAXIMUM, SET NEXT SPEED CHANGE TIME, SET NEXT SNAKE MOVE TIME
               ATLIMIT= 0 : NEXSPC= ElapsedMilliseconds()+ VELCHGTIM : NEXMOV= ElapsedMilliseconds()+ SPEED
            EndIf 
         EndIf
      EndIf      
; FINISHED GATHERING AND PROCESSING USER INPUT, NEXT PROCESS THE CONTEXTUAL AND TIMED EVENTS       
      CLEARQUESC()    ; EMPTY EVENT QUEUE ONE LAST TIME BEFORE GRAPHICS CONSTRUCTION
; CREATE SCREEN BASED ON PARAMETERIZED STATE VARIABLES 
      DRAWSCREEN(PLAYING,SNAKE1(),SNAKE2(),NUMP,SPEEDUP,ERASE,WRAP,DIAGONALS,GOOD,P1ID,P2ID,P1S,P2S) 
      If ElapsedMilliseconds() > NEXMOV And PLAYING = 1 And Not (P1DEAD Or P2DEAD) ; IS TIME TO MOVE SNAKES?
         If NEWDIR1 : CURDIR1= NEWDIR1-1 : NEWDIR1= 0 : EndIf
         Select CURDIR1  ; CALCULATE NEXT SNAKE 1 HEAD POSITION.
            Case 0 : DX= 0 : DY= -1 ; GOING UP
            Case 1 : DX= 1 : DY= 0 ; RIGHT
            Case 2 : DX= 0 : DY= 1 ; DOWN
            Case 3 : DX= -1 : DY= 0 ; LEFT
            Case 4 : DX= 1 : DY= -1 ; NE
            Case 5 : DX= 1 : DY= 1 ; SE
            Case 6 : DX= -1 : DY= 1 ; SW
            Case 7 : DX= -1 : DY= -1 ; NW
         EndSelect
         HP1X= HP1X+ DX : HP1Y= HP1Y+ DY
         If WRAP
            If HP1X<0 : HP1X= 39 
            ElseIf HP1X > 39 : HP1X= 0 : EndIf
            If HP1Y<0 : HP1Y= 29 
            ElseIf HP1Y > 29 : HP1Y= 0 : EndIf
         Else 
            If HP1X<0 Or HP1X=40 Or HP1Y<0 Or HP1Y=30 : P1DEAD= 1 : P2S+ 1 : EndIf
         EndIf
         If NEWDIR2 : CURDIR2= NEWDIR2-1 : NEWDIR2= 0 : EndIf
         Select CURDIR2  ; CALCULATE NEXT SNAKE 2 HEAD POSITION
            Case 0 : DX= 0 : DY= -1 ; GOING UP
            Case 1 : DX= 1 : DY= 0 ; RIGHT
            Case 2 : DX= 0 : DY= 1 ; DOWN
            Case 3 : DX= -1 : DY= 0 ; LEFT
            Case 4 : DX= 1 : DY= -1  ; NE
            Case 5 : DX= 1 : DY= 1  ; SE
            Case 6 : DX= -1 : DY= 1 ; SW
            Case 7 : DX= -1 : DY= -1 ; NW
         EndSelect
         HP2X= HP2X+ DX : HP2Y= HP2Y+ DY
         If WRAP
            If HP2X<0 : HP2X= 39 
            ElseIf HP2X > 39 : HP2X= 0 : EndIf
            If HP2Y<0 : HP2Y= 29 
            ElseIf HP2Y > 29 : HP2Y= 0 : EndIf
         Else 
            If HP2X<0 Or HP2X=40 Or HP2Y<0 Or HP2Y=30 : P2DEAD= 1 : P1S+ 1 : EndIf
         EndIf
         For IND= 1 To SNAKE1(0) ; CHECK FOR ANY SNAKE HITTING ITSELF OR ANOTHER
            If SNAKE1(IND)/100=HP1X And SNAKE1(IND)%100=HP1Y : P1DEAD= 1 : P2S+ 1 : EndIf         
            If SNAKE1(IND)/100=HP2X And SNAKE1(IND)%100=HP2Y : P2DEAD= 1 : P1S+ 1 : EndIf                
         Next IND
         For IND= 1 To SNAKE2(0)  
            If SNAKE2(IND)/100=HP1X And SNAKE2(IND)%100=HP1Y : P1DEAD= 1 : P2S+ 1 : EndIf         
            If SNAKE2(IND)/100=HP2X And SNAKE2(IND)%100=HP2Y : P2DEAD= 1 : P1S+ 1 : EndIf            
         Next IND         
         BLANK= 0
         If ERASE And ((P1ID=0 And KeyboardPushed(#PB_Key_LeftControl)) Or (P1ID=1 And KeyboardPushed(#PB_Key_RightControl)) Or (P1ID=2 And JB0) Or(P1ID=3 And JB1))
            BLANK= 1
         EndIf 
         UPDATESNAKE(SNAKE1(),HP1X,HP1Y,BLANK) : BLANK= 0
         If ERASE And ((P2ID=0 And KeyboardPushed(#PB_Key_LeftControl)) Or (P2ID=1 And KeyboardPushed(#PB_Key_RightControl)) Or (P2ID=2 And JB0) Or(P2ID=3 And JB1))
            BLANK= 1
         EndIf
         UPDATESNAKE(SNAKE2(),HP2X,HP2Y,BLANK)  
         If P1DEAD Or P2DEAD
            CLEARQUESC()        
            DRAWSCREEN(PLAYING,SNAKE1(),SNAKE2(),NUMP,SPEEDUP,ERASE,WRAP,DIAGONALS,GOOD,P1ID,P2ID,P1S,P2S) 
            If DIESO : PlaySound(3) : EndIf
            Delay(1000) : CLEARQUESC()
            If ((P1S > 9) Or (P2S > 9)) And (P1S <> P2S)
               PLAYING= 3 : GETOFFKEY() 
            Else
               Goto NEXTPOINT
            EndIf
         EndIf 
         If BOOP : PlaySound(2) : EndIf
         NEXMOV= ElapsedMilliseconds()+ SPEED
      EndIf
      If SPEEDUP And PLAYING = 1 And Not (P1DEAD Or P2DEAD) And Not ATLIMIT
         If ElapsedMilliseconds() > NEXSPC  ; CHECK IF TIME TO UPDATE SNAKE SPEED 
            NEXSPC= ElapsedMilliseconds()+ VELCHGTIM
            SPEED= SPEED+ SPINC
            If SPEED = 30 : ATLIMIT= 1 : EndIf
         EndIf
      EndIf     
      If ElapsedMilliseconds() < RELEASE ; LIMITS FPS TO 50 MAX 
         Repeat : Delay(2) : Until ElapsedMilliseconds() > RELEASE
      EndIf
   Until BYEBYE  
EndProcedure ;(MAIN)
; ***********************************
; **** END OF PROCEDURES SECTION ****
; ***********************************
; PROGRAM'S GLOBAL ENVIRONMENT RESOURCE SETUP IS FINISHED, CONTINUE EXECUTION.
MAIN()
End

On my daughter's computer running the 1.00 version, the word SURROUND on title screen has flicker, and the options selection screen has leftover graphics when changing the options.
(Displaying a picture here would be most excellent, but this forum does not support it.

)
It is clear from this code snippet which is unconditionally called during each screen update in the front end options selection,
that the leftover bits (on the display ARROW KEYS becomes WASDOW KEYS) should not happen unless the ClearScreen() command is not working.

Code: Select all

      ClearScreen($000000) : StartDrawing(ScreenOutput()) : DrawingFont(FontID(3))
      DrawText(260,10,"SURROUND",$FFFFFF) : DrawingFont(FontID(2))
      DrawText(20,100,"F1 -  NUMBER OF PLAYERS:  "+Str(NPL),$FFFFFF) : BUFF$= "NO" : If ACC : BUFF$= "YES" : EndIf  
      DrawText(20,150,"F2 -  SPEEDUP:  "+BUFF$,$FFFFFF) : BUFF$= "NO" : If BLNK : BUFF$= "YES" : EndIf  
      DrawText(20,200,"F3 -  ERASE:  "+BUFF$,$FFFFFF) : BUFF$= "NO" : If NWAL : BUFF$= "YES" : EndIf   
      DrawText(20,250,"F4 -  WRAPAROUND:  "+BUFF$,$FFFFFF) : BUFF$= "NO" : If DIAG : BUFF$= "YES" : EndIf  
      DrawText(20,300,"F5 -  DIAGONAL MOVES:  "+BUFF$,$FFFFFF) : BUFF$= "NO" : If Not CHSE : BUFF$= "YES" : EndIf  
      DrawText(20,350,"F6 -  PLAYER 1 CONTROLS:  "+CONDIS(P1C),$FFFFFF)
      If NPL = 2 : DrawText(20,400,"F7 -  PLAYER 2 CONTROLS:  "+CONDIS(P2C),$FFFFFF) : EndIf
      If CST Or NPL = 1 : DrawText(135,540,"PRESS THE SPACE BAR TO BEGIN",$FFFFFF) : EndIf
      StopDrawing() : FlipBuffers()

The v1.00 flicker on her title screen looks like it could be intentional.
The "PRESS THE SPACE BAR TO BEGIN" message is supposed to conditionally display, but it always shows on her system, again it seems that the ClearScreen() code appears not to work.
Does anyone else experience those graphics anomalies on their system within the front end user interface in v1.00?
Her system has a ATI Radeon HD 5450 PCI card using driver version 9.0.100.2000.
This 1.01 version eliminates the flicker and leftover bits problem by replacing both ClearScreen($000000) calls with Box(0,0,800,600,$000000).
It certainly looks like her graphics drivers are ignoring the ClearScreen($000000) calls.
The ClearScreen($00FFFF) call works fine.

edit: I discovered a slight problem that made a big difference, hence the v1.01a.
In the original both players snake heads could simultaneously occupy the same spot.
I just had to adjust player 1's starting position by 1 square to achieve the same effect.
Previously at the start HP1X= 9, now HP1X= 10.
I expect these sort of things to slip though when I work too fast and don't test well enough.

Tenaja · Post by **Tenaja** » Wed Jun 25, 2014 3:06 pm

I do not see either of those anomalies. No flicker, and no artifacts on either the title screen or the menu.

djes · Post by **djes** » Wed Jun 25, 2014 4:31 pm

Dam'it ! I've done a similar game years (20?) ago ! I had totally forgotten ! Thank you !!!

Mine was a lot faster, and was coded for an EGA (?) display adapter, giving it more "fluidity". It's a simple and fun concept, I'm happy to know the original name !

I have no display problem (Windows 7 and ATI) ; but I can't "jump" with ALT KEYS.

Thank you for this nice work

heartbone · Post by **heartbone** » Wed Jun 25, 2014 5:26 pm

Tenaja wrote:I do not see either of those anomalies. No flicker, and no artifacts on either the title screen or the menu.

That's the way that it's supposed to be, but on my daughter's system I needed to change the code.
I now think that I will avoid ClearScreen(BLACK) to eliminate potential glitch problems.

djes wrote:Dam'it ! I've done a similar game years (20?) ago ! I had totally forgotten ! Thank you !!!

Mine was a lot faster, and was coded for an EGA (?) display adapter, giving it more "fluidity". It's a simple and fun concept, I'm happy to know the original name !

I have no display problem (Windows 7 and ATI) ; but I can't "jump" with ALT KEYS.

Thank you for this nice work

And thank you for appreciating it djes.

Faster? You can adjust the speedup here.

Code: Select all

SPEED= 330 : SPINC= -60 : VELCHGTIM= 20000

This indicates that it starts at 330ms per movement, The speed will stay the same for 20 seconds, and then decrease by 60 ms to 270 for 20 seconds, then 210, 150, 90, and finally after 1 minute and 40 seconds of play time, 30ms. If that is too fast for you, see the setting and use of the ATLIMIT variable.
The default is SPEEDUP not set, so the speed would stay at 330 ms using the default settings.
It's easy to change SPEED if you desire more speed, but I've kept it close to the original game.

Fluidity? What did you do, show intermediate positions when moving the snake between stops?

I have no idea about any "jump", or what that has to do with the display glitches.

djes · Post by **djes** » Wed Jun 25, 2014 7:15 pm

No, no, don't change anything ! It's just that because the resolution was far higher, the pixel movement seems smoother and faster, really hard to follow, in fact

It was just the same concept, but different gameplay and feeling. Your game is perfect like it is !

IdeasVacuum · Post by **IdeasVacuum** » Sat Jun 28, 2014 1:18 pm

I'm terrible at these games but I do appreciate their beauty. It would be nice if your examples were pinned in their own forum group - a group for people trying out the PB demo-version. How about it Fred?

(Displaying a picture here would be most excellent, but this forum does not support it. )

It does:

Edit: Ah, you already have posted images? Do you mean you want to display a short movie? You can 'do' that with a gif file, or just provide a link to a web-based movie (YouTube if you don't have your own website).

PureBasic Forums - English

SURROUND

SURROUND

Re: SURROUND

Re: SURROUND

Re: SURROUND

Re: SURROUND

Re: SURROUND

Re: SURROUND

Re: SURROUND

Re: SURROUND