Merge branch 'master' into 950

Conflicts:
	lib/linguist/languages.yml
This commit is contained in:
Arfon Smith
2014-05-04 19:46:20 -05:00
193 changed files with 65249 additions and 717 deletions

2
.gitignore vendored
View File

@@ -1 +1,3 @@
Gemfile.lock
.bundle/
vendor/

View File

@@ -2,10 +2,8 @@ before_install:
- sudo apt-get install libicu-dev -y
- gem update --system 2.1.11
rvm:
- 1.8.7
- 1.9.2
- 1.9.3
- 2.0.0
- ree
- 2.1.1
notifications:
disabled: true

View File

@@ -1,7 +1,2 @@
source 'https://rubygems.org'
gemspec
if RUBY_VERSION < "1.9.3"
# escape_utils 1.0.0 requires 1.9.3 and above
gem "escape_utils", "0.3.2"
end

View File

@@ -106,6 +106,29 @@ To update the `samples.json` after adding new files to [`samples/`](https://gith
bundle exec rake samples
### A note on language extensions
Linguist has a number of methods available to it for identifying the language of a particular file. The initial lookup is based upon the extension of the file, possible file extensions are defined in an array called `extensions`. Take a look at this example for example for `Perl`:
```
Perl:
type: programming
ace_mode: perl
color: "#0298c3"
extensions:
- .pl
- .PL
- .perl
- .ph
- .plx
- .pm
- .pod
- .psgi
interpreters:
- perl
```
Any of the extensions defined are valid but the first in this array should be the most popular.
### Testing
Sometimes getting the tests running can be too much work, especially if you don't have much Ruby experience. It's okay: be lazy and let our build bot [Travis](http://travis-ci.org/#!/github/linguist) run the tests for you. Just open a pull request and the bot will start cranking away.

View File

@@ -1,6 +1,8 @@
require File.expand_path('../lib/linguist/version', __FILE__)
Gem::Specification.new do |s|
s.name = 'github-linguist'
s.version = '2.10.11'
s.version = Linguist::VERSION
s.summary = "GitHub Language detection"
s.description = 'We use this library at GitHub to detect blob languages, highlight code, ignore binary files, suppress generated files in diffs, and generate language breakdown graphs.'
@@ -12,7 +14,7 @@ Gem::Specification.new do |s|
s.executables << 'linguist'
s.add_dependency 'charlock_holmes', '~> 0.6.6'
s.add_dependency 'escape_utils', '>= 0.3.1'
s.add_dependency 'escape_utils', '~> 1.0.1'
s.add_dependency 'mime-types', '~> 1.19'
s.add_dependency 'pygments.rb', '~> 0.5.4'

View File

@@ -4,3 +4,4 @@ require 'linguist/heuristics'
require 'linguist/language'
require 'linguist/repository'
require 'linguist/samples'
require 'linguist/version'

View File

@@ -291,7 +291,7 @@ module Linguist
data = lambda { (binary_mime_type? || binary?) ? "" : self.data }
end
@language = binary? ? nil : Language.detect(name.to_s, data, mode)
@language = Language.detect(name.to_s, data, mode)
end
# Internal: Get the lexer of the blob.

View File

@@ -62,7 +62,8 @@ module Linguist
generated_protocol_buffer? ||
generated_jni_header? ||
composer_lock? ||
node_modules?
node_modules? ||
vcr_cassette?
end
# Internal: Is the blob an XCode project file?
@@ -235,5 +236,15 @@ module Linguist
def composer_lock?
!!name.match(/composer.lock/)
end
# Is the blob a VCR Cassette file?
#
# Returns true or false
def vcr_cassette?
return false unless extname == '.yml'
return false unless lines.count > 2
# VCR Cassettes have "recorded_with: VCR" in the second last line.
return lines[-2].include?("recorded_with: VCR")
end
end
end

View File

@@ -28,6 +28,9 @@ module Linguist
if languages.all? { |l| ["Common Lisp", "OpenCL"].include?(l) }
disambiguate_cl(data, languages)
end
if languages.all? { |l| ["Rebol", "R"].include?(l) }
disambiguate_r(data, languages)
end
end
end
@@ -73,6 +76,13 @@ module Linguist
matches
end
def self.disambiguate_r(data, languages)
matches = []
matches << Language["Rebol"] if /\bRebol\b/i.match(data)
matches << Language["R"] if data.include?("<-")
matches
end
def self.active?
!!ACTIVE
end

View File

@@ -24,7 +24,6 @@ module Linguist
@extension_index = Hash.new { |h,k| h[k] = [] }
@interpreter_index = Hash.new { |h,k| h[k] = [] }
@filename_index = Hash.new { |h,k| h[k] = [] }
@primary_extension_index = {}
# Valid Languages types
TYPES = [:data, :markup, :programming, :prose]
@@ -80,12 +79,6 @@ module Linguist
@extension_index[extension] << language
end
if @primary_extension_index.key?(language.primary_extension)
raise ArgumentError, "Duplicate primary extension: #{language.primary_extension}"
end
@primary_extension_index[language.primary_extension] = language
language.interpreters.each do |interpreter|
@interpreter_index[interpreter] << language
end
@@ -191,8 +184,7 @@ module Linguist
# Returns all matching Languages or [] if none were found.
def self.find_by_filename(filename)
basename, extname = File.basename(filename), File.extname(filename)
langs = [@primary_extension_index[extname]] +
@filename_index[basename] +
langs = @filename_index[basename] +
@extension_index[extname]
langs.compact.uniq
end
@@ -299,15 +291,6 @@ module Linguist
@interpreters = attributes[:interpreters] || []
@filenames = attributes[:filenames] || []
unless @primary_extension = attributes[:primary_extension]
raise ArgumentError, "#{@name} is missing primary extension"
end
# Prepend primary extension unless its already included
if primary_extension && !extensions.include?(primary_extension)
@extensions = [primary_extension] + extensions
end
# Set popular, and searchable flags
@popular = attributes.key?(:popular) ? attributes[:popular] : false
@searchable = attributes.key?(:searchable) ? attributes[:searchable] : true
@@ -395,20 +378,6 @@ module Linguist
# Returns the extensions Array
attr_reader :extensions
# Deprecated: Get primary extension
#
# Defaults to the first extension but can be overridden
# in the languages.yml.
#
# The primary extension can not be nil. Tests should verify this.
#
# This attribute is only used by app/helpers/gists_helper.rb for
# creating the language dropdown. It really should be using `name`
# instead. Would like to drop primary extension.
#
# Returns the extension String.
attr_reader :primary_extension
# Public: Get interpreters
#
# Examples
@@ -427,6 +396,27 @@ module Linguist
# Returns the extensions Array
attr_reader :filenames
# Public: Return all possible extensions for language
def all_extensions
(extensions + [primary_extension]).uniq
end
# Deprecated: Get primary extension
#
# Defaults to the first extension but can be overridden
# in the languages.yml.
#
# The primary extension can not be nil. Tests should verify this.
#
# This method is only used by app/helpers/gists_helper.rb for creating
# the language dropdown. It really should be using `name` instead.
# Would like to drop primary extension.
#
# Returns the extension String.
def primary_extension
extensions.first
end
# Public: Get URL escaped name.
#
# Examples
@@ -485,7 +475,7 @@ module Linguist
#
# Returns html String
def colorize(text, options = {})
lexer.highlight(text, options = {})
lexer.highlight(text, options)
end
# Public: Return name as String representation
@@ -568,9 +558,8 @@ module Linguist
:group_name => options['group'],
:searchable => options.key?('searchable') ? options['searchable'] : true,
:search_term => options['search_term'],
:extensions => options['extensions'].sort,
:extensions => [options['extensions'].first] + options['extensions'][1..-1].sort,
:interpreters => options['interpreters'].sort,
:primary_extension => options['primary_extension'],
:filenames => options['filenames'],
:popular => popular.include?(name)
)

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -10,7 +10,7 @@
## Vendor Conventions ##
# Caches
- cache/
- (^|/)cache/
# Dependencies
- ^[Dd]ependencies/
@@ -47,6 +47,9 @@
# Debian packaging
- ^debian/
# Haxelib projects often contain a neko bytecode file named run.n
- run.n$
## Commonly Bundled JavaScript frameworks ##
# jQuery
@@ -95,6 +98,12 @@
# AngularJS
- (^|/)angular([^.]*)(\.min)?\.js$
# D3.js
- (^|\/)d3(\.v\d+)?([^.]*)(\.min)?\.js$
# React
- (^|/)react(-[^.]*)?(\.min)?\.js$
## Python ##
# django
@@ -114,10 +123,18 @@
# Sparkle
- (^|/)Sparkle/
## Groovy ##
# Gradle
- (^|/)gradlew$
- (^|/)gradlew\.bat$
- (^|/)gradle/wrapper/
## .NET ##
# Visual Studio IntelliSense
- -vsdoc\.js$
- \.intellisense\.js$
# jQuery validation plugin (MS bundles this with asp.net mvc)
- (^|/)jquery([^.]*)\.validate(\.unobtrusive)?(\.min)?\.js$
@@ -172,3 +189,6 @@
# .DS_Store's
- .[Dd][Ss]_[Ss]tore$
# Mercury --use-subdirs
- Mercury/

3
lib/linguist/version.rb Normal file
View File

@@ -0,0 +1,3 @@
module Linguist
VERSION = "2.10.15"
end

View File

@@ -0,0 +1,59 @@
module examples/systems/file_system
/*
* Model of a generic file system.
*/
abstract sig Object {}
sig Name {}
sig File extends Object {} { some d: Dir | this in d.entries.contents }
sig Dir extends Object {
entries: set DirEntry,
parent: lone Dir
} {
parent = this.~@contents.~@entries
all e1, e2 : entries | e1.name = e2.name => e1 = e2
this !in this.^@parent
this != Root => Root in this.^@parent
}
one sig Root extends Dir {} { no parent }
lone sig Cur extends Dir {}
sig DirEntry {
name: Name,
contents: Object
} {
one this.~entries
}
/**
* all directories besides root have one parent
*/
pred OneParent_buggyVersion {
all d: Dir - Root | one d.parent
}
/**
* all directories besides root have one parent
*/
pred OneParent_correctVersion {
all d: Dir - Root | (one d.parent && one contents.d)
}
/**
* Only files may be linked (that is, have more than one entry)
* That is, all directories are the contents of at most one directory entry
*/
pred NoDirAliases {
all o: Dir | lone o.~contents
}
check { OneParent_buggyVersion => NoDirAliases } for 5 expect 1
check { OneParent_correctVersion => NoDirAliases } for 5 expect 0

View File

@@ -0,0 +1,83 @@
module examples/systems/marksweepgc
/*
* Model of mark and sweep garbage collection.
*/
// a node in the heap
sig Node {}
sig HeapState {
left, right : Node -> lone Node,
marked : set Node,
freeList : lone Node
}
pred clearMarks[hs, hs' : HeapState] {
// clear marked set
no hs'.marked
// left and right fields are unchanged
hs'.left = hs.left
hs'.right = hs.right
}
/**
* simulate the recursion of the mark() function using transitive closure
*/
fun reachable[hs: HeapState, n: Node] : set Node {
n + n.^(hs.left + hs.right)
}
pred mark[hs: HeapState, from : Node, hs': HeapState] {
hs'.marked = hs.reachable[from]
hs'.left = hs.left
hs'.right = hs.right
}
/**
* complete hack to simulate behavior of code to set freeList
*/
pred setFreeList[hs, hs': HeapState] {
// especially hackish
hs'.freeList.*(hs'.left) in (Node - hs.marked)
all n: Node |
(n !in hs.marked) => {
no hs'.right[n]
hs'.left[n] in (hs'.freeList.*(hs'.left))
n in hs'.freeList.*(hs'.left)
} else {
hs'.left[n] = hs.left[n]
hs'.right[n] = hs.right[n]
}
hs'.marked = hs.marked
}
pred GC[hs: HeapState, root : Node, hs': HeapState] {
some hs1, hs2: HeapState |
hs.clearMarks[hs1] && hs1.mark[root, hs2] && hs2.setFreeList[hs']
}
assert Soundness1 {
all h, h' : HeapState, root : Node |
h.GC[root, h'] =>
(all live : h.reachable[root] | {
h'.left[live] = h.left[live]
h'.right[live] = h.right[live]
})
}
assert Soundness2 {
all h, h' : HeapState, root : Node |
h.GC[root, h'] =>
no h'.reachable[root] & h'.reachable[h'.freeList]
}
assert Completeness {
all h, h' : HeapState, root : Node |
h.GC[root, h'] =>
(Node - h'.reachable[root]) in h'.reachable[h'.freeList]
}
check Soundness1 for 3 expect 0
check Soundness2 for 3 expect 0
check Completeness for 3 expect 0

217
samples/Alloy/views.als Normal file
View File

@@ -0,0 +1,217 @@
module examples/systems/views
/*
* Model of views in object-oriented programming.
*
* Two object references, called the view and the backing,
* are related by a view mechanism when changes to the
* backing are automatically propagated to the view. Note
* that the state of a view need not be a projection of the
* state of the backing; the keySet method of Map, for
* example, produces two view relationships, and for the
* one in which the map is modified by changes to the key
* set, the value of the new map cannot be determined from
* the key set. Note that in the iterator view mechanism,
* the iterator is by this definition the backing object,
* since changes are propagated from iterator to collection
* and not vice versa. Oddly, a reference may be a view of
* more than one backing: there can be two iterators on the
* same collection, eg. A reference cannot be a view under
* more than one view type.
*
* A reference is made dirty when it is a backing for a view
* with which it is no longer related by the view invariant.
* This usually happens when a view is modified, either
* directly or via another backing. For example, changing a
* collection directly when it has an iterator invalidates
* it, as does changing the collection through one iterator
* when there are others.
*
* More work is needed if we want to model more closely the
* failure of an iterator when its collection is invalidated.
*
* As a terminological convention, when there are two
* complementary view relationships, we will give them types
* t and t'. For example, KeySetView propagates from map to
* set, and KeySetView' propagates from set to map.
*
* author: Daniel Jackson
*/
open util/ordering[State] as so
open util/relation as rel
sig Ref {}
sig Object {}
-- t->b->v in views when v is view of type t of backing b
-- dirty contains refs that have been invalidated
sig State {
refs: set Ref,
obj: refs -> one Object,
views: ViewType -> refs -> refs,
dirty: set refs
-- , anyviews: Ref -> Ref -- for visualization
}
-- {anyviews = ViewType.views}
sig Map extends Object {
keys: set Ref,
map: keys -> one Ref
}{all s: State | keys + Ref.map in s.refs}
sig MapRef extends Ref {}
fact {State.obj[MapRef] in Map}
sig Iterator extends Object {
left, done: set Ref,
lastRef: lone done
}{all s: State | done + left + lastRef in s.refs}
sig IteratorRef extends Ref {}
fact {State.obj[IteratorRef] in Iterator}
sig Set extends Object {
elts: set Ref
}{all s: State | elts in s.refs}
sig SetRef extends Ref {}
fact {State.obj[SetRef] in Set}
abstract sig ViewType {}
one sig KeySetView, KeySetView', IteratorView extends ViewType {}
fact ViewTypes {
State.views[KeySetView] in MapRef -> SetRef
State.views[KeySetView'] in SetRef -> MapRef
State.views[IteratorView] in IteratorRef -> SetRef
all s: State | s.views[KeySetView] = ~(s.views[KeySetView'])
}
/**
* mods is refs modified directly or by view mechanism
* doesn't handle possibility of modifying an object and its view at once?
* should we limit frame conds to non-dirty refs?
*/
pred modifies [pre, post: State, rs: set Ref] {
let vr = pre.views[ViewType], mods = rs.*vr {
all r: pre.refs - mods | pre.obj[r] = post.obj[r]
all b: mods, v: pre.refs, t: ViewType |
b->v in pre.views[t] => viewFrame [t, pre.obj[v], post.obj[v], post.obj[b]]
post.dirty = pre.dirty +
{b: pre.refs | some v: Ref, t: ViewType |
b->v in pre.views[t] && !viewFrame [t, pre.obj[v], post.obj[v], post.obj[b]]
}
}
}
pred allocates [pre, post: State, rs: set Ref] {
no rs & pre.refs
post.refs = pre.refs + rs
}
/**
* models frame condition that limits change to view object from v to v' when backing object changes to b'
*/
pred viewFrame [t: ViewType, v, v', b': Object] {
t in KeySetView => v'.elts = dom [b'.map]
t in KeySetView' => b'.elts = dom [v'.map]
t in KeySetView' => (b'.elts) <: (v.map) = (b'.elts) <: (v'.map)
t in IteratorView => v'.elts = b'.left + b'.done
}
pred MapRef.keySet [pre, post: State, setRefs: SetRef] {
post.obj[setRefs].elts = dom [pre.obj[this].map]
modifies [pre, post, none]
allocates [pre, post, setRefs]
post.views = pre.views + KeySetView->this->setRefs + KeySetView'->setRefs->this
}
pred MapRef.put [pre, post: State, k, v: Ref] {
post.obj[this].map = pre.obj[this].map ++ k->v
modifies [pre, post, this]
allocates [pre, post, none]
post.views = pre.views
}
pred SetRef.iterator [pre, post: State, iterRef: IteratorRef] {
let i = post.obj[iterRef] {
i.left = pre.obj[this].elts
no i.done + i.lastRef
}
modifies [pre,post,none]
allocates [pre, post, iterRef]
post.views = pre.views + IteratorView->iterRef->this
}
pred IteratorRef.remove [pre, post: State] {
let i = pre.obj[this], i' = post.obj[this] {
i'.left = i.left
i'.done = i.done - i.lastRef
no i'.lastRef
}
modifies [pre,post,this]
allocates [pre, post, none]
pre.views = post.views
}
pred IteratorRef.next [pre, post: State, ref: Ref] {
let i = pre.obj[this], i' = post.obj[this] {
ref in i.left
i'.left = i.left - ref
i'.done = i.done + ref
i'.lastRef = ref
}
modifies [pre, post, this]
allocates [pre, post, none]
pre.views = post.views
}
pred IteratorRef.hasNext [s: State] {
some s.obj[this].left
}
assert zippishOK {
all
ks, vs: SetRef,
m: MapRef,
ki, vi: IteratorRef,
k, v: Ref |
let s0=so/first,
s1=so/next[s0],
s2=so/next[s1],
s3=so/next[s2],
s4=so/next[s3],
s5=so/next[s4],
s6=so/next[s5],
s7=so/next[s6] |
({
precondition [s0, ks, vs, m]
no s0.dirty
ks.iterator [s0, s1, ki]
vs.iterator [s1, s2, vi]
ki.hasNext [s2]
vi.hasNext [s2]
ki.this/next [s2, s3, k]
vi.this/next [s3, s4, v]
m.put [s4, s5, k, v]
ki.remove [s5, s6]
vi.remove [s6, s7]
} => no State.dirty)
}
pred precondition [pre: State, ks, vs, m: Ref] {
// all these conditions and other errors discovered in scope of 6 but 8,3
// in initial state, must have view invariants hold
(all t: ViewType, b, v: pre.refs |
b->v in pre.views[t] => viewFrame [t, pre.obj[v], pre.obj[v], pre.obj[b]])
// sets are not aliases
-- ks != vs
// sets are not views of map
-- no (ks+vs)->m & ViewType.pre.views
// no iterator currently on either set
-- no Ref->(ks+vs) & ViewType.pre.views
}
check zippishOK for 6 but 8 State, 3 ViewType expect 1
/**
* experiment with controlling heap size
*/
fact {all s: State | #s.obj < 5}

View File

@@ -0,0 +1,41 @@
package com.blogspot.miguelinlas3.aspectj.cache;
import java.util.Map;
import java.util.WeakHashMap;
import org.aspectj.lang.JoinPoint;
import com.blogspot.miguelinlas3.aspectj.cache.marker.Cachable;
/**
* This simple aspect simulates the behaviour of a very simple cache
*
* @author migue
*
*/
public aspect CacheAspect {
public pointcut cache(Cachable cachable): execution(@Cachable * * (..)) && @annotation(cachable);
Object around(Cachable cachable): cache(cachable){
String evaluatedKey = this.evaluateKey(cachable.scriptKey(), thisJoinPoint);
if(cache.containsKey(evaluatedKey)){
System.out.println("Cache hit for key " + evaluatedKey);
return this.cache.get(evaluatedKey);
}
System.out.println("Cache miss for key " + evaluatedKey);
Object value = proceed(cachable);
cache.put(evaluatedKey, value);
return value;
}
protected String evaluateKey(String key, JoinPoint joinPoint) {
// TODO add some smart staff to allow simple scripting in @Cachable annotation
return key;
}
protected Map<String, Object> cache = new WeakHashMap<String, Object>();
}

View File

@@ -0,0 +1,50 @@
package aspects.caching;
import java.util.Map;
/**
* Cache aspect for optimize recursive functions.
*
* @author Migueli
* @date 05/11/2013
* @version 1.0
*
*/
public abstract aspect OptimizeRecursionCache {
@SuppressWarnings("rawtypes")
private Map _cache;
public OptimizeRecursionCache() {
_cache = getCache();
}
@SuppressWarnings("rawtypes")
abstract public Map getCache();
abstract public pointcut operation(Object o);
pointcut topLevelOperation(Object o): operation(o) && !cflowbelow(operation(Object));
before(Object o) : topLevelOperation(o) {
System.out.println("Seeking value for " + o);
}
Object around(Object o) : operation(o) {
Object cachedValue = _cache.get(o);
if (cachedValue != null) {
System.out.println("Found cached value for " + o + ": " + cachedValue);
return cachedValue;
}
return proceed(o);
}
@SuppressWarnings("unchecked")
after(Object o) returning(Object result) : topLevelOperation(o) {
_cache.put(o, result);
}
after(Object o) returning(Object result) : topLevelOperation(o) {
System.out.println("cache size: " + _cache.size());
}
}

530
samples/C++/Math.inl Normal file
View File

@@ -0,0 +1,530 @@
/*
===========================================================================
The Open Game Libraries.
Copyright (C) 2007-2010 Lusito Software
Author: Santo Pfingsten (TTK-Bandit)
Purpose: Math namespace
-----------------------------------------
This software is provided 'as-is', without any express or implied
warranty. In no event will the authors be held liable for any damages
arising from the use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software
in a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
===========================================================================
*/
#ifndef __OG_MATH_INL__
#define __OG_MATH_INL__
namespace og {
/*
==============================================================================
Math
==============================================================================
*/
/*
================
Math::Abs
================
*/
OG_INLINE int Math::Abs( int i ) {
#if 1
if ( i & 0x80000000 )
return 0x80000000 - (i & MASK_SIGNED);
return i;
#else
int y = x >> 31;
return ( ( x ^ y ) - y );
#endif
}
/*
================
Math::Fabs
================
*/
OG_INLINE float Math::Fabs( float f ) {
#if 1
uInt *pf = reinterpret_cast<uInt*>(&f);
*(pf) &= MASK_SIGNED;
return f;
#else
return fabsf( f );
#endif
}
/*
================
Math::Round
================
*/
OG_INLINE float Math::Round( float f ) {
return floorf( f + 0.5f );
}
/*
================
Math::Floor
================
*/
OG_INLINE float Math::Floor( float f ) {
return floorf( f );
}
/*
================
Math::Ceil
================
*/
OG_INLINE float Math::Ceil( float f ) {
return ceilf( f );
}
/*
================
Math::Ftoi
ok since this is SSE, why should the other ftoi be the faster one ?
and: we might need to add a check for SSE extensions..
because sse isn't *really* faster (I actually read that GCC does not handle
SSE extensions perfectly. I'll find the link and send it to you when you're online)
================
*/
OG_INLINE int Math::Ftoi( float f ) {
//! @todo needs testing
// note: sse function cvttss2si
#if OG_ASM_MSVC
int i;
#if defined(OG_FTOI_USE_SSE)
if( SysInfo::cpu.general.SSE ) {
__asm cvttss2si eax, f
__asm mov i, eax
return i;
} else
#endif
{
__asm fld f
__asm fistp i
//__asm mov eax, i // do we need this ? O_o
}
return i;
#elif OG_ASM_GNU
int i;
#if defined(OG_FTOI_USE_SSE)
if( SysInfo::cpu.general.SSE ) {
__asm__ __volatile__( "cvttss2si %1 \n\t"
: "=m" (i)
: "m" (f)
);
} else
#endif
{
__asm__ __volatile__( "flds %1 \n\t"
"fistpl %0 \n\t"
: "=m" (i)
: "m" (f)
);
}
return i;
#else
// we use c++ cast instead of c cast (not sure why id did that)
return static_cast<int>(f);
#endif
}
/*
================
Math::FtoiFast
================
*/
OG_INLINE int Math::FtoiFast( float f ) {
#if OG_ASM_MSVC
int i;
__asm fld f
__asm fistp i
//__asm mov eax, i // do we need this ? O_o
return i;
#elif OG_ASM_GNU
int i;
__asm__ __volatile__( "flds %1 \n\t"
"fistpl %0 \n\t"
: "=m" (i)
: "m" (f)
);
return i;
#else
// we use c++ cast instead of c cast (not sure why id did that)
return static_cast<int>(f);
#endif
}
/*
================
Math::Ftol
================
*/
OG_INLINE long Math::Ftol( float f ) {
#if OG_ASM_MSVC
long i;
__asm fld f
__asm fistp i
//__asm mov eax, i // do we need this ? O_o
return i;
#elif OG_ASM_GNU
long i;
__asm__ __volatile__( "flds %1 \n\t"
"fistpl %0 \n\t"
: "=m" (i)
: "m" (f)
);
return i;
#else
// we use c++ cast instead of c cast (not sure why id did that)
return static_cast<long>(f);
#endif
}
/*
================
Math::Sign
================
*/
OG_INLINE float Math::Sign( float f ) {
if ( f > 0.0f )
return 1.0f;
if ( f < 0.0f )
return -1.0f;
return 0.0f;
}
/*
================
Math::Fmod
================
*/
OG_INLINE float Math::Fmod( float numerator, float denominator ) {
return fmodf( numerator, denominator );
}
/*
================
Math::Modf
================
*/
OG_INLINE float Math::Modf( float f, float& i ) {
return modff( f, &i );
}
OG_INLINE float Math::Modf( float f ) {
float i;
return modff( f, &i );
}
/*
================
Math::Sqrt
================
*/
OG_INLINE float Math::Sqrt( float f ) {
return sqrtf( f );
}
/*
================
Math::InvSqrt
Cannot be 0.0f
================
*/
OG_INLINE float Math::InvSqrt( float f ) {
OG_ASSERT( f != 0.0f );
return 1.0f / sqrtf( f );
}
/*
================
Math::RSqrt
Can be 0.0f
================
*/
OG_INLINE float Math::RSqrt( float f ) {
float g = 0.5f * f;
int i = *reinterpret_cast<int *>(&f);
// do a guess
i = 0x5f375a86 - ( i>>1 );
f = *reinterpret_cast<float *>(&i);
// Newtons calculation
f = f * ( 1.5f - g * f * f );
return f;
}
/*
================
Math::Log/Log2/Log10
Log of 0 is bad.
I've also heard you're not really
supposed to do log of negatives, yet
they work fine.
================
*/
OG_INLINE float Math::Log( float f ) {
OG_ASSERT( f != 0.0f );
return logf( f );
}
OG_INLINE float Math::Log2( float f ) {
OG_ASSERT( f != 0.0f );
return INV_LN_2 * logf( f );
}
OG_INLINE float Math::Log10( float f ) {
OG_ASSERT( f != 0.0f );
return INV_LN_10 * logf( f );
}
/*
================
Math::Pow
================
*/
OG_INLINE float Math::Pow( float base, float exp ) {
return powf( base, exp );
}
/*
================
Math::Exp
================
*/
OG_INLINE float Math::Exp( float f ) {
return expf( f );
}
/*
================
Math::IsPowerOfTwo
================
*/
OG_INLINE bool Math::IsPowerOfTwo( int x ) {
// This is the faster of the two known methods
// with the x > 0 check moved to the beginning
return x > 0 && ( x & ( x - 1 ) ) == 0;
}
/*
================
Math::HigherPowerOfTwo
================
*/
OG_INLINE int Math::HigherPowerOfTwo( int x ) {
x--;
x |= x >> 1;
x |= x >> 2;
x |= x >> 4;
x |= x >> 8;
x |= x >> 16;
return x + 1;
}
/*
================
Math::LowerPowerOfTwo
================
*/
OG_INLINE int Math::LowerPowerOfTwo( int x ) {
return HigherPowerOfTwo( x ) >> 1;
}
/*
================
Math::FloorPowerOfTwo
================
*/
OG_INLINE int Math::FloorPowerOfTwo( int x ) {
return IsPowerOfTwo( x ) ? x : LowerPowerOfTwo( x );
}
/*
================
Math::CeilPowerOfTwo
================
*/
OG_INLINE int Math::CeilPowerOfTwo( int x ) {
return IsPowerOfTwo( x ) ? x : HigherPowerOfTwo( x );
}
/*
================
Math::ClosestPowerOfTwo
================
*/
OG_INLINE int Math::ClosestPowerOfTwo( int x ) {
if ( IsPowerOfTwo( x ) )
return x;
int high = HigherPowerOfTwo( x );
int low = high >> 1;
return ((high-x) < (x-low)) ? high : low;
}
/*
================
Math::Digits
================
*/
OG_INLINE int Math::Digits( int x ) {
int digits = 1;
int step = 10;
while (step <= x) {
digits++;
step *= 10;
}
return digits;
}
/*
================
Math::Sin/ASin
================
*/
OG_INLINE float Math::Sin( float f ) {
return sinf( f );
}
OG_INLINE float Math::ASin( float f ) {
if ( f <= -1.0f )
return -HALF_PI;
if ( f >= 1.0f )
return HALF_PI;
return asinf( f );
}
/*
================
Math::Cos/ACos
================
*/
OG_INLINE float Math::Cos( float f ) {
return cosf( f );
}
OG_INLINE float Math::ACos( float f ) {
if ( f <= -1.0f )
return PI;
if ( f >= 1.0f )
return 0.0f;
return acosf( f );
}
/*
================
Math::Tan/ATan
================
*/
OG_INLINE float Math::Tan( float f ) {
return tanf( f );
}
OG_INLINE float Math::ATan( float f ) {
return atanf( f );
}
OG_INLINE float Math::ATan( float f1, float f2 ) {
return atan2f( f1, f2 );
}
/*
================
Math::SinCos
================
*/
OG_INLINE void Math::SinCos( float f, float &s, float &c ) {
#if OG_ASM_MSVC
// sometimes assembler is just waaayy faster
_asm {
fld f
fsincos
mov ecx, c
mov edx, s
fstp dword ptr [ecx]
fstp dword ptr [edx]
}
#elif OG_ASM_GNU
asm ("fsincos" : "=t" (c), "=u" (s) : "0" (f));
#else
s = Sin(f);
c = Sqrt( 1.0f - s * s ); // faster than calling Cos(f)
#endif
}
/*
================
Math::Deg2Rad
================
*/
OG_INLINE float Math::Deg2Rad( float f ) {
return f * DEG_TO_RAD;
}
/*
================
Math::Rad2Deg
================
*/
OG_INLINE float Math::Rad2Deg( float f ) {
return f * RAD_TO_DEG;
}
/*
================
Math::Square
================
*/
OG_INLINE float Math::Square( float v ) {
return v * v;
}
/*
================
Math::Cube
================
*/
OG_INLINE float Math::Cube( float v ) {
return v * v * v;
}
/*
================
Math::Sec2Ms
================
*/
OG_INLINE int Math::Sec2Ms( int sec ) {
return sec * 1000;
}
/*
================
Math::Ms2Sec
================
*/
OG_INLINE int Math::Ms2Sec( int ms ) {
return FtoiFast( ms * 0.001f );
}
}
#endif

View File

@@ -0,0 +1,82 @@
;; @file macros-advanced.cl
;;
;; @breif Advanced macro practices - defining your own macros
;;
;; Macro definition skeleton:
;; (defmacro name (parameter*)
;; "Optional documentation string"
;; body-form*)
;;
;; Note that backquote expression is most often used in the `body-form`
;;
; `primep` test a number for prime
(defun primep (n)
"test a number for prime"
(if (< n 2) (return-from primep))
(do ((i 2 (1+ i)) (p t (not (zerop (mod n i)))))
((> i (sqrt n)) p)
(when (not p) (return))))
; `next-prime` return the next prime bigger than the specified number
(defun next-prime (n)
"return the next prime bigger than the speicified number"
(do ((i (1+ n) (1+ i)))
((primep i) i)))
;
; The recommended procedures to writting a new macro are as follows:
; 1. Write a sample call to the macro and the code it should expand into
(do-primes (p 0 19)
(format t "~d " p))
; Expected expanded codes
(do ((p (next-prime (- 0 1)) (next-prime p)))
((> p 19))
(format t "~d " p))
; 2. Write code that generate the hardwritten expansion from the arguments in
; the sample call
(defmacro do-primes (var-and-range &rest body)
(let ((var (first var-and-range))
(start (second var-and-range))
(end (third var-and-range)))
`(do ((,var (next-prime (- ,start 1)) (next-prime ,var)))
((> ,var ,end))
,@body)))
; 2-1. More concise implementations with the 'parameter list destructuring' and
; '&body' synonym, it also emits more friendly messages on incorrent input.
(defmacro do-primes ((var start end) &body body)
`(do ((,var (next-prime (- ,start 1)) (next-prime ,var)))
((> ,var ,end))
,@body))
; 2-2. Test the result of macro expansion with the `macroexpand-1` function
(macroexpand-1 '(do-primes (p 0 19) (format t "~d " p)))
; 3. Make sure the macro abstraction does not "leak"
(defmacro do-primes ((var start end) &body body)
(let ((end-value-name (gensym)))
`(do ((,var (next-prime (- ,start 1)) (next-prime ,var))
(,end-value-name ,end))
((> ,var ,end-value-name))
,@body)))
; 3-1. Rules to observe to avoid common and possible leaks
; a. include any subforms in the expansion in positions that will be evaluated
; in the same order as the subforms appear in the macro call
; b. make sure subforms are evaluated only once by creating a variable in the
; expansion to hold the value of evaluating the argument form, and then
; using that variable anywhere else the value is needed in the expansion
; c. use `gensym` at macro expansion time to create variable names used in the
; expansion
;
; Appendix I. Macro-writting macros, 'with-gensyms', to guranttee that rule c
; gets observed.
; Example usage of `with-gensyms`
(defmacro do-primes-a ((var start end) &body body)
"do-primes implementation with macro-writting macro 'with-gensyms'"
(with-gensyms (end-value-name)
`(do ((,var (next-prime (- ,start 1)) (next-prime ,var))
(,end-value-name ,end))
((> ,var ,end-value-name))
,@body)))
; Define the macro, note how comma is used to interpolate the value of the loop
; expression
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,@body)
)

View File

@@ -0,0 +1,475 @@
#|
ESCUELA POLITECNICA SUPERIOR - UNIVERSIDAD AUTONOMA DE MADRID
INTELIGENCIA ARTIFICIAL
Motor de inferencia
Basado en parte en "Paradigms of AI Programming: Case Studies
in Common Lisp", de Peter Norvig, 1992
|#
;;;;;;;;;;;;;;;;;;;;;
;;;; Global variables
;;;;;;;;;;;;;;;;;;;;;
(defvar *hypothesis-list*)
(defvar *rule-list*)
(defvar *fact-list*)
;;;;;;;;;;;;;;;;;;;;;
;;;; Constants
;;;;;;;;;;;;;;;;;;;;;
(defconstant +fail+ nil "Indicates unification failure")
(defconstant +no-bindings+ '((nil))
"Indicates unification success, with no variables.")
(defconstant *mundo-abierto* nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Functions for the user
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Resets *fact-list* to NIL
(defun erase-facts () (setq *fact-list* nil))
(defun set-hypothesis-list (h) (setq *hypothesis-list* h))
;; Returns a list of solutions, each one satisfying all the hypothesis contained
;; in *hypothesis-list*
(defun motor-inferencia ()
(consulta *hypothesis-list*))
;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Auxiliary functions
;;;;;;;;;;;;;;;;;;;;;;;;
#|____________________________________________________________________________
FUNCTION: CONSULTA
COMMENTS:
CONSULTA receives a list of hypothesis (variable <hypotheses>), and returns
a list of binding lists (each binding list being a solution).
EXAMPLES:
hypotheses is:
((brothers ?x ?y) (neighbours juan ?x)).
That is, we are searching the brothers of the possible neighbors of Juan.
The function can return in this case:
(((?x . sergio) (?y . javier)) ((?x . julian) (?y . mario)) ((?x . julian) (?y . pedro))).
That is, the neighbors of Juan (Sergio and Julian) have 3 brothers in total(Javier, Mario, Pedro)
____________________________________________________________________________|#
(defun consulta (hypotheses)
(if (null hypotheses) (list +no-bindings+)
(mapcan #'(lambda (b)
(mapcar #'(lambda (x) (une-bindings-con-bindings b x))
(consulta (subst-bindings b (rest hypotheses)))))
(find-hypothesis-value (first hypotheses)))))
#|____________________________________________________________________________
FUNCTION: FIND-HYPOTHESIS-VALUE
COMMENTS:
This function manages the query a single query (only one hypothesis) given a binding list.
It tries (in the following order) to:
- Answer the query from *fact-list*
- Answer the query from the rules in *rule-list*
- Ask the user
The function returns a list of solutions (list of binding lists).
EXAMPLES:
If hypothesis is (brothers ?x ?y)
and the function returns:
(((?x . sergio) (?y . javier)) ((?x . julian) (?y . maria)) ((?x . alberto) (?y . pedro))).
Means that Sergio and Javier and brothers, Julian and Mario are brothers, and Alberto and Pedro are brothers.
____________________________________________________________________________|#
(defun find-hypothesis-value (hypothesis)
(let (rules)
(cond
((equality? hypothesis)
(value-from-equality hypothesis))
((value-from-facts hypothesis))
((setq good-rules (find-rules hypothesis))
(value-from-rules hypothesis good-rules))
(t (ask-user hypothesis)))))
; une-bindings-con-bindings takes two binding lists and returns a binding list
; Assumes that b1 and b2 are not +fail+
(defun une-bindings-con-bindings (b1 b2)
(cond
((equal b1 +no-bindings+) b2)
((equal b2 +no-bindings+) b1)
(T (append b1 b2))))
#|____________________________________________________________________________
FUNCTION: VALUE-FROM-FACTS
COMMENTS:
Returns all the solutions of <hypothesis> obtained directly from *fact-list*
EXAMPLES:
> (setf *fact-list* '((man luis) (man pedro)(woman mart)(man daniel)(woman laura)))
> (value-from-facts '(man ?x))
returns:
(((?X . LUIS)) ((?X . PEDRO)) ((?X . DANIEL)))
____________________________________________________________________________|#
(defun value-from-facts (hypothesis)
(mapcan #'(lambda(x) (let ((aux (unify hypothesis x)))
(when aux (list aux)))) *fact-list*))
#|____________________________________________________________________________
FUNCTION: FIND-RULES
COMMENTS:
Returns the rules in *rule-list* whose THENs unify with the term given in <hypothesis>
The variables in the rules that satisfy this requirement are renamed.
EXAMPLES:
> (setq *rule-list*
'((R1 (pertenece ?E (?E . ?_)))
(R2 (pertenece ?E (?_ . ?Xs)) :- ((pertenece ?E ?Xs)))))
Then:
> (FIND-RULES (PERTENECE 1 (2 5)))
returns:
((R2 (PERTENECE ?E.1 (?_ . ?XS.2)) :- ((PERTENECE ?E.1 ?XS.2))))
That is, only the THEN of rule R2 unify with <hypothesis>
However,
> (FIND-RULES (PERTENECE 1 (1 6 7)))
returns:
((R1 (PERTENECE ?E.6 (?E.6 . ?_)))
(R2 (PERTENECE ?E.7 (?_ . ?XS.8)) :- ((PERTENECE ?E.7 ?XS.8))))
So the THEN of both rules unify with <hypothesis>
____________________________________________________________________________|#
(defun find-rules (hypothesis)
(mapcan #'(lambda(b) (let ((renamed-rule (rename-variables b)))
(when (in-then? hypothesis renamed-rule)
(list renamed-rule)))) *rule-list*))
(defun in-then? (hypothesis rule)
(unless (null (rule-then rule))
(not (equal +fail+ (unify hypothesis (rule-then rule))))))
#|____________________________________________________________________________
FUNCTION: VALUE-FROM-RULES
COMMENTS:
Returns all the solutions to <hypothesis> found using all the rules given in
the list <rules>. Note that a single rule can have multiple solutions.
____________________________________________________________________________|#
(defun value-from-rules (hypothesis rules)
(mapcan #'(lambda (r) (eval-rule hypothesis r)) rules))
(defun limpia-vinculos (termino bindings)
(unify termino (subst-bindings bindings termino)))
#|____________________________________________________________________________
FUNCTION: EVAL-RULE
COMMENTS:
Returns all the solutions found using the rule given as input argument.
EXAMPLES:
> (setq *rule-list*
'((R1 (pertenece ?E (?E . ?_)))
(R2 (pertenece ?E (?_ . ?Xs)) :- ((pertenece ?E ?Xs)))))
Then:
> (EVAL-RULE
(PERTENECE 1 (1 6 7))
(R1 (PERTENECE ?E.42 (?E.42 . ?_))))
returns:
(((NIL)))
That is, the query (PERTENECE 1 (1 6 7)) can be proven from the given rule, and
no binding in the variables in the query is necessary (in fact, the query has no variables).
On the other hand:
> (EVAL-RULE
(PERTENECE 1 (7))
(R2 (PERTENECE ?E.49 (?_ . ?XS.50)) :- ((PERTENECE ?E.49 ?XS.50))))
returns:
NIL
That is, the query can not be proven from the rule R2.
____________________________________________________________________________|#
(defun eval-rule (hypothesis rule)
(let ((bindings-then
(unify (rule-then rule) hypothesis)))
(unless (equal +fail+ bindings-then)
(if (rule-ifs rule)
(mapcar #'(lambda(b) (limpia-vinculos hypothesis (append bindings-then b)))
(consulta (subst-bindings bindings-then (rule-ifs rule))))
(list (limpia-vinculos hypothesis bindings-then))))))
(defun ask-user (hypothesis)
(let ((question hypothesis))
(cond
((variables-in question) +fail+)
((not-in-fact-list? question) +fail+)
(*mundo-abierto*
(format t "~%Es cierto el hecho ~S? (T/nil)" question)
(cond
((read) (add-fact question) +no-bindings+)
(T (add-fact (list 'NOT question)) +fail+)))
(T +fail+))))
; value-from-equality:
(defun value-from-equality (hypothesis)
(let ((new-bindings (unify (second hypothesis) (third hypothesis))))
(if (not (equal +fail+ new-bindings))
(list new-bindings))))
#|____________________________________________________________________________
FUNCTION: UNIFY
COMMENTS:
Finds the most general unifier of two input expressions, taking into account the
bindings specified in the input <bingings>
In case the two expressions can unify, the function returns the total bindings necessary
for that unification. Otherwise, returns +fail+
EXAMPLES:
> (unify '1 '1)
((NIL)) ;; which is the constant +no-bindings+
> (unify 1 '2)
nil ;; which is the constant +fail+
> (unify '?x 1)
((?x . 1))
> (unify '(1 1) ?x)
((? x 1 1))
> (unify '?_ '?x)
((NIL))
> (unify '(p ?x 1 2) '(p ?y ?_ ?_))
((?x . ?y))
> (unify '(?a . ?_) '(1 2 3))
((?a . 1))
> (unify '(?_ ?_) '(1 2))
((nil))
> (unify '(?a . ?b) '(1 2 3))
((?b 2 3) (?a . 1))
> (unify '(?a . ?b) '(?v . ?d))
((?b . ?d) (?a . ?v))
> (unify '(?eval (+ 1 1)) '1)
nil
> (unify '(?eval (+ 1 1)) '2)
(nil))
____________________________________________________________________________|#
(defun unify (x y &optional (bindings +no-bindings+))
"See if x and y match with given bindings. If they do,
return a binding list that would make them equal [p 303]."
(cond ((eq bindings +fail+) +fail+)
((eql x y) bindings)
((eval? x) (unify-eval x y bindings))
((eval? y) (unify-eval y x bindings))
((variable? x) (unify-var x y bindings))
((variable? y) (unify-var y x bindings))
((and (consp x) (consp y))
(unify (rest x) (rest y)
(unify (first x) (first y) bindings)))
(t +fail+)))
;; rename-variables: renombra ?X por ?X.1, ?Y por ?Y.2 etc. salvo ?_ que no se renombra
(defun rename-variables (x)
"Replace all variables in x with new ones. Excepto ?_"
(sublis (mapcar #'(lambda (var)
(if (anonymous-var? var)
(make-binding var var)
(make-binding var (new-variable var))))
(variables-in x))
x))
;;;; Auxiliary Functions
(defun unify-var (var x bindings)
"Unify var with x, using (and maybe extending) bindings [p 303]."
(cond ((or (anonymous-var? var)(anonymous-var? x)) bindings)
((get-binding var bindings)
(unify (lookup var bindings) x bindings))
((and (variable? x) (get-binding x bindings))
(unify var (lookup x bindings) bindings))
((occurs-in? var x bindings)
+fail+)
(t (extend-bindings var x bindings))))
(defun variable? (x)
"Is x a variable (a symbol starting with ?)?"
(and (symbolp x) (eql (char (symbol-name x) 0) #\?)))
(defun get-binding (var bindings)
"Find a (variable . value) pair in a binding list."
(assoc var bindings))
(defun binding-var (binding)
"Get the variable part of a single binding."
(car binding))
(defun binding-val (binding)
"Get the value part of a single binding."
(cdr binding))
(defun make-binding (var val) (cons var val))
(defun lookup (var bindings)
"Get the value part (for var) from a binding list."
(binding-val (get-binding var bindings)))
(defun extend-bindings (var val bindings)
"Add a (var . value) pair to a binding list."
(append
(unless (eq bindings +no-bindings+) bindings)
(list (make-binding var val))))
(defun occurs-in? (var x bindings)
"Does var occur anywhere inside x?"
(cond ((eq var x) t)
((and (variable? x) (get-binding x bindings))
(occurs-in? var (lookup x bindings) bindings))
((consp x) (or (occurs-in? var (first x) bindings)
(occurs-in? var (rest x) bindings)))
(t nil)))
(defun subst-bindings (bindings x)
"Substitute the value of variables in bindings into x,
taking recursively bound variables into account."
(cond ((eq bindings +fail+) +fail+)
((eq bindings +no-bindings+) x)
((and (listp x) (eq '?eval (car x)))
(subst-bindings-quote bindings x))
((and (variable? x) (get-binding x bindings))
(subst-bindings bindings (lookup x bindings)))
((atom x) x)
(t (cons (subst-bindings bindings (car x)) ;; s/reuse-cons/cons
(subst-bindings bindings (cdr x))))))
(defun unifier (x y)
"Return something that unifies with both x and y (or fail)."
(subst-bindings (unify x y) x))
(defun variables-in (exp)
"Return a list of all the variables in EXP."
(unique-find-anywhere-if #'variable? exp))
(defun unique-find-anywhere-if (predicate tree &optional found-so-far)
"Return a list of leaves of tree satisfying predicate,
with duplicates removed."
(if (atom tree)
(if (funcall predicate tree)
(pushnew tree found-so-far)
found-so-far)
(unique-find-anywhere-if
predicate
(first tree)
(unique-find-anywhere-if predicate (rest tree)
found-so-far))))
(defun find-anywhere-if (predicate tree)
"Does predicate apply to any atom in the tree?"
(if (atom tree)
(funcall predicate tree)
(or (find-anywhere-if predicate (first tree))
(find-anywhere-if predicate (rest tree)))))
(defun new-variable (var)
"Create a new variable. Assumes user never types variables of form ?X.9"
(gentemp (format nil "~S." var)))
; (gentemp "?") )
;;;
(defun anonymous-var? (x)
(eq x '?_))
(defun subst-bindings-quote (bindings x)
"Substitute the value of variables in bindings into x,
taking recursively bound variables into account."
(cond ((eq bindings +fail+) +fail+)
((eq bindings +no-bindings+) x)
((and (variable? x) (get-binding x bindings))
(if (variable? (lookup x bindings))
(subst-bindings-quote bindings (lookup x bindings))
(subst-bindings-quote bindings (list 'quote (lookup x bindings)))
)
)
((atom x) x)
(t (cons (subst-bindings-quote bindings (car x)) ;; s/reuse-cons/cons
(subst-bindings-quote bindings (cdr x))))))
(defun eval? (x)
(and (consp x) (eq (first x) '?eval)))
(defun unify-eval (x y bindings)
(let ((exp (subst-bindings-quote bindings (second x))))
(if (variables-in exp)
+fail+
(unify (eval exp) y bindings))))
(defun rule-ifs (rule) (fourth rule))
(defun rule-then (rule) (second rule))
(defun equality? (term)
(and (consp term) (eql (first term) '?=)))
(defun in-fact-list? (expresion)
(some #'(lambda(x) (equal x expresion)) *fact-list*))
(defun not-in-fact-list? (expresion)
(if (eq (car expresion) 'NOT)
(in-fact-list? (second expresion))
(in-fact-list? (list 'NOT expresion))))
;; add-fact:
(defun add-fact (fact)
(setq *fact-list* (cons fact *fact-list*)))
(defun variable? (x)
"Is x a variable (a symbol starting with ?) except ?eval and ?="
(and (not (equal x '?eval)) (not (equal x '?=))
(symbolp x) (eql (char (symbol-name x) 0) #\?)))
;; EOF

View File

@@ -0,0 +1,169 @@
#!/usr/bin/env bin/crystal --run
require "../../spec_helper"
describe "Codegen: const" do
it "define a constant" do
run("A = 1; A").to_i.should eq(1)
end
it "support nested constant" do
run("class B; A = 1; end; B::A").to_i.should eq(1)
end
it "support constant inside a def" do
run("
class Foo
A = 1
def foo
A
end
end
Foo.new.foo
").to_i.should eq(1)
end
it "finds nearest constant first" do
run("
A = 1
class Foo
A = 2.5_f32
def foo
A
end
end
Foo.new.foo
").to_f32.should eq(2.5)
end
it "allows constants with same name" do
run("
A = 1
class Foo
A = 2.5_f32
def foo
A
end
end
A
Foo.new.foo
").to_f32.should eq(2.5)
end
it "constants with expression" do
run("
A = 1 + 1
A
").to_i.should eq(2)
end
it "finds global constant" do
run("
A = 1
class Foo
def foo
A
end
end
Foo.new.foo
").to_i.should eq(1)
end
it "define a constant in lib" do
run("lib Foo; A = 1; end; Foo::A").to_i.should eq(1)
end
it "invokes block in const" do
run("require \"prelude\"; A = [\"1\"].map { |x| x.to_i }; A[0]").to_i.should eq(1)
end
it "declare constants in right order" do
run("A = 1 + 1; B = true ? A : 0; B").to_i.should eq(2)
end
it "uses correct types lookup" do
run("
module A
class B
def foo
1
end
end
C = B.new;
end
def foo
A::C.foo
end
foo
").to_i.should eq(1)
end
it "codegens variable assignment in const" do
run("
class Foo
def initialize(@x)
end
def x
@x
end
end
A = begin
f = Foo.new(1)
f
end
def foo
A.x
end
foo
").to_i.should eq(1)
end
it "declaring var" do
run("
BAR = begin
a = 1
while 1 == 2
b = 2
end
a
end
class Foo
def compile
BAR
end
end
Foo.new.compile
").to_i.should eq(1)
end
it "initialize const that might raise an exception" do
run("
require \"prelude\"
CONST = (raise \"OH NO\" if 1 == 2)
def doit
CONST
rescue
end
doit.nil?
").to_b.should be_true
end
end

View File

@@ -0,0 +1,79 @@
#!/usr/bin/env bin/crystal --run
require "../../spec_helper"
describe "Type inference: declare var" do
it "types declare var" do
assert_type("a :: Int32") { int32 }
end
it "types declare var and reads it" do
assert_type("a :: Int32; a") { int32 }
end
it "types declare var and changes its type" do
assert_type("a :: Int32; while 1 == 2; a = 'a'; end; a") { union_of(int32, char) }
end
it "declares instance var which appears in initialize" do
result = assert_type("
class Foo
@x :: Int32
end
Foo.new") { types["Foo"] }
mod = result.program
foo = mod.types["Foo"] as NonGenericClassType
foo.instance_vars["@x"].type.should eq(mod.int32)
end
it "declares instance var of generic class" do
result = assert_type("
class Foo(T)
@x :: T
end
Foo(Int32).new") do
foo = types["Foo"] as GenericClassType
foo_i32 = foo.instantiate([int32] of Type | ASTNode)
foo_i32.lookup_instance_var("@x").type.should eq(int32)
foo_i32
end
end
it "declares instance var of generic class after reopen" do
result = assert_type("
class Foo(T)
end
f = Foo(Int32).new
class Foo(T)
@x :: T
end
f") do
foo = types["Foo"] as GenericClassType
foo_i32 = foo.instantiate([int32] of Type | ASTNode)
foo_i32.lookup_instance_var("@x").type.should eq(int32)
foo_i32
end
end
it "declares an instance variable in initialize" do
assert_type("
class Foo
def initialize
@x :: Int32
end
def x
@x
end
end
Foo.new.x
") { int32 }
end
end

View File

@@ -0,0 +1,515 @@
module Crystal
class ASTNode
def transform(transformer)
transformer.before_transform self
node = transformer.transform self
transformer.after_transform self
node
end
end
class Transformer
def before_transform(node)
end
def after_transform(node)
end
def transform(node : Expressions)
exps = [] of ASTNode
node.expressions.each do |exp|
new_exp = exp.transform(self)
if new_exp
if new_exp.is_a?(Expressions)
exps.concat new_exp.expressions
else
exps << new_exp
end
end
end
if exps.length == 1
exps[0]
else
node.expressions = exps
node
end
end
def transform(node : Call)
if node_obj = node.obj
node.obj = node_obj.transform(self)
end
transform_many node.args
if node_block = node.block
node.block = node_block.transform(self)
end
if node_block_arg = node.block_arg
node.block_arg = node_block_arg.transform(self)
end
node
end
def transform(node : And)
node.left = node.left.transform(self)
node.right = node.right.transform(self)
node
end
def transform(node : Or)
node.left = node.left.transform(self)
node.right = node.right.transform(self)
node
end
def transform(node : StringInterpolation)
transform_many node.expressions
node
end
def transform(node : ArrayLiteral)
transform_many node.elements
if node_of = node.of
node.of = node_of.transform(self)
end
node
end
def transform(node : HashLiteral)
transform_many node.keys
transform_many node.values
if of_key = node.of_key
node.of_key = of_key.transform(self)
end
if of_value = node.of_value
node.of_value = of_value.transform(self)
end
node
end
def transform(node : If)
node.cond = node.cond.transform(self)
node.then = node.then.transform(self)
node.else = node.else.transform(self)
node
end
def transform(node : Unless)
node.cond = node.cond.transform(self)
node.then = node.then.transform(self)
node.else = node.else.transform(self)
node
end
def transform(node : IfDef)
node.cond = node.cond.transform(self)
node.then = node.then.transform(self)
node.else = node.else.transform(self)
node
end
def transform(node : MultiAssign)
transform_many node.targets
transform_many node.values
node
end
def transform(node : SimpleOr)
node.left = node.left.transform(self)
node.right = node.right.transform(self)
node
end
def transform(node : Def)
transform_many node.args
node.body = node.body.transform(self)
if receiver = node.receiver
node.receiver = receiver.transform(self)
end
if block_arg = node.block_arg
node.block_arg = block_arg.transform(self)
end
node
end
def transform(node : Macro)
transform_many node.args
node.body = node.body.transform(self)
if receiver = node.receiver
node.receiver = receiver.transform(self)
end
if block_arg = node.block_arg
node.block_arg = block_arg.transform(self)
end
node
end
def transform(node : PointerOf)
node.exp = node.exp.transform(self)
node
end
def transform(node : SizeOf)
node.exp = node.exp.transform(self)
node
end
def transform(node : InstanceSizeOf)
node.exp = node.exp.transform(self)
node
end
def transform(node : IsA)
node.obj = node.obj.transform(self)
node.const = node.const.transform(self)
node
end
def transform(node : RespondsTo)
node.obj = node.obj.transform(self)
node
end
def transform(node : Case)
node.cond = node.cond.transform(self)
transform_many node.whens
if node_else = node.else
node.else = node_else.transform(self)
end
node
end
def transform(node : When)
transform_many node.conds
node.body = node.body.transform(self)
node
end
def transform(node : ImplicitObj)
node
end
def transform(node : ClassDef)
node.body = node.body.transform(self)
if superclass = node.superclass
node.superclass = superclass.transform(self)
end
node
end
def transform(node : ModuleDef)
node.body = node.body.transform(self)
node
end
def transform(node : While)
node.cond = node.cond.transform(self)
node.body = node.body.transform(self)
node
end
def transform(node : Generic)
node.name = node.name.transform(self)
transform_many node.type_vars
node
end
def transform(node : ExceptionHandler)
node.body = node.body.transform(self)
transform_many node.rescues
if node_ensure = node.ensure
node.ensure = node_ensure.transform(self)
end
node
end
def transform(node : Rescue)
node.body = node.body.transform(self)
transform_many node.types
node
end
def transform(node : Union)
transform_many node.types
node
end
def transform(node : Hierarchy)
node.name = node.name.transform(self)
node
end
def transform(node : Metaclass)
node.name = node.name.transform(self)
node
end
def transform(node : Arg)
if default_value = node.default_value
node.default_value = default_value.transform(self)
end
if restriction = node.restriction
node.restriction = restriction.transform(self)
end
node
end
def transform(node : BlockArg)
node.fun = node.fun.transform(self)
node
end
def transform(node : Fun)
transform_many node.inputs
if output = node.output
node.output = output.transform(self)
end
node
end
def transform(node : Block)
node.args.map! { |exp| exp.transform(self) as Var }
node.body = node.body.transform(self)
node
end
def transform(node : FunLiteral)
node.def.body = node.def.body.transform(self)
node
end
def transform(node : FunPointer)
if obj = node.obj
node.obj = obj.transform(self)
end
node
end
def transform(node : Return)
transform_many node.exps
node
end
def transform(node : Break)
transform_many node.exps
node
end
def transform(node : Next)
transform_many node.exps
node
end
def transform(node : Yield)
if scope = node.scope
node.scope = scope.transform(self)
end
transform_many node.exps
node
end
def transform(node : Include)
node.name = node.name.transform(self)
node
end
def transform(node : Extend)
node.name = node.name.transform(self)
node
end
def transform(node : RangeLiteral)
node.from = node.from.transform(self)
node.to = node.to.transform(self)
node
end
def transform(node : Assign)
node.target = node.target.transform(self)
node.value = node.value.transform(self)
node
end
def transform(node : Nop)
node
end
def transform(node : NilLiteral)
node
end
def transform(node : BoolLiteral)
node
end
def transform(node : NumberLiteral)
node
end
def transform(node : CharLiteral)
node
end
def transform(node : StringLiteral)
node
end
def transform(node : SymbolLiteral)
node
end
def transform(node : RegexLiteral)
node
end
def transform(node : Var)
node
end
def transform(node : MetaVar)
node
end
def transform(node : InstanceVar)
node
end
def transform(node : ClassVar)
node
end
def transform(node : Global)
node
end
def transform(node : Require)
node
end
def transform(node : Path)
node
end
def transform(node : Self)
node
end
def transform(node : LibDef)
node.body = node.body.transform(self)
node
end
def transform(node : FunDef)
if body = node.body
node.body = body.transform(self)
end
node
end
def transform(node : TypeDef)
node
end
def transform(node : StructDef)
node
end
def transform(node : UnionDef)
node
end
def transform(node : EnumDef)
node
end
def transform(node : ExternalVar)
node
end
def transform(node : IndirectRead)
node.obj = node.obj.transform(self)
node
end
def transform(node : IndirectWrite)
node.obj = node.obj.transform(self)
node.value = node.value.transform(self)
node
end
def transform(node : TypeOf)
transform_many node.expressions
node
end
def transform(node : Primitive)
node
end
def transform(node : Not)
node
end
def transform(node : TypeFilteredNode)
node
end
def transform(node : TupleLiteral)
transform_many node.exps
node
end
def transform(node : Cast)
node.obj = node.obj.transform(self)
node.to = node.to.transform(self)
node
end
def transform(node : DeclareVar)
node.var = node.var.transform(self)
node.declared_type = node.declared_type.transform(self)
node
end
def transform(node : Alias)
node.value = node.value.transform(self)
node
end
def transform(node : TupleIndexer)
node
end
def transform(node : Attribute)
node
end
def transform_many(exps)
exps.map! { |exp| exp.transform(self) } if exps
end
end
end

View File

@@ -0,0 +1,16 @@
quiet
wow
such language
very syntax
github recognized wow
loud
such language much friendly
rly friendly is true
plz console.loge with 'such friend, very inclusive'
but
plz console.loge with 'no love for doge'
wow
wow
module.exports is language

31
samples/E/Extends.E Normal file
View File

@@ -0,0 +1,31 @@
# from
# http://wiki.erights.org/wiki/Walnut/Ordinary_Programming/Objects_and_Functions
def makeVehicle(self) {
def vehicle {
to milesTillEmpty() {
return self.milesPerGallon() * self.getFuelRemaining()
}
}
return vehicle
}
def makeCar() {
var fuelRemaining := 20
def car extends makeVehicle(car) {
to milesPerGallon() {return 19}
to getFuelRemaining() {return fuelRemaining}
}
return car
}
def makeJet() {
var fuelRemaining := 2000
def jet extends makeVehicle(jet) {
to milesPerGallon() {return 2}
to getFuelRemaining() {return fuelRemaining}
}
return jet
}
def car := makeCar()
println(`The car can go ${car.milesTillEmpty()} miles.`)

21
samples/E/Functions.E Normal file
View File

@@ -0,0 +1,21 @@
# from
# http://wiki.erights.org/wiki/Walnut/Ordinary_Programming/Objects_and_Functions
def makeCar(var name) {
var x := 0
var y := 0
def car {
to moveTo(newX,newY) {
x := newX
y := newY
}
to getX() {return x}
to getY() {return y}
to setName(newName) {name := newName}
to getName() {return name}
}
return car
}
# Now use the makeCar function to make a car, which we will move and print
def sportsCar := makeCar("Ferrari")
sportsCar.moveTo(10,20)
println(`The car ${sportsCar.getName()} is at X location ${sportsCar.getX()}`)

69
samples/E/Guards.E Normal file
View File

@@ -0,0 +1,69 @@
# from
# http://wiki.erights.org/wiki/Walnut/Advanced_Topics/Build_your_Own_Guards
def makeVOCPair(brandName :String) :near {
var myTempContents := def none {}
def brand {
to __printOn(out :TextWriter) :void {
out.print(brandName)
}
}
def ProveAuth {
to __printOn(out :TextWriter) :void {
out.print(`<$brandName prover>`)
}
to getBrand() :near { return brand }
to coerce(specimen, optEjector) :near {
def sealedBox {
to getBrand() :near { return brand }
to offerContent() :void {
myTempContents := specimen
}
}
return sealedBox
}
}
def CheckAuth {
to __printOn(out :TextWriter) :void {
out.print(`<$brandName checker template>`)
}
to getBrand() :near { return brand }
match [`get`, authList :any[]] {
def checker {
to __printOn(out :TextWriter) :void {
out.print(`<$brandName checker>`)
}
to getBrand() :near { return brand }
to coerce(specimenBox, optEjector) :any {
myTempContents := null
if (specimenBox.__respondsTo("offerContent", 0)) {
# XXX Using __respondsTo/2 here is a kludge
specimenBox.offerContent()
} else {
myTempContents := specimenBox
}
for auth in authList {
if (auth == myTempContents) {
return auth
}
}
myTempContents := none
throw.eject(optEjector,
`Unmatched $brandName authorization`)
}
}
}
match [`__respondsTo`, [`get`, _]] {
true
}
match [`__respondsTo`, [_, _]] {
false
}
match [`__getAllegedType`, []] {
null.__getAllegedType()
}
}
return [ProveAuth, CheckAuth]
}

14
samples/E/IO.E Normal file
View File

@@ -0,0 +1,14 @@
# E sample from
# http://wiki.erights.org/wiki/Walnut/Ordinary_Programming/InputOutput
#File objects for hardwired files:
def file1 := <file:myFile.txt>
def file2 := <file:/home/marcs/myFile.txt>
#Using a variable for a file name:
def filePath := "c:\\docs\\myFile.txt"
def file3 := <file>[filePath]
#Using a single character to specify a Windows drive
def file4 := <file:c:/docs/myFile.txt>
def file5 := <c:/docs/myFile.txt>
def file6 := <c:\docs\myFile.txt>

9
samples/E/Promises.E Normal file
View File

@@ -0,0 +1,9 @@
# E snippet from
# http://wiki.erights.org/wiki/Walnut/Distributed_Computing/Promises
when (tempVow) -> {
#...use tempVow
} catch prob {
#.... report problem
} finally {
#....log event
}

18
samples/E/minChat.E Normal file
View File

@@ -0,0 +1,18 @@
# from
# http://wiki.erights.org/wiki/Walnut/Secure_Distributed_Computing/Auditing_minChat
pragma.syntax("0.9")
to send(message) {
when (friend<-receive(message)) -> {
chatUI.showMessage("self", message)
} catch prob {chatUI.showMessage("system", "connection lost")}
}
to receive(message) {chatUI.showMessage("friend", message)}
to receiveFriend(friendRcvr) {
bind friend := friendRcvr
chatUI.showMessage("system", "friend has arrived")
}
to save(file) {file.setText(makeURIFromObject(chatController))}
to load(file) {
bind friend := getObjectFromURI(file.getText())
friend <- receiveFriend(chatController)
}

1396
samples/Eagle/Eagle.brd Normal file

File diff suppressed because it is too large Load Diff

3612
samples/Eagle/Eagle.sch Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,44 @@
{--
This program displays the
current time on stdandard output
every other second.
-}
module examples.CommandLineClock where
data Date = native java.util.Date where
native new :: () -> IO (MutableIO Date) -- new Date()
native toString :: Mutable s Date -> ST s String -- d.toString()
--- 'IO' action to give us the current time as 'String'
current :: IO String
current = do
d <- Date.new ()
d.toString
{-
"java.lang.Thread.sleep" takes a "long" and
returns nothing, but may throw an InterruptedException.
This is without doubt an IO action.
public static void sleep(long millis)
throws InterruptedException
Encoded in Frege:
- argument type long Long
- result void ()
- does IO IO ()
- throws ... throws ....
-}
-- .... defined in frege.java.Lang
-- native sleep java.lang.Thread.sleep :: Long -> IO () throws InterruptedException
main args =
forever do
current >>= print
print "\r"
stdout.flush
Thread.sleep 999

147
samples/Frege/Concurrent.fr Normal file
View File

@@ -0,0 +1,147 @@
module examples.Concurrent where
import System.Random
import Java.Net (URL)
import Control.Concurrent as C
main2 args = do
m <- newEmptyMVar
forkIO do
m.put 'x'
m.put 'y'
m.put 'z'
replicateM_ 3 do
c <- m.take
print "got: "
println c
example1 = do
forkIO (replicateM_ 100000 (putChar 'a'))
replicateM_ 100000 (putChar 'b')
example2 = do
s <- getLine
case s.long of
Right n -> forkIO (setReminder n) >> example2
Left _ -> println ("exiting ...")
setReminder :: Long -> IO ()
setReminder n = do
println ("Ok, I remind you in " ++ show n ++ " seconds")
Thread.sleep (1000L*n)
println (show n ++ " seconds is up!")
table = "table"
mainPhil _ = do
[fork1,fork2,fork3,fork4,fork5] <- mapM MVar.new [1..5]
forkIO (philosopher "Kant" fork5 fork1)
forkIO (philosopher "Locke" fork1 fork2)
forkIO (philosopher "Wittgenstein" fork2 fork3)
forkIO (philosopher "Nozick" fork3 fork4)
forkIO (philosopher "Mises" fork4 fork5)
return ()
philosopher :: String -> MVar Int -> MVar Int -> IO ()
philosopher me left right = do
g <- Random.newStdGen
let phil g = do
let (tT,g1) = Random.randomR (60L, 120L) g
(eT, g2) = Random.randomR (80L, 160L) g1
thinkTime = 300L * tT
eatTime = 300L * eT
println(me ++ " is going to the dining room and takes his seat.")
fl <- left.take
println (me ++ " takes up left fork (" ++ show fl ++ ")")
rFork <- right.poll
case rFork of
Just fr -> do
println (me ++ " takes up right fork. (" ++ show fr ++ ")")
println (me ++ " is going to eat for " ++ show eatTime ++ "ms")
Thread.sleep eatTime
println (me ++ " finished eating.")
right.put fr
println (me ++ " took down right fork.")
left.put fl
println (me ++ " took down left fork.")
table.notifyAll
println(me ++ " is going to think for " ++ show thinkTime ++ "ms.")
Thread.sleep thinkTime
phil g2
Nothing -> do
println (me ++ " finds right fork is already in use.")
left.put fl
println (me ++ " took down left fork.")
table.notifyAll
println (me ++ " is going to the bar to await notifications from table.")
table.wait
println (me ++ " got notice that something changed at the table.")
phil g2
inter :: InterruptedException -> IO ()
inter _ = return ()
phil g `catch` inter
getURL xx = do
url <- URL.new xx
con <- url.openConnection
con.connect
is <- con.getInputStream
typ <- con.getContentType
-- stderr.println ("content-type is " ++ show typ)
ir <- InputStreamReader.new is (fromMaybe "UTF-8" (charset typ))
`catch` unsupportedEncoding is
br <- BufferedReader.new ir
br.getLines
where
unsupportedEncoding :: InputStream -> UnsupportedEncodingException -> IO InputStreamReader
unsupportedEncoding is x = do
stderr.println x.catched
InputStreamReader.new is "UTF-8"
charset ctyp = do
typ <- ctyp
case typ of
m~´charset=(\S+)´ -> m.group 1
_ -> Nothing
type SomeException = Throwable
main ["dining"] = mainPhil []
main _ = do
m1 <- MVar.newEmpty
m2 <- MVar.newEmpty
m3 <- MVar.newEmpty
forkIO do
r <- (catchAll . getURL) "http://www.wikipedia.org/wiki/Haskell"
m1.put r
forkIO do
r <- (catchAll . getURL) "htto://www.wikipedia.org/wiki/Java"
m2.put r
forkIO do
r <- (catchAll . getURL) "http://www.wikipedia.org/wiki/Frege"
m3.put r
r1 <- m1.take
r2 <- m2.take
r3 <- m3.take
println (result r1, result r2, result r3)
-- case r3 of
-- Right ss -> mapM_ putStrLn ss
-- Left _ -> return ()
where
result :: (SomeException|[String]) -> (String|Int)
result (Left x) = Left x.getClass.getName
result (Right y) = (Right . sum . map length) y
-- mapM_ putStrLn r2

561
samples/Frege/Sudoku.fr Normal file
View File

@@ -0,0 +1,561 @@
package examples.Sudoku where
import Data.TreeMap (Tree, keys)
import Data.List as DL hiding (find, union)
type Element = Int -- 1,2,3,4,5,6,7,8,9
type Zelle = [Element] -- set of candidates
type Position = Int -- 0..80
type Feld = (Position, Zelle)
type Brett = [Feld]
--- data type for assumptions and conclusions
data Assumption =
!ISNOT Position Element
| !IS Position Element
derive Eq Assumption
derive Ord Assumption
instance Show Assumption where
show (IS p e) = pname p ++ "=" ++ e.show
show (ISNOT p e) = pname p ++ "/" ++ e.show
showcs cs = joined " " (map Assumption.show cs)
elements :: [Element] -- all possible elements
elements = [1 .. 9]
{-
a b c d e f g h i
0 1 2 | 3 4 5 | 6 7 8 1
9 10 11 |12 13 14 |15 16 17 2
18 19 20 |21 22 23 |24 25 26 3
---------|---------|--------
27 28 29 |30 31 32 |33 34 35 4
36 37 38 |39 40 41 |42 43 44 5
45 46 47 |48 49 50 |51 52 53 6
---------|---------|--------
54 55 56 |57 58 59 |60 61 62 7
63 64 65 |66 67 68 |69 70 71 8
72 73 74 |75 76 77 |78 79 80 9
-}
positions :: [Position] -- all possible positions
positions = [0..80]
rowstarts :: [Position] -- all positions where a row is starting
rowstarts = [0,9,18,27,36,45,54,63,72]
colstarts :: [Position] -- all positions where a column is starting
colstarts = [0,1,2,3,4,5,6,7,8]
boxstarts :: [Position] -- all positions where a box is starting
boxstarts = [0,3,6,27,30,33,54,57,60]
boxmuster :: [Position] -- pattern for a box, by adding upper left position results in real box
boxmuster = [0,1,2,9,10,11,18,19,20]
--- extract field for position
getf :: Brett -> Position -> Feld
getf (f:fs) p
| fst f == p = f
| otherwise = getf fs p
getf [] p = (p,[])
--- extract cell for position
getc :: Brett -> Position -> Zelle
getc b p = snd (getf b p)
--- compute the list of all positions that belong to the same row as a given position
row :: Position -> [Position]
row p = [z..(z+8)] where z = (p `quot` 9) * 9
--- compute the list of all positions that belong to the same col as a given position
col :: Position -> [Position]
col p = map (c+) rowstarts where c = p `mod` 9
--- compute the list of all positions that belong to the same box as a given position
box :: Position -> [Position]
box p = map (z+) boxmuster where
ri = p `div` 27 * 27 -- 0, 27 or 54, depending on row
ci = p `mod` 9 -- column index 0..8, 0,1,2 is left, 3,4,5 is middle, 6,7,8 is right
cs = ci `div` 3 * 3 -- 0, 3 or 6
z = ri + cs
--- check if candidate set has exactly one member, i.e. field has been solved
single :: Zelle -> Bool
single [_] = true
single _ = false
unsolved :: Zelle -> Bool
unsolved [_] = false
unsolved _ = true
-- list of rows, cols, boxes
allrows = map row rowstarts
allcols = map col colstarts
allboxs = map box boxstarts
allrcb = zip (repeat "row") allrows
++ zip (repeat "col") allcols
++ zip (repeat "box") allboxs
containers :: [(Position -> [Position], String)]
containers = [(row, "row"), (col, "col"), (box, "box")]
-- ----------------- PRINTING ------------------------------------
-- printable coordinate of field, upper left is a1, lower right is i9
pname p = packed [chr (ord 'a' + p `mod` 9), chr (ord '1' + p `div` 9)]
-- print board
printb b = mapM_ p1line allrows >> println ""
where
p1line row = do
print (joined "" (map pfld line))
where line = map (getc b) row
-- print field (brief)
-- ? = no candidate
-- 5 = field is 5
-- . = some candidates
pfld [] = "?"
pfld [x] = show x
pfld zs = "0"
-- print initial/final board
result msg b = do
println ("Result: " ++ msg)
print ("Board: ")
printb b
return b
res012 b = case concatMap (getc b) [0,1,2] of
[a,b,c] -> a*100+b*10+c
_ -> 9999999
-- -------------------------- BOARD ALTERATION ACTIONS ---------------------------------
-- print a message about what is done to the board and return the new board
turnoff1 :: Position -> Zelle -> Brett -> IO Brett
turnoff1 i off b
| single nc = do
-- print (pname i)
-- print ": set to "
-- print (head nc)
-- println " (naked single)"
return newb
| otherwise = return newb
where
cell = getc b i
nc = filter (`notElem` off) cell
newb = (i, nc) : [ f | f <- b, fst f != i ]
turnoff :: Int -> Zelle -> String -> Brett -> IO Brett
turnoff i off msg b = do
-- print (pname i)
-- print ": set to "
-- print nc
-- print " by clearing "
-- print off
-- print " "
-- println msg
return newb
where
cell = getc b i
nc = filter (`notElem` off) cell
newb = (i, nc) : [ f | f <- b, fst f != i ]
turnoffh ps off msg b = foldM toh b ps
where
toh b p = turnoff p off msg b
setto :: Position -> Element -> String -> Brett -> IO Brett
setto i n cname b = do
-- print (pname i)
-- print ": set to "
-- print n
-- print " (hidden single in "
-- print cname
-- println ")"
return newb
where
nf = [n]
newb = (i, nf) : [ f | f <- b, fst f != i ]
-- ----------------------------- SOLVING STRATEGIES ---------------------------------------------
-- reduce candidate sets that contains numbers already in same row, col or box
-- This finds (and logs) NAKED SINGLEs in passing.
reduce b = [ turnoff1 p sss | (p,cell) <- b, -- for each field
unsolved cell, -- with more than 1 candidate
-- single fields in containers that are candidates of that field
sss = [ s | (rcb, _) <- containers, [s] <- map (getc b) (rcb p), s `elem` cell],
sss != [] ] -- collect field index, elements to remove from candidate set
-- look for a number that appears in exactly 1 candidate set of a container
-- this number can go in no other place (HIDDEN SINGLE)
hiddenSingle b = [ setto i n cname | -- select index, number, containername
(cname, rcb) <- allrcb, -- FOR rcb IN allrcb
n <- elements, -- FOR n IN elements
fs = filter (unsolved • snd) (map (getf b) rcb),
occurs = filter ((n `elem`) • snd) fs,
length occurs == 1,
(i, _) <- occurs ]
-- look for NAKED PAIRS, TRIPLES, QUADS
nakedPair n b = [ turnoff p t ("(naked tuple in " ++ nm ++ ")") | -- SELECT pos, tuple, name
-- n <- [2,3,4], // FOR n IN [2,3,4]
(nm, rcb) <- allrcb, -- FOR rcb IN containers
fs = map (getf b) rcb, -- let fs = fields for rcb positions
u = (fold union [] . filter unsolved . map snd) fs, -- let u = union of non single candidates
t <- n `outof` u, -- FOR t IN n-tuples
hit = (filter ((`subset` t) . snd) . filter (unsolved . snd)) fs,
length hit == n,
(p, cell) <- fs,
p `notElem` map fst hit,
any (`elem` cell) t
]
-- look for HIDDEN PAIRS, TRIPLES or QUADS
hiddenPair n b = [ turnoff p off ("(hidden " ++ show t ++ " in " ++ nm ++ ")") | -- SELECT pos, tuple, name
-- n <- [2,3,4], // FOR n IN [2,3,4]
(nm, rcb) <- allrcb, -- FOR rcb IN containers
fs = map (getf b) rcb, -- let fs = fields for rcb positions
u = (fold union [] . filter ((>1) . length) . map snd) fs, -- let u = union of non single candidates
t <- n `outof` u, -- FOR t IN n-tuples
hit = (filter (any ( `elem` t) . snd) . filter (unsolved . snd)) fs,
length hit == n,
off = (fold union [] . map snd) hit `minus` t,
off != [],
(p, cell) <- hit,
! (cell `subset` t)
]
a `subset` b = all (`elem` b) a
a `union` b = uniq (sort (a ++ b))
a `minus` b = filter (`notElem` b) a
a `common` b = filter (`elem` b) a
n `outof` as
| length as < n = []
| [] <- as = []
| 1 >= n = map (:[]) as
| (a:bs) <- as = map (a:) ((n-1) `outof` bs) ++ (n `outof` bs)
| otherwise = undefined -- cannot happen because either as is empty or not
same f a b = b `elem` f a
intersectionlist = [(allboxs, row, "box/row intersection"), (allboxs, col, "box/col intersection"),
(allrows ++ allcols, box, "line/box intersection")]
intersections b = [
turnoff pos [c] reason | -- SELECT position, candidate, reson
(from, container, reason) <- intersectionlist,
rcb <- from,
fs = (filter (unsolved . snd) . map (getf b)) rcb, -- fs = fields in from with more than 1 candidate
c <- (fold union [] • map snd) fs, -- FOR c IN union of candidates
cpos = (map fst • filter ((c `elem`) • snd)) fs, -- cpos = positions where c occurs
cpos != [], -- WHERE cpos is not empty
all (same container (head cpos)) (tail cpos), -- WHERE all positions are in the intersection
-- we can remove all occurences of c that are in container, but not in from
(pos, cell) <- map (getf b) (container (head cpos)),
c `elem` cell,
pos `notElem` rcb ]
-- look for an XY Wing
-- - there exists a cell A with candidates X and Y
-- - there exists a cell B with candidates X and Z that shares a container with A
-- - there exists a cell C with candidates Y and Z that shares a container with A
-- reasoning
-- - if A is X, B will be Z
-- - if A is Y, C will be Z
-- - since A will indeed be X or Y -> B or C will be Z
-- - thus, no cell that can see B and C can be Z
xyWing board = [ turnoff p [z] ("xy wing " ++ pname b ++ " " ++ pname c ++ " because of " ++ pname a) |
(a, [x,y]) <- board, -- there exists a cell a with candidates x and y
rcba = map (getf board) (row a ++ col a ++ box a), -- rcba = all fields that share a container with a
(b, [b1, b2]) <- rcba,
b != a,
b1 == x && b2 != y || b2 == x && b1 != y, -- there exists a cell B with candidates x and z
z = if b1 == x then b2 else b1,
(c, [c1, c2]) <- rcba,
c != a, c!= b,
c1 == y && c2 == z || c1 == z && c2 == y, -- there exists a cell C with candidates y and z
ps = (uniq . sort) ((row b ++ col b ++ box b) `common` (row c ++ col c ++ box c)),
-- remove z in ps
(p, cs) <- map (getf board) ps,
p != b, p != c,
z `elem` cs ]
-- look for a N-Fish (2: X-Wing, 3: Swordfish, 4: Jellyfish)
-- When all candidates for a particular digit in N rows are located
-- in only N columns, we can eliminate all candidates from those N columns
-- which are not located on those N rows
fish n board = fish "row" allrows row col ++ fish "col" allcols col row where
fishname 2 = "X-Wing"
fishname 3 = "Swordfish"
fishname 4 = "Jellyfish"
fishname _ = "unknown fish"
fish nm allrows row col = [ turnoff p [x] (fishname n ++ " in " ++ nm ++ " " ++ show (map (pname . head) rset)) |
rset <- n `outof` allrows, -- take n rows (or cols)
x <- elements, -- look for certain number
rflds = map (filter ((>1) . length . snd) . map (getf board)) rset, -- unsolved fields in the rowset
colss = (map (map (head . col . fst) . filter ((x `elem`) . snd)) rflds), -- where x occurs in candidates
all ((>1) . length) colss, -- x must appear in at least 2 cols
cols = fold union [] colss,
length cols == n,
cstart <- cols,
(p, cell) <- map (getf board) (col cstart),
x `elem` cell,
all (p `notElem`) rset]
-- compute immediate consequences of an assumption of the form (p `IS` e) or (p `ISNOT` e)
conseq board (IS p e) = uniq (sort ([ p `ISNOT` x | x <- getc board p, x != e ] ++
[ a `ISNOT` e |
(a,cs) <- map (getf board) (row p ++ col p ++ box p),
a != p,
e `elem` cs
]))
conseq board (ISNOT p e) = uniq (sort ([ p `IS` x | cs = getc board p, length cs == 2, x <- cs, x != e ] ++
[ a `IS` e |
cp <- [row p, box p, col p],
as = (filter ((e `elem`) . getc board) . filter (p!=)) cp,
length as == 1,
a = head as
]))
-- check if two assumptions contradict each other
contradicts (IS a x) (IS b y) = a==b && x!=y
contradicts (IS a x) (ISNOT b y) = a==b && x==y
contradicts (ISNOT a x) (IS b y) = a==b && x==y
contradicts (ISNOT _ _) (ISNOT _ _) = false
-- get the Position of an Assumption
aPos (IS p _) = p
aPos (ISNOT p _) = p
-- get List of elements that must be turned off when assumption is true/false
toClear board true (IS p x) = filter (x!=) (getc board p)
toClear board false (IS p x) = [x]
toClear board true (ISNOT p x) = [x]
toClear board false (ISNOT p x) = filter (x!=) (getc board p)
-- look for assumptions whose implications contradict themself
chain board paths = [ solution a (head cs) (reverse cs) |
(a, css) <- paths,
cs <- take 1 [ cs | cs <- css, contradicts a (head cs) ]
]
where
solution a c cs = turnoff (aPos a) (toClear board false a) reason where
reason = "Assumption " ++ show a ++ " implies " ++ show c ++ "\n\t"
++ showcs cs ++ "\n\t"
++ "Therefore, " ++ show a ++ " must be false."
-- look for an assumption that yields to contradictory implications
-- this assumption must be false
chainContra board paths = [ solution a (reverse pro) (reverse contra) |
(a, css) <- paths, -- FOR ALL assumptions "a" with list of conlusions "css"
(pro, contra) <- take 1 [ (pro, contra) |
pro <- (uniqBy (using head) . sortBy (comparing head)) css, -- FOR ALL conslusion chains "pro"
c = head pro, -- LET "c" BE the final conclusion
contra <- take 1 (filter ((contradicts c) . head) css) -- THE FIRST conclusion that contradicts c
]
]
where
solution a pro con = turnoff (aPos a) (toClear board false a) reason where
reason = ("assumption " ++ show a ++ " leads to contradictory conclusions\n\t"
++ showcs pro ++ "\n\t" ++ showcs con)
-- look for a common implication c of some assumptions ai, where at least 1 ai is true
-- so that (a0 OR a1 OR a2 OR ...) IMPLIES c
-- For all cells pi in same container that have x as candidate, we can construct (p0==x OR p1==x OR ... OR pi==x)
-- For a cell p with candidates ci, we can construct (p==c0 OR p==c1)
cellRegionChain board paths = [ solution b as (map head os) |
as <- cellas ++ regionas, -- one of as must be true
iss = filter ((`elem` as) . fst) paths, -- the implications for as
(a, ass) <- take 1 iss, -- implications for first assumption
fs <- (uniqBy (using head) . sortBy (comparing head)) ass,
b = head fs, -- final conclusions of first assumption
os = [fs] : map (take 1 . filter ((b==) . head) . snd) (tail iss), -- look for implications with same conclusion
all ([]!=) os]
where
cellas = [ map (p `IS`) candidates | (p, candidates@(_:_:_)) <- board ]
regionas = [ map (`IS` e) ps |
region <- map (map (getf board)) (allrows ++ allcols ++ allboxs),
e <- elements,
ps = map fst (filter ((e `elem`) . snd) region),
length ps > 1 ]
solution b as oss = turnoff (aPos b) (toClear board true b) reason where
reason = "all of the assumptions " ++ joined ", " (map show as) ++ " imply " ++ show b ++ "\n\t"
++ joined "\n\t" (map (showcs . reverse) oss) ++ "\n\t"
++ "One of them must be true, so " ++ show b ++ " must be true."
{-
Wir brauchen für einige Funktionen eine Datenstruktur wie
[ (Assumption, [[Assumption]]) ]
d.i. eine Liste von möglichen Annahmen samt aller Schlußketten.
Idealerweise sollte die Schlußkette in umgekehrter Reihenfolge vorliegen,
dann kann man einfach finden:
- Annahmen, die zum Selbstwiderspruch führen.
- alles, was aus einer bestimmten Annahme folgt (map (map head) [[a]])
-...
-}
--- Liste aller Annahmen für ein bestimmtes Brett
assumptions :: Brett -> [Assumption]
assumptions board = [ a |
(p, cs) <- board,
!(single cs),
a <- map (ISNOT p) cs ++ map (IS p) cs ]
consequences :: Brett -> [Assumption] -> [[Assumption]]
consequences board as = map (conseq board) as
acstree :: Brett -> Tree Assumption [Assumption]
acstree board = Tree.fromList (zip as cs)
where
as = assumptions board
cs = consequences board as
-- bypass maybe on tree lookup
find :: Tree Assumption [Assumption] -> Assumption -> [Assumption]
find t a
| Just cs <- t.lookup a = cs
| otherwise = error ("no consequences for " ++ show a)
-- for performance resons, we confine ourselves to implication chains of length 20 per assumption
mkPaths :: Tree Assumption [Assumption] -> [ (Assumption, [[Assumption]]) ]
mkPaths acst = map impl (keys acst) -- {[a1], [a2], [a3] ]
where
-- [Assumption] -> [(a, [chains, ordered by length]
impl a = (a, impls [[a]])
impls ns = (take 1000 • concat • takeUntil null • iterate expandchain) ns
-- expandchain :: [[Assumption]] -> [[Assumption]]
expandchain css = [ (n:a:as) |
(a : as) <- css, -- list of assumptions
n <- find acst a, -- consequences of a
n `notElem` as -- avoid loops
]
-- uni (a:as) = a : uni (filter ((head a !=) • head) as)
-- uni [] = empty
-- empty = []
-- ------------------ SOLVE A SUDOKU --------------------------
-- Apply all available strategies until nothing changes anymore
-- Strategy functions are supposed to return a list of
-- functions, which, when applied to a board, give a changed board.
-- When a strategy does not find anything to alter,
-- it returns [], and the next strategy can be tried.
solve b
| all (single . snd) b = result "Solved" b
| any (([]==) . snd) b = result "not solvable" b
| res@(_:_) <- reduce b = apply b res >>=solve -- compute smallest candidate sets
-- comment "candidate sets are up to date" = ()
| res@(_:_) <- hiddenSingle b = apply b res >>= solve -- find HIDDEN SINGLES
-- comment "no more hidden singles" = ()
| res@(_:_) <- intersections b = apply b res >>= solve -- find locked candidates
-- comment "no more intersections" = ()
| res@(_:_) <- nakedPair 2 b = apply b res >>= solve -- find NAKED PAIRS, TRIPLES or QUADRUPELS
-- comment "no more naked pairs" = ()
| res@(_:_) <- hiddenPair 2 b = apply b res >>= solve -- find HIDDEN PAIRS, TRIPLES or QUADRUPELS
-- comment "no more hidden pairs" = ()
-- res@(_:_) <- nakedPair 3 b = apply b res >>= solve // find NAKED PAIRS, TRIPLES or QUADRUPELS
-- | comment "no more naked triples" = ()
-- res@(_:_) <- hiddenPair 3 b = apply b res >>= solve // find HIDDEN PAIRS, TRIPLES or QUADRUPELS
-- | comment "no more hidden triples" = ()
-- res@(_:_) <- nakedPair 4 b = apply b res >>=solve // find NAKED PAIRS, TRIPLES or QUADRUPELS
-- | comment "no more naked quadruples" = ()
-- res@(_:_) <- hiddenPair 4 b = apply b res >>=solve // find HIDDEN PAIRS, TRIPLES or QUADRUPELS
-- | comment "no more hidden quadruples" = ()
| res@(_:_) <- xyWing b = apply b res >>=solve -- find XY WINGS
-- comment "no more xy wings" = ()
| res@(_:_) <- fish 2 b = apply b res >>=solve -- find 2-FISH
-- comment "no more x-wings" = ()
-- res@(_:_) <- fish 3 b = apply b res >>=solve // find 3-FISH
-- | comment "no more swordfish" = ()
-- res@(_:_) <- fish 4 b = apply b res >>=solve // find 4-FISH
-- | comment "no more jellyfish" = ()
-- | comment pcomment = ()
| res@(_:_) <- chain b paths = apply b (take 9 res) >>= solve -- find forcing chains
| res@(_:_) <- cellRegionChain b paths = apply b (take 9 res) >>= solve -- find common conclusion for true assumption
| res@(_:_) <- chainContra b paths = apply b (take 9 res) >>= solve -- find assumptions that allow to infer both a and !a
-- comment "consistent conclusions only" = ()
| otherwise = result "ambiguous" b
where
apply brd fs = foldM (\b\f -> f b) brd fs
paths = mkPaths (acstree b)
-- pcomment = show (length paths) ++ " assumptions with " ++ show (fold (+) 0 (map (length <~ snd) paths))
-- ++ " implication chains"
-- comment com = do stderr << com << "\n" for false
-- log com = do stderr << com << "\n" for true
--- turn a string into a row
mkrow :: String -> [Zelle]
mkrow s = mkrow1 xs
where
xs = s ++ "---------" -- make sure at least 9 elements
mkrow1 xs = (take 9 • filter ([]!=) • map f • unpacked) xs
f x | x >= '1' && x <= '9' = [ord x - ord '0']
| x == ' ' = [] -- ignored
| otherwise = elements
main ["-h"] = main []
main ["-help"] = main []
main [] = do
mapM_ stderr.println [
"usage: java Sudoku file ...",
" java Sudoku position",
"where position is a 81 char string consisting of digits",
"One can get such a string by going to",
"http://www.sudokuoftheday.com/pages/s-o-t-d.php",
"Right click on the puzzle and open it in new tab",
"Copy the 81 digits from the URL in the address field of your browser.",
"",
"There is also a file with hard sudokus in examples/top95.txt\n"]
return ()
main [s@#^[0-9\W]{81}$#] = solve board >> return ()
where
board = zip positions felder
felder = decode s
main files = forM_ files sudoku
where
sudoku file = do
br <- openReader file
lines <- BufferedReader.getLines br
bs <- process lines
ss <- mapM (\b -> print "Puzzle: " >> printb b >> solve b) bs
println ("Euler: " ++ show (sum (map res012 ss)))
return ()
-- "--3-" => [1..9, 1..9, [3], 1..9]
decode s = map candi (unpacked s) where
candi c | c >= '1' && c <= '9' = [(ord c - ord '0')]
| otherwise = elements
process [] = return []
process (s:ss)
| length s == 81 = consider b1
| length s == 9,
length acht == 8,
all ((9==) • length) acht = consider b2
| otherwise = do
stderr.println ("skipped line: " ++ s)
process ss
where
acht = take 8 ss
neun = fold (++) "" (s:acht)
b1 = zip positions (decode s)
b2 = zip positions (decode neun)
consider b = do
-- print "Puzzle: "
-- printb b
bs <- process ss
return (b:bs)

View File

@@ -0,0 +1,79 @@
package examples.SwingExamples where
import Java.Awt (ActionListener)
import Java.Swing
main _ = do
rs <- mapM Runnable.new [helloWorldGUI, buttonDemoGUI, celsiusConverterGUI]
mapM_ invokeLater rs
println "Hit enter to end ...."
s <- getLine
return ()
celsiusConverterGUI = do
tempTextField <- JTextField.new()
celsiusLabel <- JLabel.new ()
convertButton <- JButton.new ()
fahrenheitLabel <- JLabel.new ()
frame <- JFrame.new ()
frame.setDefaultCloseOperation JFrame.dispose_on_close
frame.setTitle "Celsius Converter"
celsiusLabel.setText "Celsius"
convertButton.setText "Convert"
let convertButtonActionPerformed _ = do
celsius <- tempTextField.getText
case celsius.double of
Left _ -> fahrenheitLabel.setText ("not a valid number: " ++ celsius)
Right c -> fahrenheitLabel.setText (show (c*1.8 + 32.0).long ++ " Fahrenheit")
return ()
ActionListener.new convertButtonActionPerformed >>= convertButton.addActionListener
fahrenheitLabel.setText "Fahrenheit"
contentPane <- frame.getContentPane
layout <- GroupLayout.new contentPane
contentPane.setLayout layout
-- TODO continue
-- http://docs.oracle.com/javase/tutorial/displayCode.html?code=http://docs.oracle.com/javase/tutorial/uiswing/examples/learn/CelsiusConverterProject/src/learn/CelsiusConverterGUI.java
frame.pack
frame.setVisible true
helloWorldGUI = do
frame <- JFrame.new "Hello World Frege"
frame.setDefaultCloseOperation(JFrame.dispose_on_close)
label <- JLabel.new "Hello World!"
cp <- frame.getContentPane
cp.add label
frame.pack
frame.setVisible true
buttonDemoGUI = do
frame <- JFrame.new "Button Demo"
frame.setDefaultCloseOperation(JFrame.dispose_on_close)
newContentPane <- JPanel.new ()
b1::JButton <- JButton.new "Disable middle button"
b1.setVerticalTextPosition SwingConstants.center
b1.setHorizontalTextPosition SwingConstants.leading
b2::JButton <- JButton.new "Middle button"
b2.setVerticalTextPosition SwingConstants.center
b2.setHorizontalTextPosition SwingConstants.leading
b3::JButton <- JButton.new "Enable middle button"
b3.setVerticalTextPosition SwingConstants.center
b3.setHorizontalTextPosition SwingConstants.leading
b3.setEnabled false
let action1 _ = do
b2.setEnabled false
b1.setEnabled false
b3.setEnabled true
action3 _ = do
b2.setEnabled true
b1.setEnabled true
b3.setEnabled false
ActionListener.new action1 >>= b1.addActionListener
ActionListener.new action3 >>= b3.addActionListener
newContentPane.add b1
newContentPane.add b2
newContentPane.add b3
newContentPane.setOpaque true
frame.setContentPane newContentPane
frame.pack
frame.setVisible true

307
samples/GAP/Magic.gd Normal file
View File

@@ -0,0 +1,307 @@
#############################################################################
##
## Magic.gd AutoDoc package
##
## Copyright 2013, Max Horn, JLU Giessen
## Sebastian Gutsche, University of Kaiserslautern
##
#############################################################################
#! @Description
#! This is the main function of the &AutoDoc; package. It can perform
#! any combination of the following three tasks:
#! <Enum>
#! <Item>
#! It can (re)generate a scaffold for your package manual.
#! That is, it can produce two XML files in &GAPDoc; format to be used as part
#! of your manual: First, a file named <F>doc/PACKAGENAME.xml</F>
#! (with your package's name substituted) which is used as
#! main file for the package manual, i.e. this file sets the
#! XML DOCTYPE and defines various XML entities, includes
#! other XML files (both those generated by &AutoDoc; as well
#! as additional files created by other means), tells &GAPDoc;
#! to generate a table of content and an index, and more.
#! Secondly, it creates a file <F>doc/title.xml</F> containing a title
#! page for your documentation, with information about your package
#! (name, description, version), its authors and more, based
#! on the data in your <F>PackageInfo.g</F>.
#! </Item>
#! <Item>
#! It can scan your package for &AutoDoc; based documentation (by using &AutoDoc;
#! tags and the Autodoc command.
#! This will
#! produce further XML files to be used as part of the package manual.
#! </Item>
#! <Item>
#! It can use &GAPDoc; to generate PDF, text and HTML (with
#! MathJaX enabled) documentation from the &GAPDoc; XML files it
#! generated as well as additional such files provided by you. For
#! this, it invokes <Ref Func='MakeGAPDocDoc' BookName='gapdoc'/>
#! to convert the XML sources, and it also instructs &GAPDoc; to copy
#! supplementary files (such as CSS style files) into your doc directory
#! (see <Ref Func='CopyHTMLStyleFiles' BookName='gapdoc'/>).
#! </Item>
#! </Enum>
#! For more information and some examples, please refer to Chapter <Ref Label='Tutorials'/>.
#! <P/>
#! The parameters have the following meanings:
#! <List>
#!
#! <Mark><A>package_name</A></Mark>
#! <Item>
#! The name of the package whose documentation should be(re)generated.
#! </Item>
#!
#!
#! <Mark><A>option_record</A></Mark>
#! <Item>
#! <A>option_record</A> can be a record with some additional options.
#! The following are currently supported:
#! <List>
#! <Mark><A>dir</A></Mark>
#! <Item>
#! This should be a string containing a (relative) path or a
#! Directory() object specifying where the package documentation
#! (i.e. the &GAPDoc; XML files) are stored.
#! <Br/>
#! <E>Default value: <C>"doc/"</C>.</E>
#! </Item>
#! <Mark><A>scaffold</A></Mark>
#! <Item>
#! This controls whether and how to generate scaffold XML files
#! for the main and title page of the package's documentation.
#! <P/>
#! The value should be either <K>true</K>, <K>false</K> or a
#! record. If it is a record or <K>true</K> (the latter is
#! equivalent to specifying an empty record), then this feature is
#! enabled. It is also enabled if <A>opt.scaffold</A> is missing but the
#! package's info record in <F>PackageInfo.g</F> has an <C>AutoDoc</C> entry.
#! In all other cases (in particular if <A>opt.scaffold</A> is
#! <K>false</K>), scaffolding is disabled.
#! <P/>
#!
#! If <A>opt.scaffold</A> is a record, it may contain the following entries.
#!
#### TODO: mention merging with PackageInfo.AutoDoc!
#! <List>
#!
#! <Mark><A>includes</A></Mark>
#! <Item>
#! A list of XML files to be included in the body of the main XML file.
#! If you specify this list and also are using &AutoDoc; to document
#! your operations with &AutoDoc; comments,
#! you can add <F>AutoDocMainFile.xml</F> to this list
#! to control at which point the documentation produced by &AutoDoc;
#! is inserted. If you do not do this, it will be added after the last
#! of your own XML files.
#! </Item>
#!
#! <Mark><A>appendix</A></Mark>
#! <Item>
#! This entry is similar to <A>opt.scaffold.includes</A> but is used
#! to specify files to include after the main body of the manual,
#! i.e. typically appendices.
#! </Item>
#!
#! <Mark><A>bib</A></Mark>
#! <Item>
#! The name of a bibliography file, in Bibtex or XML format.
#! If this key is not set, but there is a file <F>doc/PACKAGENAME.bib</F>
#! then it is assumed that you want to use this as your bibliography.
#! </Item>
#!
#### TODO: The 'entities' param is a bit strange. We should probably change it to be a bit more
#### general, as one might want to define other entities... For now, we do not document it
#### to leave us the choice of revising how it works.
####
#### <Mark><A>entities</A></Mark>
#### <Item>
#### A list of package names or other entities which are used to define corresponding XML entities.
#### For example, if set to a list containing the string <Q>SomePackage</Q>,
#### then the following is added to the XML preamble:
#### <Listing><![CDATA[<!ENTITY SomePackage '<Package>SomePackage</Package>'>]]></Listing>
#### This allows you to write <Q>&amp;SomePackage;</Q> in your documentation
#### to reference that package. If another type of entity is desired, one can simply add,
#### instead of a string, add a two entry list <A>a</A> to the list. It will be handled as
#### <Listing><![CDATA[<!ENTITY a[ 2 ] '<a[ 1 ]>a[ 2 ]</a[ 1 ]>'>]]></Listing>,
#### so please be careful.
#### </Item>
#!
#! <Mark><A>TitlePage</A></Mark>
#! <Item>
#! A record whose entries are used to embellish the generated titlepage
#! for the package manual with extra information, such as a copyright
#! statement or acknowledgments. To this end, the names of the record
#! components are used as XML element names, and the values of the
#! components are outputted as content of these XML elements. For
#! example, you could pass the following record to set a custom
#! acknowledgements text:
#! <Listing><![CDATA[
#! rec( Acknowledgements := "Many thanks to ..." )]]></Listing>
#! For a list of valid entries in the titlepage, please refer to the
#! &GAPDoc; manual, specifically section <Ref Subsect='Title' BookName='gapdoc'/>
#! and following.
#! </Item>
#! <Mark><A>document_class</A></Mark>
#! <Item>
#! Sets the document class of the resulting pdf. The value can either be a string
#! which has to be the name of the new document class, a list containing this string, or
#! a list of two strings. Then the first one has to be the document class name, the second one
#! the option string ( contained in [ ] ) in LaTeX.
#! </Item>
#! <Mark><A>latex_header_file</A></Mark>
#! <Item>
#! Replaces the standard header from &GAPDoc; completely with the header in this LaTeX file.
#! Please be careful here, and look at GAPDoc's latexheader.tex file for an example.
#! </Item>
#! <Mark><A>gapdoc_latex_options</A></Mark>
#! <Item>
#! Must be a record with entries which can be understood by SetGapDocLaTeXOptions. Each entry can be a string, which
#! will be given to &GAPDoc; directly, or a list containing of two entries: The first one must be the string "file",
#! the second one a filename. This file will be read and then its content is passed to &GAPDoc; as option with the name
#! of the entry.
#! </Item>
#!
#! </List>
#! </Item>
#!
#!
#! <Mark><A>autodoc</A></Mark>
#! <Item>
#! This controls whether and how to generate addition XML documentation files
#! by scanning for &AutoDoc; documentation comments.
#! <P/>
#! The value should be either <K>true</K>, <K>false</K> or a
#! record. If it is a record or <K>true</K> (the latter is
#! equivalent to specifying an empty record), then this feature is
#! enabled. It is also enabled if <A>opt.autodoc</A> is missing but the
#! package depends (directly) on the &AutoDoc; package.
#! In all other cases (in particular if <A>opt.autodoc</A> is
#! <K>false</K>), this feature is disabled.
#! <P/>
#!
#! If <A>opt.autodoc</A> is a record, it may contain the following entries.
#!
#! <List>
#!
#! <Mark><A>files</A></Mark>
#! <Item>
#! A list of files (given by paths relative to the package directory)
#! to be scanned for &AutoDoc; documentation comments.
#! Usually it is more convenient to use <A>autodoc.scan_dirs</A>, see below.
#! </Item>
#!
#! <Mark><A>scan_dirs</A></Mark>
#! <Item>
#! A list of subdirectories of the package directory (given as relative paths)
#! which &AutoDoc; then scans for .gi, .gd and .g files; all of these files
#! are then scanned for &AutoDoc; documentation comments.
#! <Br/>
#! <E>Default value: <C>[ "gap", "lib", "examples", "examples/doc" ]</C>.</E>
#! </Item>
#!
#! <Mark><A>level</A></Mark>
#! <Item>
#! This defines the level of the created documentation. The default value is 0.
#! When parts of the manual are declared with a higher value
#! they will not be printed into the manual.
#! </Item>
#!
#### TODO: Document section_intros later on.
#### However, note that thanks to the new AutoDoc comment syntax, the only remaining
#### use for this seems to be the ability to specify the order of chapters and
#### sections.
#### <Mark><A>section_intros</A></Mark>
#### <Item>
#### TODO.
#### </Item>
#!
#! </List>
#! </Item>
#!
#!
#! <Mark><A>gapdoc</A></Mark>
#! <Item>
#! This controls whether and how to invoke &GAPDoc; to create HTML, PDF and text
#! files from your various XML files.
#! <P/>
#! The value should be either <K>true</K>, <K>false</K> or a
#! record. If it is a record or <K>true</K> (the latter is
#! equivalent to specifying an empty record), then this feature is
#! enabled. It is also enabled if <A>opt.gapdoc</A> is missing.
#! In all other cases (in particular if <A>opt.gapdoc</A> is
#! <K>false</K>), this feature is disabled.
#! <P/>
#!
#! If <A>opt.gapdoc</A> is a record, it may contain the following entries.
#!
#! <List>
#!
#!
#### Note: 'main' is strictly speaking also used for the scaffold.
#### However, if one uses the scaffolding mechanism, then it is not
#### really necessary to specify a custom name for the main XML file.
#### Thus, the purpose of this parameter is to cater for packages
#### that have existing documentation using a different XML name,
#### and which do not wish to use scaffolding.
####
#### This explain why we only allow specifying gapdoc.main.
#### The scaffolding code will still honor it, though, just in case.
#! <Mark><A>main</A></Mark>
#! <Item>
#! The name of the main XML file of the package manual.
#! This exists primarily to support packages with existing manual
#! which use a filename here which differs from the default.
#! In particular, specifying this is unnecessary when using scaffolding.
#! <Br/>
#! <E>Default value: <C>PACKAGENAME.xml</C></E>.
#! </Item>
#!
#! <Mark><A>files</A></Mark>
#! <Item>
#! A list of files (given by paths relative to the package directory)
#! to be scanned for &GAPDoc; documentation comments.
#! Usually it is more convenient to use <A>gapdoc.scan_dirs</A>, see below.
#! </Item>
#!
#! <Mark><A>scan_dirs</A></Mark>
#! <Item>
#! A list of subdirectories of the package directory (given as relative paths)
#! which &AutoDoc; then scans for .gi, .gd and .g files; all of these files
#! are then scanned for &GAPDoc; documentation comments.
#! <Br/>
#! <E>Default value: <C>[ "gap", "lib", "examples", "examples/doc" ]</C>.</E>
#! </Item>
#!
#! </List>
#! </Item>
## This is the maketest part. Still under construction.
#! <Mark><A>maketest</A></Mark>
#! <Item>
#! The maketest item can be true or a record. When it is true,
#! a simple maketest.g is created in the main package directory,
#! which can be used to test the examples from the manual. As a record,
#! the entry can have the following entries itself, to specify some options.
#! <List>
#! <Mark>filename</Mark>
#! <Item>
#! Sets the name of the test file.
#! </Item>
#! <Mark>commands</Mark>
#! <Item>
#! A list of strings, each one a command, which
#! will be executed at the beginning of the test file.
#! </Item>
#! </List>
#! </Item>
#!
#! </List>
#! </Item>
#! </List>
#!
#! @Returns nothing
#! @Arguments package_name[, option_record ]
#! @ChapterInfo AutoDoc, The AutoDoc() function
DeclareGlobalFunction( "AutoDoc" );

534
samples/GAP/Magic.gi Normal file
View File

@@ -0,0 +1,534 @@
#############################################################################
##
## Magic.gi AutoDoc package
##
## Copyright 2013, Max Horn, JLU Giessen
## Sebastian Gutsche, University of Kaiserslautern
##
#############################################################################
# Check if a string has the given suffix or not. Another
# name for this would "StringEndsWithOtherString".
# For example, AUTODOC_HasSuffix("file.gi", ".gi") returns
# true while AUTODOC_HasSuffix("file.txt", ".gi") returns false.
BindGlobal( "AUTODOC_HasSuffix",
function(str, suffix)
local n, m;
n := Length(str);
m := Length(suffix);
return n >= m and str{[n-m+1..n]} = suffix;
end );
# Given a string containing a ".", , return its suffix,
# i.e. the bit after the last ".". For example, given "test.txt",
# it returns "txt".
BindGlobal( "AUTODOC_GetSuffix",
function(str)
local i;
i := Length(str);
while i > 0 and str[i] <> '.' do i := i - 1; od;
if i < 0 then return ""; fi;
return str{[i+1..Length(str)]};
end );
# Check whether the given directory exists, and if not, attempt
# to create it.
BindGlobal( "AUTODOC_CreateDirIfMissing",
function(d)
local tmp;
if not IsDirectoryPath(d) then
tmp := CreateDir(d); # Note: CreateDir is currently undocumented
if tmp = fail then
Error("Cannot create directory ", d, "\n",
"Error message: ", LastSystemError().message, "\n");
return false;
fi;
fi;
return true;
end );
# Scan the given (by name) subdirs of a package dir for
# files with one of the given extensions, and return the corresponding
# filenames, as relative paths (relative to the package dir).
#
# For example, the invocation
# AUTODOC_FindMatchingFiles("AutoDoc", [ "gap/" ], [ "gi", "gd" ]);
# might return a list looking like
# [ "gap/AutoDocMainFunction.gd", "gap/AutoDocMainFunction.gi", ... ]
BindGlobal( "AUTODOC_FindMatchingFiles",
function (pkg, subdirs, extensions)
local d_rel, d, tmp, files, result;
result := [];
for d_rel in subdirs do
# Get the absolute path to the directory in side the package...
d := DirectoriesPackageLibrary( pkg, d_rel );
if IsEmpty( d ) then
continue;
fi;
d := d[1];
# ... but also keep the relative path (such as "gap")
d_rel := Directory( d_rel );
files := DirectoryContents( d );
Sort( files );
for tmp in files do
if not AUTODOC_GetSuffix( tmp ) in [ "g", "gi", "gd", "autodoc" ] then
continue;
fi;
if not IsReadableFile( Filename( d, tmp ) ) then
continue;
fi;
Add( result, Filename( d_rel, tmp ) );
od;
od;
return result;
end );
# AutoDoc(pkg[, opt])
#
## Make this function callable with the package_name AutoDocWorksheet.
## Which will then create a worksheet!
InstallGlobalFunction( AutoDoc,
function( arg )
local pkg, package_info, opt, scaffold, gapdoc, maketest,
autodoc, pkg_dir, doc_dir, doc_dir_rel, d, tmp,
title_page, tree, is_worksheet, position_document_class, i, gapdoc_latex_option_record;
pkg := arg[1];
if LowercaseString( pkg ) = "autodocworksheet" then
is_worksheet := true;
package_info := rec( );
pkg_dir := DirectoryCurrent( );
else
is_worksheet := false;
package_info := PackageInfo( pkg )[ 1 ];
pkg_dir := DirectoriesPackageLibrary( pkg, "" )[1];
fi;
if Length(arg) >= 2 then
opt := arg[2];
else
opt := rec();
fi;
# Check for certain user supplied options, and if present, add them
# to the opt record.
tmp := function( key )
local val;
val := ValueOption( key );
if val <> fail then
opt.(key) := val;
fi;
end;
tmp( "dir" );
tmp( "scaffold" );
tmp( "autodoc" );
tmp( "gapdoc" );
tmp( "maketest" );
#
# Setup the output directory
#
if not IsBound( opt.dir ) then
doc_dir := "doc";
elif IsString( opt.dir ) or IsDirectory( opt.dir ) then
doc_dir := opt.dir;
else
Error( "opt.dir must be a string containing a path, or a directory object" );
fi;
if IsString( doc_dir ) then
# Record the relative version of the path
doc_dir_rel := Directory( doc_dir );
# We intentionally do not use
# DirectoriesPackageLibrary( pkg, "doc" )
# because it returns an empty list if the subdirectory is missing.
# But we want to handle that case by creating the directory.
doc_dir := Filename(pkg_dir, doc_dir);
doc_dir := Directory(doc_dir);
else
# TODO: doc_dir_rel = ... ?
fi;
# Ensure the output directory exists, create it if necessary
AUTODOC_CreateDirIfMissing(Filename(doc_dir, ""));
# Let the developer know where we are generating the documentation.
# This helps diagnose problems where multiple instances of a package
# are visible to GAP and the wrong one is used for generating the
# documentation.
# TODO: Using Info() instead of Print?
Print( "Generating documentation in ", doc_dir, "\n" );
#
# Extract scaffolding settings, which can be controlled via
# opt.scaffold or package_info.AutoDoc. The former has precedence.
#
if not IsBound(opt.scaffold) then
# Default: enable scaffolding if and only if package_info.AutoDoc is present
if IsBound( package_info.AutoDoc ) then
scaffold := rec( );
fi;
elif IsRecord(opt.scaffold) then
scaffold := opt.scaffold;
elif IsBool(opt.scaffold) then
if opt.scaffold = true then
scaffold := rec();
fi;
else
Error("opt.scaffold must be a bool or a record");
fi;
# Merge package_info.AutoDoc into scaffold
if IsBound(scaffold) and IsBound( package_info.AutoDoc ) then
AUTODOC_APPEND_RECORD_WRITEONCE( scaffold, package_info.AutoDoc );
fi;
if IsBound( scaffold ) then
AUTODOC_WriteOnce( scaffold, "TitlePage", true );
AUTODOC_WriteOnce( scaffold, "MainPage", true );
fi;
#
# Extract AutoDoc settings
#
if not IsBound(opt.autodoc) and not is_worksheet then
# Enable AutoDoc support if the package depends on AutoDoc.
tmp := Concatenation( package_info.Dependencies.NeededOtherPackages,
package_info.Dependencies.SuggestedOtherPackages );
if ForAny( tmp, x -> LowercaseString(x[1]) = "autodoc" ) then
autodoc := rec();
fi;
elif IsRecord(opt.autodoc) then
autodoc := opt.autodoc;
elif IsBool(opt.autodoc) and opt.autodoc = true then
autodoc := rec();
fi;
if IsBound(autodoc) then
if not IsBound( autodoc.files ) then
autodoc.files := [ ];
fi;
if not IsBound( autodoc.scan_dirs ) and not is_worksheet then
autodoc.scan_dirs := [ "gap", "lib", "examples", "examples/doc" ];
elif not IsBound( autodoc.scan_dirs ) and is_worksheet then
autodoc.scan_dirs := [ ];
fi;
if not IsBound( autodoc.level ) then
autodoc.level := 0;
fi;
PushOptions( rec( level_value := autodoc.level ) );
if not is_worksheet then
Append( autodoc.files, AUTODOC_FindMatchingFiles(pkg, autodoc.scan_dirs, [ "g", "gi", "gd" ]) );
fi;
fi;
#
# Extract GAPDoc settings
#
if not IsBound( opt.gapdoc ) then
# Enable GAPDoc support by default
gapdoc := rec();
elif IsRecord( opt.gapdoc ) then
gapdoc := opt.gapdoc;
elif IsBool( opt.gapdoc ) and opt.gapdoc = true then
gapdoc := rec();
fi;
#
# Extract test settings
#
if IsBound( opt.maketest ) then
if IsRecord( opt.maketest ) then
maketest := opt.maketest;
elif opt.maketest = true then
maketest := rec( );
fi;
fi;
if IsBound( gapdoc ) then
if not IsBound( gapdoc.main ) then
gapdoc.main := pkg;
fi;
# FIXME: the following may break if a package uses more than one book
if IsBound( package_info.PackageDoc ) and IsBound( package_info.PackageDoc[1].BookName ) then
gapdoc.bookname := package_info.PackageDoc[1].BookName;
elif not is_worksheet then
# Default: book name = package name
gapdoc.bookname := pkg;
Print("\n");
Print("WARNING: PackageInfo.g is missing a PackageDoc entry!\n");
Print("Without this, your package manual will not be recognized by the GAP help system.\n");
Print("You can correct this by adding the following to your PackageInfo.g:\n");
Print("PackageDoc := rec(\n");
Print(" BookName := ~.PackageName,\n");
#Print(" BookName := \"", pkg, "\",\n");
Print(" ArchiveURLSubset := [\"doc\"],\n");
Print(" HTMLStart := \"doc/chap0.html\",\n");
Print(" PDFFile := \"doc/manual.pdf\",\n");
Print(" SixFile := \"doc/manual.six\",\n");
Print(" LongTitle := ~.Subtitle,\n");
Print("),\n");
Print("\n");
fi;
if not IsBound( gapdoc.files ) then
gapdoc.files := [];
fi;
if not IsBound( gapdoc.scan_dirs ) and not is_worksheet then
gapdoc.scan_dirs := [ "gap", "lib", "examples", "examples/doc" ];
fi;
if not is_worksheet then
Append( gapdoc.files, AUTODOC_FindMatchingFiles(pkg, gapdoc.scan_dirs, [ "g", "gi", "gd" ]) );
fi;
# Attempt to weed out duplicates as they may confuse GAPDoc (this
# won't work if there are any non-normalized paths in the list).
gapdoc.files := Set( gapdoc.files );
# Convert the file paths in gapdoc.files, which are relative to
# the package directory, to paths which are relative to the doc directory.
# For this, we assume that doc_dir_rel is normalized (e.g.
# it does not contains '//') and relative.
d := Number( Filename( doc_dir_rel, "" ), x -> x = '/' );
d := Concatenation( ListWithIdenticalEntries(d, "../") );
gapdoc.files := List( gapdoc.files, f -> Concatenation( d, f ) );
fi;
# read tree
# FIXME: shouldn't tree be declared inside of an 'if IsBound(autodoc)' section?
tree := DocumentationTree( );
if IsBound( autodoc ) then
if IsBound( autodoc.section_intros ) then
AUTODOC_PROCESS_INTRO_STRINGS( autodoc.section_intros : Tree := tree );
fi;
AutoDocScanFiles( autodoc.files : PackageName := pkg, Tree := tree );
fi;
if is_worksheet then
# FIXME: We use scaffold and autodoc here without checking whether
# they are bound. Does that mean worksheets always use them?
if IsRecord( scaffold.TitlePage ) and IsBound( scaffold.TitlePage.Title ) then
pkg := scaffold.TitlePage.Title;
elif IsBound( tree!.TitlePage.Title ) then
pkg := tree!.TitlePage.Title;
elif IsBound( autodoc.files ) and Length( autodoc.files ) > 0 then
pkg := autodoc.files[ 1 ];
while Position( pkg, '/' ) <> fail do
Remove( pkg, 1 );
od;
while Position( pkg, '.' ) <> fail do
Remove( pkg, Length( pkg ) );
od;
else
Error( "could not figure out a title." );
fi;
if not IsString( pkg ) then
pkg := JoinStringsWithSeparator( pkg, " " );
fi;
gapdoc.main := ReplacedString( pkg, " ", "_" );
gapdoc.bookname := ReplacedString( pkg, " ", "_" );
fi;
#
# Generate scaffold
#
gapdoc_latex_option_record := rec( );
if IsBound( scaffold ) then
## Syntax is [ "class", [ "options" ] ]
if IsBound( scaffold.document_class ) then
position_document_class := PositionSublist( GAPDoc2LaTeXProcs.Head, "documentclass" );
if IsString( scaffold.document_class ) then
scaffold.document_class := [ scaffold.document_class ];
fi;
if position_document_class = fail then
Error( "something is wrong with the LaTeX header" );
fi;
GAPDoc2LaTeXProcs.Head := Concatenation(
GAPDoc2LaTeXProcs.Head{[ 1 .. PositionSublist( GAPDoc2LaTeXProcs.Head, "{", position_document_class ) ]},
scaffold.document_class[ 1 ],
GAPDoc2LaTeXProcs.Head{[ PositionSublist( GAPDoc2LaTeXProcs.Head, "}", position_document_class ) .. Length( GAPDoc2LaTeXProcs.Head ) ]} );
if Length( scaffold.document_class ) = 2 then
GAPDoc2LaTeXProcs.Head := Concatenation(
GAPDoc2LaTeXProcs.Head{[ 1 .. PositionSublist( GAPDoc2LaTeXProcs.Head, "[", position_document_class ) ]},
scaffold.document_class[ 2 ],
GAPDoc2LaTeXProcs.Head{[ PositionSublist( GAPDoc2LaTeXProcs.Head, "]", position_document_class ) .. Length( GAPDoc2LaTeXProcs.Head ) ]} );
fi;
fi;
if IsBound( scaffold.latex_header_file ) then
GAPDoc2LaTeXProcs.Head := StringFile( scaffold.latex_header_file );
fi;
if IsBound( scaffold.gapdoc_latex_options ) then
if IsRecord( scaffold.gapdoc_latex_options ) then
for i in RecNames( scaffold.gapdoc_latex_options ) do
if not IsString( scaffold.gapdoc_latex_options.( i ) )
and IsList( scaffold.gapdoc_latex_options.( i ) )
and LowercaseString( scaffold.gapdoc_latex_options.( i )[ 1 ] ) = "file" then
scaffold.gapdoc_latex_options.( i ) := StringFile( scaffold.gapdoc_latex_options.( i )[ 2 ] );
fi;
od;
gapdoc_latex_option_record := scaffold.gapdoc_latex_options;
fi;
fi;
if not IsBound( scaffold.includes ) then
scaffold.includes := [ ];
fi;
if IsBound( autodoc ) then
# If scaffold.includes is already set, then we add
# AutoDocMainFile.xml to it, but *only* if it not already
# there. This way, package authors can control where
# it is put in their includes list.
if not "AutoDocMainFile.xml" in scaffold.includes then
Add( scaffold.includes, "AutoDocMainFile.xml" );
fi;
fi;
if IsBound( scaffold.bib ) and IsBool( scaffold.bib ) then
if scaffold.bib = true then
scaffold.bib := Concatenation( pkg, ".bib" );
else
Unbind( scaffold.bib );
fi;
elif not IsBound( scaffold.bib ) then
# If there is a doc/PKG.bib file, assume that we want to reference it in the scaffold.
if IsReadableFile( Filename( doc_dir, Concatenation( pkg, ".bib" ) ) ) then
scaffold.bib := Concatenation( pkg, ".bib" );
fi;
fi;
AUTODOC_WriteOnce( scaffold, "index", true );
if IsBound( gapdoc ) then
if AUTODOC_GetSuffix( gapdoc.main ) = "xml" then
scaffold.main_xml_file := gapdoc.main;
else
scaffold.main_xml_file := Concatenation( gapdoc.main, ".xml" );
fi;
fi;
# TODO: It should be possible to only rebuild the title page. (Perhaps also only the main page? but this is less important)
if IsBound( scaffold.TitlePage ) then
if IsRecord( scaffold.TitlePage ) then
title_page := scaffold.TitlePage;
else
title_page := rec( );
fi;
AUTODOC_WriteOnce( title_page, "dir", doc_dir );
AUTODOC_APPEND_RECORD_WRITEONCE( title_page, tree!.TitlePage );
if not is_worksheet then
AUTODOC_APPEND_RECORD_WRITEONCE( title_page, ExtractTitleInfoFromPackageInfo( pkg ) );
fi;
CreateTitlePage( title_page );
fi;
if IsBound( scaffold.MainPage ) and scaffold.MainPage <> false then
scaffold.dir := doc_dir;
scaffold.book_name := pkg;
CreateMainPage( scaffold );
fi;
fi;
#
# Run AutoDoc
#
if IsBound( autodoc ) then
WriteDocumentation( tree, doc_dir );
fi;
#
# Run GAPDoc
#
if IsBound( gapdoc ) then
# Ask GAPDoc to use UTF-8 as input encoding for LaTeX, as the XML files
# of the documentation are also in UTF-8 encoding, and may contain characters
# not contained in the default Latin 1 encoding.
SetGapDocLaTeXOptions( "utf8", gapdoc_latex_option_record );
MakeGAPDocDoc( doc_dir, gapdoc.main, gapdoc.files, gapdoc.bookname, "MathJax" );
CopyHTMLStyleFiles( Filename( doc_dir, "" ) );
# The following (undocumented) API is there for compatibility
# with old-style gapmacro.tex based package manuals. It
# produces a manual.lab file which those packages can use if
# they wish to link to things in the manual we are currently
# generating. This can probably be removed eventually, but for
# now, doing it does not hurt.
# FIXME: It seems that this command does not work if pdflatex
# is not present. Maybe we should remove it.
if not is_worksheet then
GAPDocManualLab( pkg );
fi;
fi;
if IsBound( maketest ) then
AUTODOC_WriteOnce( maketest, "filename", "maketest.g" );
AUTODOC_WriteOnce( maketest, "folder", pkg_dir );
AUTODOC_WriteOnce( maketest, "scan_dir", doc_dir );
AUTODOC_WriteOnce( maketest, "files_to_scan", gapdoc.files );
if IsString( maketest.folder ) then
maketest.folder := Directory( maketest.folder );
fi;
if IsString( maketest.scan_dir ) then
maketest.scan_dir := Directory( maketest.scan_dir );
fi;
AUTODOC_WriteOnce( maketest, "commands", [ ] );
AUTODOC_WriteOnce( maketest, "book_name", gapdoc.main );
CreateMakeTest( maketest );
fi;
return true;
end );

115
samples/GAP/PackageInfo.g Normal file
View File

@@ -0,0 +1,115 @@
#############################################################################
##
## PackageInfo.g for the package `cvec' Max Neunhoeffer
##
## (created from Frank Lübeck's PackageInfo.g template file)
##
SetPackageInfo( rec(
PackageName := "cvec",
Subtitle := "Compact vectors over finite fields",
Version := "2.5.1",
Date := "04/04/2014", # dd/mm/yyyy format
## Information about authors and maintainers.
Persons := [
rec(
LastName := "Neunhoeffer",
FirstNames := "Max",
IsAuthor := true,
IsMaintainer := false,
Email := "neunhoef@mcs.st-and.ac.uk",
WWWHome := "http://www-groups.mcs.st-and.ac.uk/~neunhoef/",
PostalAddress := Concatenation( [
"School of Mathematics and Statistics\n",
"University of St Andrews\n",
"Mathematical Institute\n",
"North Haugh\n",
"St Andrews, Fife KY16 9SS\n",
"Scotland, UK" ] ),
Place := "St Andrews",
Institution := "University of St Andrews"
),
],
## Status information. Currently the following cases are recognized:
## "accepted" for successfully refereed packages
## "deposited" for packages for which the GAP developers agreed
## to distribute them with the core GAP system
## "dev" for development versions of packages
## "other" for all other packages
##
# Status := "accepted",
Status := "deposited",
## You must provide the next two entries if and only if the status is
## "accepted" because is was successfully refereed:
# format: 'name (place)'
# CommunicatedBy := "Mike Atkinson (St. Andrews)",
#CommunicatedBy := "",
# format: mm/yyyy
# AcceptDate := "08/1999",
#AcceptDate := "",
PackageWWWHome := "http://neunhoef.github.io/cvec/",
README_URL := Concatenation(~.PackageWWWHome, "README"),
PackageInfoURL := Concatenation(~.PackageWWWHome, "PackageInfo.g"),
ArchiveURL := Concatenation("https://github.com/neunhoef/cvec/",
"releases/download/v", ~.Version,
"/cvec-", ~.Version),
ArchiveFormats := ".tar.gz .tar.bz2",
## Here you must provide a short abstract explaining the package content
## in HTML format (used on the package overview Web page) and an URL
## for a Webpage with more detailed information about the package
## (not more than a few lines, less is ok):
## Please, use '<span class="pkgname">GAP</span>' and
## '<span class="pkgname">MyPKG</span>' for specifing package names.
##
AbstractHTML :=
"This package provides an implementation of compact vectors over finite\
fields. Contrary to earlier implementations no table lookups are used\
but only word-based processor arithmetic. This allows for bigger finite\
fields and higher speed.",
PackageDoc := rec(
BookName := "cvec",
ArchiveURLSubset := ["doc"],
HTMLStart := "doc/chap0.html",
PDFFile := "doc/manual.pdf",
SixFile := "doc/manual.six",
LongTitle := "Compact vectors over finite fields",
),
Dependencies := rec(
GAP := ">=4.5.5",
NeededOtherPackages := [
["GAPDoc", ">= 1.2"],
["IO", ">= 4.1"],
["orb", ">= 4.2"],
],
SuggestedOtherPackages := [],
ExternalConditions := []
),
AvailabilityTest := function()
if not "cvec" in SHOW_STAT() and
Filename(DirectoriesPackagePrograms("cvec"), "cvec.so") = fail then
#Info(InfoWarning, 1, "cvec: kernel cvec functions not available.");
return fail;
fi;
return true;
end,
## *Optional*, but recommended: path relative to package root to a file which
## contains as many tests of the package functionality as sensible.
#TestFile := "tst/testall.g",
## *Optional*: Here you can list some keyword related to the topic
## of the package.
Keywords := []
));

23
samples/GAP/example.gd Normal file
View File

@@ -0,0 +1,23 @@
#############################################################################
##
#W example.gd
##
## This file contains a sample of a GAP declaration file.
##
DeclareProperty( "SomeProperty", IsLeftModule );
DeclareGlobalFunction( "SomeGlobalFunction" );
#############################################################################
##
#C IsQuuxFrobnicator(<R>)
##
## <ManSection>
## <Filt Name="IsQuuxFrobnicator" Arg='R' Type='Category'/>
##
## <Description>
## Tests whether R is a quux frobnicator.
## </Description>
## </ManSection>
##
DeclareSynonym( "IsQuuxFrobnicator", IsField and IsGroup );

64
samples/GAP/example.gi Normal file
View File

@@ -0,0 +1,64 @@
#############################################################################
##
#W example.gd
##
## This file contains a sample of a GAP implementation file.
##
#############################################################################
##
#M SomeOperation( <val> )
##
## performs some operation on <val>
##
InstallMethod( SomeProperty,
"for left modules",
[ IsLeftModule ], 0,
function( M )
if IsFreeLeftModule( M ) and not IsTrivial( M ) then
return true;
fi;
TryNextMethod();
end );
#############################################################################
##
#F SomeGlobalFunction( )
##
## A global variadic funfion.
##
InstallGlobalFunction( SomeGlobalFunction, function( arg )
if Length( arg ) = 3 then
return arg[1] + arg[2] * arg[3];
elif Length( arg ) = 2 then
return arg[1] - arg[2]
else
Error( "usage: SomeGlobalFunction( <x>, <y>[, <z>] )" );
fi;
end );
#
# A plain function.
#
SomeFunc := function(x, y)
local z, func, tmp, j;
z := x * 1.0;
y := 17^17 - y;
func := a -> a mod 5;
tmp := List( [1..50], func );
while y > 0 do
for j in tmp do
Print(j, "\n");
od;
repeat
y := y - 1;
until 0 < 1;
y := y -1;
od;
return z;
end;

822
samples/GAP/vspc.gd Normal file
View File

@@ -0,0 +1,822 @@
#############################################################################
##
#W vspc.gd GAP library Thomas Breuer
##
##
#Y Copyright (C) 1997, Lehrstuhl D für Mathematik, RWTH Aachen, Germany
#Y (C) 1998 School Math and Comp. Sci., University of St Andrews, Scotland
#Y Copyright (C) 2002 The GAP Group
##
## This file declares the operations for vector spaces.
##
## The operations for bases of free left modules can be found in the file
## <F>lib/basis.gd<F>.
##
#############################################################################
##
#C IsLeftOperatorRing(<R>)
##
## <ManSection>
## <Filt Name="IsLeftOperatorRing" Arg='R' Type='Category'/>
##
## <Description>
## </Description>
## </ManSection>
##
DeclareSynonym( "IsLeftOperatorRing",
IsLeftOperatorAdditiveGroup and IsRing and IsAssociativeLOpDProd );
#T really?
#############################################################################
##
#C IsLeftOperatorRingWithOne(<R>)
##
## <ManSection>
## <Filt Name="IsLeftOperatorRingWithOne" Arg='R' Type='Category'/>
##
## <Description>
## </Description>
## </ManSection>
##
DeclareSynonym( "IsLeftOperatorRingWithOne",
IsLeftOperatorAdditiveGroup and IsRingWithOne
and IsAssociativeLOpDProd );
#T really?
#############################################################################
##
#C IsLeftVectorSpace( <V> )
#C IsVectorSpace( <V> )
##
## <#GAPDoc Label="IsLeftVectorSpace">
## <ManSection>
## <Filt Name="IsLeftVectorSpace" Arg='V' Type='Category'/>
## <Filt Name="IsVectorSpace" Arg='V' Type='Category'/>
##
## <Description>
## A <E>vector space</E> in &GAP; is a free left module
## (see&nbsp;<Ref Func="IsFreeLeftModule"/>) over a division ring
## (see Chapter&nbsp;<Ref Chap="Fields and Division Rings"/>).
## <P/>
## Whenever we talk about an <M>F</M>-vector space <A>V</A> then <A>V</A> is
## an additive group (see&nbsp;<Ref Func="IsAdditiveGroup"/>) on which the
## division ring <M>F</M> acts via multiplication from the left such that
## this action and the addition in <A>V</A> are left and right distributive.
## The division ring <M>F</M> can be accessed as value of the attribute
## <Ref Func="LeftActingDomain"/>.
## <P/>
## Vector spaces in &GAP; are always <E>left</E> vector spaces,
## <Ref Filt="IsLeftVectorSpace"/> and <Ref Filt="IsVectorSpace"/> are
## synonyms.
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareSynonym( "IsLeftVectorSpace",
IsLeftModule and IsLeftActedOnByDivisionRing );
DeclareSynonym( "IsVectorSpace", IsLeftVectorSpace );
InstallTrueMethod( IsFreeLeftModule,
IsLeftModule and IsLeftActedOnByDivisionRing );
#############################################################################
##
#F IsGaussianSpace( <V> )
##
## <#GAPDoc Label="IsGaussianSpace">
## <ManSection>
## <Func Name="IsGaussianSpace" Arg='V'/>
##
## <Description>
## The filter <Ref Filt="IsGaussianSpace"/> (see&nbsp;<Ref Sect="Filters"/>)
## for the row space (see&nbsp;<Ref Func="IsRowSpace"/>)
## or matrix space (see&nbsp;<Ref Func="IsMatrixSpace"/>) <A>V</A>
## over the field <M>F</M>, say,
## indicates that the entries of all row vectors or matrices in <A>V</A>,
## respectively, are all contained in <M>F</M>.
## In this case, <A>V</A> is called a <E>Gaussian</E> vector space.
## Bases for Gaussian spaces can be computed using Gaussian elimination for
## a given list of vector space generators.
## <Example><![CDATA[
## gap> mats:= [ [[1,1],[2,2]], [[3,4],[0,1]] ];;
## gap> V:= VectorSpace( Rationals, mats );;
## gap> IsGaussianSpace( V );
## true
## gap> mats[1][1][1]:= E(4);; # an element in an extension field
## gap> V:= VectorSpace( Rationals, mats );;
## gap> IsGaussianSpace( V );
## false
## gap> V:= VectorSpace( Field( Rationals, [ E(4) ] ), mats );;
## gap> IsGaussianSpace( V );
## true
## ]]></Example>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareFilter( "IsGaussianSpace", IsVectorSpace );
InstallTrueMethod( IsGaussianSpace,
IsVectorSpace and IsFullMatrixModule );
InstallTrueMethod( IsGaussianSpace,
IsVectorSpace and IsFullRowModule );
#############################################################################
##
#C IsDivisionRing( <D> )
##
## <#GAPDoc Label="IsDivisionRing">
## <ManSection>
## <Filt Name="IsDivisionRing" Arg='D' Type='Category'/>
##
## <Description>
## A <E>division ring</E> in &GAP; is a nontrivial associative algebra
## <A>D</A> with a multiplicative inverse for each nonzero element.
## In &GAP; every division ring is a vector space over a division ring
## (possibly over itself).
## Note that being a division ring is thus not a property that a ring can
## get, because a ring is usually not represented as a vector space.
## <P/>
## The field of coefficients is stored as the value of the attribute
## <Ref Func="LeftActingDomain"/> of <A>D</A>.
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareSynonymAttr( "IsDivisionRing",
IsMagmaWithInversesIfNonzero
and IsLeftOperatorRingWithOne
and IsLeftVectorSpace
and IsNonTrivial
and IsAssociative
and IsEuclideanRing );
#############################################################################
##
#A GeneratorsOfLeftVectorSpace( <V> )
#A GeneratorsOfVectorSpace( <V> )
##
## <#GAPDoc Label="GeneratorsOfLeftVectorSpace">
## <ManSection>
## <Attr Name="GeneratorsOfLeftVectorSpace" Arg='V'/>
## <Attr Name="GeneratorsOfVectorSpace" Arg='V'/>
##
## <Description>
## For an <M>F</M>-vector space <A>V</A>,
## <Ref Attr="GeneratorsOfLeftVectorSpace"/> returns a list of vectors in
## <A>V</A> that generate <A>V</A> as an <M>F</M>-vector space.
## <Example><![CDATA[
## gap> GeneratorsOfVectorSpace( FullRowSpace( Rationals, 3 ) );
## [ [ 1, 0, 0 ], [ 0, 1, 0 ], [ 0, 0, 1 ] ]
## ]]></Example>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareSynonymAttr( "GeneratorsOfLeftVectorSpace",
GeneratorsOfLeftOperatorAdditiveGroup );
DeclareSynonymAttr( "GeneratorsOfVectorSpace",
GeneratorsOfLeftOperatorAdditiveGroup );
#############################################################################
##
#A CanonicalBasis( <V> )
##
## <#GAPDoc Label="CanonicalBasis">
## <ManSection>
## <Attr Name="CanonicalBasis" Arg='V'/>
##
## <Description>
## If the vector space <A>V</A> supports a <E>canonical basis</E> then
## <Ref Attr="CanonicalBasis"/> returns this basis,
## otherwise <K>fail</K> is returned.
## <P/>
## The defining property of a canonical basis is that its vectors are
## uniquely determined by the vector space.
## If canonical bases exist for two vector spaces over the same left acting
## domain (see&nbsp;<Ref Func="LeftActingDomain"/>) then the equality of
## these vector spaces can be decided by comparing the canonical bases.
## <P/>
## The exact meaning of a canonical basis depends on the type of <A>V</A>.
## Canonical bases are defined for example for Gaussian row and matrix
## spaces (see&nbsp;<Ref Sect="Row and Matrix Spaces"/>).
## <P/>
## If one designs a new kind of vector spaces
## (see&nbsp;<Ref Sect="How to Implement New Kinds of Vector Spaces"/>) and
## defines a canonical basis for these spaces then the
## <Ref Attr="CanonicalBasis"/> method one installs
## (see&nbsp;<Ref Func="InstallMethod"/>)
## must <E>not</E> call <Ref Func="Basis"/>.
## On the other hand, one probably should install a <Ref Func="Basis"/>
## method that simply calls <Ref Attr="CanonicalBasis"/>,
## the value of the method
## (see&nbsp;<Ref Sect="Method Installation"/> and
## <Ref Sect="Applicable Methods and Method Selection"/>)
## being <C>CANONICAL_BASIS_FLAGS</C>.
## <Example><![CDATA[
## gap> vecs:= [ [ 1, 2, 3 ], [ 1, 1, 1 ], [ 1, 1, 1 ] ];;
## gap> V:= VectorSpace( Rationals, vecs );;
## gap> B:= CanonicalBasis( V );
## CanonicalBasis( <vector space over Rationals, with 3 generators> )
## gap> BasisVectors( B );
## [ [ 1, 0, -1 ], [ 0, 1, 2 ] ]
## ]]></Example>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareAttribute( "CanonicalBasis", IsFreeLeftModule );
#############################################################################
##
#F IsRowSpace( <V> )
##
## <#GAPDoc Label="IsRowSpace">
## <ManSection>
## <Func Name="IsRowSpace" Arg='V'/>
##
## <Description>
## A <E>row space</E> in &GAP; is a vector space that consists of
## row vectors (see Chapter&nbsp;<Ref Chap="Row Vectors"/>).
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareSynonym( "IsRowSpace", IsRowModule and IsVectorSpace );
#############################################################################
##
#F IsGaussianRowSpace( <V> )
##
## <ManSection>
## <Func Name="IsGaussianRowSpace" Arg='V'/>
##
## <Description>
## A row space is <E>Gaussian</E> if the left acting domain contains all
## scalars that occur in the vectors.
## Thus one can use Gaussian elimination in the calculations.
## <P/>
## (Otherwise the space is non-Gaussian.
## We will need a flag for this to write down methods that delegate from
## non-Gaussian spaces to Gaussian ones.)
## <!-- reformulate this when it becomes documented -->
## </Description>
## </ManSection>
##
DeclareSynonym( "IsGaussianRowSpace", IsGaussianSpace and IsRowSpace );
#############################################################################
##
#F IsNonGaussianRowSpace( <V> )
##
## <ManSection>
## <Func Name="IsNonGaussianRowSpace" Arg='V'/>
##
## <Description>
## If an <M>F</M>-vector space <A>V</A> is in the filter
## <Ref Func="IsNonGaussianRowSpace"/> then this expresses that <A>V</A>
## consists of row vectors (see&nbsp;<Ref Func="IsRowVector"/>) such
## that not all entries in these row vectors are contained in <M>F</M>
## (so Gaussian elimination cannot be used to compute an <M>F</M>-basis
## from a list of vector space generators),
## and that <A>V</A> is handled via the mechanism of nice bases
## (see&nbsp;<Ref ???="..."/>) in the following way.
## Let <M>K</M> be the field spanned by the entries of all vectors in
## <A>V</A>.
## Then the <Ref Attr="NiceFreeLeftModuleInfo"/> value of <A>V</A> is
## a basis <M>B</M> of the field extension <M>K / ( K \cap F )</M>,
## and the <Ref Func="NiceVector"/> value of <M>v \in <A>V</A></M>
## is defined by replacing each entry of <M>v</M> by the list of its
## <M>B</M>-coefficients, and then forming the concatenation.
## <P/>
## So the associated nice vector space is a Gaussian row space
## (see&nbsp;<Ref Func="IsGaussianRowSpace"/>).
## </Description>
## </ManSection>
##
DeclareHandlingByNiceBasis( "IsNonGaussianRowSpace",
"for non-Gaussian row spaces" );
#############################################################################
##
#F IsMatrixSpace( <V> )
##
## <#GAPDoc Label="IsMatrixSpace">
## <ManSection>
## <Func Name="IsMatrixSpace" Arg='V'/>
##
## <Description>
## A <E>matrix space</E> in &GAP; is a vector space that consists of matrices
## (see Chapter&nbsp;<Ref Chap="Matrices"/>).
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareSynonym( "IsMatrixSpace", IsMatrixModule and IsVectorSpace );
#############################################################################
##
#F IsGaussianMatrixSpace( <V> )
##
## <ManSection>
## <Func Name="IsGaussianMatrixSpace" Arg='V'/>
##
## <Description>
## A matrix space is Gaussian if the left acting domain contains all
## scalars that occur in the vectors.
## Thus one can use Gaussian elimination in the calculations.
## <P/>
## (Otherwise the space is non-Gaussian.
## We will need a flag for this to write down methods that delegate from
## non-Gaussian spaces to Gaussian ones.)
## </Description>
## </ManSection>
##
DeclareSynonym( "IsGaussianMatrixSpace", IsGaussianSpace and IsMatrixSpace );
#############################################################################
##
#F IsNonGaussianMatrixSpace( <V> )
##
## <ManSection>
## <Func Name="IsNonGaussianMatrixSpace" Arg='V'/>
##
## <Description>
## If an <M>F</M>-vector space <A>V</A> is in the filter
## <Ref Func="IsNonGaussianMatrixSpace"/>
## then this expresses that <A>V</A> consists of matrices
## (see&nbsp;<Ref Func="IsMatrix"/>)
## such that not all entries in these matrices are contained in <M>F</M>
## (so Gaussian elimination cannot be used to compute an <M>F</M>-basis
## from a list of vector space generators),
## and that <A>V</A> is handled via the mechanism of nice bases
## (see&nbsp;<Ref ???="..."/>) in the following way.
## Let <M>K</M> be the field spanned by the entries of all vectors in <A>V</A>.
## The <Ref Attr="NiceFreeLeftModuleInfo"/> value of <A>V</A> is irrelevant,
## and the <Ref Func="NiceVector"/> value of <M>v \in <A>V</A></M>
## is defined as the concatenation of the rows of <M>v</M>.
## <P/>
## So the associated nice vector space is a (not necessarily Gaussian)
## row space (see&nbsp;<Ref Func="IsRowSpace"/>).
## </Description>
## </ManSection>
##
DeclareHandlingByNiceBasis( "IsNonGaussianMatrixSpace",
"for non-Gaussian matrix spaces" );
#############################################################################
##
#A NormedRowVectors( <V> ) . . . normed vectors in a Gaussian row space <V>
##
## <#GAPDoc Label="NormedRowVectors">
## <ManSection>
## <Attr Name="NormedRowVectors" Arg='V'/>
##
## <Description>
## For a finite Gaussian row space <A>V</A>
## (see&nbsp;<Ref Func="IsRowSpace"/>, <Ref Func="IsGaussianSpace"/>),
## <Ref Attr="NormedRowVectors"/> returns a list of those nonzero
## vectors in <A>V</A> that have a one in the first nonzero component.
## <P/>
## The result list can be used as action domain for the action of a matrix
## group via <Ref Func="OnLines"/>, which yields the natural action on
## one-dimensional subspaces of <A>V</A>
## (see also&nbsp;<Ref Func="Subspaces"/>).
## <Example><![CDATA[
## gap> vecs:= NormedRowVectors( GF(3)^2 );
## [ [ 0*Z(3), Z(3)^0 ], [ Z(3)^0, 0*Z(3) ], [ Z(3)^0, Z(3)^0 ],
## [ Z(3)^0, Z(3) ] ]
## gap> Action( GL(2,3), vecs, OnLines );
## Group([ (3,4), (1,2,4) ])
## ]]></Example>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareAttribute( "NormedRowVectors", IsGaussianSpace );
#############################################################################
##
#A TrivialSubspace( <V> )
##
## <#GAPDoc Label="TrivialSubspace">
## <ManSection>
## <Attr Name="TrivialSubspace" Arg='V'/>
##
## <Description>
## For a vector space <A>V</A>, <Ref Attr="TrivialSubspace"/> returns the
## subspace of <A>V</A> that consists of the zero vector in <A>V</A>.
## <Example><![CDATA[
## gap> V:= GF(3)^3;;
## gap> triv:= TrivialSubspace( V );
## <vector space over GF(3), with 0 generators>
## gap> AsSet( triv );
## [ [ 0*Z(3), 0*Z(3), 0*Z(3) ] ]
## ]]></Example>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareSynonymAttr( "TrivialSubspace", TrivialSubmodule );
#############################################################################
##
#F VectorSpace( <F>, <gens>[, <zero>][, "basis"] )
##
## <#GAPDoc Label="VectorSpace">
## <ManSection>
## <Func Name="VectorSpace" Arg='F, gens[, zero][, "basis"]'/>
##
## <Description>
## For a field <A>F</A> and a collection <A>gens</A> of vectors,
## <Ref Func="VectorSpace"/> returns the <A>F</A>-vector space spanned by
## the elements in <A>gens</A>.
## <P/>
## The optional argument <A>zero</A> can be used to specify the zero element
## of the space; <A>zero</A> <E>must</E> be given if <A>gens</A> is empty.
## The optional string <C>"basis"</C> indicates that <A>gens</A> is known to
## be linearly independent over <A>F</A>, in particular the dimension of the
## vector space is immediately set;
## note that <Ref Func="Basis"/> need <E>not</E> return the basis formed by
## <A>gens</A> if the string <C>"basis"</C> is given as an argument.
## <!-- crossref. to <C>FreeLeftModule</C> as soon as the modules chapter
## is reliable!-->
## <Example><![CDATA[
## gap> V:= VectorSpace( Rationals, [ [ 1, 2, 3 ], [ 1, 1, 1 ] ] );
## <vector space over Rationals, with 2 generators>
## ]]></Example>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareGlobalFunction( "VectorSpace" );
#############################################################################
##
#F Subspace( <V>, <gens>[, "basis"] ) . subspace of <V> generated by <gens>
#F SubspaceNC( <V>, <gens>[, "basis"] )
##
## <#GAPDoc Label="Subspace">
## <ManSection>
## <Func Name="Subspace" Arg='V, gens[, "basis"]'/>
## <Func Name="SubspaceNC" Arg='V, gens[, "basis"]'/>
##
## <Description>
## For an <M>F</M>-vector space <A>V</A> and a list or collection
## <A>gens</A> that is a subset of <A>V</A>,
## <Ref Func="Subspace"/> returns the <M>F</M>-vector space spanned by
## <A>gens</A>; if <A>gens</A> is empty then the trivial subspace
## (see&nbsp;<Ref Func="TrivialSubspace"/>) of <A>V</A> is returned.
## The parent (see&nbsp;<Ref Sect="Parents"/>) of the returned vector space
## is set to <A>V</A>.
## <P/>
## <Ref Func="SubspaceNC"/> does the same as <Ref Func="Subspace"/>,
## except that it omits the check whether <A>gens</A> is a subset of
## <A>V</A>.
## <P/>
## The optional string <A>"basis"</A> indicates that <A>gens</A> is known to
## be linearly independent over <M>F</M>.
## In this case the dimension of the subspace is immediately set,
## and both <Ref Func="Subspace"/> and <Ref Func="SubspaceNC"/> do
## <E>not</E> check whether <A>gens</A> really is linearly independent and
## whether <A>gens</A> is a subset of <A>V</A>.
## <!-- crossref. to <C>Submodule</C> as soon as the modules chapter
## is reliable!-->
## <Example><![CDATA[
## gap> V:= VectorSpace( Rationals, [ [ 1, 2, 3 ], [ 1, 1, 1 ] ] );;
## gap> W:= Subspace( V, [ [ 0, 1, 2 ] ] );
## <vector space over Rationals, with 1 generators>
## ]]></Example>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareSynonym( "Subspace", Submodule );
DeclareSynonym( "SubspaceNC", SubmoduleNC );
#############################################################################
##
#O AsVectorSpace( <F>, <D> ) . . . . . . . . . view <D> as <F>-vector space
##
## <#GAPDoc Label="AsVectorSpace">
## <ManSection>
## <Oper Name="AsVectorSpace" Arg='F, D'/>
##
## <Description>
## Let <A>F</A> be a division ring and <A>D</A> a domain.
## If the elements in <A>D</A> form an <A>F</A>-vector space then
## <Ref Oper="AsVectorSpace"/> returns this <A>F</A>-vector space,
## otherwise <K>fail</K> is returned.
## <P/>
## <Ref Oper="AsVectorSpace"/> can be used for example to view a given
## vector space as a vector space over a smaller or larger division ring.
## <Example><![CDATA[
## gap> V:= FullRowSpace( GF( 27 ), 3 );
## ( GF(3^3)^3 )
## gap> Dimension( V ); LeftActingDomain( V );
## 3
## GF(3^3)
## gap> W:= AsVectorSpace( GF( 3 ), V );
## <vector space over GF(3), with 9 generators>
## gap> Dimension( W ); LeftActingDomain( W );
## 9
## GF(3)
## gap> AsVectorSpace( GF( 9 ), V );
## fail
## ]]></Example>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareSynonym( "AsVectorSpace", AsLeftModule );
#############################################################################
##
#O AsSubspace( <V>, <U> ) . . . . . . . . . . . view <U> as subspace of <V>
##
## <#GAPDoc Label="AsSubspace">
## <ManSection>
## <Oper Name="AsSubspace" Arg='V, U'/>
##
## <Description>
## Let <A>V</A> be an <M>F</M>-vector space, and <A>U</A> a collection.
## If <A>U</A> is a subset of <A>V</A> such that the elements of <A>U</A>
## form an <M>F</M>-vector space then <Ref Oper="AsSubspace"/> returns this
## vector space, with parent set to <A>V</A>
## (see&nbsp;<Ref Func="AsVectorSpace"/>).
## Otherwise <K>fail</K> is returned.
## <Example><![CDATA[
## gap> V:= VectorSpace( Rationals, [ [ 1, 2, 3 ], [ 1, 1, 1 ] ] );;
## gap> W:= VectorSpace( Rationals, [ [ 1/2, 1/2, 1/2 ] ] );;
## gap> U:= AsSubspace( V, W );
## <vector space over Rationals, with 1 generators>
## gap> Parent( U ) = V;
## true
## gap> AsSubspace( V, [ [ 1, 1, 1 ] ] );
## fail
## ]]></Example>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareOperation( "AsSubspace", [ IsVectorSpace, IsCollection ] );
#############################################################################
##
#F Intersection2Spaces( <AsStruct>, <Substruct>, <Struct> )
##
## <ManSection>
## <Func Name="Intersection2Spaces" Arg='AsStruct, Substruct, Struct'/>
##
## <Description>
## is a function that takes two arguments <A>V</A> and <A>W</A> which must
## be finite dimensional vector spaces,
## and returns the intersection of <A>V</A> and <A>W</A>.
## <P/>
## If the left acting domains are different then let <M>F</M> be their
## intersection.
## The intersection of <A>V</A> and <A>W</A> is computed as intersection of
## <C><A>AsStruct</A>( <A>F</A>, <A>V</A> )</C> and
## <C><A>AsStruct</A>( <A>F</A>, <A>V</A> )</C>.
## <P/>
## If the left acting domains are equal to <M>F</M> then the intersection of
## <A>V</A> and <A>W</A> is returned either as <M>F</M>-<A>Substruct</A>
## with the common parent of <A>V</A> and <A>W</A> or as
## <M>F</M>-<A>Struct</A>, in both cases with known basis.
## <P/>
## This function is used to handle the intersections of two vector spaces,
## two algebras, two algebras-with-one, two left ideals, two right ideals,
## two two-sided ideals.
## </Description>
## </ManSection>
##
DeclareGlobalFunction( "Intersection2Spaces" );
#############################################################################
##
#F FullRowSpace( <F>, <n> )
##
## <#GAPDoc Label="FullRowSpace">
## <ManSection>
## <Func Name="FullRowSpace" Arg='F, n'/>
## <Meth Name="\^" Arg='F, n' Label="for a field and an integer"/>
##
## <Description>
## For a field <A>F</A> and a nonnegative integer <A>n</A>,
## <Ref Func="FullRowSpace"/> returns the <A>F</A>-vector space that
## consists of all row vectors (see&nbsp;<Ref Func="IsRowVector"/>) of
## length <A>n</A> with entries in <A>F</A>.
## <P/>
## An alternative to construct this vector space is via
## <A>F</A><C>^</C><A>n</A>.
## <Example><![CDATA[
## gap> FullRowSpace( GF( 9 ), 3 );
## ( GF(3^2)^3 )
## gap> GF(9)^3; # the same as above
## ( GF(3^2)^3 )
## ]]></Example>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareSynonym( "FullRowSpace", FullRowModule );
DeclareSynonym( "RowSpace", FullRowModule );
#############################################################################
##
#F FullMatrixSpace( <F>, <m>, <n> )
##
## <#GAPDoc Label="FullMatrixSpace">
## <ManSection>
## <Func Name="FullMatrixSpace" Arg='F, m, n'/>
## <Meth Name="\^" Arg='F, dims'
## Label="for a field and a pair of integers"/>
##
## <Description>
## For a field <A>F</A> and two positive integers <A>m</A> and <A>n</A>,
## <Ref Func="FullMatrixSpace"/> returns the <A>F</A>-vector space that
## consists of all <A>m</A> by <A>n</A> matrices
## (see&nbsp;<Ref Func="IsMatrix"/>) with entries in <A>F</A>.
## <P/>
## If <A>m</A><C> = </C><A>n</A> then the result is in fact an algebra
## (see&nbsp;<Ref Func="FullMatrixAlgebra"/>).
## <P/>
## An alternative to construct this vector space is via
## <A>F</A><C>^[</C><A>m</A>,<A>n</A><C>]</C>.
## <Example><![CDATA[
## gap> FullMatrixSpace( GF(2), 4, 5 );
## ( GF(2)^[ 4, 5 ] )
## gap> GF(2)^[ 4, 5 ]; # the same as above
## ( GF(2)^[ 4, 5 ] )
## ]]></Example>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareSynonym( "FullMatrixSpace", FullMatrixModule );
DeclareSynonym( "MatrixSpace", FullMatrixModule );
DeclareSynonym( "MatSpace", FullMatrixModule );
#############################################################################
##
#C IsSubspacesVectorSpace( <D> )
##
## <#GAPDoc Label="IsSubspacesVectorSpace">
## <ManSection>
## <Filt Name="IsSubspacesVectorSpace" Arg='D' Type='Category'/>
##
## <Description>
## The domain of all subspaces of a (finite) vector space or of all
## subspaces of fixed dimension, as returned by <Ref Func="Subspaces"/>
## (see&nbsp;<Ref Func="Subspaces"/>) lies in the category
## <Ref Filt="IsSubspacesVectorSpace"/>.
## <Example><![CDATA[
## gap> D:= Subspaces( GF(3)^3 );
## Subspaces( ( GF(3)^3 ) )
## gap> Size( D );
## 28
## gap> iter:= Iterator( D );;
## gap> NextIterator( iter );
## <vector space over GF(3), with 0 generators>
## gap> NextIterator( iter );
## <vector space of dimension 1 over GF(3)>
## gap> IsSubspacesVectorSpace( D );
## true
## ]]></Example>
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareCategory( "IsSubspacesVectorSpace", IsDomain );
#############################################################################
##
#M IsFinite( <D> ) . . . . . . . . . . . . . . . . . for a subspaces domain
##
## Returns `true' if <D> is finite.
## We allow subspaces domains in `IsSubspacesVectorSpace' only for finite
## vector spaces.
##
InstallTrueMethod( IsFinite, IsSubspacesVectorSpace );
#############################################################################
##
#A Subspaces( <V>[, <k>] )
##
## <#GAPDoc Label="Subspaces">
## <ManSection>
## <Attr Name="Subspaces" Arg='V[, k]'/>
##
## <Description>
## Called with a finite vector space <A>v</A>,
## <Ref Oper="Subspaces"/> returns the domain of all subspaces of <A>V</A>.
## <P/>
## Called with <A>V</A> and a nonnegative integer <A>k</A>,
## <Ref Oper="Subspaces"/> returns the domain of all <A>k</A>-dimensional
## subspaces of <A>V</A>.
## <P/>
## Special <Ref Attr="Size"/> and <Ref Oper="Iterator"/> methods are
## provided for these domains.
## <!-- <C>Enumerator</C> would also be good ...
## (special treatment for full row spaces,
## other spaces delegate to this)-->
## </Description>
## </ManSection>
## <#/GAPDoc>
##
DeclareAttribute( "Subspaces", IsLeftModule );
DeclareOperation( "Subspaces", [ IsLeftModule, IsInt ] );
#############################################################################
##
#F IsSubspace( <V>, <U> )
##
## <ManSection>
## <Func Name="IsSubspace" Arg='V, U'/>
##
## <Description>
## check that <A>U</A> is a vector space that is contained in <A>V</A>
## <!-- Must also <A>V</A> be a vector space?
## If yes then must <A>V</A> and <A>U</A> have same left acting domain?
## (Is this function useful at all?) -->
## </Description>
## </ManSection>
##
DeclareGlobalFunction( "IsSubspace" );
#############################################################################
##
#A OrthogonalSpaceInFullRowSpace( <U> )
##
## <ManSection>
## <Attr Name="OrthogonalSpaceInFullRowSpace" Arg='U'/>
##
## <Description>
## For a Gaussian row space <A>U</A> over <M>F</M>,
## <Ref Attr="OrthogonalSpaceInFullRowSpace"/>
## returns a complement of <A>U</A> in the full row space of same vector
## dimension as <A>U</A> over <M>F</M>.
## </Description>
## </ManSection>
##
DeclareAttribute( "OrthogonalSpaceInFullRowSpace", IsGaussianSpace );
#############################################################################
##
#P IsVectorSpaceHomomorphism( <map> )
##
## <ManSection>
## <Prop Name="IsVectorSpaceHomomorphism" Arg='map'/>
##
## <Description>
## A mapping <M>f</M> is a vector space homomorphism (or linear mapping)
## if the source and range are vector spaces
## (see&nbsp;<Ref Func="IsVectorSpace"/>)
## over the same division ring <M>D</M>
## (see&nbsp;<Ref Func="LeftActingDomain"/>),
## and if <M>f( a + b ) = f(a) + f(b)</M> and <M>f( s * a ) = s * f(a)</M>
## hold for all elements <M>a</M>, <M>b</M> in the source of <M>f</M> and
## <M>s \in D</M>.
## </Description>
## </ManSection>
##
DeclareProperty( "IsVectorSpaceHomomorphism", IsGeneralMapping );
#############################################################################
##
#E

651
samples/GAP/vspc.gi Normal file
View File

@@ -0,0 +1,651 @@
#############################################################################
##
#W vspc.gi GAP library Thomas Breuer
##
##
#Y Copyright (C) 1997, Lehrstuhl D für Mathematik, RWTH Aachen, Germany
#Y (C) 1998 School Math and Comp. Sci., University of St Andrews, Scotland
#Y Copyright (C) 2002 The GAP Group
##
## This file contains generic methods for vector spaces.
##
#############################################################################
##
#M SetLeftActingDomain( <extL>, <D> )
##
## check whether the left acting domain <D> of the external left set <extL>
## knows that it is a division ring.
## This is used, e.g., to tell a free module over a division ring
## that it is a vector space.
##
InstallOtherMethod( SetLeftActingDomain,
"method to set also 'IsLeftActedOnByDivisionRing'",
[ IsAttributeStoringRep and IsLeftActedOnByRing, IsObject ],0,
function( extL, D )
if HasIsDivisionRing( D ) and IsDivisionRing( D ) then
SetIsLeftActedOnByDivisionRing( extL, true );
fi;
TryNextMethod();
end );
#############################################################################
##
#M IsLeftActedOnByDivisionRing( <M> )
##
InstallMethod( IsLeftActedOnByDivisionRing,
"method for external left set that is left acted on by a ring",
[ IsExtLSet and IsLeftActedOnByRing ],
function( M )
if IsIdenticalObj( M, LeftActingDomain( M ) ) then
TryNextMethod();
else
return IsDivisionRing( LeftActingDomain( M ) );
fi;
end );
#############################################################################
##
#F VectorSpace( <F>, <gens>[, <zero>][, "basis"] )
##
## The only difference between `VectorSpace' and `FreeLeftModule' shall be
## that the left acting domain of a vector space must be a division ring.
##
InstallGlobalFunction( VectorSpace, function( arg )
if Length( arg ) = 0 or not IsDivisionRing( arg[1] ) then
Error( "usage: VectorSpace( <F>, <gens>[, <zero>][, \"basis\"] )" );
fi;
return CallFuncList( FreeLeftModule, arg );
end );
#############################################################################
##
#M AsSubspace( <V>, <C> ) . . . . . . . for a vector space and a collection
##
InstallMethod( AsSubspace,
"for a vector space and a collection",
[ IsVectorSpace, IsCollection ],
function( V, C )
local newC;
if not IsSubset( V, C ) then
return fail;
fi;
newC:= AsVectorSpace( LeftActingDomain( V ), C );
if newC = fail then
return fail;
fi;
SetParent( newC, V );
UseIsomorphismRelation( C, newC );
UseSubsetRelation( C, newC );
return newC;
end );
#############################################################################
##
#M AsLeftModule( <F>, <V> ) . . . . . . for division ring and vector space
##
## View the vector space <V> as a vector space over the division ring <F>.
##
InstallMethod( AsLeftModule,
"method for a division ring and a vector space",
[ IsDivisionRing, IsVectorSpace ],
function( F, V )
local W, # the space, result
base, # basis vectors of field extension
gen, # loop over generators of 'V'
b, # loop over 'base'
gens, # generators of 'V'
newgens; # extended list of generators
if Characteristic( F ) <> Characteristic( LeftActingDomain( V ) ) then
# This is impossible.
return fail;
elif F = LeftActingDomain( V ) then
# No change of the left acting domain is necessary.
return V;
elif IsSubset( F, LeftActingDomain( V ) ) then
# Check whether 'V' is really a space over the bigger field,
# that is, whether the set of elements does not change.
base:= BasisVectors( Basis( AsField( LeftActingDomain( V ), F ) ) );
for gen in GeneratorsOfLeftModule( V ) do
for b in base do
if not b * gen in V then
# The field extension would change the set of elements.
return fail;
fi;
od;
od;
# Construct the space.
W:= LeftModuleByGenerators( F, GeneratorsOfLeftModule(V), Zero(V) );
elif IsSubset( LeftActingDomain( V ), F ) then
# View 'V' as a space over a smaller field.
# For that, the list of generators must be extended.
gens:= GeneratorsOfLeftModule( V );
if IsEmpty( gens ) then
W:= LeftModuleByGenerators( F, [], Zero( V ) );
else
base:= BasisVectors( Basis( AsField( F, LeftActingDomain( V ) ) ) );
newgens:= [];
for b in base do
for gen in gens do
Add( newgens, b * gen );
od;
od;
W:= LeftModuleByGenerators( F, newgens );
fi;
else
# View 'V' first as space over the intersection of fields,
# and then over the desired field.
return AsLeftModule( F,
AsLeftModule( Intersection( F,
LeftActingDomain( V ) ), V ) );
fi;
UseIsomorphismRelation( V, W );
UseSubsetRelation( V, W );
return W;
end );
#############################################################################
##
#M ViewObj( <V> ) . . . . . . . . . . . . . . . . . . . view a vector space
##
## print left acting domain, if known also dimension or no. of generators
##
InstallMethod( ViewObj,
"for vector space with known generators",
[ IsVectorSpace and HasGeneratorsOfLeftModule ],
function( V )
Print( "<vector space over ", LeftActingDomain( V ), ", with ",
Length( GeneratorsOfLeftModule( V ) ), " generators>" );
end );
InstallMethod( ViewObj,
"for vector space with known dimension",
[ IsVectorSpace and HasDimension ],
1, # override method for known generators
function( V )
Print( "<vector space of dimension ", Dimension( V ),
" over ", LeftActingDomain( V ), ">" );
end );
InstallMethod( ViewObj,
"for vector space",
[ IsVectorSpace ],
function( V )
Print( "<vector space over ", LeftActingDomain( V ), ">" );
end );
#############################################################################
##
#M PrintObj( <V> ) . . . . . . . . . . . . . . . . . . . for a vector space
##
InstallMethod( PrintObj,
"method for vector space with left module generators",
[ IsVectorSpace and HasGeneratorsOfLeftModule ],
function( V )
Print( "VectorSpace( ", LeftActingDomain( V ), ", ",
GeneratorsOfLeftModule( V ) );
if IsEmpty( GeneratorsOfLeftModule( V ) ) and HasZero( V ) then
Print( ", ", Zero( V ), " )" );
else
Print( " )" );
fi;
end );
InstallMethod( PrintObj,
"method for vector space",
[ IsVectorSpace ],
function( V )
Print( "VectorSpace( ", LeftActingDomain( V ), ", ... )" );
end );
#############################################################################
##
#M \/( <V>, <W> ) . . . . . . . . . factor of a vector space by a subspace
#M \/( <V>, <vectors> ) . . . . . . factor of a vector space by a subspace
##
InstallOtherMethod( \/,
"method for vector space and collection",
IsIdenticalObj,
[ IsVectorSpace, IsCollection ],
function( V, vectors )
if IsVectorSpace( vectors ) then
TryNextMethod();
else
return V / Subspace( V, vectors );
fi;
end );
InstallOtherMethod( \/,
"generic method for two vector spaces",
IsIdenticalObj,
[ IsVectorSpace, IsVectorSpace ],
function( V, W )
return ImagesSource( NaturalHomomorphismBySubspace( V, W ) );
end );
#############################################################################
##
#M Intersection2Spaces( <AsStruct>, <Substruct>, <Struct> )
##
InstallGlobalFunction( Intersection2Spaces,
function( AsStructure, Substructure, Structure )
return function( V, W )
local inters, # intersection, result
F, # coefficients field
gensV, # list of generators of 'V'
gensW, # list of generators of 'W'
VW, # sum of 'V' and 'W'
B; # basis of 'VW'
if LeftActingDomain( V ) <> LeftActingDomain( W ) then
# Compute the intersection as vector space over the intersection
# of the coefficients fields.
# (Note that the characteristic is the same.)
F:= Intersection2( LeftActingDomain( V ), LeftActingDomain( W ) );
return Intersection2( AsStructure( F, V ), AsStructure( F, W ) );
elif IsFiniteDimensional( V ) and IsFiniteDimensional( W ) then
# Compute the intersection of two spaces over the same field.
gensV:= GeneratorsOfLeftModule( V );
gensW:= GeneratorsOfLeftModule( W );
if IsEmpty( gensV ) then
if Zero( V ) in W then
inters:= V;
else
inters:= [];
fi;
elif IsEmpty( gensW ) then
if Zero( V ) in W then
inters:= W;
else
inters:= [];
fi;
else
# Compute a common coefficient space.
VW:= LeftModuleByGenerators( LeftActingDomain( V ),
Concatenation( gensV, gensW ) );
B:= Basis( VW );
# Construct the coefficient subspaces corresponding to 'V' and 'W'.
gensV:= List( gensV, x -> Coefficients( B, x ) );
gensW:= List( gensW, x -> Coefficients( B, x ) );
# Construct the intersection of row spaces, and carry back to VW.
inters:= List( SumIntersectionMat( gensV, gensW )[2],
x -> LinearCombination( B, x ) );
# Construct the intersection space, if possible with a parent.
if HasParent( V ) and HasParent( W )
and IsIdenticalObj( Parent( V ), Parent( W ) ) then
inters:= Substructure( Parent( V ), inters, "basis" );
elif IsEmpty( inters ) then
inters:= Substructure( V, inters, "basis" );
SetIsTrivial( inters, true );
else
inters:= Structure( LeftActingDomain( V ), inters, "basis" );
fi;
# Run implications by the subset relation.
UseSubsetRelation( V, inters );
UseSubsetRelation( W, inters );
fi;
# Return the result.
return inters;
else
TryNextMethod();
fi;
end;
end );
#############################################################################
##
#M Intersection2( <V>, <W> ) . . . . . . . . . . . . . for two vector spaces
##
InstallMethod( Intersection2,
"method for two vector spaces",
IsIdenticalObj,
[ IsVectorSpace, IsVectorSpace ],
Intersection2Spaces( AsLeftModule, SubspaceNC, VectorSpace ) );
#############################################################################
##
#M ClosureLeftModule( <V>, <a> ) . . . . . . . . . closure of a vector space
##
InstallMethod( ClosureLeftModule,
"method for a vector space with basis, and a vector",
IsCollsElms,
[ IsVectorSpace and HasBasis, IsVector ],
function( V, w )
local B; # basis of 'V'
# We can test membership easily.
B:= Basis( V );
#T why easily?
if Coefficients( B, w ) = fail then
# In the case of a vector space, we know a basis of the closure.
B:= Concatenation( BasisVectors( B ), [ w ] );
V:= LeftModuleByGenerators( LeftActingDomain( V ), B );
UseBasis( V, B );
fi;
return V;
end );
#############################################################################
##
## Methods for collections of subspaces of a vector space
##
#############################################################################
##
#R IsSubspacesVectorSpaceDefaultRep( <D> )
##
## is the representation of domains of subspaces of a vector space <V>,
## with the components 'structure' (with value <V>) and 'dimension'
## (with value either the dimension of the subspaces in the domain
## or the string '\"all\"', which means that the domain contains all
## subspaces of <V>).
##
DeclareRepresentation(
"IsSubspacesVectorSpaceDefaultRep",
IsComponentObjectRep,
[ "dimension", "structure" ] );
#T not IsAttributeStoringRep?
#############################################################################
##
#M PrintObj( <D> ) . . . . . . . . . . . . . . . . . for a subspaces domain
##
InstallMethod( PrintObj,
"method for a subspaces domain",
[ IsSubspacesVectorSpace and IsSubspacesVectorSpaceDefaultRep ],
function( D )
if IsInt( D!.dimension ) then
Print( "Subspaces( ", D!.structure, ", ", D!.dimension, " )" );
else
Print( "Subspaces( ", D!.structure, " )" );
fi;
end );
#############################################################################
##
#M Size( <D> ) . . . . . . . . . . . . . . . . . . . for a subspaces domain
##
## The number of $k$-dimensional subspaces in a $n$-dimensional space over
## the field with $q$ elements is
## $$
## a(n,k) = \prod_{i=0}^{k-1} \frac{q^n-q^i}{q^k-q^i} =
## \prod_{i=0}^{k-1} \frac{q^{n-i}-1}{q^{k-i}-1}.
## $$
## We have the recursion
## $$
## a(n,k+1) = a(n,k) \frac{q^{n-i}-1}{q^{i+1}-1}.
## $$
##
## (The number of all subspaces is $\sum_{k=0}^n a(n,k)$.)
##
InstallMethod( Size,
"method for a subspaces domain",
[ IsSubspacesVectorSpace and IsSubspacesVectorSpaceDefaultRep ],
function( D )
local k,
n,
q,
size,
qn,
qd,
ank,
i;
if D!.dimension = "all" then
# all subspaces of the space
n:= Dimension( D!.structure );
q:= Size( LeftActingDomain( D!.structure ) );
size:= 1;
qn:= q^n;
qd:= q;
# $a(n,0)$
ank:= 1;
for k in [ 1 .. Int( (n-1)/2 ) ] do
# Compute $a(n,k)$.
ank:= ank * ( qn - 1 ) / ( qd - 1 );
qn:= qn / q;
qd:= qd * q;
size:= size + ank;
od;
size:= 2 * size;
if n mod 2 = 0 then
# Add the number of spaces of dimension $n/2$.
size:= size + ank * ( qn - 1 ) / ( qd - 1 );
fi;
else
# number of spaces of dimension 'k' only
n:= Dimension( D!.structure );
if D!.dimension < 0 or
n < D!.dimension then
return 0;
elif n / 2 < D!.dimension then
k:= n - D!.dimension;
else
k:= D!.dimension;
fi;
q:= Size( LeftActingDomain( D!.structure ) );
size:= 1;
qn:= q^n;
qd:= q;
for i in [ 1 .. k ] do
size:= size * ( qn - 1 ) / ( qd - 1 );
qn:= qn / q;
qd:= qd * q;
od;
fi;
# Return the result.
return size;
end );
#############################################################################
##
#M Enumerator( <D> ) . . . . . . . . . . . . . . . . for a subspaces domain
##
## Use the iterator to compute the elements list.
#T This is not allowed!
##
InstallMethod( Enumerator,
"method for a subspaces domain",
[ IsSubspacesVectorSpace and IsSubspacesVectorSpaceDefaultRep ],
function( D )
local iter, # iterator for 'D'
elms; # elements list, result
iter:= Iterator( D );
elms:= [];
while not IsDoneIterator( iter ) do
Add( elms, NextIterator( iter ) );
od;
return elms;
end );
#T necessary?
#############################################################################
##
#M Iterator( <D> ) . . . . . . . . . . . . . . . . . for a subspaces domain
##
## uses the subspaces iterator for full row spaces and the mechanism of
## associated row spaces.
##
BindGlobal( "IsDoneIterator_Subspaces",
iter -> IsDoneIterator( iter!.associatedIterator ) );
BindGlobal( "NextIterator_Subspaces", function( iter )
local next;
next:= NextIterator( iter!.associatedIterator );
next:= List( GeneratorsOfLeftModule( next ),
x -> LinearCombination( iter!.basis, x ) );
return Subspace( iter!.structure, next, "basis" );
end );
BindGlobal( "ShallowCopy_Subspaces",
iter -> rec( structure := iter!.structure,
basis := iter!.basis,
associatedIterator := ShallowCopy(
iter!.associatedIterator ) ) );
InstallMethod( Iterator,
"for a subspaces domain",
[ IsSubspacesVectorSpace and IsSubspacesVectorSpaceDefaultRep ],
function( D )
local V; # the vector space
V:= D!.structure;
return IteratorByFunctions( rec(
IsDoneIterator := IsDoneIterator_Subspaces,
NextIterator := NextIterator_Subspaces,
ShallowCopy := ShallowCopy_Subspaces,
structure := V,
basis := Basis( V ),
associatedIterator := Iterator(
Subspaces( FullRowSpace( LeftActingDomain( V ),
Dimension( V ) ),
D!.dimension ) ) ) );
end );
#############################################################################
##
#M Subspaces( <V>, <dim> )
##
InstallMethod( Subspaces,
"for a vector space, and an integer",
[ IsVectorSpace, IsInt ],
function( V, dim )
if IsFinite( V ) then
return Objectify( NewType( CollectionsFamily( FamilyObj( V ) ),
IsSubspacesVectorSpace
and IsSubspacesVectorSpaceDefaultRep ),
rec(
structure := V,
dimension := dim
)
);
else
TryNextMethod();
fi;
end );
#############################################################################
##
#M Subspaces( <V> )
##
InstallMethod( Subspaces,
"for a vector space",
[ IsVectorSpace ],
function( V )
if IsFinite( V ) then
return Objectify( NewType( CollectionsFamily( FamilyObj( V ) ),
IsSubspacesVectorSpace
and IsSubspacesVectorSpaceDefaultRep ),
rec(
structure := V,
dimension := "all"
)
);
else
TryNextMethod();
fi;
end );
#############################################################################
##
#F IsSubspace( <V>, <U> ) . . . . . . . . . . . . . . . . . check <U> <= <V>
##
InstallGlobalFunction( IsSubspace, function( V, U )
return IsVectorSpace( U ) and IsSubset( V, U );
end );
#############################################################################
##
#M IsVectorSpaceHomomorphism( <map> )
##
InstallMethod( IsVectorSpaceHomomorphism,
[ IsGeneralMapping ],
function( map )
local S, R, F;
S:= Source( map );
if not IsVectorSpace( S ) then
return false;
fi;
R:= Range( map );
if not IsVectorSpace( R ) then
return false;
fi;
F:= LeftActingDomain( S );
return ( F = LeftActingDomain( R ) ) and IsLinearMapping( F, map );
end );
#############################################################################
##
#E

View File

@@ -0,0 +1,642 @@
/*
Originally from /Source/gg2/Scripts/Client/ClientBeginStep.gml in Gang Garrison 2
Copyright (C) 2008-2013 Faucet Software
http://www.ganggarrison.com
This program is free software;
you can redistribute it and/or modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 3 of the License, or (at your option)
any later version.
This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with this program; if not,
see <http://www.gnu.org/licenses>.
Additional permission under GNU GPL version 3 section 7
If you modify this Program, or any covered work, by linking or combining it with the Game Maker runtime library,
the 39dll library/extension, Hobbel's Download Manager DLL, or modified versions of these libraries,
the licensors of this Program grant you additional permission to convey the resulting work.
*/
// receive and interpret the server's message(s)
var i, playerObject, playerID, player, otherPlayerID, otherPlayer, sameVersion, buffer, plugins, pluginsRequired, usePlugins;
if(tcp_eof(global.serverSocket)) {
if(gotServerHello)
show_message("You have been disconnected from the server.");
else
show_message("Unable to connect to the server.");
instance_destroy();
exit;
}
if(room == DownloadRoom and keyboard_check(vk_escape))
{
instance_destroy();
exit;
}
if(downloadingMap)
{
while(tcp_receive(global.serverSocket, min(1024, downloadMapBytes-buffer_size(downloadMapBuffer))))
{
write_buffer(downloadMapBuffer, global.serverSocket);
if(buffer_size(downloadMapBuffer) == downloadMapBytes)
{
write_buffer_to_file(downloadMapBuffer, "Maps/" + downloadMapName + ".png");
downloadingMap = false;
buffer_destroy(downloadMapBuffer);
downloadMapBuffer = -1;
exit;
}
}
exit;
}
roomchange = false;
do {
if(tcp_receive(global.serverSocket,1)) {
switch(read_ubyte(global.serverSocket)) {
case HELLO:
gotServerHello = true;
global.joinedServerName = receivestring(global.serverSocket, 1);
downloadMapName = receivestring(global.serverSocket, 1);
advertisedMapMd5 = receivestring(global.serverSocket, 1);
receiveCompleteMessage(global.serverSocket, 1, global.tempBuffer);
pluginsRequired = read_ubyte(global.tempBuffer);
plugins = receivestring(global.serverSocket, 1);
if(string_pos("/", downloadMapName) != 0 or string_pos("\", downloadMapName) != 0)
{
show_message("Server sent illegal map name: "+downloadMapName);
instance_destroy();
exit;
}
if (!noReloadPlugins && string_length(plugins))
{
usePlugins = pluginsRequired || !global.serverPluginsPrompt;
if (global.serverPluginsPrompt)
{
var prompt;
if (pluginsRequired)
{
prompt = show_question(
"This server requires the following plugins to play on it: "
+ string_replace_all(plugins, ",", "#")
+ '#They are downloaded from the source: "'
+ PLUGIN_SOURCE
+ '"#The source states: "'
+ PLUGIN_SOURCE_NOTICE
+ '"#Do you wish to download them and continue connecting?'
);
if (!prompt)
{
instance_destroy();
exit;
}
}
else
{
prompt = show_question(
"This server suggests the following optional plugins to play on it: "
+ string_replace_all(plugins, ",", "#")
+ '#They are downloaded from the source: "'
+ PLUGIN_SOURCE
+ '"#The source states: "'
+ PLUGIN_SOURCE_NOTICE
+ '"#Do you wish to download them and use them?'
);
if (prompt)
{
usePlugins = true;
}
}
}
if (usePlugins)
{
if (!loadserverplugins(plugins))
{
show_message("Error ocurred loading server-sent plugins.");
instance_destroy();
exit;
}
global.serverPluginsInUse = true;
}
}
noReloadPlugins = false;
if(advertisedMapMd5 != "")
{
var download;
download = not file_exists("Maps/" + downloadMapName + ".png");
if(!download and CustomMapGetMapMD5(downloadMapName) != advertisedMapMd5)
{
if(show_question("The server's copy of the map (" + downloadMapName + ") differs from ours.#Would you like to download this server's version of the map?"))
download = true;
else
{
instance_destroy();
exit;
}
}
if(download)
{
write_ubyte(global.serverSocket, DOWNLOAD_MAP);
socket_send(global.serverSocket);
receiveCompleteMessage(global.serverSocket,4,global.tempBuffer);
downloadMapBytes = read_uint(global.tempBuffer);
downloadMapBuffer = buffer_create();
downloadingMap = true;
roomchange=true;
}
}
ClientPlayerJoin(global.serverSocket);
if(global.rewardKey != "" and global.rewardId != "")
{
var rewardId;
rewardId = string_copy(global.rewardId, 0, 255);
write_ubyte(global.serverSocket, REWARD_REQUEST);
write_ubyte(global.serverSocket, string_length(rewardId));
write_string(global.serverSocket, rewardId);
}
if(global.queueJumping == true)
{
write_ubyte(global.serverSocket, CLIENT_SETTINGS);
write_ubyte(global.serverSocket, global.queueJumping);
}
socket_send(global.serverSocket);
break;
case JOIN_UPDATE:
receiveCompleteMessage(global.serverSocket,2,global.tempBuffer);
global.playerID = read_ubyte(global.tempBuffer);
global.currentMapArea = read_ubyte(global.tempBuffer);
break;
case FULL_UPDATE:
deserializeState(FULL_UPDATE);
break;
case QUICK_UPDATE:
deserializeState(QUICK_UPDATE);
break;
case CAPS_UPDATE:
deserializeState(CAPS_UPDATE);
break;
case INPUTSTATE:
deserializeState(INPUTSTATE);
break;
case PLAYER_JOIN:
player = instance_create(0,0,Player);
player.name = receivestring(global.serverSocket, 1);
ds_list_add(global.players, player);
if(ds_list_size(global.players)-1 == global.playerID) {
global.myself = player;
instance_create(0,0,PlayerControl);
}
break;
case PLAYER_LEAVE:
// Delete player from the game, adjust own ID accordingly
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
playerID = read_ubyte(global.tempBuffer);
player = ds_list_find_value(global.players, playerID);
removePlayer(player);
if(playerID < global.playerID) {
global.playerID -= 1;
}
break;
case PLAYER_DEATH:
var causeOfDeath, assistantPlayerID, assistantPlayer;
receiveCompleteMessage(global.serverSocket,4,global.tempBuffer);
playerID = read_ubyte(global.tempBuffer);
otherPlayerID = read_ubyte(global.tempBuffer);
assistantPlayerID = read_ubyte(global.tempBuffer);
causeOfDeath = read_ubyte(global.tempBuffer);
player = ds_list_find_value(global.players, playerID);
otherPlayer = noone;
if(otherPlayerID != 255)
otherPlayer = ds_list_find_value(global.players, otherPlayerID);
assistantPlayer = noone;
if(assistantPlayerID != 255)
assistantPlayer = ds_list_find_value(global.players, assistantPlayerID);
doEventPlayerDeath(player, otherPlayer, assistantPlayer, causeOfDeath);
break;
case BALANCE:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
balanceplayer=read_ubyte(global.tempBuffer);
if balanceplayer == 255 {
if !instance_exists(Balancer) instance_create(x,y,Balancer);
with(Balancer) notice=0;
} else {
player = ds_list_find_value(global.players, balanceplayer);
if(player.object != -1) {
with(player.object) {
instance_destroy();
}
player.object = -1;
}
if(player.team==TEAM_RED) {
player.team = TEAM_BLUE;
} else {
player.team = TEAM_RED;
}
if !instance_exists(Balancer) instance_create(x,y,Balancer);
Balancer.name=player.name;
with (Balancer) notice=1;
}
break;
case PLAYER_CHANGETEAM:
receiveCompleteMessage(global.serverSocket,2,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
if(player.object != -1) {
with(player.object) {
instance_destroy();
}
player.object = -1;
}
player.team = read_ubyte(global.tempBuffer);
break;
case PLAYER_CHANGECLASS:
receiveCompleteMessage(global.serverSocket,2,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
if(player.object != -1) {
with(player.object) {
instance_destroy();
}
player.object = -1;
}
player.class = read_ubyte(global.tempBuffer);
break;
case PLAYER_CHANGENAME:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
player.name = receivestring(global.serverSocket, 1);
if player=global.myself {
global.playerName=player.name
}
break;
case PLAYER_SPAWN:
receiveCompleteMessage(global.serverSocket,3,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
doEventSpawn(player, read_ubyte(global.tempBuffer), read_ubyte(global.tempBuffer));
break;
case CHAT_BUBBLE:
var bubbleImage;
receiveCompleteMessage(global.serverSocket,2,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
setChatBubble(player, read_ubyte(global.tempBuffer));
break;
case BUILD_SENTRY:
receiveCompleteMessage(global.serverSocket,6,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
buildSentry(player, read_ushort(global.tempBuffer)/5, read_ushort(global.tempBuffer)/5, read_byte(global.tempBuffer));
break;
case DESTROY_SENTRY:
receiveCompleteMessage(global.serverSocket,4,global.tempBuffer);
playerID = read_ubyte(global.tempBuffer);
otherPlayerID = read_ubyte(global.tempBuffer);
assistantPlayerID = read_ubyte(global.tempBuffer);
causeOfDeath = read_ubyte(global.tempBuffer);
player = ds_list_find_value(global.players, playerID);
if(otherPlayerID == 255) {
doEventDestruction(player, noone, noone, causeOfDeath);
} else {
otherPlayer = ds_list_find_value(global.players, otherPlayerID);
if (assistantPlayerID == 255) {
doEventDestruction(player, otherPlayer, noone, causeOfDeath);
} else {
assistantPlayer = ds_list_find_value(global.players, assistantPlayerID);
doEventDestruction(player, otherPlayer, assistantPlayer, causeOfDeath);
}
}
break;
case GRAB_INTEL:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
doEventGrabIntel(player);
break;
case SCORE_INTEL:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
doEventScoreIntel(player);
break;
case DROP_INTEL:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
doEventDropIntel(player);
break;
case RETURN_INTEL:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
doEventReturnIntel(read_ubyte(global.tempBuffer));
break;
case GENERATOR_DESTROY:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
team = read_ubyte(global.tempBuffer);
doEventGeneratorDestroy(team);
break;
case UBER_CHARGED:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
doEventUberReady(player);
break;
case UBER:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
doEventUber(player);
break;
case OMNOMNOMNOM:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
if(player.object != -1) {
with(player.object) {
omnomnomnom=true;
if(hp < 200)
{
canEat = false;
alarm[6] = eatCooldown; //10 second cooldown
}
if(player.team == TEAM_RED) {
omnomnomnomindex=0;
omnomnomnomend=31;
} else if(player.team==TEAM_BLUE) {
omnomnomnomindex=32;
omnomnomnomend=63;
}
xscale=image_xscale;
}
}
break;
case TOGGLE_ZOOM:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
if player.object != -1 {
toggleZoom(player.object);
}
break;
case PASSWORD_REQUEST:
if(!usePreviousPwd)
global.clientPassword = get_string("Enter Password:", "");
write_ubyte(global.serverSocket, string_length(global.clientPassword));
write_string(global.serverSocket, global.clientPassword);
socket_send(global.serverSocket);
break;
case PASSWORD_WRONG:
show_message("Incorrect Password.");
instance_destroy();
exit;
case INCOMPATIBLE_PROTOCOL:
show_message("Incompatible server protocol version.");
instance_destroy();
exit;
case KICK:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
reason = read_ubyte(global.tempBuffer);
if reason == KICK_NAME kickReason = "Name Exploit";
else if reason == KICK_BAD_PLUGIN_PACKET kickReason = "Invalid plugin packet ID";
else if reason == KICK_MULTI_CLIENT kickReason = "There are too many connections from your IP";
else kickReason = "";
show_message("You have been kicked from the server. "+kickReason+".");
instance_destroy();
exit;
case ARENA_STARTROUND:
doEventArenaStartRound();
break;
case ARENA_ENDROUND:
with ArenaHUD clientArenaEndRound();
break;
case ARENA_RESTART:
doEventArenaRestart();
break;
case UNLOCKCP:
doEventUnlockCP();
break;
case MAP_END:
global.nextMap=receivestring(global.serverSocket, 1);
receiveCompleteMessage(global.serverSocket,2,global.tempBuffer);
global.winners=read_ubyte(global.tempBuffer);
global.currentMapArea=read_ubyte(global.tempBuffer);
global.mapchanging = true;
if !instance_exists(ScoreTableController) instance_create(0,0,ScoreTableController);
instance_create(0,0,WinBanner);
break;
case CHANGE_MAP:
roomchange=true;
global.mapchanging = false;
global.currentMap = receivestring(global.serverSocket, 1);
global.currentMapMD5 = receivestring(global.serverSocket, 1);
if(global.currentMapMD5 == "") { // if this is an internal map (signified by the lack of an md5)
if(findInternalMapRoom(global.currentMap))
room_goto_fix(findInternalMapRoom(global.currentMap));
else
{
show_message("Error:#Server went to invalid internal map: " + global.currentMap + "#Exiting.");
instance_destroy();
exit;
}
} else { // it's an external map
if(string_pos("/", global.currentMap) != 0 or string_pos("\", global.currentMap) != 0)
{
show_message("Server sent illegal map name: "+global.currentMap);
instance_destroy();
exit;
}
if(!file_exists("Maps/" + global.currentMap + ".png") or CustomMapGetMapMD5(global.currentMap) != global.currentMapMD5)
{ // Reconnect to the server to download the map
var oldReturnRoom;
oldReturnRoom = returnRoom;
returnRoom = DownloadRoom;
if (global.serverPluginsInUse)
noUnloadPlugins = true;
event_perform(ev_destroy,0);
ClientCreate();
if (global.serverPluginsInUse)
noReloadPlugins = true;
returnRoom = oldReturnRoom;
usePreviousPwd = true;
exit;
}
room_goto_fix(CustomMapRoom);
}
for(i=0; i<ds_list_size(global.players); i+=1) {
player = ds_list_find_value(global.players, i);
if global.currentMapArea == 1 {
player.stats[KILLS] = 0;
player.stats[DEATHS] = 0;
player.stats[CAPS] = 0;
player.stats[ASSISTS] = 0;
player.stats[DESTRUCTION] = 0;
player.stats[STABS] = 0;
player.stats[HEALING] = 0;
player.stats[DEFENSES] = 0;
player.stats[INVULNS] = 0;
player.stats[BONUS] = 0;
player.stats[DOMINATIONS] = 0;
player.stats[REVENGE] = 0;
player.stats[POINTS] = 0;
player.roundStats[KILLS] = 0;
player.roundStats[DEATHS] = 0;
player.roundStats[CAPS] = 0;
player.roundStats[ASSISTS] = 0;
player.roundStats[DESTRUCTION] = 0;
player.roundStats[STABS] = 0;
player.roundStats[HEALING] = 0;
player.roundStats[DEFENSES] = 0;
player.roundStats[INVULNS] = 0;
player.roundStats[BONUS] = 0;
player.roundStats[DOMINATIONS] = 0;
player.roundStats[REVENGE] = 0;
player.roundStats[POINTS] = 0;
player.team = TEAM_SPECTATOR;
}
}
break;
case SERVER_FULL:
show_message("The server is full.");
instance_destroy();
exit;
case REWARD_CHALLENGE_CODE:
var challengeData;
receiveCompleteMessage(global.serverSocket,16,global.tempBuffer);
challengeData = read_binstring(global.tempBuffer, buffer_size(global.tempBuffer));
challengeData += socket_remote_ip(global.serverSocket);
write_ubyte(global.serverSocket, REWARD_CHALLENGE_RESPONSE);
write_binstring(global.serverSocket, hmac_md5_bin(global.rewardKey, challengeData));
socket_send(global.serverSocket);
break;
case REWARD_UPDATE:
receiveCompleteMessage(global.serverSocket,1,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
var rewardString;
rewardString = receivestring(global.serverSocket, 2);
doEventUpdateRewards(player, rewardString);
break;
case MESSAGE_STRING:
var message, notice;
message = receivestring(global.serverSocket, 1);
with NoticeO instance_destroy();
notice = instance_create(0, 0, NoticeO);
notice.notice = NOTICE_CUSTOM;
notice.message = message;
break;
case SENTRY_POSITION:
receiveCompleteMessage(global.serverSocket,5,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
if(player.sentry)
{
player.sentry.x = read_ushort(global.tempBuffer) / 5;
player.sentry.y = read_ushort(global.tempBuffer) / 5;
player.sentry.xprevious = player.sentry.x;
player.sentry.yprevious = player.sentry.y;
player.sentry.vspeed = 0;
}
break;
case WEAPON_FIRE:
receiveCompleteMessage(global.serverSocket,9,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
if(player.object)
{
with(player.object)
{
x = read_ushort(global.tempBuffer)/5;
y = read_ushort(global.tempBuffer)/5;
hspeed = read_byte(global.tempBuffer)/8.5;
vspeed = read_byte(global.tempBuffer)/8.5;
xprevious = x;
yprevious = y;
}
doEventFireWeapon(player, read_ushort(global.tempBuffer));
}
break;
case PLUGIN_PACKET:
var packetID, packetLen, buf, success;
// fetch full packet
receiveCompleteMessage(global.serverSocket, 2, global.tempBuffer);
packetLen = read_ushort(global.tempBuffer);
receiveCompleteMessage(global.serverSocket, packetLen, global.tempBuffer);
packetID = read_ubyte(global.tempBuffer);
// get packet data
buf = buffer_create();
write_buffer_part(buf, global.tempBuffer, packetLen - 1);
// try to enqueue
// give "noone" value for client since received from server
success = _PluginPacketPush(packetID, buf, noone);
// if it returned false, packetID was invalid
if (!success)
{
// clear up buffer
buffer_destroy(buf);
show_error("ERROR when reading plugin packet: no such plugin packet ID " + string(packetID), true);
}
break;
case CLIENT_SETTINGS:
receiveCompleteMessage(global.serverSocket,2,global.tempBuffer);
player = ds_list_find_value(global.players, read_ubyte(global.tempBuffer));
player.queueJump = read_ubyte(global.tempBuffer);
break;
default:
promptRestartOrQuit("The Server sent unexpected data.");
exit;
}
} else {
break;
}
} until(roomchange);

View File

@@ -0,0 +1,141 @@
/*
Originally from /Source/gg2/Objects/Updater.events/Create.xml in Gang Garrison 2
Copyright (C) 2008-2013 Faucet Software
http://www.ganggarrison.com
This program is free software;
you can redistribute it and/or modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 3 of the License, or (at your option)
any later version.
This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with this program; if not,
see <http://www.gnu.org/licenses>.
Additional permission under GNU GPL version 3 section 7
If you modify this Program, or any covered work, by linking or combining it with the Game Maker runtime library,
the 39dll library/extension, Hobbel's Download Manager DLL, or modified versions of these libraries,
the licensors of this Program grant you additional permission to convey the resulting work.
*/
// Downloading code.
var downloadHandle, url, tmpfile, window_oldshowborder, window_oldfullscreen;
timeLeft = 0;
counter = 0;
AudioControlPlaySong(-1, false);
window_oldshowborder = window_get_showborder();
window_oldfullscreen = window_get_fullscreen();
window_set_fullscreen(false);
window_set_showborder(false);
if(global.updaterBetaChannel)
url = UPDATE_SOURCE_BETA;
else
url = UPDATE_SOURCE;
tmpfile = temp_directory + "\gg2update.zip";
downloadHandle = httpGet(url, -1);
while(!httpRequestStatus(downloadHandle))
{ // while download isn't finished
sleep(floor(1000/30)); // sleep for the equivalent of one frame
io_handle(); // this prevents GameMaker from appearing locked-up
httpRequestStep(downloadHandle);
// check if the user cancelled the download with the esc key
if(keyboard_check(vk_escape))
{
httpRequestDestroy(downloadHandle);
window_set_showborder(window_oldshowborder);
window_set_fullscreen(window_oldfullscreen);
room_goto_fix(Menu);
exit;
}
if(counter == 0 || counter mod 60 == 0)
timer = random(359)+1;
draw_sprite(UpdaterBackgroundS,0,0,0);
draw_set_color(c_white);
draw_set_halign(fa_left);
draw_set_valign(fa_center);
minutes=floor(timer/60);
seconds=floor(timer-minutes*60);
draw_text(x,y-20,string(minutes) + " minutes " + string(seconds) + " seconds Remaining...");
counter+=1;
var progress, size;
progress = httpRequestResponseBodyProgress(downloadHandle);
size = httpRequestResponseBodySize(downloadHandle);
if (size != -1)
{
progressBar = floor((progress/size) * 20);
offset = 3;
for(i=0;i<progressBar;i+=1){
draw_sprite(UpdaterProgressS,0,x+offset,y);
offset+=12;
}
}
screen_refresh();
}
// Errored
if (httpRequestStatus(downloadHandle) == 2)
{
show_message("Downloading update failed!#" + httpRequestError(downloadHandle));
httpRequestDestroy(downloadHandle);
window_set_showborder(window_oldshowborder);
window_set_fullscreen(window_oldfullscreen);
room_goto_fix(Menu);
exit;
}
// Request failed
if (httpRequestStatusCode(downloadHandle) != 200)
{
show_message("Downloading update failed!#" + string(httpRequestStatusCode(downloadHandle)) + " " + httpRequestReasonPhrase(downloadHandle));
httpRequestDestroy(downloadHandle);
window_set_showborder(window_oldshowborder);
window_set_fullscreen(window_oldfullscreen);
room_goto_fix(Menu);
exit;
}
write_buffer_to_file(httpRequestResponseBody(downloadHandle), tmpfile);
httpRequestDestroy(downloadHandle);
if(!file_exists(tmpfile))
{
window_set_showborder(window_oldshowborder);
window_set_fullscreen(window_oldfullscreen);
show_message("Error updating: Missing gg2update.zip in temp directory, download failed(?)");
room_goto_fix(Menu);
exit;
}
// rename existing "Gang Garrison 2.exe" to avoid conflict when extracting
if (file_exists("Gang Garrison 2.exe"))
{
var newName, n;
n = 1;
// increment until unused name found
do
{
newName = "gg2-old.delete.me." + string(n);
n += 1;
}
until(!file_exists(newName));
file_rename("Gang Garrison 2.exe", newName);
}
// let's extract the downloaded file now.
extractzip(tmpfile, working_directory);
// run new version
execute_program("Gang Garrison 2.exe", "", false);
// exit
game_end();

View File

@@ -0,0 +1,161 @@
/*
Originally from /Source/gg2/Objects/InGameElements/Character.events/Draw.xml in Gang Garrison 2
Copyright (C) 2008-2013 Faucet Software
http://www.ganggarrison.com
This program is free software;
you can redistribute it and/or modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 3 of the License, or (at your option)
any later version.
This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with this program; if not,
see <http://www.gnu.org/licenses>.
Additional permission under GNU GPL version 3 section 7
If you modify this Program, or any covered work, by linking or combining it with the Game Maker runtime library,
the 39dll library/extension, Hobbel's Download Manager DLL, or modified versions of these libraries,
the licensors of this Program grant you additional permission to convey the resulting work.
*/
xoffset = view_xview[0];
yoffset = view_yview[0];
xsize = view_wview[0];
ysize = view_hview[0];
if (distance_to_point(xoffset+xsize/2,yoffset+ysize/2) > 800)
exit;
var xr, yr;
xr = round(x);
yr = round(y);
image_alpha = cloakAlpha;
if (global.myself.team == team and canCloak)
image_alpha = cloakAlpha/2 + 0.5;
if (invisible)
exit;
if(stabbing)
image_alpha -= power(currentWeapon.stab.alpha, 2);
if team == global.myself.team && (player != global.myself || global.showHealthBar == 1){
draw_set_alpha(1);
draw_healthbar(xr-10, yr-30, xr+10, yr-25,hp*100/maxHp,c_black,c_red,c_green,0,true,true);
}
if(distance_to_point(mouse_x, mouse_y)<25) {
if cloak && team!=global.myself.team exit;
draw_set_alpha(1);
draw_set_halign(fa_center);
draw_set_valign(fa_bottom);
if(team==TEAM_RED) {
draw_set_color(c_red);
} else {
draw_set_color(c_blue);
}
draw_text(xr, yr-35, player.name);
if(team == global.myself.team && global.showTeammateStats)
{
if(weapons[0] == Medigun)
draw_text(xr,yr+50, "Superburst: " + string(currentWeapon.uberCharge/20) + "%");
else if(weapons[0] == Shotgun)
draw_text(xr,yr+50, "Nuts 'N' Bolts: " + string(nutsNBolts));
else if(weapons[0] == Minegun)
draw_text(xr,yr+50, "Lobbed Mines: " + string(currentWeapon.lobbed));
}
}
draw_set_alpha(1);
if team == TEAM_RED ubercolour = c_red;
if team == TEAM_BLUE ubercolour = c_blue;
var sprite, overlaySprite;
if zoomed
{
if (team == TEAM_RED)
sprite = SniperCrouchRedS;
else
sprite = SniperCrouchBlueS;
overlaySprite = sniperCrouchOverlay;
}
else
{
sprite = sprite_index;
overlaySprite = overlay;
}
if (omnomnomnom)
{
draw_sprite_ext_overlay(omnomnomnomSprite,omnomnomnomOverlay,omnomnomnomindex,xr,yr,image_xscale,image_yscale,image_angle,c_white,1);
if (ubered)
draw_sprite_ext_overlay(omnomnomnomSprite,omnomnomnomOverlay,omnomnomnomindex,xr,yr,image_xscale,image_yscale,image_angle,ubercolour,0.7);
}
else if (taunting)
{
draw_sprite_ext_overlay(tauntsprite,tauntOverlay,tauntindex,xr,yr,image_xscale,image_yscale,image_angle,c_white,1);
if (ubered)
draw_sprite_ext_overlay(tauntsprite,tauntOverlay,tauntindex,xr,yr,image_xscale,image_yscale,image_angle,ubercolour,0.7);
}
else if (player.humiliated)
draw_sprite_ext(humiliationPoses,floor(animationImage)+humiliationOffset,xr,yr,image_xscale,image_yscale,image_angle,c_white,image_alpha);
else if (!taunting)
{
if (cloak)
{
if (!ubered)
draw_sprite_ext(sprite,floor(animationImage+animationOffset),xr,yr,image_xscale,image_yscale,image_angle,c_white,image_alpha);
else if (ubered)
{
draw_sprite_ext(sprite,floor(animationImage+animationOffset),xr,yr,image_xscale,image_yscale,image_angle,c_white,1);
draw_sprite_ext(sprite,floor(animationImage+animationOffset),xr,yr,image_xscale,image_yscale,image_angle,ubercolour,0.7);
}
}
else
{
if (!ubered)
draw_sprite_ext_overlay(sprite,overlaySprite,floor(animationImage+animationOffset),xr,yr,image_xscale,image_yscale,image_angle,c_white,image_alpha);
else if (ubered)
{
draw_sprite_ext_overlay(sprite,overlaySprite,floor(animationImage+animationOffset),xr,yr,image_xscale,image_yscale,image_angle,c_white,1);
draw_sprite_ext_overlay(sprite,overlaySprite,floor(animationImage+animationOffset),xr,yr,image_xscale,image_yscale,image_angle,ubercolour,0.7);
}
}
}
if (burnDuration > 0 or burnIntensity > 0) {
for(i = 0; i < numFlames * burnIntensity / maxIntensity; i += 1)
{
draw_sprite_ext(FlameS, alarm[5] + i + random(2), x + flameArray_x[i], y + flameArray_y[i], 1, 1, 0, c_white, burnDuration / maxDuration * 0.71 + 0.35);
}
}
// Copied from Lorgan's itemserver "angels" with slight modifications
// All credit be upon him
if (demon != -1)
{
demonX = median(x-40,demonX,x+40);
demonY = median(y-40,demonY,y);
demonOffset += demonDir;
if (abs(demonOffset) > 15)
demonDir *= -1;
var dir;
if (demonX > x)
dir = -1;
else
dir = 1;
if (demonFrame > sprite_get_number(demon))
demonFrame = 0;
if (stabbing || ubered)
draw_sprite_ext(demon,demonFrame+floor(animationImage)+7*player.team,demonX,demonY+demonOffset,dir*1,1,0,c_white,1);
else
draw_sprite_ext(demon,demonFrame+floor(animationImage)+7*player.team,demonX,demonY+demonOffset,dir*1,1,0,c_white,image_alpha);
demonFrame += 1;
}

View File

@@ -0,0 +1,80 @@
// Originally from /spelunky/Scripts/Platform Engine/characterDrawEvent.gml in the Spelunky Community Update Project
/**********************************************************************************
Copyright (c) 2008, 2009 Derek Yu and Mossmouth, LLC
This file is part of Spelunky.
You can redistribute and/or modify Spelunky, including its source code, under
the terms of the Spelunky User License.
Spelunky is distributed in the hope that it will be entertaining and useful,
but WITHOUT WARRANTY. Please see the Spelunky User License for more details.
The Spelunky User License should be available in "Game Information", which
can be found in the Resource Explorer, or as an external file called COPYING.
If not, please obtain a new copy of Spelunky from <http://spelunkyworld.com/>
***********************************************************************************/
/*
This event should be placed in the draw event of the platform character.
*/
//draws the sprite
draw = true;
if (facing == RIGHT) image_xscale = -1;
else image_xscale = 1;
if (blinkToggle != 1)
{
if ((state == CLIMBING or (sprite_index == sPExit or sprite_index == sDamselExit or sprite_index == sTunnelExit)) and global.hasJetpack and not whipping)
{
draw_sprite_ext(sprite_index, -1, x, y, image_xscale, image_yscale, image_angle, image_blend, image_alpha);
//draw_sprite(sprite_index,-1,x,y);
draw_sprite(sJetpackBack,-1,x,y);
draw = false;
}
else if (global.hasJetpack and facing == RIGHT) draw_sprite(sJetpackRight,-1,x-4,y-1);
else if (global.hasJetpack) draw_sprite(sJetpackLeft,-1,x+4,y-1);
if (draw)
{
if (redColor > 0) draw_sprite_ext(sprite_index, -1, x, y, image_xscale, image_yscale, image_angle, make_color_rgb(200 + redColor,0,0), image_alpha);
else draw_sprite_ext(sprite_index, -1, x, y, image_xscale, image_yscale, image_angle, image_blend, image_alpha);
}
if (facing == RIGHT)
{
if (holdArrow == ARROW_NORM)
{
draw_sprite(sArrowRight, -1, x+4, y+1);
}
else if (holdArrow == ARROW_BOMB)
{
if (holdArrowToggle) draw_sprite(sBombArrowRight, 0, x+4, y+2);
else draw_sprite(sBombArrowRight, 1, x+4, y+2);
}
}
else if (facing == LEFT)
{
if (holdArrow == ARROW_NORM)
{
draw_sprite(sArrowLeft, -1, x-4, y+1);
}
else if (holdArrow == ARROW_BOMB)
{
if (holdArrowToggle) draw_sprite(sBombArrowLeft, 0, x-4, y+2);
else draw_sprite(sBombArrowLeft, 1, x-4, y+2);
}
}
}
/*
if canRun
{
xOffset=80
if player=1
yOffset=120
else
yOffset=143
//draw the "flySpeed" bar, which shows how much speed the character has acquired while holding the "run" button
//draw_healthbar(view_xview[0]+224+xOffset,view_yview[0]+432+yOffset,view_xview[0]+400+xOffset,view_yview[0]+450+yOffset,flySpeed,make_color_rgb(0,64,128),c_blue,c_aqua,0,1,1)
}
*/

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,251 @@
/*
Originally from /Source/gg2/Scripts/Events/doEventPlayerDeath.gml in Gang Garrison 2
Copyright (C) 2008-2013 Faucet Software
http://www.ganggarrison.com
This program is free software;
you can redistribute it and/or modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 3 of the License, or (at your option)
any later version.
This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with this program; if not,
see <http://www.gnu.org/licenses>.
Additional permission under GNU GPL version 3 section 7
If you modify this Program, or any covered work, by linking or combining it with the Game Maker runtime library,
the 39dll library/extension, Hobbel's Download Manager DLL, or modified versions of these libraries,
the licensors of this Program grant you additional permission to convey the resulting work.
*/
/**
* Perform the "player death" event, i.e. change the appropriate scores,
* destroy the character object to much splattering and so on.
*
* argument0: The player whose character died
* argument1: The player who inflicted the fatal damage (or noone for unknown)
* argument2: The player who assisted the kill (or noone for no assist)
* argument3: The source of the fatal damage
*/
var victim, killer, assistant, damageSource;
victim = argument0;
killer = argument1;
assistant = argument2;
damageSource = argument3;
if(!instance_exists(killer))
killer = noone;
if(!instance_exists(assistant))
assistant = noone;
//*************************************
//* Scoring and Kill log
//*************************************
recordKillInLog(victim, killer, assistant, damageSource);
victim.stats[DEATHS] += 1;
if(killer)
{
if(damageSource == WEAPON_KNIFE || damageSource == WEAPON_BACKSTAB)
{
killer.stats[STABS] += 1;
killer.roundStats[STABS] += 1;
killer.stats[POINTS] += 1;
killer.roundStats[POINTS] +=1;
}
if (victim.object.currentWeapon.object_index == Medigun)
{
if (victim.object.currentWeapon.uberReady)
{
killer.stats[BONUS] += 1;
killer.roundStats[BONUS] += 1;
killer.stats[POINTS] += 1;
killer.roundStats[POINTS] += 1;
}
}
if (killer != victim)
{
killer.stats[KILLS] += 1;
killer.roundStats[KILLS] += 1;
killer.stats[POINTS] += 1;
killer.roundStats[POINTS] += 1;
if(victim.object.intel)
{
killer.stats[DEFENSES] += 1;
killer.roundStats[DEFENSES] += 1;
killer.stats[POINTS] += 1;
killer.roundStats[POINTS] += 1;
recordEventInLog(4, killer.team, killer.name, global.myself == killer);
}
}
}
if (assistant)
{
assistant.stats[ASSISTS] += 1;
assistant.roundStats[ASSISTS] += 1;
assistant.stats[POINTS] += .5;
assistant.roundStats[POINTS] += .5;
}
//SPEC
if (victim == global.myself)
instance_create(victim.object.x, victim.object.y, Spectator);
//*************************************
//* Gibbing
//*************************************
var xoffset, yoffset, xsize, ysize;
xoffset = view_xview[0];
yoffset = view_yview[0];
xsize = view_wview[0];
ysize = view_hview[0];
randomize();
with(victim.object) {
if((damageSource == WEAPON_ROCKETLAUNCHER
or damageSource == WEAPON_MINEGUN or damageSource == FRAG_BOX
or damageSource == WEAPON_REFLECTED_STICKY or damageSource == WEAPON_REFLECTED_ROCKET
or damageSource == FINISHED_OFF_GIB or damageSource == GENERATOR_EXPLOSION)
and (player.class != CLASS_QUOTE) and (global.gibLevel>1)
and distance_to_point(xoffset+xsize/2,yoffset+ysize/2) < 900) {
if (hasReward(victim, 'PumpkinGibs'))
{
repeat(global.gibLevel * 2) {
createGib(x,y,PumpkinGib,hspeed,vspeed,random(145)-72, choose(0,1,1,2,2,3), false, true)
}
}
else
{
repeat(global.gibLevel) {
createGib(x,y,Gib,hspeed,vspeed,random(145)-72, 0, false)
}
switch(player.team)
{
case TEAM_BLUE :
repeat(global.gibLevel - 1) {
createGib(x,y,BlueClump,hspeed,vspeed,random(145)-72, 0, false)
}
break;
case TEAM_RED :
repeat(global.gibLevel - 1) {
createGib(x,y,RedClump,hspeed,vspeed,random(145)-72, 0, false)
}
break;
}
}
repeat(global.gibLevel * 14) {
var blood;
blood = instance_create(x+random(23)-11,y+random(23)-11,BloodDrop);
blood.hspeed=(random(21)-10);
blood.vspeed=(random(21)-13);
if (hasReward(victim, 'PumpkinGibs'))
{
blood.sprite_index = PumpkinJuiceS;
}
}
if (!hasReward(victim, 'PumpkinGibs'))
{
//All Classes gib head, hands, and feet
if(global.gibLevel > 2 || choose(0,1) == 1)
createGib(x,y,Headgib,0,0,random(105)-52, player.class, false);
repeat(global.gibLevel -1){
//Medic has specially colored hands
if (player.class == CLASS_MEDIC){
if (player.team == TEAM_RED)
createGib(x,y,Hand, hspeed, vspeed, random(105)-52 , 9, false);
else
createGib(x,y,Hand, hspeed, vspeed, random(105)-52 , 10, false);
}else{
createGib(x,y,Hand, hspeed, vspeed, random(105)-52 , player.class, false);
}
createGib(x,y,Feet,random(5)-2,random(3),random(13)-6 , player.class, true);
}
}
//Class specific gibs
switch(player.class) {
case CLASS_PYRO :
if(global.gibLevel > 2 || choose(0,1) == 1)
createGib(x,y,Accesory,hspeed,vspeed,random(105)-52, 4, false)
break;
case CLASS_SOLDIER :
if(global.gibLevel > 2 || choose(0,1) == 1){
switch(player.team) {
case TEAM_BLUE :
createGib(x,y,Accesory,hspeed,vspeed,random(105)-52, 2, false);
break;
case TEAM_RED :
createGib(x,y,Accesory,hspeed,vspeed,random(105)-52, 1, false);
break;
}
}
break;
case CLASS_ENGINEER :
if(global.gibLevel > 2 || choose(0,1) == 1)
createGib(x,y,Accesory,hspeed,vspeed,random(105)-52, 3, false)
break;
case CLASS_SNIPER :
if(global.gibLevel > 2 || choose(0,1) == 1)
createGib(x,y,Accesory,hspeed,vspeed,random(105)-52, 0, false)
break;
}
playsound(x,y,Gibbing);
} else {
var deadbody;
if player.class != CLASS_QUOTE playsound(x,y,choose(DeathSnd1, DeathSnd2));
deadbody = instance_create(x,y-30,DeadGuy);
// 'GS' reward - *G*olden *S*tatue
if(hasReward(player, 'GS'))
{
deadbody.sprite_index = haxxyStatue;
deadbody.image_index = 0;
}
else
{
deadbody.sprite_index = sprite_index;
deadbody.image_index = CHARACTER_ANIMATION_DEAD;
}
deadbody.hspeed=hspeed;
deadbody.vspeed=vspeed;
if(hspeed>0) {
deadbody.image_xscale = -1;
}
}
}
if (global.gg_birthday){
myHat = instance_create(victim.object.x,victim.object.y,PartyHat);
myHat.image_index = victim.team;
}
if (global.xmas){
myHat = instance_create(victim.object.x,victim.object.y,XmasHat);
myHat.image_index = victim.team;
}
with(victim.object) {
instance_destroy();
}
//*************************************
//* Deathcam
//*************************************
if( global.killCam and victim == global.myself and killer and killer != victim and !(damageSource == KILL_BOX || damageSource == FRAG_BOX || damageSource == FINISHED_OFF || damageSource == FINISHED_OFF_GIB || damageSource == GENERATOR_EXPLOSION)) {
instance_create(0,0,DeathCam);
DeathCam.killedby=killer;
DeathCam.name=killer.name;
DeathCam.oldxview=view_xview[0];
DeathCam.oldyview=view_yview[0];
DeathCam.lastDamageSource=damageSource;
DeathCam.team = global.myself.team;
}

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,484 @@
/*
Originally from /Source/gg2/Scripts/game_init.gml in Gang Garrison 2
Copyright (C) 2008-2013 Faucet Software
http://www.ganggarrison.com
This program is free software;
you can redistribute it and/or modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 3 of the License, or (at your option)
any later version.
This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with this program; if not,
see <http://www.gnu.org/licenses>.
Additional permission under GNU GPL version 3 section 7
If you modify this Program, or any covered work, by linking or combining it with the Game Maker runtime library,
the 39dll library/extension, Hobbel's Download Manager DLL, or modified versions of these libraries,
the licensors of this Program grant you additional permission to convey the resulting work.
*/
// Returns true if the game is successfully initialized, false if there was an error and we should quit.
{
instance_create(0,0,RoomChangeObserver);
set_little_endian_global(true);
if file_exists("game_errors.log") file_delete("game_errors.log");
if file_exists("last_plugin.log") file_delete("last_plugin.log");
// Delete old left-over files created by the updater
var backupFilename;
backupFilename = file_find_first("gg2-old.delete.me.*", 0);
while(backupFilename != "")
{
file_delete(backupFilename);
backupFilename = file_find_next();
}
file_find_close();
var customMapRotationFile, restart;
restart = false;
//import wav files for music
global.MenuMusic=sound_add(choose("Music/menumusic1.wav","Music/menumusic2.wav","Music/menumusic3.wav","Music/menumusic4.wav","Music/menumusic5.wav","Music/menumusic6.wav"), 1, true);
global.IngameMusic=sound_add("Music/ingamemusic.wav", 1, true);
global.FaucetMusic=sound_add("Music/faucetmusic.wav", 1, true);
if(global.MenuMusic != -1)
sound_volume(global.MenuMusic, 0.8);
if(global.IngameMusic != -1)
sound_volume(global.IngameMusic, 0.8);
if(global.FaucetMusic != -1)
sound_volume(global.FaucetMusic, 0.8);
global.sendBuffer = buffer_create();
global.tempBuffer = buffer_create();
global.HudCheck = false;
global.map_rotation = ds_list_create();
global.CustomMapCollisionSprite = -1;
window_set_region_scale(-1, false);
ini_open("gg2.ini");
global.playerName = ini_read_string("Settings", "PlayerName", "Player");
if string_count("#",global.playerName) > 0 global.playerName = "Player";
global.playerName = string_copy(global.playerName, 0, min(string_length(global.playerName), MAX_PLAYERNAME_LENGTH));
global.fullscreen = ini_read_real("Settings", "Fullscreen", 0);
global.useLobbyServer = ini_read_real("Settings", "UseLobby", 1);
global.hostingPort = ini_read_real("Settings", "HostingPort", 8190);
global.music = ini_read_real("Settings", "Music", ini_read_real("Settings", "IngameMusic", MUSIC_BOTH));
global.playerLimit = ini_read_real("Settings", "PlayerLimit", 10);
//thy playerlimit shalt not exceed 48!
if (global.playerLimit > 48)
{
if (global.dedicatedMode != 1)
show_message("Warning: Player Limit cannot exceed 48. It has been set to 48");
global.playerLimit = 48;
ini_write_real("Settings", "PlayerLimit", 48);
}
global.multiClientLimit = ini_read_real("Settings", "MultiClientLimit", 3);
global.particles = ini_read_real("Settings", "Particles", PARTICLES_NORMAL);
global.gibLevel = ini_read_real("Settings", "Gib Level", 3);
global.killCam = ini_read_real("Settings", "Kill Cam", 1);
global.monitorSync = ini_read_real("Settings", "Monitor Sync", 0);
if global.monitorSync == 1 set_synchronization(true);
else set_synchronization(false);
global.medicRadar = ini_read_real("Settings", "Healer Radar", 1);
global.showHealer = ini_read_real("Settings", "Show Healer", 1);
global.showHealing = ini_read_real("Settings", "Show Healing", 1);
global.showHealthBar = ini_read_real("Settings", "Show Healthbar", 0);
global.showTeammateStats = ini_read_real("Settings", "Show Extra Teammate Stats", 0);
global.serverPluginsPrompt = ini_read_real("Settings", "ServerPluginsPrompt", 1);
global.restartPrompt = ini_read_real("Settings", "RestartPrompt", 1);
//user HUD settings
global.timerPos=ini_read_real("Settings","Timer Position", 0)
global.killLogPos=ini_read_real("Settings","Kill Log Position", 0)
global.kothHudPos=ini_read_real("Settings","KoTH HUD Position", 0)
global.clientPassword = "";
// for admin menu
customMapRotationFile = ini_read_string("Server", "MapRotation", "");
global.shuffleRotation = ini_read_real("Server", "ShuffleRotation", 1);
global.timeLimitMins = max(1, min(255, ini_read_real("Server", "Time Limit", 15)));
global.serverPassword = ini_read_string("Server", "Password", "");
global.mapRotationFile = customMapRotationFile;
global.dedicatedMode = ini_read_real("Server", "Dedicated", 0);
global.serverName = ini_read_string("Server", "ServerName", "My Server");
global.welcomeMessage = ini_read_string("Server", "WelcomeMessage", "");
global.caplimit = max(1, min(255, ini_read_real("Server", "CapLimit", 5)));
global.caplimitBkup = global.caplimit;
global.autobalance = ini_read_real("Server", "AutoBalance",1);
global.Server_RespawntimeSec = ini_read_real("Server", "Respawn Time", 5);
global.rewardKey = unhex(ini_read_string("Haxxy", "RewardKey", ""));
global.rewardId = ini_read_string("Haxxy", "RewardId", "");
global.mapdownloadLimitBps = ini_read_real("Server", "Total bandwidth limit for map downloads in bytes per second", 50000);
global.updaterBetaChannel = ini_read_real("General", "UpdaterBetaChannel", isBetaVersion());
global.attemptPortForward = ini_read_real("Server", "Attempt UPnP Forwarding", 0);
global.serverPluginList = ini_read_string("Server", "ServerPluginList", "");
global.serverPluginsRequired = ini_read_real("Server", "ServerPluginsRequired", 0);
if (string_length(global.serverPluginList) > 254) {
show_message("Error: Server plugin list cannot exceed 254 characters");
return false;
}
var CrosshairFilename, CrosshairRemoveBG;
CrosshairFilename = ini_read_string("Settings", "CrosshairFilename", "");
CrosshairRemoveBG = ini_read_real("Settings", "CrosshairRemoveBG", 1);
global.queueJumping = ini_read_real("Settings", "Queued Jumping", 0);
global.backgroundHash = ini_read_string("Background", "BackgroundHash", "default");
global.backgroundTitle = ini_read_string("Background", "BackgroundTitle", "");
global.backgroundURL = ini_read_string("Background", "BackgroundURL", "");
global.backgroundShowVersion = ini_read_real("Background", "BackgroundShowVersion", true);
readClasslimitsFromIni();
global.currentMapArea=1;
global.totalMapAreas=1;
global.setupTimer=1800;
global.joinedServerName="";
global.serverPluginsInUse=false;
// Create plugin packet maps
global.pluginPacketBuffers = ds_map_create();
global.pluginPacketPlayers = ds_map_create();
ini_write_string("Settings", "PlayerName", global.playerName);
ini_write_real("Settings", "Fullscreen", global.fullscreen);
ini_write_real("Settings", "UseLobby", global.useLobbyServer);
ini_write_real("Settings", "HostingPort", global.hostingPort);
ini_key_delete("Settings", "IngameMusic");
ini_write_real("Settings", "Music", global.music);
ini_write_real("Settings", "PlayerLimit", global.playerLimit);
ini_write_real("Settings", "MultiClientLimit", global.multiClientLimit);
ini_write_real("Settings", "Particles", global.particles);
ini_write_real("Settings", "Gib Level", global.gibLevel);
ini_write_real("Settings", "Kill Cam", global.killCam);
ini_write_real("Settings", "Monitor Sync", global.monitorSync);
ini_write_real("Settings", "Healer Radar", global.medicRadar);
ini_write_real("Settings", "Show Healer", global.showHealer);
ini_write_real("Settings", "Show Healing", global.showHealing);
ini_write_real("Settings", "Show Healthbar", global.showHealthBar);
ini_write_real("Settings", "Show Extra Teammate Stats", global.showTeammateStats);
ini_write_real("Settings", "Timer Position", global.timerPos);
ini_write_real("Settings", "Kill Log Position", global.killLogPos);
ini_write_real("Settings", "KoTH HUD Position", global.kothHudPos);
ini_write_real("Settings", "ServerPluginsPrompt", global.serverPluginsPrompt);
ini_write_real("Settings", "RestartPrompt", global.restartPrompt);
ini_write_string("Server", "MapRotation", customMapRotationFile);
ini_write_real("Server", "ShuffleRotation", global.shuffleRotation);
ini_write_real("Server", "Dedicated", global.dedicatedMode);
ini_write_string("Server", "ServerName", global.serverName);
ini_write_string("Server", "WelcomeMessage", global.welcomeMessage);
ini_write_real("Server", "CapLimit", global.caplimit);
ini_write_real("Server", "AutoBalance", global.autobalance);
ini_write_real("Server", "Respawn Time", global.Server_RespawntimeSec);
ini_write_real("Server", "Total bandwidth limit for map downloads in bytes per second", global.mapdownloadLimitBps);
ini_write_real("Server", "Time Limit", global.timeLimitMins);
ini_write_string("Server", "Password", global.serverPassword);
ini_write_real("General", "UpdaterBetaChannel", global.updaterBetaChannel);
ini_write_real("Server", "Attempt UPnP Forwarding", global.attemptPortForward);
ini_write_string("Server", "ServerPluginList", global.serverPluginList);
ini_write_real("Server", "ServerPluginsRequired", global.serverPluginsRequired);
ini_write_string("Settings", "CrosshairFilename", CrosshairFilename);
ini_write_real("Settings", "CrosshairRemoveBG", CrosshairRemoveBG);
ini_write_real("Settings", "Queued Jumping", global.queueJumping);
ini_write_string("Background", "BackgroundHash", global.backgroundHash);
ini_write_string("Background", "BackgroundTitle", global.backgroundTitle);
ini_write_string("Background", "BackgroundURL", global.backgroundURL);
ini_write_real("Background", "BackgroundShowVersion", global.backgroundShowVersion);
ini_write_real("Classlimits", "Scout", global.classlimits[CLASS_SCOUT])
ini_write_real("Classlimits", "Pyro", global.classlimits[CLASS_PYRO])
ini_write_real("Classlimits", "Soldier", global.classlimits[CLASS_SOLDIER])
ini_write_real("Classlimits", "Heavy", global.classlimits[CLASS_HEAVY])
ini_write_real("Classlimits", "Demoman", global.classlimits[CLASS_DEMOMAN])
ini_write_real("Classlimits", "Medic", global.classlimits[CLASS_MEDIC])
ini_write_real("Classlimits", "Engineer", global.classlimits[CLASS_ENGINEER])
ini_write_real("Classlimits", "Spy", global.classlimits[CLASS_SPY])
ini_write_real("Classlimits", "Sniper", global.classlimits[CLASS_SNIPER])
ini_write_real("Classlimits", "Quote", global.classlimits[CLASS_QUOTE])
//screw the 0 index we will start with 1
//map_truefort
maps[1] = ini_read_real("Maps", "ctf_truefort", 1);
//map_2dfort
maps[2] = ini_read_real("Maps", "ctf_2dfort", 2);
//map_conflict
maps[3] = ini_read_real("Maps", "ctf_conflict", 3);
//map_classicwell
maps[4] = ini_read_real("Maps", "ctf_classicwell", 4);
//map_waterway
maps[5] = ini_read_real("Maps", "ctf_waterway", 5);
//map_orange
maps[6] = ini_read_real("Maps", "ctf_orange", 6);
//map_dirtbowl
maps[7] = ini_read_real("Maps", "cp_dirtbowl", 7);
//map_egypt
maps[8] = ini_read_real("Maps", "cp_egypt", 8);
//arena_montane
maps[9] = ini_read_real("Maps", "arena_montane", 9);
//arena_lumberyard
maps[10] = ini_read_real("Maps", "arena_lumberyard", 10);
//gen_destroy
maps[11] = ini_read_real("Maps", "gen_destroy", 11);
//koth_valley
maps[12] = ini_read_real("Maps", "koth_valley", 12);
//koth_corinth
maps[13] = ini_read_real("Maps", "koth_corinth", 13);
//koth_harvest
maps[14] = ini_read_real("Maps", "koth_harvest", 14);
//dkoth_atalia
maps[15] = ini_read_real("Maps", "dkoth_atalia", 15);
//dkoth_sixties
maps[16] = ini_read_real("Maps", "dkoth_sixties", 16);
//Server respawn time calculator. Converts each second to a frame. (read: multiply by 30 :hehe:)
if (global.Server_RespawntimeSec == 0)
{
global.Server_Respawntime = 1;
}
else
{
global.Server_Respawntime = global.Server_RespawntimeSec * 30;
}
// I have to include this, or the client'll complain about an unknown variable.
global.mapchanging = false;
ini_write_real("Maps", "ctf_truefort", maps[1]);
ini_write_real("Maps", "ctf_2dfort", maps[2]);
ini_write_real("Maps", "ctf_conflict", maps[3]);
ini_write_real("Maps", "ctf_classicwell", maps[4]);
ini_write_real("Maps", "ctf_waterway", maps[5]);
ini_write_real("Maps", "ctf_orange", maps[6]);
ini_write_real("Maps", "cp_dirtbowl", maps[7]);
ini_write_real("Maps", "cp_egypt", maps[8]);
ini_write_real("Maps", "arena_montane", maps[9]);
ini_write_real("Maps", "arena_lumberyard", maps[10]);
ini_write_real("Maps", "gen_destroy", maps[11]);
ini_write_real("Maps", "koth_valley", maps[12]);
ini_write_real("Maps", "koth_corinth", maps[13]);
ini_write_real("Maps", "koth_harvest", maps[14]);
ini_write_real("Maps", "dkoth_atalia", maps[15]);
ini_write_real("Maps", "dkoth_sixties", maps[16]);
ini_close();
// parse the protocol version UUID for later use
global.protocolUuid = buffer_create();
parseUuid(PROTOCOL_UUID, global.protocolUuid);
global.gg2lobbyId = buffer_create();
parseUuid(GG2_LOBBY_UUID, global.gg2lobbyId);
// Create abbreviations array for rewards use
initRewards()
var a, IPRaw, portRaw;
doubleCheck=0;
global.launchMap = "";
for(a = 1; a <= parameter_count(); a += 1)
{
if (parameter_string(a) == "-dedicated")
{
global.dedicatedMode = 1;
}
else if (parameter_string(a) == "-restart")
{
restart = true;
}
else if (parameter_string(a) == "-server")
{
IPRaw = parameter_string(a+1);
if (doubleCheck == 1)
{
doubleCheck = 2;
}
else
{
doubleCheck = 1;
}
}
else if (parameter_string(a) == "-port")
{
portRaw = parameter_string(a+1);
if (doubleCheck == 1)
{
doubleCheck = 2;
}
else
{
doubleCheck = 1;
}
}
else if (parameter_string(a) == "-map")
{
global.launchMap = parameter_string(a+1);
global.dedicatedMode = 1;
}
}
if (doubleCheck == 2)
{
global.serverPort = real(portRaw);
global.serverIP = IPRaw;
global.isHost = false;
instance_create(0,0,Client);
}
global.customMapdesginated = 0;
// if the user defined a valid map rotation file, then load from there
if(customMapRotationFile != "" && file_exists(customMapRotationFile) && global.launchMap == "") {
global.customMapdesginated = 1;
var fileHandle, i, mapname;
fileHandle = file_text_open_read(customMapRotationFile);
for(i = 1; !file_text_eof(fileHandle); i += 1) {
mapname = file_text_read_string(fileHandle);
// remove leading whitespace from the string
while(string_char_at(mapname, 0) == " " || string_char_at(mapname, 0) == chr(9)) { // while it starts with a space or tab
mapname = string_delete(mapname, 0, 1); // delete that space or tab
}
if(mapname != "" && string_char_at(mapname, 0) != "#") { // if it's not blank and it's not a comment (starting with #)
ds_list_add(global.map_rotation, mapname);
}
file_text_readln(fileHandle);
}
file_text_close(fileHandle);
}
else if (global.launchMap != "") && (global.dedicatedMode == 1)
{
ds_list_add(global.map_rotation, global.launchMap);
}
else { // else load from the ini file Maps section
//Set up the map rotation stuff
var i, sort_list;
sort_list = ds_list_create();
for(i=1; i <= 16; i += 1) {
if(maps[i] != 0) ds_list_add(sort_list, ((100*maps[i])+i));
}
ds_list_sort(sort_list, 1);
// translate the numbers back into the names they represent
for(i=0; i < ds_list_size(sort_list); i += 1) {
switch(ds_list_find_value(sort_list, i) mod 100) {
case 1:
ds_list_add(global.map_rotation, "ctf_truefort");
break;
case 2:
ds_list_add(global.map_rotation, "ctf_2dfort");
break;
case 3:
ds_list_add(global.map_rotation, "ctf_conflict");
break;
case 4:
ds_list_add(global.map_rotation, "ctf_classicwell");
break;
case 5:
ds_list_add(global.map_rotation, "ctf_waterway");
break;
case 6:
ds_list_add(global.map_rotation, "ctf_orange");
break;
case 7:
ds_list_add(global.map_rotation, "cp_dirtbowl");
break;
case 8:
ds_list_add(global.map_rotation, "cp_egypt");
break;
case 9:
ds_list_add(global.map_rotation, "arena_montane");
break;
case 10:
ds_list_add(global.map_rotation, "arena_lumberyard");
break;
case 11:
ds_list_add(global.map_rotation, "gen_destroy");
break;
case 12:
ds_list_add(global.map_rotation, "koth_valley");
break;
case 13:
ds_list_add(global.map_rotation, "koth_corinth");
break;
case 14:
ds_list_add(global.map_rotation, "koth_harvest");
break;
case 15:
ds_list_add(global.map_rotation, "dkoth_atalia");
break;
case 16:
ds_list_add(global.map_rotation, "dkoth_sixties");
break;
}
}
ds_list_destroy(sort_list);
}
window_set_fullscreen(global.fullscreen);
global.gg2Font = font_add_sprite(gg2FontS,ord("!"),false,0);
global.countFont = font_add_sprite(countFontS, ord("0"),false,2);
draw_set_font(global.gg2Font);
cursor_sprite = CrosshairS;
if(!directory_exists(working_directory + "\Maps")) directory_create(working_directory + "\Maps");
instance_create(0, 0, AudioControl);
instance_create(0, 0, SSControl);
// custom dialog box graphics
message_background(popupBackgroundB);
message_button(popupButtonS);
message_text_font("Century",9,c_white,1);
message_button_font("Century",9,c_white,1);
message_input_font("Century",9,c_white,0);
//Key Mapping
ini_open("controls.gg2");
global.jump = ini_read_real("Controls", "jump", ord("W"));
global.down = ini_read_real("Controls", "down", ord("S"));
global.left = ini_read_real("Controls", "left", ord("A"));
global.right = ini_read_real("Controls", "right", ord("D"));
global.attack = ini_read_real("Controls", "attack", MOUSE_LEFT);
global.special = ini_read_real("Controls", "special", MOUSE_RIGHT);
global.taunt = ini_read_real("Controls", "taunt", ord("F"));
global.chat1 = ini_read_real("Controls", "chat1", ord("Z"));
global.chat2 = ini_read_real("Controls", "chat2", ord("X"));
global.chat3 = ini_read_real("Controls", "chat3", ord("C"));
global.medic = ini_read_real("Controls", "medic", ord("E"));
global.drop = ini_read_real("Controls", "drop", ord("B"));
global.changeTeam = ini_read_real("Controls", "changeTeam", ord("N"));
global.changeClass = ini_read_real("Controls", "changeClass", ord("M"));
global.showScores = ini_read_real("Controls", "showScores", vk_shift);
ini_close();
calculateMonthAndDay();
if(!directory_exists(working_directory + "\Plugins")) directory_create(working_directory + "\Plugins");
loadplugins();
/* Windows 8 is known to crash GM when more than three (?) sounds play at once
* We'll store the kernel version (Win8 is 6.2, Win7 is 6.1) and check it there.
***/
registry_set_root(1); // HKLM
global.NTKernelVersion = real(registry_read_string_ext("\SOFTWARE\Microsoft\Windows NT\CurrentVersion\", "CurrentVersion")); // SIC
if (file_exists(CrosshairFilename))
{
sprite_replace(CrosshairS,CrosshairFilename,1,CrosshairRemoveBG,false,0,0);
sprite_set_offset(CrosshairS,sprite_get_width(CrosshairS)/2,sprite_get_height(CrosshairS)/2);
}
if(global.dedicatedMode == 1) {
AudioControlToggleMute();
room_goto_fix(Menu);
} else if(restart) {
room_goto_fix(Menu);
}
return true;
}

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,252 @@
/*
Originally from /Source/gg2/Scripts/Plugins/loadserverplugins.gml in Gang Garrison 2
Copyright (C) 2008-2013 Faucet Software
http://www.ganggarrison.com
This program is free software;
you can redistribute it and/or modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 3 of the License, or (at your option)
any later version.
This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with this program; if not,
see <http://www.gnu.org/licenses>.
Additional permission under GNU GPL version 3 section 7
If you modify this Program, or any covered work, by linking or combining it with the Game Maker runtime library,
the 39dll library/extension, Hobbel's Download Manager DLL, or modified versions of these libraries,
the licensors of this Program grant you additional permission to convey the resulting work.
*/
// loads plugins from ganggarrison.com asked for by server
// argument0 - comma separated plugin list (pluginname@md5hash)
// returns true on success, false on failure
var list, hashList, text, i, pluginname, pluginhash, realhash, url, handle, filesize, progress, tempfile, tempdir, failed, lastContact, isCached;
failed = false;
list = ds_list_create();
lastContact = 0;
isCached = false;
isDebug = false;
hashList = ds_list_create();
// split plugin list string
list = split(argument0, ',');
// Split hashes from plugin names
for (i = 0; i < ds_list_size(list); i += 1)
{
text = ds_list_find_value(list, i);
pluginname = string_copy(text, 0, string_pos("@", text) - 1);
pluginhash = string_copy(text, string_pos("@", text) + 1, string_length(text) - string_pos("@", text));
ds_list_replace(list, i, pluginname);
ds_list_add(hashList, pluginhash);
}
// Check plugin names and check for duplicates
for (i = 0; i < ds_list_size(list); i += 1)
{
pluginname = ds_list_find_value(list, i);
// invalid plugin name
if (!checkpluginname(pluginname))
{
show_message('Error loading server-sent plugins - invalid plugin name:#"' + pluginname + '"');
return false;
}
// is duplicate
else if (ds_list_find_index(list, pluginname) != i)
{
show_message('Error loading server-sent plugins - duplicate plugin:#"' + pluginname + '"');
return false;
}
}
// Download plugins
for (i = 0; i < ds_list_size(list); i += 1)
{
pluginname = ds_list_find_value(list, i);
pluginhash = ds_list_find_value(hashList, i);
isDebug = file_exists(working_directory + "\ServerPluginsDebug\" + pluginname + ".zip");
isCached = file_exists(working_directory + "\ServerPluginsCache\" + pluginname + "@" + pluginhash);
tempfile = temp_directory + "\" + pluginname + ".zip.tmp";
tempdir = temp_directory + "\" + pluginname + ".tmp";
// check to see if we have a local copy for debugging
if (isDebug)
{
file_copy(working_directory + "\ServerPluginsDebug\" + pluginname + ".zip", tempfile);
// show warning
if (global.isHost)
{
show_message(
"Warning: server-sent plugin '"
+ pluginname
+ "' is being loaded from ServerPluginsDebug. Make sure clients have the same version, else they may be unable to connect."
);
}
else
{
show_message(
"Warning: server-sent plugin '"
+ pluginname
+ "' is being loaded from ServerPluginsDebug. Make sure the server has the same version, else you may be unable to connect."
);
}
}
// otherwise, check if we have it cached
else if (isCached)
{
file_copy(working_directory + "\ServerPluginsCache\" + pluginname + "@" + pluginhash, tempfile);
}
// otherwise, download as usual
else
{
// construct the URL
// http://www.ganggarrison.com/plugins/$PLUGINNAME$@$PLUGINHASH$.zip)
url = PLUGIN_SOURCE + pluginname + "@" + pluginhash + ".zip";
// let's make the download handle
handle = httpGet(url, -1);
// download it
while (!httpRequestStatus(handle)) {
// prevent game locking up
io_handle();
httpRequestStep(handle);
if (!global.isHost) {
// send ping if we haven't contacted server in 20 seconds
// we need to do this to keep the connection open
if (current_time-lastContact > 20000) {
write_byte(global.serverSocket, PING);
socket_send(global.serverSocket);
lastContact = current_time;
}
}
// draw progress bar since they may be waiting a while
filesize = httpRequestResponseBodySize(handle);
progress = httpRequestResponseBodyProgress(handle);
draw_background_ext(background_index[0], 0, 0, background_xscale[0], background_yscale[0], 0, c_white, 1);
draw_set_color(c_white);
draw_set_alpha(1);
draw_set_halign(fa_left);
draw_rectangle(50, 550, 300, 560, 2);
draw_text(50, 530, "Downloading server-sent plugin " + string(i + 1) + "/" + string(ds_list_size(list)) + ' - "' + pluginname + '"');
if (filesize != -1)
draw_rectangle(50, 550, 50 + progress / filesize * 250, 560, 0);
screen_refresh();
}
// errored
if (httpRequestStatus(handle) == 2)
{
show_message('Error loading server-sent plugins - download failed for "' + pluginname + '":#' + httpRequestError(handle));
failed = true;
break;
}
// request failed
if (httpRequestStatusCode(handle) != 200)
{
show_message('Error loading server-sent plugins - download failed for "' + pluginname + '":#' + string(httpRequestStatusCode(handle)) + ' ' + httpRequestReasonPhrase(handle));
failed = true;
break;
}
else
{
write_buffer_to_file(httpRequestResponseBody(handle), tempfile);
if (!file_exists(tempfile))
{
show_message('Error loading server-sent plugins - download failed for "' + pluginname + '":# No such file?');
failed = true;
break;
}
}
httpRequestDestroy(handle);
}
// check file integrity
realhash = GG2DLL_compute_MD5(tempfile);
if (realhash != pluginhash)
{
show_message('Error loading server-sent plugins - integrity check failed (MD5 hash mismatch) for:#"' + pluginname + '"');
failed = true;
break;
}
// don't try to cache debug plugins
if (!isDebug)
{
// add to cache if we don't already have it
if (!file_exists(working_directory + "\ServerPluginsCache\" + pluginname + "@" + pluginhash))
{
// make sure directory exists
if (!directory_exists(working_directory + "\ServerPluginsCache"))
{
directory_create(working_directory + "\ServerPluginsCache");
}
// store in cache
file_copy(tempfile, working_directory + "\ServerPluginsCache\" + pluginname + "@" + pluginhash);
}
}
// let's get 7-zip to extract the files
extractzip(tempfile, tempdir);
// if the directory doesn't exist, extracting presumably failed
if (!directory_exists(tempdir))
{
show_message('Error loading server-sent plugins - extracting zip failed for:#"' + pluginname + '"');
failed = true;
break;
}
}
if (!failed)
{
// Execute plugins
for (i = 0; i < ds_list_size(list); i += 1)
{
pluginname = ds_list_find_value(list, i);
tempdir = temp_directory + "\" + pluginname + ".tmp";
// Debugging facility, so we know *which* plugin caused compile/execute error
fp = file_text_open_write(working_directory + "\last_plugin.log");
file_text_write_string(fp, pluginname);
file_text_close(fp);
// packetID is (i), so make queues for it
ds_map_add(global.pluginPacketBuffers, i, ds_queue_create());
ds_map_add(global.pluginPacketPlayers, i, ds_queue_create());
// Execute plugin
execute_file(
// the plugin's main gml file must be in the root of the zip
// it is called plugin.gml
tempdir + "\plugin.gml",
// the plugin needs to know where it is
// so the temporary directory is passed as first argument
tempdir,
// the plugin needs to know its packetID
// so it is passed as the second argument
i
);
}
}
// Delete last plugin log
file_delete(working_directory + "\last_plugin.log");
// Get rid of plugin list
ds_list_destroy(list);
// Get rid of plugin hash list
ds_list_destroy(hashList);
return !failed;

View File

@@ -0,0 +1,384 @@
/*
Originally from /Source/gg2/Scripts/GameServer/processClientCommands.gml in Gang Garrison 2
Copyright (C) 2008-2013 Faucet Software
http://www.ganggarrison.com
This program is free software;
you can redistribute it and/or modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 3 of the License, or (at your option)
any later version.
This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with this program; if not,
see <http://www.gnu.org/licenses>.
Additional permission under GNU GPL version 3 section 7
If you modify this Program, or any covered work, by linking or combining it with the Game Maker runtime library,
the 39dll library/extension, Hobbel's Download Manager DLL, or modified versions of these libraries,
the licensors of this Program grant you additional permission to convey the resulting work.
*/
var player, playerId, commandLimitRemaining;
player = argument0;
playerId = argument1;
// To prevent players from flooding the server, limit the number of commands to process per step and player.
commandLimitRemaining = 10;
with(player) {
if(!variable_local_exists("commandReceiveState")) {
// 0: waiting for command byte.
// 1: waiting for command data length (1 byte)
// 2: waiting for command data.
commandReceiveState = 0;
commandReceiveExpectedBytes = 1;
commandReceiveCommand = 0;
}
}
while(commandLimitRemaining > 0) {
var socket;
socket = player.socket;
if(!tcp_receive(socket, player.commandReceiveExpectedBytes)) {
return 0;
}
switch(player.commandReceiveState)
{
case 0:
player.commandReceiveCommand = read_ubyte(socket);
switch(commandBytes[player.commandReceiveCommand]) {
case commandBytesInvalidCommand:
// Invalid byte received. Wait for another command byte.
break;
case commandBytesPrefixLength1:
player.commandReceiveState = 1;
player.commandReceiveExpectedBytes = 1;
break;
case commandBytesPrefixLength2:
player.commandReceiveState = 3;
player.commandReceiveExpectedBytes = 2;
break;
default:
player.commandReceiveState = 2;
player.commandReceiveExpectedBytes = commandBytes[player.commandReceiveCommand];
break;
}
break;
case 1:
player.commandReceiveState = 2;
player.commandReceiveExpectedBytes = read_ubyte(socket);
break;
case 3:
player.commandReceiveState = 2;
player.commandReceiveExpectedBytes = read_ushort(socket);
break;
case 2:
player.commandReceiveState = 0;
player.commandReceiveExpectedBytes = 1;
commandLimitRemaining -= 1;
switch(player.commandReceiveCommand)
{
case PLAYER_LEAVE:
socket_destroy(player.socket);
player.socket = -1;
break;
case PLAYER_CHANGECLASS:
var class;
class = read_ubyte(socket);
if(getCharacterObject(player.team, class) != -1)
{
if(player.object != -1)
{
with(player.object)
{
if (collision_point(x,y,SpawnRoom,0,0) < 0)
{
if (!instance_exists(lastDamageDealer) || lastDamageDealer == player)
{
sendEventPlayerDeath(player, player, noone, BID_FAREWELL);
doEventPlayerDeath(player, player, noone, BID_FAREWELL);
}
else
{
var assistant;
assistant = secondToLastDamageDealer;
if (lastDamageDealer.object)
if (lastDamageDealer.object.healer)
assistant = lastDamageDealer.object.healer;
sendEventPlayerDeath(player, lastDamageDealer, assistant, FINISHED_OFF);
doEventPlayerDeath(player, lastDamageDealer, assistant, FINISHED_OFF);
}
}
else
instance_destroy();
}
}
else if(player.alarm[5]<=0)
player.alarm[5] = 1;
class = checkClasslimits(player, player.team, class);
player.class = class;
ServerPlayerChangeclass(playerId, player.class, global.sendBuffer);
}
break;
case PLAYER_CHANGETEAM:
var newTeam, balance, redSuperiority;
newTeam = read_ubyte(socket);
redSuperiority = 0 //calculate which team is bigger
with(Player)
{
if(team == TEAM_RED)
redSuperiority += 1;
else if(team == TEAM_BLUE)
redSuperiority -= 1;
}
if(redSuperiority > 0)
balance = TEAM_RED;
else if(redSuperiority < 0)
balance = TEAM_BLUE;
else
balance = -1;
if(balance != newTeam)
{
if(getCharacterObject(newTeam, player.class) != -1 or newTeam==TEAM_SPECTATOR)
{
if(player.object != -1)
{
with(player.object)
{
if (!instance_exists(lastDamageDealer) || lastDamageDealer == player)
{
sendEventPlayerDeath(player, player, noone, BID_FAREWELL);
doEventPlayerDeath(player, player, noone, BID_FAREWELL);
}
else
{
var assistant;
assistant = secondToLastDamageDealer;
if (lastDamageDealer.object)
if (lastDamageDealer.object.healer)
assistant = lastDamageDealer.object.healer;
sendEventPlayerDeath(player, lastDamageDealer, assistant, FINISHED_OFF);
doEventPlayerDeath(player, lastDamageDealer, assistant, FINISHED_OFF);
}
}
player.alarm[5] = global.Server_Respawntime;
}
else if(player.alarm[5]<=0)
player.alarm[5] = 1;
var newClass;
newClass = checkClasslimits(player, newTeam, player.class);
if newClass != player.class
{
player.class = newClass;
ServerPlayerChangeclass(playerId, player.class, global.sendBuffer);
}
player.team = newTeam;
ServerPlayerChangeteam(playerId, player.team, global.sendBuffer);
ServerBalanceTeams();
}
}
break;
case CHAT_BUBBLE:
var bubbleImage;
bubbleImage = read_ubyte(socket);
if(global.aFirst) {
bubbleImage = 0;
}
write_ubyte(global.sendBuffer, CHAT_BUBBLE);
write_ubyte(global.sendBuffer, playerId);
write_ubyte(global.sendBuffer, bubbleImage);
setChatBubble(player, bubbleImage);
break;
case BUILD_SENTRY:
if(player.object != -1)
{
if(player.class == CLASS_ENGINEER
and collision_circle(player.object.x, player.object.y, 50, Sentry, false, true) < 0
and player.object.nutsNBolts == 100
and (collision_point(player.object.x,player.object.y,SpawnRoom,0,0) < 0)
and !player.sentry
and !player.object.onCabinet)
{
write_ubyte(global.sendBuffer, BUILD_SENTRY);
write_ubyte(global.sendBuffer, playerId);
write_ushort(global.serializeBuffer, round(player.object.x*5));
write_ushort(global.serializeBuffer, round(player.object.y*5));
write_byte(global.serializeBuffer, player.object.image_xscale);
buildSentry(player, player.object.x, player.object.y, player.object.image_xscale);
}
}
break;
case DESTROY_SENTRY:
with(player.sentry)
instance_destroy();
break;
case DROP_INTEL:
if (player.object != -1)
{
if (player.object.intel)
{
sendEventDropIntel(player);
doEventDropIntel(player);
}
}
break;
case OMNOMNOMNOM:
if(player.object != -1) {
if(!player.humiliated
and !player.object.taunting
and !player.object.omnomnomnom
and player.object.canEat
and player.class==CLASS_HEAVY)
{
write_ubyte(global.sendBuffer, OMNOMNOMNOM);
write_ubyte(global.sendBuffer, playerId);
with(player.object)
{
omnomnomnom = true;
if player.team == TEAM_RED {
omnomnomnomindex=0;
omnomnomnomend=31;
} else if player.team==TEAM_BLUE {
omnomnomnomindex=32;
omnomnomnomend=63;
}
xscale=image_xscale;
}
}
}
break;
case TOGGLE_ZOOM:
if player.object != -1 {
if player.class == CLASS_SNIPER {
write_ubyte(global.sendBuffer, TOGGLE_ZOOM);
write_ubyte(global.sendBuffer, playerId);
toggleZoom(player.object);
}
}
break;
case PLAYER_CHANGENAME:
var nameLength;
nameLength = socket_receivebuffer_size(socket);
if(nameLength > MAX_PLAYERNAME_LENGTH)
{
write_ubyte(player.socket, KICK);
write_ubyte(player.socket, KICK_NAME);
socket_destroy(player.socket);
player.socket = -1;
}
else
{
with(player)
{
if(variable_local_exists("lastNamechange"))
if(current_time - lastNamechange < 1000)
break;
lastNamechange = current_time;
name = read_string(socket, nameLength);
if(string_count("#",name) > 0)
{
name = "I <3 Bacon";
}
write_ubyte(global.sendBuffer, PLAYER_CHANGENAME);
write_ubyte(global.sendBuffer, playerId);
write_ubyte(global.sendBuffer, string_length(name));
write_string(global.sendBuffer, name);
}
}
break;
case INPUTSTATE:
if(player.object != -1)
{
with(player.object)
{
keyState = read_ubyte(socket);
netAimDirection = read_ushort(socket);
aimDirection = netAimDirection*360/65536;
event_user(1);
}
}
break;
case REWARD_REQUEST:
player.rewardId = read_string(socket, socket_receivebuffer_size(socket));
player.challenge = rewardCreateChallenge();
write_ubyte(socket, REWARD_CHALLENGE_CODE);
write_binstring(socket, player.challenge);
break;
case REWARD_CHALLENGE_RESPONSE:
var answer, i, authbuffer;
answer = read_binstring(socket, 16);
with(player)
if(variable_local_exists("challenge") and variable_local_exists("rewardId"))
rewardAuthStart(player, answer, challenge, true, rewardId);
break;
case PLUGIN_PACKET:
var packetID, buf, success;
packetID = read_ubyte(socket);
// get packet data
buf = buffer_create();
write_buffer_part(buf, socket, socket_receivebuffer_size(socket));
// try to enqueue
success = _PluginPacketPush(packetID, buf, player);
// if it returned false, packetID was invalid
if (!success)
{
// clear up buffer
buffer_destroy(buf);
// kick player
write_ubyte(player.socket, KICK);
write_ubyte(player.socket, KICK_BAD_PLUGIN_PACKET);
socket_destroy(player.socket);
player.socket = -1;
}
break;
case CLIENT_SETTINGS:
var mirror;
mirror = read_ubyte(player.socket);
player.queueJump = mirror;
write_ubyte(global.sendBuffer, CLIENT_SETTINGS);
write_ubyte(global.sendBuffer, playerId);
write_ubyte(global.sendBuffer, mirror);
break;
}
break;
}
}

View File

@@ -0,0 +1,298 @@
// Originally from /spelunky/Scripts/Level Generation/scrInitLevel.gml in the Spelunky Community Update Project
//
// scrInitLevel()
//
// Calls scrLevelGen(), scrRoomGen*(), and scrEntityGen() to build level.
//
/**********************************************************************************
Copyright (c) 2008, 2009 Derek Yu and Mossmouth, LLC
This file is part of Spelunky.
You can redistribute and/or modify Spelunky, including its source code, under
the terms of the Spelunky User License.
Spelunky is distributed in the hope that it will be entertaining and useful,
but WITHOUT WARRANTY. Please see the Spelunky User License for more details.
The Spelunky User License should be available in "Game Information", which
can be found in the Resource Explorer, or as an external file called COPYING.
If not, please obtain a new copy of Spelunky from <http://spelunkyworld.com/>
***********************************************************************************/
global.levelType = 0;
//global.currLevel = 16;
if (global.currLevel > 4 and global.currLevel < 9) global.levelType = 1;
if (global.currLevel > 8 and global.currLevel < 13) global.levelType = 2;
if (global.currLevel > 12 and global.currLevel < 16) global.levelType = 3;
if (global.currLevel == 16) global.levelType = 4;
if (global.currLevel <= 1 or
global.currLevel == 5 or
global.currLevel == 9 or
global.currLevel == 13)
{
global.hadDarkLevel = false;
}
// global.levelType = 3; // debug
// DEBUG MODE //
/*
if (global.currLevel == 2) global.levelType = 4;
if (global.currLevel == 3) global.levelType = 2;
if (global.currLevel == 4) global.levelType = 3;
if (global.currLevel == 5) global.levelType = 4;
*/
// global.levelType = 0;
global.startRoomX = 0;
global.startRoomY = 0;
global.endRoomX = 0;
global.endRoomY = 0;
oGame.levelGen = false;
// this is used to determine the path to the exit (generally no bombs required)
for (i = 0; i < 4; i += 1)
{
for (j = 0; j < 4; j += 1)
{
global.roomPath[i,j] = 0;
}
}
// side walls
if (global.levelType == 4)
k = 54;
else if (global.levelType == 2)
k = 38;
else if (global.lake)
k = 41;
else
k = 33;
for (i = 0; i <= 42; i += 1)
{
for (j = 0; j <= k; j += 1)
{
if (not isLevel())
{
i = 999;
j = 999;
}
else if (global.levelType == 2)
{
if (i*16 == 0 or
i*16 == 656 or
j*16 == 0)
{
obj = instance_create(i*16, j*16, oDark);
obj.invincible = true;
obj.sprite_index = sDark;
}
}
else if (global.levelType == 4)
{
if (i*16 == 0 or
i*16 == 656 or
j*16 == 0)
{
obj = instance_create(i*16, j*16, oTemple);
obj.invincible = true;
if (not global.cityOfGold) obj.sprite_index = sTemple;
}
}
else if (global.lake)
{
if (i*16 == 0 or
i*16 == 656 or
j*16 == 0 or
j*16 >= 656)
{
obj = instance_create(i*16, j*16, oLush); obj.sprite_index = sLush;
obj.invincible = true;
}
}
else if (i*16 == 0 or
i*16 == 656 or
j*16 == 0 or
j*16 >= 528)
{
if (global.levelType == 0) { obj = instance_create(i*16, j*16, oBrick); obj.sprite_index = sBrick; }
else if (global.levelType == 1) { obj = instance_create(i*16, j*16, oLush); obj.sprite_index = sLush; }
else { obj = instance_create(i*16, j*16, oTemple); if (not global.cityOfGold) obj.sprite_index = sTemple; }
obj.invincible = true;
}
}
}
if (global.levelType == 2)
{
for (i = 0; i <= 42; i += 1)
{
instance_create(i*16, 40*16, oDark);
//instance_create(i*16, 35*16, oSpikes);
}
}
if (global.levelType == 3)
{
background_index = bgTemple;
}
global.temp1 = global.gameStart;
scrLevelGen();
global.cemetary = false;
if (global.levelType == 1 and rand(1,global.probCemetary) == 1) global.cemetary = true;
with oRoom
{
if (global.levelType == 0) scrRoomGen();
else if (global.levelType == 1)
{
if (global.blackMarket) scrRoomGenMarket();
else scrRoomGen2();
}
else if (global.levelType == 2)
{
if (global.yetiLair) scrRoomGenYeti();
else scrRoomGen3();
}
else if (global.levelType == 3) scrRoomGen4();
else scrRoomGen5();
}
global.darkLevel = false;
//if (not global.hadDarkLevel and global.currLevel != 0 and global.levelType != 2 and global.currLevel != 16 and rand(1,1) == 1)
if (not global.hadDarkLevel and not global.noDarkLevel and global.currLevel != 0 and global.currLevel != 1 and global.levelType != 2 and global.currLevel != 16 and rand(1,global.probDarkLevel) == 1)
{
global.darkLevel = true;
global.hadDarkLevel = true;
//instance_create(oPlayer1.x, oPlayer1.y, oFlare);
}
if (global.blackMarket) global.darkLevel = false;
global.genUdjatEye = false;
if (not global.madeUdjatEye)
{
if (global.currLevel == 2 and rand(1,3) == 1) global.genUdjatEye = true;
else if (global.currLevel == 3 and rand(1,2) == 1) global.genUdjatEye = true;
else if (global.currLevel == 4) global.genUdjatEye = true;
}
global.genMarketEntrance = false;
if (not global.madeMarketEntrance)
{
if (global.currLevel == 5 and rand(1,3) == 1) global.genMarketEntrance = true;
else if (global.currLevel == 6 and rand(1,2) == 1) global.genMarketEntrance = true;
else if (global.currLevel == 7) global.genMarketEntrance = true;
}
////////////////////////////
// ENTITY / TREASURES
////////////////////////////
global.temp2 = global.gameStart;
if (not isRoom("rTutorial") and not isRoom("rLoadLevel")) scrEntityGen();
if (instance_exists(oEntrance) and not global.customLevel)
{
oPlayer1.x = oEntrance.x+8;
oPlayer1.y = oEntrance.y+8;
}
if (global.darkLevel or
global.blackMarket or
global.snakePit or
global.cemetary or
global.lake or
global.yetiLair or
global.alienCraft or
global.sacrificePit or
global.cityOfGold)
{
if (not isRoom("rLoadLevel"))
{
with oPlayer1 { alarm[0] = 10; }
}
}
if (global.levelType == 4) scrSetupWalls(864);
else if (global.lake) scrSetupWalls(656);
else scrSetupWalls(528);
// add background details
if (global.graphicsHigh)
{
repeat(20)
{
// bg = instance_create(16*rand(1,42), 16*rand(1,33), oCaveBG);
if (global.levelType == 1 and rand(1,3) < 3)
tile_add(bgExtrasLush, 32*rand(0,1), 0, 32, 32, 16*rand(1,42), 16*rand(1,33), 10002);
else if (global.levelType == 2 and rand(1,3) < 3)
tile_add(bgExtrasIce, 32*rand(0,1), 0, 32, 32, 16*rand(1,42), 16*rand(1,33), 10002);
else if (global.levelType == 3 and rand(1,3) < 3)
tile_add(bgExtrasTemple, 32*rand(0,1), 0, 32, 32, 16*rand(1,42), 16*rand(1,33), 10002);
else
tile_add(bgExtras, 32*rand(0,1), 0, 32, 32, 16*rand(1,42), 16*rand(1,33), 10002);
}
}
oGame.levelGen = true;
// generate angry shopkeeper at exit if murderer or thief
if ((global.murderer or global.thiefLevel > 0) and isRealLevel())
{
with oExit
{
if (type == "Exit")
{
obj = instance_create(x, y, oShopkeeper);
obj.status = 4;
}
}
// global.thiefLevel -= 1;
}
with oTreasure
{
if (collision_point(x, y, oSolid, 0, 0))
{
obj = instance_place(x, y, oSolid);
if (obj.invincible) instance_destroy();
}
}
with oWater
{
if (sprite_index == sWaterTop or sprite_index == sLavaTop)
{
scrCheckWaterTop();
}
/*
obj = instance_place(x-16, y, oWater);
if (instance_exists(obj))
{
if (obj.sprite_index == sWaterTop or obj.sprite_index == sLavaTop)
{
if (type == "Lava") sprite_index = sLavaTop;
else sprite_index = sWaterTop;
}
}
obj = instance_place(x+16, y, oWater);
if (instance_exists(obj))
{
if (obj.sprite_index == sWaterTop or obj.sprite_index == sLavaTop)
{
if (type == "Lava") sprite_index = sLavaTop;
else sprite_index = sWaterTop;
}
}
*/
}
global.temp3 = global.gameStart;

View File

@@ -0,0 +1,22 @@
# set terminal pngcairo background "#ffffff" fontscale 1.0 dashed size 640, 480
# set output 'dashcolor.1.png'
set label 1 "set style line 1 lt 2 lc rgb \"red\" lw 3" at -0.4, -0.25, 0 left norotate back textcolor rgb "red" nopoint offset character 0, 0, 0
set label 2 "set style line 2 lt 2 lc rgb \"orange\" lw 2" at -0.4, -0.35, 0 left norotate back textcolor rgb "orange" nopoint offset character 0, 0, 0
set label 3 "set style line 3 lt 2 lc rgb \"yellow\" lw 3" at -0.4, -0.45, 0 left norotate back textcolor rgb "yellow" nopoint offset character 0, 0, 0
set label 4 "set style line 4 lt 2 lc rgb \"green\" lw 2" at -0.4, -0.55, 0 left norotate back textcolor rgb "green" nopoint offset character 0, 0, 0
set label 5 "plot ... lt 1 lc 3 " at -0.4, -0.65, 0 left norotate back textcolor lt 3 nopoint offset character 0, 0, 0
set label 6 "plot ... lt 3 lc 3 " at -0.4, -0.75, 0 left norotate back textcolor lt 3 nopoint offset character 0, 0, 0
set label 7 "plot ... lt 5 lc 3 " at -0.4, -0.85, 0 left norotate back textcolor lt 3 nopoint offset character 0, 0, 0
set style line 1 linetype 2 linecolor rgb "red" linewidth 3.000 pointtype 2 pointsize default pointinterval 0
set style line 2 linetype 2 linecolor rgb "orange" linewidth 2.000 pointtype 2 pointsize default pointinterval 0
set style line 3 linetype 2 linecolor rgb "yellow" linewidth 3.000 pointtype 2 pointsize default pointinterval 0
set style line 4 linetype 2 linecolor rgb "green" linewidth 2.000 pointtype 2 pointsize default pointinterval 0
set noxtics
set noytics
set title "Independent colors and dot/dash styles"
set xlabel "You will only see dashed lines if your current terminal setting permits it"
set xrange [ -0.500000 : 3.50000 ] noreverse nowriteback
set yrange [ -1.00000 : 1.40000 ] noreverse nowriteback
set bmargin 7
unset colorbox
plot cos(x) ls 1 title 'ls 1', cos(x-.2) ls 2 title 'ls 2', cos(x-.4) ls 3 title 'ls 3', cos(x-.6) ls 4 title 'ls 4', cos(x-.8) lt 1 lc 3 title 'lt 1 lc 3', cos(x-1.) lt 3 lc 3 title 'lt 3 lc 3', cos(x-1.2) lt 5 lc 3 title 'lt 5 lc 3'

View File

@@ -0,0 +1,15 @@
# set terminal pngcairo transparent enhanced font "arial,10" fontscale 1.0 size 500, 350
# set output 'histograms.2.png'
set boxwidth 0.9 absolute
set style fill solid 1.00 border lt -1
set key inside right top vertical Right noreverse noenhanced autotitles nobox
set style histogram clustered gap 1 title offset character 0, 0, 0
set datafile missing '-'
set style data histograms
set xtics border in scale 0,0 nomirror rotate by -45 offset character 0, 0, 0 autojustify
set xtics norangelimit font ",8"
set xtics ()
set title "US immigration from Northern Europe\nPlot selected data columns as histogram of clustered boxes"
set yrange [ 0.00000 : 300000. ] noreverse nowriteback
i = 22
plot 'immigration.dat' using 6:xtic(1) ti col, '' u 12 ti col, '' u 13 ti col, '' u 14 ti col

14
samples/Gnuplot/rates.gp Normal file
View File

@@ -0,0 +1,14 @@
#!/usr/bin/env gnuplot
reset
set terminal png
set output 'rates100.png'
set xlabel "A2A price"
set ylabel "Response Rate"
#set xr [0:5]
#set yr [0:6]
plot 'rates100.dat' pt 7 notitle

View File

@@ -0,0 +1,40 @@
# set terminal pngcairo transparent enhanced font "arial,10" fontscale 1.0 size 500, 350
# set output 'surface1.16.png'
set dummy u,v
set label 1 "increasing v" at 6, 0, -1 left norotate back nopoint offset character 0, 0, 0
set label 2 "u=0" at 5, 6.5, -1 left norotate back nopoint offset character 0, 0, 0
set label 3 "u=1" at 5, 6.5, 0.100248 left norotate back nopoint offset character 0, 0, 0
set arrow 1 from 5, -5, -1.2 to 5, 5, -1.2 head back nofilled linetype -1 linewidth 1.000
set arrow 2 from 5, 6, -1 to 5, 5, -1 head back nofilled linetype -1 linewidth 1.000
set arrow 3 from 5, 6, 0.100248 to 5, 5, 0.100248 head back nofilled linetype -1 linewidth 1.000
set parametric
set view 70, 20, 1, 1
set samples 51, 51
set isosamples 2, 33
set hidden3d back offset 1 trianglepattern 3 undefined 1 altdiagonal bentover
set ztics -1.00000,0.25,1.00000 norangelimit
set title "\"fence plot\" using separate parametric surfaces"
set xlabel "X axis"
set xlabel offset character -3, -2, 0 font "" textcolor lt -1 norotate
set xrange [ -5.00000 : 5.00000 ] noreverse nowriteback
set ylabel "Y axis"
set ylabel offset character 3, -2, 0 font "" textcolor lt -1 rotate by -270
set yrange [ -5.00000 : 5.00000 ] noreverse nowriteback
set zlabel "Z axis"
set zlabel offset character -5, 0, 0 font "" textcolor lt -1 norotate
set zrange [ -1.00000 : 1.00000 ] noreverse nowriteback
sinc(u,v) = sin(sqrt(u**2+v**2)) / sqrt(u**2+v**2)
GPFUN_sinc = "sinc(u,v) = sin(sqrt(u**2+v**2)) / sqrt(u**2+v**2)"
xx = 6.08888888888889
dx = 1.10888888888889
x0 = -5
x1 = -3.89111111111111
x2 = -2.78222222222222
x3 = -1.67333333333333
x4 = -0.564444444444444
x5 = 0.544444444444445
x6 = 1.65333333333333
x7 = 2.76222222222222
x8 = 3.87111111111111
x9 = 4.98
splot [u=0:1][v=-4.99:4.99] x0, v, (u<0.5) ? -1 : sinc(x0,v) notitle, x1, v, (u<0.5) ? -1 : sinc(x1,v) notitle, x2, v, (u<0.5) ? -1 : sinc(x2,v) notitle, x3, v, (u<0.5) ? -1 : sinc(x3,v) notitle, x4, v, (u<0.5) ? -1 : sinc(x4,v) notitle, x5, v, (u<0.5) ? -1 : sinc(x5,v) notitle, x6, v, (u<0.5) ? -1 : sinc(x6,v) notitle, x7, v, (u<0.5) ? -1 : sinc(x7,v) notitle, x8, v, (u<0.5) ? -1 : sinc(x8,v) notitle, x9, v, (u<0.5) ? -1 : sinc(x9,v) notitle

View File

@@ -0,0 +1,46 @@
# set terminal pngcairo transparent enhanced font "arial,10" fontscale 1.0 size 500, 350
# set output 'surface1.17.png'
set dummy u,v
set label 1 "increasing v" at 6, 0, -1 left norotate back nopoint offset character 0, 0, 0
set label 2 "increasing u" at 0, -5, -1.5 left norotate back nopoint offset character 0, 0, 0
set label 3 "floor(u)%3=0" at 5, 6.5, -1 left norotate back nopoint offset character 0, 0, 0
set label 4 "floor(u)%3=1" at 5, 6.5, 0.100248 left norotate back nopoint offset character 0, 0, 0
set arrow 1 from 5, -5, -1.2 to 5, 5, -1.2 head back nofilled linetype -1 linewidth 1.000
set arrow 2 from -5, -5, -1.2 to 5, -5, -1.2 head back nofilled linetype -1 linewidth 1.000
set arrow 3 from 5, 6, -1 to 5, 5, -1 head back nofilled linetype -1 linewidth 1.000
set arrow 4 from 5, 6, 0.100248 to 5, 5, 0.100248 head back nofilled linetype -1 linewidth 1.000
set parametric
set view 70, 20, 1, 1
set samples 51, 51
set isosamples 30, 33
set hidden3d back offset 1 trianglepattern 3 undefined 1 altdiagonal bentover
set ztics -1.00000,0.25,1.00000 norangelimit
set title "\"fence plot\" using single parametric surface with undefined points"
set xlabel "X axis"
set xlabel offset character -3, -2, 0 font "" textcolor lt -1 norotate
set xrange [ -5.00000 : 5.00000 ] noreverse nowriteback
set ylabel "Y axis"
set ylabel offset character 3, -2, 0 font "" textcolor lt -1 rotate by -270
set yrange [ -5.00000 : 5.00000 ] noreverse nowriteback
set zlabel "Z axis"
set zlabel offset character -5, 0, 0 font "" textcolor lt -1 norotate
set zrange [ -1.00000 : 1.00000 ] noreverse nowriteback
sinc(u,v) = sin(sqrt(u**2+v**2)) / sqrt(u**2+v**2)
GPFUN_sinc = "sinc(u,v) = sin(sqrt(u**2+v**2)) / sqrt(u**2+v**2)"
xx = 6.08888888888889
dx = 1.11
x0 = -5
x1 = -3.89111111111111
x2 = -2.78222222222222
x3 = -1.67333333333333
x4 = -0.564444444444444
x5 = 0.544444444444445
x6 = 1.65333333333333
x7 = 2.76222222222222
x8 = 3.87111111111111
x9 = 4.98
xmin = -4.99
xmax = 5
n = 10
zbase = -1
splot [u=.5:3*n-.5][v=-4.99:4.99] xmin+floor(u/3)*dx, v, ((floor(u)%3)==0) ? zbase : (((floor(u)%3)==1) ? sinc(xmin+u/3.*dx,v) : 1/0) notitle

View File

@@ -0,0 +1,21 @@
# set terminal pngcairo transparent enhanced font "arial,10" fontscale 1.0 size 500, 350
# set output 'world2.1.png'
unset border
set dummy u,v
set angles degrees
set parametric
set view 60, 136, 1.22, 1.26
set samples 64, 64
set isosamples 13, 13
set mapping spherical
set noxtics
set noytics
set noztics
set title "Labels colored by GeV plotted in spherical coordinate system"
set urange [ -90.0000 : 90.0000 ] noreverse nowriteback
set vrange [ 0.00000 : 360.000 ] noreverse nowriteback
set cblabel "GeV"
set cbrange [ 0.00000 : 8.00000 ] noreverse nowriteback
set colorbox user
set colorbox vertical origin screen 0.9, 0.2, 0 size screen 0.02, 0.75, 0 front bdefault
splot cos(u)*cos(v),cos(u)*sin(v),sin(u) notitle with lines lt 5, 'world.dat' notitle with lines lt 2, 'srl.dat' using 3:2:(1):1:4 with labels notitle point pt 6 lw .1 left offset 1,0 font "Helvetica,7" tc pal

View File

@@ -0,0 +1,15 @@
-- (c) 2009 Aarne Ranta under LGPL
abstract Foods = {
flags startcat = Comment ;
cat
Comment ; Item ; Kind ; Quality ;
fun
Pred : Item -> Quality -> Comment ;
This, That, These, Those : Kind -> Item ;
Mod : Quality -> Kind -> Kind ;
Wine, Cheese, Fish, Pizza : Kind ;
Very : Quality -> Quality ;
Fresh, Warm, Italian,
Expensive, Delicious, Boring : Quality ;
}

View File

@@ -0,0 +1,79 @@
-- (c) 2009 Laurette Pretorius Sr & Jr and Ansu Berg under LGPL
concrete FoodsAfr of Foods = open Prelude, Predef in{
flags coding=utf8;
lincat
Comment = {s: Str} ;
Kind = {s: Number => Str} ;
Item = {s: Str ; n: Number} ;
Quality = {s: AdjAP => Str} ;
lin
Pred item quality = {s = item.s ++ "is" ++ (quality.s ! Predic)};
This kind = {s = "hierdie" ++ (kind.s ! Sg); n = Sg};
That kind = {s = "daardie" ++ (kind.s ! Sg); n = Sg};
These kind = {s = "hierdie" ++ (kind.s ! Pl); n = Pl};
Those kind = {s = "daardie" ++ (kind.s ! Pl); n = Pl};
Mod quality kind = {s = table{n => (quality.s ! Attr) ++ (kind.s!n)}};
Wine = declNoun_e "wyn";
Cheese = declNoun_aa "kaas";
Fish = declNoun_ss "vis";
Pizza = declNoun_s "pizza";
Very quality = veryAdj quality;
Fresh = regAdj "vars";
Warm = regAdj "warm";
Italian = smartAdj_e "Italiaans";
Expensive = regAdj "duur";
Delicious = smartAdj_e "heerlik";
Boring = smartAdj_e "vervelig";
param
AdjAP = Attr | Predic ;
Number = Sg | Pl ;
oper
--Noun operations (wyn, kaas, vis, pizza)
declNoun_aa: Str -> {s: Number => Str} = \x ->
let v = tk 2 x
in
{s = table{Sg => x ; Pl => v + (last x) +"e"}};
declNoun_e: Str -> {s: Number => Str} = \x -> {s = table{Sg => x ; Pl => x + "e"}} ;
declNoun_s: Str -> {s: Number => Str} = \x -> {s = table{Sg => x ; Pl => x + "s"}} ;
declNoun_ss: Str -> {s: Number => Str} = \x -> {s = table{Sg => x ; Pl => x + (last x) + "e"}} ;
--Adjective operations
mkAdj : Str -> Str -> {s: AdjAP => Str} = \x,y -> {s = table{Attr => x; Predic => y}};
declAdj_e : Str -> {s : AdjAP=> Str} = \x -> mkAdj (x + "e") x;
declAdj_g : Str -> {s : AdjAP=> Str} = \w ->
let v = init w
in mkAdj (v + "ë") w ;
declAdj_oog : Str -> {s : AdjAP=> Str} = \w ->
let v = init w
in
let i = init v
in mkAdj (i + "ë") w ;
regAdj : Str -> {s : AdjAP=> Str} = \x -> mkAdj x x;
veryAdj : {s: AdjAP => Str} -> {s : AdjAP=> Str} = \x -> {s = table{a => "baie" ++ (x.s!a)}};
smartAdj_e : Str -> {s : AdjAP=> Str} = \a -> case a of
{
_ + "oog" => declAdj_oog a ;
_ + ("e" | "ie" | "o" | "oe") + "g" => declAdj_g a ;
_ => declAdj_e a
};
}

View File

@@ -0,0 +1,21 @@
concrete FoodsAmh of Foods ={
flags coding = utf8;
lincat
Comment,Item,Kind,Quality = Str;
lin
Pred item quality = item ++ quality++ "ነው::" ;
This kind = "ይህ" ++ kind;
That kind = "ያ" ++ kind;
Mod quality kind = quality ++ kind;
Wine = "ወይን";
Cheese = "አይብ";
Fish = "ዓሳ";
Very quality = "በጣም" ++ quality;
Fresh = "አዲስ";
Warm = "ትኩስ";
Italian = "የጥልያን";
Expensive = "ውድ";
Delicious = "ጣፋጭ";
Boring = "አስቀያሚ";
}

View File

@@ -0,0 +1,43 @@
-- (c) 2009 Krasimir Angelov under LGPL
concrete FoodsBul of Foods = {
flags
coding = utf8;
param
Gender = Masc | Fem | Neutr;
Number = Sg | Pl;
Agr = ASg Gender | APl ;
lincat
Comment = Str ;
Quality = {s : Agr => Str} ;
Item = {s : Str; a : Agr} ;
Kind = {s : Number => Str; g : Gender} ;
lin
Pred item qual = item.s ++ case item.a of {ASg _ => "е"; APl => "са"} ++ qual.s ! item.a ;
This kind = {s=case kind.g of {Masc=>"този"; Fem=>"тази"; Neutr=>"това" } ++ kind.s ! Sg; a=ASg kind.g} ;
That kind = {s=case kind.g of {Masc=>"онзи"; Fem=>"онази"; Neutr=>"онова"} ++ kind.s ! Sg; a=ASg kind.g} ;
These kind = {s="тези" ++ kind.s ! Pl; a=APl} ;
Those kind = {s="онези" ++ kind.s ! Pl; a=APl} ;
Mod qual kind = {s=\\n => qual.s ! (case n of {Sg => ASg kind.g; Pl => APl}) ++ kind.s ! n; g=kind.g} ;
Wine = {s = table {Sg => "вино"; Pl => "вина"}; g = Neutr};
Cheese = {s = table {Sg => "сирене"; Pl => "сирена"}; g = Neutr};
Fish = {s = table {Sg => "риба"; Pl => "риби"}; g = Fem};
Pizza = {s = table {Sg => "пица"; Pl => "пици"}; g = Fem};
Very qual = {s = \\g => "много" ++ qual.s ! g};
Fresh = {s = table {ASg Masc => "свеж"; ASg Fem => "свежа"; ASg Neutr => "свежо"; APl => "свежи"}};
Warm = {s = table {ASg Masc => "горещ"; ASg Fem => "гореща"; ASg Neutr => "горещо"; APl => "горещи"}};
Italian = {s = table {ASg Masc => "италиански"; ASg Fem => "италианска"; ASg Neutr => "италианско"; APl => "италиански"}};
Expensive = {s = table {ASg Masc => "скъп"; ASg Fem => "скъпа"; ASg Neutr => "скъпо"; APl => "скъпи"}};
Delicious = {s = table {ASg Masc => "превъзходен"; ASg Fem => "превъзходна"; ASg Neutr => "превъзходно"; APl => "превъзходни"}};
Boring = {s = table {ASg Masc => "еднообразен"; ASg Fem => "еднообразна"; ASg Neutr => "еднообразно"; APl => "еднообразни"}};
}

View File

@@ -0,0 +1,7 @@
--# -path=.:present
-- (c) 2009 Jordi Saludes under LGPL
concrete FoodsCat of Foods = FoodsI with
(Syntax = SyntaxCat),
(LexFoods = LexFoodsCat) ;

View File

@@ -0,0 +1,35 @@
concrete FoodsChi of Foods = {
flags coding = utf8 ;
lincat
Comment, Item = Str ;
Kind = {s,c : Str} ;
Quality = {s,p : Str} ;
lin
Pred item quality = item ++ "是" ++ quality.s ++ quality.p ;
This kind = "这" ++ kind.c ++ kind.s ;
That kind = "那" ++ kind.c ++ kind.s ;
These kind = "这" ++ "些" ++ kind.s ;
Those kind = "那" ++ "些" ++ kind.s ;
Mod quality kind = {
s = quality.s ++ quality.p ++ kind.s ;
c = kind.c
} ;
Wine = geKind "酒" ;
Pizza = geKind "比 萨 饼" ;
Cheese = geKind "奶 酪" ;
Fish = geKind "鱼" ;
Very quality = longQuality ("非 常" ++ quality.s) ;
Fresh = longQuality "新 鲜" ;
Warm = longQuality "温 热" ;
Italian = longQuality "意 大 利 式" ;
Expensive = longQuality "昂 贵" ;
Delicious = longQuality "美 味" ;
Boring = longQuality "难 吃" ;
oper
mkKind : Str -> Str -> {s,c : Str} = \s,c ->
{s = s ; c = c} ;
geKind : Str -> {s,c : Str} = \s ->
mkKind s "个" ;
longQuality : Str -> {s,p : Str} = \s ->
{s = s ; p = "的"} ;
}

View File

@@ -0,0 +1,35 @@
-- (c) 2011 Katerina Bohmova under LGPL
concrete FoodsCze of Foods = open ResCze in {
flags
coding = utf8 ;
lincat
Comment = {s : Str} ;
Quality = Adjective ;
Kind = Noun ;
Item = NounPhrase ;
lin
Pred item quality =
{s = item.s ++ copula ! item.n ++
quality.s ! item.g ! item.n} ;
This = det Sg "tento" "tato" "toto" ;
That = det Sg "tamten" "tamta" "tamto" ;
These = det Pl "tyto" "tyto" "tato" ;
Those = det Pl "tamty" "tamty" "tamta" ;
Mod quality kind = {
s = \\n => quality.s ! kind.g ! n ++ kind.s ! n ;
g = kind.g
} ;
Wine = noun "víno" "vína" Neutr ;
Cheese = noun "sýr" "sýry" Masc ;
Fish = noun "ryba" "ryby" Fem ;
Pizza = noun "pizza" "pizzy" Fem ;
Very qual = {s = \\g,n => "velmi" ++ qual.s ! g ! n} ;
Fresh = regAdj "čerstv" ;
Warm = regAdj "tepl" ;
Italian = regAdj "italsk" ;
Expensive = regAdj "drah" ;
Delicious = regnfAdj "vynikající" ;
Boring = regAdj "nudn" ;
}

View File

@@ -0,0 +1,58 @@
-- (c) 2009 Femke Johansson under LGPL
concrete FoodsDut of Foods = {
lincat
Comment = {s : Str};
Quality = {s : AForm => Str};
Kind = { s : Number => Str};
Item = {s : Str ; n : Number};
lin
Pred item quality =
{s = item.s ++ copula ! item.n ++ quality.s ! APred};
This = det Sg "deze";
These = det Pl "deze";
That = det Sg "die";
Those = det Pl "die";
Mod quality kind =
{s = \\n => quality.s ! AAttr ++ kind.s ! n};
Wine = regNoun "wijn";
Cheese = noun "kaas" "kazen";
Fish = noun "vis" "vissen";
Pizza = noun "pizza" "pizza's";
Very a = {s = \\f => "erg" ++ a.s ! f};
Fresh = regadj "vers";
Warm = regadj "warm";
Italian = regadj "Italiaans";
Expensive = adj "duur" "dure";
Delicious = regadj "lekker";
Boring = regadj "saai";
param
Number = Sg | Pl;
AForm = APred | AAttr;
oper
det : Number -> Str ->
{s : Number => Str} -> {s : Str ; n: Number} =
\n,det,noun -> {s = det ++ noun.s ! n ; n=n};
noun : Str -> Str -> {s : Number => Str} =
\man,men -> {s = table {Sg => man; Pl => men}};
regNoun : Str -> {s : Number => Str} =
\wijn -> noun wijn (wijn + "en");
regadj : Str -> {s : AForm => Str} =
\koud -> adj koud (koud+"e");
adj : Str -> Str -> {s : AForm => Str} =
\duur, dure -> {s = table {APred => duur; AAttr => dure}};
copula : Number => Str =
table {Sg => "is" ; Pl => "zijn"};
}

View File

@@ -0,0 +1,43 @@
-- (c) 2009 Aarne Ranta under LGPL
concrete FoodsEng of Foods = {
flags language = en_US;
lincat
Comment, Quality = {s : Str} ;
Kind = {s : Number => Str} ;
Item = {s : Str ; n : Number} ;
lin
Pred item quality =
{s = item.s ++ copula ! item.n ++ quality.s} ;
This = det Sg "this" ;
That = det Sg "that" ;
These = det Pl "these" ;
Those = det Pl "those" ;
Mod quality kind =
{s = \\n => quality.s ++ kind.s ! n} ;
Wine = regNoun "wine" ;
Cheese = regNoun "cheese" ;
Fish = noun "fish" "fish" ;
Pizza = regNoun "pizza" ;
Very a = {s = "very" ++ a.s} ;
Fresh = adj "fresh" ;
Warm = adj "warm" ;
Italian = adj "Italian" ;
Expensive = adj "expensive" ;
Delicious = adj "delicious" ;
Boring = adj "boring" ;
param
Number = Sg | Pl ;
oper
det : Number -> Str ->
{s : Number => Str} -> {s : Str ; n : Number} =
\n,det,noun -> {s = det ++ noun.s ! n ; n = n} ;
noun : Str -> Str -> {s : Number => Str} =
\man,men -> {s = table {Sg => man ; Pl => men}} ;
regNoun : Str -> {s : Number => Str} =
\car -> noun car (car + "s") ;
adj : Str -> {s : Str} =
\cold -> {s = cold} ;
copula : Number => Str =
table {Sg => "is" ; Pl => "are"} ;
}

View File

@@ -0,0 +1,48 @@
-- (c) 2009 Julia Hammar under LGPL
concrete FoodsEpo of Foods = open Prelude in {
flags coding =utf8 ;
lincat
Comment = SS ;
Kind, Quality = {s : Number => Str} ;
Item = {s : Str ; n : Number} ;
lin
Pred item quality = ss (item.s ++ copula ! item.n ++ quality.s ! item.n) ;
This = det Sg "ĉi tiu" ;
That = det Sg "tiu" ;
These = det Pl "ĉi tiuj" ;
Those = det Pl "tiuj" ;
Mod quality kind = {s = \\n => quality.s ! n ++ kind.s ! n} ;
Wine = regNoun "vino" ;
Cheese = regNoun "fromaĝo" ;
Fish = regNoun "fiŝo" ;
Pizza = regNoun "pico" ;
Very quality = {s = \\n => "tre" ++ quality.s ! n} ;
Fresh = regAdj "freŝa" ;
Warm = regAdj "varma" ;
Italian = regAdj "itala" ;
Expensive = regAdj "altekosta" ;
Delicious = regAdj "bongusta" ;
Boring = regAdj "enuiga" ;
param
Number = Sg | Pl ;
oper
det : Number -> Str -> {s : Number => Str} -> {s : Str ; n : Number} =
\n,d,cn -> {
s = d ++ cn.s ! n ;
n = n
} ;
regNoun : Str -> {s : Number => Str} =
\vino -> {s = table {Sg => vino ; Pl => vino + "j"}
} ;
regAdj : Str -> {s : Number => Str} =
\nova -> {s = table {Sg => nova ; Pl => nova + "j"}
} ;
copula : Number => Str = \\_ => "estas" ;
}

View File

@@ -0,0 +1,7 @@
--# -path=.:present
-- (c) 2009 Aarne Ranta under LGPL
concrete FoodsFin of Foods = FoodsI with
(Syntax = SyntaxFin),
(LexFoods = LexFoodsFin) ;

View File

@@ -0,0 +1,32 @@
--# -path=.:../foods:present
concrete FoodsFre of Foods = open SyntaxFre, ParadigmsFre in {
flags coding = utf8 ;
lincat
Comment = Utt ;
Item = NP ;
Kind = CN ;
Quality = AP ;
lin
Pred item quality = mkUtt (mkCl item quality) ;
This kind = mkNP this_QuantSg kind ;
That kind = mkNP that_QuantSg kind ;
These kind = mkNP these_QuantPl kind ;
Those kind = mkNP those_QuantPl kind ;
Mod quality kind = mkCN quality kind ;
Very quality = mkAP very_AdA quality ;
Wine = mkCN (mkN "vin" masculine) ;
Pizza = mkCN (mkN "pizza" feminine) ;
Cheese = mkCN (mkN "fromage" masculine) ;
Fish = mkCN (mkN "poisson" masculine) ;
Fresh = mkAP (mkA "frais" "fraîche" "frais" "fraîchement") ;
Warm = mkAP (mkA "chaud") ;
Italian = mkAP (mkA "italien") ;
Expensive = mkAP (mkA "cher") ;
Delicious = mkAP (mkA "délicieux") ;
Boring = mkAP (mkA "ennuyeux") ;
}

View File

@@ -0,0 +1,7 @@
--# -path=.:present
-- (c) 2009 Aarne Ranta under LGPL
concrete FoodsGer of Foods = FoodsI with
(Syntax = SyntaxGer),
(LexFoods = LexFoodsGer) ;

View File

@@ -0,0 +1,108 @@
--# -path=alltenses
--(c) 2009 Dana Dannells
-- Licensed under LGPL
concrete FoodsHeb of Foods = open Prelude in {
flags coding=utf8 ;
lincat
Comment = SS ;
Quality = {s: Number => Species => Gender => Str} ;
Kind = {s : Number => Species => Str ; g : Gender ; mod : Modified} ;
Item = {s : Str ; g : Gender ; n : Number ; sp : Species ; mod : Modified} ;
lin
Pred item quality = ss (item.s ++ quality.s ! item.n ! Indef ! item.g ) ;
This = det Sg Def "הזה" "הזאת";
That = det Sg Def "ההוא" "ההיא" ;
These = det Pl Def "האלה" "האלה" ;
Those = det Pl Def "ההם" "ההן" ;
Mod quality kind = {
s = \\n,sp => kind.s ! n ! sp ++ quality.s ! n ! sp ! kind.g;
g = kind.g ;
mod = T
} ;
Wine = regNoun "יין" "יינות" Masc ;
Cheese = regNoun "גבינה" "גבינות" Fem ;
Fish = regNoun "דג" "דגים" Masc ;
Pizza = regNoun "פיצה" "פיצות" Fem ;
Very qual = {s = \\g,n,sp => "מאוד" ++ qual.s ! g ! n ! sp} ;
Fresh = regAdj "טרי" ;
Warm = regAdj "חם" ;
Italian = regAdj2 "איטלקי" ;
Expensive = regAdj "יקר" ;
Delicious = regAdj "טעים" ;
Boring = regAdj2 "משעמם";
param
Number = Sg | Pl ;
Gender = Masc | Fem ;
Species = Def | Indef ;
Modified = T | F ;
oper
Noun : Type = {s : Number => Species => Str ; g : Gender ; mod : Modified } ;
Adj : Type = {s : Number => Species => Gender => Str} ;
det : Number -> Species -> Str -> Str -> Noun ->
{s : Str ; g :Gender ; n : Number ; sp : Species ; mod : Modified} =
\n,sp,m,f,cn -> {
s = case cn.mod of { _ => cn.s ! n ! sp ++ case cn.g of {Masc => m ; Fem => f} };
g = cn.g ;
n = n ;
sp = sp ;
mod = cn.mod
} ;
noun : (gvina,hagvina,gvinot,hagvinot : Str) -> Gender -> Noun =
\gvina,hagvina,gvinot,hagvinot,g -> {
s = table {
Sg => table {
Indef => gvina ;
Def => hagvina
} ;
Pl => table {
Indef => gvinot ;
Def => hagvinot
}
} ;
g = g ;
mod = F
} ;
regNoun : Str -> Str -> Gender -> Noun =
\gvina,gvinot, g ->
noun gvina (defH gvina) gvinot (defH gvinot) g ;
defH : Str -> Str = \cn ->
case cn of {_ => "ה" + cn};
replaceLastLetter : Str -> Str = \c ->
case c of {"ף" => "פ" ; "ם" => "מ" ; "ן" => "נ" ; "ץ" => "צ" ; "ך" => "כ"; _ => c} ;
adjective : (_,_,_,_ : Str) -> Adj =
\tov,tova,tovim,tovot -> {
s = table {
Sg => table {
Indef => table { Masc => tov ; Fem => tova } ;
Def => table { Masc => defH tov ; Fem => defH tova }
} ;
Pl => table {
Indef => table {Masc => tovim ; Fem => tovot } ;
Def => table { Masc => defH tovim ; Fem => defH tovot }
}
}
} ;
regAdj : Str -> Adj = \tov ->
case tov of { to + c@? =>
adjective tov (to + replaceLastLetter (c) + "ה" ) (to + replaceLastLetter (c) +"ים" ) (to + replaceLastLetter (c) + "ות" )};
regAdj2 : Str -> Adj = \italki ->
case italki of { italk+ c@? =>
adjective italki (italk + replaceLastLetter (c) +"ת" ) (italk + replaceLastLetter (c)+ "ים" ) (italk + replaceLastLetter (c) + "ות" )};
} -- FoodsHeb

View File

@@ -0,0 +1,75 @@
-- (c) 2010 Vikash Rauniyar under LGPL
concrete FoodsHin of Foods = {
flags coding=utf8 ;
param
Gender = Masc | Fem ;
Number = Sg | Pl ;
lincat
Comment = {s : Str} ;
Item = {s : Str ; g : Gender ; n : Number} ;
Kind = {s : Number => Str ; g : Gender} ;
Quality = {s : Gender => Number => Str} ;
lin
Pred item quality = {
s = item.s ++ quality.s ! item.g ! item.n ++ copula item.n
} ;
This kind = {s = "यह" ++ kind.s ! Sg ; g = kind.g ; n = Sg} ;
That kind = {s = "वह" ++ kind.s ! Sg ; g = kind.g ; n = Sg} ;
These kind = {s = "ये" ++ kind.s ! Pl ; g = kind.g ; n = Pl} ;
Those kind = {s = "वे" ++ kind.s ! Pl ; g = kind.g ; n = Pl} ;
Mod quality kind = {
s = \\n => quality.s ! kind.g ! n ++ kind.s ! n ;
g = kind.g
} ;
Wine = regN "मदिरा" ;
Cheese = regN "पनीर" ;
Fish = regN "मछली" ;
Pizza = regN "पिज़्ज़ा" ;
Very quality = {s = \\g,n => "अति" ++ quality.s ! g ! n} ;
Fresh = regAdj "ताज़ा" ;
Warm = regAdj "गरम" ;
Italian = regAdj "इटली" ;
Expensive = regAdj "बहुमूल्य" ;
Delicious = regAdj "स्वादिष्ट" ;
Boring = regAdj "अरुचिकर" ;
oper
mkN : Str -> Str -> Gender -> {s : Number => Str ; g : Gender} =
\s,p,g -> {
s = table {
Sg => s ;
Pl => p
} ;
g = g
} ;
regN : Str -> {s : Number => Str ; g : Gender} = \s -> case s of {
lark + "ा" => mkN s (lark + "े") Masc ;
lark + "ी" => mkN s (lark + "ीयँा") Fem ;
_ => mkN s s Masc
} ;
mkAdj : Str -> Str -> Str -> {s : Gender => Number => Str} = \ms,mp,f -> {
s = table {
Masc => table {
Sg => ms ;
Pl => mp
} ;
Fem => \\_ => f
}
} ;
regAdj : Str -> {s : Gender => Number => Str} = \a -> case a of {
acch + "ा" => mkAdj a (acch + "े") (acch + "ी") ;
_ => mkAdj a a a
} ;
copula : Number -> Str = \n -> case n of {
Sg => "है" ;
Pl => "हैं"
} ;
}

View File

@@ -0,0 +1,29 @@
-- (c) 2009 Aarne Ranta under LGPL
incomplete concrete FoodsI of Foods =
open Syntax, LexFoods in {
lincat
Comment = Utt ;
Item = NP ;
Kind = CN ;
Quality = AP ;
lin
Pred item quality = mkUtt (mkCl item quality) ;
This kind = mkNP this_Det kind ;
That kind = mkNP that_Det kind ;
These kind = mkNP these_Det kind ;
Those kind = mkNP those_Det kind ;
Mod quality kind = mkCN quality kind ;
Very quality = mkAP very_AdA quality ;
Wine = mkCN wine_N ;
Pizza = mkCN pizza_N ;
Cheese = mkCN cheese_N ;
Fish = mkCN fish_N ;
Fresh = mkAP fresh_A ;
Warm = mkAP warm_A ;
Italian = mkAP italian_A ;
Expensive = mkAP expensive_A ;
Delicious = mkAP delicious_A ;
Boring = mkAP boring_A ;
}

View File

@@ -0,0 +1,84 @@
--# -path=.:prelude
-- (c) 2009 Martha Dis Brandt under LGPL
concrete FoodsIce of Foods = open Prelude in {
flags coding=utf8;
lincat
Comment = SS ;
Quality = {s : Gender => Number => Defin => Str} ;
Kind = {s : Number => Str ; g : Gender} ;
Item = {s : Str ; g : Gender ; n : Number} ;
lin
Pred item quality = ss (item.s ++ copula item.n ++ quality.s ! item.g ! item.n ! Ind) ;
This, That = det Sg "þessi" "þessi" "þetta" ;
These, Those = det Pl "þessir" "þessar" "þessi" ;
Mod quality kind = { s = \\n => quality.s ! kind.g ! n ! Def ++ kind.s ! n ; g = kind.g } ;
Wine = noun "vín" "vín" Neutr ;
Cheese = noun "ostur" "ostar" Masc ;
Fish = noun "fiskur" "fiskar" Masc ;
-- the word "pizza" is more commonly used in Iceland, but "flatbaka" is the Icelandic word for it
Pizza = noun "flatbaka" "flatbökur" Fem ;
Very qual = {s = \\g,n,defOrInd => "mjög" ++ qual.s ! g ! n ! defOrInd } ;
Fresh = regAdj "ferskur" ;
Warm = regAdj "heitur" ;
Boring = regAdj "leiðinlegur" ;
-- the order of the given adj forms is: mSg fSg nSg mPl fPl nPl mSgDef f/nSgDef _PlDef
Italian = adjective "ítalskur" "ítölsk" "ítalskt" "ítalskir" "ítalskar" "ítölsk" "ítalski" "ítalska" "ítalsku" ;
Expensive = adjective "dýr" "dýr" "dýrt" "dýrir" "dýrar" "dýr" "dýri" "dýra" "dýru" ;
Delicious = adjective "ljúffengur" "ljúffeng" "ljúffengt" "ljúffengir" "ljúffengar" "ljúffeng" "ljúffengi" "ljúffenga" "ljúffengu" ;
param
Number = Sg | Pl ;
Gender = Masc | Fem | Neutr ;
Defin = Ind | Def ;
oper
det : Number -> Str -> Str -> Str -> {s : Number => Str ; g : Gender} ->
{s : Str ; g : Gender ; n : Number} =
\n,masc,fem,neutr,cn -> {
s = case cn.g of {Masc => masc ; Fem => fem; Neutr => neutr } ++ cn.s ! n ;
g = cn.g ;
n = n
} ;
noun : Str -> Str -> Gender -> {s : Number => Str ; g : Gender} =
\man,men,g -> {
s = table {
Sg => man ;
Pl => men
} ;
g = g
} ;
adjective : (x1,_,_,_,_,_,_,_,x9 : Str) -> {s : Gender => Number => Defin => Str} =
\ferskur,fersk,ferskt,ferskir,ferskar,fersk_pl,ferski,ferska,fersku -> {
s = \\g,n,t => case <g,n,t> of {
< Masc, Sg, Ind > => ferskur ;
< Masc, Pl, Ind > => ferskir ;
< Fem, Sg, Ind > => fersk ;
< Fem, Pl, Ind > => ferskar ;
< Neutr, Sg, Ind > => ferskt ;
< Neutr, Pl, Ind > => fersk_pl;
< Masc, Sg, Def > => ferski ;
< Fem, Sg, Def > | < Neutr, Sg, Def > => ferska ;
< _ , Pl, Def > => fersku
}
} ;
regAdj : Str -> {s : Gender => Number => Defin => Str} = \ferskur ->
let fersk = Predef.tk 2 ferskur
in adjective
ferskur fersk (fersk + "t")
(fersk + "ir") (fersk + "ar") fersk
(fersk + "i") (fersk + "a") (fersk + "u") ;
copula : Number -> Str =
\n -> case n of {
Sg => "er" ;
Pl => "eru"
} ;
}

View File

@@ -0,0 +1,8 @@
--# -path=.:present
-- (c) 2009 Aarne Ranta under LGPL
concrete FoodsIta of Foods = FoodsI with
(Syntax = SyntaxIta),
(LexFoods = LexFoodsIta) ;

View File

@@ -0,0 +1,72 @@
--# -path=.:../lib/src/prelude
-- (c) 2009 Zofia Stankiewicz under LGPL
concrete FoodsJpn of Foods = open Prelude in {
flags coding=utf8 ;
lincat
Comment = {s: Style => Str};
Quality = {s: AdjUse => Str ; t: AdjType} ;
Kind = {s : Number => Str} ;
Item = {s : Str ; n : Number} ;
lin
Pred item quality = {s = case quality.t of {
IAdj => table {Plain => item.s ++ quality.s ! APred ; Polite => item.s ++ quality.s ! APred ++ copula ! Polite ! item.n } ;
NaAdj => \\p => item.s ++ quality.s ! APred ++ copula ! p ! item.n }
} ;
This = det Sg "この" ;
That = det Sg "その" ;
These = det Pl "この" ;
Those = det Pl "その" ;
Mod quality kind = {s = \\n => quality.s ! Attr ++ kind.s ! n} ;
Wine = regNoun "ワインは" ;
Cheese = regNoun "チーズは" ;
Fish = regNoun "魚は" ;
Pizza = regNoun "ピザは" ;
Very quality = {s = \\a => "とても" ++ quality.s ! a ; t = quality.t } ;
Fresh = adj "新鮮な" "新鮮";
Warm = regAdj "あたたかい" ;
Italian = adj "イタリアの" "イタリアのもの";
Expensive = regAdj "たかい" ;
Delicious = regAdj "おいしい" ;
Boring = regAdj "つまらない" ;
param
Number = Sg | Pl ;
AdjUse = Attr | APred ; -- na-adjectives have different forms as noun attributes and predicates
Style = Plain | Polite ; -- for phrase types
AdjType = IAdj | NaAdj ; -- IAdj can form predicates without the copula, NaAdj cannot
oper
det : Number -> Str -> {s : Number => Str} -> {s : Str ; n : Number} =
\n,d,cn -> {
s = d ++ cn.s ! n ;
n = n
} ;
noun : Str -> Str -> {s : Number => Str} =
\sakana,sakana -> {s = \\_ => sakana } ;
regNoun : Str -> {s : Number => Str} =
\sakana -> noun sakana sakana ;
adj : Str -> Str -> {s : AdjUse => Str ; t : AdjType} =
\chosenna, chosen -> {
s = table {
Attr => chosenna ;
APred => chosen
} ;
t = NaAdj
} ;
regAdj : Str -> {s: AdjUse => Str ; t : AdjType} =\akai -> {
s = \\_ => akai ; t = IAdj} ;
copula : Style => Number => Str =
table {
Plain => \\_ => "だ" ;
Polite => \\_ => "です" } ;
}

View File

@@ -0,0 +1,91 @@
--# -path=.:prelude
-- (c) 2009 Inese Bernsone under LGPL
concrete FoodsLav of Foods = open Prelude in {
flags
coding=utf8 ;
lincat
Comment = SS ;
Quality = {s : Q => Gender => Number => Defin => Str } ;
Kind = {s : Number => Str ; g : Gender} ;
Item = {s : Str ; g : Gender ; n : Number } ;
lin
Pred item quality = ss (item.s ++ {- copula item.n -} "ir" ++ quality.s ! Q1 ! item.g ! item.n ! Ind ) ;
This = det Sg "šis" "šī" ;
That = det Sg "tas" "tā" ;
These = det Pl "šie" "šīs" ;
Those = det Pl "tie" "tās" ;
Mod quality kind = {s = \\n => quality.s ! Q1 ! kind.g ! n ! Def ++ kind.s ! n ; g = kind.g } ;
Wine = noun "vīns" "vīni" Masc ;
Cheese = noun "siers" "sieri" Masc ;
Fish = noun "zivs" "zivis" Fem ;
Pizza = noun "pica" "picas" Fem ;
Very qual = {s = \\q,g,n,spec => "ļoti" ++ qual.s ! Q2 ! g ! n ! spec };
Fresh = adjective "svaigs" "svaiga" "svaigi" "svaigas" "svaigais" "svaigā" "svaigie" "svaigās" ;
Warm = regAdj "silts" ;
Italian = specAdj "itāļu" (regAdj "itālisks") ;
Expensive = regAdj "dārgs" ;
Delicious = regAdj "garšīgs" ;
Boring = regAdj "garlaicīgs" ;
param
Number = Sg | Pl ;
Gender = Masc | Fem ;
Defin = Ind | Def ;
Q = Q1 | Q2 ;
oper
det : Number -> Str -> Str -> {s : Number => Str ; g : Gender} ->
{s : Str ; g : Gender ; n : Number} =
\n,m,f,cn -> {
s = case cn.g of {Masc => m ; Fem => f} ++ cn.s ! n ;
g = cn.g ;
n = n
} ;
noun : Str -> Str -> Gender -> {s : Number => Str ; g : Gender} =
\man,men,g -> {
s = table {
Sg => man ;
Pl => men
} ;
g = g
} ;
adjective : (_,_,_,_,_,_,_,_ : Str) -> {s : Q => Gender => Number => Defin => Str} =
\skaists,skaista,skaisti,skaistas,skaistais,skaistaa,skaistie,skaistaas -> {
s = table {
_ => table {
Masc => table {
Sg => table {Ind => skaists ; Def => skaistais} ;
Pl => table {Ind => skaisti ; Def => skaistie}
} ;
Fem => table {
Sg => table {Ind => skaista ; Def => skaistaa} ;
Pl => table {Ind => skaistas ; Def => skaistaas}
}
}
}
} ;
{- irregAdj : Str -> {s : Gender => Number => Defin => Str} = \itaalju ->
let itaalju = itaalju
in adjective itaalju (itaalju) (itaalju) (itaalju) (itaalju) (itaalju) (itaalju) (itaalju) ; -}
regAdj : Str -> {s : Q => Gender => Number => Defin => Str} = \skaists ->
let skaist = init skaists
in adjective skaists (skaist + "a") (skaist + "i") (skaist + "as") (skaist + "ais") (skaist + "ā") (skaist + "ie") (skaist + "ās");
Adjective : Type = {s : Q => Gender => Number => Defin => Str} ;
specAdj : Str -> Adjective -> Adjective = \s,a -> {
s = table {
Q2 => a.s ! Q1 ;
Q1 => \\_,_,_ => s
}
} ;
}

View File

@@ -0,0 +1,105 @@
-- (c) 2013 John J. Camilleri under LGPL
concrete FoodsMlt of Foods = open Prelude in {
flags coding=utf8 ;
lincat
Comment = SS ;
Quality = {s : Gender => Number => Str} ;
Kind = {s : Number => Str ; g : Gender} ;
Item = {s : Str ; g : Gender ; n : Number} ;
lin
-- Pred item quality = ss (item.s ++ copula item.n item.g ++ quality.s ! item.g ! item.n) ;
Pred item quality = ss (item.s ++ quality.s ! item.g ! item.n) ;
This kind = det Sg "dan" "din" kind ;
That kind = det Sg "dak" "dik" kind ;
These kind = det Pl "dawn" "" kind ;
Those kind = det Pl "dawk" "" kind ;
Mod quality kind = {
s = \\n => kind.s ! n ++ quality.s ! kind.g ! n ;
g = kind.g
} ;
Wine = noun "inbid" "inbejjed" Masc ;
Cheese = noun "ġobon" "ġobniet" Masc ;
Fish = noun "ħuta" "ħut" Fem ;
Pizza = noun "pizza" "pizzez" Fem ;
Very qual = {s = \\g,n => qual.s ! g ! n ++ "ħafna"} ;
Warm = adjective "sħun" "sħuna" "sħan" ;
Expensive = adjective "għali" "għalja" "għaljin" ;
Delicious = adjective "tajjeb" "tajba" "tajbin" ;
Boring = uniAdj "tad-dwejjaq" ;
Fresh = regAdj "frisk" ;
Italian = regAdj "Taljan" ;
param
Number = Sg | Pl ;
Gender = Masc | Fem ;
oper
--Create an adjective (full function)
--Params: Sing Masc, Sing Fem, Plural
adjective : (_,_,_ : Str) -> {s : Gender => Number => Str} = \iswed,sewda,suwed -> {
s = table {
Masc => table {
Sg => iswed ;
Pl => suwed
} ;
Fem => table {
Sg => sewda ;
Pl => suwed
}
}
} ;
--Create a regular adjective
--Param: Sing Masc
regAdj : Str -> {s : Gender => Number => Str} = \frisk ->
adjective frisk (frisk + "a") (frisk + "i") ;
--Create a "uni-adjective" eg tal-buzz
--Param: Sing Masc
uniAdj : Str -> {s : Gender => Number => Str} = \uni ->
adjective uni uni uni ;
--Create a noun
--Params: Singular, Plural, Gender (inherent)
noun : Str -> Str -> Gender -> {s : Number => Str ; g : Gender} = \ktieb,kotba,g -> {
s = table {
Sg => ktieb ;
Pl => kotba
} ;
g = g
} ;
--Copula is a linking verb
--Params: Number, Gender
-- copula : Number -> Gender -> Str = \n,g -> case n of {
-- Sg => case g of { Masc => "huwa" ; Fem => "hija" } ;
-- Pl => "huma"
-- } ;
--Create an article, taking into account first letter of next word
article = pre {
"a"|"e"|"i"|"o"|"u" => "l-" ;
--cons@("ċ"|"d"|"n"|"r"|"s"|"t"|"x"|"ż") => "i" + cons + "-" ;
_ => "il-"
} ;
--Create a determinant
--Params: Sg/Pl, Masc, Fem
det : Number -> Str -> Str -> {s : Number => Str ; g : Gender} -> {s : Str ; g : Gender ; n : Number} = \n,m,f,cn -> {
s = case n of {
Sg => case cn.g of {Masc => m ; Fem => f}; --string
Pl => m --default to masc
} ++ article ++ cn.s ! n ;
g = cn.g ; --gender
n = n --number
} ;
}

View File

@@ -0,0 +1,49 @@
--# -path=.:/GF/lib/src/prelude
-- (c) 2009 Nyamsuren Erdenebadrakh under LGPL
concrete FoodsMon of Foods = open Prelude in {
flags coding=utf8;
lincat
Comment, Quality = SS ;
Kind = {s : Number => Str} ;
Item = {s : Str ; n : Number} ;
lin
Pred item quality = ss (item.s ++ "бол" ++ quality.s) ;
This = det Sg "энэ" ;
That = det Sg "тэр" ;
These = det Pl "эдгээр" ;
Those = det Pl "тэдгээр" ;
Mod quality kind = {s = \\n => quality.s ++ kind.s ! n} ;
Wine = regNoun "дарс" ;
Cheese = regNoun "бяслаг" ;
Fish = regNoun "загас" ;
Pizza = regNoun "пицца" ;
Very = prefixSS "маш" ;
Fresh = ss "шинэ" ;
Warm = ss "халуун" ;
Italian = ss "итали" ;
Expensive = ss "үнэтэй" ;
Delicious = ss "амттай" ;
Boring = ss "амтгүй" ;
param
Number = Sg | Pl ;
oper
det : Number -> Str -> {s : Number => Str} -> {s : Str ; n : Number} =
\n,d,cn -> {
s = d ++ cn.s ! n ;
n = n
} ;
regNoun : Str -> {s : Number => Str} =
\x -> {s = table {
Sg => x ;
Pl => x + "нууд"}
} ;
}

View File

@@ -0,0 +1,60 @@
-- (c) 2011 Dinesh Simkhada under LGPL
concrete FoodsNep of Foods = {
flags coding = utf8 ;
lincat
Comment, Quality = {s : Str} ;
Kind = {s : Number => Str} ;
Item = {s : Str ; n : Number} ;
lin
Pred item quality =
{s = item.s ++ quality.s ++ copula ! item.n} ;
This = det Sg "यो" ;
That = det Sg "त्यो" ;
These = det Pl "यी" ;
Those = det Pl "ती" ;
Mod quality kind =
{s = \\n => quality.s ++ kind.s ! n} ;
Wine = regNoun "रक्सी" ;
Cheese = regNoun "चिज" ;
Fish = regNoun "माछा" ;
Pizza = regNoun "पिज्जा" ;
Very a = {s = "धेरै" ++ a.s} ;
Fresh = adj "ताजा" ;
Warm = adj "तातो" ;
Italian = adj "इटालियन" ;
Expensive = adj "महँगो" | adj "बहुमूल्य" ;
Delicious = adj "स्वादिष्ट" | adj "मीठो" ;
Boring = adjPl "नमिठो" ;
param
Number = Sg | Pl ;
oper
det : Number -> Str ->
{s : Number => Str} -> {s : Str ; n : Number} =
\n,det,noun -> {s = det ++ noun.s ! n ; n = n} ;
noun : Str -> Str -> {s : Number => Str} =
\man,men -> {s = table {Sg => man ; Pl => men}} ;
regNoun : Str -> {s : Number => Str} =
\car -> noun car (car + "हरु") ;
adjPl : Str -> {s : Str} = \a -> case a of {
bor + "ठो" => adj (bor + "ठा") ;
_ => adj a
} ;
adj : Str -> {s : Str} =
\cold -> {s = cold} ;
copula : Number => Str =
table {Sg => "छ" ; Pl => "छन्"} ;
}

View File

@@ -0,0 +1,30 @@
concrete FoodsOri of Foods = {
flags coding = utf8 ;
lincat
Comment = Str;
Item = Str;
Kind = Str;
Quality = Str;
lin
Pred item quality = item ++ quality ++ "ଅଟେ";
This kind = "ଏଇ" ++ kind;
That kind = "ସେଇ" ++ kind;
These kind = "ଏଇ" ++ kind ++ "ଗୁଡିକ" ;
Those kind = "ସେଇ" ++ kind ++ "ଗୁଡିକ" ;
Mod quality kind = quality ++ kind;
Wine = "ମଦ";
Cheese = "ଛେନା";
Fish = "ମାଛ";
Pizza = "ପିଜଜ଼ା" ;
Very quality = "ଅତି" ++ quality;
Fresh = "ତାଜା";
Warm = "ଗରମ";
Italian = "ଇଟାଲି";
Expensive = "ମୁଲ୍ୟବାନ୍";
Delicious = "ସ୍ଵାଦିସ୍ଟ ";
Boring = "ଅରୁଚିକର";
}

View File

@@ -0,0 +1,65 @@
concrete FoodsPes of Foods = {
flags optimize=noexpand ; coding=utf8 ;
lincat
Comment = {s : Str} ;
Quality = {s : Add => Str; prep : Str} ;
Kind = {s : Add => Number => Str ; prep : Str};
Item = {s : Str ; n : Number};
lin
Pred item quality = {s = item.s ++ quality.s ! Indep ++ copula ! item.n} ;
This = det Sg "این" ;
That = det Sg "آن" ;
These = det Pl "این" ;
Those = det Pl "آن" ;
Mod quality kind = {s = \\a,n => kind.s ! Attr ! n ++ kind.prep ++ quality.s ! a ;
prep = quality.prep
};
Wine = regN "شراب" ;
Cheese = regN "پنیر" ;
Fish = regN "ماهى" ;
Pizza = regN "پیتزا" ;
Very a = {s = \\at => "خیلی" ++ a.s ! at ; prep = a.prep} ;
Fresh = adj "تازه" ;
Warm = adj "گرم" ;
Italian = adj "ایتالیایی" ;
Expensive = adj "گران" ;
Delicious = adj "لذىذ" ;
Boring = adj "ملال آور" ; -- it must be written as ملال آور.
param
Number = Sg | Pl ;
Add = Indep | Attr ;
oper
det : Number -> Str -> {s: Add => Number => Str ; prep : Str} -> {s : Str ; n: Number} =
\n,det,noun -> {s = det ++ noun.s ! Indep ! n ; n = n };
noun : (x1,_,_,x4 : Str) -> {s : Add => Number => Str ; prep : Str} = \pytzA, pytzAy, pytzAhA,pr ->
{s = \\a,n => case <a,n> of
{<Indep,Sg> => pytzA ; <Indep,Pl> => pytzAhA ;
<Attr,Sg> =>pytzA ; <Attr,Pl> => pytzAhA + "ى" };
prep = pr
};
regN : Str -> {s: Add => Number => Str ; prep : Str} = \mrd ->
case mrd of
{ _ + ("ا"|"ه"|"ى"|"و"|"") => noun mrd (mrd+"ى") (mrd + "ها") "";
_ => noun mrd mrd (mrd + "ها") "e"
};
adj : Str -> {s : Add => Str; prep : Str} = \tAzh ->
case tAzh of
{ _ + ("ا"|"ه"|"ى"|"و"|"") => mkAdj tAzh (tAzh ++ "ى") "" ;
_ => mkAdj tAzh tAzh "ه"
};
mkAdj : Str -> Str -> Str -> {s : Add => Str; prep : Str} = \tAzh, tAzhy, pr ->
{s = table {Indep => tAzh;
Attr => tAzhy};
prep = pr
};
copula : Number => Str = table {Sg => "است"; Pl => "هستند"};
}

View File

@@ -0,0 +1,79 @@
-- (c) 2009 Rami Shashati under LGPL
concrete FoodsPor of Foods = open Prelude in {
flags coding=utf8;
lincat
Comment = {s : Str} ;
Quality = {s : Gender => Number => Str} ;
Kind = {s : Number => Str ; g : Gender} ;
Item = {s : Str ; n : Number ; g : Gender } ;
lin
Pred item quality =
{s = item.s ++ copula ! item.n ++ quality.s ! item.g ! item.n } ;
This = det Sg (table {Masc => "este" ; Fem => "esta"}) ;
That = det Sg (table {Masc => "esse" ; Fem => "essa"}) ;
These = det Pl (table {Masc => "estes" ; Fem => "estas"}) ;
Those = det Pl (table {Masc => "esses" ; Fem => "essas"}) ;
Mod quality kind = { s = \\n => kind.s ! n ++ quality.s ! kind.g ! n ; g = kind.g } ;
Wine = regNoun "vinho" Masc ;
Cheese = regNoun "queijo" Masc ;
Fish = regNoun "peixe" Masc ;
Pizza = regNoun "pizza" Fem ;
Very a = { s = \\g,n => "muito" ++ a.s ! g ! n } ;
Fresh = mkAdjReg "fresco" ;
Warm = mkAdjReg "quente" ;
Italian = mkAdjReg "Italiano" ;
Expensive = mkAdjReg "caro" ;
Delicious = mkAdjReg "delicioso" ;
Boring = mkAdjReg "chato" ;
param
Number = Sg | Pl ;
Gender = Masc | Fem ;
oper
QualityT : Type = {s : Gender => Number => Str} ;
mkAdj : (_,_,_,_ : Str) -> QualityT = \bonito,bonita,bonitos,bonitas -> {
s = table {
Masc => table { Sg => bonito ; Pl => bonitos } ;
Fem => table { Sg => bonita ; Pl => bonitas }
} ;
} ;
-- regular pattern
adjSozinho : Str -> QualityT = \sozinho ->
let sozinh = Predef.tk 1 sozinho
in mkAdj sozinho (sozinh + "a") (sozinh + "os") (sozinh + "as") ;
-- for gender-independent adjectives
adjUtil : Str -> Str -> QualityT = \util,uteis ->
mkAdj util util uteis uteis ;
-- smart paradigm for adjcetives
mkAdjReg : Str -> QualityT = \a -> case last a of {
"o" => adjSozinho a ;
"e" => adjUtil a (a + "s")
} ;
ItemT : Type = {s : Str ; n : Number ; g : Gender } ;
det : Number -> (Gender => Str) -> KindT -> ItemT =
\num,det,noun -> {s = det ! noun.g ++ noun.s ! num ; n = num ; g = noun.g } ;
KindT : Type = {s : Number => Str ; g : Gender} ;
noun : Str -> Str -> Gender -> KindT =
\animal,animais,gen -> {s = table {Sg => animal ; Pl => animais} ; g = gen } ;
regNoun : Str -> Gender -> KindT =
\carro,gen -> noun carro (carro + "s") gen ;
copula : Number => Str = table {Sg => "é" ; Pl => "são"} ;
}

View File

@@ -0,0 +1,72 @@
-- (c) 2009 Ramona Enache under LGPL
concrete FoodsRon of Foods =
{
flags coding=utf8 ;
param Number = Sg | Pl ;
Gender = Masc | Fem ;
NGender = NMasc | NFem | NNeut ;
lincat
Comment = {s : Str};
Quality = {s : Number => Gender => Str};
Kind = {s : Number => Str; g : NGender};
Item = {s : Str ; n : Number; g : Gender};
lin
This = det Sg (mkTab "acest" "această");
That = det Sg (mkTab "acel" "acea");
These = det Pl (mkTab "acești" "aceste");
Those = det Pl (mkTab "acei" "acele");
Wine = mkNoun "vin" "vinuri" NNeut ;
Cheese = mkNoun "brânză" "brânzeturi" NFem ;
Fish = mkNoun "peşte" "peşti" NMasc ;
Pizza = mkNoun "pizza" "pizze" NFem;
Very a = {s = \\n,g => "foarte" ++ a.s ! n ! g};
Fresh = mkAdj "proaspăt" "proaspătă" "proaspeţi" "proaspete" ;
Warm = mkAdj "cald" "caldă" "calzi" "calde" ;
Italian = mkAdj "italian" "italiană" "italieni" "italiene" ;
Expensive = mkAdj "scump" "scumpă" "scumpi" "scumpe" ;
Delicious = mkAdj "delicios" "delcioasă" "delicioşi" "delicioase" ;
Boring = mkAdj "plictisitor" "plictisitoare" "plictisitori" "plictisitoare" ;
Pred item quality = {s = item.s ++ copula ! item.n ++ quality.s ! item.n ! item.g} ;
Mod quality kind = {s = \\n => kind.s ! n ++ quality.s ! n ! (getAgrGender kind.g n) ; g = kind.g};
oper
mkTab : Str -> Str -> {s : Gender => Str} = \acesta, aceasta ->
{s = table{Masc => acesta;
Fem => aceasta}};
det : Number -> {s : Gender => Str} -> {s : Number => Str ; g : NGender} -> {s : Str; n : Number; g : Gender} =
\n,det,noun -> let gg = getAgrGender noun.g n
in
{s = det.s ! gg ++ noun.s ! n ; n = n ; g = gg};
mkNoun : Str -> Str -> NGender -> {s : Number => Str; g : NGender} = \peste, pesti,g ->
{s = table {Sg => peste;
Pl => pesti};
g = g
};
oper mkAdj : (x1,_,_,x4 : Str) -> {s : Number => Gender => Str} = \scump, scumpa, scumpi, scumpe ->
{s = \\n,g => case <n,g> of
{<Sg,Masc> => scump ; <Sg,Fem> => scumpa;
<Pl,Masc> => scumpi ; <Pl,Fem> => scumpe
}};
copula : Number => Str = table {Sg => "este" ; Pl => "sunt"};
getAgrGender : NGender -> Number -> Gender = \ng,n ->
case <ng,n> of
{<NMasc,_> => Masc ; <NFem,_> => Fem;
<NNeut,Sg> => Masc ; <NNeut,Pl> => Fem
};
}

View File

@@ -0,0 +1,31 @@
--# -path=.:present
concrete FoodsSpa of Foods = open SyntaxSpa, StructuralSpa, ParadigmsSpa in {
lincat
Comment = Utt ;
Item = NP ;
Kind = CN ;
Quality = AP ;
lin
Pred item quality = mkUtt (mkCl item quality) ;
This kind = mkNP this_QuantSg kind ;
That kind = mkNP that_QuantSg kind ;
These kind = mkNP these_QuantPl kind ;
Those kind = mkNP those_QuantPl kind ;
Mod quality kind = mkCN quality kind ;
Very quality = mkAP very_AdA quality ;
Wine = mkCN (mkN "vino") ;
Pizza = mkCN (mkN "pizza") ;
Cheese = mkCN (mkN "queso") ;
Fish = mkCN (mkN "pescado") ;
Fresh = mkAP (mkA "fresco") ;
Warm = mkAP (mkA "caliente") ;
Italian = mkAP (mkA "italiano") ;
Expensive = mkAP (mkA "caro") ;
Delicious = mkAP (mkA "delicioso") ;
Boring = mkAP (mkA "aburrido") ;
}

View File

@@ -0,0 +1,7 @@
--# -path=.:present
-- (c) 2009 Aarne Ranta under LGPL
concrete FoodsSwe of Foods = FoodsI with
(Syntax = SyntaxSwe),
(LexFoods = LexFoodsSwe) ** {flags language = sv_SE;} ;

View File

@@ -0,0 +1,33 @@
--# -path=.:alltenses
concrete FoodsTha of Foods = open SyntaxTha, LexiconTha,
ParadigmsTha, (R=ResTha) in {
flags coding = utf8 ;
lincat
Comment = Utt ;
Item = NP ;
Kind = CN ;
Quality = AP ;
lin
Pred item quality = mkUtt (mkCl item quality) ;
This kind = mkNP this_Det kind ;
That kind = mkNP that_Det kind ;
These kind = mkNP these_Det kind ;
Those kind = mkNP those_Det kind ;
Mod quality kind = mkCN quality kind ;
Very quality = mkAP very_AdA quality ;
Wine = mkCN (mkN (R.thword "เหล้าอ" "งุ่น") "ขวด") ;
Pizza = mkCN (mkN (R.thword "พิซ" "ซา") "ถาด") ;
Cheese = mkCN (mkN (R.thword "เนย" "แข็ง") "ก้อน") ;
Fish = mkCN fish_N ;
Fresh = mkAP (mkA "สด") ;
Warm = mkAP warm_A ;
Italian = mkAP (mkA " อิตาลี") ;
Expensive = mkAP (mkA "แพง") ;
Delicious = mkAP (mkA "อร่อย") ;
Boring = mkAP (mkA (R.thword "น่า" "เบิ่อ")) ;
}

View File

@@ -0,0 +1,178 @@
--# -path=alltenses
-- (c) 2009 Laurette Pretorius Sr & Jr and Ansu Berg under LGPL
concrete FoodsTsn of Foods = open Prelude, Predef in {
flags coding = utf8;
lincat
Comment = {s:Str};
Item = {s:Str; c:NounClass; n:Number};
Kind = {w: Number => Str; r: Str; c: NounClass; q: Number => Str; b: Bool};
Quality = {s: NounClass => Number => Str; p_form: Str; t: TType};
lin
Pred item quality = {s = item.s ++ ((mkPredDescrCop quality.t) ! item.c ! item.n) ++ quality.p_form};
This kind = {s = (kind.w ! Sg) ++ (mkDemPron1 ! kind.c ! Sg) ++ (kind.q ! Sg); c = kind.c; n = Sg};
That kind = {s = (kind.w ! Sg) ++ (mkDemPron2 ! kind.c ! Sg) ++ (kind.q ! Sg); c = kind.c; n = Sg};
These kind = {s = (kind.w ! Pl) ++ (mkDemPron1 ! kind.c ! Pl) ++ (kind.q ! Pl); c = kind.c; n = Pl};
Those kind = {s = (kind.w ! Pl) ++ (mkDemPron2 ! kind.c ! Pl) ++ (kind.q ! Pl); c = kind.c; n = Pl};
Mod quality kind = mkMod quality kind;
-- Lexicon
Wine = mkNounNC14_6 "jalwa";
Cheese = mkNounNC9_10 "kase";
Fish = mkNounNC9_10 "thlapi";
Pizza = mkNounNC9_10 "pizza";
Very quality = smartVery quality;
Fresh = mkVarAdj "ntsha";
Warm = mkOrdAdj "bothitho";
Italian = mkPerAdj "Itali";
Expensive = mkVerbRel "tura";
Delicious = mkOrdAdj "monate";
Boring = mkOrdAdj "bosula";
param
NounClass = NC9_10 | NC14_6;
Number = Sg | Pl;
TType = P | V | ModV | R ;
oper
mkMod : {s: NounClass => Number => Str; p_form: Str; t: TType} -> {w: Number => Str; r: Str; c: NounClass; q: Number => Str; b: Bool} -> {w: Number => Str; r: Str; c: NounClass; q: Number => Str;
b: Bool} = \x,y -> case y.b of
{
True => {w = y.w; r = y.r; c = y.c;
q = table {
Sg => ((y.q ! Sg) ++ "le" ++ ((smartQualRelPart (x.t)) ! y.c ! Sg) ++ ((smartDescrCop (x.t)) ! y.c ! Sg) ++ (x.s ! y.c ! Sg));
Pl => ((y.q ! Pl) ++ "le" ++ ((smartQualRelPart (x.t))! y.c ! Pl) ++ ((smartDescrCop (x.t)) ! y.c ! Pl) ++(x.s ! y.c ! Pl))
}; b = True
};
False => {w = y.w; r = y.r; c = y.c;
q = table {
Sg => ((y.q ! Sg) ++ ((smartQualRelPart (x.t)) ! y.c ! Sg) ++ ((smartDescrCop (x.t)) ! y.c ! Sg) ++ (x.s ! y.c ! Sg));
Pl => ((y.q ! Pl) ++ ((smartQualRelPart (x.t)) ! y.c ! Pl) ++ ((smartDescrCop (x.t)) ! y.c ! Pl) ++(x.s ! y.c ! Pl))
}; b = True
}
};
mkNounNC14_6 : Str -> {w: Number => Str; r: Str; c: NounClass; q: Number => Str; b: Bool} = \x -> {w = table {Sg => "bo" + x; Pl => "ma" + x}; r = x; c = NC14_6;
q = table {Sg => ""; Pl => ""}; b = False};
mkNounNC9_10 : Str -> {w: Number => Str; r: Str; c: NounClass; q: Number => Str; b: Bool} = \x -> {w = table {Sg => "" + x; Pl => "di" + x}; r = x; c = NC9_10;
q = table {Sg => ""; Pl => ""}; b = False};
mkVarAdj : Str -> {s: NounClass => Number => Str; p_form: Str; t: TType} = \x ->
{
s = table {
NC9_10 => table {Sg => "" + x; Pl => "di" + x};
NC14_6 => table {Sg => "bo" + x; Pl => "ma" + x}
};
p_form = x;
t = R;
};
mkOrdAdj : Str -> {s: NounClass => Number => Str; p_form: Str; t: TType} = \x ->
{
s = table {
NC9_10 => table {Sg => "" + x; Pl => "" + x};
NC14_6 => table {Sg => "" + x; Pl => "" + x}
};
p_form = x;
t = R;
};
mkVerbRel : Str -> {s: NounClass => Number => Str; p_form: Str; t: TType} = \x ->
{
s = table {
NC9_10 => table {Sg => x + "ng"; Pl => x + "ng"};
NC14_6 => table {Sg => x + "ng"; Pl => x + "ng"}
};
p_form = x;
t = V;
};
mkPerAdj : Str -> {s: NounClass => Number => Str; p_form: Str; t: TType} = \x ->
{
s = table {
NC9_10 => table {Sg => "" + x; Pl => "" + x};
NC14_6 => table {Sg => "" + x; Pl => "" + x}
};
p_form = "mo" ++ x;
t = P;
};
mkVeryAdj : {s: NounClass => Number => Str; p_form: Str; t: TType} -> {s: NounClass => Number => Str; p_form: Str; t: TType} = \x ->
{
s = table{c => table{n => (x.s!c!n) ++ "thata"}}; p_form = x.p_form ++ "thata"; t = x.t
};
mkVeryVerb : {s: NounClass => Number => Str; p_form: Str; t: TType} -> {s: NounClass => Number => Str; p_form: Str; t: TType} = \x ->
{
s = table{c => table{n => (x.s!c!n) ++ "thata"}}; p_form = x.p_form ++ "thata"; t = ModV
};
smartVery : {s: NounClass => Number => Str; p_form: Str; t: TType} -> {s: NounClass => Number => Str; p_form: Str; t: TType} =
\x -> case x.t of --(x.s!c!n)
{
(V | ModV) => mkVeryVerb x;
--ModV => mkVeryVerb x;
_ => mkVeryAdj x
};
mkDemPron1 : NounClass => Number => Str = table
{
NC9_10 => table {Sg => "e"; Pl => "tse"};
NC14_6 => table {Sg => "bo"; Pl => "a"}
};
mkDemPron2 : NounClass => Number => Str = table
{
NC9_10 => table {Sg => "eo"; Pl => "tseo"};
NC14_6 => table {Sg => "boo"; Pl => "ao"}
};
smartQualRelPart : TType -> (NounClass => Number => Str) = \x -> case x of
{
P => mkQualRelPart_PName;
_ => mkQualRelPart
};
mkQualRelPart : NounClass => Number => Str = table
{
NC9_10 => table {Sg => "e"; Pl => "tse"};
NC14_6 => table {Sg => "bo"; Pl => "a"}
};
mkQualRelPart_PName : NounClass => Number => Str = table
{
NC9_10 => table {Sg => "ya"; Pl => "tsa"};
NC14_6 => table {Sg => "ba"; Pl => "a"}
};
smartDescrCop : TType -> (NounClass => Number => Str) = \x -> case x of
{
P => mkDescrCop_PName;
_ => mkDescrCop
};
mkDescrCop : NounClass => Number => Str = table
{
NC9_10 => table {Sg => "e"; Pl => "di"};
NC14_6 => table {Sg => "bo"; Pl => "a"}
};
mkDescrCop_PName : NounClass => Number => Str = table
{
NC9_10 => table {Sg => "ga"; Pl => "ga"};
NC14_6 => table {Sg => "ga"; Pl => "ga"}
};
mkPredDescrCop : TType -> (NounClass => Number => Str) = \x -> case x of
{
V => table {NC9_10 => table {Sg => "e" ++ "a"; Pl => "di" ++ "a"};
NC14_6 => table {Sg => "bo" ++ "a"; Pl => "a" ++ "a"}};
_ => table {NC9_10 => table {Sg => "e"; Pl => "di"};
NC14_6 => table {Sg => "bo"; Pl => "a"}}
};
}

View File

@@ -0,0 +1,140 @@
{-
File : FoodsTur.gf
Author : Server Çimen
Version : 1.0
Created on: August 26, 2009
This file contains concrete grammar of Foods abstract grammar for Turkish Language.
This grammar is to be used for Fridge demo and developed in the scope of GF Resource
Grammar Summer School.
-}
concrete FoodsTur of Foods = open Predef in {
flags
coding=utf8 ;
lincat
Comment = {s : Str} ;
Quality = {s : Str ; c : Case; softness : Softness; h : Harmony} ;
Kind = {s : Case => Number => Str} ;
Item = {s : Str; n : Number} ;
lin
This = det Sg "bu" ;
That = det Sg "şu" ;
These = det Pl "bu" ;
Those = det Pl "şu" ;
-- Reason for excluding plural form of copula: In Turkish if subject is not a human being,
-- then singular form of copula is used regardless of the number of subject. Since all
-- possible subjects are non human, copula do not need to have plural form.
Pred item quality = {s = item.s ++ quality.s ++ "&+" ++ copula ! quality.softness ! quality.h} ;--! item.n} ;
Mod quality kind = {s = case quality.c of {
Nom => \\t,n => quality.s ++ kind.s ! t ! n ;
Gen => \\t,n => quality.s ++ kind.s ! Gen ! n
}
} ;
Wine = mkN "şarap" "şaraplar" "şarabı" "şarapları" ;
Cheese = mkN "peynir" "peynirler" "peyniri" "peynirleri" ;
Fish = mkN "balık" "balıklar" "balığı" "balıkları" ;
Pizza = mkN "pizza" "pizzalar" "pizzası" "pizzaları" ;
Very a = {s = "çok" ++ a.s ; c = a.c; softness = a.softness; h = a.h} ;
Fresh = adj "taze" Nom;
Warm = adj "ılık" Nom;
Italian = adj "İtalyan" Gen ;
Expensive = adj "pahalı" Nom;
Delicious = adj "lezzetli" Nom;
Boring = adj "sıkıcı" Nom;
param
Number = Sg | Pl ;
Case = Nom | Gen ;
Harmony = I_Har | Ih_Har | U_Har | Uh_Har ; --Ih = İ; Uh = Ü
Softness = Soft | Hard ;
oper
det : Number -> Str -> {s : Case => Number => Str} -> {s : Str; n : Number} =
\num,det,noun -> {s = det ++ noun.s ! Nom ! num; n = num} ;
mkN = overload {
mkN : Str -> Str -> {s : Case => Number => Str} = regNoun ;
mkn : Str -> Str -> Str -> Str-> {s : Case => Number => Str} = noun ;
} ;
regNoun : Str -> Str -> {s : Case => Number => Str} =
\peynir,peynirler -> noun peynir peynirler [] [] ;
noun : Str -> Str -> Str -> Str-> {s : Case => Number => Str} =
\sarap,saraplar,sarabi,saraplari -> {
s = table {
Nom => table {
Sg => sarap ;
Pl => saraplar
} ;
Gen => table {
Sg => sarabi ;
Pl => saraplari
}
}
};
{-
Since there is a bug in overloading, this overload is useless.
mkA = overload {
mkA : Str -> {s : Str; c : Case; softness : Softness; h : Harmony} = \base -> adj base Nom ;
mkA : Str -> Case -> {s : Str; c : Case; softness : Softness; h : Harmony} = adj ;
} ;
-}
adj : Str -> Case -> {s : Str; c : Case; softness : Softness; h : Harmony} =
\italyan,ca -> {s = italyan ; c = ca; softness = (getSoftness italyan); h = (getHarmony italyan)} ;
-- See the comment at lines 26 and 27 for excluded plural form of copula.
copula : Softness => Harmony {-=> Number-} => Str =
table {
Soft => table {
I_Har => "dır" ;--table {
-- Sg => "dır" ;
-- Pl => "dırlar"
--} ;
Ih_Har => "dir" ;--table {
--Sg => "dir" ;
--Pl => "dirler"
--} ;
U_Har => "dur" ;--table {
-- Sg => "dur" ;
-- Pl => "durlar"
--} ;
Uh_Har => "dür" --table {
--Sg => "dür" ;
--Pl => "dürler"
--}
} ;
Hard => table {
I_Har => "tır" ;--table {
--Sg => "tır" ;
--Pl => "tırlar"
--} ;
Ih_Har => "tir" ;--table {
--Sg => "tir" ;
--Pl => "tirler"
--} ;
U_Har => "tur" ;--table {
-- Sg => "tur" ;
-- Pl => "turlar"
--} ;
Uh_Har => "tür"--table {
--Sg => "tür" ;
--Pl => "türler"
--}
}
} ;
getHarmony : Str -> Harmony
= \base -> case base of {
_+c@("ı"|"a"|"i"|"e"|"u"|"o"|"ü"|"ö")+
("b"|"v"|"d"|"z"|"j"|"c"|"g"|"ğ"|"l"|"r"|"m"|"n"|"y"|"p"|"f"|"t"|"s"|"ş"|"ç"|"k"|"h")* =>
case c of {
("ı"|"a") => I_Har ;
("i"|"e") => Ih_Har ;
("u"|"o") => U_Har ;
("ü"|"ö") => Uh_Har
}
} ;
getSoftness : Str -> Softness
= \base -> case base of {
_+("f"|"s"|"t"|"k"|"ç"|"ş"|"h"|"p") => Hard ;
_ => Soft
} ;
}

View File

@@ -0,0 +1,53 @@
-- (c) 2009 Shafqat Virk under LGPL
concrete FoodsUrd of Foods = {
flags coding=utf8 ;
param Number = Sg | Pl ;
param Gender = Masc | Fem;
oper coupla : Number -> Str =\n -> case n of {Sg => "ہے" ; Pl => "ہیں"};
lincat
Comment = {s : Str} ;
Item = {s: Str ; n: Number ; g:Gender};
Kind = {s: Number => Str ; g:Gender};
Quality = {s: Gender => Number => Str};
lin
Pred item quality = {s = item.s ++ quality.s ! item.g ! item.n ++ coupla item.n} ;
This kind = {s = "یھ" ++ kind.s ! Sg; n= Sg ; g = kind.g } ;
These kind = {s = "یھ" ++ kind.s ! Pl; n = Pl ; g = kind.g} ;
That kind = {s = "وہ" ++ kind.s ! Sg; n= Sg ; g = kind.g} ;
Those kind = {s = "وہ" ++ kind.s ! Pl; n=Pl ; g = kind.g} ;
Mod quality kind = {s = \\n => quality.s ! kind.g ! n ++ kind.s ! n ; g = kind.g};
Wine = {s = table { Sg => "شراب" ; Pl => "شرابیں"} ; g = Fem};
Cheese = {s = table { Sg => "پنیر" ; Pl => "پنیریں"} ; g = Fem};
Fish = {s = table { Sg => "مچھلی" ; Pl => "مچھلیاں"} ; g = Fem};
Pizza = {s = table { Sg => "پیزہ" ; Pl => "پیزے"} ; g = Masc};
Very quality = {s = \\g,n => "بہت" ++ quality.s ! g ! n} ;
Fresh = regAdj "تازہ" ;
Warm = regAdj "گرم" ;
Italian = regAdj "اٹا لوی" ;
Expensive = regAdj "مہنگا" ;
Delicious = regAdj "مزیدار" ;
Boring = regAdj "فضول" ;
oper
regAdj : Str -> {s: Gender => Number => Str} = \a -> case a of {
x + "ا" => mkAdj a (x+"ے") (x+"ی");
_ => mkAdj a a a
};
mkAdj : Str -> Str -> Str -> {s: Gender => Number => Str} = \s,p,f -> {
s = table {
Masc => table {
Sg => s;
Pl => p
};
Fem => \\_ => f
}
};
}

View File

@@ -0,0 +1,15 @@
-- (c) 2009 Aarne Ranta under LGPL
interface LexFoods = open Syntax in {
oper
wine_N : N ;
pizza_N : N ;
cheese_N : N ;
fish_N : N ;
fresh_A : A ;
warm_A : A ;
italian_A : A ;
expensive_A : A ;
delicious_A : A ;
boring_A : A ;
}

View File

@@ -0,0 +1,18 @@
-- (c) 2009 Jordi Saludes under LGPL
instance LexFoodsCat of LexFoods =
open SyntaxCat, ParadigmsCat, (M = MorphoCat) in {
flags
coding = utf8 ;
oper
wine_N = mkN "vi" "vins" M.Masc ;
pizza_N = mkN "pizza" ;
cheese_N = mkN "formatge" ;
fish_N = mkN "peix" "peixos" M.Masc;
fresh_A = mkA "fresc" "fresca" "frescos" "fresques" "frescament";
warm_A = mkA "calent" ;
italian_A = mkA "italià" "italiana" "italians" "italianes" "italianament" ;
expensive_A = mkA "car" ;
delicious_A = mkA "deliciós" "deliciosa" "deliciosos" "delicioses" "deliciosament";
boring_A = mkA "aburrit" "aburrida" "aburrits" "aburrides" "aburridament" ;
}

View File

@@ -0,0 +1,21 @@
-- (c) 2009 Aarne Ranta under LGPL
instance LexFoodsFin of LexFoods =
open SyntaxFin, ParadigmsFin in {
flags coding=utf8;
oper
wine_N = mkN "viini" ;
pizza_N = mkN "pizza" ;
cheese_N = mkN "juusto" ;
fish_N = mkN "kala" ;
fresh_A = mkA "tuore" ;
warm_A = mkA
(mkN "lämmin" "lämpimän" "lämmintä" "lämpimänä" "lämpimään"
"lämpiminä" "lämpimiä" "lämpimien" "lämpimissä" "lämpimiin"
)
"lämpimämpi" "lämpimin" ;
italian_A = mkA "italialainen" ;
expensive_A = mkA "kallis" ;
delicious_A = mkA "herkullinen" ;
boring_A = mkA "tylsä" ;
}

Some files were not shown because too many files have changed in this diff Show More