Emulation/libretro-samples
1
0
Fork 0
mirror of https://github.com/libretro/libretro-samples.git synced 2025-04-02 10:31:48 -04:00
Code Issues Projects Releases Packages Wiki Activity
libretro-samples/lang/pascal/pong.pas
twinaphex ef7753ee44 Add samples/lang
2016-10-01 03:07:58 +02:00

574 lines
20 KiB
ObjectPascal
Raw Permalink Blame History

(*
Copyright (c) 2015-2016, Higor Eurípedes
All rights reserved.
Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice, this
list of conditions and the following disclaimer in the documentation and/or
other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
library paspong;
{$Mode OBJFPC}
uses
Math,
SysUtils;
const
Font: array [0..7, 0..511] of $0..$1 = (
(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,1,0,1,1,0,0,0,1,1,0,1,1,0,0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,1,0,0,0,1,1,1,1,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,1,1,0,0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,0,0,1,1,0,0,0,1,1,1,1,1,1,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,0,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,0,0,0,1,1,1,1,0,0,0,1,1,0,0,1,1,0,0,1,1,1,1,1,1,0,0,0,0,1,1,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,1,0,0,1,1,0,0,1,1,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,1,1,1,1,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,1,0,1,1,0,0,1,1,1,1,1,1,1,0,0,0,1,1,1,1,0,0,0,1,1,0,0,1,0,0,0,1,1,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,1,1,1,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,1,1,1,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,1,1,0,0,1,1,0,0,1,0,0,0,0,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,1,1,0,0,0,1,1,0,0,0,0,0,0,1,1,1,0,1,1,0,0,1,1,1,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,1,0,0,0,1,1,1,1,0,0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,1,1,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,1,0,0,1,0,0,0,1,1,0,1,1,0,0,0,1,0,1,1,0,0,0,0,0,0,0,1,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0,1,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,1,1,0,1,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,1,1,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,0,0,0,1,1,1,1,1,0,0,0,0,0,0,1,1,0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,1,1,1,1,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,1,0,0,0,1,0,1,1,0,1,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,1,1,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,1,1,0,0,0,0,0,0,1,1,1,1,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,1,1,0,0,1,1,1,1,0,0,0,0,1,1,0,0,0,0,0,0,1,1,1,1,1,1,0,0,1,1,1,1,1,1,0,0,1,1,0,0,1,1,0,0,1,1,1,1,1,0,0,0,1,1,0,0,1,1,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,0,1,1,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,1,0,1,0,0,0,0,1,1,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,1,1,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,1,0,0,0,0,1,1,1,1,0,0,0,0,0,1,0,0,0,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,1,0,1,0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,1,1,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,1,1,0,0,1,1,0,1,1,0,0,0,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,1,1,0,0,0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,1,1,0,0,0,0,1,0,1,1,1,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,1,1,1,0,0,1,1,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,1,1,0,0,0,1,1,0,0,0,0,0,0,1,1,0,1,0,1,0,0,1,1,0,1,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,1,1,1,1,0,0,0,1,1,1,1,0,0,0,0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,1,1,0,1,0,0,0,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,1,1,0,0,0,0,0,1,1,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,1,1,0,0,0,0,0,1,1,0,0,1,1,0,0,1,1,1,1,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,1,1,0,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,1,1,1,1,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,1,1,0,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,1,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,0,1,1,0,0,0,0,1,1,0,0,1,1,0,0,0,1,1,1,1,0,0,0,1,1,1,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,1,0,0,0,0,1,1,1,1,0,0,0,1,0,0,0,1,1,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,0,0,0,1,1,1,1,0,0,0,0,0,0,1,1,0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,1,1,0,0,0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,1,0,0,0,0,0,1,1,1,1,0,0,0,1,1,0,0,1,1,0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,0,0,0,1,1,1,1,1,1,0,0,1,1,0,0,0,0,0,0,0,1,1,1,1,1,0,0,1,1,0,0,1,1,0,0,1,1,1,1,1,1,0,0,0,1,1,1,1,0,0,0,1,1,0,0,1,1,0,0,1,1,1,1,1,1,0,0,1,1,0,0,0,1,0,0,1,1,0,0,1,1,0,0,0,1,1,1,1,0,0,0,1,1,0,0,0,0,0,0,0,1,1,1,1,1,0,0,1,1,0,0,1,1,0,0,0,1,1,1,1,0,0,0,0,0,1,1,0,0,0,0,0,1,1,1,1,1,0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,1,0,0,1,1,0,0,1,1,0,0,0,1,1,1,1,0,0,0,1,1,1,1,1,1,0,0,0,1,1,1,1,0,0,0,0,0,0,0,1,1,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1)
);
type
TRetroEnvironment = function(cmd: UInt32; Data: Pointer): boolean; cdecl;
TRetroVideoRefresh = procedure(Data: Pointer; Width: UInt32;
Height: UInt32; pitch: SizeUInt); cdecl;
TRetroAudioSample = procedure(left: Int16; right: Int16); cdecl;
TRetroAudioSampleBatch = function(Data: PInt16;
frames: SizeUInt): Int16; cdecl;
TRetroInputPoll = procedure; cdecl;
TRetroInputState = function(port: UInt32; device: UInt32;
index: UInt32; id: UInt32): Int16; cdecl;
PRetroSystemInfo = ^TRetroSystemInfo;
TRetroSystemInfo = record
LibraryName: PAnsiChar;
LibraryVersion: PAnsiChar;
ValidExtensions: PAnsiChar;
NeedFullpath: boolean;
BlockExtract: boolean;
end;
TRetroGameGeometry = record
BaseWidth: UInt32;
BaseHeight: UInt32;
MaxWidth: UInt32;
MaxHeight: UInt32;
AspectRatio: single;
end;
TRetroSystemTiming = record
FPS: double;
SampleRate: double;
end;
PRetroSystemAvInfo = ^TRetroSystemAvInfo;
TRetroSystemAvInfo = record
Geometry: TRetroGameGeometry;
Timing: TRetroSystemTiming;
end;
PRetroGameInfo = ^TRetroGameInfo;
TRetroGameInfo = record
Path: PAnsiChar;
Data: Pointer;
Size: SizeUInt;
Meta: PAnsiChar;
end;
PTARGB1555 = ^TARGB1555;
TARGB1555 = bitpacked record
a: $0..$01;
b: $0..$1f;
g: $0..$1f;
r: $0..$1f;
end;
PPlayer = ^TPlayer;
TPlayer = object
Id: integer;
Score: 0..99;
X, Y, W, H: integer;
procedure Update();
procedure Draw();
end;
TBall = object
X, Y, W, H: integer;
HSpeed, VSpeed: integer;
procedure Reset();
procedure Update();
procedure Draw();
end;
TGameState = (gsStart, gsPlaying, gsScore);
const
Width = 320;
Height = 180;
Size = 8;
Speed = 2;
// https://en.wikipedia.org/wiki/List_of_video_game_console_palettes#SECAM
Black: TARGB1555 = (a: 1; b: 0 shr 3; g: 1 shr 3; r: 0 shr 3);
Blue: TARGB1555 = (a: 1; b: 255 shr 3; g: 36 shr 3; r: 0 shr 3);
Red: TARGB1555 = (a: 1; b: 122 shr 3; g: 58 shr 3; r: 241 shr 3);
Magenta: TARGB1555 = (a: 1; b: 255 shr 3; g: 75 shr 3; r: 255 shr 3);
Green: TARGB1555 = (a: 1; b: 0 shr 3; g: 255 shr 3; r: 126 shr 3);
Cyan: TARGB1555 = (a: 1; b: 255 shr 3; g: 255 shr 3; r: 121 shr 3);
Yellow: TARGB1555 = (a: 1; b: 61 shr 3; g: 255 shr 3; r: 252 shr 3);
White: TARGB1555 = (a: 1; b: 252 shr 3; g: 255 shr 3; r: 254 shr 3);
JoypadB = 0;
JoypadSelect = 2;
JoypadStart = 3;
JoypadUp = 4;
JoypadDown = 5;
JoypadLeft = 6;
JoypadRight = 7;
JoypadA = 8;
var
EnvCb: TRetroEnvironment;
VideoCb: TRetroVideoRefresh;
PollCb: TRetroInputPoll;
InputCb: TRetroInputState;
Screen: array [0..(Width * Height)] of TARGB1555;
Player: array [1..2] of TPlayer;
Ball: TBall;
GameState: TGameState;
function MakeColor(a, r, g, b: byte): TARGB1555;
var
c: TARGB1555;
begin
c.a := integer(a > 1);
c.r := r shr 3;
c.g := g shr 3;
c.b := b shr 3;
Result := c;
end;
procedure Clear(color: TARGB1555);
var
i: integer;
begin
for i := 0 to (Width * Height) do
Screen[i] := color;
end;
procedure ToScreen(x, y, w, h: PInteger);
var
left, right, top, bottom: integer;
begin
left := Max(x^, 0);
right := Min(Width, x^ + w^);
top := Max(y^, 0);
bottom := Min(Height, y^ + h^);
x^ := left;
y^ := top;
w^ := right - left;
h^ := bottom - top;
end;
procedure DrawText(Text: string; x, y: integer; color: TARGB1555);
var
fx, fy: integer;
tx, ty, tw, th: integer;
left, top: integer;
c: char;
begin
for c in upCase(Text) do
begin
if (c > ' ') and (c < '`') then
begin
tx := x;
ty := y;
tw := 8;
th := 8;
ToScreen(@tx, @ty, @tw, @th);
if (tw > 0) and (th > 0) then
begin
fy := 0;
for top := ty to ty + th - 1 do
begin
fx := (Ord(c) - 32) * 8;
for left := tx to tx + tw - 1 do
begin
if Font[fy][fx] = 1 then
Screen[top * Width + left] := color;
fx += 1;
end;
fy += 1;
end;
end;
end;
x := x + 8;
end;
end;
procedure DrawTextCentered(Text: string; cols, rows: integer;
color: TARGB1555);
begin
DrawText(Text, (Width - Length(Text) * 8) div 2 + cols * 8,
(Height - 8) div 2 + rows * 8, color);
end;
procedure DrawRect(x, y, w, h: integer; color: TARGB1555);
var
left, top: integer;
begin
ToScreen(@x, @y, @w, @h);
if (w > 0) and (h > 0) then
begin
for top := y to y + h - 1 do
begin
for left := x to x + w - 1 do
begin
Screen[top * Width + left] := color;
end;
end;
end;
end;
// METHODS ---------------------------------------------------------------------
procedure TPlayer.Update();
var
ymove: integer;
begin
ymove := InputCb(Id, 1, 0, JoypadDown) - InputCb(Id, 1, 0, JoypadUp);
Y += ymove;
end;
procedure TPlayer.Draw();
begin
DrawRect(X, Y, W, H, White);
end;
procedure TBall.Reset();
begin
X := (Width - W) div 2;
Y := (Height - H) div 2;
HSpeed := Speed;
VSpeed := Speed;
if Random(100) mod 2 = 0 then
HSpeed := -HSpeed;
if Random(100) mod 2 = 0 then
VSpeed := -VSpeed;
end;
procedure TBall.Update();
var
i: integer;
begin
Y += VSpeed;
if (Y < 0) or (Y + H >= Height) then
VSpeed := -VSpeed
else
begin
X += HSpeed;
if (X <= Player[1].X + Player[1].W) and
((Y + H >= Player[1].Y) and (Y <= Player[1].Y + Player[1].H)) then
begin
HSpeed := -HSpeed;
X := Player[1].X + Player[1].W;
end
else
if (X + W >= Player[2].X) and ((Y + H >= Player[2].Y) and
(Y <= Player[2].Y + Player[2].H)) then
begin
HSpeed := -HSpeed;
X := Player[2].X - W;
end;
end;
end;
procedure TBall.Draw();
begin
DrawRect(X, Y, W, H, White);
end;
// LIBRETRO --------------------------------------------------------------------
procedure retro_set_environment(p: TRetroEnvironment); cdecl;
var
no_game: boolean = True;
begin
EnvCb := p;
EnvCb(18, @no_game);
end;
procedure retro_set_video_refresh(p: TRetroVideoRefresh); cdecl;
begin
VideoCb := p;
end;
procedure retro_set_audio_sample(p: TRetroAudioSample); cdecl;
begin
end;
procedure retro_set_audio_sample_batch(p: TRetroAudioSampleBatch); cdecl;
begin
end;
procedure retro_set_input_poll(p: TRetroInputPoll); cdecl;
begin
PollCb := p;
end;
procedure retro_set_input_state(p: TRetroInputState); cdecl;
begin
InputCb := p;
end;
procedure retro_init; cdecl;
begin
Randomize;
end;
procedure retro_deinit; cdecl;
begin
end;
function retro_api_version: UInt32; cdecl;
begin
Result := 1;
end;
procedure retro_get_system_info(info: PRetroSystemInfo); cdecl;
begin
info^.LibraryName := 'pascal test';
info^.LibraryVersion := '1.0';
end;
procedure retro_get_system_av_info(info: PRetroSystemAvInfo); cdecl;
begin
with info^.Geometry do
begin
BaseWidth := Width;
BaseHeight := Height;
MaxWidth := BaseWidth;
MaxHeight := BaseHeight;
AspectRatio := single(BaseWidth) / single(BaseHeight);
end;
with info^.Timing do
begin
FPS := 60;
SampleRate := 44000;
end;
end;
procedure retro_set_controller_port_device(port: UInt32;
device: UInt32); cdecl;
begin
end;
procedure retro_reset; cdecl;
var
i: integer;
begin
for i := 1 to 2 do
begin
Player[i].Id := 0;//i - 1;
Player[i].W := Size;
Player[i].H := Size * 4;
Player[i].X := (Width - Size) * (i - 1);
Player[i].Y := (Height - Player[i].H) div 2;
Player[i].Score := 0;
end;
GameState := gsStart;
Ball.W := Size;
Ball.H := Ball.W;
Ball.Reset();
end;
procedure retro_run; cdecl;
var
i: integer;
begin
PollCb();
Clear(Black);
case GameState of
gsStart:
begin
if InputCb(0, 1, 0, JoypadA) <> 0 then
GameState := gsPlaying;
DrawTextCentered('enygmata''s pascal pong', 0, -2, Yellow);
DrawTextCentered('a: start', 0, 0, Blue);
DrawTextCentered('b: reset', 0, 1, Blue);
DrawTextCentered('- press a to start -', 0, 3, Red);
end;
gsPlaying:
begin
if (InputCb(0, 1, 0, JoypadB) <> 0) or
(InputCb(0, 1, 0, JoypadB) <> 0) then
retro_reset()
else
begin
DrawText(Format('%2d/%-2d', [Player[1].Score, Player[2].Score]),
(Width - 8 * 5) div 2, 8, White);
for i := 1 to 2 do
begin
Player[i].Update();
Player[i].Draw();
end;
Ball.Update();
Ball.Draw();
if Ball.X + Ball.W < Player[1].X then
begin
Player[2].Score += 1;
Ball.Reset();
end
else if Ball.X > Player[2].X + Player[2].W then
begin
Player[1].Score += 1;
Ball.Reset();
end;
end;
end;
gsScore:
begin
end;
end;
VideoCb(@Screen, Width, Height, Width * 2);
end;
function retro_serialize_size: SizeUInt; cdecl;
begin
Result := 0;
end;
function retro_serialize(Data: Pointer; size: SizeUInt): boolean; cdecl;
begin
Result := False;
end;
function retro_unserialize(const Data: Pointer;
size: SizeUInt): boolean; cdecl;
begin
Result := False;
end;
procedure retro_cheat_reset; cdecl;
begin
end;
procedure retro_cheat_set(index: UInt32; Enabled: boolean;
const code: PAnsiChar); cdecl;
begin
end;
function retro_load_game(const game: PRetroGameInfo): boolean; cdecl;
var
pixel_format: Int32 = 0; // 0rgb1555
begin
EnvCb(10, @pixel_format);
retro_reset;
Result := True;
end;
function retro_load_game_special(gameType: UInt32; info: PRetroGameInfo;
numInfo: SizeUInt): boolean; cdecl;
begin
Result := retro_load_game(info);
end;
procedure retro_unload_game; cdecl;
begin
end;
function retro_get_region: UInt32; cdecl;
begin
Result := 1;
end;
function retro_get_memory_data(id: UInt32): Pointer; cdecl;
begin
Result := nil;
end;
function retro_get_memory_size(id: UInt32): SizeUInt; cdecl;
begin
Result := 0;
end;
exports
retro_set_environment,
retro_set_video_refresh,
retro_set_audio_sample,
retro_set_audio_sample_batch,
retro_set_input_poll,
retro_set_input_state,
retro_init,
retro_deinit,
retro_api_version,
retro_get_system_info,
retro_get_system_av_info,
retro_set_controller_port_device,
retro_reset,
retro_run,
retro_serialize_size,
retro_serialize,
retro_unserialize,
retro_cheat_reset,
retro_cheat_set,
retro_load_game,
retro_load_game_special,
retro_unload_game,
retro_get_region,
retro_get_memory_data,
retro_get_memory_size;
begin
writeln();
writeln('WELCOME TO THE FIRST LIBRETRO GAME WRITTEN IN PASCAL');
writeln();
end.
Reference in a new issue View git blame Copy permalink