$ ! Battleship
$ !
$ ! (C) 2005-2006 Dr. ERDI Gergo <cactus@cactus.rulez.org>
$ !
$ ! See http://cactus.rulez.org/elte/2005-1-vms/#5 for a description of what it does
$ !
$ ! Licensed under the GNU General Public License, version 2
$
$ ! Parameterek: A tabla szelte es hossza, valamint a max. korok
$ ! 
$ ! TODO:
$ !     * Detect when ships sink
$ !     * Make number and size of ships customizable
$ !     * Detect if the playboard is too small to place the ships on it
$ !     * Calculate number of rounds allowed based on the size of the board
$ !       and the number of ships
$ !     * Speed shit the hell up
$ 
$ IF (f$type(P1) .NES. "INTEGER") .OR. (f$int(P1) .GT. 10) THEN P1 = 10
$ IF (f$type(P2) .NES. "INTEGER") .OR. (f$int(P2) .GT. 10) THEN P2 = 10
$ IF (f$type(P3) .NES. "INTEGER") THEN P3 = 40
$
$ ! t[0-9[0-9]:	A tabla. Egy mezo tartalma:
$ !             0		ures
$ !             10		ismert ures
$ !              2, 3, 4	hajo, megtalalas nelkul
$ !             12,13,14	hajo, megtalalva
$ !		22,23,24	hajo, elsullyesztve
$ !				(nincs implementalva)
$
$ t_width == f$int(P1)
$ t_height == f$int(P2)
$ max_turn == f$int(P3)
$
$ turn == 1
$
$ SAY "Placing ships, this could take a while."
$
$ PLACE_RESTART = "IF (TORPEDO$noplace) THEN GOTO PLACE_START"
$
$ PLACE_START:
$ CALL init_table
$
$ CALL place_ship_random 4
$ PLACE_RESTART
$ CALL place_ship_random 3
$ PLACE_RESTART
$ CALL place_ship_random 3
$ PLACE_RESTART
$ CALL place_ship_random 2
$ PLACE_RESTART
$
$
$ CALL play
$ EXIT
$
$ init_table: SUBROUTINE
$
$   x = 0
$   X_LOOP_B:
$   IF (x .EQ. t_width) THEN GOTO X_LOOP_E
$     y = 0
$     Y_LOOP_B:
$     IF (y .EQ. t_height) THEN GOTO Y_LOOP_E
$       t'x''y' == 0
$     y = y + 1
$     GOTO Y_LOOP_B
$     Y_LOOP_E:
$   x = x + 1
$   GOTO X_LOOP_B
$   X_LOOP_E:
$
$ ENDSUBROUTINE
$
$ ! won -> TORPEDO$won
$ won: SUBROUTINE
$ r = "TORPEDO$won"
$ 
$   'r' == 0
$   x = 0
$   X_LOOP_B:
$   IF (x .EQ. t_width) THEN GOTO X_LOOP_E
$     y = 0
$     Y_LOOP_B:
$     IF (y .EQ. t_height) THEN GOTO Y_LOOP_E
$       IF (t'x''y' .GT. 0) .AND. (t'x''y' .LT. 10) THEN EXIT 
$     y = y + 1
$     GOTO Y_LOOP_B
$     Y_LOOP_E:
$   x = x + 1
$   GOTO X_LOOP_B
$   X_LOOP_E:
$  
$   'r' == 1
$ ENDSUBROUTINE
$
$
$ ! random max -> TORPEDO$random
$ random: SUBROUTINE
$ max = f$int(P1)
$ r = "TORPEDO$random"
$
$   x = f$cvtime(,,"hundredth")
$   'r' == (x - (x / max) * max)
$
$ ENDSUBROUTINE
$
$ ! get_display_char x y -> TORPEDO$display_char
$ get_display_char: SUBROUTINE
$ x = f$int(P1)
$ y = f$int(P2)
$ r = "TORPEDO$display_char"
$
$   t = t'x''y'
$   IF (t .LT. 10) THEN 'r' == " "
$   IF (t .EQ. 10) THEN 'r' == "."
$   !IF (t .GT. 10) .AND. (t .LT. 20) THEN 'r' == "#"
$   !IF (t .GT. 20) THEN 'r' == "*"
$   IF (t .GT. 10) THEN 'r' == f$str(f$int(t) - 10)
$
$ ENDSUBROUTINE
$
$ play: SUBROUTINE
$   START:
$
$   CALL won
$   IF (TORPEDO$won)
$   THEN
$     TYPE /PAGE NLA0:
$     SAY ""
$     SAY ""
$     CALL display_table
$     SAY ""
$     SAY ""
$     SAY "VICTORY! You've successfully sank all ships in ", turn, " turns."
$     EXIT
$   ENDIF
$   IF (turn .gt. max_turn)
$   THEN
$     TYPE /PAGE NLA0:
$     SAY ""
$     SAY ""
$     CALL display_table
$     SAY ""
$     SAY ""
$     SAY "DEFEAT! You failed to sink all ships in ", max_turn, " turns."
$     EXIT
$   ENDIF
$
$   CALL turn
$   GOTO start
$ ENDSUBROUTINE
$
$ turn: SUBROUTINE
$   CALL display
$   INPUT:
$     INQUIRE line "Enter row and column"
$     line = f$edit(line, "TRIM, COMPRESS")
$     row = f$elem(0, " ", line)
$     col = f$elem(1, " ", line)
$   IF (f$type(row) .NES. "INTEGER") .OR. (f$type(col) .NES. "INTEGER") THEN GOTO INPUT
$
$   CALL shoot 'col' 'row'
$   turn == turn + 1
$ ENDSUBROUTINE
$ 
$ display: SUBROUTINE
$
$   TYPE /PAGE NLA0:
$   SAY "Turn ", turn
$   SAY ""
$   CALL display_table
$   SAY ""
$   SAY ""
$ ENDSUBROUTINE
$
$ display_table: SUBROUTINE
$
$   x = 0
$   sor = "    "
$   HEADER_LOOP_B:
$   IF (x .EQ. t_height) THEN GOTO HEADER_LOOP_E
$     sor = sor + f$str(x)
$   x = x + 1
$   GOTO HEADER_LOOP_B
$   HEADER_LOOP_E:
$   SAY sor
$   SAY ""
$
$   y = 0
$   Y_LOOP_B:
$   IF (y .EQ. t_height) THEN GOTO Y_LOOP_E
$     sor = "  " + f$str(y) + " "
$     x = 0
$
$     X_LOOP_B:
$     IF (x .EQ. t_width) THEN GOTO X_LOOP_E
$       CALL get_display_char 'x' 'y'
$       sor = sor + TORPEDO$display_char
$     x = x + 1
$     GOTO X_LOOP_B
$     X_LOOP_E:
$
$     SAY sor
$   y = y + 1
$   GOTO Y_LOOP_B
$   Y_LOOP_E:
$ 
$ ENDSUBROUTINE
$
$ ! shoot x y
$ shoot: SUBROUTINE
$ x = f$int(P1)
$ y = f$int(P2)
$
$   IF (t'x''y' .LT. 10) THEN t'x''y' == t'x''y' + 10
$ 
$ ENDSUBROUTINE
$
$ ! check_row x y len -> TORPEDO$check
$ check_row: SUBROUTINE
$ x = f$int(P1)
$ y = f$int(P2)
$ len = f$int(P3)
$ r = "TORPEDO$check"
$ 
$   'r' == 0
$   end = x + len
$   LOOP_B:
$   IF (x .EQ. end) THEN GOTO LOOP_E
$     IF (t'x''y' .NE. 0) THEN EXIT  
$     x = x + 1
$   GOTO LOOP_B
$   LOOP_E:
$   'r' == 1
$ 
$ ENDSUBROUTINE
$
$ ! check_col x y len -> TORPEDO$check
$ check_col: SUBROUTINE
$ x = f$int(P1)
$ y = f$int(P2)
$ len = f$int(P3)
$ r = "TORPEDO$check"
$
$   'r' == 0
$   end = y + len
$   LOOP_B:
$   IF (y .EQ. end) THEN GOTO LOOP_E
$     IF (t'x''y' .NE. 0) THEN EXIT  
$     y = y + 1
$   GOTO LOOP_B
$   LOOP_E:
$   'r' == 1
$ 
$ ENDSUBROUTINE
$
$ ! palce_ship size x y orient
$ place_ship: SUBROUTINE
$ size = f$int(P1)
$ x = f$int(P2)
$ y = f$int(P3)
$ orient = 'P4'
$
$   i = 0 
$   LOOP_B:
$   IF (i .EQ. size) THEN GOTO LOOP_E
$     t'x''y' == size
$     IF orient
$     THEN
$       x = x + 1 
$     ELSE
$       y = y + 1
$     ENDIF
$   i = i + 1
$   GOTO LOOP_B
$   LOOP_E:
$
$ ENDSUBROUTINE
$
$ ! can_place_ship size x y orient -> TORPEDO$can_place_ship
$ can_place_ship: SUBROUTINE
$ size = f$int(P1)
$ x = f$int(P2)
$ y = f$int(P3)
$ orient = 'P4'
$ r = "TORPEDO$can_place_ship"
$
$   'r' == 0
$   RET = "IF (TORPEDO$check .EQ. 0) THEN EXIT"
$   ! Place horizontal ships
$   IF orient
$   THEN
$     IF (x .GT. 0)
$     THEN
$       x = x - 1
$       size = size + 1
$     ENDIF
$     IF (x + size .LT. t_width) THEN size = size + 1
$     CALL check_row 'x' 'y' 'size'
$     RET
$     IF (y .GT. 0)
$     THEN
$       ym = y - 1
$       CALL check_row 'x' 'ym' 'size'
$       RET
$     ENDIF
$     IF (y .LT. t_height - 1)
$     THEN
$       yp = y + 1
$       CALL check_row 'x' 'yp' 'size'
$       RET
$     ENDIF
$   ! Place vertical ships
$   ELSE
$     IF (y .GT. 0)
$     THEN
$       y = y - 1
$       size = size + 1
$     ENDIF
$     IF (y + size .LT. t_height) THEN size = size + 1
$     CALL check_col 'x' 'y' 'size'
$     RET
$     IF (x .GT. 0)
$     THEN
$       xm = x - 1
$       CALL check_col 'xm' 'y' 'size'
$       RET
$     ENDIF
$     IF (x .LT. t_width - 1)
$     THEN
$       xp = x + 1
$       CALL check_col 'xp' 'y' 'size'
$       RET
$     ENDIF
$   ENDIF
$   'r' == 1
$
$ ENDSUBROUTINE 
$
$
$
$ ! place_ship_random size
$ place_ship_random: SUBROUTINE
$ size = f$int(P1)
$
$   ! Create a vector of allowed positions
$   place_h_n = 0
$   place_v_n = 0
$   
$   x = 0
$
$   X_LOOP_B:
$   IF (x .EQ. t_width) THEN GOTO X_LOOP_E
$     y = 0
$     Y_LOOP_B:
$     IF (y .EQ. t_height) THEN GOTO Y_LOOP_E
$
$       IF (x + size .LT. t_width)
$       THEN
$         CALL can_place_ship 'size' 'x' 'y' 1 
$         IF (TORPEDO$can_place_ship .NE. 0)
$         THEN
$           place_h'place_h_n' = (t_height * x) + y
$           place_h_n = place_h_n + 1
$         ENDIF
$       ENDIF
$       IF (y + size .LT. t_height)
$       THEN
$         CALL can_place_ship 'size' 'x' 'y' 0 
$         IF (TORPEDO$can_place_ship .NE. 0)
$         THEN
$           place_v'place_v_n' = (t_height * x) + y
$    	    place_v_n = place_v_n + 1
$         ENDIF
$       ENDIF
$
$     y = y + 1
$     GOTO Y_LOOP_B
$     Y_LOOP_E:
$   x = x + 1
$   GOTO X_LOOP_B
$   X_LOOP_E:
$
$   TORPEDO$noplace == 0
$
$   ! Place a ship on a random, allowed position
$   CALL random 2
$   orient = 'TORPEDO$random'
$   IF (orient .EQ. 1) .AND. (place_h_n .EQ. 0) THEN orient = 0
$   IF (orient .EQ. 0) .AND. (place_v_n .EQ. 0) THEN orient = 1
$
$   IF (orient .EQ. 1)
$   THEN
$     IF (place_h_n .EQ. 0) 
$     THEN 
$       TORPEDO$noplace == 1
$       EXIT
$     ENDIF
$     CALL random 'place_h_n'
$     p = place_h'TORPEDO$random'
$   ELSE
$     IF (place_v_n .EQ. 0) 
$     THEN 
$       TORPEDO$noplace == 1
$       EXIT
$     ENDIF
$     CALL random 'place_v_n'
$     p = place_v'TORPEDO$random'
$   ENDIF
$
$   x = p / t_height
$   y = p - t_height * x
$
$   CALL place_ship 'size' 'x' 'y' 'orient'
$
$ ENDSUBROUTINE