program xenopeltis; uses crt; const { System settings } DELAY_DURATION = 150{miliseconds}; MESSAGE_PAUSE = 2000{miliseconds}; SCREEN_WIDTH = 80{characters}; SCREEN_HEIGHT = 25{characters}; { Visualization settings } FOOD_SYMBOL = '@'; FOOD_COLOR = LIGHTRED; COIL_SYMBOL = '#'; COIL_COLOR = BROWN; HEAD_SYMBOL = 'X'; HEAD_COLOR = YELLOW; { Game settings } START_LENGHT = 13; FOOD_INFLUENCE = 3; type Snake = ^Coil; Coil = record x, y: integer; next: Snake end; Food = record x, y: integer end; Velocity = record dx, dy: integer end; Command = (none, up, right, down, left, quit); var head: Snake; speed: Velocity; dish: Food; __extension__: integer; __last_x__, __last_y__: integer; procedure createSnake(var head: Snake; lenght: integer); begin if lenght = 0 then begin head := nil; __last_x__ := 0; __last_y__ := 0; __extension__ := 0 end else begin new(head); head^.x := lenght; head^.y := 0; createSnake(head^.next, lenght - 1) end end; procedure deleteSnake(var head: Snake); begin if head^.next <> nil then deleteSnake(head^.next); dispose(head); head := nil end; procedure setVelocity(var speed: Velocity; dx, dy: integer); begin speed.dx := dx; speed.dy := dy end; procedure placeFood(var dish: Food; head: Snake); var ok: boolean; iteration_pice: Snake; begin ok := false; while not ok do begin dish.x := random(SCREEN_WIDTH); dish.y := random(SCREEN_HEIGHT); ok := true; iteration_pice := head; while iteration_pice <> nil do begin if (iteration_pice^.x = dish.x) and (iteration_pice^.y = dish.y) then begin ok := false; break end; iteration_pice := iteration_pice^.next end end end; function inputCommand: Command; const UP_SYMBOL = #72; IS_UP_SYMBOL_STARTS_WITH_NULL = true; RIGHT_SYMBOL = #77; IS_RIGHT_SYMBOL_STARTS_WITH_NULL = true; DOWN_SYMBOL = #80; IS_DOWN_SYMBOL_STARTS_WITH_NULL = true; LEFT_SYMBOL = #75; IS_LEFT_SYMBOL_STARTS_WITH_NULL = true; QUIT_SYMBOL = #27; IS_QUIT_SYMBOL_STARTS_WITH_NULL = false; var c: char; begin if keyPressed then begin c := readKey; case c of #0: begin c := readKey; case c of UP_SYMBOL: if IS_UP_SYMBOL_STARTS_WITH_NULL then inputCommand := up; RIGHT_SYMBOL: if IS_RIGHT_SYMBOL_STARTS_WITH_NULL then inputCommand := right; DOWN_SYMBOL: if IS_DOWN_SYMBOL_STARTS_WITH_NULL then inputCommand := down; LEFT_SYMBOL: if IS_LEFT_SYMBOL_STARTS_WITH_NULL then inputCommand := left; QUIT_SYMBOL: if IS_QUIT_SYMBOL_STARTS_WITH_NULL then inputCommand := quit end end; UP_SYMBOL: if not IS_UP_SYMBOL_STARTS_WITH_NULL then inputCommand := up; RIGHT_SYMBOL: if not IS_RIGHT_SYMBOL_STARTS_WITH_NULL then inputCommand := right; DOWN_SYMBOL: if not IS_DOWN_SYMBOL_STARTS_WITH_NULL then inputCommand := down; LEFT_SYMBOL: if not IS_LEFT_SYMBOL_STARTS_WITH_NULL then inputCommand := left; QUIT_SYMBOL: if not IS_QUIT_SYMBOL_STARTS_WITH_NULL then inputCommand := quit end end end; procedure insertCoil(x, y: integer; var head: Snake); var new_head: Snake; begin new(new_head); new_head^.x := x; new_head^.y := y; new_head^.next := head; head := new_head end; procedure deleteLastCoil(var head: Snake); begin if head^.next = nil then begin __last_x__ := head^.x; __last_y__ := head^.y; dispose(head); head := nil end else deleteLastCoil(head^.next) end; procedure moveSnake(var head: Snake; speed: Velocity); begin insertCoil(head^.x + speed.dx, head^.y + speed.dy, head); if __extension__ > 0 then __extension__ := __extension__ - 1 else deleteLastCoil(head) end; function isColliding(head: Snake): boolean; var iteration_pice: Snake; begin isColliding := false; if (head^.x < 0) or (head^.y < 0) or (head^.x >= SCREEN_WIDTH) or (head^.y >= SCREEN_HEIGHT) then begin isColliding := true; exit end; iteration_pice := head^.next; while iteration_pice <> nil do begin if (head^.x = iteration_pice^.x) and (head^.y = iteration_pice^.y) then begin isColliding := true; exit end; iteration_pice := iteration_pice^.next end end; function isEating(head: Snake; dish: Food): boolean; begin if (head^.x = dish.x) and (head^.y = dish.y) then isEating := true else isEating := false end; procedure drawSnake(head: Snake); begin goToXY(head^.x + 1, head^.y + 1); textColor(HEAD_COLOR); write(HEAD_SYMBOL); head := head^.next; while head <> nil do begin goToXY(head^.x + 1, head^.y + 1); textColor(COIL_COLOR); write(COIL_SYMBOL); head := head^.next end; goToXY(__last_x__ + 1, __last_y__ + 1); write(' ') end; procedure drawFood(dish: Food); begin goToXY(dish.x + 1, dish.y + 1); textColor(FOOD_COLOR); write(FOOD_SYMBOL) end; begin { Initialize game } cursorOff; clrScr; goToXY(10, trunc(SCREEN_HEIGHT / 2)); textColor(LIGHTBLUE); write('WELCOME IN XENOPELTIS, A GAME BASED ON SNAKE!'); goToXY(15, trunc(SCREEN_HEIGHT / 2) + 2); write('by AKVeresov'); goToXY(10, trunc(SCREEN_HEIGHT / 2) + 4); write('Control snake by pushing arrow keys.'); goToXY(10, trunc(SCREEN_HEIGHT / 2) + 5); write('Exit with pushing Esc key.'); delay(MESSAGE_PAUSE); clrScr; randomize; createSnake(head, START_LENGHT); setVelocity(speed, 0, 1); placeFood(dish, head); { Main loop } repeat { Process the command } case inputCommand of up: setVelocity(speed, 0, -1); right: setVelocity(speed, 1, 0); down: setVelocity(speed, 0, 1); left: setVelocity(speed, -1, 0); quit: break end; moveSnake(head, speed); { Check state and execute the rules } if isColliding(head) then begin clrScr; goToXY(10, trunc(SCREEN_HEIGHT / 2)); textColor(LIGHTRED); write('GAME OVER'); delay(MESSAGE_PAUSE); break end; if isEating(head, dish) then begin __extension__ := __extension__ + FOOD_INFLUENCE; placeFood(dish, head) end; { Drawing } drawFood(dish); drawSnake(head); { Correct update speed } delay(DELAY_DURATION); until false; { End game } clrScr; deleteSnake(head); goToXY(10, trunc(SCREEN_HEIGHT / 2)); textColor(LIGHTBLUE); write('GOODBUE!'); delay(MESSAGE_PAUSE); clrScr; cursorOn end.