moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2025-01-09 04:38:01 -05:00
Code Issues Releases Wiki Activity

Dist Cleaned the files, removed binaries, etc.

Browse Source
This commit is contained in:
Thomas Dunne 2011-08-13 12:08:08 +01:00
commit a115d1b37b
62 changed files with 2075 additions and 645 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
Doc/sphinx/Makefile
View File

@ -12,20 +12,26 @@ PAPEROPT_a4 = -D latex_paper_size=a4
PAPEROPT_letter = -D latex_paper_size=letter PAPEROPT_letter = -D latex_paper_size=letter
ALLSPHINXOPTS = -d $(BUILDDIR)/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) . ALLSPHINXOPTS = -d $(BUILDDIR)/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) .
.PHONY: help clean html dirhtml pickle json htmlhelp qthelp latex changes linkcheck doctest .PHONY: help clean html dirhtml singlehtml pickle json htmlhelp qthelp devhelp epub latex latexpdf text man changes linkcheck doctest
help: help:
@echo "Please use \`make <target>' where <target> is one of" @echo "Please use \`make <target>' where <target> is one of"
@echo " html to make standalone HTML files" @echo " html to make standalone HTML files"
@echo " dirhtml to make HTML files named index.html in directories" @echo " dirhtml to make HTML files named index.html in directories"
@echo " pickle to make pickle files" @echo " singlehtml to make a single large HTML file"
@echo " json to make JSON files" @echo " pickle to make pickle files"
@echo " htmlhelp to make HTML files and a HTML help project" @echo " json to make JSON files"
@echo " qthelp to make HTML files and a qthelp project" @echo " htmlhelp to make HTML files and a HTML help project"
@echo " latex to make LaTeX files, you can set PAPER=a4 or PAPER=letter" @echo " qthelp to make HTML files and a qthelp project"
@echo " changes to make an overview of all changed/added/deprecated items" @echo " devhelp to make HTML files and a Devhelp project"
@echo " linkcheck to check all external links for integrity" @echo " epub to make an epub"
@echo " doctest to run all doctests embedded in the documentation (if enabled)" @echo " latex to make LaTeX files, you can set PAPER=a4 or PAPER=letter"
@echo " latexpdf to make LaTeX files and run them through pdflatex"
@echo " text to make text files"
@echo " man to make manual pages"
@echo " changes to make an overview of all changed/added/deprecated items"
@echo " linkcheck to check all external links for integrity"
@echo " doctest to run all doctests embedded in the documentation (if enabled)"
clean: clean:
-rm -rf $(BUILDDIR)/* -rm -rf $(BUILDDIR)/*
@ -40,6 +46,11 @@ dirhtml:
@echo @echo
@echo "Build finished. The HTML pages are in $(BUILDDIR)/dirhtml." @echo "Build finished. The HTML pages are in $(BUILDDIR)/dirhtml."
singlehtml:
$(SPHINXBUILD) -b singlehtml $(ALLSPHINXOPTS) $(BUILDDIR)/singlehtml
@echo
@echo "Build finished. The HTML page is in $(BUILDDIR)/singlehtml."
pickle: pickle:
$(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) $(BUILDDIR)/pickle $(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) $(BUILDDIR)/pickle
@echo @echo
@ -65,12 +76,42 @@ qthelp:
@echo "To view the help file:" @echo "To view the help file:"
@echo "# assistant -collectionFile $(BUILDDIR)/qthelp/Simba.qhc" @echo "# assistant -collectionFile $(BUILDDIR)/qthelp/Simba.qhc"
devhelp:
$(SPHINXBUILD) -b devhelp $(ALLSPHINXOPTS) $(BUILDDIR)/devhelp
@echo
@echo "Build finished."
@echo "To view the help file:"
@echo "# mkdir -p $$HOME/.local/share/devhelp/Simba"
@echo "# ln -s $(BUILDDIR)/devhelp $$HOME/.local/share/devhelp/Simba"
@echo "# devhelp"
epub:
$(SPHINXBUILD) -b epub $(ALLSPHINXOPTS) $(BUILDDIR)/epub
@echo
@echo "Build finished. The epub file is in $(BUILDDIR)/epub."
latex: latex:
$(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
@echo @echo
@echo "Build finished; the LaTeX files are in $(BUILDDIR)/latex." @echo "Build finished; the LaTeX files are in $(BUILDDIR)/latex."
@echo "Run \`make all-pdf' or \`make all-ps' in that directory to" \ @echo "Run \`make' in that directory to run these through (pdf)latex" \
"run these through (pdf)latex." "(use \`make latexpdf' here to do that automatically)."
latexpdf:
$(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
@echo "Running LaTeX files through pdflatex..."
make -C $(BUILDDIR)/latex all-pdf
@echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex."
text:
$(SPHINXBUILD) -b text $(ALLSPHINXOPTS) $(BUILDDIR)/text
@echo
@echo "Build finished. The text files are in $(BUILDDIR)/text."
man:
$(SPHINXBUILD) -b man $(ALLSPHINXOPTS) $(BUILDDIR)/man
@echo
@echo "Build finished. The manual pages are in $(BUILDDIR)/man."
changes: changes:
$(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) $(BUILDDIR)/changes $(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) $(BUILDDIR)/changes

104
Doc/sphinx/conf.py
View File

@ -1,7 +1,7 @@
# -*- coding: utf-8 -*- # -*- coding: utf-8 -*-
# #
# Simba documentation build configuration file, created by # Simba documentation build configuration file, created by
# sphinx-quickstart on Wed Jun 9 23:55:23 2010. # sphinx-quickstart on Sun Jul 24 18:24:27 2011.
# #
# This file is execfile()d with the current directory set to its containing dir. # This file is execfile()d with the current directory set to its containing dir.
# #
@ -16,16 +16,19 @@ import sys, os
# If extensions (or modules to document with autodoc) are in another directory, # If extensions (or modules to document with autodoc) are in another directory,
# add these directories to sys.path here. If the directory is relative to the # add these directories to sys.path here. If the directory is relative to the
# documentation root, use os.path.abspath to make it absolute, like shown here. # documentation root, use os.path.abspath to make it absolute, like shown here.
#sys.path.append(os.path.abspath('.')) #sys.path.insert(0, os.path.abspath('.'))
sys.path.append(os.path.abspath('../../Projects/libmml/pymml/mml')) sys.path.append(os.path.abspath('../../Projects/libmml/pymml/mml'))
sys.path.append(os.path.abspath('../../Projects/libmml/pymml')) sys.path.append(os.path.abspath('../../Projects/libmml/pymml'))
# -- General configuration ----------------------------------------------------- # -- General configuration -----------------------------------------------------
# If your documentation needs a minimal Sphinx version, state it here.
#needs_sphinx = '1.0'
# Add any Sphinx extension module names here, as strings. They can be extensions # Add any Sphinx extension module names here, as strings. They can be extensions
# coming with Sphinx (named 'sphinx.ext.*') or your custom ones. # coming with Sphinx (named 'sphinx.ext.*') or your custom ones.
extensions = ['sphinx.ext.autodoc'] extensions = ['sphinx.ext.autodoc', 'sphinx.ext.viewcode']
# Add any paths that contain templates here, relative to this directory. # Add any paths that contain templates here, relative to this directory.
templates_path = ['_templates'] templates_path = ['_templates']
@ -34,23 +37,23 @@ templates_path = ['_templates']
source_suffix = '.rst' source_suffix = '.rst'
# The encoding of source files. # The encoding of source files.
#source_encoding = 'utf-8' #source_encoding = 'utf-8-sig'
# The master toctree document. # The master toctree document.
master_doc = 'index' master_doc = 'index'
# General information about the project. # General information about the project.
project = u'Simba' project = u'Simba'
copyright = u'2010, Merlijn Wajer, Raymond van Venetie' copyright = u'2011, Merlijn Wajer, Raymond van Venetie'
# The version info for the project you're documenting, acts as replacement for # The version info for the project you're documenting, acts as replacement for
# |version| and |release|, also used in various other places throughout the # |version| and |release|, also used in various other places throughout the
# built documents. # built documents.
# #
# The short X.Y version. # The short X.Y version.
version = '0.810' version = '0.97'
# The full version, including alpha/beta/rc tags. # The full version, including alpha/beta/rc tags.
release = '0.810' release = '0.97'
# The language for content autogenerated by Sphinx. Refer to documentation # The language for content autogenerated by Sphinx. Refer to documentation
# for a list of supported languages. # for a list of supported languages.
@ -62,12 +65,9 @@ release = '0.810'
# Else, today_fmt is used as the format for a strftime call. # Else, today_fmt is used as the format for a strftime call.
#today_fmt = '%B %d, %Y' #today_fmt = '%B %d, %Y'
# List of documents that shouldn't be included in the build. # List of patterns, relative to source directory, that match files and
#unused_docs = [] # directories to ignore when looking for source files.
exclude_patterns = ['_build']
# List of directories, relative to source directory, that shouldn't be searched
# for source files.
exclude_trees = ['_build']
# The reST default role (used for this markup: `text`) to use for all documents. # The reST default role (used for this markup: `text`) to use for all documents.
#default_role = None #default_role = None
@ -92,9 +92,9 @@ pygments_style = 'sphinx'
# -- Options for HTML output --------------------------------------------------- # -- Options for HTML output ---------------------------------------------------
# The theme to use for HTML and HTML Help pages. Major themes that come with # The theme to use for HTML and HTML Help pages. See the documentation for
# Sphinx are currently 'default' and 'sphinxdoc'. # a list of builtin themes.
html_theme = 'default' html_theme = 'nature'
# Theme options are theme-specific and customize the look and feel of a theme # Theme options are theme-specific and customize the look and feel of a theme
# further. For a list of options available for each theme, see the # further. For a list of options available for each theme, see the
@ -141,7 +141,7 @@ html_static_path = ['_static']
#html_additional_pages = {} #html_additional_pages = {}
# If false, no module index is generated. # If false, no module index is generated.
#html_use_modindex = True #html_domain_indices = True
# If false, no index is generated. # If false, no index is generated.
#html_use_index = True #html_use_index = True
@ -152,13 +152,19 @@ html_static_path = ['_static']
# If true, links to the reST sources are added to the pages. # If true, links to the reST sources are added to the pages.
#html_show_sourcelink = True #html_show_sourcelink = True
# If true, "Created using Sphinx" is shown in the HTML footer. Default is True.
#html_show_sphinx = True
# If true, "(C) Copyright ..." is shown in the HTML footer. Default is True.
#html_show_copyright = True
# If true, an OpenSearch description file will be output, and all pages will # If true, an OpenSearch description file will be output, and all pages will
# contain a <link> tag referring to it. The value of this option must be the # contain a <link> tag referring to it. The value of this option must be the
# base URL from which the finished HTML is served. # base URL from which the finished HTML is served.
#html_use_opensearch = '' #html_use_opensearch = ''
# If nonempty, this is the file name suffix for HTML files (e.g. ".xhtml"). # This is the file name suffix for HTML files (e.g. ".xhtml").
#html_file_suffix = '' #html_file_suffix = None
# Output file base name for HTML help builder. # Output file base name for HTML help builder.
htmlhelp_basename = 'Simbadoc' htmlhelp_basename = 'Simbadoc'
@ -187,6 +193,12 @@ latex_documents = [
# not chapters. # not chapters.
#latex_use_parts = False #latex_use_parts = False
# If true, show page references after internal links.
#latex_show_pagerefs = False
# If true, show URL addresses after external links.
#latex_show_urls = False
# Additional stuff for the LaTeX preamble. # Additional stuff for the LaTeX preamble.
#latex_preamble = '' #latex_preamble = ''
@ -194,4 +206,54 @@ latex_documents = [
#latex_appendices = [] #latex_appendices = []
# If false, no module index is generated. # If false, no module index is generated.
#latex_use_modindex = True #latex_domain_indices = True
# -- Options for manual page output --------------------------------------------
# One entry per manual page. List of tuples
# (source start file, name, description, authors, manual section).
man_pages = [
('index', 'simba', u'Simba Documentation',
[u'Merlijn Wajer, Raymond van Venetie'], 1)
]
# -- Options for Epub output ---------------------------------------------------
# Bibliographic Dublin Core info.
epub_title = u'Simba'
epub_author = u'Merlijn Wajer, Raymond van Venetie'
epub_publisher = u'Merlijn Wajer, Raymond van Venetie'
epub_copyright = u'2011, Merlijn Wajer, Raymond van Venetie'
# The language of the text. It defaults to the language option
# or en if the language is not set.
#epub_language = ''
# The scheme of the identifier. Typical schemes are ISBN or URL.
#epub_scheme = ''
# The unique identifier of the text. This can be a ISBN number
# or the project homepage.
#epub_identifier = ''
# A unique identification for the text.
#epub_uid = ''
# HTML files that should be inserted before the pages created by sphinx.
# The format is a list of tuples containing the path and title.
#epub_pre_files = []
# HTML files shat should be inserted after the pages created by sphinx.
# The format is a list of tuples containing the path and title.
#epub_post_files = []
# A list of files that should not be packed into the epub file.
#epub_exclude_files = []
# The depth of the table of contents in toc.ncx.
#epub_tocdepth = 3
# Allow duplicate toc entries.
#epub_tocdup = True

25
Doc/sphinx/docdoc.rst
View File

@ -1,3 +1,5 @@
.. _docdoc:
Documentation Documentation Documentation Documentation
=========================== ===========================
@ -18,6 +20,7 @@ be found at the bottom of the page.
Building the documentation Building the documentation
-------------------------- --------------------------
In the future, the online documentation will be refreshed every hour. However, In the future, the online documentation will be refreshed every hour. However,
if you want to build the documentation yourself, you should install if you want to build the documentation yourself, you should install
``python-sphinx``. ``python-sphinx``.
@ -69,3 +72,25 @@ Simba specific words (like Simba itself) capitalized.
Try to stick to the Python documentation standards. Try to stick to the Python documentation standards.
( http://docs.python.org/using/index.html ) ( http://docs.python.org/using/index.html )
References
----------
Sphinx has references, most of the .rst files contain labels and references.
A label looks something like this:
.. code-block:: python
.. _<X>-<Y>:
Where X is either the name of file or folder; and Y is the name of the
file/function if X is a folder. For referring to specific functions for example,
use:
.. code-block:: python
.. _scriptref-movemouse:
To define a label for the MoveMouse function. Labels are always placed right
above section/chapter declarations.

10
Doc/sphinx/features.rst
View File

@ -1,7 +1,11 @@
Feature Overview Detailed Feature Overview
================ =========================
Simba has some fancy features; the most basic operations as well as detailed
information about settings will be explained here.
.. toctree:: .. toctree::
:maxdepth: 2
features/scriptmanager.rst features/scriptmanager.rst
features/autoupdate.rst features/autoupdate.rst
@ -10,5 +14,3 @@ Feature Overview
features/ui.rst features/ui.rst
features/notwellknown.rst features/notwellknown.rst
Most stuff here is probably misplaced anyway.

12
Doc/sphinx/features/exten.rst
View File

@ -14,9 +14,17 @@ Recommended Simba Extensions
---------------------------- ----------------------------
Recommended: Recommended:
* SRL Updater (and Downloader)
* DTM Editor * Extension Updater (highly recommended)
* SRL Updater (and Installer/Download)
* Associate Files * Associate Files
* Security extension. (Implements a File and Fire wall)
For developers:
* DTM Editor
* Paster Extension
* CRov, Crash Recovery.
.. note:: .. note::
You can also use the Reflection Updater (and Downloader) for updating You can also use the Reflection Updater (and Downloader) for updating

3
Doc/sphinx/features/notwellknown.rst
View File

@ -1,6 +1,9 @@
Not Well Known Features Not Well Known Features
======================= =======================
..
TODO
Simba has several features that are relatively unknown. Simba has several features that are relatively unknown.
A few will be listed here. A few will be listed here.

30
Doc/sphinx/gettingstarted.rst
View File

@ -1,3 +1,4 @@
.. _gettingstarted:
Getting Started with Simba Getting Started with Simba
========================== ==========================
@ -18,10 +19,12 @@ minutes.
Simba installer Simba installer
~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~
Everyone can download Simba at http://wizzup.org/simba/ Everyone can get Simba at http://wizzup.org/simba/
Go to download and download the Simba installer.
Once it is done downloading, simply run the installer and follow the steps. Go to *Download* and download the Simba installer.
Once it is done downloading, simply run the installer, follow the steps and
please make notice of the following note:
.. note:: .. note::
Simba will install to C:/ by default; if you want to install it Simba will install to C:/ by default; if you want to install it
@ -35,18 +38,20 @@ Once it is done downloading, simply run the installer and follow the steps.
Simba will probably tell you there is an update available. In this case, an Simba will probably tell you there is an update available. In this case, an
update button will appear. Click it and the Simba Updater will show up. update button will appear. Click it and the Simba Updater will show up.
Alternatively you can update Simba using Tools -> Update. Alternatively you can update Simba using Tools -> Update which will update Simba
if there is a new update available.
.. note:: .. note::
Updating Simba regularly is recommended. Updating Simba as soon as an update is released is recommended.
Downloading Simba binary Portable Simba Installation
~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~
This is harder and not recommended. Steps on how to do this will follow later. ..
TODO
For now, simply stick to the installer and update Simba after the install has To get a portable installation at this time is not supported but will follow
completed. sooner or later.
Setting up SRL 4 with Simba Setting up SRL 4 with Simba
--------------------------- ---------------------------
@ -54,7 +59,7 @@ Setting up SRL 4 with Simba
If you were using the :ref:`simba-installer` then you can simply enable the If you were using the :ref:`simba-installer` then you can simply enable the
``SRL Updater`` extension. (Go to View -> Extensions and enable ``srl.sex``) ``SRL Updater`` extension. (Go to View -> Extensions and enable ``srl.sex``)
See :ref:`simbaext` for more information on Extensions. See :ref:`simbaext` for more information on (other) Simba extensions.
This is the only supported way. You can simply do a svn checkout on the srl This is the only supported way. You can simply do a svn checkout on the srl
repository, but if you can do that, then you should be able to set up SRL repository, but if you can do that, then you should be able to set up SRL
@ -68,6 +73,9 @@ This will follow later, upon SRL 5 release.
Installing scripts Installing scripts
------------------ ------------------
..
TODO
Scripts can be downloaded with the Script Manager, in Tools -> Script Manager. Scripts can be downloaded with the Script Manager, in Tools -> Script Manager.
.. note:: .. note::

27
Doc/sphinx/index.rst
View File

@ -7,11 +7,28 @@ Welcome to the Simba documentation!
=================================== ===================================
.. note:: .. note::
The documentation is still WIP (Work In Progress)
Welcome to the Documentation for the Simba project. Welcome to the Documentation for the Simba project.
This documentation is aimed at providing documentation on just about anything The documentation is actively being worked on and somewhat incomplete.
you'd want to know about Simba.
This documentation aims to provide information on just about anything
there is to know about Simba.
Starting points are :ref:`whatis`, :ref:`gettingstarted` and the :ref:`scriptref`
Want to help out with the documentation? See :ref:`docdoc`.
Simba is a program used to repeat certain (complicated) tasks. Typically these
tasks involve using the mouse and keyboard. Simba is programmable, which means
you can design your own logic and steps that Simba will follow, based upon
certain input or as a reaction to a certain action.
Simba is created by the SRL community, fully open source and actively
maintained.
For community forums see http://villavu.com/
Contents: Contents:
@ -19,7 +36,6 @@ Contents:
:maxdepth: 2 :maxdepth: 2
whatis.rst whatis.rst
whatsnew.rst
whysimba.rst whysimba.rst
gettingstarted.rst gettingstarted.rst
troubleshooting.rst troubleshooting.rst
@ -31,6 +47,7 @@ Contents:
referencesimba.rst referencesimba.rst
docdoc.rst docdoc.rst
todo.rst todo.rst
libmml.rst
pymml.rst pymml.rst

11
Doc/sphinx/libmml.rst Normal file
View File

@ -0,0 +1,11 @@
.. _lib-mml:
libMML
==========
.. toctree::
:maxdepth: 2
libmml/intro.rst

100
Doc/sphinx/libmml/intro.rst Normal file
View File

@ -0,0 +1,100 @@
libMML
======
libMML is short for the library to the Mufasa Macro Library.
Why libMML?
-----------
One of the first questions that rise are probably *why* libMML and *what* is
libMML exactly?
libMML is a loadable C-like library that provides most of the MML functionality.
For the ones that do not know, MML is the core component for Simba that does all
the *computational* and *algorithmic* work. See :ref:`mmlref` for more
information.
To summarize, the MML covers:
- Targetting specific windows and getting the window information such as
their bitmaps and dimensions.
- Controlling the mouse and keyboard.
- Finding colours, bitmaps and dtms.
- Text recognition (OCR)
- Accessing files and sockets in an unified manner
Hopefully the *what* part of the question has mainly been covered by now. If
you're literate in computer science the *why* question has also been answered as
soon as it was mentioned that is was a loadable library - which is also implied
by its name. Exporting the MML into a loadable library allows virtually any
program to load it and just use all the MML functionality.
Design (issues)
---------------
libMML itself should not be too complex. It should simply translate the OOP MML
to a non-OOP C-type library and convert datatypes when required (see below as to
why). libMML is basically just a codebase that calls MML functions and passes
the result along in a slightly different format. In simple cases such as
MoveMouse the integers are simply passed; since there's do not differ, but in
the case of arrays of any type we have to copy the arrays to a C format - at
least until MML internally will no longer use Free Pascal (managed) arrays.
As previously mentioned, libMML is a *C*-type library; this is mentioned
explicitly because MML is written in Free Pascal (Object Pascal) which has quite
a few different datatypes. Strings are typically not compatible, and arrays are
managed in Pascal whereas they are not in C which makes it hard to just *pass*
the array along. One of the problems we have to cope with when writing libMML is
converting datatypes to C-compatible datatypes. C-compatible datatypes are
supported by most programming languages and thus the best way to go when making
a universal MML library.
libMML use cases
----------------
Theoretically libMML can be loaded by any programming language; but typically
each programming languages has it's own kind of programming practices and thus
write - again - their own wrapper around libMML. This is what is being done with
*pyMML*, the python libMML wrapper. It is still as much in development as libMML
is, but the functionality exposed by libMML is succesfully used.
As of writing the pyMML usage looks like this, the passing around of a client
may be removed in a later stage, or at least have it's behaviour changed.
.. code-block:: python
DLL = MMLCore('../libmml.so')
client = DLL.dll.create_client()
print 'Python Client: %d' % client
if client in (0, 1):
raise Exception('Could create a client');
c = Color(DLL, client)
ret = c.find((0, 0, 100, 100), 0)
print ret
ret = c.find_all((0, 0, 100, 100), 0, tol=100)
print ret
m = Mouse(DLL, client)
print m[(Mouse.Pos, Mouse.Left, Mouse.Right)]
m[(Mouse.Pos, Mouse.Right)] = ((300,300), True)
print m.getButtonStates()
sleep(0.5)
m.setPos((200,200))
sleep(2)
print 'Done'
m[(Mouse.Left, Mouse.Right, Mouse.Middle)] = [False for x in range(3)]
for v in zip((Mouse.Left, Mouse.Right), m[(Mouse.Left, Mouse.Right)]):
print v
print m.getPos()
del DLL

1
Doc/sphinx/pymml.rst
View File

@ -6,7 +6,6 @@ Python MML
.. toctree:: .. toctree::
:maxdepth: 2 :maxdepth: 2
pymml/mml.rst
pymml/mouse.rst pymml/mouse.rst
pymml/color.rst pymml/color.rst

2
Doc/sphinx/referencemml.rst
View File

@ -1,3 +1,5 @@
.. _mmlref:
MML Reference MML Reference
============= =============

2
Doc/sphinx/referencescript.rst
View File

@ -1,3 +1,5 @@
.. _scriptref:
Scripting Reference Scripting Reference
=================== ===================

157
Doc/sphinx/scriptref/bitmaps.rst
View File

@ -4,12 +4,44 @@
Bitmaps Bitmaps
======= =======
A bitmap in Simba is simply a two dimensional *field of colours*. These colours
can all be the same, or they can be of different colours. Simba features
functions to create, manipulate and search for bitmaps.
.. INSERT BITMAP EXAMPLE HERE (Picture, etc)
The bitmaps are - just as files - represented as integer in Simba (they point to
a list of bitmaps, and the value of the integer is the position in the list).
So typically, when referring to bitmaps in Simba, you simply represent them as
an integer:
.. code-block:: pascal
var bmp, x, y: integer;
bmp := CreateBitmap(10, 10); // Create a bitmap of size (10, 10)
if FindBitmapIn(bmp, x, y, 0, 0, 300, 300) then
writeln('Found it!');
FreeBitmap(bmp); // Don't forget to free it when we are done.
Note that the previous example doesn't make a lot of sense as the bitmap has
only been created and not filled with any colours, they are as of yet,
undefined. You can also create bitmaps from screenshots and load them when your
script starts using the :ref:`scriptref-bitmapfromstring` function, or
simple store them as files and load them using the :ref:`scriptref-loadbitmap`
function.
Word of caution on bitmap creation
----------------------------------
Bitmaps in Simba are internally all instances of *TMufasBitmap*. Scripts should Bitmaps in Simba are internally all instances of *TMufasBitmap*. Scripts should
generally access bitmaps using their *handle*: an integer. All functions generally access bitmaps using their *handle*: an integer. All functions
referenced here either require a bitmap *handle* or return one. referenced here either require a bitmap *handle* or return one.
If you want to gain more access over a specific bitmap, see the If you want to gain more access over a specific bitmap, see the
*GetMufasaBitmap* function. It is highly unrecommended to create bitmaps with: *GetMufasaBitmap* function. It is highly unrecommended to create bitmaps like
this, because Simba will not free them automatically for you. (There's no
problem doing it like this if you only want to perform operations on it and then
free it again)
.. code-block:: pascal .. code-block:: pascal
@ -48,6 +80,7 @@ then call this function to get the class reference.
bmp.SetSize(150,150); // also changes bmph, as they are the same bitmap. bmp.SetSize(150,150); // also changes bmph, as they are the same bitmap.
.. _scriptref-createbitmapstring:
CreateBitmapString CreateBitmapString
------------------ ------------------
@ -56,7 +89,11 @@ CreateBitmapString
function CreateBitmapString(bmp : integer) : string; function CreateBitmapString(bmp : integer) : string;
Creates a string for the given bitmap. Creates a string for the given bitmap, you can use this to save a bitmap for
later us, for example loading it again using :ref:`scriptref-bitmapfromstring`.
.. _scriptref-createbitmap:
CreateBitmap CreateBitmap
------------ ------------
@ -65,8 +102,10 @@ CreateBitmap
function CreateBitmap(w,h :integer) : integer; function CreateBitmap(w,h :integer) : integer;
Create a bitmap with width *h* and height *h*. Returns the bitmap reference. Create a bitmap with width *h* and height *h*.
Returns the reference to the created bitmap.
.. _scriptref-freebitmap:
FreeBitmap FreeBitmap
---------- ----------
@ -80,6 +119,8 @@ Be careful when working with bitmaps: not freeing it when you no longer need it
leads to memory leaks, which will eventually make your script crash. (Unless you leads to memory leaks, which will eventually make your script crash. (Unless you
stop it in time, in which case Simba will free the bitmaps for you) stop it in time, in which case Simba will free the bitmaps for you)
.. _scriptref-savebitmap:
SaveBitmap SaveBitmap
---------- ----------
@ -89,6 +130,8 @@ SaveBitmap
Save the given bitmap to the specified path. Save the given bitmap to the specified path.
.. _scriptref-bitmapfromstring:
BitmapFromString BitmapFromString
---------------- ----------------
@ -99,6 +142,7 @@ BitmapFromString
Load a bitmap from the given string. This command is usually generated with the Load a bitmap from the given string. This command is usually generated with the
Bitmap to String feature in Simba. Bitmap to String feature in Simba.
.. _scriptref-loadbitmap:
LoadBitmap LoadBitmap
---------- ----------
@ -107,8 +151,10 @@ LoadBitmap
function LoadBitmap(Path : string) : integer; function LoadBitmap(Path : string) : integer;
Load a bitmap from a path to a file. Known formats are .bmp and .png. (Possibly Load a bitmap from a path to a file. Formats known to work are BMP and PNG
others, don't know for sure) images.
.. _scriptref-setbitmapsize:
SetBitmapSize SetBitmapSize
------------- -------------
@ -117,7 +163,12 @@ SetBitmapSize
procedure SetBitmapSize(Bmp,NewW,NewH : integer); procedure SetBitmapSize(Bmp,NewW,NewH : integer);
Change the size of the bitmap. Previous data will be preserved (if possible). Change the size of the bitmap.
Previous data will be preserved (if possible), so enlarging the bitmap won't
destroy the old data, but shrinking it will inevitably destroy some data.
(Everything that falls out of the new bounds)
.. _scriptref-getbitmapsize:
GetBitmapSize GetBitmapSize
------------- -------------
@ -128,6 +179,8 @@ GetBitmapSize
Returns the size of the bitmap in *BmpW*, *BmpH*. Returns the size of the bitmap in *BmpW*, *BmpH*.
.. _scriptref-stretchbitmapresize:
StretchBitmapResize StretchBitmapResize
------------------- -------------------
@ -136,6 +189,8 @@ StretchBitmapResize
procedure StretchBitmapResize(Bmp,NewW,NewH : integer); procedure StretchBitmapResize(Bmp,NewW,NewH : integer);
.. _scriptref-createmirroredbitmap:
CreateMirroredBitmap CreateMirroredBitmap
-------------------- --------------------
@ -144,6 +199,8 @@ CreateMirroredBitmap
function CreateMirroredBitmap(Bmp : integer) : integer; function CreateMirroredBitmap(Bmp : integer) : integer;
.. _scriptref-createmirroredbitmapex:
CreateMirroredBitmapEx CreateMirroredBitmapEx
---------------------- ----------------------
@ -152,6 +209,8 @@ CreateMirroredBitmapEx
function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer; function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;
.. _scriptref-fastsetpixel:
FastSetPixel FastSetPixel
------------ ------------
@ -161,6 +220,8 @@ FastSetPixel
Set the pixel on the bitmap at position x, y to *color*. Set the pixel on the bitmap at position x, y to *color*.
.. _scriptref-fastsetpixels:
FastSetPixels FastSetPixels
------------- -------------
@ -170,6 +231,7 @@ FastSetPixels
Set the pixels on the bitmap at position TPA[index] to Colors[index]. Set the pixels on the bitmap at position TPA[index] to Colors[index].
.. _scriptref-fastgetpixel:
FastGetPixel FastGetPixel
------------ ------------
@ -180,6 +242,8 @@ FastGetPixel
Return the colour of pixel on the bitmap, position specified by x, y. Return the colour of pixel on the bitmap, position specified by x, y.
.. _scriptref-fastgetpixels:
FastGetPixels FastGetPixels
------------- -------------
@ -189,6 +253,7 @@ FastGetPixels
Return an array of the colours on the bitmap; positions specified by *TPA*. Return an array of the colours on the bitmap; positions specified by *TPA*.
.. _scriptref-getbitmapareacolors:
GetBitmapAreaColors GetBitmapAreaColors
------------------- -------------------
@ -200,6 +265,8 @@ GetBitmapAreaColors
Returns all the colours in the area defined by (*xs*, *xy*, *xe*, *ye*) on the Returns all the colours in the area defined by (*xs*, *xy*, *xe*, *ye*) on the
bitmap in a two dimensions integer array. bitmap in a two dimensions integer array.
.. _scriptref-fastdrawclear:
FastDrawClear FastDrawClear
------------- -------------
@ -209,6 +276,8 @@ FastDrawClear
Draw *Color* on every pixel on the bitmap. Draw *Color* on every pixel on the bitmap.
.. _scriptref-fastdrawtransparent:
FastDrawTransparent FastDrawTransparent
------------------- -------------------
@ -217,6 +286,8 @@ FastDrawTransparent
procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer); procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);
.. _scriptref-setransparentcolor:
SetTransparentColor SetTransparentColor
------------------- -------------------
@ -224,6 +295,7 @@ SetTransparentColor
procedure SetTransparentColor(bmp : integer; Color : TColor); procedure SetTransparentColor(bmp : integer; Color : TColor);
.. _scriptref-getransparentcolor:
GetTransparentColor GetTransparentColor
------------------- -------------------
@ -232,6 +304,7 @@ GetTransparentColor
function GetTransparentColor(bmp: integer) : TColor; function GetTransparentColor(bmp: integer) : TColor;
.. _scriptref-fastreplacecolor:
FastReplaceColor FastReplaceColor
---------------- ----------------
@ -240,6 +313,7 @@ FastReplaceColor
procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor); procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);
.. _scriptref-copyclienttobitmap:
CopyClientToBitmap CopyClientToBitmap
------------------ ------------------
@ -250,6 +324,8 @@ CopyClientToBitmap
Copy client area *xs, ys, xe, ye* to specified bitmap. Copy client area *xs, ys, xe, ye* to specified bitmap.
.. _scriptref-bitmapfromclient:
BitmapFromClient BitmapFromClient
---------------- ----------------
@ -259,6 +335,8 @@ BitmapFromClient
Create a bitmap from the client. Area specified by *xs, ye, xe, ye*. Create a bitmap from the client. Area specified by *xs, ye, xe, ye*.
.. _scriptref-setbitmapname:
SetBitmapName SetBitmapName
------------- -------------
@ -269,6 +347,20 @@ SetBitmapName
Assign a name to the bitmap. Mainly for debugging purposes. (It will write the Assign a name to the bitmap. Mainly for debugging purposes. (It will write the
name of the bitmap if it hasn't been freed.) name of the bitmap if it hasn't been freed.)
.. code-block:: pascal
program new;
var bmp: integer;
begin
bmp := CreateBitmap(10, 10);
SetBitmapName(bmp, 'We will not free this bitmap');
end.
// Simba will print what bitmap has not been freed (along with his long
// name)
.. _scriptref-findbitmap:
FindBitmap FindBitmap
---------- ----------
@ -279,6 +371,8 @@ FindBitmap
Searches for the Bitmap *bmp* on the entire client. Returns true if found. Searches for the Bitmap *bmp* on the entire client. Returns true if found.
If found, *x, y* specifies the position where the bitmap was found. If found, *x, y* specifies the position where the bitmap was found.
.. _scriptref-findbitmapin:
FindBitmapIn FindBitmapIn
------------ ------------
@ -291,6 +385,8 @@ Searches for the Bitmap *bmp* on the client in the area defined by *xs,ys,xe,ye*
Returns true if found. If found, *x, y* specifies the position where the bitmap Returns true if found. If found, *x, y* specifies the position where the bitmap
was found. was found.
.. _scriptref-findbitmaptolerancein:
FindBitmapToleranceIn FindBitmapToleranceIn
--------------------- ---------------------
@ -300,10 +396,12 @@ FindBitmapToleranceIn
Searches for the Bitmap *bmp* on the client in the area defined by *xs,ys,xe,ye*. Searches for the Bitmap *bmp* on the client in the area defined by *xs,ys,xe,ye*.
Tolerance defines the tolerance per pixel when matching bitmaps. See Tolerance defines the tolerance per pixel when matching bitmaps. See
:ref:`scriptref_CTS` for more information on tolerance. :ref:`scriptref-CTS` for more information on tolerance.
Returns true if found. If found, *x, y* specifies the position where the bitmap Returns true if found. If found, *x, y* specifies the position where the bitmap
was found. was found.
.. _scriptref-findbitmapspiral:
FindBitmapSpiral FindBitmapSpiral
---------------- ----------------
@ -316,6 +414,8 @@ Returns true if found. If found, *x, y* specifies the position where the bitmap
was found. Search starts from a point defined by *x, y*. was found. Search starts from a point defined by *x, y*.
.. _scriptref-findbitmapsspiraltolerance:
FindBitmapsSpiralTolerance FindBitmapsSpiralTolerance
-------------------------- --------------------------
@ -326,10 +426,12 @@ FindBitmapsSpiralTolerance
Searches for the Bitmap *bmp* on the client in the area defined by *xs,ys,xe,ye*. Searches for the Bitmap *bmp* on the client in the area defined by *xs,ys,xe,ye*.
Tolerance defines the tolerance per pixel when matching bitmaps. See Tolerance defines the tolerance per pixel when matching bitmaps. See
:ref:`scriptref_CTS` for more information on tolerance. :ref:`scriptref-CTS` for more information on tolerance.
Search starts from a point defined by *x, y*. Search starts from a point defined by *x, y*.
Returns true if found. If found, each point in *TPA* specifies a match. Returns true if found. If found, each point in *TPA* specifies a match.
.. _scriptref-findbitmapspiraltolerance:
FindBitmapSpiralTolerance FindBitmapSpiralTolerance
------------------------- -------------------------
@ -339,11 +441,13 @@ FindBitmapSpiralTolerance
Searches for the Bitmap *bmp* on the client in the area defined by *xs,ys,xe,ye*. Searches for the Bitmap *bmp* on the client in the area defined by *xs,ys,xe,ye*.
Tolerance defines the tolerance per pixel when matching bitmaps. See Tolerance defines the tolerance per pixel when matching bitmaps. See
:ref:`scriptref_CTS` for more information on tolerance. :ref:`scriptref-CTS` for more information on tolerance.
Search starts from a point defined by *x, y*. Search starts from a point defined by *x, y*.
Returns true if found. If found, *x, y* specifies the position where the bitmap Returns true if found. If found, *x, y* specifies the position where the bitmap
was found. was found.
.. _scriptref-rotatebitmap:
RotateBitmap RotateBitmap
------------ ------------
@ -352,6 +456,8 @@ RotateBitmap
function RotateBitmap(bitmap: Integer; angle: Extended): Integer; function RotateBitmap(bitmap: Integer; angle: Extended): Integer;
.. _scriptref-desaturatebitmap:
DesaturateBitmap DesaturateBitmap
---------------- ----------------
@ -360,6 +466,8 @@ DesaturateBitmap
function DesaturateBitmap(Bitmap : integer) : integer; function DesaturateBitmap(Bitmap : integer) : integer;
.. _scriptref-invertbitmap:
InvertBitmap InvertBitmap
------------ ------------
@ -368,6 +476,8 @@ InvertBitmap
procedure InvertBitmap(Bitmap : integer); procedure InvertBitmap(Bitmap : integer);
.. _scriptref-copybitmap:
CopyBitmap CopyBitmap
---------- ----------
@ -377,6 +487,8 @@ CopyBitmap
Creates a copy of the *Bitmap*. Returns the bitmap copy. Creates a copy of the *Bitmap*. Returns the bitmap copy.
.. _scriptref-greyscalebitmap:
GreyScaleBitmap GreyScaleBitmap
--------------- ---------------
@ -386,6 +498,7 @@ GreyScaleBitmap
Creates a copy of the bitmap, greyscaled. Creates a copy of the bitmap, greyscaled.
.. _scriptref-brightnessbitmap:
BrightnessBitmap BrightnessBitmap
---------------- ----------------
@ -400,6 +513,8 @@ Returns a new bitmap with the brightness applied.
If you instead want to apply brightness to the current bitmap, see If you instead want to apply brightness to the current bitmap, see
:ref:`filter_apply_bitmap` :ref:`filter_apply_bitmap`
.. _scriptref-contrastbitmap:
ContrastBitmap ContrastBitmap
-------------- --------------
@ -410,6 +525,7 @@ ContrastBitmap
Changes the constrast of a bitmap, returns a new bitmap with the contrast Changes the constrast of a bitmap, returns a new bitmap with the contrast
applied. applied.
.. _scriptref-posterizebitmap:
PosterizeBitmap PosterizeBitmap
--------------- ---------------
@ -441,6 +557,8 @@ Applying a filter on the current bitmap
FreeBitmap(b); FreeBitmap(b);
end. end.
.. _scriptref-createmaskfrombitmap:
CreateMaskFromBitmap CreateMaskFromBitmap
-------------------- --------------------
@ -449,6 +567,8 @@ CreateMaskFromBitmap
function CreateMaskFromBitmap(Bitmap : integer) : TMask; function CreateMaskFromBitmap(Bitmap : integer) : TMask;
.. _scriptref-findmasktolerance:
FindMaskTolerance FindMaskTolerance
----------------- -----------------
@ -457,6 +577,8 @@ FindMaskTolerance
function FindMaskTolerance(const mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean; function FindMaskTolerance(const mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
.. _scriptref-findbitmapmasktolerance:
FindBitmapMaskTolerance FindBitmapMaskTolerance
----------------------- -----------------------
@ -465,6 +587,8 @@ FindBitmapMaskTolerance
function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean; function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;
.. _scriptref-finddeformedbitmaptolerancein:
FindDeformedBitmapToleranceIn FindDeformedBitmapToleranceIn
----------------------------- -----------------------------
@ -473,6 +597,8 @@ FindDeformedBitmapToleranceIn
function FindDeformedBitmapToleranceIn(bitmap: integer; var x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean; function FindDeformedBitmapToleranceIn(bitmap: integer; var x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean;
.. _scriptref-drawtpabitmap:
DrawTPABitmap DrawTPABitmap
------------- -------------
@ -484,6 +610,7 @@ DrawTPABitmap
on the bitmap by setting the pixel on the bitmap (position defined by tpa point) on the bitmap by setting the pixel on the bitmap (position defined by tpa point)
to *color*. to *color*.
.. _scriptref-drawatpabitmap:
DrawATPABitmap DrawATPABitmap
-------------- --------------
@ -497,6 +624,8 @@ Each point in the TPointArray is *painted* on the bitmap by setting
the pixel on the bitmap (position defined by tpa point) the pixel on the bitmap (position defined by tpa point)
to a color. Colors differ per TPointArray (group). to a color. Colors differ per TPointArray (group).
.. _scriptref-drawatpabitmapex:
DrawATPABitmapEx DrawATPABitmapEx
---------------- ----------------
@ -509,6 +638,7 @@ Each point in the TPointArray is *painted* on the bitmap by setting
the pixel on the bitmap (position defined by tpa point) the pixel on the bitmap (position defined by tpa point)
to a color. Colors are defined by *Colors*. to a color. Colors are defined by *Colors*.
.. _scriptref-drawbitmap:
DrawBitmap DrawBitmap
---------- ----------
@ -519,6 +649,8 @@ DrawBitmap
Draw the bitmap to a TCanvas. Draw the bitmap to a TCanvas.
.. _scriptref-rectanglebitmap:
RectangleBitmap RectangleBitmap
--------------- ---------------
@ -527,6 +659,8 @@ RectangleBitmap
procedure RectangleBitmap(bitmap : integer; const box : TBox; Color : TColor); procedure RectangleBitmap(bitmap : integer; const box : TBox; Color : TColor);
.. _scriptref-floodfillbitmap:
FloodFillBitmap FloodFillBitmap
--------------- ---------------
@ -535,6 +669,8 @@ FloodFillBitmap
procedure FloodFillBitmap(bitmap : integer; const StartPoint : TPoint; const SearchCol,ReplaceCol : TColor); procedure FloodFillBitmap(bitmap : integer; const StartPoint : TPoint; const SearchCol,ReplaceCol : TColor);
.. _scriptref-calculatepixelshift:
CalculatePixelShift CalculatePixelShift
------------------- -------------------
@ -543,6 +679,8 @@ CalculatePixelShift
function CalculatePixelShift(Bmp1,Bmp2 : Integer; CompareBox : TBox) : integer; function CalculatePixelShift(Bmp1,Bmp2 : Integer; CompareBox : TBox) : integer;
.. _scriptref-calculatepixeltolerance:
CalculatePixelTolerance CalculatePixelTolerance
----------------------- -----------------------
@ -550,4 +688,3 @@ CalculatePixelTolerance
function CalculatePixelTolerance(Bmp1,Bmp2 : Integer; CompareBox : TBox; CTS : integer) : extended;') function CalculatePixelTolerance(Bmp1,Bmp2 : Integer; CompareBox : TBox; CTS : integer) : extended;')

27
Doc/sphinx/scriptref/colourconverting.rst
View File

@ -1,8 +1,11 @@
.. _scriptref_colourconv: .. _scriptref-colourconv:
Colour Conversions Colour Conversions
================== ==================
..
TODO:
Colour spaces Colour spaces
------------- -------------
@ -12,6 +15,7 @@ Explain some colour spaces here.
Colour Conversion Methods Colour Conversion Methods
------------------------- -------------------------
.. _scriptref-colortorgb:
ColorToRGB ColorToRGB
~~~~~~~~~~ ~~~~~~~~~~
@ -20,6 +24,8 @@ ColorToRGB
procedure ColorToRGB(Color: integer; var r, g, b: Integer); procedure ColorToRGB(Color: integer; var r, g, b: Integer);
.. _scriptref-rgbtocolor:
RGBtoColor RGBtoColor
~~~~~~~~~~ ~~~~~~~~~~
@ -27,6 +33,8 @@ RGBtoColor
function RGBtoColor(r, g, b: Integer): TColor; function RGBtoColor(r, g, b: Integer): TColor;
.. _scriptref-colortohsl:
ColorToHSL ColorToHSL
~~~~~~~~~~ ~~~~~~~~~~
@ -34,6 +42,8 @@ ColorToHSL
procedure ColorToHSL(Color: Integer; var h, s, l: Extended); procedure ColorToHSL(Color: Integer; var h, s, l: Extended);
.. _scriptref-hsltocolor:
HSLToColor HSLToColor
~~~~~~~~~~ ~~~~~~~~~~
@ -41,6 +51,8 @@ HSLToColor
function HSLToColor(H, S, L: Extended): TColor; function HSLToColor(H, S, L: Extended): TColor;
.. _scriptref-colortoxyz:
ColorToXYZ ColorToXYZ
~~~~~~~~~~ ~~~~~~~~~~
@ -48,6 +60,8 @@ ColorToXYZ
procedure ColorToXYZ(Color: Integer; var x, y, z: Extended); procedure ColorToXYZ(Color: Integer; var x, y, z: Extended);
.. _scriptref-xyztocolor:
XYZToColor XYZToColor
~~~~~~~~~~ ~~~~~~~~~~
@ -55,6 +69,8 @@ XYZToColor
function XYZToColor(X, Y, Z: Extended): TColor; function XYZToColor(X, Y, Z: Extended): TColor;
.. _scriptref-rgbtohsl:
RGBToHSL RGBToHSL
~~~~~~~~ ~~~~~~~~
@ -62,6 +78,8 @@ RGBToHSL
procedure RGBToHSL(R, G, B: Integer; var h, s, l: Extended); procedure RGBToHSL(R, G, B: Integer; var h, s, l: Extended);
.. _scriptref-hsltorgb:
HSLtoRGB HSLtoRGB
~~~~~~~~ ~~~~~~~~
@ -69,6 +87,8 @@ HSLtoRGB
procedure HSLtoRGB(H, S, L: extended; var R, G ,B: Integer); procedure HSLtoRGB(H, S, L: extended; var R, G ,B: Integer);
.. _scriptref-rgbtoxyz:
RGBToXYZ RGBToXYZ
~~~~~~~~ ~~~~~~~~
@ -76,6 +96,8 @@ RGBToXYZ
procedure RGBToXYZ(R, G, B: Integer;var x, y ,z: Extended); procedure RGBToXYZ(R, G, B: Integer;var x, y ,z: Extended);
.. _scriptref-xyztorgb:
XYZToRGB XYZToRGB
~~~~~~~~ ~~~~~~~~
@ -83,4 +105,5 @@ XYZToRGB
procedure XYZToRGB(X, Y, Z: Extended; var R, G, B: Integer); procedure XYZToRGB(X, Y, Z: Extended; var R, G, B: Integer);
..
TODO: Add CIE L*a*b.

55
Doc/sphinx/scriptref/colourfinding.rst
View File

@ -37,6 +37,7 @@ components:
a *TPointArray*. a *TPointArray*.
.. note:: .. note::
Other techniques exist, which involve relative point distance from one point Other techniques exist, which involve relative point distance from one point
to another; these are found in the :ref:`scriptref-dtm` section. to another; these are found in the :ref:`scriptref-dtm` section.
@ -51,6 +52,8 @@ Colour Finding Methods
A list of all colour finding methods in Simba. A list of all colour finding methods in Simba.
.. _scriptref-similarcolors:
SimilarColors SimilarColors
~~~~~~~~~~~~~ ~~~~~~~~~~~~~
@ -61,6 +64,8 @@ SimilarColors
SimilarColors returns true if the two passed colours are *similar* given the SimilarColors returns true if the two passed colours are *similar* given the
passed *Tolerance*. passed *Tolerance*.
.. _scriptref-getcolor:
GetColor GetColor
~~~~~~~~ ~~~~~~~~
@ -68,13 +73,19 @@ GetColor
function GetColor(x, y: Integer): Integer; function GetColor(x, y: Integer): Integer;
GetColor returns the color on the coordinate (*x*, *y*). GetColor returns the color on the coordinate *(x, y)*.
*Example: Printing the colour on coordinate (25, 25)* Example printing the colour on coordinate (25, 25).
.. code-block:: pascal .. code-block:: pascal
Writeln('Colour is ' + IntToStr(GetColor(25, 25))) program printcolour;
begin
Writeln('Colour is ' + IntToStr(GetColor(25, 25)))
end.
.. _scriptref-getcolors:
GetColors GetColors
~~~~~~~~~ ~~~~~~~~~
@ -85,6 +96,7 @@ GetColors
GetColors returns an array of the colours at the given *Coords*. GetColors returns an array of the colours at the given *Coords*.
.. _scriptref-countcolor:
CountColor CountColor
~~~~~~~~~~ ~~~~~~~~~~
@ -96,6 +108,8 @@ CountColor
Returns how many times *Color* occurs in the area defined by (*xs*, *ys*), Returns how many times *Color* occurs in the area defined by (*xs*, *ys*),
(*xe*, *ye*) (*xe*, *ye*)
.. _scriptref-countcolortolerance:
CountColorTolerance CountColorTolerance
~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~
@ -106,6 +120,8 @@ CountColorTolerance
Returns how many times *Color* occurs (within *Tolerance*) Returns how many times *Color* occurs (within *Tolerance*)
in the area defined by (*xs*, *ys*), (*xe*, *ye*) in the area defined by (*xs*, *ys*), (*xe*, *ye*)
.. _scriptref-findcolor:
FindColor FindColor
~~~~~~~~~ ~~~~~~~~~
@ -121,6 +137,8 @@ The point is returned in *x* and *y*.
It searches from the top left to the bottom right and will stop It searches from the top left to the bottom right and will stop
after matching a point. after matching a point.
.. _scriptref-findcolortolerance:
FindColorTolerance FindColorTolerance
~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~
@ -134,9 +152,11 @@ FindColorTolerance returns true if a colour within the given tolerance range
*x2*, *y2*. *x2*, *y2*.
Only the first point is returned in *x* and *y*. Only the first point is returned in *x* and *y*.
Whether or not a colour is within the tolerance range is determined by the Whether or not a colour is within the tolerance range is determined by the
:ref:`scriptref_CTS` mode. It searches from the top left to the bottom right :ref:`scriptref-CTS` mode. It searches from the top left to the bottom right
and will stop after matching a point. and will stop after matching a point.
.. _scriptref-findcolors:
FindColors FindColors
~~~~~~~~~~ ~~~~~~~~~~
@ -148,6 +168,8 @@ FindColors returns a list of all points that match the colour *col* in an area
defined by *x1*, *y1*, *x2*, *y2*. It returns true if one or more points have defined by *x1*, *y1*, *x2*, *y2*. It returns true if one or more points have
been found. been found.
.. _scriptref-findcolorstolerance:
FindColorsTolerance FindColorsTolerance
~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~
@ -160,10 +182,12 @@ FindColorsTolerance returns true if at least one point was found.
A point is found if it is within the given tolerance range *tol* A point is found if it is within the given tolerance range *tol*
of the given colour *col* and inside the box defined by *x1*, *y1*, *x2*, *y2*. of the given colour *col* and inside the box defined by *x1*, *y1*, *x2*, *y2*.
Whether or not a color is within the tolerance range is determined by the Whether or not a color is within the tolerance range is determined by the
:ref:`scriptref_CTS` mode. :ref:`scriptref-CTS` mode.
It searches from the top left to the bottom right and will find all It searches from the top left to the bottom right and will find all
matching points in the area. matching points in the area.
.. _scriptref-findcolorspiral:
FindColorSpiral FindColorSpiral
~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~
@ -174,6 +198,8 @@ FindColorSpiral
Same as FindColor, but starts searching from *x*, *y*. Same as FindColor, but starts searching from *x*, *y*.
.. _scriptref-findcolorspiraltolerance:
FindColorSpiralTolerance FindColorSpiralTolerance
~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~
@ -184,6 +210,8 @@ FindColorSpiralTolerance
Same as FindColorTolerance, but starts searching from *x*, *y*. Same as FindColorTolerance, but starts searching from *x*, *y*.
.. _scriptref-findcolorsspiraltolerance:
FindColorsSpiralTolerance FindColorsSpiralTolerance
~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~
@ -194,6 +222,9 @@ FindColorsSpiralTolerance
Same as FindColorsTolerance, but starts searching from *x*, *y*. Same as FindColorsTolerance, but starts searching from *x*, *y*.
.. _scriptref-findcoloredarea:
.. _scriptref-findcoloredareatolerance:
Find areas of colours Find areas of colours
~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~
@ -215,7 +246,7 @@ FindColoredArea finds an area that consists out of Colours that match *Color* wi
the given *Tolerance* and has a minimal size of *MinArea*. the given *Tolerance* and has a minimal size of *MinArea*.
If you want minimal area of 5x5 pixels (25), then set MinArea to 25. If you want minimal area of 5x5 pixels (25), then set MinArea to 25.
.. _scriptref_CTS: .. _scriptref-CTS:
Colour tolerance Colour tolerance
---------------- ----------------
@ -236,6 +267,11 @@ given a tolerance. There are three algorithms, from fastest to slowest:
very little in hue. Luminance is assigned a somewhat static function, and very little in hue. Luminance is assigned a somewhat static function, and
has no modifier. has no modifier.
..
TODO: CIE-Lab
.. _scriptref-gettolerancespeed:
.. _scriptref-setcolortolerancespeed:
Get and Set Colour Tolerance Get and Set Colour Tolerance
~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@ -258,12 +294,15 @@ function, which returns the current colour tolerance speed:
function GetToleranceSpeed: Integer; function GetToleranceSpeed: Integer;
*Example: Printing the Color Tolerance* Example printing the Color Tolerance
.. code-block:: pascal .. code-block:: pascal
Writeln(Format('Tolerance Speed = %d', [GetToleranceSpeed])) Writeln(Format('Tolerance Speed = %d', [GetToleranceSpeed]))
.. _scriptref-settolerancespeed2modifiers:
.. _scriptref-gettolerancespeed2modifiers:
Get And Set Colour Modifiers Get And Set Colour Modifiers
~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@ -287,7 +326,7 @@ The following function
returns colour speed 2 modifiers. returns colour speed 2 modifiers.
*Example: Getting the modifiers* Example getting the modifiers:
.. code-block:: pascal .. code-block:: pascal

81
Doc/sphinx/scriptref/mouseandkeyboard.rst
View File

@ -1,6 +1,9 @@
Mouse and Keyboard Mouse and Keyboard
================== ==================
Simba contains several functions to manipulate the mouse and keyboard.
Features range from clicking and moving the mouse to faking keypresses.
Types Types
----- -----
@ -27,15 +30,43 @@ list.
Mouse Functions Mouse Functions
--------------- ---------------
Simba's coordinate system is similar to most computer coordinate systems.
Coordinate *(0, 0)* is the top-left part of your selected window (the desktop by
default). To get to point *(5, 0)* we move five pixels to the right; to get to
*(5, 5)* we move five pixels to the right, and five pixels down.
Recall that the first value is *x*, the second value is *y*: *(x, y)*
..
TODO: Picture?
MoveMouse MoveMouse
~~~~~~~~~ ~~~~~~~~~
.. _scriptref-movemouse:
.. code-block:: pascal .. code-block:: pascal
procedure MoveMouse(x, y: integer); procedure MoveMouse(x, y: integer);
MoveMouse moves the mouse pointer to the specified x and y coordinates. MoveMouse moves the mouse pointer to the specified x and y coordinates.
The following example will move the mouse to position *(10, 10)*; relative
to the selected client. (To get to point (10, 10) visually, recall that (0, 0)
is the *top left* part and to get to (10, 10) we move 10 pixels to the right,
and ten pixels down.)
.. code-block:: pascal
Program MouseMove;
begin
MoveMouse(10, 10);
end.
.. _scriptref-getmousepos:
GetMousePos GetMousePos
~~~~~~~~~~~ ~~~~~~~~~~~
@ -43,9 +74,23 @@ GetMousePos
procedure GetMousePos(var x, y: integer); procedure GetMousePos(var x, y: integer);
GetMousePos returns the current position of the mouse in x and GetMousePos returns the current position of the mouse in x and y.
y.
The following example moves the mouse 1 pixel to the right, relative to its
current position:
.. code-block:: pascal
Program MouseMoveRelative;
var x, y: integer;
begin
GetMousePos(x, y);
MoveMouse(x + 1, y);
end.
.. _scriptref-holdmouse:
HoldMouse HoldMouse
~~~~~~~~~ ~~~~~~~~~
@ -54,9 +99,14 @@ HoldMouse
procedure HoldMouse(x, y: Integer; clickType: TClickType); procedure HoldMouse(x, y: Integer; clickType: TClickType);
HoldMouse holds the given mouse button (clickType) down at the specified HoldMouse holds the given mouse button specified by clickType down at the
x, y coordinate. If the mouse if not at the given x, y yet, the mouse position specified *(x, y)* coordinate. If the mouse if not at the given
will be set to x, y. (*x, y)* yet, the mouse position will be set to *(x, y)*.
..
TODO: Example
.. _scriptref-releasemouse:
ReleaseMouse ReleaseMouse
~~~~~~~~~~~~ ~~~~~~~~~~~~
@ -69,6 +119,11 @@ HoldMouse holds the given mouse button (clickType) down at the specified
x, y coordinate. If the mouse if not at the given x, y yet, the x, y coordinate. If the mouse if not at the given x, y yet, the
mouse position will be set to x, y. mouse position will be set to x, y.
..
TODO: Example
.. _scriptref-clickmouse:
ClickMouse ClickMouse
~~~~~~~~~~ ~~~~~~~~~~
@ -77,7 +132,9 @@ ClickMouse
procedure ClickMouse(x, y: Integer; clickType: Integer): procedure ClickMouse(x, y: Integer; clickType: Integer):
ClickMouse performs a click with the given mouse button (clickType) at the ClickMouse performs a click with the given mouse button (clickType) at the
specified x, y coordinate. specified *(x, y)* coordinate. This ``click`` equals an immediate click, with no
wait between holding down and releasing the mouse button. To create a more
human-like effect, use the HoldMouse and ReleaseMouse functions.
Keyboard Functions Keyboard Functions
------------------ ------------------
@ -85,18 +142,22 @@ Keyboard Functions
Keyboard functions are obviously used to manipulate the keyboard input. It can Keyboard functions are obviously used to manipulate the keyboard input. It can
also be used to read states of specific keys. also be used to read states of specific keys.
.. _scriptref-keydown:
KeyDown KeyDown
~~~~~~~ ~~~~~~~
.. code-block:: pascal .. code-block:: pascal
procedure KeyDown(key: Word); procedure KeyDown(key: Word);
KeyDown sends a request to the Operating System to "fake" an event that KeyDown sends a request to the Operating System to "fake" an event that
causes the ``key`` to be "down". causes the keyboard ``key`` to be "down".
..
TODO: Example
.. _scriptref-keyup:
KeyUp KeyUp
~~~~~ ~~~~~
@ -108,8 +169,10 @@ KeyUp
KeyDown sends a request to the Operating System to "fake" an event that KeyDown sends a request to the Operating System to "fake" an event that
causes the ``key`` to be "up". causes the ``key`` to be "up".
..
TODO: Example
.. _virtualkeys: .. _scriptref-virtualkeys:
Keyboard Virtual Keys Keyboard Virtual Keys
--------------------- ---------------------

4
Doc/sphinx/scriptref/sound.rst
View File

@ -1,12 +1,12 @@
.. _scriptref_web: .. _scriptref_sound:
Multimedia Functions Multimedia Functions
==================== ====================
Sound Functions Sound Functions
-------------- ---------------
PlaySound PlaySound
~~~~~~~~~ ~~~~~~~~~

1
Doc/sphinx/todo.rst
View File

@ -3,7 +3,6 @@
Documentation TODO Documentation TODO
================== ==================
* **WIP** - What's New. Changelog template added, fill it with stuff.
* *Wizzup* - Script manager (non technical). * *Wizzup* - Script manager (non technical).
* *Wizzup* - Script manager (technical). * *Wizzup* - Script manager (technical).
* Extend "Getting Started". Include downloading scripts from the manager. * Extend "Getting Started". Include downloading scripts from the manager.

3
Doc/sphinx/troubleshooting.rst
View File

@ -23,9 +23,10 @@ Simba crashes on start complaining about settings.xml
This means your settings.xml has become corrupt somehow, or Simba may not be This means your settings.xml has become corrupt somehow, or Simba may not be
able to create it. If a settings.xml exists in your Simba directory, you can able to create it. If a settings.xml exists in your Simba directory, you can
delete it. (All your settings will be lost, but this shouldn't be a bug deal) delete it. (All your settings will be lost, but this shouldn't be a big deal)
Note that this should no longer happen with Simba 750 and up. Note that this should no longer happen with Simba 750 and up.
.. ..
TODO
Anything else? Anything else?

9
Doc/sphinx/whatis.rst
View File

@ -1,3 +1,5 @@
.. _whatis:
What Is Simba? What Is Simba?
============== ==============
@ -22,4 +24,11 @@ Simba can:
and more. Start now by :ref:`installingsimba`. and more. Start now by :ref:`installingsimba`.
Currently Simba is still in its beta stages; this includes the documentation.
You will probably notice some parts of the documentation aren't finished or are just
plain missing.
Simba is being updated almost every day. To see changes as they are added, view
https://github.com/MerlijnWajer/Simba.
If you want to know more about Simba, see :ref:`whysimba` If you want to know more about Simba, see :ref:`whysimba`

10
Doc/sphinx/whatsnew.rst
View File

@ -1,10 +0,0 @@
What's new in Simba?
====================
Currently Simba is still in its beta stages; this includes the documentation.
You will probably notice some parts of the documentation aren't finished or are just
plain missing.
Simba is being updated almost every day. To see changes as they are added, view
https://github.com/MerlijnWajer/Simba. Each commit should be explained
in one line, and the exact changes can be viewed with "commitdiff".

5
Doc/sphinx/whysimba.rst
View File

@ -46,7 +46,7 @@ However this does not guarantee a bug free program.
(Bug free programs don't exist) (Bug free programs don't exist)
Should you encounter a bug, please consider sending a bug report so we can Should you encounter a bug, please consider sending a bug report so we can
resolve the issue: :ref:`bugreport`. try to resolve the issue: :ref:`bugreport`.
Cross Platform Cross Platform
~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~
@ -94,5 +94,4 @@ Well Documented
~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~
Simba is well documented. (You're looking the documentation right now...) Simba is well documented. (You're looking the documentation right now...)
There is still a lot left to document but overall the documentation is pretty There is still a lot left to document though.
good.

15
Extensions/extension.sex Normal file
View File

@ -0,0 +1,15 @@
program ExtUpdater;
{$I ..\Extensions\Updater.sei}
procedure Init;
var
EXT: integer;
begin
Settings.GetKeyValueDef('Extensions_Visible', 'false'); //Default Menu to be hidden =)
AddUpdater('Extensions', 'http://wizzup.org/static/srl/exten.tar.bz2',
'http://wizzup.org/static/srl/exten_version', ScriptPath + {$IFDEF WINDOWS}'\' {$ELSE}'/'{$ENDIF}, True, True, EXT);
end;
function GetName: string; begin Result := 'Extensions Updater'; end;
function GetVersion: string; begin Result := '0.1'; end;
begin end.

2
Extensions/paster.sex
View File

@ -87,7 +87,7 @@ begin
HOST := HOSTDef; HOST := HOSTDef;
if (InputQuery(GetName + ' ' + GetVersion + ' Extension', 'Which ID would you like to grab?', Data)) then if (InputQuery(GetName + ' ' + GetVersion + ' Extension', 'Which ID would you like to grab?', Data)) then
begin begin
if IntToStr(StrToInt(Data)) = Data then if IntToStr(StrToIntDef(Data, -1)) = Data then
Data := '{"paste_id": ' + Data + '}' Data := '{"paste_id": ' + Data + '}'
else else
Data := '{"paste_id": "' + Data + '"}'; Data := '{"paste_id": "' + Data + '"}';

16
Install/windows/Setup.iss
View File

@ -8,9 +8,9 @@
AppId={{524C9B9A-B57F-4FEC-89BE-292202EBA44D} AppId={{524C9B9A-B57F-4FEC-89BE-292202EBA44D}
AppName=Simba AppName=Simba
AppVerName=Simba 0.97 AppVerName=Simba 0.97
AppPublisherURL=http://simba.villavu.com/ AppPublisherURL=http://wizzup.org/simba
AppSupportURL=http://simba.villavu.com/ AppSupportURL=http://wizzup.org/simba
AppUpdatesURL=http://simba.villavu.com/ AppUpdatesURL=http://wizzup.org/simba
DefaultDirName={sd}\Simba DefaultDirName={sd}\Simba
DefaultGroupName=Simba DefaultGroupName=Simba
OutputDir=C:\simba\Install\windows\ OutputDir=C:\simba\Install\windows\
@ -30,11 +30,12 @@ Name: "{app}\Extensions"
Name: "{app}\Includes" Name: "{app}\Includes"
Name: "{app}\Plugins" Name: "{app}\Plugins"
Name: "{app}\Scripts" Name: "{app}\Scripts"
Name: "{app}\Scripts\Tests" ; Name: "{app}\Scripts\Tests"
[Files] [Files]
Source: "C:\Simba\Simba.exe"; DestDir: "{app}"; Flags: ignoreversion Source: "C:\Simba\Simba.exe"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Simba\Extensions\srl.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion Source: "C:\Simba\Extensions\srl.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion
Source: "C:\Simba\Extensions\extension.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion
Source: "C:\Simba\Extensions\msi.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion Source: "C:\Simba\Extensions\msi.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion
Source: "C:\Simba\Extensions\associate.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion Source: "C:\Simba\Extensions\associate.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion
Source: "C:\Simba\Extensions\dtm_editor.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion Source: "C:\Simba\Extensions\dtm_editor.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion
@ -43,8 +44,11 @@ Source: "C:\Simba\Extensions\paster.sex"; DestDir: "{app}\Extensions"; Flags: ig
Source: "C:\Simba\Extensions\CRov.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion Source: "C:\Simba\Extensions\CRov.sex"; DestDir: "{app}\Extensions"; Flags: ignoreversion
Source: "C:\Simba\Extensions\Updater.sei"; DestDir: "{app}\Extensions"; Flags: ignoreversion Source: "C:\Simba\Extensions\Updater.sei"; DestDir: "{app}\Extensions"; Flags: ignoreversion
Source: "C:\Simba\Includes\mml.simba"; DestDir: "{app}\Includes"; Flags: ignoreversion Source: "C:\Simba\Includes\mml.simba"; DestDir: "{app}\Includes"; Flags: ignoreversion
Source: "C:\Simba\Fonts\*"; DestDir: "{app}\Fonts"; Flags: ignoreversion recursesubdirs createallsubdirs ; Source: "C:\Simba\settings.xml"; DestDir: "{app}\"; Flags: ignoreversion
Source: "C:\Simba\Tests\PS\*"; DestDir:"{app}\Scripts\Tests"; Flags: ignoreversion ; XXX Make sure to use a MINIMAL settings.xml XXX
; Source: "C:\Simba\Fonts\*"; DestDir: "{app}\Fonts"; Flags: ignoreversion recursesubdirs createallsubdirs
; Source: "C:\Simba\Tests\PS\*"; DestDir:"{app}\Scripts\Tests"; Flags: ignoreversion
; NOTE: Don't use "Flags: ignoreversion" on any shared system files ; NOTE: Don't use "Flags: ignoreversion" on any shared system files
[Icons] [Icons]

BIN
Projects/MMLBenchmark/project1.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

199
Projects/MMLBenchmark/project1.lpi Normal file
View File

@ -0,0 +1,199 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
</Flags>
<MainUnit Value="0"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
<ActiveWindowIndexAtStart Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1" Active="Default">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<Units Count="6">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="47"/>
<CursorPos X="25" Y="58"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="../../Units/MMLCore/client.pas"/>
<UnitName Value="Client"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="89" Y="10"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../../fpc/packages/fcl-base/src/custapp.pp"/>
<UnitName Value="CustApp"/>
<WindowIndex Value="0"/>
<TopLine Value="42"/>
<CursorPos X="14" Y="63"/>
<UsageCount Value="10"/>
</Unit2>
<Unit3>
<Filename Value="../../Units/MMLCore/bitmaps.pas"/>
<UnitName Value="bitmaps"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="863"/>
<CursorPos X="12" Y="883"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="../../Units/MMLCore/os_linux.pas"/>
<UnitName Value="os_linux"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="9"/>
<CursorPos X="79" Y="32"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="../../Units/MMLCore/colour_conv.pas"/>
<UnitName Value="colour_conv"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="12"/>
<CursorPos X="60" Y="33"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit5>
</Units>
<JumpHistory Count="15" HistoryIndex="14">
<Position1>
<Filename Value="project1.lpr"/>
<Caret Line="34" Column="11" TopLine="13"/>
</Position1>
<Position2>
<Filename Value="project1.lpr"/>
<Caret Line="42" Column="21" TopLine="13"/>
</Position2>
<Position3>
<Filename Value="project1.lpr"/>
<Caret Line="34" Column="11" TopLine="1"/>
</Position3>
<Position4>
<Filename Value="../../Units/MMLCore/bitmaps.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position4>
<Position5>
<Filename Value="../../Units/MMLCore/os_linux.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position5>
<Position6>
<Filename Value="../../Units/MMLCore/os_linux.pas"/>
<Caret Line="34" Column="103" TopLine="8"/>
</Position6>
<Position7>
<Filename Value="../../Units/MMLCore/os_linux.pas"/>
<Caret Line="29" Column="64" TopLine="8"/>
</Position7>
<Position8>
<Filename Value="../../Units/MMLCore/colour_conv.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position8>
<Position9>
<Filename Value="project1.lpr"/>
<Caret Line="10" Column="48" TopLine="1"/>
</Position9>
<Position10>
<Filename Value="project1.lpr"/>
<Caret Line="17" Column="45" TopLine="1"/>
</Position10>
<Position11>
<Filename Value="project1.lpr"/>
<Caret Line="34" Column="19" TopLine="13"/>
</Position11>
<Position12>
<Filename Value="project1.lpr"/>
<Caret Line="40" Column="20" TopLine="25"/>
</Position12>
<Position13>
<Filename Value="../../Units/MMLCore/bitmaps.pas"/>
<Caret Line="27" Column="82" TopLine="1"/>
</Position13>
<Position14>
<Filename Value="project1.lpr"/>
<Caret Line="34" Column="16" TopLine="20"/>
</Position14>
<Position15>
<Filename Value="project1.lpr"/>
<Caret Line="43" Column="32" TopLine="24"/>
</Position15>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="10"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../../Units/MMLCore;../../Units/Linux;../../Units/Misc;$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS);$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType);$(LazarusDir)/components/mouseandkeyinput"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
</Debugging>
</Linking>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

139
Projects/MMLBenchmark/project1.lpr Normal file
View File

@ -0,0 +1,139 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp,
interfaces, // to prevent linking errors. :|
client, MufasaTypes,
lclintf;
type
{ TMMLBenchmark }
TMMLBenchmark = class(TCustomApplication)
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
var
bmp: Integer;
MMLClient: TClient;
{ TMMLBenchmark }
procedure init;
begin
MMLClient := TClient.Create('');
bmp := MMLClient.MBitmaps.CreateBMP(0, 0);
MMLClient.MBitmaps.GetBMP(bmp).LoadFromFile('/home/merlijn/Programs/simba/wall.bmp');
MMLClient.IOManager.SetTarget(MMLClient.MBitmaps[bmp]);
end;
procedure free;
begin
MMLClient.IOManager.SetDesktop;
MMLClient.MBitmaps.FreeBMP(bmp);
MMLClient.Free;
end;
procedure Benchmark;
var
t, t2, t3: PtrUInt;
i, c, w, h: integer;
col, tol: integer;
dummytpa: TPointArray;
begin
init;
t := gettickcount;
MMLClient.IOManager.GetDimensions(w, h);
col := 16777215; tol := 30;
for c := 0 to 2 do // benchmark all CTS'es
begin
MMLClient.MFinder.SetToleranceSpeed(c);
t2 := gettickcount;
for i := 0 to 100 do
begin
MMLClient.MFinder.FindColorsTolerance(dummytpa, col, 0, 0, w-1,h-1, tol);
end;
t3 := gettickcount;
writeln(format('FindColorsTolerance'+#10+
'Time spent: %d ms (per %f ms), matches: %d, CTS: %d, Colour: %d, Tolerance %d',
[t3-t2, (t3-t2) / 100.0, length(dummytpa), c, col, tol]));
end;
free;
end;
procedure TMMLBenchmark.DoRun;
var
ErrorMsg: String;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h','help');
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
// parse parameters
if HasOption('h','help') then begin
WriteHelp;
Terminate;
Exit;
end;
Benchmark;
{ add your program here }
// stop program loop
Terminate;
end;
constructor TMMLBenchmark.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TMMLBenchmark.Destroy;
begin
inherited Destroy;
end;
procedure TMMLBenchmark.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
var
Application: TMMLBenchmark;
{$R *.res}
begin
Application:=TMMLBenchmark.Create(nil);
Application.Run;
Application.Free;
end.

154
Projects/SMARTLoader/project1.lpi Normal file
View File

@ -0,0 +1,154 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
</Flags>
<MainUnit Value="0"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
<ActiveWindowIndexAtStart Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1" Active="Default">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="FCL"/>
</Item1>
</RequiredPackages>
<Units Count="5">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="52"/>
<CursorPos X="3" Y="87"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="../../Units/MMLAddon/plugins.pas"/>
<UnitName Value="plugins"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="6"/>
<CursorPos X="26" Y="37"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../../fpc/rtl/inc/dynlibs.pas"/>
<UnitName Value="dynlibs"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="10"/>
</Unit2>
<Unit3>
<Filename Value="../../Units/Linux/keybinder.pas"/>
<UnitName Value="keybinder"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="61" Y="24"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="../../Units/Linux/xinput.pas"/>
<UnitName Value="xinput"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit4>
</Units>
<JumpHistory Count="6" HistoryIndex="5">
<Position1>
<Filename Value="../../Units/MMLAddon/plugins.pas"/>
<Caret Line="37" Column="26" TopLine="27"/>
</Position1>
<Position2>
<Filename Value="project1.lpr"/>
<Caret Line="69" Column="17" TopLine="40"/>
</Position2>
<Position3>
<Filename Value="project1.lpr"/>
<Caret Line="16" Column="93" TopLine="1"/>
</Position3>
<Position4>
<Filename Value="project1.lpr"/>
<Caret Line="11" Column="10" TopLine="1"/>
</Position4>
<Position5>
<Filename Value="../../Units/MMLAddon/plugins.pas"/>
<Caret Line="37" Column="26" TopLine="6"/>
</Position5>
<Position6>
<Filename Value="project1.lpr"/>
<Caret Line="53" Column="3" TopLine="25"/>
</Position6>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="10"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../../Units/MMLCore"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<PassLinkerOptions Value="True"/>
</Options>
</Linking>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

95
Projects/SMARTLoader/project1.lpr Normal file
View File

@ -0,0 +1,95 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp,
{ you can add units after this }
dynlibs;
const libSmart = 'smart';
procedure std_setup (ServerURL, SecondParam: PChar; sizeX, sizeY: Integer; SomeStr: PChar); cdecl; external libSmart;
type
{ TMyApplication }
TMyApplication = class(TCustomApplication)
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
procedure LoadSmart;
begin
std_setup('http://world19.runescape.com/', 'plugin.js?param=o0,a1,m0', 765, 503, 's');
end;
{ TMyApplication }
procedure TMyApplication.DoRun;
var
ErrorMsg: String;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h','help');
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
// parse parameters
if HasOption('h','help') then begin
WriteHelp;
Terminate;
Exit;
end;
LoadSmart;
sleep(100000);
{ add your program here }
// stop program loop
Terminate;
end;
constructor TMyApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TMyApplication.Destroy;
begin
inherited Destroy;
end;
procedure TMyApplication.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
var
Application: TMyApplication;
//{$R *.res}
begin
Application:=TMyApplication.Create(nil);
Application.Run;
Application.Free;
end.

BIN
Projects/ScriptManager/project1
View File

Binary file not shown.

4
Projects/Simba/Simba.inc
View File

@ -26,11 +26,13 @@
// See Units/Linux/keybinder.pas // See Units/Linux/keybinder.pas
{$ENDIF} {$ENDIF}
//{$DEFINE SIMBA_VERBOSE} // For more verbosity.
//{$DEFINE USE_RUTIS} //{$DEFINE USE_RUTIS}
//{$DEFINE USE_CPASCAL} // TODO //{$DEFINE USE_CPASCAL} // TODO
//{$DEFINE USE_LAPE} // TODO //{$DEFINE USE_LAPE} // TODO
//{$DEFINE USE_EXTENSIONS} // TODO {$DEFINE USE_EXTENSIONS}
//{$DEFINE USE_CODECOMPLETION} // TODO //{$DEFINE USE_CODECOMPLETION} // TODO
//{$DEFINE TERMINALWRITELN} // Only used once. Remove from SimbaUnit? //{$DEFINE TERMINALWRITELN} // Only used once. Remove from SimbaUnit?

25
Projects/Simba/Simba.lpi
View File

@ -35,20 +35,16 @@
<LaunchingApplication PathPlusParams="/usr/bin/gnome-terminal -t 'Lazarus Run Output' -e '$(LazarusDir)/tools/runwait.sh $(TargetCmdLine)'"/> <LaunchingApplication PathPlusParams="/usr/bin/gnome-terminal -t 'Lazarus Run Output' -e '$(LazarusDir)/tools/runwait.sh $(TargetCmdLine)'"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="3"> <RequiredPackages Count="2">
<Item1> <Item1>
<PackageName Value="LCLBase"/>
<MinVersion Major="1" Release="1" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="SynEdit"/> <PackageName Value="SynEdit"/>
<MinVersion Major="1" Valid="True"/> <MinVersion Major="1" Valid="True"/>
</Item2> </Item1>
<Item3> <Item2>
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item3> </Item2>
</RequiredPackages> </RequiredPackages>
<Units Count="48"> <Units Count="50">
<Unit0> <Unit0>
<Filename Value="Simba.lpr"/> <Filename Value="Simba.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -308,10 +304,19 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="os_linux"/> <UnitName Value="os_linux"/>
</Unit47> </Unit47>
<Unit48>
<Filename Value="../../Units/MMLCore/tpa.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="tpa"/>
</Unit48>
<Unit49>
<Filename Value="../../Units/MMLAddon/PSInc/psexportedmethods.inc"/>
<IsPartOfProject Value="True"/>
</Unit49>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="10"/> <Version Value="9"/>
<Target> <Target>
<Filename Value="../../Simba"/> <Filename Value="../../Simba"/>
</Target> </Target>

6
Projects/Simba/Simba.lpr
View File

@ -33,11 +33,11 @@ uses
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
Interfaces, Forms, SimbaUnit, colourhistory, About, internets, debugimage, Interfaces, Forms, SimbaUnit, colourhistory, About, internets, debugimage,
framefunctionlist, simpleanalyzer, updater, updateform, Simbasettings, framefunctionlist, simpleanalyzer, updater, updateform, Simbasettings,
libloader, mufasabase, v_ideCodeInsight, libloader, mufasabase, tpa, v_ideCodeInsight,
PSDump, v_ideCodeParser, PSDump, v_ideCodeParser,
v_AutoCompleteForm, CastaliaPasLex, CastaliaPasLexTypes, CastaliaSimplePasPar, v_AutoCompleteForm, CastaliaPasLex, CastaliaPasLexTypes, CastaliaSimplePasPar,
CastaliaSimplePasParTypes, dcpbase64, mPasLex, v_Constants, v_MiscFunctions, CastaliaSimplePasParTypes, dcpbase64, mPasLex, v_Constants, v_MiscFunctions,
extensionmanagergui, mmisc, bitmapconv; mmisc, bitmapconv;
{$R Simba.res} {$R Simba.res}
@ -48,7 +48,7 @@ begin
Application.CreateForm(TColourHistoryForm, ColourHistoryForm); Application.CreateForm(TColourHistoryForm, ColourHistoryForm);
Application.CreateForm(TAboutForm, AboutForm); Application.CreateForm(TAboutForm, AboutForm);
Application.CreateForm(TDebugImgForm, DebugImgForm); Application.CreateForm(TDebugImgForm, DebugImgForm);
Application.CreateForm(TExtensionsForm, ExtensionsForm); // Application.CreateForm(TExtensionsForm, ExtensionsForm);
Application.CreateForm(TBitmapConvForm, BitmapConvForm); Application.CreateForm(TBitmapConvForm, BitmapConvForm);
// Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm); // Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm);
// Application.CreateForm(TSettingsForm, SettingsForm); Done in FormCreate of MainForm // Application.CreateForm(TSettingsForm, SettingsForm); Done in FormCreate of MainForm

BIN
Projects/Simba/Simba.res
View File

Binary file not shown.

1
Projects/Simba/about.pas
View File

@ -65,6 +65,7 @@ begin
AboutMemo.Lines.Add(format('You are currently using version: %d',[SimbaUnit.SimbaVersion])); AboutMemo.Lines.Add(format('You are currently using version: %d',[SimbaUnit.SimbaVersion]));
AboutMemo.Lines.Add(''); AboutMemo.Lines.Add('');
AboutMemo.Lines.Add('Please report bugs at: http://bugs.villavu.com/'); AboutMemo.Lines.Add('Please report bugs at: http://bugs.villavu.com/');
AboutMemo.ReadOnly:= True;
end; end;
procedure TAboutForm.OkButtonClick(Sender: TObject); procedure TAboutForm.OkButtonClick(Sender: TObject);

1
Projects/Simba/debugimage.pas
View File

@ -110,6 +110,7 @@ begin
Width := DispSize.x; Width := DispSize.x;
Height := DispSize.y; Height := DispSize.y;
end; end;
FormStyle := fsStayOnTop;
end; end;
initialization initialization

11
Projects/Simba/extensionmanager.pas
View File

@ -58,10 +58,15 @@ end;
destructor TExtensionManager.Destroy; destructor TExtensionManager.Destroy;
var var
i: Integer; I, C: Integer;
begin begin
for i := 0 to Extensions.Count - 1 do C := Extensions.Count - 1;
TExtension(Extensions.Items[i]).Free; for I := 0 to C do
begin
TExtension(Extensions.Items[I]).Settings.Free;
TExtension(Extensions.Items[I]).Free;
end;
Extensions.Free; Extensions.Free;
inherited Destroy; inherited Destroy;
end; end;

16
Projects/Simba/framefunctionlist.lfm
View File

@ -12,11 +12,11 @@ object FunctionListFrame: TFunctionListFrame
DesignTop = 200 DesignTop = 200
object FunctionList: TTreeView object FunctionList: TTreeView
Left = 0 Left = 0
Height = 483 Height = 479
Top = 18 Top = 20
Width = 182 Width = 182
Align = alClient Align = alClient
DefaultItemHeight = 15 DefaultItemHeight = 17
ReadOnly = True ReadOnly = True
ScrollBars = ssAutoBoth ScrollBars = ssAutoBoth
TabOrder = 0 TabOrder = 0
@ -28,16 +28,19 @@ object FunctionListFrame: TFunctionListFrame
end end
object editSearchList: TEdit object editSearchList: TEdit
Left = 0 Left = 0
Height = 21 Height = 23
Top = 501 Hint = 'Search ...'
Top = 499
Width = 182 Width = 182
Align = alBottom Align = alBottom
OnChange = editSearchListChange OnChange = editSearchListChange
ParentShowHint = False
ShowHint = True
TabOrder = 1 TabOrder = 1
end end
object FunctionListLabel: TLabel object FunctionListLabel: TLabel
Left = 2 Left = 2
Height = 14 Height = 16
Top = 2 Top = 2
Width = 178 Width = 178
Align = alTop Align = alTop
@ -55,7 +58,6 @@ object FunctionListFrame: TFunctionListFrame
Top = 2 Top = 2
Width = 16 Width = 16
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Color = clBtnFace
Flat = True Flat = True
Glyph.Data = { Glyph.Data = {
36090000424D3609000000000000360000002800000018000000180000000100 36090000424D3609000000000000360000002800000018000000180000000100

3
Projects/Simba/psextension.pas
View File

@ -265,7 +265,7 @@ begin
begin begin
{$I ../../Units/MMLAddon/PSInc/pscompile.inc} {$I ../../Units/MMLAddon/PSInc/pscompile.inc}
AddTypes('TStringArray','Array of String'); AddTypes('TStringArray','Array of String');
AddConstantN('ExtPath','string').SetString(ExtPath); AddConstantN('ExtPath', 'string').SetString({$IFDEF USE_EXTENSIONS}ExtPath{$ELSE}''{$ENDIF});
for i := 0 to high(VirtualKeys) do for i := 0 to high(VirtualKeys) do
AddConstantN(Format('VK_%S',[VirtualKeys[i].Str]),'Byte').SetInt(VirtualKeys[i].Key); AddConstantN(Format('VK_%S',[VirtualKeys[i].Str]),'Byte').SetInt(VirtualKeys[i].Key);
end; end;
@ -329,6 +329,7 @@ begin
FreeScript; FreeScript;
if Assigned(PSInstance) then if Assigned(PSInstance) then
FreeAndNil(PSInstance); FreeAndNil(PSInstance);
Script.Free;
inherited; inherited;
end; end;

55
Projects/Simba/simbaunit.lfm
View File

@ -6,7 +6,7 @@ object SimbaForm: TSimbaForm
ActiveControl = ScriptPanel ActiveControl = ScriptPanel
AllowDropFiles = True AllowDropFiles = True
Caption = 'THA FUKING Simba' Caption = 'THA FUKING Simba'
ClientHeight = 598 ClientHeight = 603
ClientWidth = 660 ClientWidth = 660
KeyPreview = True KeyPreview = True
Menu = MainMenu Menu = MainMenu
@ -208,8 +208,8 @@ object SimbaForm: TSimbaForm
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 21 Height = 23
Top = 577 Top = 580
Width = 660 Width = 660
Panels = < Panels = <
item item
@ -231,7 +231,7 @@ object SimbaForm: TSimbaForm
object PanelMemo: TPanel object PanelMemo: TPanel
Left = 0 Left = 0
Height = 154 Height = 154
Top = 423 Top = 426
Width = 660 Width = 660
Align = alBottom Align = alBottom
ClientHeight = 154 ClientHeight = 154
@ -254,19 +254,19 @@ object SimbaForm: TSimbaForm
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 5 Height = 5
Top = 418 Top = 421
Width = 660 Width = 660
Align = alBottom Align = alBottom
ResizeAnchor = akBottom ResizeAnchor = akBottom
end end
object ScriptPanel: TPanel object ScriptPanel: TPanel
Left = 0 Left = 0
Height = 394 Height = 397
Top = 24 Top = 24
Width = 660 Width = 660
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 394 ClientHeight = 397
ClientWidth = 660 ClientWidth = 660
DockSite = True DockSite = True
TabOrder = 4 TabOrder = 4
@ -274,7 +274,7 @@ object SimbaForm: TSimbaForm
OnDockOver = ScriptPanelDockOver OnDockOver = ScriptPanelDockOver
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 155 Left = 155
Height = 359 Height = 362
Top = 0 Top = 0
Width = 505 Width = 505
Align = alClient Align = alClient
@ -293,7 +293,7 @@ object SimbaForm: TSimbaForm
object SearchPanel: TPanel object SearchPanel: TPanel
Left = 0 Left = 0
Height = 35 Height = 35
Top = 359 Top = 362
Width = 660 Width = 660
Align = alBottom Align = alBottom
BevelOuter = bvSpace BevelOuter = bvSpace
@ -389,7 +389,7 @@ object SimbaForm: TSimbaForm
end end
object LabeledEditSearch: TLabeledEdit object LabeledEditSearch: TLabeledEdit
Left = 104 Left = 104
Height = 27 Height = 23
Top = 6 Top = 6
Width = 80 Width = 80
EditLabel.AnchorSideLeft.Control = LabeledEditSearch EditLabel.AnchorSideLeft.Control = LabeledEditSearch
@ -397,10 +397,17 @@ object SimbaForm: TSimbaForm
EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = LabeledEditSearch EditLabel.AnchorSideRight.Control = LabeledEditSearch
EditLabel.AnchorSideBottom.Control = LabeledEditSearch EditLabel.AnchorSideBottom.Control = LabeledEditSearch
<<<<<<< HEAD
EditLabel.Left = 64 EditLabel.Left = 64
EditLabel.Height = 18 EditLabel.Height = 18
EditLabel.Top = 10 EditLabel.Top = 10
EditLabel.Width = 37 EditLabel.Width = 37
=======
EditLabel.Left = 71
EditLabel.Height = 16
EditLabel.Top = 9
EditLabel.Width = 30
>>>>>>> upstream/master
EditLabel.Caption = 'Find: ' EditLabel.Caption = 'Find: '
EditLabel.ParentColor = False EditLabel.ParentColor = False
LabelPosition = lpLeft LabelPosition = lpLeft
@ -415,7 +422,11 @@ object SimbaForm: TSimbaForm
Left = 320 Left = 320
Height = 24 Height = 24
Top = 7 Top = 7
<<<<<<< HEAD
Width = 101 Width = 101
=======
Width = 80
>>>>>>> upstream/master
Caption = 'Match case' Caption = 'Match case'
OnClick = CheckBoxMatchCaseClick OnClick = CheckBoxMatchCaseClick
TabOrder = 1 TabOrder = 1
@ -423,16 +434,16 @@ object SimbaForm: TSimbaForm
end end
object SplitterFunctionList: TSplitter object SplitterFunctionList: TSplitter
Left = 150 Left = 150
Height = 359 Height = 362
Top = 0 Top = 0
Width = 5 Width = 5
OnCanResize = SplitterFunctionListCanResize OnCanResize = SplitterFunctionListCanResize
Visible = False Visible = False
end end
inline frmFunctionList: TFunctionListFrame inline frmFunctionList: TFunctionListFrame
Height = 359 Height = 362
Width = 150 Width = 150
ClientHeight = 359 ClientHeight = 362
ClientWidth = 150 ClientWidth = 150
OnEndDock = nil OnEndDock = nil
TabOrder = 3 TabOrder = 3
@ -441,22 +452,29 @@ object SimbaForm: TSimbaForm
Width = 146 Width = 146
end end
inherited FunctionList: TTreeView inherited FunctionList: TTreeView
Height = 310 Height = 319
Top = 22 Top = 20
Width = 150 Width = 150
DefaultItemHeight = 19 DefaultItemHeight = 17
OnChange = FunctionListChange OnChange = FunctionListChange
OnEnter = FunctionListEnter OnEnter = FunctionListEnter
OnExit = FunctionListExit OnExit = FunctionListExit
end end
inherited editSearchList: TEdit inherited editSearchList: TEdit
Height = 27 Height = 23
Top = 332 Top = 339
Width = 150 Width = 150
OnExit = editSearchListExit OnExit = editSearchListExit
OnKeyDown = editSearchListKeyDown OnKeyDown = editSearchListKeyDown
OnKeyPress = editSearchListKeyPress OnKeyPress = editSearchListKeyPress
end end
<<<<<<< HEAD
=======
inherited FunctionListLabel: TLabel
Height = 16
Width = 146
end
>>>>>>> upstream/master
end end
end end
object MainMenu: TMainMenu object MainMenu: TMainMenu
@ -3013,6 +3031,7 @@ object SimbaForm: TSimbaForm
Caption = '&Extensions' Caption = '&Extensions'
OnExecute = ActionExtensionsExecute OnExecute = ActionExtensionsExecute
OnUpdate = ActionExtensionsUpdate OnUpdate = ActionExtensionsUpdate
Visible = False
end end
object ActionPascalScript: TAction object ActionPascalScript: TAction
Caption = 'PascalScript' Caption = 'PascalScript'

109
Projects/Simba/simbaunit.pas
View File

@ -51,8 +51,9 @@ uses
SynExportHTML, SynEditKeyCmds, SynEditHighlighter, SynExportHTML, SynEditKeyCmds, SynEditHighlighter,
SynEditMarkupHighAll, LMessages, Buttons, SynEditMarkupHighAll, LMessages, Buttons,
mmisc, stringutil,mufasatypesutil, mufasabase, mmisc, stringutil,mufasatypesutil, mufasabase,
about, framefunctionlist, ocr, updateform, Simbasettings, psextension, virtualextension, about, framefunctionlist, ocr, updateform, Simbasettings,
extensionmanager, settingssandbox, {$IFDEF USE_EXTENSIONS}psextension, virtualextension, extensionmanager,{$ENDIF}
settingssandbox,
v_ideCodeParser, v_ideCodeInsight, CastaliaPasLexTypes, // Code completion units v_ideCodeParser, v_ideCodeInsight, CastaliaPasLexTypes, // Code completion units
CastaliaSimplePasPar, v_AutoCompleteForm, // Code completion units CastaliaSimplePasPar, v_AutoCompleteForm, // Code completion units
@ -61,7 +62,7 @@ uses
settings, updater; settings, updater;
const const
SimbaVersion = 830; SimbaVersion = 972;
interp_PS = 0; //PascalScript interp_PS = 0; //PascalScript
interp_RT = 1; //RUTIS interp_RT = 1; //RUTIS
@ -410,6 +411,7 @@ type
OpenFileData : TOpenFileData; OpenFileData : TOpenFileData;
WriteFileData : TWriteFileData; WriteFileData : TWriteFileData;
ScriptStartData : TScriptStartData; ScriptStartData : TScriptStartData;
procedure UpdateInterpreter; procedure UpdateInterpreter;
procedure HandleConnectionData; procedure HandleConnectionData;
procedure HandleOpenFileData; procedure HandleOpenFileData;
@ -418,7 +420,7 @@ type
function GetInterpreter: Integer; function GetInterpreter: Integer;
function GetDefScriptPath: string; function GetDefScriptPath: string;
function GetScriptPath : string; function GetScriptPath : string;
function GetExtPath: string; {$IFDEF USE_EXTENSIONS}function GetExtPath: string;{$ENDIF}
function GetFontPath: String; function GetFontPath: String;
function GetHighlighter: TSynCustomHighlighter; function GetHighlighter: TSynCustomHighlighter;
function GetIncludePath: String; function GetIncludePath: String;
@ -428,7 +430,7 @@ type
function GetShowCodeCompletionAuto: Boolean; function GetShowCodeCompletionAuto: Boolean;
function GetSimbaNews: String; function GetSimbaNews: String;
procedure SetDefScriptPath(const AValue: string); procedure SetDefScriptPath(const AValue: string);
procedure SetExtPath(const AValue: string); {$IFDEF USE_EXTENSIONS}procedure SetExtPath(const AValue: string);{$ENDIF}
procedure SetFontPath(const AValue: String); procedure SetFontPath(const AValue: String);
procedure SetIncludePath(const AValue: String); procedure SetIncludePath(const AValue: String);
procedure SetInterpreter(const AValue: Integer); procedure SetInterpreter(const AValue: Integer);
@ -501,7 +503,7 @@ type
property IncludePath : String read GetIncludePath write SetIncludePath; property IncludePath : String read GetIncludePath write SetIncludePath;
property FontPath : String read GetFontPath write SetFontPath; property FontPath : String read GetFontPath write SetFontPath;
property PluginPath : string read GetPluginPath write SetPluginPath; property PluginPath : string read GetPluginPath write SetPluginPath;
property ExtPath : string read GetExtPath write SetExtPath; {$IFDEF USE_EXTENSIONS}property ExtPath : string read GetExtPath write SetExtPath;{$ENDIF}
property ScriptDir : string read GetScriptPath write SetScriptPath; property ScriptDir : string read GetScriptPath write SetScriptPath;
property DefScriptPath : string read GetDefScriptPath write SetDefScriptPath; property DefScriptPath : string read GetDefScriptPath write SetDefScriptPath;
property CurrHighlighter : TSynCustomHighlighter read GetHighlighter; property CurrHighlighter : TSynCustomHighlighter read GetHighlighter;
@ -545,7 +547,7 @@ uses
InterfaceBase, InterfaceBase,
bitmapconv, bitmapconv,
bitmaps, bitmaps,
extensionmanagergui, {$IFDEF USE_EXTENSIONS}extensionmanagergui,{$ENDIF}
colourhistory, colourhistory,
math math
@ -744,6 +746,7 @@ begin
end; end;
procedure TSimbaForm.HandleConnectionData; procedure TSimbaForm.HandleConnectionData;
{$IFDEF USE_EXTENSIONS}
var var
Args : TVariantArray; Args : TVariantArray;
begin begin
@ -758,6 +761,9 @@ begin
on e : Exception do on e : Exception do
mDebugLn('ERROR in HandleConnectiondata: ' + e.message); mDebugLn('ERROR in HandleConnectiondata: ' + e.message);
end; end;
{$ELSE}
begin
{$ENDIF}
end; end;
function TSimbaForm.GetInterpreter: Integer; function TSimbaForm.GetInterpreter: Integer;
@ -781,6 +787,7 @@ begin
end; end;
procedure TSimbaForm.HandleOpenFileData; procedure TSimbaForm.HandleOpenFileData;
{$IFDEF USE_EXTENSIONS}
var var
Args : TVariantArray; Args : TVariantArray;
begin begin
@ -795,9 +802,13 @@ begin
on e : Exception do on e : Exception do
mDebugLn('ERROR in HandleOpenFileData: ' + e.message); mDebugLn('ERROR in HandleOpenFileData: ' + e.message);
end; end;
{$ELSE}
begin
{$ENDIF}
end; end;
procedure TSimbaForm.HandleWriteFileData; procedure TSimbaForm.HandleWriteFileData;
{$IFDEF USE_EXTENSIONS}
var var
Args : TVariantArray; Args : TVariantArray;
begin begin
@ -812,9 +823,13 @@ begin
on e : Exception do on e : Exception do
mDebugLn('ERROR in HandleWriteFileData: ' + e.message); mDebugLn('ERROR in HandleWriteFileData: ' + e.message);
end; end;
{$ELSE}
begin
{$ENDIF}
end; end;
procedure TSimbaForm.HandleScriptStartData; procedure TSimbaForm.HandleScriptStartData;
{$IFDEF USE_EXTENSIONS}
var var
Args : TVariantArray; Args : TVariantArray;
begin begin
@ -829,6 +844,9 @@ begin
on e : Exception do on e : Exception do
mDebugLn('ERROR in HandleScriptStartData: ' + e.message); mDebugLn('ERROR in HandleScriptStartData: ' + e.message);
end; end;
{$ELSE}
begin
{$ENDIF}
end; end;
procedure TSimbaForm.ProcessDebugStream(Sender: TObject); procedure TSimbaForm.ProcessDebugStream(Sender: TObject);
@ -1361,7 +1379,7 @@ begin
CreateSetting('Settings/CodeHints/ShowAutomatically','True'); CreateSetting('Settings/CodeHints/ShowAutomatically','True');
CreateSetting('Settings/CodeCompletion/ShowAutomatically','True'); CreateSetting('Settings/CodeCompletion/ShowAutomatically','True');
CreateSetting('Settings/SourceEditor/LazColors','True'); CreateSetting('Settings/SourceEditor/LazColors','True');
CreateSetting('Settings/Extensions/FileExtension','sex'); {$IFDEF USE_EXTENSIONS}CreateSetting('Settings/Extensions/FileExtension','sex');{$ENDIF}
CreateSetting('Settings/Updater/RemoteLink',SimbaURL + 'Simba'{$IFDEF WINDOWS} +'.exe'{$ENDIF}); CreateSetting('Settings/Updater/RemoteLink',SimbaURL + 'Simba'{$IFDEF WINDOWS} +'.exe'{$ENDIF});
CreateSetting('Settings/Updater/RemoteVersionLink',SimbaURL + 'Version'); CreateSetting('Settings/Updater/RemoteVersionLink',SimbaURL + 'Version');
@ -1372,8 +1390,10 @@ begin
{Creates the paths and returns the path} {Creates the paths and returns the path}
PluginsPath := CreateSetting('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS)); PluginsPath := CreateSetting('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS));
{$IFDEF USE_EXTENSIONS}
extensionsPath := CreateSetting('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS)); extensionsPath := CreateSetting('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS));
CreateSetting('Extensions/ExtensionCount','0'); CreateSetting('Extensions/ExtensionCount','0');
{$ENDIF}
CreateSetting('LastConfig/MainForm/Position',''); CreateSetting('LastConfig/MainForm/Position','');
CreateSetting('LastConfig/MainForm/State','Normal'); CreateSetting('LastConfig/MainForm/State','Normal');
{$ifdef MSWindows} {$ifdef MSWindows}
@ -1387,10 +1407,12 @@ begin
CreateDir(FontPath); CreateDir(FontPath);
if not DirectoryExists(PluginsPath) then if not DirectoryExists(PluginsPath) then
CreateDir(PluginsPath); CreateDir(PluginsPath);
{$IFDEF USE_EXTENSIONS}
if not DirectoryExists(extensionsPath) then if not DirectoryExists(extensionsPath) then
CreateDir(extensionsPath); CreateDir(extensionsPath);
if not DirectoryExists(ExtPath) then if not DirectoryExists(ExtPath) then
CreateDir(ExtPath); CreateDir(ExtPath);
{$ENDIF}
if not DirectoryExists(ScriptDir) then if not DirectoryExists(ScriptDir) then
CreateDir(ScriptDir); CreateDir(ScriptDir);
SettingsForm.SettingsTreeView.Items.GetFirstNode.Expand(false); SettingsForm.SettingsTreeView.Items.GetFirstNode.Expand(false);
@ -1491,19 +1513,21 @@ begin
else else
SetSetting('LastConfig/Console/Visible','False'); SetSetting('LastConfig/Console/Visible','False');
{$endif} {$endif}
{$IFDEF USE_EXTENSIONS}
SetSetting('Extensions/ExtensionCount',inttostr(ExtManager.Extensions.Count)); SetSetting('Extensions/ExtensionCount',inttostr(ExtManager.Extensions.Count));
for i := 0 to ExtManager.Extensions.Count-1 do for i := 0 to ExtManager.Extensions.Count-1 do
begin; begin;
path :='Extensions/Extension' + inttostr(I); path :='Extensions/Extension' + inttostr(I);
SetSetting(Path + '/Path',TVirtualSimbaExtension(ExtManager.Extensions[i]).Filename); SetSetting(Path + '/Path',TVirtualSimbaExtension(ExtManager.Extensions[i]).Filename);
SetSetting(Path + '/Enabled',BoolToStr(TVirtualSimbaExtension(ExtManager.Extensions[i]).Enabled,True)); SetSetting(Path + '/Enabled',BoolToStr(TVirtualSimbaExtension(ExtManager.Extensions[i]).Enabled,True));
end; end;
{$ENDIF}
SaveToXML(SimbaSettingsFile); SaveToXML(SimbaSettingsFile);
end; end;
end; end;
procedure TSimbaForm.LoadExtensions; procedure TSimbaForm.LoadExtensions;
{$IFDEF USE_EXTENSIONS}
var var
extCount : integer; extCount : integer;
function LoadExtension(Number : integer) : boolean; function LoadExtension(Number : integer) : boolean;
@ -1551,6 +1575,9 @@ begin
str := LoadSettingDef('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS)); str := LoadSettingDef('Settings/Extensions/Path',ExpandFileName(MainDir +DS + 'Extensions' + DS));
str2 := LoadSettingDef('Settings/Extensions/FileExtension','sex'); str2 := LoadSettingDef('Settings/Extensions/FileExtension','sex');
ExtManager.LoadPSExtensionsDir(str,str2); ExtManager.LoadPSExtensionsDir(str,str2);
{$ELSE}
begin
{$ENDIF}
end; end;
procedure TSimbaForm.AddRecentFile(const filename: string); procedure TSimbaForm.AddRecentFile(const filename: string);
@ -1648,26 +1675,30 @@ begin
Thread.Client.IOManager.SetTarget(Selector.LastPick); Thread.Client.IOManager.SetTarget(Selector.LastPick);
loadFontsOnScriptStart := (lowercase(LoadSettingDef('Settings/Fonts/LoadOnStartUp', 'True')) = 'true'); loadFontsOnScriptStart := (lowercase(LoadSettingDef('Settings/Fonts/LoadOnStartUp', 'True')) = 'true');
// Copy our current fonts
if not assigned(Self.OCR_Fonts) and loadFontsOnScriptStart and DirectoryExists(fontPath) then if (loadFontsOnScriptStart) then
begin begin
Self.OCR_Fonts := TMOCR.Create(Thread.Client); if ((not (Assigned(OCR_Fonts))) and DirectoryExists(fontPath)) then
OCR_Fonts.InitTOCR(fontPath); begin
Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts OCR_Fonts := TMOCR.Create(Thread.Client);
end else OCR_Fonts.InitTOCR(fontPath);
if assigned(Self.OCR_Fonts) and loadFontsOnScriptStart then end;
if (Assigned(OCR_Fonts)) then
Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts; Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts;
end;
{ {
We pass the entire settings to the script; it will then create a Sandbox We pass the entire settings to the script; it will then create a Sandbox
for settings that are exported to the script. This way we can access all for settings that are exported to the script. This way we can access all
the settings from the PSTHread, and scripts can only access limited the settings from the PSThread, and scripts can only access limited
resources. Hopefully this won't cause any form / thread related problems? resources. Hopefully this won't cause any form / thread related problems?
(Settings doesn't use the Settings form, iirc) (Settings doesn't use the Settings form, iirc)
Well, it was like this previously as well, we just passed a sandbox to it Well, it was like this previously as well, we just passed a sandbox to it
directly, but the sandbox still called Settings. directly, but the sandbox still called Settings.
} }
Thread.SetSettings(SettingsForm.Settings, SimbaSettingsFile); Thread.SetSettings(SettingsForm.Settings, SimbaSettingsFile);
Thread.OpenConnectionEvent:=@ThreadOpenConnectionEvent; Thread.OpenConnectionEvent:=@ThreadOpenConnectionEvent;
Thread.WriteFileEvent:=@ThreadWriteFileEvent; Thread.WriteFileEvent:=@ThreadWriteFileEvent;
Thread.OpenFileEvent:=@ThreadOpenFileEvent; Thread.OpenFileEvent:=@ThreadOpenFileEvent;
@ -1830,15 +1861,17 @@ end;
procedure TSimbaForm.ActionExtensionsExecute(Sender: TObject); procedure TSimbaForm.ActionExtensionsExecute(Sender: TObject);
begin begin
{$IFDEF USE_EXTENSIONS}
if not ExtensionsForm.Showing then if not ExtensionsForm.Showing then
ExtensionsForm.Show ExtensionsForm.Show
else else
ExtensionsForm.Hide; ExtensionsForm.Hide;
{$ENDIF}
end; end;
procedure TSimbaForm.ActionExtensionsUpdate(Sender: TObject); procedure TSimbaForm.ActionExtensionsUpdate(Sender: TObject);
begin begin
TAction(Sender).Checked := ExtensionsForm.Showing; {$IFDEF USE_EXTENSIONS}TAction(Sender).Checked := ExtensionsForm.Showing;{$ENDIF}
end; end;
procedure TSimbaForm.ActionFindNextExecute(Sender: TObject); procedure TSimbaForm.ActionFindNextExecute(Sender: TObject);
@ -2308,7 +2341,7 @@ begin
end; end;
FunctionListTimer.Enabled:= false; FunctionListTimer.Enabled:= false;
CloseAction := caFree; CloseAction := caFree;
FreeAndNil(ExtManager); {$IFDEF USE_EXTENSIONS}FreeAndNil(ExtManager);{$ENDIF}
end; end;
procedure CCFillCore; procedure CCFillCore;
@ -2410,6 +2443,7 @@ begin
UpdateTimer.OnTimer:= @UpdateTimerCheck; UpdateTimer.OnTimer:= @UpdateTimerCheck;
Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm); Application.CreateForm(TSimbaUpdateForm, SimbaUpdateForm);
{$IFDEF USE_EXTENSIONS}Application.CreateForm(TExtensionsForm, ExtensionsForm);{$ENDIF}
if FileExistsUTF8(SimbaSettingsFile) then if FileExistsUTF8(SimbaSettingsFile) then
begin begin
@ -2464,13 +2498,15 @@ begin
FillThread.Resume; FillThread.Resume;
//Load the extensions //Load the extensions
LoadExtensions; {$IFDEF USE_EXTENSIONS}LoadExtensions;{$ENDIF}
UpdateTitle; UpdateTitle;
{$IFNDEF USE_RUTIS} {$IFNDEF USE_RUTIS}
MenuItemRUTIS.Enabled:=False; MenuItemRUTIS.Enabled:=False;
{$ENDIF} {$ENDIF}
{$IFDEF USE_EXTENSIONS}ActionExtensions.Visible := True;{$ENDIF}
self.EndFormUpdate; self.EndFormUpdate;
if SettingsForm.Oops then if SettingsForm.Oops then
@ -2488,8 +2524,10 @@ begin
for i := 0 to high(RecentFileItems) do for i := 0 to high(RecentFileItems) do
RecentFileItems[i].Free; RecentFileItems[i].Free;
if ExtManager <> nil then {$IFDEF USE_EXTENSIONS}
FreeAndNil(extmanager); if ExtManager <> nil then
FreeAndNil(extmanager);
{$ENDIF}
Tabs.Free; Tabs.Free;
@ -2501,6 +2539,10 @@ begin
{ Free the plugins } { Free the plugins }
PluginsGlob.Free; PluginsGlob.Free;
{ Free Fonts }
if (Assigned(OCR_Fonts)) then
OCR_Fonts.Free;
SetLength(DebugStream, 0); SetLength(DebugStream, 0);
DebugCriticalSection.Free; DebugCriticalSection.Free;
@ -2795,10 +2837,12 @@ begin
SetSetting('Settings/SourceEditor/DefScriptPath',AValue,True); SetSetting('Settings/SourceEditor/DefScriptPath',AValue,True);
end; end;
{$IFDEF USE_EXTENSIONS}
procedure TSimbaForm.SetExtPath(const AValue: string); procedure TSimbaForm.SetExtPath(const AValue: string);
begin begin
SetSetting('Settings/Extensions/Path',AValue,true); SetSetting('Settings/Extensions/Path',AValue,true);
end; end;
{$ENDIF}
procedure TSimbaForm.NewsTimerTimer(Sender: TObject); procedure TSimbaForm.NewsTimerTimer(Sender: TObject);
var var
@ -2828,6 +2872,11 @@ var
c, x, y: Integer; c, x, y: Integer;
cobj: TColourPickerObject; cobj: TColourPickerObject;
begin begin
if Picker.Picking then
begin
formWriteln('Error: Already picking a colour');
exit;
end;
Picker.Pick(c, x, y); Picker.Pick(c, x, y);
cobj := TColourPickerObject.Create(c, Classes.Point(x,y), ''); cobj := TColourPickerObject.Create(c, Classes.Point(x,y), '');
@ -2928,6 +2977,7 @@ end;
procedure TSimbaForm.PickerPick(Sender: TObject; const Colour, colourx, procedure TSimbaForm.PickerPick(Sender: TObject; const Colour, colourx,
coloury: integer); coloury: integer);
{$IFDEF USE_EXTENSIONS}
var var
Args : TVariantArray; Args : TVariantArray;
begin begin
@ -2936,6 +2986,9 @@ begin
Args[1] := Colourx; Args[1] := Colourx;
Args[2] := Coloury; Args[2] := Coloury;
ExtManager.HandleHook(EventHooks[SExt_OnColourPick].HookName,Args); ExtManager.HandleHook(EventHooks[SExt_OnColourPick].HookName,Args);
{$ELSE}
begin
{$ENDIF}
end; end;
procedure TSimbaForm.PopupItemFindClick(Sender: TObject); procedure TSimbaForm.PopupItemFindClick(Sender: TObject);
@ -2969,10 +3022,12 @@ begin
Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Fonts/Path', ExpandFileName(MainDir+DS+'Fonts' + DS))); Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Fonts/Path', ExpandFileName(MainDir+DS+'Fonts' + DS)));
end; end;
{$IFDEF USE_EXTENSIONS}
function TSimbaForm.GetExtPath: string; function TSimbaForm.GetExtPath: string;
begin begin
result :=IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Extensions/Path', ExpandFileName(MainDir+DS+'Extensions' + DS))); Result := IncludeTrailingPathDelimiter(LoadSettingDef('Settings/Extensions/Path', ExpandFileName(MainDir+DS+'Extensions' + DS)));
end; end;
{$ENDIF}
function TSimbaForm.GetHighlighter: TSynCustomHighlighter; function TSimbaForm.GetHighlighter: TSynCustomHighlighter;
begin begin
@ -3122,7 +3177,6 @@ begin
if Assigned(self.OCR_Fonts) then if Assigned(self.OCR_Fonts) then
self.OCR_Fonts.Free; self.OCR_Fonts.Free;
FormWriteln('Freeing the current fonts. Creating new ones now'); FormWriteln('Freeing the current fonts. Creating new ones now');
// XXX: Can this cause problems when running scripts?
Self.OCR_Fonts := TMOCR.Create(nil); Self.OCR_Fonts := TMOCR.Create(nil);
OCR_Fonts.InitTOCR(fontPath); OCR_Fonts.InitTOCR(fontPath);
end; end;
@ -3292,7 +3346,8 @@ begin
else else
InitialDir := ScriptDir; InitialDir := ScriptDir;
Options := [ofAllowMultiSelect, ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofEnableSizing, ofViewDetail]; Options := [ofAllowMultiSelect, ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofEnableSizing, ofViewDetail];
Filter:= 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.' +LoadSettingDef('Settings/Extensions/FileExtension','sex')+ Filter:= 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt' +
{$IFDEF USE_EXTENSIONS}';*.' + LoadSettingDef('Settings/Extensions/FileExtension', 'sex') + {$ENDIF}
'|Any files|*.*'; '|Any files|*.*';
if Execute then if Execute then
begin begin
@ -3399,8 +3454,8 @@ begin
InitialDir := ExtractFileDir(CurrScript.ScriptFile) InitialDir := ExtractFileDir(CurrScript.ScriptFile)
else else
InitialDir := ScriptDir; InitialDir := ScriptDir;
filter := 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt;*.' + filter := 'Simba Files|*.simba;*.simb;*.cogat;*.mufa;*.txt' +
LoadSettingDef('Settings/Extensions/FileExtension','sex')+ {$IFDEF USE_EXTENSIONS}';*.' + LoadSettingDef('Settings/Extensions/FileExtension','sex') + {$ENDIF}
'|Any files|*.*'; '|Any files|*.*';
if Execute then if Execute then
begin; begin;

3
Projects/Simba/updateform.pas
View File

@ -251,7 +251,8 @@ begin
end; end;
end; end;
FDone := True; FDone := True;
Self.UpdateButton.Caption := 'Update!'; Self.UpdateButton.Caption := 'Updated!';
Self.UpdateButton.Enabled := False;
Self.CloseButton.Enabled := true; Self.CloseButton.Enabled := true;
FUpdating:= false; FUpdating:= false;
end; end;

683
Projects/libmml/libmml.lpr
View File

@ -15,6 +15,11 @@ Const
MOUSE_UP = 0; MOUSE_UP = 0;
MOUSE_DOWN = 1; MOUSE_DOWN = 1;
{
Global variables.
To actually read the last_error, make sure you copy it to a safe place
directly after the function call.
}
var var
last_error: String; last_error: String;
debug: boolean; debug: boolean;
@ -23,28 +28,28 @@ var
function init: integer; cdecl; function init: integer; cdecl;
begin begin
last_error := ''; last_error := '';
debug := true; debug := true;
result := RESULT_OK; result := RESULT_OK;
end; end;
procedure set_last_error(s: string); procedure set_last_error(s: string);
begin begin
last_error := s; last_error := s;
if debug then if debug then
writeln('ERROR: ' + s); writeln('ERROR: ' + s);
end; end;
{ Validate the TClient. If it is NULL, set last error and return false } { Validate the TClient. If it is NULL, set last error and return false }
function validate_client(C: TClient): boolean; inline; function validate_client(C: TClient): boolean; inline;
begin begin
result := Assigned(C); result := Assigned(C);
if not result then if not result then
begin begin
last_error := 'PClient is NULL'; last_error := 'PClient is NULL';
if debug then if debug then
writeln(last_error); writeln(last_error);
end; end;
end; end;
{ {
@ -55,42 +60,42 @@ function create_client: PtrUInt; cdecl;
var var
C: TClient; C: TClient;
begin begin
try try
C := TClient.Create(''); C := TClient.Create('');
Result := PtrUInt(C); Result := PtrUInt(C);
except on e : Exception do except on e : Exception do
begin begin
// FIXME UINT negative // FIXME UINT negative
result := PtrUInt(RESULT_ERROR); result := PtrUInt(RESULT_ERROR);
set_last_error(e.message); set_last_error(e.message);
end; end;
end; end;
writeln(format('C: %d, IOManager: %d', [PtrUInt(C), PtrUInt(C.IOManager)])); writeln(format('C: %d, IOManager: %d', [PtrUInt(C), PtrUInt(C.IOManager)]));
end; end;
{ Destroy a TClient } { Destroy a TClient }
function destroy_client(C: TClient): integer; cdecl; function destroy_client(C: TClient): integer; cdecl;
begin begin
try try
C.Free; C.Free;
except on e : Exception do except on e : Exception do
begin begin
result := RESULT_ERROR; result := RESULT_ERROR;
set_last_error(e.message); set_last_error(e.message);
end; end;
end; end;
end; end;
{ Set (verbose) debug on/off } { Set (verbose) debug on/off }
procedure set_debug(v: Boolean); cdecl; procedure set_debug(v: Boolean); cdecl;
begin begin
debug := v; debug := v;
end; end;
{ Get debug } { Get debug }
function get_debug: boolean; cdecl; function get_debug: boolean; cdecl;
begin begin
exit(debug); exit(debug);
end; end;
{ {
@ -101,40 +106,40 @@ end;
} }
function get_last_error: pchar; cdecl; function get_last_error: pchar; cdecl;
begin begin
exit(@last_error[1]); exit(@last_error[1]);
end; end;
{ Turn an array into a pointer. The pointer memory is not managed by FPC, so we can pass { Turn an array into a pointer. The pointer memory is not managed by FPC, so we can pass
it along happily. It'll have to be freed by the external control though } it along happily. It'll have to be freed by the external control though }
function array_to_ptr(ptr: Pointer; size: PtrUInt; objsize: PtrUInt): Pointer; cdecl; function array_to_ptr(ptr: Pointer; size: PtrUInt; objsize: PtrUInt): Pointer; cdecl;
begin begin
result := GetMem(objsize * size); result := GetMem(objsize * size);
Move(ptr^, result^, objsize * size); Move(ptr^, result^, objsize * size);
end; end;
{ Free memory previously allocated by libMML } { Free memory previously allocated by libMML }
function free_ptr(ptr: pointer): boolean; cdecl; function free_ptr(ptr: pointer): boolean; cdecl;
begin begin
result := Assigned(ptr); result := Assigned(ptr);
if not result then if not result then
begin begin
set_last_error('TClient is NULL'); set_last_error('TClient is NULL');
if debug then if debug then
writeln(last_error); writeln(last_error);
end else end else
FreeMem(ptr); FreeMem(ptr);
end; end;
{ Allocate memory with libMML } { Allocate memory with libMML }
function alloc_mem(size, objsize: PtrUInt): Pointer; cdecl; function alloc_mem(size, objsize: PtrUInt): Pointer; cdecl;
begin begin
result := GetMem(size * objsize); result := GetMem(size * objsize);
end; end;
{ Reallocate memory with libMML } { Reallocate memory with libMML }
function realloc_mem(ptr: Pointer; size, objsize: PtrUInt): Pointer; cdecl; function realloc_mem(ptr: Pointer; size, objsize: PtrUInt): Pointer; cdecl;
begin begin
result := ReAllocMem(ptr, size*objsize); result := ReAllocMem(ptr, size*objsize);
end; end;
{ Mouse } { Mouse }
@ -143,34 +148,32 @@ end;
function get_mouse_pos(C: TClient; var t: tpoint): integer; cdecl; function get_mouse_pos(C: TClient; var t: tpoint): integer; cdecl;
begin begin
if not validate_client(C) then if not validate_client(C) then
begin exit(RESULT_ERROR);
exit(RESULT_ERROR);
end;
try try
C.IOManager.GetMousePos(t.x,t.y); C.IOManager.GetMousePos(t.x,t.y);
result := RESULT_OK; result := RESULT_OK;
except on e : Exception do except on e : Exception do
begin begin
result := RESULT_ERROR; result := RESULT_ERROR;
set_last_error(e.Message); set_last_error(e.Message);
end;
end; end;
end;
end; end;
{ Set mouse position of client C to point t } { Set mouse position of client C to point t }
function set_mouse_pos(C: TClient; var t: tpoint): integer; cdecl; function set_mouse_pos(C: TClient; var t: tpoint): integer; cdecl;
begin begin
try try
C.IOManager.MoveMouse(t.x,t.y); C.IOManager.MoveMouse(t.x,t.y);
result := RESULT_OK; result := RESULT_OK;
except on e : Exception do except on e : Exception do
begin begin
result := RESULT_ERROR; result := RESULT_ERROR;
set_last_error(e.Message); set_last_error(e.Message);
end; end;
end; end;
end; end;
@ -187,38 +190,38 @@ end;
{ Return the state of a mouse button given client C } { Return the state of a mouse button given client C }
function get_mouse_button_state(C: TClient; But: Integer): Integer; cdecl; function get_mouse_button_state(C: TClient; But: Integer): Integer; cdecl;
begin begin
try try
if C.IOManager.IsMouseButtonDown(ConvIntClickType(But)) then if C.IOManager.IsMouseButtonDown(ConvIntClickType(But)) then
result := MOUSE_DOWN result := MOUSE_DOWN
else else
result := MOUSE_UP; result := MOUSE_UP;
except on e : Exception do except on e : Exception do
begin begin
result := RESULT_ERROR; result := RESULT_ERROR;
set_last_error(e.Message); set_last_error(e.Message);
end;
end; end;
end;
end; end;
{ Set the state of a mouse button given client C } { Set the state of a mouse button given client C }
function set_mouse_button_state(C: TClient; But, State, X, Y: Integer): Integer; cdecl; function set_mouse_button_state(C: TClient; But, State, X, Y: Integer): Integer; cdecl;
begin begin
try try
if State = MOUSE_UP then if State = MOUSE_UP then
begin
C.IOManager.ReleaseMouse(X, Y, ConvIntClickType(But));
result := RESULT_OK;
end else if state = MOUSE_DOWN then
begin
C.IOManager.HoldMouse(X, Y, ConvIntClickType(But));
result := RESULT_OK;
end;
except on e : Exception do
begin begin
result := RESULT_ERROR; C.IOManager.ReleaseMouse(X, Y, ConvIntClickType(But));
set_last_error(e.Message); result := RESULT_OK;
end else if state = MOUSE_DOWN then
begin
C.IOManager.HoldMouse(X, Y, ConvIntClickType(But));
result := RESULT_OK;
end; end;
except on e : Exception do
begin
result := RESULT_ERROR;
set_last_error(e.Message);
end; end;
end;
end; end;
@ -227,52 +230,52 @@ end;
function get_color(C: TClient; x, y: Integer; function get_color(C: TClient; x, y: Integer;
out color: Integer): Integer; cdecl; out color: Integer): Integer; cdecl;
begin begin
try try
color := C.IOManager.GetColor(x, y); color := C.IOManager.GetColor(x, y);
if color > -1 then if color > -1 then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
{ Find color on client C in area (x1,y1,x2,y2) and return coordinate (if any) in x, y } { Find color on client C in area (x1,y1,x2,y2) and return coordinate (if any) in x, y }
function find_color(C: TClient; var x, y: Integer; function find_color(C: TClient; var x, y: Integer;
color, x1, y1, x2, y2: Integer): Integer; cdecl; color, x1, y1, x2, y2: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColor(x, y, color, x1, y1, x2, y2) then if C.MFinder.FindColor(x, y, color, x1, y1, x2, y2) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.Message); set_last_error(e.Message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function find_color_tolerance(C: TClient; var x, y: Integer; color: Integer; function find_color_tolerance(C: TClient; var x, y: Integer; color: Integer;
tol, x1, y1, x2, y2: Integer): Integer; cdecl; tol, x1, y1, x2, y2: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColorTolerance(x, y, color, x1, y1, x2, y2, tol) then if C.MFinder.FindColorTolerance(x, y, color, x1, y1, x2, y2, tol) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.Message); set_last_error(e.Message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function find_color_tolerance_optimised(C: TClient; var x, y: Integer; function find_color_tolerance_optimised(C: TClient; var x, y: Integer;
@ -280,18 +283,18 @@ function find_color_tolerance_optimised(C: TClient; var x, y: Integer;
x1, y1, x2, y2: Integer; x1, y1, x2, y2: Integer;
tol: Integer): Integer; cdecl; tol: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColorToleranceOptimised(x, y, col, x1, y1, x2, y2, if C.MFinder.FindColorToleranceOptimised(x, y, col, x1, y1, x2, y2,
tol) then tol) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function find_colors(C: TClient; var ptr: PPoint; var len: Integer; function find_colors(C: TClient; var ptr: PPoint; var len: Integer;
@ -299,27 +302,27 @@ function find_colors(C: TClient; var ptr: PPoint; var len: Integer;
var var
TPA: TPointArray; TPA: TPointArray;
begin begin
setlength(TPA, 0); setlength(TPA, 0);
try try
C.MFinder.FindColors(TPA, color, x1, y1, x2, y2); C.MFinder.FindColors(TPA, color, x1, y1, x2, y2);
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.Message); set_last_error(e.Message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
len := Length(TPA); len := Length(TPA);
if len > 0 then if len > 0 then
result := RESULT_OK result := RESULT_OK
else else
begin begin
setlength(tpa, 0);
exit(RESULT_FALSE);
end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(tpa, 0); setlength(tpa, 0);
exit(RESULT_FALSE);
end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(tpa, 0);
end; end;
function find_colors_tolerance(C: TClient; var ptr: PPoint; var len: Integer; function find_colors_tolerance(C: TClient; var ptr: PPoint; var len: Integer;
@ -327,26 +330,26 @@ function find_colors_tolerance(C: TClient; var ptr: PPoint; var len: Integer;
var var
TPA: TPointArray; TPA: TPointArray;
begin begin
try try
C.MFinder.FindColorsTolerance(TPA, color, x1, y1, x2, y2, tol); C.MFinder.FindColorsTolerance(TPA, color, x1, y1, x2, y2, tol);
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.Message); set_last_error(e.Message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
len := Length(TPA); len := Length(TPA);
if len > 0 then if len > 0 then
result := RESULT_OK result := RESULT_OK
else else
begin begin
setlength(tpa, 0); setlength(tpa, 0);
exit(RESULT_FALSE); exit(RESULT_FALSE);
end; end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(TPA, 0); setlength(TPA, 0);
end; end;
function find_colors_tolerance_optimised(C: TClient; var ptr: PPoint; function find_colors_tolerance_optimised(C: TClient; var ptr: PPoint;
@ -356,184 +359,184 @@ function find_colors_tolerance_optimised(C: TClient; var ptr: PPoint;
var var
TPA: TPointArray; TPA: TPointArray;
begin begin
try try
C.MFinder.FindColorsToleranceOptimised(TPA, col, x1, y1, x2, y2, tol); C.MFinder.FindColorsToleranceOptimised(TPA, col, x1, y1, x2, y2, tol);
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
len := Length(TPA); len := Length(TPA);
if len > 0 then if len > 0 then
result := RESULT_OK result := RESULT_OK
else else
begin begin
setlength(tpa, 0); setlength(tpa, 0);
exit(RESULT_FALSE); exit(RESULT_FALSE);
end; end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(TPA, 0); setlength(TPA, 0);
end; end;
function similar_colors(C: TClient; col1, col2, tol: Integer): Integer; cdecl; function similar_colors(C: TClient; col1, col2, tol: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.SimilarColors(col1, col2, tol) then if C.MFinder.SimilarColors(col1, col2, tol) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_FALSE; result := RESULT_FALSE;
end;
end; end;
end;
end; end;
function count_color(C: TClient; out count: Integer; function count_color(C: TClient; out count: Integer;
Color, xs, ys, xe, ye: Integer): Integer; cdecl; Color, xs, ys, xe, ye: Integer): Integer; cdecl;
begin begin
try try
count := C.MFinder.CountColor(Color, xs, ys, xe, ye); count := C.MFinder.CountColor(Color, xs, ys, xe, ye);
if count > 0 then if count > 0 then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function count_color_tolerance(C: TClient; out count: Integer; col: Integer; function count_color_tolerance(C: TClient; out count: Integer; col: Integer;
xs, ys, xe, ye, tol: Integer): Integer; cdecl; xs, ys, xe, ye, tol: Integer): Integer; cdecl;
begin begin
try try
count := C.MFinder.CountColorTolerance(col, xs, ys, xe, ye, tol); count := C.MFinder.CountColorTolerance(col, xs, ys, xe, ye, tol);
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
if count > 0 then if count > 0 then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
end; end;
function find_color_spiral(C: TClient; var x, y: Integer; function find_color_spiral(C: TClient; var x, y: Integer;
col, xs, ys, xe, ye: Integer): Integer; cdecl; col, xs, ys, xe, ye: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColorSpiral(x, y, col, xs, ys, xe, ye) then if C.MFinder.FindColorSpiral(x, y, col, xs, ys, xe, ye) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function find_color_spiral_tolerance(C: TClient; var x, y: Integer; function find_color_spiral_tolerance(C: TClient; var x, y: Integer;
col, xs, ys, xe, ye: Integer; col, xs, ys, xe, ye: Integer;
tol: Integer): Integer; cdecl; tol: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColorSpiralTolerance(x, y, col, xs, ys, xe, ye, if C.MFinder.FindColorSpiralTolerance(x, y, col, xs, ys, xe, ye,
tol) then tol) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function find_colored_area(C: TClient; var x, y: Integer; function find_colored_area(C: TClient; var x, y: Integer;
col, xs, ys, xe, ye, minA: Integer): Integer; cdecl; col, xs, ys, xe, ye, minA: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColoredArea(x, y, col, xs, ys, xe, ye, minA) then if C.MFinder.FindColoredArea(x, y, col, xs, ys, xe, ye, minA) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function find_colored_area_tolerance(C: TClient; var x, y: Integer; function find_colored_area_tolerance(C: TClient; var x, y: Integer;
col, xs, ys, xe, ye, minA: Integer; col, xs, ys, xe, ye, minA: Integer;
tol: Integer): Integer; cdecl; tol: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColoredAreaTolerance(x, y, col, if C.MFinder.FindColoredAreaTolerance(x, y, col,
xs, ys, xe, ye, minA, tol) then xs, ys, xe, ye, minA, tol) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function set_tolerance_speed(C: TClient; nCTS: Integer): Integer; cdecl; function set_tolerance_speed(C: TClient; nCTS: Integer): Integer; cdecl;
begin begin
try try
C.MFinder.SetToleranceSpeed(nCTS); C.MFinder.SetToleranceSpeed(nCTS);
result := RESULT_OK; result := RESULT_OK;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function get_tolerance_speed(C: TClient; out cts: Integer): Integer; cdecl; function get_tolerance_speed(C: TClient; out cts: Integer): Integer; cdecl;
begin begin
try try
cts := C.MFinder.GetToleranceSpeed; cts := C.MFinder.GetToleranceSpeed;
result := RESULT_OK; result := RESULT_OK;
except on e: Exception do except on e: Exception do
begin; begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end end
end; end;
end; end;
function set_tolerance_speed_2_modifiers(C: TClient; function set_tolerance_speed_2_modifiers(C: TClient;
nHue, nSat: Extended): Integer; cdecl; nHue, nSat: Extended): Integer; cdecl;
begin begin
try try
C.MFinder.SetToleranceSpeed2Modifiers(nHue, nSat); C.MFinder.SetToleranceSpeed2Modifiers(nHue, nSat);
result := RESULT_OK; result := RESULT_OK;
except on e : Exception do except on e : Exception do
begin; begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function get_tolerance_speed_2_modifiers(C: TClient; out hueMod: Extended; function get_tolerance_speed_2_modifiers(C: TClient; out hueMod: Extended;
@ -541,17 +544,17 @@ function get_tolerance_speed_2_modifiers(C: TClient; out hueMod: Extended;
var var
h, s: Extended; h, s: Extended;
begin begin
try try
C.MFinder.GetToleranceSpeed2Modifiers(h, s); C.MFinder.GetToleranceSpeed2Modifiers(h, s);
hueMod := h; hueMod := h;
satMod := s; satMod := s;
result := RESULT_OK; result := RESULT_OK;
except on e : Exception do except on e : Exception do
begin; begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
{ DTM } { DTM }
@ -564,53 +567,53 @@ function create_dtm(PointLen: integer; Points: PMDTMPoint; DTM: TMDTM): integer;
var var
i: integer; i: integer;
begin begin
DTM := TMDTM.Create; DTM := TMDTM.Create;
for i := 0 to PointLen - 1 do for i := 0 to PointLen - 1 do
DTM.AddPoint(Points[i]); DTM.AddPoint(Points[i]);
if DTM.Valid then if DTM.Valid then
exit(RESULT_OK); exit(RESULT_OK);
DTM.Free; DTM.Free;
set_last_error('Invalid DTM'); set_last_error('Invalid DTM');
result := RESULT_ERROR; result := RESULT_ERROR;
end; end;
{ Delete a MDTM. Don't delete it if it is managed! use remove_dtm instead } { Delete a MDTM. Don't delete it if it is managed! use remove_dtm instead }
function delete_dtm(C: TClient; DTM: TMDTM): integer; cdecl; function delete_dtm(C: TClient; DTM: TMDTM): integer; cdecl;
begin begin
if not assigned(DTM) then if not assigned(DTM) then
begin begin
set_last_error('DTM is NULL'); set_last_error('DTM is NULL');
exit(RESULT_ERROR); exit(RESULT_ERROR);
end; end;
DTM.Free; DTM.Free;
result := RESULT_OK; result := RESULT_OK;
end; end;
{ Add a previously created DTM to the DTM Manager } { Add a previously created DTM to the DTM Manager }
function add_dtm(C: TClient; DTM: TMDTM; var index: integer): integer; cdecl; function add_dtm(C: TClient; DTM: TMDTM; var index: integer): integer; cdecl;
begin begin
if not assigned(DTM) then if not assigned(DTM) then
begin begin
set_last_error('DTM is NULL'); set_last_error('DTM is NULL');
exit(RESULT_ERROR); exit(RESULT_ERROR);
end; end;
try try
index := C.MDTMs.AddDTM(DTM); index := C.MDTMs.AddDTM(DTM);
exit(RESULT_OK); exit(RESULT_OK);
except on e : Exception do except on e : Exception do
result := RESULT_ERROR; result := RESULT_ERROR;
end; end;
end; end;
{ Remove a previously added DTM from the DTM manager. This also frees the DTM } { Remove a previously added DTM from the DTM manager. This also frees the DTM }
function remove_dtm(C: TClient; DTMi: integer): integer; cdecl; function remove_dtm(C: TClient; DTMi: integer): integer; cdecl;
begin begin
C.MDTMs.FreeDTM(DTMi); C.MDTMs.FreeDTM(DTMi);
end; end;
{ Find a DTM given DTM index i, client C in area x1,y1,x2,y2. Return coord at x, y. } { Find a DTM given DTM index i, client C in area x1,y1,x2,y2. Return coord at x, y. }
@ -619,19 +622,19 @@ function find_dtm(C: TClient; DTMi: integer; var x, y: integer; x1, y1, x2,
var var
res: boolean; res: boolean;
begin begin
try try
res := C.MFinder.FindDTM(C.MDTMs.DTM[DTMi], x, y, x1, y1, x2, y2); res := C.MFinder.FindDTM(C.MDTMs.DTM[DTMi], x, y, x1, y1, x2, y2);
except on e : Exception do except on e : Exception do
begin; begin;
result := RESULT_ERROR; result := RESULT_ERROR;
set_last_error(e.Message); set_last_error(e.Message);
end;
end; end;
end;
if res then if res then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
end; end;
{ Find a DTM given DTM index i, client C in area x1,y1,x2,y2. Return coord at x, y. } { Find a DTM given DTM index i, client C in area x1,y1,x2,y2. Return coord at x, y. }
@ -642,46 +645,46 @@ var
len: integer; len: integer;
TPA: TPointArray; TPA: TPointArray;
begin begin
try try
res := C.MFinder.FindDTMs(C.MDTMs.DTM[DTMi], TPA, x1, y1, x2, y2); res := C.MFinder.FindDTMs(C.MDTMs.DTM[DTMi], TPA, x1, y1, x2, y2);
except on e : Exception do except on e : Exception do
begin; begin;
result := RESULT_ERROR; result := RESULT_ERROR;
set_last_error(e.Message); set_last_error(e.Message);
end; end;
end; end;
len := Length(TPA); len := Length(TPA);
if len > 0 then if len > 0 then
result := RESULT_OK result := RESULT_OK
else else
begin begin
setlength(tpa, 0); setlength(tpa, 0);
exit(RESULT_FALSE); exit(RESULT_FALSE);
end; end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(TPA, 0); setlength(TPA, 0);
end; end;
function set_array_target(C: TClient; Arr: PRGB32; Size: TPoint): integer; function set_array_target(C: TClient; Arr: PRGB32; Size: TPoint): integer;
cdecl; cdecl;
begin begin
if not assigned(Arr) then if not assigned(Arr) then
begin begin
set_last_error('Arr is not assigned'); set_last_error('Arr is not assigned');
exit(RESULT_FALSE); exit(RESULT_FALSE);
end; end;
try try
C.IOManager.SetTarget(Arr, Size); C.IOManager.SetTarget(Arr, Size);
result := RESULT_OK; result := RESULT_OK;
except on e : Exception do except on e : Exception do
begin; begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_FALSE; result := RESULT_FALSE;
end;
end; end;
end;
end; end;
exports exports

34
Tests/PS/bmpbench.simba Normal file
View File

@ -0,0 +1,34 @@
program new;
//http://farm4.static.flickr.com/3067/2612399892_7df428d482.jpg
{Make the above bitmap your target}
var
Bmp : integer;
x,y : integer;
w,h : integer;
t, i, c: integer;
begin
Bmp := createBitmap(15, 10);
FastDrawClear(bmp, clRed);
GetClientDimensions(w,h);
writeln(w);
writeln(h);
for c := 0 to 2 do
begin
writeln('cts: ' + inttostr(c));
setcolortolerancespeed(c);
t:=getsystemtime;
for i := 0 to 100 do
findBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,10);
writeln((getsystemtime-t) / 100.0);
if findBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,200) then
writeln('found');
end;
{if FindBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,300) then
begin
writeln('found');
MoveMouse(x,y);
end;}
end.

5
Units/MMLAddon/PSInc/Wrappers/tpa.inc
View File

@ -143,6 +143,11 @@ begin
FilterPointsLine(points,radial,radius,mx,my); FilterPointsLine(points,radial,radius,mx,my);
end; end;
procedure ps_FilterTPADist(var TPA: TPointArray; maxDist: integer);
begin
FilterTPADist(TPA, maxDist);
end;
function ps_GetATPABounds(const ATPA: T2DPointArray): TBox;extdecl; function ps_GetATPABounds(const ATPA: T2DPointArray): TBox;extdecl;
begin begin
result := GetATPABounds(ATPA); result := GetATPABounds(ATPA);

1
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -458,6 +458,7 @@ AddFunction(@ps_FloodFillTPA,'function FloodFillTPA(const TPA : TPointArray) : T
AddFunction(@ps_FilterPointsPie,'procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);'); AddFunction(@ps_FilterPointsPie,'procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);');
AddFunction(@ps_FilterPointsLine,'procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);'); AddFunction(@ps_FilterPointsLine,'procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);');
AddFunction(@ps_filterpointsdist,'procedure FilterPointsDist(var Points: TPointArray; const MinDist, MaxDist: Extended; Mx, My: Integer);'); AddFunction(@ps_filterpointsdist,'procedure FilterPointsDist(var Points: TPointArray; const MinDist, MaxDist: Extended; Mx, My: Integer);');
AddFunction(@ps_filterTPADist, 'procedure FilterTPADist(var TPA: TPointArray; maxDist: integer);');
AddFunction(@ps_GetATPABounds,'function GetATPABounds(const ATPA: T2DPointArray): TBox;'); AddFunction(@ps_GetATPABounds,'function GetATPABounds(const ATPA: T2DPointArray): TBox;');
AddFunction(@ps_GetTPABounds,'function GetTPABounds(const TPA: TPointArray): TBox;'); AddFunction(@ps_GetTPABounds,'function GetTPABounds(const TPA: TPointArray): TBox;');
AddFunction(@ps_FindTPAinTPA,'function FindTPAinTPA(const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;'); AddFunction(@ps_FindTPAinTPA,'function FindTPAinTPA(const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;');

21
Units/MMLAddon/colourpicker.pas
View File

@ -51,7 +51,12 @@ type
procedure ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure ImageInfoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ImageInfoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
Procedure ColorPickUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); procedure ColorPickUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
private
{ Are we currently picking? }
FPicking: Boolean;
public public
manager: TIOManager; manager: TIOManager;
{ Form components } { Form components }
@ -68,7 +73,9 @@ type
{ Handles } { Handles }
InfoHandle, ImageHandle : HDC; InfoHandle, ImageHandle : HDC;
public public
property Picking: Boolean read FPicking;
property OnPick: TColourPickEvent read FPickEvent write FPickEvent; property OnPick: TColourPickEvent read FPickEvent write FPickEvent;
end; end;
@ -80,7 +87,8 @@ constructor TMColorPicker.Create(manager: TIOManager);
begin begin
inherited Create; inherited Create;
self.manager := manager; Self.manager := manager;
Self.FPicking := False;
end; end;
destructor TMColorPicker.Destroy; destructor TMColorPicker.Destroy;
@ -103,12 +111,17 @@ var
begin begin
if self.FPicking then
raise Exception.Create('Pick() has not yet returned, but has been called'
+ 'again');
Self.FPicking := True;
{ Disable both of the color pick buttons } { Disable both of the color pick buttons }
w := 0; w := 0;
h := 0; h := 0;
{ If the target window isn't valid (closed etc), make the destkop the new window} { If the target window isn't valid (closed etc), make the destkop the new window}
if not Self.Manager.TargetValid then if not Self.Manager.TargetValid then
self.Manager.SetDesktop; Self.Manager.SetDesktop;
{Desktop is needed for the whole picture} {Desktop is needed for the whole picture}
Desktop := TIOManager.Create; Desktop := TIOManager.Create;
@ -214,6 +227,8 @@ begin
Desktop.free; Desktop.free;
self.FPicking := False;
{ Re-enable the color pick buttons } { Re-enable the color pick buttons }
// Application.MainForm.Enabled := True; // Application.MainForm.Enabled := True;
// ColourHistoryForm.Enabled := True; // ColourHistoryForm.Enabled := True;

57
Units/MMLAddon/mmlpsthread.pas
View File

@ -184,7 +184,8 @@ type
procedure OnCompile(Sender: TPSScript); procedure OnCompile(Sender: TPSScript);
function RequireFile(Sender: TObject; const OriginFileName: String; function RequireFile(Sender: TObject; const OriginFileName: String;
var FileName, OutPut: string): Boolean; var FileName, OutPut: string): Boolean;
function FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean; function FileAlreadyIncluded(Sender: TObject; OrgFileName, FileName: string): Boolean;
function OnIncludingFile(Sender: TObject; OrgFileName, FileName: string): Boolean;
procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler); procedure OnCompImport(Sender: TObject; x: TPSPascalCompiler);
procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); procedure OnExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
@ -425,7 +426,9 @@ begin
Exit; Exit;
end; end;
filename := path;//Yeah! filename := path;//Yeah!
Includes.Add(path);
if Includes.IndexOf(path) = -1 then
Includes.Add(path);
try try
f:= TFileStream.Create(UTF8ToSys(Path), fmOpenRead); f:= TFileStream.Create(UTF8ToSys(Path), fmOpenRead);
@ -615,6 +618,7 @@ begin
PSScript.UsePreProcessor:= True; PSScript.UsePreProcessor:= True;
PSScript.CompilerOptions := PSScript.CompilerOptions + [icBooleanShortCircuit]; PSScript.CompilerOptions := PSScript.CompilerOptions + [icBooleanShortCircuit];
PSScript.OnNeedFile := @RequireFile; PSScript.OnNeedFile := @RequireFile;
PSScript.OnIncludingFile := @OnIncludingFile;
PSScript.OnFileAlreadyIncluded := @FileAlreadyIncluded; PSScript.OnFileAlreadyIncluded := @FileAlreadyIncluded;
PSScript.OnProcessDirective:=@OnProcessDirective; PSScript.OnProcessDirective:=@OnProcessDirective;
PSScript.OnProcessUnknowDirective:=@PSScriptProcessUnknownDirective; PSScript.OnProcessUnknowDirective:=@PSScriptProcessUnknownDirective;
@ -737,20 +741,57 @@ begin
'{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}'; '{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}';
end; end;
function TPSThread.FileAlreadyIncluded(Sender: TObject; FileName: string): Boolean; function TPSThread.FileAlreadyIncluded(Sender: TObject; OrgFileName, FileName: string): Boolean;
var var
path: string; path: string;
i: integer; i: integer;
begin begin
path := FindFile(Filename,[ScriptPath,IncludePath]); path := FindFile(filename,[includepath,ScriptPath,IncludeTrailingPathDelimiter(ExtractFileDir(OrgFileName))]);
if path = '' then
begin
Result := True;
Exit;
end;
path := ExpandFileNameUTF8(path);
if (path <> '') then if (path <> '') then
if Includes.Find(path,i) then if Includes.IndexOf(path) <> -1 then
begin begin
psWriteln('Include_Once file already included'); {$IFDEF SIMBA_VERBOSE}
Result := False; writeln('Include_Once file already included:' + Path);
{$ENDIF}
Result := True;
Exit;
end; end;
{$IFDEF SIMBA_VERBOSE}
writeln('OnFileAlreadyIncluded, Adding: ' + path);
{$ENDIF}
Includes.Add(path); Includes.Add(path);
Result := True; Result := False;
end;
function TPSThread.OnIncludingFile(Sender: TObject; OrgFileName, FileName: string): Boolean;
var
path: string;
begin
path := FindFile(filename,[includepath,ScriptPath,IncludeTrailingPathDelimiter(ExtractFileDir(OrgFileName))]);
if path = '' then
begin
Result := True;
Exit;
end;
path := ExpandFileNameUTF8(path);
if Includes.IndexOf(path) = -1 then
begin
{$IFDEF SIMBA_VERBOSE}
writeln('OnIncludingFile, Adding: ' + path);
{$ENDIF}
Includes.Add(path);
end;
Result := True; // Not used
end; end;
procedure SIRegister_Mufasa(cl: TPSPascalCompiler); procedure SIRegister_Mufasa(cl: TPSPascalCompiler);

1
Units/MMLCore/files.pas
View File

@ -128,6 +128,7 @@ begin;
exit; exit;
end; end;
end; end;
result := '';
end; end;
constructor TMFiles.Create(Owner : TObject); constructor TMFiles.Create(Owner : TObject);

2
Units/MMLCore/finder.pas
View File

@ -1692,6 +1692,8 @@ begin
end; end;
//We did find the Bmp, otherwise we would be at the part below //We did find the Bmp, otherwise we would be at the part below
TClient(Client).IOManager.FreeReturnData;
x := ClientTPA[i].x + xs; x := ClientTPA[i].x + xs;
y := ClientTPA[i].y + ys; y := ClientTPA[i].y + ys;
result := true; result := true;

5
Units/MMLCore/ocr.pas
View File

@ -176,12 +176,15 @@ end;
{ Get the current pointer to our list of Fonts } { Get the current pointer to our list of Fonts }
function TMOCR.GetFonts:TMFonts; function TMOCR.GetFonts:TMFonts;
begin begin
Exit(Self.FFonts); Result := Self.FFonts;
end; end;
{ Set new Fonts. We set it to a Copy of NewFonts } { Set new Fonts. We set it to a Copy of NewFonts }
procedure TMOCR.SetFonts(const NewFonts: TMFonts); procedure TMOCR.SetFonts(const NewFonts: TMFonts);
begin begin
if (Self.FFonts <> nil) then
Self.FFonts.Free;
Self.FFonts := NewFonts.Copy(Self.Client); Self.FFonts := NewFonts.Copy(Self.Client);
end; end;

55
Units/MMLCore/os_linux.pas
View File

@ -23,6 +23,12 @@
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
unit os_linux; unit os_linux;
{
TODO's:
- Allow selecting a different X display
- Fix keyboard layout / SendString
}
interface interface
uses uses
@ -126,7 +132,7 @@ implementation
{ {
This is extremely hacky, but also very useful. This is extremely hacky, but also very useful.
We have to install a X error handler, because otherwise X We have to install a X error handler, because otherwise X
will terminate out entire app on error. will terminate our entire app on error.
Since we want the right thread to recieve the right error, we have to Since we want the right thread to recieve the right error, we have to
fiddle a bit with threadvars, mutexes / semaphores. fiddle a bit with threadvars, mutexes / semaphores.
@ -413,33 +419,40 @@ implementation
result := xmask and ButtonP > 0; result := xmask and ButtonP > 0;
end; end;
{ TODO: Check if this supports multiple keyboard layouts, probably not }
procedure TWindow.SendString(str: string); procedure TWindow.SendString(str: string);
var var
i: integer; I, L: Integer;
key: byte; K: Byte;
HoldShift : boolean; HoldShift: Boolean;
begin begin
HoldShift := false; HoldShift := False;
for i := 1 to length(str) do L := Length(str);
for I := 1 to L do
begin begin
if((str[i] >= 'A') and (str[i] <= 'Z')) then if (((str[I] >= 'A') and (str[I] <= 'Z')) or
((str[I] >= '!') and (str[I] <= '&')) or
((str[I] >= '(') and (str[I] <= '+')) or
(str[I] = ':') or
((str[I] >= '<') and (str[I] <= '@')) or
((str[I] >= '^') and (str[I] <= '_')) or
((str[I] >= '{') and (str[I] <= '~'))) then
begin begin
HoldKey(VK_SHIFT); HoldKey(VK_SHIFT);
HoldShift:= True; HoldShift := True;
str[i] := lowerCase(str[i]); end;
end else
if HoldShift then K := GetKeyCode(str[I]);
begin HoldKey(K);
HoldShift:= false; Sleep(20);
ReleaseKey(VK_SHIFT); ReleaseKey(K);
end;
key:= GetKeyCode(str[i]); if (HoldShift) then
HoldKey(key); begin
//BenLand100: You should probably wait here... HoldShift := False;
ReleaseKey(key); ReleaseKey(VK_SHIFT);
end;
end; end;
if HoldShift then
ReleaseKey(VK_SHIFT);
end; end;
procedure TWindow.HoldKey(key: integer); procedure TWindow.HoldKey(key: integer);

52
Units/MMLCore/os_windows.pas
View File

@ -366,34 +366,34 @@ begin
end; end;
end; end;
procedure TWindow.SendString(str: string); procedure TWindow.SendString(str: string);
var var
i: integer; I, L: integer;
key: byte; C: Byte;
HoldShift : boolean; ScanCode, VK: Word;
Shift: boolean;
begin
L := Length(str);
for I := 1 to L do
begin begin
HoldShift := false; VK := VkKeyScan(str[I]);
for i := 1 to length(str) do Shift := (Hi(VK) > 0);
begin C := LoByte(VK);
if((str[i] >= 'A') and (str[i] <= 'Z')) then ScanCode := MapVirtualKey(C, 0);
begin if (ScanCode = 0) then
HoldKey(VK_SHIFT); Continue;
HoldShift:= True;
str[i] := lowerCase(str[i]); if (Shift) then
end else Keybd_Event(VK_SHIFT, $2A, 0, 0);
if HoldShift then
begin Keybd_Event(C, ScanCode, 0, 0);
HoldShift:= false; Keybd_Event(C, ScanCode, KEYEVENTF_KEYUP, 0);
ReleaseKey(VK_SHIFT);
end; if (Shift) then
key:= GetKeyCode(str[i]); Keybd_Event(VK_SHIFT, $2A, KEYEVENTF_KEYUP, 0);
HoldKey(key);
//BenLand100 note: probably should wait here
ReleaseKey(key);
end;
if HoldShift then
ReleaseKey(VK_SHIFT);
end; end;
end;
procedure TWindow.HoldKey(key: integer); procedure TWindow.HoldKey(key: integer);
begin begin
keyinput.Down(key); keyinput.Down(key);

50
Units/MMLCore/tpa.pas
View File

@ -67,6 +67,7 @@ function FloodFillTPA(const TPA : TPointArray) : T2DPointArray;
procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer); procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);
procedure FilterPointsDist(var Points: TPointArray; const MinDist,MaxDist: Extended; Mx, My: Integer); procedure FilterPointsDist(var Points: TPointArray; const MinDist,MaxDist: Extended; Mx, My: Integer);
procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer); procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);
procedure FilterTPADist(var TPA: TPointArray; maxDist: integer);
function RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray; function RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;
function GetATPABounds(const ATPA: T2DPointArray): TBox; function GetATPABounds(const ATPA: T2DPointArray): TBox;
function GetTPABounds(const TPA: TPointArray): TBox; function GetTPABounds(const TPA: TPointArray): TBox;
@ -1168,6 +1169,55 @@ begin
Points:= P; Points:= P;
end; end;
{/\
Removes points in the TPA that are within maxDist of each other.
/\}
procedure FilterTPADist(var TPA: TPointArray; maxDist: integer);
var
c, i, j, l, h, maxDistSq: integer;
newTPA: TPointArray;
inBadElements: TBooleanArray;
begin
h := high(TPA);
l := (h + 1);
maxDistSq := (maxDist * maxDist);
setLength(inBadElements, l);
setLength(newTPA, l);
for i := 0 to h do
inBadElements[i] := false;
for i := 0 to (h - 1) do
begin
if (inBadElements[i]) then
continue;
for j := (i + 1) to h do
begin
if (inBadElements[j]) then
continue;
// simplified -> a^2 + b^2 <= c^2
if (((TPA[i].x - TPA[j].x) * (TPA[i].x - TPA[j].x)) + ((TPA[i].y - TPA[j].y) * (TPA[i].y - TPA[j].y)) <= maxDistSq) then
inBadElements[j] := true;
end;
end;
c := 0;
// set the new TPA
for i := 0 to h do
if (not inBadElements[i]) then
begin
newTPA[c] := TPA[i];
inc(c);
end;
setLength(newTPA, c);
TPA := newTPA;
end;
{/\ {/\
Removes the points that are inside or outside the distance Dist from the point (x, y) from the TPointArray ThePoints. Removes the points that are inside or outside the distance Dist from the point (x, y) from the TPointArray ThePoints.
/\} /\}

31
Units/PascalScript/uPSComponent.pas
View File

@ -94,7 +94,8 @@ type
TPSOnNeedFile = function (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean of object; TPSOnNeedFile = function (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean of object;
{ Added by Wizzup } { Added by Wizzup }
TPSOnFileAlreadyIncluded = function (Sender: TObject; FileName: tbtstring): Boolean of object; TPSOnFileAlreadyIncluded = function (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean of object;
TPSOnIncludingFile = function (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean of object;
{ Wizzup out } { Wizzup out }
TPSOnProcessDirective = procedure ( TPSOnProcessDirective = procedure (
@ -127,6 +128,7 @@ type
FOnNeedFile: TPSOnNeedFile; FOnNeedFile: TPSOnNeedFile;
{ Added by Wizzup } { Added by Wizzup }
FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded; FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded;
FOnIncludingFile: TPSOnIncludingFile;
{ Wizzup out } { Wizzup out }
FUsePreProcessor: Boolean; FUsePreProcessor: Boolean;
FDefines: TStrings; FDefines: TStrings;
@ -161,7 +163,8 @@ type
//--jgv new //--jgv new
function DoOnNeedFile (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean; virtual; function DoOnNeedFile (Sender: TObject; const OrginFileName: tbtstring; var FileName, Output: tbtstring): Boolean; virtual;
{ Added by Wizzup } { Added by Wizzup }
function DoOnFileAlreadyIncluded (Sender: TObject; FileName: tbtstring): Boolean; virtual; function DoOnFileAlreadyIncluded (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean; virtual;
function DoOnIncludingFile (Sender: TObject; OrgFileName, FileName: tbtstring): Boolean; virtual;
{ Wizzup out } { Wizzup out }
function DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; virtual; // return true if processed function DoOnUnknowUses (Sender: TPSPascalCompiler; const Name: tbtstring): Boolean; virtual; // return true if processed
procedure DoOnCompImport; virtual; procedure DoOnCompImport; virtual;
@ -300,6 +303,7 @@ type
{ Added by Wizzup } { Added by Wizzup }
property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded; property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded;
property OnIncludingFile: TPSOnIncludingFile read FOnIncludingFile write FOnIncludingFile;
{ Wizzup out } { Wizzup out }
property Defines: TStrings read FDefines write SetDefines; property Defines: TStrings read FDefines write SetDefines;
@ -553,9 +557,14 @@ begin
end; end;
{ Added by Wizzup } { Added by Wizzup }
function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; FileName: tbtstring): Boolean; function CEOnFileAlreadyIncluded(Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean;
begin begin
Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, Filename); Result := TPSScript (Sender.ID).DoOnFileAlreadyIncluded(Sender.ID, OrgFileName, Filename);
end;
function CEOnIncludingFile(Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean;
begin
Result := TPSScript (Sender.ID).DoOnIncludingFile(Sender.ID, OrgFileName, Filename);
end; end;
{ Wizzup out } { Wizzup out }
@ -675,6 +684,7 @@ begin
{ Added by Wizzup } { Added by Wizzup }
FPP.OnFileAlreadyIncluded:= CEOnFileAlreadyIncluded; FPP.OnFileAlreadyIncluded:= CEOnFileAlreadyIncluded;
FPP.OnIncludingFile:= CEOnIncludingFile;
{ Wizzup out } { Wizzup out }
FDefines := TStringList.Create; FDefines := TStringList.Create;
@ -1081,10 +1091,19 @@ end;
{ Added by Wizzup } { Added by Wizzup }
function TPSScript.DoOnFileAlreadyIncluded(Sender: TObject; function TPSScript.DoOnFileAlreadyIncluded(Sender: TObject;
FileName: tbtstring): Boolean; OrgFileName, FileName: tbtstring): Boolean;
begin begin
If Assigned (OnFileAlreadyIncluded) then If Assigned (OnFileAlreadyIncluded) then
Result := OnFileAlreadyIncluded(Sender, FileName) Result := OnFileAlreadyIncluded(Sender, OrgFileName, FileName)
else
Result := False;
end;
function TPSScript.DoOnIncludingFile(Sender: TObject;
OrgFileName, FileName: tbtstring): Boolean;
begin
If Assigned (OnIncludingFile) then
Result := OnIncludingFile(Sender, OrgFileName, FileName)
else else
Result := False; Result := False;
end; end;

2
Units/PascalScript/uPSI_ComCtrls.pas
View File

@ -311,7 +311,7 @@ begin T := Self.TabIndex; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
procedure TTabControlNoteBookStringsNoteBook_R(Self: TTabControlNoteBookStrings; var T: TNoteBook); procedure TTabControlNoteBookStringsNoteBook_R(Self: TTabControlNoteBookStrings; var T: TNoteBook);
begin T := TNoteBook(Self.NoteBook); end; begin T := Self.NoteBook; end;
(*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*)
procedure TTabControlStringsTabWidth_W(Self: TTabControlStrings; const T: Smallint); procedure TTabControlStringsTabWidth_W(Self: TTabControlStrings; const T: Smallint);

9
Units/PascalScript/uPSPreProcessor.pas
View File

@ -16,7 +16,8 @@ type
TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean; TPSOnNeedFile = function (Sender: TPSPreProcessor; const callingfilename: tbtstring; var FileName, Output: tbtstring): Boolean;
{ Added by Wizzup } { Added by Wizzup }
TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; FileName: tbtstring): Boolean; TPSOnFileAlreadyIncluded = function (Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean;
TPSOnIncludingFile = function (Sender: TPSPreProcessor; OrgFileName, FileName: tbtstring): Boolean;
{ Wizzup out } { Wizzup out }
TPSOnProcessDirective = procedure ( TPSOnProcessDirective = procedure (
@ -99,6 +100,7 @@ type
FOnNeedFile: TPSOnNeedFile; FOnNeedFile: TPSOnNeedFile;
{ Added by Wizzup } { Added by Wizzup }
FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded; FOnFileAlreadyIncluded: TPSOnFileAlreadyIncluded;
FOnIncludingFile: TPSOnIncludingFile;
{ Wizzup out } { Wizzup out }
FAddedPosition: Cardinal; FAddedPosition: Cardinal;
FDefineState: TPSDefineStates; FDefineState: TPSDefineStates;
@ -120,6 +122,7 @@ type
{ Added by Wizzup } { Added by Wizzup }
property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded; property OnFileAlreadyIncluded: TPSOnFileAlreadyIncluded read FOnFileAlreadyIncluded write FOnFileAlreadyIncluded;
property OnIncludingFile: TPSOnIncludingFile read FOnIncludingFile write FOnIncludingFile;
{ Wizzup out } { Wizzup out }
property Defines: TStringList read FDefines write FDefines; property Defines: TStringList read FDefines write FDefines;
@ -633,6 +636,8 @@ begin
begin begin
if FDefineState.DoWrite then if FDefineState.DoWrite then
begin begin
if assigned(@OnIncludingFile) then
OnIncludingFile(self , Filename, s);
FAddedPosition := 0; FAddedPosition := 0;
IntPreProcess(Level +1, FileName, s, Dest); IntPreProcess(Level +1, FileName, s, Dest);
FCurrentLineInfo.Current := current; FCurrentLineInfo.Current := current;
@ -646,7 +651,7 @@ begin
raise EPSPreProcessor.CreateFmt(RPS_IncludeOnceNotFound, [FileName, OrgFileName]) raise EPSPreProcessor.CreateFmt(RPS_IncludeOnceNotFound, [FileName, OrgFileName])
else else
begin begin
if not OnFileAlreadyIncluded(Self, FileName) then if not OnFileAlreadyIncluded(Self, FileName, s) then
begin begin
FAddedPosition := 0; FAddedPosition := 0;
IntPreProcess(Level +1, FileName, s, Dest); IntPreProcess(Level +1, FileName, s, Dest);

12
Units/PascalScript/uPSR_extctrls.pas
View File

@ -85,14 +85,14 @@ procedure RIRegisterTPANEL(Cl: TPSRuntimeClassImporter);
begin begin
Cl.Add(TPANEL); Cl.Add(TPANEL);
end; end;
procedure TPagePageIndex_R(Self: TCustomPage; var T: INTEGER); begin T := Self.PageIndex; end; procedure TPagePageIndex_R(Self: TPAGE; var T: INTEGER); begin T := Self.PageIndex; end;
procedure TPagePageIndex_W(Self: TCustomPage; T: INTEGER); begin Self.PageIndex := T; end; procedure TPagePageIndex_W(Self: TPAGE; T: INTEGER); begin Self.PageIndex := T; end;
procedure TPageOnShow_R(Self: TCustomPage; var T: TNotifyEvent); begin T := Self.OnShow; end; procedure TPageOnShow_R(Self: TPAGE; var T: TNotifyEvent); begin T := Self.OnShow; end;
procedure TPageOnShow_W(Self: TCustomPage; T: TNotifyEvent); begin Self.OnShow := T; end; procedure TPageOnShow_W(Self: TPAGE; T: TNotifyEvent); begin Self.OnShow := T; end;
{$IFNDEF CLX} {$IFNDEF CLX}
procedure RIRegisterTPAGE(Cl: TPSRuntimeClassImporter); procedure RIRegisterTPAGE(Cl: TPSRuntimeClassImporter);
begin begin
with Cl.Add(TCustomPage) do with Cl.Add(TPAGE) do
begin begin
RegisterPropertyHelper(@TPagePageIndex_R,@TPagePageIndex_W,'PageIndex'); RegisterPropertyHelper(@TPagePageIndex_R,@TPagePageIndex_W,'PageIndex');
RegisterEventPropertyHelper(@TPageOnShow_R,@TPageOnShow_W,'OnShow'); RegisterEventPropertyHelper(@TPageOnShow_R,@TPageOnShow_W,'OnShow');
@ -106,7 +106,7 @@ begin
with Cl.Add(TNOTEBOOK) do with Cl.Add(TNOTEBOOK) do
begin begin
{$IFDEF FPC} {$IFDEF FPC}
// RegisterMethod(@TNoteBook.TabIndexAtClientPos,'TABINDEXATCLIENTPOS'); RegisterMethod(@TNoteBook.TabIndexAtClientPos,'TABINDEXATCLIENTPOS');
{$ENDIF} {$ENDIF}
RegisterPropertyHelper(@TNoteBookPageCount_R,nil,'PAGECOUNT'); RegisterPropertyHelper(@TNoteBookPageCount_R,nil,'PAGECOUNT');
end; end;

2
Units/lape

@ -1 +1 @@
Subproject commit 1b8211db373428cd2916905980ad51be8fab1f83 Subproject commit b24c52b9748c6f9f3e91a7a86f727022bf2fd6ce